summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore9
-rw-r--r--.gitlab-ci.yml45
-rw-r--r--CONTRIBUTE9
-rw-r--r--INSTALL36
-rw-r--r--Makefile.in7
-rw-r--r--README2
-rw-r--r--admin/CPP-DEFINES4
-rw-r--r--admin/authors.el35
-rwxr-xr-xadmin/automerge1
-rw-r--r--admin/charsets/cp51932.awk13
-rw-r--r--admin/charsets/eucjp-ms.awk14
-rw-r--r--admin/cus-test.el13
-rw-r--r--admin/find-gc.el4
-rw-r--r--admin/gitmerge.el4
-rwxr-xr-xadmin/make-manuals1
-rwxr-xr-xadmin/merge-gnulib16
-rw-r--r--admin/notes/git-workflow36
-rw-r--r--admin/notes/unicode10
-rw-r--r--admin/nt/dist-build/README-windows-binaries4
-rwxr-xr-xadmin/nt/dist-build/build-dep-zips.py2
-rw-r--r--admin/release-process13
-rwxr-xr-xadmin/unidata/blocks.awk1
-rw-r--r--admin/unidata/unidata-gen.el163
-rwxr-xr-xadmin/update_autogen1
-rwxr-xr-xadmin/upload-manuals1
-rwxr-xr-xbuild-aux/config.guess54
-rwxr-xr-xbuild-aux/config.sub586
-rwxr-xr-xbuild-aux/gitlog-to-changelog4
-rwxr-xr-xbuild-aux/install-sh115
-rwxr-xr-xbuild-aux/update-copyright4
-rwxr-xr-xbuild-aux/update-subdirs2
-rw-r--r--configure.ac386
-rw-r--r--doc/emacs/abbrevs.texi33
-rw-r--r--doc/emacs/basic.texi16
-rw-r--r--doc/emacs/buffers.texi11
-rw-r--r--doc/emacs/building.texi48
-rw-r--r--doc/emacs/calendar.texi4
-rw-r--r--doc/emacs/cmdargs.texi15
-rw-r--r--doc/emacs/custom.texi5
-rw-r--r--doc/emacs/dired.texi52
-rw-r--r--doc/emacs/display.texi36
-rw-r--r--doc/emacs/emacs.texi18
-rw-r--r--doc/emacs/files.texi21
-rw-r--r--doc/emacs/fixit.texi26
-rw-r--r--doc/emacs/frames.texi48
-rw-r--r--doc/emacs/help.texi22
-rw-r--r--doc/emacs/killing.texi4
-rw-r--r--doc/emacs/m-x.texi4
-rw-r--r--doc/emacs/maintaining.texi172
-rw-r--r--doc/emacs/misc.texi43
-rw-r--r--doc/emacs/msdos.texi15
-rw-r--r--doc/emacs/mule.texi9
-rw-r--r--doc/emacs/package.texi69
-rw-r--r--doc/emacs/programs.texi32
-rw-r--r--doc/emacs/search.texi13
-rw-r--r--doc/emacs/trouble.texi20
-rw-r--r--doc/emacs/windows.texi10
-rw-r--r--doc/lispintro/emacs-lisp-intro.texi2
-rw-r--r--doc/lispref/backups.texi78
-rw-r--r--doc/lispref/customize.texi20
-rw-r--r--doc/lispref/display.texi33
-rw-r--r--doc/lispref/edebug.texi15
-rw-r--r--doc/lispref/files.texi42
-rw-r--r--doc/lispref/frames.texi28
-rw-r--r--doc/lispref/functions.texi37
-rw-r--r--doc/lispref/help.texi3
-rw-r--r--doc/lispref/internals.texi226
-rw-r--r--doc/lispref/intro.texi4
-rw-r--r--doc/lispref/keymaps.texi7
-rw-r--r--doc/lispref/loading.texi11
-rw-r--r--doc/lispref/minibuf.texi60
-rw-r--r--doc/lispref/modes.texi50
-rw-r--r--doc/lispref/objects.texi8
-rw-r--r--doc/lispref/os.texi17
-rw-r--r--doc/lispref/positions.texi8
-rw-r--r--doc/lispref/processes.texi49
-rw-r--r--doc/lispref/searching.texi11
-rw-r--r--doc/lispref/strings.texi45
-rw-r--r--doc/lispref/text.texi16
-rw-r--r--doc/lispref/tips.texi65
-rw-r--r--doc/lispref/variables.texi7
-rw-r--r--doc/lispref/windows.texi14
-rw-r--r--doc/misc/auth.texi5
-rw-r--r--doc/misc/calc.texi19
-rw-r--r--doc/misc/cc-mode.texi79
-rw-r--r--doc/misc/cl.texi2
-rw-r--r--doc/misc/dbus.texi285
-rw-r--r--doc/misc/dired-x.texi91
-rw-r--r--doc/misc/ediff.texi37
-rw-r--r--doc/misc/efaq.texi16
-rw-r--r--doc/misc/eieio.texi32
-rw-r--r--doc/misc/emacs-gnutls.texi2
-rw-r--r--doc/misc/emacs-mime.texi22
-rw-r--r--doc/misc/eshell.texi3
-rw-r--r--doc/misc/eudc.texi48
-rw-r--r--doc/misc/eww.texi44
-rw-r--r--doc/misc/gnus-coding.texi10
-rw-r--r--doc/misc/gnus-faq.texi2
-rw-r--r--doc/misc/gnus.texi592
-rw-r--r--doc/misc/idlwave.texi8
-rw-r--r--doc/misc/ido.texi2
-rw-r--r--doc/misc/message.texi67
-rw-r--r--doc/misc/org.texi7
-rw-r--r--doc/misc/reftex.texi9
-rw-r--r--doc/misc/sem-user.texi2
-rw-r--r--doc/misc/smtpmail.texi33
-rw-r--r--doc/misc/speedbar.texi10
-rw-r--r--doc/misc/texinfo.tex415
-rw-r--r--doc/misc/tramp.texi374
-rw-r--r--doc/misc/trampver.texi5
-rw-r--r--doc/misc/url.texi2
-rw-r--r--doc/misc/viper.texi9
-rw-r--r--etc/AUTHORS224
-rw-r--r--etc/MACHINES25
-rw-r--r--etc/NEWS4563
-rw-r--r--etc/NEWS.273210
-rw-r--r--etc/PROBLEMS265
-rw-r--r--etc/TODO7
-rw-r--r--etc/compilation.txt23
-rw-r--r--etc/edt-user.el2
-rw-r--r--etc/emacs-mail.desktop10
-rw-r--r--etc/emacs.service2
-rw-r--r--etc/emacsclient.desktop12
-rw-r--r--etc/forms/forms-d2.el2
-rw-r--r--etc/forms/forms-pass.el2
-rw-r--r--etc/refcards/cs-refcard.tex1
-rw-r--r--etc/refcards/cs-survival.tex1
-rw-r--r--etc/refcards/de-refcard.tex1
-rw-r--r--etc/refcards/fr-refcard.tex1
-rw-r--r--etc/refcards/fr-survival.tex1
-rw-r--r--etc/refcards/pl-refcard.tex2
-rw-r--r--etc/refcards/pt-br-refcard.tex1
-rw-r--r--etc/refcards/refcard.tex5
-rw-r--r--etc/refcards/ru-refcard.tex3
-rw-r--r--etc/refcards/sk-refcard.tex1
-rw-r--r--etc/refcards/sk-survival.tex1
-rw-r--r--etc/refcards/survival.tex1
-rw-r--r--etc/srecode/el.srt2
-rw-r--r--etc/themes/adwaita-theme.el2
-rw-r--r--etc/themes/deeper-blue-theme.el3
-rw-r--r--etc/themes/dichromacy-theme.el2
-rw-r--r--etc/themes/leuven-theme.el689
-rw-r--r--etc/themes/light-blue-theme.el2
-rw-r--r--etc/themes/manoj-dark-theme.el11
-rw-r--r--etc/themes/misterioso-theme.el2
-rw-r--r--etc/themes/modus-operandi-theme.el4266
-rw-r--r--etc/themes/modus-vivendi-theme.el4266
-rw-r--r--etc/themes/tango-dark-theme.el2
-rw-r--r--etc/themes/tango-theme.el2
-rw-r--r--etc/themes/tsdh-dark-theme.el2
-rw-r--r--etc/themes/tsdh-light-theme.el2
-rw-r--r--etc/themes/wheatgrass-theme.el2
-rw-r--r--etc/themes/whiteboard-theme.el3
-rw-r--r--etc/themes/wombat-theme.el2
-rw-r--r--etc/tutorials/TUTORIAL15
-rw-r--r--etc/tutorials/TUTORIAL.he5
-rw-r--r--leim/SKK-DIC/SKK-JISYO.L4
-rw-r--r--lib-src/Makefile.in2
-rw-r--r--lib-src/emacsclient.c18
-rw-r--r--lib-src/etags.c7
-rw-r--r--lib/_Noreturn.h5
-rw-r--r--lib/alloca.in.h21
-rw-r--r--lib/arg-nonnull.h2
-rw-r--r--lib/at-func.c2
-rw-r--r--lib/attribute.h215
-rw-r--r--lib/binary-io.h5
-rw-r--r--lib/c++defs.h19
-rw-r--r--lib/c-ctype.h3
-rw-r--r--lib/c-strcasecmp.c5
-rw-r--r--lib/c-strncasecmp.c5
-rw-r--r--lib/canonicalize-lgpl.c6
-rw-r--r--lib/careadlinkat.c120
-rw-r--r--lib/careadlinkat.h2
-rw-r--r--lib/cdefs.h114
-rw-r--r--lib/cloexec.c3
-rw-r--r--lib/close-stream.c3
-rw-r--r--lib/count-leading-zeros.h11
-rw-r--r--lib/count-one-bits.h94
-rw-r--r--lib/count-trailing-zeros.h11
-rw-r--r--lib/diffseq.h132
-rw-r--r--lib/dirent.in.h10
-rw-r--r--lib/dosname.h53
-rw-r--r--lib/dup2.c105
-rw-r--r--lib/explicit_bzero.c18
-rw-r--r--lib/fchmodat.c144
-rw-r--r--lib/fcntl.c4
-rw-r--r--lib/fcntl.in.h24
-rw-r--r--lib/filemode.h4
-rw-r--r--lib/filename.h110
-rw-r--r--lib/fpending.c4
-rw-r--r--lib/fpending.h4
-rw-r--r--lib/fsusage.c8
-rw-r--r--lib/ftoastr.c23
-rw-r--r--lib/ftoastr.h7
-rw-r--r--lib/futimens.c37
-rw-r--r--lib/getgroups.c3
-rw-r--r--lib/getloadavg.c49
-rw-r--r--lib/getopt-cdefs.in.h2
-rw-r--r--lib/getopt-pfx-core.h8
-rw-r--r--lib/getrandom.c187
-rw-r--r--lib/gettext.h4
-rw-r--r--lib/gettime.c3
-rw-r--r--lib/gettimeofday.c32
-rw-r--r--lib/gnulib.mk.in264
-rw-r--r--lib/group-member.c4
-rw-r--r--lib/ieee754.in.h4
-rw-r--r--lib/ignore-value.h5
-rw-r--r--lib/intprops.h20
-rw-r--r--lib/inttypes.in.h496
-rw-r--r--lib/lchmod.c110
-rw-r--r--lib/libc-config.h16
-rw-r--r--lib/limits.in.h23
-rw-r--r--lib/localtime-buffer.c61
-rw-r--r--lib/localtime-buffer.h28
-rw-r--r--lib/malloca.c3
-rw-r--r--lib/malloca.h6
-rw-r--r--lib/md5.c4
-rw-r--r--lib/md5.h14
-rw-r--r--lib/memmem.c4
-rw-r--r--lib/memrchr.c4
-rw-r--r--lib/mini-gmp-gnulib.c39
-rw-r--r--lib/mini-gmp.c (renamed from src/mini-gmp.c)362
-rw-r--r--lib/mini-gmp.h (renamed from src/mini-gmp.h)18
-rw-r--r--lib/mktime.c8
-rw-r--r--lib/nstrftime.c58
-rw-r--r--lib/open.c10
-rw-r--r--lib/openat-proc.c5
-rw-r--r--lib/openat.h20
-rw-r--r--lib/putenv.c194
-rw-r--r--lib/regcomp.c2
-rw-r--r--lib/regex.c2
-rw-r--r--lib/regex.h19
-rw-r--r--lib/regex_internal.h61
-rw-r--r--lib/sha1.c3
-rw-r--r--lib/sha1.h7
-rw-r--r--lib/sha256.h20
-rw-r--r--lib/sha512.h20
-rw-r--r--lib/sig2str.c20
-rw-r--r--lib/sigdescr_np.c376
-rw-r--r--lib/signal.in.h30
-rw-r--r--lib/stdalign.in.h23
-rw-r--r--lib/stddef.in.h29
-rw-r--r--lib/stdint.in.h21
-rw-r--r--lib/stdio.in.h328
-rw-r--r--lib/stdlib.in.h139
-rw-r--r--lib/strftime.h9
-rw-r--r--lib/string.in.h128
-rw-r--r--lib/strtoimax.c26
-rw-r--r--lib/strtol.c4
-rw-r--r--lib/strtoll.c4
-rw-r--r--lib/sys_random.in.h96
-rw-r--r--lib/sys_select.in.h6
-rw-r--r--lib/sys_stat.in.h98
-rw-r--r--lib/sys_time.in.h2
-rw-r--r--lib/tempname.c281
-rw-r--r--lib/tempname.h7
-rw-r--r--lib/time.in.h29
-rw-r--r--lib/time_r.c3
-rw-r--r--lib/time_rz.c51
-rw-r--r--lib/timespec.h41
-rw-r--r--lib/unistd.in.h226
-rw-r--r--lib/utimensat.c160
-rw-r--r--lib/verify.h48
-rw-r--r--lib/warn-on-use.h44
-rw-r--r--lib/xalloc-oversized.h3
-rw-r--r--lisp/Makefile.in1
-rw-r--r--lisp/abbrev.el162
-rw-r--r--lisp/align.el8
-rw-r--r--lisp/allout-widgets.el185
-rw-r--r--lisp/allout.el470
-rw-r--r--lisp/ansi-color.el2
-rw-r--r--lisp/apropos.el125
-rw-r--r--lisp/arc-mode.el1077
-rw-r--r--lisp/auth-source.el4
-rw-r--r--lisp/autoarg.el7
-rw-r--r--lisp/autoinsert.el2
-rw-r--r--lisp/autorevert.el114
-rw-r--r--lisp/battery.el670
-rw-r--r--lisp/bindings.el96
-rw-r--r--lisp/bookmark.el116
-rw-r--r--lisp/bs.el7
-rw-r--r--lisp/buff-menu.el63
-rw-r--r--lisp/button.el74
-rw-r--r--lisp/calc/calc-bin.el4
-rw-r--r--lisp/calc/calc-comb.el58
-rw-r--r--lisp/calc/calc-forms.el13
-rw-r--r--lisp/calc/calc-funcs.el14
-rw-r--r--lisp/calc/calc-mtx.el2
-rw-r--r--lisp/calc/calc-store.el10
-rw-r--r--lisp/calc/calc-units.el8
-rw-r--r--lisp/calc/calc-yank.el56
-rw-r--r--lisp/calc/calc.el107
-rw-r--r--lisp/calc/calcalg3.el24
-rw-r--r--lisp/calc/calccomp.el3
-rw-r--r--lisp/calculator.el12
-rw-r--r--lisp/calendar/cal-bahai.el4
-rw-r--r--lisp/calendar/cal-dst.el18
-rw-r--r--lisp/calendar/cal-julian.el22
-rw-r--r--lisp/calendar/calendar.el24
-rw-r--r--lisp/calendar/diary-lib.el2
-rw-r--r--lisp/calendar/icalendar.el59
-rw-r--r--lisp/calendar/iso8601.el17
-rw-r--r--lisp/calendar/lunar.el44
-rw-r--r--lisp/calendar/parse-time.el98
-rw-r--r--lisp/calendar/solar.el10
-rw-r--r--lisp/calendar/time-date.el38
-rw-r--r--lisp/calendar/timeclock.el8
-rw-r--r--lisp/calendar/todo-mode.el97
-rw-r--r--lisp/cdl.el2
-rw-r--r--lisp/cedet/data-debug.el42
-rw-r--r--lisp/cedet/ede.el16
-rw-r--r--lisp/cedet/ede/cpp-root.el15
-rw-r--r--lisp/cedet/ede/detect.el10
-rw-r--r--lisp/cedet/ede/emacs.el27
-rw-r--r--lisp/cedet/ede/make.el24
-rw-r--r--lisp/cedet/ede/pconf.el5
-rw-r--r--lisp/cedet/ede/proj-elisp.el15
-rw-r--r--lisp/cedet/semantic.el79
-rw-r--r--lisp/cedet/semantic/bovine/c.el25
-rw-r--r--lisp/cedet/semantic/bovine/el.el3
-rw-r--r--lisp/cedet/semantic/bovine/grammar.el3
-rw-r--r--lisp/cedet/semantic/bovine/scm.el2
-rw-r--r--lisp/cedet/semantic/complete.el8
-rw-r--r--lisp/cedet/semantic/db-ebrowse.el5
-rw-r--r--lisp/cedet/semantic/db-find.el4
-rw-r--r--lisp/cedet/semantic/db-mode.el4
-rw-r--r--lisp/cedet/semantic/db.el4
-rw-r--r--lisp/cedet/semantic/decorate/mode.el3
-rw-r--r--lisp/cedet/semantic/dep.el18
-rw-r--r--lisp/cedet/semantic/doc.el3
-rw-r--r--lisp/cedet/semantic/ede-grammar.el17
-rw-r--r--lisp/cedet/semantic/edit.el3
-rw-r--r--lisp/cedet/semantic/fw.el23
-rw-r--r--lisp/cedet/semantic/grammar.el50
-rw-r--r--lisp/cedet/semantic/idle.el9
-rw-r--r--lisp/cedet/semantic/imenu.el11
-rw-r--r--lisp/cedet/semantic/java.el5
-rw-r--r--lisp/cedet/semantic/lex-spp.el4
-rw-r--r--lisp/cedet/semantic/lex.el238
-rw-r--r--lisp/cedet/semantic/symref/list.el10
-rw-r--r--lisp/cedet/semantic/tag-file.el13
-rw-r--r--lisp/cedet/semantic/tag-ls.el16
-rw-r--r--lisp/cedet/semantic/tag.el20
-rw-r--r--lisp/cedet/semantic/util.el7
-rw-r--r--lisp/cedet/semantic/wisent.el5
-rw-r--r--lisp/cedet/semantic/wisent/comp.el4
-rw-r--r--lisp/cedet/semantic/wisent/wisent.el9
-rw-r--r--lisp/cedet/srecode/document.el14
-rw-r--r--lisp/cedet/srecode/semantic.el2
-rw-r--r--lisp/cedet/srecode/srt-mode.el2
-rw-r--r--lisp/char-fold.el13
-rw-r--r--lisp/cmuscheme.el7
-rw-r--r--lisp/comint.el67
-rw-r--r--lisp/completion.el127
-rw-r--r--lisp/composite.el2
-rw-r--r--lisp/cus-dep.el42
-rw-r--r--lisp/cus-edit.el97
-rw-r--r--lisp/cus-face.el16
-rw-r--r--lisp/cus-start.el19
-rw-r--r--lisp/cus-theme.el17
-rw-r--r--lisp/custom.el38
-rw-r--r--lisp/descr-text.el39
-rw-r--r--lisp/desktop.el4
-rw-r--r--lisp/dframe.el1
-rw-r--r--lisp/dired-aux.el354
-rw-r--r--lisp/dired-x.el104
-rw-r--r--lisp/dired.el501
-rw-r--r--lisp/dirtrack.el3
-rw-r--r--lisp/disp-table.el2
-rw-r--r--lisp/display-fill-column-indicator.el17
-rw-r--r--lisp/dnd.el50
-rw-r--r--lisp/doc-view.el103
-rw-r--r--lisp/dom.el50
-rw-r--r--lisp/dos-vars.el6
-rw-r--r--lisp/double.el2
-rw-r--r--lisp/ebuff-menu.el1
-rw-r--r--lisp/ehelp.el4
-rw-r--r--lisp/elide-head.el12
-rw-r--r--lisp/emacs-lisp/advice.el14
-rw-r--r--lisp/emacs-lisp/autoload.el163
-rw-r--r--lisp/emacs-lisp/benchmark.el2
-rw-r--r--lisp/emacs-lisp/bindat.el5
-rw-r--r--lisp/emacs-lisp/byte-opt.el394
-rw-r--r--lisp/emacs-lisp/byte-run.el156
-rw-r--r--lisp/emacs-lisp/bytecomp.el284
-rw-r--r--lisp/emacs-lisp/cconv.el34
-rw-r--r--lisp/emacs-lisp/chart.el4
-rw-r--r--lisp/emacs-lisp/check-declare.el5
-rw-r--r--lisp/emacs-lisp/checkdoc.el21
-rw-r--r--lisp/emacs-lisp/cl-extra.el8
-rw-r--r--lisp/emacs-lisp/cl-generic.el16
-rw-r--r--lisp/emacs-lisp/cl-indent.el36
-rw-r--r--lisp/emacs-lisp/cl-lib.el8
-rw-r--r--lisp/emacs-lisp/cl-macs.el213
-rw-r--r--lisp/emacs-lisp/crm.el6
-rw-r--r--lisp/emacs-lisp/debug.el7
-rw-r--r--lisp/emacs-lisp/derived.el1
-rw-r--r--lisp/emacs-lisp/disass.el5
-rw-r--r--lisp/emacs-lisp/easy-mmode.el19
-rw-r--r--lisp/emacs-lisp/easymenu.el10
-rw-r--r--lisp/emacs-lisp/edebug.el165
-rw-r--r--lisp/emacs-lisp/eieio-base.el259
-rw-r--r--lisp/emacs-lisp/eieio-core.el4
-rw-r--r--lisp/emacs-lisp/eieio-opt.el9
-rw-r--r--lisp/emacs-lisp/eieio-speedbar.el6
-rw-r--r--lisp/emacs-lisp/eieio.el42
-rw-r--r--lisp/emacs-lisp/eldoc.el678
-rw-r--r--lisp/emacs-lisp/elp.el6
-rw-r--r--lisp/emacs-lisp/ert-x.el12
-rw-r--r--lisp/emacs-lisp/ert.el17
-rw-r--r--lisp/emacs-lisp/ewoc.el48
-rw-r--r--lisp/emacs-lisp/find-func.el30
-rw-r--r--lisp/emacs-lisp/float-sup.el2
-rw-r--r--lisp/emacs-lisp/generator.el10
-rw-r--r--lisp/emacs-lisp/generic.el4
-rw-r--r--lisp/emacs-lisp/gv.el47
-rw-r--r--lisp/emacs-lisp/hierarchy.el579
-rw-r--r--lisp/emacs-lisp/lisp-mnt.el13
-rw-r--r--lisp/emacs-lisp/lisp-mode.el38
-rw-r--r--lisp/emacs-lisp/lisp.el180
-rw-r--r--lisp/emacs-lisp/map.el17
-rw-r--r--lisp/emacs-lisp/nadvice.el8
-rw-r--r--lisp/emacs-lisp/package.el344
-rw-r--r--lisp/emacs-lisp/pcase.el56
-rw-r--r--lisp/emacs-lisp/re-builder.el4
-rw-r--r--lisp/emacs-lisp/rx.el2
-rw-r--r--lisp/emacs-lisp/seq.el4
-rw-r--r--lisp/emacs-lisp/shadow.el3
-rw-r--r--lisp/emacs-lisp/smie.el21
-rw-r--r--lisp/emacs-lisp/subr-x.el10
-rw-r--r--lisp/emacs-lisp/syntax.el97
-rw-r--r--lisp/emacs-lisp/tabulated-list.el8
-rw-r--r--lisp/emacs-lisp/text-property-search.el18
-rw-r--r--lisp/emacs-lisp/timer-list.el121
-rw-r--r--lisp/emacs-lisp/timer.el3
-rw-r--r--lisp/emacs-lisp/trace.el17
-rw-r--r--lisp/emacs-lisp/warnings.el45
-rw-r--r--lisp/emacs-lock.el11
-rw-r--r--lisp/emulation/cua-base.el9
-rw-r--r--lisp/emulation/cua-rect.el8
-rw-r--r--lisp/emulation/edt-mapper.el3
-rw-r--r--lisp/emulation/edt.el4
-rw-r--r--lisp/emulation/viper-cmd.el60
-rw-r--r--lisp/emulation/viper-init.el2
-rw-r--r--lisp/emulation/viper-keym.el2
-rw-r--r--lisp/emulation/viper-mous.el52
-rw-r--r--lisp/emulation/viper-util.el21
-rw-r--r--lisp/emulation/viper.el36
-rw-r--r--lisp/epa-dired.el45
-rw-r--r--lisp/epa-file.el85
-rw-r--r--lisp/epa-hook.el12
-rw-r--r--lisp/epa-mail.el27
-rw-r--r--lisp/epa.el272
-rw-r--r--lisp/epg-config.el21
-rw-r--r--lisp/epg.el97
-rw-r--r--lisp/erc/erc-autoaway.el4
-rw-r--r--lisp/erc/erc-backend.el85
-rw-r--r--lisp/erc/erc-button.el4
-rw-r--r--lisp/erc/erc-capab.el16
-rw-r--r--lisp/erc/erc-dcc.el36
-rw-r--r--lisp/erc/erc-desktop-notifications.el11
-rw-r--r--lisp/erc/erc-ezbounce.el2
-rw-r--r--lisp/erc/erc-fill.el2
-rw-r--r--lisp/erc/erc-goodies.el30
-rw-r--r--lisp/erc/erc-join.el26
-rw-r--r--lisp/erc/erc-list.el28
-rw-r--r--lisp/erc/erc-log.el4
-rw-r--r--lisp/erc/erc-match.el92
-rw-r--r--lisp/erc/erc-networks.el8
-rw-r--r--lisp/erc/erc-notify.el2
-rw-r--r--lisp/erc/erc-pcomplete.el1
-rw-r--r--lisp/erc/erc-speedbar.el5
-rw-r--r--lisp/erc/erc-stamp.el1
-rw-r--r--lisp/erc/erc-status-sidebar.el309
-rw-r--r--lisp/erc/erc-track.el12
-rw-r--r--lisp/erc/erc.el260
-rw-r--r--lisp/eshell/em-cmpl.el38
-rw-r--r--lisp/eshell/em-dirs.el5
-rw-r--r--lisp/eshell/em-glob.el4
-rw-r--r--lisp/eshell/em-hist.el64
-rw-r--r--lisp/eshell/em-ls.el3
-rw-r--r--lisp/eshell/em-pred.el25
-rw-r--r--lisp/eshell/em-prompt.el16
-rw-r--r--lisp/eshell/em-rebind.el14
-rw-r--r--lisp/eshell/em-unix.el34
-rw-r--r--lisp/eshell/em-xtra.el30
-rw-r--r--lisp/eshell/esh-arg.el16
-rw-r--r--lisp/eshell/esh-io.el7
-rw-r--r--lisp/eshell/esh-mode.el210
-rw-r--r--lisp/eshell/esh-proc.el30
-rw-r--r--lisp/eshell/esh-util.el65
-rw-r--r--lisp/eshell/esh-var.el57
-rw-r--r--lisp/eshell/eshell.el31
-rw-r--r--lisp/expand.el8
-rw-r--r--lisp/facemenu.el13
-rw-r--r--lisp/faces.el55
-rw-r--r--lisp/ffap.el166
-rw-r--r--lisp/filecache.el3
-rw-r--r--lisp/fileloop.el56
-rw-r--r--lisp/files-x.el19
-rw-r--r--lisp/files.el283
-rw-r--r--lisp/filesets.el2
-rw-r--r--lisp/find-dired.el16
-rw-r--r--lisp/finder.el9
-rw-r--r--lisp/font-lock.el58
-rw-r--r--lisp/format-spec.el183
-rw-r--r--lisp/format.el8
-rw-r--r--lisp/forms.el25
-rw-r--r--lisp/frame.el53
-rw-r--r--lisp/frameset.el12
-rw-r--r--lisp/generic-x.el2
-rw-r--r--lisp/gnus/deuglify.el10
-rw-r--r--lisp/gnus/gmm-utils.el6
-rw-r--r--lisp/gnus/gnus-agent.el22
-rw-r--r--lisp/gnus/gnus-art.el103
-rw-r--r--lisp/gnus/gnus-async.el6
-rw-r--r--lisp/gnus/gnus-bookmark.el8
-rw-r--r--lisp/gnus/gnus-cache.el30
-rw-r--r--lisp/gnus/gnus-cloud.el64
-rw-r--r--lisp/gnus/gnus-dbus.el70
-rw-r--r--lisp/gnus/gnus-delay.el6
-rw-r--r--lisp/gnus/gnus-draft.el2
-rw-r--r--lisp/gnus/gnus-eform.el18
-rw-r--r--lisp/gnus/gnus-fun.el15
-rw-r--r--lisp/gnus/gnus-gravatar.el14
-rw-r--r--lisp/gnus/gnus-group.el157
-rw-r--r--lisp/gnus/gnus-icalendar.el88
-rw-r--r--lisp/gnus/gnus-int.el53
-rw-r--r--lisp/gnus/gnus-kill.el2
-rw-r--r--lisp/gnus/gnus-msg.el152
-rw-r--r--lisp/gnus/gnus-registry.el166
-rw-r--r--lisp/gnus/gnus-score.el87
-rw-r--r--lisp/gnus/gnus-sieve.el10
-rw-r--r--lisp/gnus/gnus-srvr.el6
-rw-r--r--lisp/gnus/gnus-start.el130
-rw-r--r--lisp/gnus/gnus-sum.el405
-rw-r--r--lisp/gnus/gnus-topic.el4
-rw-r--r--lisp/gnus/gnus-util.el70
-rw-r--r--lisp/gnus/gnus-uu.el6
-rw-r--r--lisp/gnus/gnus-win.el2
-rw-r--r--lisp/gnus/gnus.el80
-rw-r--r--lisp/gnus/gssapi.el11
-rw-r--r--lisp/gnus/mail-source.el36
-rw-r--r--lisp/gnus/message.el405
-rw-r--r--lisp/gnus/mm-archive.el8
-rw-r--r--lisp/gnus/mm-decode.el49
-rw-r--r--lisp/gnus/mm-util.el79
-rw-r--r--lisp/gnus/mm-uu.el14
-rw-r--r--lisp/gnus/mm-view.el24
-rw-r--r--lisp/gnus/mml-sec.el64
-rw-r--r--lisp/gnus/mml-smime.el12
-rw-r--r--lisp/gnus/mml.el41
-rw-r--r--lisp/gnus/mml1991.el1
-rw-r--r--lisp/gnus/mml2015.el10
-rw-r--r--lisp/gnus/nnbabyl.el4
-rw-r--r--lisp/gnus/nndiary.el16
-rw-r--r--lisp/gnus/nndoc.el3
-rw-r--r--lisp/gnus/nndraft.el4
-rw-r--r--lisp/gnus/nneething.el2
-rw-r--r--lisp/gnus/nnfolder.el8
-rw-r--r--lisp/gnus/nnheader.el353
-rw-r--r--lisp/gnus/nnimap.el20
-rw-r--r--lisp/gnus/nnir.el908
-rw-r--r--lisp/gnus/nnmail.el24
-rw-r--r--lisp/gnus/nnmaildir.el38
-rw-r--r--lisp/gnus/nnmairix.el6
-rw-r--r--lisp/gnus/nnmbox.el4
-rw-r--r--lisp/gnus/nnmh.el2
-rw-r--r--lisp/gnus/nnml.el19
-rw-r--r--lisp/gnus/nnrss.el4
-rw-r--r--lisp/gnus/nnselect.el949
-rw-r--r--lisp/gnus/nnspool.el2
-rw-r--r--lisp/gnus/nntp.el18
-rw-r--r--lisp/gnus/nnvirtual.el2
-rw-r--r--lisp/gnus/smiley.el13
-rw-r--r--lisp/gnus/smime.el8
-rw-r--r--lisp/gnus/spam-stat.el2
-rw-r--r--lisp/gnus/spam.el2
-rw-r--r--lisp/help-at-pt.el9
-rw-r--r--lisp/help-fns.el286
-rw-r--r--lisp/help-mode.el15
-rw-r--r--lisp/help.el121
-rw-r--r--lisp/hexl.el23
-rw-r--r--lisp/hi-lock.el187
-rw-r--r--lisp/hilit-chg.el16
-rw-r--r--lisp/hippie-exp.el2
-rw-r--r--lisp/htmlfontify.el122
-rw-r--r--lisp/ibuf-ext.el32
-rw-r--r--lisp/ibuffer.el2
-rw-r--r--lisp/icomplete.el100
-rw-r--r--lisp/ido.el305
-rw-r--r--lisp/ielm.el37
-rw-r--r--lisp/image-dired.el11
-rw-r--r--lisp/image-file.el12
-rw-r--r--lisp/image-mode.el166
-rw-r--r--lisp/image.el10
-rw-r--r--lisp/image/gravatar.el170
-rw-r--r--lisp/image/image-converter.el38
-rw-r--r--lisp/imenu.el33
-rw-r--r--lisp/info-look.el13
-rw-r--r--lisp/info.el86
-rw-r--r--lisp/informat.el2
-rw-r--r--lisp/international/ccl.el8
-rw-r--r--lisp/international/ja-dic-cnv.el13
-rw-r--r--lisp/international/kinsoku.el2
-rw-r--r--lisp/international/mule-cmds.el148
-rw-r--r--lisp/international/mule-conf.el7
-rw-r--r--lisp/international/mule-diag.el4
-rw-r--r--lisp/international/mule-util.el9
-rw-r--r--lisp/international/mule.el180
-rw-r--r--lisp/international/ogonek.el8
-rw-r--r--lisp/international/rfc1843.el2
-rw-r--r--lisp/international/titdic-cnv.el240
-rw-r--r--lisp/international/ucs-normalize.el18
-rw-r--r--lisp/isearch.el102
-rw-r--r--lisp/jit-lock.el41
-rw-r--r--lisp/json.el577
-rw-r--r--lisp/jsonrpc.el119
-rw-r--r--lisp/kermit.el2
-rw-r--r--lisp/kmacro.el2
-rw-r--r--lisp/language/burmese.el1
-rw-r--r--lisp/language/chinese.el5
-rw-r--r--lisp/language/cyril-util.el2
-rw-r--r--lisp/language/cyrillic.el7
-rw-r--r--lisp/language/hanja-util.el4
-rw-r--r--lisp/language/hebrew.el2
-rw-r--r--lisp/language/ind-util.el40
-rw-r--r--lisp/language/indian.el2
-rw-r--r--lisp/language/japanese.el10
-rw-r--r--lisp/language/korea-util.el4
-rw-r--r--lisp/language/korean.el12
-rw-r--r--lisp/language/lao-util.el16
-rw-r--r--lisp/language/misc-lang.el8
-rw-r--r--lisp/language/tibet-util.el16
-rw-r--r--lisp/language/tibetan.el8
-rw-r--r--lisp/ldefs-boot.el3885
-rw-r--r--lisp/leim/quail/indian.el89
-rw-r--r--lisp/leim/quail/ipa.el2
-rw-r--r--lisp/leim/quail/latin-ltx.el11
-rw-r--r--lisp/linum.el3
-rw-r--r--lisp/loadup.el2
-rw-r--r--lisp/locate.el4
-rw-r--r--lisp/ls-lisp.el6
-rw-r--r--lisp/mail/binhex.el10
-rw-r--r--lisp/mail/emacsbug.el231
-rw-r--r--lisp/mail/feedmail.el2
-rw-r--r--lisp/mail/flow-fill.el37
-rw-r--r--lisp/mail/mail-extr.el4
-rw-r--r--lisp/mail/mailabbrev.el5
-rw-r--r--lisp/mail/mailalias.el8
-rw-r--r--lisp/mail/mailclient.el2
-rw-r--r--lisp/mail/mspools.el108
-rw-r--r--lisp/mail/qp.el6
-rw-r--r--lisp/mail/rfc2045.el2
-rw-r--r--lisp/mail/rfc2047.el6
-rw-r--r--lisp/mail/rfc2368.el2
-rw-r--r--lisp/mail/rmail-spam-filter.el14
-rw-r--r--lisp/mail/rmail.el101
-rw-r--r--lisp/mail/rmailedit.el4
-rw-r--r--lisp/mail/sendmail.el4
-rw-r--r--lisp/mail/smtpmail.el18
-rw-r--r--lisp/mail/uudecode.el14
-rw-r--r--lisp/man.el42
-rw-r--r--lisp/master.el12
-rw-r--r--lisp/menu-bar.el133
-rw-r--r--lisp/mh-e/mh-comp.el3
-rw-r--r--lisp/mh-e/mh-e.el110
-rw-r--r--lisp/mh-e/mh-limit.el4
-rw-r--r--lisp/mh-e/mh-speed.el2
-rw-r--r--lisp/mh-e/mh-thread.el2
-rw-r--r--lisp/minibuf-eldef.el22
-rw-r--r--lisp/minibuffer.el211
-rw-r--r--lisp/misc.el12
-rw-r--r--lisp/misearch.el6
-rw-r--r--lisp/mouse.el582
-rw-r--r--lisp/mpc.el4
-rw-r--r--lisp/msb.el2
-rw-r--r--lisp/mwheel.el125
-rw-r--r--lisp/net/ange-ftp.el8
-rw-r--r--lisp/net/browse-url.el410
-rw-r--r--lisp/net/dbus.el1325
-rw-r--r--lisp/net/dig.el11
-rw-r--r--lisp/net/dns.el284
-rw-r--r--lisp/net/eudc-bob.el136
-rw-r--r--lisp/net/eudcb-macos-contacts.el123
-rw-r--r--lisp/net/eww.el350
-rw-r--r--lisp/net/gnutls.el15
-rw-r--r--lisp/net/goto-addr.el10
-rw-r--r--lisp/net/hmac-md5.el40
-rw-r--r--lisp/net/imap.el62
-rw-r--r--lisp/net/ldap.el2
-rw-r--r--lisp/net/mailcap.el79
-rw-r--r--lisp/net/net-utils.el2
-rw-r--r--lisp/net/network-stream.el89
-rw-r--r--lisp/net/newst-backend.el12
-rw-r--r--lisp/net/newst-treeview.el30
-rw-r--r--lisp/net/newsticker.el2
-rw-r--r--lisp/net/nsm.el13
-rw-r--r--lisp/net/ntlm.el44
-rw-r--r--lisp/net/puny.el12
-rw-r--r--lisp/net/rcirc.el28
-rw-r--r--lisp/net/sasl-scram-sha256.el59
-rw-r--r--lisp/net/sasl.el5
-rw-r--r--lisp/net/secrets.el2
-rw-r--r--lisp/net/shr.el262
-rw-r--r--lisp/net/soap-client.el152
-rw-r--r--lisp/net/telnet.el2
-rw-r--r--lisp/net/tramp-adb.el693
-rw-r--r--lisp/net/tramp-archive.el25
-rw-r--r--lisp/net/tramp-cache.el252
-rw-r--r--lisp/net/tramp-cmds.el68
-rw-r--r--lisp/net/tramp-compat.el126
-rw-r--r--lisp/net/tramp-crypt.el838
-rw-r--r--lisp/net/tramp-ftp.el7
-rw-r--r--lisp/net/tramp-gvfs.el832
-rw-r--r--lisp/net/tramp-rclone.el24
-rw-r--r--lisp/net/tramp-sh.el1122
-rw-r--r--lisp/net/tramp-smb.el190
-rw-r--r--lisp/net/tramp-sudoedit.el108
-rw-r--r--lisp/net/tramp-uu.el5
-rw-r--r--lisp/net/tramp.el760
-rw-r--r--lisp/net/trampver.el14
-rw-r--r--lisp/net/webjump.el5
-rw-r--r--lisp/obsolete/complete.el2
-rw-r--r--lisp/obsolete/cust-print.el5
-rw-r--r--lisp/obsolete/erc-compat.el (renamed from lisp/erc/erc-compat.el)21
-rw-r--r--lisp/obsolete/erc-hecomplete.el2
-rw-r--r--lisp/obsolete/iswitchb.el2
-rw-r--r--lisp/obsolete/ledit.el157
-rw-r--r--lisp/obsolete/levents.el292
-rw-r--r--lisp/obsolete/lmenu.el445
-rw-r--r--lisp/obsolete/longlines.el17
-rw-r--r--lisp/obsolete/lucid.el211
-rw-r--r--lisp/obsolete/metamail.el (renamed from lisp/mail/metamail.el)1
-rw-r--r--lisp/obsolete/old-whitespace.el801
-rw-r--r--lisp/obsolete/rcompile.el2
-rw-r--r--lisp/obsolete/sb-image.el46
-rw-r--r--lisp/obsolete/tls.el16
-rw-r--r--lisp/obsolete/tpu-edt.el12
-rw-r--r--lisp/obsolete/vc-arch.el11
-rw-r--r--lisp/obsolete/vi.el2
-rw-r--r--lisp/obsolete/vip.el14
-rw-r--r--lisp/org/ob-core.el5
-rw-r--r--lisp/org/ob-fortran.el2
-rw-r--r--lisp/org/ob-plantuml.el2
-rw-r--r--lisp/org/ob-ruby.el4
-rw-r--r--lisp/org/ob-sass.el2
-rw-r--r--lisp/org/ob-screen.el2
-rw-r--r--lisp/org/ob-stan.el2
-rw-r--r--lisp/org/ol-gnus.el6
-rw-r--r--lisp/org/ol.el4
-rw-r--r--lisp/org/org-agenda.el10
-rw-r--r--lisp/org/org-capture.el2
-rw-r--r--lisp/org/org-element.el2
-rw-r--r--lisp/org/org-protocol.el2
-rw-r--r--lisp/org/org-table.el10
-rw-r--r--lisp/org/org.el12
-rw-r--r--lisp/org/ox-latex.el2
-rw-r--r--lisp/org/ox-odt.el2
-rw-r--r--lisp/org/ox.el4
-rw-r--r--lisp/outline.el11
-rw-r--r--lisp/password-cache.el19
-rw-r--r--lisp/pcmpl-gnu.el2
-rw-r--r--lisp/pcmpl-linux.el12
-rw-r--r--lisp/pcmpl-unix.el47
-rw-r--r--lisp/pcmpl-x.el32
-rw-r--r--lisp/pcomplete.el44
-rw-r--r--lisp/play/5x5.el2
-rw-r--r--lisp/play/animate.el4
-rw-r--r--lisp/play/bubbles.el13
-rw-r--r--lisp/play/dissociate.el2
-rw-r--r--lisp/play/gamegrid.el9
-rw-r--r--lisp/play/gametree.el6
-rw-r--r--lisp/play/gomoku.el46
-rw-r--r--lisp/play/life.el88
-rw-r--r--lisp/play/pong.el20
-rw-r--r--lisp/play/snake.el5
-rw-r--r--lisp/play/spook.el8
-rw-r--r--lisp/play/tetris.el2
-rw-r--r--lisp/printing.el40
-rw-r--r--lisp/profiler.el4
-rw-r--r--lisp/progmodes/antlr-mode.el9
-rw-r--r--lisp/progmodes/autoconf.el2
-rw-r--r--lisp/progmodes/bat-mode.el2
-rw-r--r--lisp/progmodes/bug-reference.el303
-rw-r--r--lisp/progmodes/cc-align.el32
-rw-r--r--lisp/progmodes/cc-awk.el2
-rw-r--r--lisp/progmodes/cc-cmds.el129
-rw-r--r--lisp/progmodes/cc-defs.el72
-rw-r--r--lisp/progmodes/cc-engine.el163
-rw-r--r--lisp/progmodes/cc-fonts.el141
-rw-r--r--lisp/progmodes/cc-langs.el54
-rw-r--r--lisp/progmodes/cc-mode.el397
-rw-r--r--lisp/progmodes/cc-styles.el6
-rw-r--r--lisp/progmodes/cc-vars.el16
-rw-r--r--lisp/progmodes/cfengine.el16
-rw-r--r--lisp/progmodes/cl-font-lock.el290
-rw-r--r--lisp/progmodes/compile.el98
-rw-r--r--lisp/progmodes/cperl-mode.el416
-rw-r--r--lisp/progmodes/cwarn.el4
-rw-r--r--lisp/progmodes/ebnf-abn.el13
-rw-r--r--lisp/progmodes/ebnf-bnf.el6
-rw-r--r--lisp/progmodes/ebnf-dtd.el19
-rw-r--r--lisp/progmodes/ebnf-ebx.el20
-rw-r--r--lisp/progmodes/ebnf-iso.el6
-rw-r--r--lisp/progmodes/ebnf-yac.el6
-rw-r--r--lisp/progmodes/ebnf2ps.el58
-rw-r--r--lisp/progmodes/ebrowse.el458
-rw-r--r--lisp/progmodes/elisp-mode.el144
-rw-r--r--lisp/progmodes/etags.el10
-rw-r--r--lisp/progmodes/flymake-cc.el8
-rw-r--r--lisp/progmodes/flymake-proc.el2
-rw-r--r--lisp/progmodes/flymake.el25
-rw-r--r--lisp/progmodes/fortran.el2
-rw-r--r--lisp/progmodes/gdb-mi.el456
-rw-r--r--lisp/progmodes/glasses.el11
-rw-r--r--lisp/progmodes/grep.el128
-rw-r--r--lisp/progmodes/gud.el43
-rw-r--r--lisp/progmodes/hideif.el10
-rw-r--r--lisp/progmodes/idlw-complete-structtag.el2
-rw-r--r--lisp/progmodes/idlw-help.el9
-rw-r--r--lisp/progmodes/idlw-shell.el19
-rw-r--r--lisp/progmodes/idlw-toolbar.el2
-rw-r--r--lisp/progmodes/idlwave.el240
-rw-r--r--lisp/progmodes/inf-lisp.el12
-rw-r--r--lisp/progmodes/js.el5
-rw-r--r--lisp/progmodes/make-mode.el4
-rw-r--r--lisp/progmodes/meta-mode.el2
-rw-r--r--lisp/progmodes/octave.el25
-rw-r--r--lisp/progmodes/opascal.el2
-rw-r--r--lisp/progmodes/pascal.el57
-rw-r--r--lisp/progmodes/perl-mode.el6
-rw-r--r--lisp/progmodes/project.el825
-rw-r--r--lisp/progmodes/prolog.el108
-rw-r--r--lisp/progmodes/python.el190
-rw-r--r--lisp/progmodes/ruby-mode.el60
-rw-r--r--lisp/progmodes/scheme.el2
-rw-r--r--lisp/progmodes/sh-script.el1462
-rw-r--r--lisp/progmodes/sql.el231
-rw-r--r--lisp/progmodes/subword.el2
-rw-r--r--lisp/progmodes/tcl.el5
-rw-r--r--lisp/progmodes/vera-mode.el69
-rw-r--r--lisp/progmodes/verilog-mode.el317
-rw-r--r--lisp/progmodes/vhdl-mode.el6
-rw-r--r--lisp/progmodes/which-func.el97
-rw-r--r--lisp/progmodes/xref.el113
-rw-r--r--lisp/progmodes/xscheme.el2
-rw-r--r--lisp/ps-def.el22
-rw-r--r--lisp/ps-print.el16
-rw-r--r--lisp/ps-samp.el2
-rw-r--r--lisp/recentf.el15
-rw-r--r--lisp/rect.el9
-rw-r--r--lisp/registry.el2
-rw-r--r--lisp/repeat.el6
-rw-r--r--lisp/replace.el119
-rw-r--r--lisp/reveal.el22
-rw-r--r--lisp/ruler-mode.el2
-rw-r--r--lisp/savehist.el4
-rw-r--r--lisp/saveplace.el16
-rw-r--r--lisp/sb-image.el107
-rw-r--r--lisp/scroll-lock.el2
-rw-r--r--lisp/server.el31
-rw-r--r--lisp/ses.el16
-rw-r--r--lisp/shell.el79
-rw-r--r--lisp/simple.el525
-rw-r--r--lisp/skeleton.el101
-rw-r--r--lisp/so-long.el10
-rw-r--r--lisp/speedbar.el115
-rw-r--r--lisp/startup.el12
-rw-r--r--lisp/strokes.el6
-rw-r--r--lisp/subr.el156
-rw-r--r--lisp/svg.el2
-rw-r--r--lisp/t-mouse.el4
-rw-r--r--lisp/tab-bar.el119
-rw-r--r--lisp/tab-line.el48
-rw-r--r--lisp/talk.el2
-rw-r--r--lisp/tar-mode.el72
-rw-r--r--lisp/tempo.el47
-rw-r--r--lisp/term.el109
-rw-r--r--lisp/term/bobcat.el1
-rw-r--r--lisp/term/cygwin.el2
-rw-r--r--lisp/term/internal.el6
-rw-r--r--lisp/term/konsole.el2
-rw-r--r--lisp/term/linux.el2
-rw-r--r--lisp/term/ns-win.el32
-rw-r--r--lisp/term/rxvt.el21
-rw-r--r--lisp/term/st.el20
-rw-r--r--lisp/term/tty-colors.el58
-rw-r--r--lisp/term/vt100.el2
-rw-r--r--lisp/term/vt200.el2
-rw-r--r--lisp/term/w32-win.el6
-rw-r--r--lisp/term/x-win.el10
-rw-r--r--lisp/textmodes/artist.el29
-rw-r--r--lisp/textmodes/bibtex.el121
-rw-r--r--lisp/textmodes/conf-mode.el191
-rw-r--r--lisp/textmodes/css-mode.el81
-rw-r--r--lisp/textmodes/flyspell.el138
-rw-r--r--lisp/textmodes/ispell.el124
-rw-r--r--lisp/textmodes/mhtml-mode.el85
-rw-r--r--lisp/textmodes/nroff-mode.el1
-rw-r--r--lisp/textmodes/paragraphs.el65
-rw-r--r--lisp/textmodes/po.el2
-rw-r--r--lisp/textmodes/refer.el6
-rw-r--r--lisp/textmodes/reftex-ref.el4
-rw-r--r--lisp/textmodes/reftex-vars.el4
-rw-r--r--lisp/textmodes/reftex.el2
-rw-r--r--lisp/textmodes/remember.el6
-rw-r--r--lisp/textmodes/rst.el18
-rw-r--r--lisp/textmodes/sgml-mode.el37
-rw-r--r--lisp/textmodes/table.el55
-rw-r--r--lisp/textmodes/tex-mode.el73
-rw-r--r--lisp/textmodes/texinfo.el84
-rw-r--r--lisp/textmodes/tildify.el4
-rw-r--r--lisp/thingatpt.el6
-rw-r--r--lisp/thread.el2
-rw-r--r--lisp/thumbs.el2
-rw-r--r--lisp/time.el331
-rw-r--r--lisp/tooltip.el2
-rw-r--r--lisp/uniquify.el21
-rw-r--r--lisp/url/url-about.el2
-rw-r--r--lisp/url/url-auth.el2
-rw-r--r--lisp/url/url-cache.el4
-rw-r--r--lisp/url/url-expand.el13
-rw-r--r--lisp/url/url-gw.el2
-rw-r--r--lisp/url/url-handlers.el3
-rw-r--r--lisp/url/url-http.el35
-rw-r--r--lisp/url/url-irc.el2
-rw-r--r--lisp/url/url-news.el2
-rw-r--r--lisp/url/url-queue.el29
-rw-r--r--lisp/url/url-util.el29
-rw-r--r--lisp/url/url-vars.el10
-rw-r--r--lisp/url/url.el21
-rw-r--r--lisp/vc/add-log.el2
-rw-r--r--lisp/vc/diff-mode.el29
-rw-r--r--lisp/vc/diff.el2
-rw-r--r--lisp/vc/ediff-diff.el4
-rw-r--r--lisp/vc/ediff-init.el56
-rw-r--r--lisp/vc/ediff-mult.el17
-rw-r--r--lisp/vc/ediff-ptch.el2
-rw-r--r--lisp/vc/ediff-util.el70
-rw-r--r--lisp/vc/ediff-vers.el25
-rw-r--r--lisp/vc/ediff-wind.el21
-rw-r--r--lisp/vc/ediff.el101
-rw-r--r--lisp/vc/emerge.el5
-rw-r--r--lisp/vc/log-edit.el15
-rw-r--r--lisp/vc/pcvs-parse.el2
-rw-r--r--lisp/vc/smerge-mode.el15
-rw-r--r--lisp/vc/vc-annotate.el4
-rw-r--r--lisp/vc/vc-bzr.el9
-rw-r--r--lisp/vc/vc-cvs.el35
-rw-r--r--lisp/vc/vc-dir.el94
-rw-r--r--lisp/vc/vc-dispatcher.el6
-rw-r--r--lisp/vc/vc-git.el72
-rw-r--r--lisp/vc/vc-hg.el71
-rw-r--r--lisp/vc/vc-hooks.el16
-rw-r--r--lisp/vc/vc-mtn.el1
-rw-r--r--lisp/vc/vc-rcs.el2
-rw-r--r--lisp/vc/vc-src.el67
-rw-r--r--lisp/vc/vc-svn.el9
-rw-r--r--lisp/vc/vc.el109
-rw-r--r--lisp/vcursor.el3
-rw-r--r--lisp/version.el4
-rw-r--r--lisp/vt-control.el2
-rw-r--r--lisp/vt100-led.el2
-rw-r--r--lisp/w32-fns.el10
-rw-r--r--lisp/w32-vars.el14
-rw-r--r--lisp/wdired.el39
-rw-r--r--lisp/whitespace.el57
-rw-r--r--lisp/wid-browse.el2
-rw-r--r--lisp/wid-edit.el353
-rw-r--r--lisp/windmove.el83
-rw-r--r--lisp/window.el247
-rw-r--r--lisp/woman.el26
-rw-r--r--lisp/x-dnd.el61
-rw-r--r--lisp/xml.el23
-rw-r--r--lisp/xt-mouse.el5
-rw-r--r--lisp/xwidget.el278
-rw-r--r--m4/00gnulib.m4105
-rw-r--r--m4/absolute-header.m410
-rw-r--r--m4/acl.m44
-rw-r--r--m4/alloca.m442
-rw-r--r--m4/canonicalize.m414
-rw-r--r--m4/count-leading-zeros.m412
-rw-r--r--m4/count-one-bits.m412
-rw-r--r--m4/count-trailing-zeros.m412
-rw-r--r--m4/d-type.m43
-rw-r--r--m4/dup2.m4185
-rw-r--r--m4/explicit_bzero.m41
-rw-r--r--m4/fchmodat.m482
-rw-r--r--m4/fcntl.m43
-rw-r--r--m4/fdopendir.m420
-rw-r--r--m4/filemode.m43
-rw-r--r--m4/fpending.m44
-rw-r--r--m4/fsusage.m43
-rw-r--r--m4/futimens.m466
-rw-r--r--m4/getdtablesize.m419
-rw-r--r--m4/getgroups.m48
-rw-r--r--m4/getloadavg.m412
-rw-r--r--m4/getrandom.m468
-rw-r--r--m4/gettime.m43
-rw-r--r--m4/gettimeofday.m464
-rw-r--r--m4/glibc21.m44
-rw-r--r--m4/gnulib-common.m4361
-rw-r--r--m4/gnulib-comp.m4176
-rw-r--r--m4/group-member.m43
-rw-r--r--m4/include_next.m434
-rw-r--r--m4/inttypes.m424
-rw-r--r--m4/largefile.m429
-rw-r--r--m4/lchmod.m430
-rw-r--r--m4/libgmp.m471
-rw-r--r--m4/localtime-buffer.m421
-rw-r--r--m4/longlong.m4113
-rw-r--r--m4/malloca.m47
-rw-r--r--m4/manywarnings.m4192
-rw-r--r--m4/memmem.m44
-rw-r--r--m4/mempcpy.m44
-rw-r--r--m4/memrchr.m44
-rw-r--r--m4/mktime.m445
-rw-r--r--m4/multiarch.m467
-rw-r--r--m4/nstrftime.m49
-rw-r--r--m4/open-slash.m43
-rw-r--r--m4/pathmax.m44
-rw-r--r--m4/pselect.m45
-rw-r--r--m4/pthread_sigmask.m43
-rw-r--r--m4/putenv.m460
-rw-r--r--m4/regex.m492
-rw-r--r--m4/sig2str.m43
-rw-r--r--m4/sigdescr_np.m417
-rw-r--r--m4/signal_h.m44
-rw-r--r--m4/ssize_t.m43
-rw-r--r--m4/st_dm_mode.m43
-rw-r--r--m4/stat-time.m44
-rw-r--r--m4/std-gnu11.m44
-rw-r--r--m4/stddef_h.m44
-rw-r--r--m4/stdint.m441
-rw-r--r--m4/stdio_h.m44
-rw-r--r--m4/stdlib_h.m44
-rw-r--r--m4/string_h.m493
-rw-r--r--m4/strnlen.m44
-rw-r--r--m4/strtoimax.m46
-rw-r--r--m4/strtoll.m416
-rw-r--r--m4/sys_random_h.m453
-rw-r--r--m4/sys_socket_h.m44
-rw-r--r--m4/sys_stat_h.m413
-rw-r--r--m4/time_h.m410
-rw-r--r--m4/time_rz.m414
-rw-r--r--m4/timespec.m43
-rw-r--r--m4/unistd_h.m411
-rw-r--r--m4/utimens.m45
-rw-r--r--m4/utimensat.m470
-rw-r--r--m4/utimes.m43
-rw-r--r--m4/warnings.m421
-rw-r--r--m4/zzgnulib.m423
-rw-r--r--msdos/sed2v2.inp2
-rw-r--r--nextstep/templates/Info.plist.in12
-rw-r--r--nt/README.W322
-rw-r--r--nt/gnulib-cfg.mk4
-rw-r--r--nt/inc/ms-w32.h46
-rw-r--r--nt/inc/sys/stat.h5
-rw-r--r--nt/mingw-cfg.site11
-rw-r--r--src/.gdbinit6
-rw-r--r--src/Makefile.in12
-rw-r--r--src/alloc.c1069
-rw-r--r--src/bidi.c20
-rw-r--r--src/bignum.c36
-rw-r--r--src/bignum.h12
-rw-r--r--src/buffer.c153
-rw-r--r--src/buffer.h154
-rw-r--r--src/bytecode.c50
-rw-r--r--src/callint.c4
-rw-r--r--src/callproc.c18
-rw-r--r--src/casefiddle.c32
-rw-r--r--src/ccl.c128
-rw-r--r--src/character.c164
-rw-r--r--src/character.h838
-rw-r--r--src/charset.c46
-rw-r--r--src/chartab.c10
-rw-r--r--src/cmds.c19
-rw-r--r--src/coding.c223
-rw-r--r--src/coding.h4
-rw-r--r--src/composite.c79
-rw-r--r--src/composite.h9
-rw-r--r--src/conf_post.h109
-rw-r--r--src/data.c196
-rw-r--r--src/dbusbind.c339
-rw-r--r--src/deps.mk3
-rw-r--r--src/dired.c4
-rw-r--r--src/dispextern.h67
-rw-r--r--src/dispnew.c9
-rw-r--r--src/editfns.c282
-rw-r--r--src/emacs-module.c270
-rw-r--r--src/emacs-module.h.in52
-rw-r--r--src/emacs.c90
-rw-r--r--src/eval.c80
-rw-r--r--src/fileio.c169
-rw-r--r--src/filelock.c33
-rw-r--r--src/fns.c497
-rw-r--r--src/font.c148
-rw-r--r--src/font.h6
-rw-r--r--src/fontset.c27
-rw-r--r--src/frame.c136
-rw-r--r--src/frame.h48
-rw-r--r--src/fringe.c21
-rw-r--r--src/ftcrfont.c5
-rw-r--r--src/ftfont.c23
-rw-r--r--src/ftxfont.c371
-rw-r--r--src/gmalloc.c16
-rw-r--r--src/gnutls.c20
-rw-r--r--src/gtkutil.c18
-rw-r--r--src/hbfont.c11
-rw-r--r--src/image.c528
-rw-r--r--src/indent.c64
-rw-r--r--src/insdel.c7
-rw-r--r--src/intervals.c15
-rw-r--r--src/intervals.h24
-rw-r--r--src/json.c5
-rw-r--r--src/keyboard.c161
-rw-r--r--src/keymap.c173
-rw-r--r--src/lcms.c7
-rw-r--r--src/lisp.h300
-rw-r--r--src/lread.c239
-rw-r--r--src/macfont.m97
-rw-r--r--src/marker.c10
-rw-r--r--src/menu.c26
-rw-r--r--src/mini-gmp-emacs.c32
-rw-r--r--src/minibuf.c14
-rw-r--r--src/module-env-25.h67
-rw-r--r--src/module-env-27.h2
-rw-r--r--src/module-env-28.h18
-rw-r--r--src/msdos.c4
-rw-r--r--src/nsfns.m272
-rw-r--r--src/nsfont.m249
-rw-r--r--src/nsimage.m80
-rw-r--r--src/nsmenu.m10
-rw-r--r--src/nsselect.m2
-rw-r--r--src/nsterm.h93
-rw-r--r--src/nsterm.m1763
-rw-r--r--src/nsxwidget.h80
-rw-r--r--src/nsxwidget.m601
-rw-r--r--src/pdumper.c380
-rw-r--r--src/pdumper.h1
-rw-r--r--src/print.c138
-rw-r--r--src/process.c199
-rw-r--r--src/process.h2
-rw-r--r--src/ptr-bounds.h79
-rw-r--r--src/regex-emacs.c115
-rw-r--r--src/search.c86
-rw-r--r--src/syntax.c150
-rw-r--r--src/sysdep.c303
-rw-r--r--src/systhread.c8
-rw-r--r--src/systhread.h12
-rw-r--r--src/systime.h3
-rw-r--r--src/term.c54
-rw-r--r--src/termchar.h2
-rw-r--r--src/textprop.c27
-rw-r--r--src/thread.c20
-rw-r--r--src/timefns.c127
-rw-r--r--src/w32.c194
-rw-r--r--src/w32.h4
-rw-r--r--src/w32fns.c258
-rw-r--r--src/w32gui.h6
-rw-r--r--src/w32heap.c12
-rw-r--r--src/w32image.c477
-rw-r--r--src/w32menu.c2
-rw-r--r--src/w32proc.c2
-rw-r--r--src/w32term.c139
-rw-r--r--src/w32term.h8
-rw-r--r--src/window.c79
-rw-r--r--src/window.h1
-rw-r--r--src/xdisp.c893
-rw-r--r--src/xfaces.c224
-rw-r--r--src/xfns.c47
-rw-r--r--src/xfont.c2
-rw-r--r--src/xgselect.c42
-rw-r--r--src/xgselect.h2
-rw-r--r--src/xmenu.c2
-rw-r--r--src/xrdb.c2
-rw-r--r--src/xselect.c21
-rw-r--r--src/xterm.c209
-rw-r--r--src/xterm.h3
-rw-r--r--src/xwidget.c263
-rw-r--r--src/xwidget.h48
-rw-r--r--test/ChangeLog.12
-rw-r--r--test/Makefile.in14
-rw-r--r--test/README5
-rw-r--r--test/data/emacs-module/mod-test.c175
-rw-r--r--test/data/mml-sec/.gpg-v21-migrated0
-rw-r--r--test/data/mml-sec/gpg-agent.conf5
-rw-r--r--test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.keybin0 -> 526 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.keybin0 -> 841 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.keybin0 -> 526 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.keybin0 -> 798 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.keybin0 -> 798 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.keybin0 -> 526 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.keybin0 -> 710 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.keybin0 -> 798 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.keybin0 -> 527 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.keybin0 -> 798 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.keybin0 -> 526 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.keybin0 -> 709 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.keybin0 -> 710 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.keybin0 -> 841 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.keybin0 -> 841 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.keybin0 -> 527 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.keybin0 -> 710 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.keybin0 -> 710 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.keybin0 -> 841 bytes
-rw-r--r--test/data/mml-sec/pubring.gpgbin0 -> 13883 bytes
-rw-r--r--test/data/mml-sec/pubring.kbxbin0 -> 3076 bytes
-rw-r--r--test/data/mml-sec/secring.gpgbin0 -> 17362 bytes
-rw-r--r--test/data/mml-sec/trustdb.gpgbin0 -> 1880 bytes
-rw-r--r--test/data/mml-sec/trustlist.txt26
-rw-r--r--test/data/syntax-comments.txt66
-rw-r--r--test/data/themes/faces-test-dark-theme.el8
-rw-r--r--test/data/themes/faces-test-light-theme.el8
-rw-r--r--test/lib-src/emacsclient-tests.el2
-rw-r--r--test/lisp/allout-tests.el148
-rw-r--r--test/lisp/allout-widgets-tests.el87
-rw-r--r--test/lisp/apropos-tests.el133
-rw-r--r--test/lisp/arc-mode-tests.el4
-rw-r--r--test/lisp/auth-source-pass-tests.el4
-rw-r--r--test/lisp/autoinsert-tests.el8
-rw-r--r--test/lisp/autorevert-tests.el6
-rw-r--r--test/lisp/battery-tests.el106
-rw-r--r--test/lisp/bookmark-resources/test-list.bmk20
-rw-r--r--test/lisp/bookmark-tests.el290
-rw-r--r--test/lisp/calc/calc-tests.el217
-rw-r--r--test/lisp/calendar/cal-julian-tests.el72
-rw-r--r--test/lisp/calendar/icalendar-tests.el143
-rw-r--r--test/lisp/calendar/iso8601-tests.el185
-rw-r--r--test/lisp/calendar/lunar-tests.el75
-rw-r--r--test/lisp/calendar/parse-time-tests.el2
-rw-r--r--test/lisp/calendar/time-date-tests.el38
-rw-r--r--test/lisp/calendar/todo-mode-resources/todo-test-1.todo10
-rw-r--r--test/lisp/calendar/todo-mode-tests.el99
-rw-r--r--test/lisp/cedet/semantic-utest-c.el59
-rw-r--r--test/lisp/cedet/semantic-utest-fmt.el4
-rw-r--r--test/lisp/cedet/semantic-utest-ia.el7
-rw-r--r--test/lisp/cedet/semantic-utest.el32
-rw-r--r--test/lisp/cedet/srecode-utest-getset.el4
-rw-r--r--test/lisp/cedet/srecode-utest-template.el7
-rw-r--r--test/lisp/char-fold-tests.el8
-rw-r--r--test/lisp/comint-tests.el80
-rw-r--r--test/lisp/completion-tests.el170
-rw-r--r--test/lisp/custom-resources/custom--test-theme.el2
-rw-r--r--test/lisp/custom-tests.el23
-rw-r--r--test/lisp/dabbrev-tests.el2
-rw-r--r--test/lisp/descr-text-tests.el6
-rw-r--r--test/lisp/dired-aux-tests.el47
-rw-r--r--test/lisp/dired-tests.el4
-rw-r--r--test/lisp/dom-tests.el7
-rw-r--r--test/lisp/electric-tests.el26
-rw-r--r--test/lisp/elide-head-tests.el62
-rw-r--r--test/lisp/emacs-lisp/bindat-tests.el16
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el61
-rw-r--r--test/lisp/emacs-lisp/cconv-tests.el160
-rw-r--r--test/lisp/emacs-lisp/check-declare-tests.el116
-rw-r--r--test/lisp/emacs-lisp/cl-generic-tests.el38
-rw-r--r--test/lisp/emacs-lisp/cl-lib-tests.el16
-rw-r--r--test/lisp/emacs-lisp/cl-macs-tests.el24
-rw-r--r--test/lisp/emacs-lisp/cl-seq-tests.el1
-rw-r--r--test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el2
-rw-r--r--test/lisp/emacs-lisp/edebug-tests.el94
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el58
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el2
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-tests.el5
-rw-r--r--test/lisp/emacs-lisp/ert-x-tests.el23
-rw-r--r--test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el4
-rw-r--r--test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el2
-rw-r--r--test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup2
-rw-r--r--test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el2
-rw-r--r--test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el2
-rw-r--r--test/lisp/emacs-lisp/find-func-tests.el45
-rw-r--r--test/lisp/emacs-lisp/float-sup-tests.el33
-rw-r--r--test/lisp/emacs-lisp/generator-tests.el11
-rw-r--r--test/lisp/emacs-lisp/gv-tests.el64
-rw-r--r--test/lisp/emacs-lisp/hierarchy-tests.el556
-rw-r--r--test/lisp/emacs-lisp/lisp-mode-tests.el14
-rw-r--r--test/lisp/emacs-lisp/lisp-tests.el60
-rw-r--r--test/lisp/emacs-lisp/map-tests.el6
-rw-r--r--test/lisp/emacs-lisp/nadvice-tests.el2
-rw-r--r--test/lisp/emacs-lisp/package-resources/newer-versions/new-pkg-1.0.el2
-rw-r--r--test/lisp/emacs-lisp/package-resources/newer-versions/simple-single-1.4.el2
-rw-r--r--test/lisp/emacs-lisp/package-resources/simple-depend-1.0.el2
-rw-r--r--test/lisp/emacs-lisp/package-resources/simple-single-1.3.el2
-rw-r--r--test/lisp/emacs-lisp/package-resources/simple-two-depend-1.1.el2
-rw-r--r--test/lisp/emacs-lisp/package-tests.el151
-rw-r--r--test/lisp/emacs-lisp/pcase-tests.el2
-rw-r--r--test/lisp/emacs-lisp/regexp-opt-tests.el29
-rw-r--r--test/lisp/emacs-lisp/rmc-tests.el8
-rw-r--r--test/lisp/emacs-lisp/rx-tests.el19
-rw-r--r--test/lisp/emacs-lisp/seq-tests.el10
-rw-r--r--test/lisp/emacs-lisp/shadow-resources/p1/foo.el2
-rw-r--r--test/lisp/emacs-lisp/shadow-resources/p2/FOO.el2
-rw-r--r--test/lisp/emacs-lisp/subr-x-tests.el10
-rw-r--r--test/lisp/emacs-lisp/syntax-tests.el67
-rw-r--r--test/lisp/emacs-lisp/text-property-search-tests.el10
-rw-r--r--test/lisp/emacs-lisp/unsafep-tests.el (renamed from lisp/emacs-lisp/tcover-unsafep.el)76
-rw-r--r--test/lisp/emacs-lisp/warnings-tests.el60
-rw-r--r--test/lisp/emulation/viper-tests.el2
-rw-r--r--test/lisp/erc/erc-tests.el47
-rw-r--r--test/lisp/erc/erc-track-tests.el6
-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.el11
-rw-r--r--test/lisp/faces-tests.el8
-rw-r--r--test/lisp/ffap-tests.el42
-rw-r--r--test/lisp/filenotify-tests.el64
-rw-r--r--test/lisp/files-tests.el111
-rw-r--r--test/lisp/format-spec-tests.el135
-rw-r--r--test/lisp/gnus/gnus-icalendar-tests.el259
-rw-r--r--test/lisp/gnus/gnus-tests.el2
-rw-r--r--test/lisp/gnus/gnus-util-tests.el174
-rw-r--r--test/lisp/gnus/mml-sec-tests.el888
-rw-r--r--test/lisp/help-fns-tests.el61
-rw-r--r--test/lisp/help-mode-tests.el169
-rw-r--r--test/lisp/hi-lock-tests.el164
-rw-r--r--test/lisp/ibuffer-tests.el2
-rw-r--r--test/lisp/image/gravatar-tests.el9
-rw-r--r--test/lisp/imenu-tests.el17
-rw-r--r--test/lisp/info-xref-tests.el2
-rw-r--r--test/lisp/international/ccl-tests.el16
-rw-r--r--test/lisp/international/mule-tests.el32
-rw-r--r--test/lisp/international/mule-util-tests.el4
-rw-r--r--test/lisp/international/ucs-normalize-tests.el13
-rw-r--r--test/lisp/isearch-tests.el8
-rw-r--r--test/lisp/jit-lock-tests.el2
-rw-r--r--test/lisp/json-tests.el875
-rw-r--r--test/lisp/jsonrpc-tests.el10
-rw-r--r--test/lisp/mail/flow-fill-tests.el3
-rw-r--r--test/lisp/mail/footnote-tests.el8
-rw-r--r--test/lisp/mail/qp-tests.el74
-rw-r--r--test/lisp/mail/rfc2045-tests.el37
-rw-r--r--test/lisp/mail/rfc2368-tests.el39
-rw-r--r--test/lisp/mail/rmailmm-tests.el (renamed from test/manual/rmailmm.el)60
-rw-r--r--test/lisp/man-tests.el4
-rw-r--r--test/lisp/minibuffer-tests.el8
-rw-r--r--test/lisp/misc-tests.el77
-rw-r--r--test/lisp/mwheel-tests.el46
-rw-r--r--test/lisp/net/browse-url-tests.el119
-rw-r--r--test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml49
-rw-r--r--test/lisp/net/dbus-tests.el1730
-rw-r--r--test/lisp/net/dig-tests.el56
-rw-r--r--test/lisp/net/gnutls-tests.el3
-rw-r--r--test/lisp/net/hmac-md5-tests.el80
-rw-r--r--test/lisp/net/network-stream-tests.el65
-rw-r--r--test/lisp/net/newsticker-tests.el2
-rw-r--r--test/lisp/net/puny-tests.el23
-rw-r--r--test/lisp/net/rfc2104-tests.el2
-rw-r--r--test/lisp/net/sasl-scram-rfc-tests.el26
-rw-r--r--test/lisp/net/tramp-archive-tests.el17
-rw-r--r--test/lisp/net/tramp-tests.el715
-rw-r--r--test/lisp/net/webjump-tests.el73
-rw-r--r--test/lisp/nxml/nxml-mode-tests.el21
-rw-r--r--test/lisp/obsolete/cl-tests.el3
-rw-r--r--test/lisp/org/org-tests.el2
-rw-r--r--test/lisp/password-cache-tests.el14
-rw-r--r--test/lisp/pcmpl-linux-resources/fs/ext4/.keep0
-rw-r--r--test/lisp/pcmpl-linux-resources/mtab11
-rw-r--r--test/lisp/pcmpl-linux-tests.el51
-rw-r--r--test/lisp/play/animate-tests.el56
-rw-r--r--test/lisp/play/dissociate-tests.el38
-rw-r--r--test/lisp/play/life-tests.el80
-rw-r--r--test/lisp/progmodes/autoconf-tests.el55
-rw-r--r--test/lisp/progmodes/cc-mode-tests.el33
-rw-r--r--test/lisp/progmodes/compile-tests.el14
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl52
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl44
-rw-r--r--test/lisp/progmodes/cperl-mode-tests.el206
-rw-r--r--test/lisp/progmodes/elisp-mode-tests.el18
-rw-r--r--test/lisp/progmodes/etags-tests.el2
-rw-r--r--test/lisp/progmodes/f90-tests.el3
-rw-r--r--test/lisp/progmodes/glasses-tests.el101
-rw-r--r--test/lisp/progmodes/js-tests.el2
-rw-r--r--test/lisp/progmodes/opascal-tests.el45
-rw-r--r--test/lisp/progmodes/pascal-tests.el63
-rw-r--r--test/lisp/progmodes/ps-mode-tests.el26
-rw-r--r--test/lisp/progmodes/python-tests.el11
-rw-r--r--test/lisp/progmodes/ruby-mode-resources/ruby.rb (renamed from test/manual/indent/ruby.rb)2
-rw-r--r--test/lisp/progmodes/ruby-mode-tests.el19
-rw-r--r--test/lisp/progmodes/scheme-tests.el50
-rw-r--r--test/lisp/progmodes/subword-tests.el10
-rw-r--r--test/lisp/progmodes/tcl-tests.el2
-rw-r--r--test/lisp/progmodes/xref-tests.el2
-rw-r--r--test/lisp/replace-tests.el44
-rw-r--r--test/lisp/saveplace-resources/saveplace4
-rw-r--r--test/lisp/saveplace-tests.el103
-rw-r--r--test/lisp/shadowfile-tests.el23
-rw-r--r--test/lisp/simple-tests.el59
-rw-r--r--test/lisp/sort-tests.el8
-rw-r--r--test/lisp/subr-tests.el135
-rw-r--r--test/lisp/tar-mode-tests.el3
-rw-r--r--test/lisp/tempo-tests.el39
-rw-r--r--test/lisp/textmodes/bibtex-tests.el57
-rw-r--r--test/lisp/textmodes/conf-mode-tests.el8
-rw-r--r--test/lisp/textmodes/css-mode-resources/test-indent.css (renamed from test/manual/indent/css-mode.css)4
-rw-r--r--test/lisp/textmodes/css-mode-tests.el22
-rw-r--r--test/lisp/textmodes/mhtml-mode-tests.el2
-rw-r--r--test/lisp/textmodes/paragraphs-tests.el4
-rw-r--r--test/lisp/textmodes/po-tests.el68
-rw-r--r--test/lisp/textmodes/sgml-mode-tests.el2
-rw-r--r--test/lisp/thingatpt-tests.el2
-rw-r--r--test/lisp/time-stamp-tests.el110
-rw-r--r--test/lisp/url/url-auth-tests.el2
-rw-r--r--test/lisp/url/url-expand-tests.el9
-rw-r--r--test/lisp/url/url-future-tests.el24
-rw-r--r--test/lisp/url/url-handlers-test.el8
-rw-r--r--test/lisp/url/url-parse-tests.el2
-rw-r--r--test/lisp/url/url-tramp-tests.el2
-rw-r--r--test/lisp/url/url-util-tests.el2
-rw-r--r--test/lisp/vc/add-log-tests.el12
-rw-r--r--test/lisp/vc/diff-mode-tests.el11
-rw-r--r--test/lisp/vc/ediff-ptch-tests.el2
-rw-r--r--test/lisp/vc/smerge-mode-tests.el2
-rw-r--r--test/lisp/vc/vc-bzr-tests.el5
-rw-r--r--test/lisp/vc/vc-hg-tests.el2
-rw-r--r--test/lisp/vc/vc-tests.el14
-rw-r--r--test/lisp/version-tests.el31
-rw-r--r--test/lisp/wdired-tests.el24
-rw-r--r--test/lisp/wid-edit-tests.el16
-rw-r--r--test/lisp/xml-tests.el33
-rw-r--r--test/manual/cedet/cedet-utests.el12
-rw-r--r--test/manual/cedet/semantic-tests.el4
-rw-r--r--test/manual/etags/c-src/abbrev.c14
-rw-r--r--test/manual/etags/c-src/emacs/src/keyboard.c2
-rw-r--r--test/manual/etags/y-src/parse.c2
-rw-r--r--test/manual/etags/y-src/parse.y2
-rw-r--r--test/manual/image-circular-tests.el144
-rw-r--r--test/manual/image-size-tests.el6
-rw-r--r--test/manual/image-transforms-tests.el50
-rw-r--r--test/manual/indent/less-css-mode.less10
-rw-r--r--test/manual/indent/nxml.xml10
-rw-r--r--test/manual/indent/opascal.pas12
-rw-r--r--test/manual/indent/ps-mode.ps14
-rw-r--r--test/manual/indent/scheme.scm9
-rw-r--r--test/manual/indent/scss-mode.scss4
-rw-r--r--test/manual/scroll-tests.el6
-rw-r--r--test/src/alloc-tests.el7
-rw-r--r--test/src/buffer-tests.el20
-rw-r--r--test/src/callint-tests.el3
-rw-r--r--test/src/callproc-tests.el17
-rw-r--r--test/src/charset-tests.el10
-rw-r--r--test/src/chartab-tests.el10
-rw-r--r--test/src/cmds-tests.el10
-rw-r--r--test/src/coding-tests.el64
-rw-r--r--test/src/decompress-tests.el2
-rw-r--r--test/src/doc-tests.el10
-rw-r--r--test/src/editfns-tests.el12
-rw-r--r--test/src/emacs-module-tests.el117
-rw-r--r--test/src/fileio-tests.el5
-rw-r--r--test/src/floatfns-tests.el2
-rw-r--r--test/src/fns-tests.el145
-rw-r--r--test/src/font-tests.el2
-rw-r--r--test/src/indent-tests.el59
-rw-r--r--test/src/keyboard-tests.el15
-rw-r--r--test/src/keymap-tests.el2
-rw-r--r--test/src/lread-tests.el22
-rw-r--r--test/src/print-tests.el34
-rw-r--r--test/src/process-tests.el22
-rw-r--r--test/src/regex-emacs-tests.el6
-rw-r--r--test/src/syntax-tests.el190
-rw-r--r--test/src/textprop-tests.el2
-rw-r--r--test/src/thread-tests.el2
-rw-r--r--test/src/timefns-tests.el59
-rw-r--r--test/src/undo-tests.el4
-rw-r--r--test/src/xdisp-tests.el52
-rw-r--r--test/src/xfaces-tests.el50
-rw-r--r--test/src/xml-tests.el23
1477 files changed, 74221 insertions, 39690 deletions
diff --git a/.gitignore b/.gitignore
index 014970f96b2..94c0009aa29 100644
--- a/.gitignore
+++ b/.gitignore
@@ -60,6 +60,7 @@ lib/execinfo.h
lib/fcntl.h
lib/getopt.h
lib/getopt-cdefs.h
+lib/gmp.h
lib/ieee754.h
lib/inttypes.h
lib/libgnu.a
@@ -135,6 +136,7 @@ src/gl-stamp
*.o
*.res
*.so
+*.dylib
core
core.*[0-9]
gmon.out
@@ -150,6 +152,7 @@ test/manual/etags/regexfile
test/manual/etags/ETAGS
test/manual/etags/CTAGS
test/manual/indent/*.new
+test/data/mml-sec/random_seed
# ctags, etags.
TAGS
@@ -161,6 +164,12 @@ GSYMS
GRTAGS
GTAGS
+# auto-generated compilation database
+compile_commands.json
+
+# ccls, a LSP-compliant server for C
+/.ccls-cache
+
# GNU idutils.
ID
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 9a62137c168..f4e08d59dd0 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -40,6 +40,33 @@ stages:
test-all:
# This tests also file monitor libraries inotify and inotifywatch.
stage: test
+ only:
+ changes:
+ - "Makefile.in"
+ - .gitlab-ci.yml
+ - aclocal.m4
+ - autogen.sh
+ - configure.ac
+ - lib/*.{h,c}
+ - lisp/*.el
+ - lisp/**/*.el
+ - src/*.{h,c}
+ - test/lisp/*.el
+ - test/lisp/**/*.el
+ - test/src/*.el
+ except:
+ changes:
+ # gfilemonitor, kqueue
+ - src/gfilenotify.c
+ - src/kqueue.c
+ # MS Windows
+ - lisp/w32*.el
+ - lisp/term/w32*.el
+ - src/w32*.{h,c}
+ # GNUstep
+ - lisp/term/ns-win.el
+ - src/ns*.{h,m}
+ - src/macfont.{h,m}
script:
- DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 inotify-tools
- ./autogen.sh autoconf
@@ -65,3 +92,21 @@ test-filenotify-gio:
- ./configure --without-makeinfo --with-file-notification=gfile
- make bootstrap
- make -C test autorevert-tests filenotify-tests
+
+test-gnustep:
+ stage: test
+ # This tests the GNUstep build process
+ only:
+ changes:
+ - .gitlab-ci.yml
+ - configure.ac
+ - src/ns*.{h,m}
+ - src/macfont.{h,m}
+ - lisp/term/ns-win.el
+ - nextstep/**/*
+ script:
+ - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 gnustep-devel
+ - ./autogen.sh autoconf
+ - ./configure --without-makeinfo --with-ns
+ - make bootstrap
+ - make install
diff --git a/CONTRIBUTE b/CONTRIBUTE
index 4e42c7aafcc..cb09391c324 100644
--- a/CONTRIBUTE
+++ b/CONTRIBUTE
@@ -257,13 +257,12 @@ them right the first time, so here are guidelines for formatting them:
- There is no standard or recommended way to identify revisions in
ChangeLog entries. Using Git SHA1 values limits the usability of
the references to Git, and will become much less useful if Emacs
- switches to a different VCS. So we recommend against that.
+ switches to a different VCS. So we recommend against doing only that.
One way to identify revisions is by quoting their summary line.
- Another is with an action stamp - an RFC3339 date followed by !
- followed by the committer's email - for example,
- "2014-01-16T05:43:35Z!esr@thyrsus.com". Often, "my previous commit"
- will suffice.
+ Prefixing the summary with the commit date can give useful context
+ (use 'git show -s "--pretty=format:%cd \"%s\"" --date=short HASH' to
+ produce that). Often, "my previous commit" will suffice.
- There is no need to mention files such as NEWS and MAINTAINERS, or
to indicate regeneration of files such as 'lib/gnulib.mk', in the
diff --git a/INSTALL b/INSTALL
index 2d257f9ce68..f1ceb2c1bf8 100644
--- a/INSTALL
+++ b/INSTALL
@@ -214,42 +214,6 @@ like 'apt-get build-dep emacs' (on older systems, replace 'emacs' with
eg 'emacs25'). On Red Hat-based systems, the corresponding command is
'dnf builddep emacs' (on older systems, use 'yum-builddep' instead).
-* GNU/Linux source and debug packages
-
-Many GNU/Linux systems provide separate packages containing the
-sources and debug symbols of Emacs. They are useful if you want to
-check the source code of Emacs primitive functions or debug Emacs on
-the C level.
-
-The names of the packages that you need vary according to the
-GNU/Linux distribution that you use. On Debian-based systems, you can
-install a source package of Emacs with a command like 'apt-get source
-emacs' (on older systems, replace 'emacs' with eg 'emacs25'). The
-target directory for unpacking the source tree is the current
-directory. On Red Hat-based systems, the corresponding command is
-'dnf install emacs-debugsource', with target directory /usr/src/debug
-(this requires to add the *-debuginfo repositories first, via 'dnf
-config-manager --set-enabled fedora-debuginfo updates-debuginfo').
-
-Once you have installed the source package, for example at
-/path/to/emacs-26.1, add the following line to your startup file:
-
- (setq find-function-C-source-directory
- "/path/to/emacs-26.1/src")
-
-The installation directory of the Emacs source package will contain
-the exact package name and version number Emacs is installed on your
-system. If a new Emacs package is installed, the source package must
-be reinstalled as well, and the setting in your startup file must be
-updated.
-
-Emacs debugging symbols are distributed by a debug package. It does
-not exist for every released Emacs package, this depends on the
-distribution. On Debian-based systems, you can install a debug
-package of Emacs with a command like 'apt-get install emacs-dbg' (on
-older systems, replace 'emacs' with eg 'emacs25'). On Red Hat-based
-systems, the corresponding command is 'dnf debuginfo-install emacs'.
-
DETAILED BUILDING AND INSTALLATION:
diff --git a/Makefile.in b/Makefile.in
index 67e15cfecd2..fbb1891ba72 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -714,6 +714,13 @@ install-etc:
${srcdir}/etc/emacs.desktop > $${tmp}; \
${INSTALL_DATA} $${tmp} "$(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop"; \
rm -f $${tmp}
+ tmp=etc/emacsclient.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.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}; \
sed -e "s/emacs\.desktop/${EMACS_NAME}.desktop/" \
diff --git a/README b/README
index 279a66b3aff..3d499a3596d 100644
--- a/README
+++ b/README
@@ -2,7 +2,7 @@ Copyright (C) 2001-2020 Free Software Foundation, Inc.
See the end of the file for license conditions.
-This directory tree holds version 27.1.50 of GNU Emacs, the extensible,
+This directory tree holds version 28.0.50 of GNU Emacs, the extensible,
customizable, self-documenting real-time display editor.
The file INSTALL in this directory says how to build and install GNU
diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES
index ea99d50094f..a40b4302723 100644
--- a/admin/CPP-DEFINES
+++ b/admin/CPP-DEFINES
@@ -124,9 +124,7 @@ HAVE_DECL_STRTOIMAX
HAVE_DECL_STRTOLL
HAVE_DECL_STRTOULL
HAVE_DECL_STRTOUMAX
-HAVE_DECL_SYS_SIGLIST
HAVE_DECL_TZNAME
-HAVE_DECL___SYS_SIGLIST
HAVE_DIALOGS
HAVE_DIFFTIME
HAVE_DUP2
@@ -201,7 +199,6 @@ HAVE_LIBXML2
HAVE_LIBXMU
HAVE_LOCALTIME_R
HAVE_LOCAL_SOCKETS
-HAVE_LONG_LONG_INT
HAVE_LRAND48
HAVE_LSTAT
HAVE_LUTIMES
@@ -322,7 +319,6 @@ HAVE_TM_ZONE
HAVE_TOUCHLOCK
HAVE_TZNAME
HAVE_TZSET
-HAVE_UNSIGNED_LONG_LONG_INT
HAVE_UTIL_H
HAVE_UTIMENSAT
HAVE_UTIMES
diff --git a/admin/authors.el b/admin/authors.el
index a418efea44f..cf9cf9871e5 100644
--- a/admin/authors.el
+++ b/admin/authors.el
@@ -284,9 +284,9 @@ If REALNAME is nil, ignore that author.")
(defvar authors-obsolete-files-regexps
- '(".*loaddefs\\.el$" ; not obsolete, but auto-generated
- "\\.\\(bzr\\|cvs\\|git\\)ignore$" ; obsolete or uninteresting
- "\\.arch-inventory$"
+ '(".*loaddefs\\.el\\'" ; not obsolete, but auto-generated
+ "\\.\\(bzr\\|cvs\\|git\\)ignore\\'" ; obsolete or uninteresting
+ "\\.arch-inventory\\'"
"ChangeLog\\(\\.[0-9]+\\)?\\'"
"\\(automated\\|test\\)/data/" ; not interesting
"cedet/tests/"
@@ -366,7 +366,7 @@ Changes to files matching one of the regexps in this list are not listed.")
"lib/stdarg.in.h" "lib/stdbool.in.h"
"unidata/bidimirror.awk" "unidata/biditype.awk"
"split-man" "Xkeymap.txt" "ms-7bkermit" "ulimit.hack"
- "gnu-hp300" "refcard.bit" "ledit.l" "forms.README" "forms-d2.dat"
+ "gnu-hp300" "refcard.bit" "forms.README" "forms-d2.dat"
"CXTERM-DIC/PY.tit" "CXTERM-DIC/ZIRANMA.tit"
"CXTERM-DIC/CTLau.tit" "CXTERM-DIC/CTLauB.tit"
"copying.paper" "celibacy.1" "condom.1" "echo.msg" "sex.6"
@@ -474,6 +474,9 @@ Changes to files matching one of the regexps in this list are not listed.")
;; Replaced by lisp/thread.el
"lisp/emacs-lisp/thread-list.el"
"etc/images/slash.bmp"
+ "src/mini-gmp-emacs.c"
+ "lib/dosname.h"
+ "lib/putenv.c"
)
"List of files and directories to ignore.
Changes to files in this list are not listed.")
@@ -610,7 +613,7 @@ Changes to files in this list are not listed.")
;; No longer distributed: lselect.el.
("Lucid, Inc." :changed "bytecode.c" "byte-opt.el" "byte-run.el"
"bytecomp.el" "delsel.el" "disass.el" "faces.el" "font-lock.el"
- "lmenu.el" "mailabbrev.el" "select.el" "xfaces.c" "xselect.c")
+ "mailabbrev.el" "select.el" "xfaces.c" "xselect.c")
;; MCC. No longer distributed: emacsserver.c.
("Microelectronics and Computer Technology Corporation"
:changed "etags.c" "emacsclient.c" "movemail.c"
@@ -774,7 +777,7 @@ Changes to files in this list are not listed.")
"erc-hecomplete.el"
"eshell/esh-maint.el"
"language/persian.el"
- "ledit.el" "meese.el" "iswitchb.el" "longlines.el"
+ "meese.el" "iswitchb.el" "longlines.el"
"mh-exec.el" "mh-init.el" "mh-customize.el"
"net/zone-mode.el" "xesam.el"
"term/mac-win.el" "sup-mouse.el"
@@ -878,7 +881,9 @@ Changes to files in this list are not listed.")
"library-of-babel.org"
"flymake-elisp.el"
"flymake-ui.el"
- "pinentry.el")
+ "pinentry.el"
+ "ledit.el"
+ "lmenu.el")
"File names which are valid, but no longer exist (or cannot be found)
in the repository.")
@@ -1120,6 +1125,8 @@ in the repository.")
("gnus-news.texi" . "doc/misc/gnus.texi")
("lisp/multifile.el". "lisp/fileloop.el")
("lisp/emacs-lisp/thread.el". "lisp/thread.el")
+ ("src/mini-gmp.c" . "lib/mini-gmp.c")
+ ("src/mini-gmp.h" . "lib/mini-gmp.h")
)
"Alist of files which have been renamed during their lifetime.
Elements are (OLDNAME . NEWNAME).")
@@ -1141,7 +1148,7 @@ Elements are (OLDNAME . NEWNAME).")
\\(\\(cs\\|fr\\|sk\\)-\\)?survival\\)\\.tex\\'" "refcards/\\&")
("\\`refcard-\\(de\\|pl\\)\\.tex\\'" "refcards/\\1-refcard.tex")
("\\`\\(refcards/\\)?fr-drdref\\.tex\\'" "refcards/fr-dired-ref.tex")
- ("^\\(TUTORIAL[^/]*\\)" "tutorials/\\1")
+ ("\\`\\(TUTORIAL[^/]*\\)" "tutorials/\\1")
("\\`themes/dev-\\(tsdh-\\(?:light\\|dark\\)-theme\\.el\\)\\'"
"themes/\\1")
;; Moved from lisp/toolbar to etc/images.
@@ -1166,9 +1173,9 @@ remove\\|run\\|until\\|up\\|watch\\)\\(\\.\\(?:pb\\|xp\\)m\\)\\'"
("\\`\\(toolbar/gud-\\|images/gud/\\)s\\(i\\)?\\(\\.\\(?:pb\\|xp\\)m\\)\\'"
"images/gud/step\\2\\3")
("\\`toolbar/lc-\\([-a-z]+\\.xpm\\)\\'" "images/low-color/\\1")
- ("^\\(tree-widget/\\(?:default\\|folder\\)/[-a-z]+\\.\\(png\\|xpm\\)\\)$"
+ ("\\`\\(tree-widget/\\(?:default\\|folder\\)/[-a-z]+\\.\\(png\\|xpm\\)\\)\\'"
"images/\\1")
- ("^\\(images/icons/\\)mac\\(emacs\\)_\\([0-9]+\\)\\(\\.png\\)"
+ ("\\`\\(images/icons/\\)mac\\(emacs\\)_\\([0-9]+\\)\\(\\.png\\)"
"\\1\\2\\3_mac\\4")
("\\(images/icons/\\)emacs_\\([0-9][0-9]\\)\\.png"
"\\1hicolor/\\2x\\2/apps/emacs.png")
@@ -1199,10 +1206,10 @@ ediff\\|emerge\\|log-edit\\|log-view\\|pcvs\\|smerge-mode\\|vc\\)\\.el\\'"
;; Maybe not the exact new name, but disambiguates from lisp/.
("automated/\\([^/]*\\)\\.el\\'" "\\1-tests.el")
;; NB lax rules should come last.
- ("^m/m-\\(.*\\.h\\)$" "m/\\1" t)
- ("^m-\\(.*\\.h\\)$" "\\1" t)
- ("^s/s-\\(.*\\.h\\)$" "s/\\1" t)
- ("^s-\\(.*\\.h\\)$" "\\1" t)
+ ("\\`m/m-\\(.*\\.h\\)\\'" "m/\\1" t)
+ ("\\`m-\\(.*\\.h\\)\\'" "\\1" t)
+ ("\\`s/s-\\(.*\\.h\\)\\'" "s/\\1" t)
+ ("\\`s-\\(.*\\.h\\)\\'" "\\1" t)
("\\.\\(el\\|[ch]\\|x[pb]m\\|pbm\\)\\'" t t)
)
"List of regexps and rewriting rules for renamed files.
diff --git a/admin/automerge b/admin/automerge
index f7717026b15..cd0f22c3f25 100755
--- a/admin/automerge
+++ b/admin/automerge
@@ -4,6 +4,7 @@
## Copyright (C) 2018-2020 Free Software Foundation, Inc.
## Author: Glenn Morris <rgm@gnu.org>
+## Maintainer: emacs-devel@gnu.org
## This file is part of GNU Emacs.
diff --git a/admin/charsets/cp51932.awk b/admin/charsets/cp51932.awk
index 6aac98815b5..c3555095249 100644
--- a/admin/charsets/cp51932.awk
+++ b/admin/charsets/cp51932.awk
@@ -43,13 +43,14 @@ BEGIN {
END {
print ")))";
- print " (mapc #'(lambda (x)";
- print " (setcar x (decode-char 'japanese-jisx0208 (car x))))";
- print " map)";
+ print " (setq map (mapcar (lambda (x)";
+ print " (cons (decode-char 'japanese-jisx0208 (car x))";
+ print " (cdr x)))";
+ print " map))";
print " (define-translation-table 'cp51932-decode map)";
- print " (mapc #'(lambda (x)";
- print " (let ((tmp (car x)))";
- print " (setcar x (cdr x)) (setcdr x tmp)))";
+ print " (mapc (lambda (x)";
+ print " (let ((tmp (car x)))";
+ print " (setcar x (cdr x)) (setcdr x tmp)))";
print " map)";
print " (define-translation-table 'cp51932-encode map))";
print "";
diff --git a/admin/charsets/eucjp-ms.awk b/admin/charsets/eucjp-ms.awk
index 0c9f94d0f48..f6a6748ce51 100644
--- a/admin/charsets/eucjp-ms.awk
+++ b/admin/charsets/eucjp-ms.awk
@@ -93,15 +93,17 @@ function write_entry (unicode) {
END {
print ")))";
- print " (mapc #'(lambda (x)";
+ print " (setq map";
+ print " (mapcar";
+ print " (lambda (x)";
print " (let ((code (logand (car x) #x7F7F)))";
print " (if (integerp (cdr x))";
- print " (setcar x (decode-char 'japanese-jisx0208 code))";
- print " (setcar x (decode-char 'japanese-jisx0212 code))";
- print " (setcdr x (cadr x)))))";
- print " map)";
+ print " (cons (decode-char 'japanese-jisx0208 code) (cdr x))";
+ print " (cons (decode-char 'japanese-jisx0212 code)"
+ print " (cadr x)))))";
+ print " map))";
print " (define-translation-table 'eucjp-ms-decode map)";
- print " (mapc #'(lambda (x)";
+ print " (mapc (lambda (x)";
print " (let ((tmp (car x)))";
print " (setcar x (cdr x)) (setcdr x tmp)))";
print " map)";
diff --git a/admin/cus-test.el b/admin/cus-test.el
index 842240946eb..b4e4b426515 100644
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -347,7 +347,7 @@ Optional argument ALL non-nil means list all (non-obsolete) Lisp files."
;; Hack to remove leading "./".
(mapcar (lambda (e) (substring e 2))
(apply 'process-lines find-program
- "-name" "obsolete" "-prune" "-o"
+ "." "-name" "obsolete" "-prune" "-o"
"-name" "[^.]*.el" ; ignore .dir-locals.el
(if all
'("-print")
@@ -370,7 +370,9 @@ This function is suitable for batch mode. E.g., invoke
in the Emacs source directory.
Normally only tests options belonging to files in loaddefs.el.
-If optional argument ALL is non-nil, test all files with defcustoms."
+If optional argument ALL is non-nil, test all files with defcustoms.
+
+Returns a list of variables with suspicious types."
(interactive)
(and noninteractive
command-line-args-left
@@ -382,9 +384,12 @@ If optional argument ALL is non-nil, test all files with defcustoms."
(message "Running %s" 'cus-test-apropos)
(cus-test-apropos "")
(if (not cus-test-errors)
- (message "No problems found")
+ (progn
+ (message "No problems found")
+ nil)
(message "The following options might have problems:")
- (cus-test-message cus-test-errors)))
+ (cus-test-message cus-test-errors)
+ cus-test-errors))
(defun cus-test-deps ()
"Run a verbose version of `custom-load-symbol' on all atoms.
diff --git a/admin/find-gc.el b/admin/find-gc.el
index 9bab3776a51..7de2474b828 100644
--- a/admin/find-gc.el
+++ b/admin/find-gc.el
@@ -73,8 +73,8 @@ Also store it in `find-gc-unsafe-list'."
(find-unsafe-funcs 'Fgarbage_collect)
(setq find-gc-unsafe-list
(sort find-gc-unsafe-list
- (function (lambda (x y)
- (string-lessp (car x) (car y)))))))
+ (lambda (x y)
+ (string-lessp (car x) (car y))))))
;;; This does a depth-first search to find all functions that can
;;; ultimately call the function "target". The result is an a-list
diff --git a/admin/gitmerge.el b/admin/gitmerge.el
index eeef4e3fc59..18da466aaa1 100644
--- a/admin/gitmerge.el
+++ b/admin/gitmerge.el
@@ -52,7 +52,7 @@
;; caused false positives. --Stef
(let ((skip "back[- ]?port\\|cherry picked from commit\\|\
\\(do\\( no\\|n['’]\\)t\\|no need to\\) merge\\|not to be merged\\|\
-bump \\(Emacs \\)?version\\|Auto-commit"))
+bump Emacs version\\|Auto-commit"))
(if noninteractive skip
;; "Regenerate" is quite prone to false positives.
;; We only want to skip merging things like AUTHORS and ldefs-boot.
@@ -354,7 +354,7 @@ Returns non-nil if conflicts remain."
;; The conflict markers remain so we return non-nil.
(message "Failed to fix NEWS conflict"))))
;; Generated files.
- ((member file '("lisp/ldefs-boot.el"))
+ ((member file '("lisp/ldefs-boot.el" "etc/AUTHORS"))
;; We are in the file's buffer, so names are relative.
(call-process "git" nil t nil "reset" "--"
(file-name-nondirectory file))
diff --git a/admin/make-manuals b/admin/make-manuals
index 1cb1c514331..13a8148bb3c 100755
--- a/admin/make-manuals
+++ b/admin/make-manuals
@@ -4,6 +4,7 @@
## Copyright 2018-2020 Free Software Foundation, Inc.
## Author: Glenn Morris <rgm@gnu.org>
+## Maintainer: emacs-devel@gnu.org
## This file is part of GNU Emacs.
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
index 3dee0b72b32..164300e1db6 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -31,19 +31,19 @@ GNULIB_MODULES='
careadlinkat close-stream copy-file-range
count-leading-zeros count-one-bits count-trailing-zeros
crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer
- d-type diffseq dosname double-slash-root dtoastr dtotimespec dup2
+ d-type diffseq double-slash-root dtoastr dtotimespec dup2
environ execinfo explicit_bzero faccessat
- fcntl fcntl-h fdopendir
- filemode filevercmp flexmember fpieee fstatat fsusage fsync
- getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog
- ieee754-h ignore-value intprops largefile lstat
+ fchmodat fcntl fcntl-h fdopendir
+ filemode filename filevercmp flexmember fpieee fstatat fsusage fsync futimens
+ getloadavg getopt-gnu getrandom gettime gettimeofday gitlog-to-changelog
+ ieee754-h ignore-value intprops largefile libgmp lstat
manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime nstrftime
- pathmax pipe2 pselect pthread_sigmask putenv
+ pathmax pipe2 pselect pthread_sigmask
qcopy-acl readlink readlinkat regex
- sig2str socklen stat-time std-gnu11 stdalign stddef stdio
+ sig2str sigdescr_np socklen stat-time std-gnu11 stdalign stddef stdio
stpcpy strnlen strtoimax symlink sys_stat sys_time
tempname time time_r time_rz timegm timer-time timespec-add timespec-sub
- update-copyright unlocked-io utimens
+ update-copyright unlocked-io utimensat
vla warnings
'
diff --git a/admin/notes/git-workflow b/admin/notes/git-workflow
index 28b6f91a25d..d109cdaa354 100644
--- a/admin/notes/git-workflow
+++ b/admin/notes/git-workflow
@@ -15,14 +15,15 @@ Initial setup
=============
Then we want to clone the repository. We normally want to have both
-the current master and the emacs-26 branch.
+the current master and (if there is one) the active release branch
+(eg emacs-27).
mkdir ~/emacs
cd ~/emacs
git clone <membername>@git.sv.gnu.org:/srv/git/emacs.git master
cd master
git config push.default current
-git worktree add ../emacs-26 emacs-26
+git worktree add ../emacs-27 emacs-27
You now have both branches conveniently accessible, and you can do
"git pull" in them once in a while to keep updated.
@@ -52,11 +53,11 @@ you commit your change locally and then send a patch file as a bug report
as described in ../../CONTRIBUTE.
-Backporting to emacs-26
-=======================
+Backporting to release branch
+=============================
If you have applied a fix to the master, but then decide that it should
-be applied to the emacs-26 branch, too, then
+be applied to the release branch, too, then
cd ~/emacs/master
git log
@@ -66,7 +67,7 @@ which will look like
commit 958b768a6534ae6e77a8547a56fc31b46b63710b
-cd ~/emacs/emacs-26
+cd ~/emacs/emacs-27
git cherry-pick -xe 958b768a6534ae6e77a8547a56fc31b46b63710b
and add "Backport:" to the commit string. Then
@@ -74,17 +75,28 @@ and add "Backport:" to the commit string. Then
git push
-Merging emacs-26 to the master
-==============================
+Reverting on release branch
+===========================
+
+If a commit is made to the release branch, and then it is later
+decided that this change should only be on the master branch, the
+simplest way to handle this is to revert the commit on the release
+branch, and include in the associated log entry "do not merge to master".
+(Otherwise, the reversion may get merged to master, and inadvertently
+clobber the change on master if it has been manually made there.)
+
+
+Merging release branch to the master
+====================================
It is recommended to use the file gitmerge.el in the admin directory
-for merging 'emacs-26' into 'master'. It will take care of many
+for merging the release branch into 'master'. It will take care of many
things which would otherwise have to be done manually, like ignoring
commits that should not land in master, fixing up ChangeLogs and
automatically dealing with certain types of conflicts. If you really
want to, you can do the merge manually, but then you're on your own.
If you still choose to do that, make absolutely sure that you *always*
-use the 'merge' command to transport commits from 'emacs-26' to
+use the 'merge' command to transport commits from the release branch to
'master'. *Never* use 'cherry-pick'! If you don't know why, then you
shouldn't manually do the merge in the first place; just use
gitmerge.el instead.
@@ -97,11 +109,11 @@ up-to-date by doing a pull. Then start Emacs with
emacs -l admin/gitmerge.el -f gitmerge
You'll be asked for the branch to merge, which will default to
-'origin/emacs-26', which you should accept. Merging a local tracking
+(eg) 'origin/emacs-27', which you should accept. Merging a local tracking
branch is discouraged, since it might not be up-to-date, or worse,
contain commits from you which are not yet pushed upstream.
-You will now see the list of commits from 'emacs-26' which are not yet
+You will now see the list of commits from the release branch that are not yet
merged to 'master'. You might also see commits that are already
marked for "skipping", which means that they will be merged with a
different merge strategy ('ours'), which will effectively ignore the
diff --git a/admin/notes/unicode b/admin/notes/unicode
index 6cb1b764c51..1e418590a68 100644
--- a/admin/notes/unicode
+++ b/admin/notes/unicode
@@ -256,11 +256,19 @@ nontrivial changes to the build process.
etc/tutorials/TUTORIAL.ja
+ * iso-2022-7bit
+
+ This file contains multiple Chinese charsets, and converting it
+ to UTF-8 would lose the charset property and would change the
+ code's behavior. Although this could be worked around by
+ propertizing the strings, that hasn't been done.
+
+ lisp/international/titdic-cnv.el
+
* utf-8-emacs
These files contain characters that cannot be encoded in UTF-8.
- lisp/international/titdic-cnv.el
lisp/language/ethio-util.el
lisp/language/ethiopic.el
lisp/language/ind-util.el
diff --git a/admin/nt/dist-build/README-windows-binaries b/admin/nt/dist-build/README-windows-binaries
index c8fb5797de9..01f7ed9da13 100644
--- a/admin/nt/dist-build/README-windows-binaries
+++ b/admin/nt/dist-build/README-windows-binaries
@@ -67,11 +67,11 @@ The dependencies. Unzipping this file on top of
emacs-$VERSION-x86_64-no-deps.zip should result in the same install as
emacs-$VERSION-x86_64.zip.
-emacs-27-i686-deps.zip
+emacs-$VERSION-i686-deps.zip
The 32-bit version of the dependencies.
-emacs-27-deps-mingw-w64-src.zip
+emacs-$VERSION-deps-mingw-w64-src.zip
The source for the dependencies. Source for Emacs itself is available
in the main distribution tarball. These dependencies were produced
diff --git a/admin/nt/dist-build/build-dep-zips.py b/admin/nt/dist-build/build-dep-zips.py
index 0e5f1ae1dc6..7047d28346d 100755
--- a/admin/nt/dist-build/build-dep-zips.py
+++ b/admin/nt/dist-build/build-dep-zips.py
@@ -26,7 +26,7 @@ import re
from subprocess import check_output
## Constants
-EMACS_MAJOR_VERSION="27"
+EMACS_MAJOR_VERSION="28"
# This list derives from the features we want Emacs to compile with.
PKG_REQ='''mingw-w64-x86_64-giflib
diff --git a/admin/release-process b/admin/release-process
index c3728b582f1..73879b13f08 100644
--- a/admin/release-process
+++ b/admin/release-process
@@ -200,21 +200,14 @@ sk Miroslav Vaško
** Check for modes which bind M-s that conflicts with a new global binding M-s
and change key bindings where necessary. The current list of modes:
-1. Gnus binds 'M-s' to 'gnus-summary-search-article-forward'.
-
-2. Minibuffer binds 'M-s' to 'next-matching-history-element'
+1. Minibuffer binds 'M-s' to 'next-matching-history-element'
(not useful any more since C-s can now search in the history).
-3. 'center-line' in Text mode was already moved to the text formatting
- keymap as 'M-o M-s' (thus this binding is not necessary any more
- in 'nroff-mode-map' too and can be removed now from the nroff mode
- because it can now use the global key binding 'M-o M-s' 'center-line').
-
-4. PCL-CVS binds 'M-s' to 'cvs-status', and log-edit-mode binds it to
+2. PCL-CVS binds 'M-s' to 'cvs-status', and log-edit-mode binds it to
'log-edit-comment-search-forward'. Perhaps search commands
on the global key binding 'M-s' are useless in these modes.
-5. Rmail binds '\es' to 'rmail-search'/'rmail-summary-search'.
+3. Rmail binds '\es' to 'rmail-search'/'rmail-summary-search'.
* DOCUMENTATION
diff --git a/admin/unidata/blocks.awk b/admin/unidata/blocks.awk
index 1e85eecb68f..70e96ed802d 100755
--- a/admin/unidata/blocks.awk
+++ b/admin/unidata/blocks.awk
@@ -3,6 +3,7 @@
## Copyright (C) 2015-2020 Free Software Foundation, Inc.
## Author: Glenn Morris <rgm@gnu.org>
+## Maintainer: emacs-devel@gnu.org
## This file is part of GNU Emacs.
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 71959d633c5..510bb7959f1 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.
+;; unidata-gen.el -- Create files containing character property data -*- lexical-binding:t -*-
;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
@@ -77,7 +77,7 @@
;; 2nd: function to call to get a property value,
;; or an index number of C function to decode the value,
;; or nil if the value can be directly got from the table.
-;; 3nd: function to call to put a property value,
+;; 3rd: function to call to put a property value,
;; or an index number of C function to encode the value,
;; or nil if the value can be directly stored in the table.
;; 4th: function to call to get a description of a property value, or nil
@@ -349,13 +349,10 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(n o c)))))
;; Functions to access the above data.
-(defsubst unidata-prop-prop (proplist) (nth 0 proplist))
-(defsubst unidata-prop-index (proplist) (nth 1 proplist))
-(defsubst unidata-prop-generator (proplist) (nth 2 proplist))
-(defsubst unidata-prop-docstring (proplist) (nth 3 proplist))
-(defsubst unidata-prop-describer (proplist) (nth 4 proplist))
-(defsubst unidata-prop-default (proplist) (nth 5 proplist))
-(defsubst unidata-prop-val-list (proplist) (nth 6 proplist))
+(cl-defstruct (unidata-prop
+ (:type list)
+ (:constructor nil))
+ prop index generator docstring describer default val-list)
;; SIMPLE TABLE
@@ -383,11 +380,11 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
;; 3rd: 0 (corresponding to uniprop_encode_character in chartab.c)
;; 4th to 5th: nil
-(defun unidata-gen-table-character (prop prop-idx &rest ignore)
+(defun unidata-gen-table-character (prop prop-idx &rest _ignore)
(let ((table (make-char-table 'char-code-property-table))
(vec (make-vector 128 0))
(tail unidata-list)
- elt range val idx slot)
+ elt range val)
(if (functionp prop-idx)
(setq tail (funcall prop-idx)
prop-idx 1))
@@ -395,9 +392,9 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(setq elt (car tail) tail (cdr tail))
(setq range (car elt)
val (nth prop-idx elt))
- (if (= (length val) 0)
- (setq val nil)
- (setq val (string-to-number val 16)))
+ (setq val (if (= (length val) 0)
+ nil
+ (string-to-number val 16)))
(if (consp range)
(if val
(set-char-table-range table range val))
@@ -419,8 +416,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(setq first-index last-index)))
(setq tail (cdr tail)))
(when first-index
- (let ((str (string 1 first-index))
- c)
+ (let ((str (string 1 first-index)))
(while (<= first-index last-index)
(setq str (format "%s%c" str (or (aref vec first-index) 0))
first-index (1+ first-index)))
@@ -502,7 +498,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
;; bidi.c:bidi_get_type and bidi.c:bidi_get_category.
(bidi-warning "\
** Found new bidi-class `%s', please update bidi.c and dispextern.h")
- tail elt range val val-code idx slot
+ tail elt range val val-code
prev-range-data)
(setq val-list (cons nil (copy-sequence val-list)))
(setq tail val-list val-code 0)
@@ -510,9 +506,9 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(while tail
(setcar tail (cons (car tail) val-code))
(setq tail (cdr tail) val-code (1+ val-code)))
- (if (consp default-value)
- (setq default-value (copy-sequence default-value))
- (setq default-value (list default-value)))
+ (setq default-value (if (consp default-value)
+ (copy-sequence default-value)
+ (list default-value)))
(setcar default-value
(unidata-encode-val val-list (car default-value)))
(set-char-table-range table t (car default-value))
@@ -602,17 +598,17 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(if (= count 128)
(if val
(set-char-table-range table (cons start limit) val-code))
- (if (= val-code 0)
- (set-char-table-range table (cons start limit) str)
- (if (> count 2)
- (setq str (concat str (string val-code (+ count 128))))
- (if (= count 2)
- (setq str (concat str (string val-code val-code)))
- (setq str (concat str (string val-code)))))
- (set-char-table-range table (cons start limit) str))))))
+ (set-char-table-range table (cons start limit)
+ (if (= val-code 0)
+ str
+ (concat str (if (> count 2)
+ (string val-code (+ count 128))
+ (if (= count 2)
+ (string val-code val-code)
+ (string val-code))))))))))
(set-char-table-extra-slot table 0 prop)
- (set-char-table-extra-slot table 4 (vconcat (mapcar 'car val-list)))
+ (set-char-table-extra-slot table 4 (vconcat (mapcar #'car val-list)))
table))
(defun unidata-gen-table-symbol (prop index default-value val-list)
@@ -679,8 +675,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(let ((beg 0)
(end 0)
(len1 (length l1))
- (len2 (length l2))
- result)
+ (len2 (length l2)))
(when (< len1 16)
(while (and l1 (eq (car l1) (car l2)))
(setq beg (1+ beg)
@@ -688,13 +683,13 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(while (and (< end len1) (< end len2)
(eq (nth (- len1 end 1) l1) (nth (- len2 end 1) l2)))
(setq end (1+ end))))
- (if (= (+ beg end) 0)
- (setq result (list -1))
- (setq result (list (+ (* beg 16) (+ beg (- len1 end))))))
- (while (< end len2)
- (setcdr result (cons (nth (- len2 end 1) l2) (cdr result)))
- (setq end (1+ end)))
- result))
+ (let ((result (list (if (= (+ beg end) 0)
+ -1
+ (+ (* beg 16) (+ beg (- len1 end)))))))
+ (while (< end len2)
+ (push (nth (- len2 end 1) l2) (cdr result))
+ (setq end (1+ end)))
+ result)))
;; Return a compressed form of the vector VEC. Each element of VEC is
;; a list of symbols of which names can be concatenated to form a
@@ -703,7 +698,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
;; elements is usually small.
(defun unidata-word-list-compress (vec)
- (let (last-elt last-idx diff-head tail elt val)
+ (let (last-elt last-idx diff-head elt val)
(dotimes (i 128)
(setq elt (aref vec i))
(when elt
@@ -768,7 +763,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(vec (make-vector 128 nil))
(idx 0)
(case-fold-search nil)
- c word-list tail-list last-list word diff-head)
+ c word-list tail-list last-list diff-head)
(while (< i len)
(setq c (aref val i))
(if (< c 3)
@@ -784,7 +779,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(setq diff-head
(prog1 (aref val i) (setq i (1+ i)))))
(setq tail-list (nthcdr (% diff-head 16) last-list))
- (dotimes (i (/ diff-head 16))
+ (dotimes (_ (/ diff-head 16))
(setq word-list (nconc word-list (list (car l)))
l (cdr l))))))
(setq word-list
@@ -808,7 +803,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(setcdr tail (cons elt (cdr tail)))
(setcar tail " ")))
(setq tail (cddr tail)))
- (setq name (apply 'concat name))))
+ (setq name (apply #'concat name))))
(aset table c name)
(if (= c char)
(setq val name))))
@@ -872,7 +867,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(vec (make-vector 128 nil))
(idx 0)
(case-fold-search nil)
- c word-list tail-list last-list word diff-head)
+ c word-list tail-list last-list diff-head)
(while (< i len)
(setq c (aref val i))
(if (< c 3)
@@ -888,7 +883,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(setq diff-head
(prog1 (aref val i) (setq i (1+ i)))))
(setq tail-list (nthcdr (% diff-head 16) last-list))
- (dotimes (i (/ diff-head 16))
+ (dotimes (_ (/ diff-head 16))
(setq word-list (nconc word-list (list (car l)))
l (cdr l))))))
(setq word-list
@@ -945,7 +940,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(word-list (list nil))
word-table
block-list block-word-table block-end
- tail elt range val idx slot)
+ tail elt range val idx)
(setq tail unidata-list)
(setq block-end -1)
(while tail
@@ -984,9 +979,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(push (list val range) block-list))))
(let* ((start (ash (ash range -7) 7))
(limit (+ start 127))
- (first tail)
- (vec (make-vector 128 nil))
- c name len)
+ (vec (make-vector 128 nil)))
(if (<= start block-end)
;; START overlap with the previous block.
(aset table range (nth prop-idx elt))
@@ -1037,10 +1030,10 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(cdr (assq elt word-list))))
(setcar tail (string code))
(setq tail (cdr tail)))
- (aset vec i (mapconcat 'identity (aref vec i) "")))))
+ (aset vec i (mapconcat #'identity (aref vec i) "")))))
(set-char-table-range
table (cons idx (+ idx 127))
- (mapconcat 'identity vec "")))))
+ (mapconcat #'identity vec "")))))
(setq block-word-table (make-vector (length block-list) nil))
(setq idx 0)
@@ -1086,19 +1079,18 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(or (byte-code-function-p (symbol-function fun))
(byte-compile fun))))
-(defun unidata-gen-table-name (prop index &rest ignore)
+(defun unidata-gen-table-name (prop index &rest _ignore)
(let* ((table (unidata-gen-table-word-list prop index 'unidata-split-name))
(word-tables (char-table-extra-slot table 4)))
(unidata--ensure-compiled 'unidata-get-name 'unidata-put-name)
(set-char-table-extra-slot table 1 (symbol-function 'unidata-get-name))
(set-char-table-extra-slot table 2 (symbol-function 'unidata-put-name))
- (if (eq prop 'name)
- (set-char-table-extra-slot table 4
+ (set-char-table-extra-slot table 4
+ (if (eq prop 'name)
(vector (car word-tables)
(cdr word-tables)
- unidata-name-jamo-name-table))
- (set-char-table-extra-slot table 4
+ unidata-name-jamo-name-table)
(vector (car word-tables))))
table))
@@ -1107,24 +1099,25 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
str
(let ((len (length str))
(l nil)
- (idx 0)
- c)
+ (idx 0))
(if (= len 0)
nil
(dotimes (i len)
- (setq c (aref str i))
- (if (= c 32)
- (setq l (if (= (aref str idx) ?<)
- (cons (intern (substring str (1+ idx) (1- i))) l)
- (cons (string-to-number (substring str idx i) 16) l))
- idx (1+ i))))
- (if (= (aref str idx) ?<)
- (setq l (cons (intern (substring str (1+ idx) (1- len))) l))
- (setq l (cons (string-to-number (substring str idx len) 16) l)))
+ (let ((c (aref str i)))
+ (when (= c ?\s)
+ (push (if (= (aref str idx) ?<)
+ (intern (substring str (1+ idx) (1- i)))
+ (string-to-number (substring str idx i) 16))
+ l)
+ (setq idx (1+ i)))))
+ (push (if (= (aref str idx) ?<)
+ (intern (substring str (1+ idx) (1- len)))
+ (string-to-number (substring str idx len) 16))
+ l)
(nreverse l)))))
-(defun unidata-gen-table-decomposition (prop index &rest ignore)
+(defun unidata-gen-table-decomposition (prop index &rest _ignore)
(let* ((table (unidata-gen-table-word-list prop index 'unidata-split-decomposition))
(word-tables (char-table-extra-slot table 4)))
(unidata--ensure-compiled 'unidata-get-decomposition
@@ -1167,7 +1160,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(forward-line)))
result))
-(defun unidata-gen-table-special-casing (prop prop-idx &rest ignore)
+(defun unidata-gen-table-special-casing (prop prop-idx &rest _ignore)
(let ((table (make-char-table 'char-code-property-table)))
(set-char-table-extra-slot table 0 prop)
(mapc (lambda (entry)
@@ -1175,7 +1168,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
;; If character maps to a single character, the mapping is already
;; covered by regular casing property. Don’t store those.
(when (/= (length v) 1)
- (set-char-table-range table ch (apply 'string v)))))
+ (set-char-table-range table ch (apply #'string v)))))
(or unidata-gen-table-special-casing--cache
(setq unidata-gen-table-special-casing--cache
(unidata-gen-table-special-casing--do-load))))
@@ -1184,7 +1177,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(defun unidata-describe-general-category (val)
(cdr (assq val
- '((nil . "Uknown")
+ '((nil . "Unknown")
(Lu . "Letter, Uppercase")
(Ll . "Letter, Lowercase")
(Lt . "Letter, Titlecase")
@@ -1353,7 +1346,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
;; unidata-gen-table-special-casing--do-load and there is no other file
;; to compare those values with. This is why we’re skipping the check
;; for special casing properties.
- (unless (eq generator 'unidata-gen-table-special-casing)
+ (unless (eq generator #'unidata-gen-table-special-casing)
(setq table (progn
(message "Generating %S table..." prop)
(funcall generator prop index default-value val-list))
@@ -1369,19 +1362,21 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(and (stringp val1)
(= (length val1) 0)
(setq val1 nil))
- (if val1
- (cond ((eq generator 'unidata-gen-table-symbol)
- (setq val1 (intern val1)))
- ((eq generator 'unidata-gen-table-integer)
- (setq val1 (string-to-number val1)))
- ((eq generator 'unidata-gen-table-character)
- (setq val1 (string-to-number val1 16)))
- ((eq generator 'unidata-gen-table-decomposition)
- (setq val1 (unidata-split-decomposition val1))))
- (cond ((eq prop 'decomposition)
- (setq val1 (list char)))
- ((eq prop 'bracket-type)
- (setq val1 'n))))
+ (setq val1
+ (if val1
+ (cond ((eq generator #'unidata-gen-table-symbol)
+ (intern val1))
+ ((eq generator #'unidata-gen-table-integer)
+ (string-to-number val1))
+ ((eq generator #'unidata-gen-table-character)
+ (string-to-number val1 16))
+ ((eq generator #'unidata-gen-table-decomposition)
+ (unidata-split-decomposition val1))
+ (t val1))
+ (cond ((eq prop 'decomposition)
+ (list char))
+ ((eq prop 'bracket-type)
+ 'n))))
(setq val2 (aref table char))
(when decoder
(setq val2 (funcall decoder char val2 table)))
diff --git a/admin/update_autogen b/admin/update_autogen
index af339a9e7ec..d60984e13f6 100755
--- a/admin/update_autogen
+++ b/admin/update_autogen
@@ -4,6 +4,7 @@
## Copyright (C) 2011-2020 Free Software Foundation, Inc.
## Author: Glenn Morris <rgm@gnu.org>
+## Maintainer: emacs-devel@gnu.org
## This file is part of GNU Emacs.
diff --git a/admin/upload-manuals b/admin/upload-manuals
index af1c8c18704..b7187971df0 100755
--- a/admin/upload-manuals
+++ b/admin/upload-manuals
@@ -5,6 +5,7 @@
## Copyright 2018-2020 Free Software Foundation, Inc.
## Author: Glenn Morris <rgm@gnu.org>
+## Maintainer: emacs-devel@gnu.org
## This file is part of GNU Emacs.
diff --git a/build-aux/config.guess b/build-aux/config.guess
index 4c8498faf3e..9aff91cfd03 100755
--- a/build-aux/config.guess
+++ b/build-aux/config.guess
@@ -2,7 +2,7 @@
# Attempt to guess a canonical system name.
# Copyright 1992-2020 Free Software Foundation, Inc.
-timestamp='2019-09-10'
+timestamp='2020-08-17'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -50,7 +50,7 @@ version="\
GNU config.guess ($timestamp)
Originally written by Per Bothner.
-Copyright 1992-2019 Free Software Foundation, Inc.
+Copyright 1992-2020 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
@@ -99,6 +99,8 @@ tmp=
trap 'test -z "$tmp" || rm -fr "$tmp"' 0 1 2 13 15
set_cc_for_build() {
+ # prevent multiple calls if $tmp is already set
+ test "$tmp" && return 0
: "${TMPDIR=/tmp}"
# shellcheck disable=SC2039
{ tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
@@ -402,7 +404,7 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
# If there is a compiler, see if it is configured for 64-bit objects.
# Note that the Sun cc does not turn __LP64__ into 1 like gcc does.
# This test works for both compilers.
- if [ "$CC_FOR_BUILD" != no_compiler_found ]; then
+ if test "$CC_FOR_BUILD" != no_compiler_found; then
if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \
(CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
grep IS_64BIT_ARCH >/dev/null
@@ -542,10 +544,10 @@ EOF
AViiON:dgux:*:*)
# DG/UX returns AViiON for all architectures
UNAME_PROCESSOR=`/usr/bin/uname -p`
- if [ "$UNAME_PROCESSOR" = mc88100 ] || [ "$UNAME_PROCESSOR" = mc88110 ]
+ if test "$UNAME_PROCESSOR" = mc88100 || test "$UNAME_PROCESSOR" = mc88110
then
- if [ "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx ] || \
- [ "$TARGET_BINARY_INTERFACE"x = x ]
+ if test "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx || \
+ test "$TARGET_BINARY_INTERFACE"x = x
then
echo m88k-dg-dgux"$UNAME_RELEASE"
else
@@ -578,7 +580,7 @@ EOF
echo i386-ibm-aix
exit ;;
ia64:AIX:*:*)
- if [ -x /usr/bin/oslevel ] ; then
+ if test -x /usr/bin/oslevel ; then
IBM_REV=`/usr/bin/oslevel`
else
IBM_REV="$UNAME_VERSION.$UNAME_RELEASE"
@@ -618,7 +620,7 @@ EOF
else
IBM_ARCH=powerpc
fi
- if [ -x /usr/bin/lslpp ] ; then
+ if test -x /usr/bin/lslpp ; then
IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc |
awk -F: '{ print $3 }' | sed s/[0-9]*$/0/`
else
@@ -653,7 +655,7 @@ EOF
9000/31?) HP_ARCH=m68000 ;;
9000/[34]??) HP_ARCH=m68k ;;
9000/[678][0-9][0-9])
- if [ -x /usr/bin/getconf ]; then
+ if test -x /usr/bin/getconf; then
sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
case "$sc_cpu_version" in
@@ -667,7 +669,7 @@ EOF
esac ;;
esac
fi
- if [ "$HP_ARCH" = "" ]; then
+ if test "$HP_ARCH" = ""; then
set_cc_for_build
sed 's/^ //' << EOF > "$dummy.c"
@@ -706,7 +708,7 @@ EOF
test -z "$HP_ARCH" && HP_ARCH=hppa
fi ;;
esac
- if [ "$HP_ARCH" = hppa2.0w ]
+ if test "$HP_ARCH" = hppa2.0w
then
set_cc_for_build
@@ -780,7 +782,7 @@ EOF
echo hppa1.0-hp-osf
exit ;;
i*86:OSF1:*:*)
- if [ -x /usr/sbin/sysversion ] ; then
+ if test -x /usr/sbin/sysversion ; then
echo "$UNAME_MACHINE"-unknown-osf1mk
else
echo "$UNAME_MACHINE"-unknown-osf1
@@ -924,7 +926,7 @@ EOF
echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
exit ;;
alpha:Linux:*:*)
- case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
+ case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' /proc/cpuinfo 2>/dev/null` in
EV5) UNAME_MACHINE=alphaev5 ;;
EV56) UNAME_MACHINE=alphaev56 ;;
PCA56) UNAME_MACHINE=alphapca56 ;;
@@ -1093,7 +1095,17 @@ EOF
echo "$UNAME_MACHINE"-dec-linux-"$LIBC"
exit ;;
x86_64:Linux:*:*)
- echo "$UNAME_MACHINE"-pc-linux-"$LIBC"
+ set_cc_for_build
+ LIBCABI=$LIBC
+ if test "$CC_FOR_BUILD" != no_compiler_found; then
+ if (echo '#ifdef __ILP32__'; echo IS_X32; echo '#endif') | \
+ (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
+ grep IS_X32 >/dev/null
+ then
+ LIBCABI="$LIBC"x32
+ fi
+ fi
+ echo "$UNAME_MACHINE"-pc-linux-"$LIBCABI"
exit ;;
xtensa*:Linux:*:*)
echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
@@ -1282,7 +1294,7 @@ EOF
echo mips-sony-newsos6
exit ;;
R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
- if [ -d /usr/nec ]; then
+ if test -d /usr/nec; then
echo mips-nec-sysv"$UNAME_RELEASE"
else
echo mips-unknown-sysv"$UNAME_RELEASE"
@@ -1330,6 +1342,9 @@ EOF
*:Rhapsody:*:*)
echo "$UNAME_MACHINE"-apple-rhapsody"$UNAME_RELEASE"
exit ;;
+ arm64:Darwin:*:*)
+ echo aarch64-apple-darwin"$UNAME_RELEASE"
+ exit ;;
*:Darwin:*:*)
UNAME_PROCESSOR=`uname -p`
case $UNAME_PROCESSOR in
@@ -1344,7 +1359,7 @@ EOF
else
set_cc_for_build
fi
- if [ "$CC_FOR_BUILD" != no_compiler_found ]; then
+ if test "$CC_FOR_BUILD" != no_compiler_found; then
if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \
(CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
grep IS_64BIT_ARCH >/dev/null
@@ -1627,6 +1642,12 @@ copies of config.guess and config.sub with the latest versions from:
https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess
and
https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub
+EOF
+
+year=`echo $timestamp | sed 's,-.*,,'`
+# shellcheck disable=SC2003
+if test "`expr "\`date +%Y\`" - "$year"`" -lt 3 ; then
+ cat >&2 <<EOF
If $0 has already been updated, send the following data and any
information you think might be pertinent to config-patches@gnu.org to
@@ -1654,6 +1675,7 @@ UNAME_RELEASE = "$UNAME_RELEASE"
UNAME_SYSTEM = "$UNAME_SYSTEM"
UNAME_VERSION = "$UNAME_VERSION"
EOF
+fi
exit 1
diff --git a/build-aux/config.sub b/build-aux/config.sub
index df031b3c853..0753e308458 100755
--- a/build-aux/config.sub
+++ b/build-aux/config.sub
@@ -2,7 +2,7 @@
# Configuration validation subroutine script.
# Copyright 1992-2020 Free Software Foundation, Inc.
-timestamp='2019-06-30'
+timestamp='2020-08-17'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -67,7 +67,7 @@ Report bugs and patches to <config-patches@gnu.org>."
version="\
GNU config.sub ($timestamp)
-Copyright 1992-2019 Free Software Foundation, Inc.
+Copyright 1992-2020 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
@@ -124,28 +124,27 @@ case $1 in
;;
*-*-*-*)
basic_machine=$field1-$field2
- os=$field3-$field4
+ basic_os=$field3-$field4
;;
*-*-*)
# Ambiguous whether COMPANY is present, or skipped and KERNEL-OS is two
# parts
maybe_os=$field2-$field3
case $maybe_os in
- nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc \
- | linux-newlib* | linux-musl* | linux-uclibc* | uclinux-uclibc* \
+ nto-qnx* | linux-* | uclinux-uclibc* \
| uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* \
| netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \
| storm-chaos* | os2-emx* | rtmk-nova*)
basic_machine=$field1
- os=$maybe_os
+ basic_os=$maybe_os
;;
android-linux)
basic_machine=$field1-unknown
- os=linux-android
+ basic_os=linux-android
;;
*)
basic_machine=$field1-$field2
- os=$field3
+ basic_os=$field3
;;
esac
;;
@@ -154,7 +153,7 @@ case $1 in
case $field1-$field2 in
decstation-3100)
basic_machine=mips-dec
- os=
+ basic_os=
;;
*-*)
# Second component is usually, but not always the OS
@@ -162,7 +161,7 @@ case $1 in
# Prevent following clause from handling this valid os
sun*os*)
basic_machine=$field1
- os=$field2
+ basic_os=$field2
;;
# Manufacturers
dec* | mips* | sequent* | encore* | pc533* | sgi* | sony* \
@@ -175,11 +174,11 @@ case $1 in
| microblaze* | sim | cisco \
| oki | wec | wrs | winbond)
basic_machine=$field1-$field2
- os=
+ basic_os=
;;
*)
basic_machine=$field1
- os=$field2
+ basic_os=$field2
;;
esac
;;
@@ -191,447 +190,451 @@ case $1 in
case $field1 in
386bsd)
basic_machine=i386-pc
- os=bsd
+ basic_os=bsd
;;
a29khif)
basic_machine=a29k-amd
- os=udi
+ basic_os=udi
;;
adobe68k)
basic_machine=m68010-adobe
- os=scout
+ basic_os=scout
;;
alliant)
basic_machine=fx80-alliant
- os=
+ basic_os=
;;
altos | altos3068)
basic_machine=m68k-altos
- os=
+ basic_os=
;;
am29k)
basic_machine=a29k-none
- os=bsd
+ basic_os=bsd
;;
amdahl)
basic_machine=580-amdahl
- os=sysv
+ basic_os=sysv
;;
amiga)
basic_machine=m68k-unknown
- os=
+ basic_os=
;;
amigaos | amigados)
basic_machine=m68k-unknown
- os=amigaos
+ basic_os=amigaos
;;
amigaunix | amix)
basic_machine=m68k-unknown
- os=sysv4
+ basic_os=sysv4
;;
apollo68)
basic_machine=m68k-apollo
- os=sysv
+ basic_os=sysv
;;
apollo68bsd)
basic_machine=m68k-apollo
- os=bsd
+ basic_os=bsd
;;
aros)
basic_machine=i386-pc
- os=aros
+ basic_os=aros
;;
aux)
basic_machine=m68k-apple
- os=aux
+ basic_os=aux
;;
balance)
basic_machine=ns32k-sequent
- os=dynix
+ basic_os=dynix
;;
blackfin)
basic_machine=bfin-unknown
- os=linux
+ basic_os=linux
;;
cegcc)
basic_machine=arm-unknown
- os=cegcc
+ basic_os=cegcc
;;
convex-c1)
basic_machine=c1-convex
- os=bsd
+ basic_os=bsd
;;
convex-c2)
basic_machine=c2-convex
- os=bsd
+ basic_os=bsd
;;
convex-c32)
basic_machine=c32-convex
- os=bsd
+ basic_os=bsd
;;
convex-c34)
basic_machine=c34-convex
- os=bsd
+ basic_os=bsd
;;
convex-c38)
basic_machine=c38-convex
- os=bsd
+ basic_os=bsd
;;
cray)
basic_machine=j90-cray
- os=unicos
+ basic_os=unicos
;;
crds | unos)
basic_machine=m68k-crds
- os=
+ basic_os=
;;
da30)
basic_machine=m68k-da30
- os=
+ basic_os=
;;
decstation | pmax | pmin | dec3100 | decstatn)
basic_machine=mips-dec
- os=
+ basic_os=
;;
delta88)
basic_machine=m88k-motorola
- os=sysv3
+ basic_os=sysv3
;;
dicos)
basic_machine=i686-pc
- os=dicos
+ basic_os=dicos
;;
djgpp)
basic_machine=i586-pc
- os=msdosdjgpp
+ basic_os=msdosdjgpp
;;
ebmon29k)
basic_machine=a29k-amd
- os=ebmon
+ basic_os=ebmon
;;
es1800 | OSE68k | ose68k | ose | OSE)
basic_machine=m68k-ericsson
- os=ose
+ basic_os=ose
;;
gmicro)
basic_machine=tron-gmicro
- os=sysv
+ basic_os=sysv
;;
go32)
basic_machine=i386-pc
- os=go32
+ basic_os=go32
;;
h8300hms)
basic_machine=h8300-hitachi
- os=hms
+ basic_os=hms
;;
h8300xray)
basic_machine=h8300-hitachi
- os=xray
+ basic_os=xray
;;
h8500hms)
basic_machine=h8500-hitachi
- os=hms
+ basic_os=hms
;;
harris)
basic_machine=m88k-harris
- os=sysv3
+ basic_os=sysv3
;;
hp300 | hp300hpux)
basic_machine=m68k-hp
- os=hpux
+ basic_os=hpux
;;
hp300bsd)
basic_machine=m68k-hp
- os=bsd
+ basic_os=bsd
;;
hppaosf)
basic_machine=hppa1.1-hp
- os=osf
+ basic_os=osf
;;
hppro)
basic_machine=hppa1.1-hp
- os=proelf
+ basic_os=proelf
;;
i386mach)
basic_machine=i386-mach
- os=mach
+ basic_os=mach
;;
isi68 | isi)
basic_machine=m68k-isi
- os=sysv
+ basic_os=sysv
;;
m68knommu)
basic_machine=m68k-unknown
- os=linux
+ basic_os=linux
;;
magnum | m3230)
basic_machine=mips-mips
- os=sysv
+ basic_os=sysv
;;
merlin)
basic_machine=ns32k-utek
- os=sysv
+ basic_os=sysv
;;
mingw64)
basic_machine=x86_64-pc
- os=mingw64
+ basic_os=mingw64
;;
mingw32)
basic_machine=i686-pc
- os=mingw32
+ basic_os=mingw32
;;
mingw32ce)
basic_machine=arm-unknown
- os=mingw32ce
+ basic_os=mingw32ce
;;
monitor)
basic_machine=m68k-rom68k
- os=coff
+ basic_os=coff
;;
morphos)
basic_machine=powerpc-unknown
- os=morphos
+ basic_os=morphos
;;
moxiebox)
basic_machine=moxie-unknown
- os=moxiebox
+ basic_os=moxiebox
;;
msdos)
basic_machine=i386-pc
- os=msdos
+ basic_os=msdos
;;
msys)
basic_machine=i686-pc
- os=msys
+ basic_os=msys
;;
mvs)
basic_machine=i370-ibm
- os=mvs
+ basic_os=mvs
;;
nacl)
basic_machine=le32-unknown
- os=nacl
+ basic_os=nacl
;;
ncr3000)
basic_machine=i486-ncr
- os=sysv4
+ basic_os=sysv4
;;
netbsd386)
basic_machine=i386-pc
- os=netbsd
+ basic_os=netbsd
;;
netwinder)
basic_machine=armv4l-rebel
- os=linux
+ basic_os=linux
;;
news | news700 | news800 | news900)
basic_machine=m68k-sony
- os=newsos
+ basic_os=newsos
;;
news1000)
basic_machine=m68030-sony
- os=newsos
+ basic_os=newsos
;;
necv70)
basic_machine=v70-nec
- os=sysv
+ basic_os=sysv
;;
nh3000)
basic_machine=m68k-harris
- os=cxux
+ basic_os=cxux
;;
nh[45]000)
basic_machine=m88k-harris
- os=cxux
+ basic_os=cxux
;;
nindy960)
basic_machine=i960-intel
- os=nindy
+ basic_os=nindy
;;
mon960)
basic_machine=i960-intel
- os=mon960
+ basic_os=mon960
;;
nonstopux)
basic_machine=mips-compaq
- os=nonstopux
+ basic_os=nonstopux
;;
os400)
basic_machine=powerpc-ibm
- os=os400
+ basic_os=os400
;;
OSE68000 | ose68000)
basic_machine=m68000-ericsson
- os=ose
+ basic_os=ose
;;
os68k)
basic_machine=m68k-none
- os=os68k
+ basic_os=os68k
;;
paragon)
basic_machine=i860-intel
- os=osf
+ basic_os=osf
;;
parisc)
basic_machine=hppa-unknown
- os=linux
+ basic_os=linux
+ ;;
+ psp)
+ basic_machine=mipsallegrexel-sony
+ basic_os=psp
;;
pw32)
basic_machine=i586-unknown
- os=pw32
+ basic_os=pw32
;;
rdos | rdos64)
basic_machine=x86_64-pc
- os=rdos
+ basic_os=rdos
;;
rdos32)
basic_machine=i386-pc
- os=rdos
+ basic_os=rdos
;;
rom68k)
basic_machine=m68k-rom68k
- os=coff
+ basic_os=coff
;;
sa29200)
basic_machine=a29k-amd
- os=udi
+ basic_os=udi
;;
sei)
basic_machine=mips-sei
- os=seiux
+ basic_os=seiux
;;
sequent)
basic_machine=i386-sequent
- os=
+ basic_os=
;;
sps7)
basic_machine=m68k-bull
- os=sysv2
+ basic_os=sysv2
;;
st2000)
basic_machine=m68k-tandem
- os=
+ basic_os=
;;
stratus)
basic_machine=i860-stratus
- os=sysv4
+ basic_os=sysv4
;;
sun2)
basic_machine=m68000-sun
- os=
+ basic_os=
;;
sun2os3)
basic_machine=m68000-sun
- os=sunos3
+ basic_os=sunos3
;;
sun2os4)
basic_machine=m68000-sun
- os=sunos4
+ basic_os=sunos4
;;
sun3)
basic_machine=m68k-sun
- os=
+ basic_os=
;;
sun3os3)
basic_machine=m68k-sun
- os=sunos3
+ basic_os=sunos3
;;
sun3os4)
basic_machine=m68k-sun
- os=sunos4
+ basic_os=sunos4
;;
sun4)
basic_machine=sparc-sun
- os=
+ basic_os=
;;
sun4os3)
basic_machine=sparc-sun
- os=sunos3
+ basic_os=sunos3
;;
sun4os4)
basic_machine=sparc-sun
- os=sunos4
+ basic_os=sunos4
;;
sun4sol2)
basic_machine=sparc-sun
- os=solaris2
+ basic_os=solaris2
;;
sun386 | sun386i | roadrunner)
basic_machine=i386-sun
- os=
+ basic_os=
;;
sv1)
basic_machine=sv1-cray
- os=unicos
+ basic_os=unicos
;;
symmetry)
basic_machine=i386-sequent
- os=dynix
+ basic_os=dynix
;;
t3e)
basic_machine=alphaev5-cray
- os=unicos
+ basic_os=unicos
;;
t90)
basic_machine=t90-cray
- os=unicos
+ basic_os=unicos
;;
toad1)
basic_machine=pdp10-xkl
- os=tops20
+ basic_os=tops20
;;
tpf)
basic_machine=s390x-ibm
- os=tpf
+ basic_os=tpf
;;
udi29k)
basic_machine=a29k-amd
- os=udi
+ basic_os=udi
;;
ultra3)
basic_machine=a29k-nyu
- os=sym1
+ basic_os=sym1
;;
v810 | necv810)
basic_machine=v810-nec
- os=none
+ basic_os=none
;;
vaxv)
basic_machine=vax-dec
- os=sysv
+ basic_os=sysv
;;
vms)
basic_machine=vax-dec
- os=vms
+ basic_os=vms
;;
vsta)
basic_machine=i386-pc
- os=vsta
+ basic_os=vsta
;;
vxworks960)
basic_machine=i960-wrs
- os=vxworks
+ basic_os=vxworks
;;
vxworks68)
basic_machine=m68k-wrs
- os=vxworks
+ basic_os=vxworks
;;
vxworks29k)
basic_machine=a29k-wrs
- os=vxworks
+ basic_os=vxworks
;;
xbox)
basic_machine=i686-pc
- os=mingw32
+ basic_os=mingw32
;;
ymp)
basic_machine=ymp-cray
- os=unicos
+ basic_os=unicos
;;
*)
basic_machine=$1
- os=
+ basic_os=
;;
esac
;;
@@ -683,17 +686,17 @@ case $basic_machine in
bluegene*)
cpu=powerpc
vendor=ibm
- os=cnk
+ basic_os=cnk
;;
decsystem10* | dec10*)
cpu=pdp10
vendor=dec
- os=tops10
+ basic_os=tops10
;;
decsystem20* | dec20*)
cpu=pdp10
vendor=dec
- os=tops20
+ basic_os=tops20
;;
delta | 3300 | motorola-3300 | motorola-delta \
| 3300-motorola | delta-motorola)
@@ -703,7 +706,7 @@ case $basic_machine in
dpx2*)
cpu=m68k
vendor=bull
- os=sysv3
+ basic_os=sysv3
;;
encore | umax | mmax)
cpu=ns32k
@@ -712,7 +715,7 @@ case $basic_machine in
elxsi)
cpu=elxsi
vendor=elxsi
- os=${os:-bsd}
+ basic_os=${basic_os:-bsd}
;;
fx2800)
cpu=i860
@@ -725,7 +728,7 @@ case $basic_machine in
h3050r* | hiux*)
cpu=hppa1.1
vendor=hitachi
- os=hiuxwe2
+ basic_os=hiuxwe2
;;
hp3k9[0-9][0-9] | hp9[0-9][0-9])
cpu=hppa1.0
@@ -768,36 +771,36 @@ case $basic_machine in
i*86v32)
cpu=`echo "$1" | sed -e 's/86.*/86/'`
vendor=pc
- os=sysv32
+ basic_os=sysv32
;;
i*86v4*)
cpu=`echo "$1" | sed -e 's/86.*/86/'`
vendor=pc
- os=sysv4
+ basic_os=sysv4
;;
i*86v)
cpu=`echo "$1" | sed -e 's/86.*/86/'`
vendor=pc
- os=sysv
+ basic_os=sysv
;;
i*86sol2)
cpu=`echo "$1" | sed -e 's/86.*/86/'`
vendor=pc
- os=solaris2
+ basic_os=solaris2
;;
j90 | j90-cray)
cpu=j90
vendor=cray
- os=${os:-unicos}
+ basic_os=${basic_os:-unicos}
;;
iris | iris4d)
cpu=mips
vendor=sgi
- case $os in
+ case $basic_os in
irix*)
;;
*)
- os=irix4
+ basic_os=irix4
;;
esac
;;
@@ -808,26 +811,26 @@ case $basic_machine in
*mint | mint[0-9]* | *MiNT | *MiNT[0-9]*)
cpu=m68k
vendor=atari
- os=mint
+ basic_os=mint
;;
news-3600 | risc-news)
cpu=mips
vendor=sony
- os=newsos
+ basic_os=newsos
;;
next | m*-next)
cpu=m68k
vendor=next
- case $os in
+ case $basic_os in
openstep*)
;;
nextstep*)
;;
ns2*)
- os=nextstep2
+ basic_os=nextstep2
;;
*)
- os=nextstep3
+ basic_os=nextstep3
;;
esac
;;
@@ -838,12 +841,12 @@ case $basic_machine in
op50n-* | op60c-*)
cpu=hppa1.1
vendor=oki
- os=proelf
+ basic_os=proelf
;;
pa-hitachi)
cpu=hppa1.1
vendor=hitachi
- os=hiuxwe2
+ basic_os=hiuxwe2
;;
pbd)
cpu=sparc
@@ -880,12 +883,12 @@ case $basic_machine in
sde)
cpu=mipsisa32
vendor=sde
- os=${os:-elf}
+ basic_os=${basic_os:-elf}
;;
simso-wrs)
cpu=sparclite
vendor=wrs
- os=vxworks
+ basic_os=vxworks
;;
tower | tower-32)
cpu=m68k
@@ -902,7 +905,7 @@ case $basic_machine in
w89k-*)
cpu=hppa1.1
vendor=winbond
- os=proelf
+ basic_os=proelf
;;
none)
cpu=none
@@ -955,11 +958,11 @@ case $cpu-$vendor in
# some cases the only manufacturer, in others, it is the most popular.
craynv-unknown)
vendor=cray
- os=${os:-unicosmp}
+ basic_os=${basic_os:-unicosmp}
;;
c90-unknown | c90-cray)
vendor=cray
- os=${os:-unicos}
+ basic_os=${Basic_os:-unicos}
;;
fx80-unknown)
vendor=alliant
@@ -1003,7 +1006,7 @@ case $cpu-$vendor in
dpx20-unknown | dpx20-bull)
cpu=rs6000
vendor=bull
- os=${os:-bosx}
+ basic_os=${basic_os:-bosx}
;;
# Here we normalize CPU types irrespective of the vendor
@@ -1012,7 +1015,7 @@ case $cpu-$vendor in
;;
blackfin-*)
cpu=bfin
- os=linux
+ basic_os=linux
;;
c54x-*)
cpu=tic54x
@@ -1025,7 +1028,7 @@ case $cpu-$vendor in
;;
e500v[12]-*)
cpu=powerpc
- os=$os"spe"
+ basic_os=${basic_os}"spe"
;;
mips3*-*)
cpu=mips64
@@ -1035,7 +1038,7 @@ case $cpu-$vendor in
;;
m68knommu-*)
cpu=m68k
- os=linux
+ basic_os=linux
;;
m9s12z-* | m68hcs12z-* | hcs12z-* | s12z-*)
cpu=s12z
@@ -1045,7 +1048,7 @@ case $cpu-$vendor in
;;
parisc-*)
cpu=hppa
- os=linux
+ basic_os=linux
;;
pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
cpu=i586
@@ -1101,11 +1104,14 @@ case $cpu-$vendor in
xscale-* | xscalee[bl]-*)
cpu=`echo "$cpu" | sed 's/^xscale/arm/'`
;;
+ arm64-*)
+ cpu=aarch64
+ ;;
# Recognize the canonical CPU Types that limit and/or modify the
# company names they are paired with.
cr16-*)
- os=${os:-elf}
+ basic_os=${basic_os:-elf}
;;
crisv32-* | etraxfs*-*)
cpu=crisv32
@@ -1116,7 +1122,7 @@ case $cpu-$vendor in
vendor=axis
;;
crx-*)
- os=${os:-elf}
+ basic_os=${basic_os:-elf}
;;
neo-tandem)
cpu=neo
@@ -1138,16 +1144,12 @@ case $cpu-$vendor in
cpu=nsx
vendor=tandem
;;
- s390-*)
- cpu=s390
- vendor=ibm
- ;;
- s390x-*)
- cpu=s390x
- vendor=ibm
+ mipsallegrexel-sony)
+ cpu=mipsallegrexel
+ vendor=sony
;;
tile*-*)
- os=${os:-linux-gnu}
+ basic_os=${basic_os:-linux-gnu}
;;
*)
@@ -1164,7 +1166,7 @@ case $cpu-$vendor in
| am33_2.0 \
| amdgcn \
| arc | arceb \
- | arm | arm[lb]e | arme[lb] | armv* \
+ | arm | arm[lb]e | arme[lb] | armv* \
| avr | avr32 \
| asmjs \
| ba \
@@ -1229,6 +1231,7 @@ case $cpu-$vendor in
| pyramid \
| riscv | riscv32 | riscv64 \
| rl78 | romp | rs6000 | rx \
+ | s390 | s390x \
| score \
| sh | shl \
| sh[1234] | sh[24]a | sh[24]ae[lb] | sh[23]e | she[lb] | sh[lb]e \
@@ -1275,8 +1278,43 @@ esac
# Decode manufacturer-specific aliases for certain operating systems.
-if [ x$os != x ]
+if test x$basic_os != x
then
+
+# First recognize some ad-hoc caes, or perhaps split kernel-os, or else just
+# set os.
+case $basic_os in
+ gnu/linux*)
+ kernel=linux
+ os=`echo $basic_os | sed -e 's|gnu/linux|gnu|'`
+ ;;
+ nto-qnx*)
+ kernel=nto
+ os=`echo $basic_os | sed -e 's|nto-qnx|qnx|'`
+ ;;
+ *-*)
+ # shellcheck disable=SC2162
+ IFS="-" read kernel os <<EOF
+$basic_os
+EOF
+ ;;
+ # Default OS when just kernel was specified
+ nto*)
+ kernel=nto
+ os=`echo $basic_os | sed -e 's|nto|qnx|'`
+ ;;
+ linux*)
+ kernel=linux
+ os=`echo $basic_os | sed -e 's|linux|gnu|'`
+ ;;
+ *)
+ kernel=
+ os=$basic_os
+ ;;
+esac
+
+# Now, normalize the OS (knowing we just have one component, it's not a kernel,
+# etc.)
case $os in
# First match some system type aliases that might get confused
# with valid system types.
@@ -1296,9 +1334,6 @@ case $os in
unixware*)
os=sysv4.2uw
;;
- gnu/linux*)
- os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`
- ;;
# es1800 is here to avoid being matched by es* (a different OS)
es1800*)
os=ose
@@ -1322,10 +1357,7 @@ case $os in
sco3.2.[4-9]*)
os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
;;
- sco3.2v[4-9]* | sco5v6*)
- # Don't forget version if it is 3.2v4 or newer.
- ;;
- scout)
+ sco*v* | scout)
# Don't match below
;;
sco*)
@@ -1334,41 +1366,6 @@ case $os in
psos*)
os=psos
;;
- # Now accept the basic system types.
- # The portable systems comes first.
- # Each alternative MUST end in a * to match a version number.
- # sysv* is not here because it comes later, after sysvr4.
- gnu* | bsd* | mach* | minix* | genix* | ultrix* | irix* \
- | *vms* | esix* | aix* | cnk* | sunos | sunos[34]*\
- | hpux* | unos* | osf* | luna* | dgux* | auroraux* | solaris* \
- | sym* | kopensolaris* | plan9* \
- | amigaos* | amigados* | msdos* | newsos* | unicos* | aof* \
- | aos* | aros* | cloudabi* | sortix* | twizzler* \
- | nindy* | vxsim* | vxworks* | ebmon* | hms* | mvs* \
- | clix* | riscos* | uniplus* | iris* | isc* | rtu* | xenix* \
- | knetbsd* | mirbsd* | netbsd* \
- | bitrig* | openbsd* | solidbsd* | libertybsd* | os108* \
- | ekkobsd* | kfreebsd* | freebsd* | riscix* | lynxos* \
- | bosx* | nextstep* | cxux* | aout* | elf* | oabi* \
- | ptx* | coff* | ecoff* | winnt* | domain* | vsta* \
- | udi* | eabi* | lites* | ieee* | go32* | aux* | hcos* \
- | chorusrdb* | cegcc* | glidix* \
- | cygwin* | msys* | pe* | moss* | proelf* | rtems* \
- | midipix* | mingw32* | mingw64* | linux-gnu* | linux-android* \
- | linux-newlib* | linux-musl* | linux-uclibc* \
- | uxpv* | beos* | mpeix* | udk* | moxiebox* \
- | interix* | uwin* | mks* | rhapsody* | darwin* \
- | openstep* | oskit* | conix* | pw32* | nonstopux* \
- | storm-chaos* | tops10* | tenex* | tops20* | its* \
- | os2* | vos* | palmos* | uclinux* | nucleus* \
- | morphos* | superux* | rtmk* | windiss* \
- | powermax* | dnix* | nx6 | nx7 | sei* | dragonfly* \
- | skyos* | haiku* | rdos* | toppers* | drops* | es* \
- | onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \
- | midnightbsd* | amdhsa* | unleashed* | emscripten* | wasi* \
- | nsk* | powerunix)
- # Remember, each alternative MUST END IN *, to match a version number.
- ;;
qnx*)
case $cpu in
x86 | i*86)
@@ -1381,31 +1378,19 @@ case $os in
hiux*)
os=hiuxwe2
;;
- nto-qnx*)
- ;;
- nto*)
- os=`echo $os | sed -e 's|nto|nto-qnx|'`
- ;;
- sim | xray | os68k* | v88r* \
- | windows* | osx | abug | netware* | os9* \
- | macos* | mpw* | magic* | mmixware* | mon960* | lnews*)
- ;;
- linux-dietlibc)
- os=linux-dietlibc
- ;;
- linux*)
- os=`echo $os | sed -e 's|linux|linux-gnu|'`
- ;;
lynx*178)
os=lynxos178
;;
lynx*5)
os=lynxos5
;;
+ lynxos*)
+ # don't get caught up in next wildcard
+ ;;
lynx*)
os=lynxos
;;
- mac*)
+ mac[0-9]*)
os=`echo "$os" | sed -e 's|mac|macos|'`
;;
opened*)
@@ -1475,18 +1460,12 @@ case $os in
sysvr4)
os=sysv4
;;
- # This must come after sysvr4.
- sysv*)
- ;;
ose*)
os=ose
;;
*mint | mint[0-9]* | *MiNT | MiNT[0-9]*)
os=mint
;;
- zvmoe)
- os=zvmoe
- ;;
dicos*)
os=dicos
;;
@@ -1503,19 +1482,11 @@ case $os in
;;
esac
;;
- nacl*)
- ;;
- ios)
- ;;
- none)
- ;;
- *-eabi)
- ;;
*)
- echo Invalid configuration \`"$1"\': system \`"$os"\' not recognized 1>&2
- exit 1
+ # No normalization, but not necessarily accepted, that comes below.
;;
esac
+
else
# Here we handle the default operating systems that come with various machines.
@@ -1528,6 +1499,7 @@ else
# will signal an error saying that MANUFACTURER isn't an operating
# system, and we'll never get to this point.
+kernel=
case $cpu-$vendor in
score-*)
os=elf
@@ -1539,7 +1511,8 @@ case $cpu-$vendor in
os=riscix1.2
;;
arm*-rebel)
- os=linux
+ kernel=linux
+ os=gnu
;;
arm*-semi)
os=aout
@@ -1705,84 +1678,169 @@ case $cpu-$vendor in
os=none
;;
esac
+
fi
+# Now, validate our (potentially fixed-up) OS.
+case $os in
+ # Sometimes we do "kernel-abi", so those need to count as OSes.
+ musl* | newlib* | uclibc*)
+ ;;
+ # Likewise for "kernel-libc"
+ eabi | eabihf | gnueabi | gnueabihf)
+ ;;
+ # Now accept the basic system types.
+ # The portable systems comes first.
+ # Each alternative MUST end in a * to match a version number.
+ gnu* | android* | bsd* | mach* | minix* | genix* | ultrix* | irix* \
+ | *vms* | esix* | aix* | cnk* | sunos | sunos[34]* \
+ | hpux* | unos* | osf* | luna* | dgux* | auroraux* | solaris* \
+ | sym* | plan9* | psp* | sim* | xray* | os68k* | v88r* \
+ | hiux* | abug | nacl* | netware* | windows* \
+ | os9* | macos* | osx* | ios* \
+ | mpw* | magic* | mmixware* | mon960* | lnews* \
+ | amigaos* | amigados* | msdos* | newsos* | unicos* | aof* \
+ | aos* | aros* | cloudabi* | sortix* | twizzler* \
+ | nindy* | vxsim* | vxworks* | ebmon* | hms* | mvs* \
+ | clix* | riscos* | uniplus* | iris* | isc* | rtu* | xenix* \
+ | mirbsd* | netbsd* | dicos* | openedition* | ose* \
+ | bitrig* | openbsd* | solidbsd* | libertybsd* | os108* \
+ | ekkobsd* | freebsd* | riscix* | lynxos* | os400* \
+ | bosx* | nextstep* | cxux* | aout* | elf* | oabi* \
+ | ptx* | coff* | ecoff* | winnt* | domain* | vsta* \
+ | udi* | lites* | ieee* | go32* | aux* | hcos* \
+ | chorusrdb* | cegcc* | glidix* \
+ | cygwin* | msys* | pe* | moss* | proelf* | rtems* \
+ | midipix* | mingw32* | mingw64* | mint* \
+ | uxpv* | beos* | mpeix* | udk* | moxiebox* \
+ | interix* | uwin* | mks* | rhapsody* | darwin* \
+ | openstep* | oskit* | conix* | pw32* | nonstopux* \
+ | storm-chaos* | tops10* | tenex* | tops20* | its* \
+ | os2* | vos* | palmos* | uclinux* | nucleus* | morphos* \
+ | scout* | superux* | sysv* | rtmk* | tpf* | windiss* \
+ | powermax* | dnix* | nx6 | nx7 | sei* | dragonfly* \
+ | skyos* | haiku* | rdos* | toppers* | drops* | es* \
+ | onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \
+ | midnightbsd* | amdhsa* | unleashed* | emscripten* | wasi* \
+ | nsk* | powerunix* | genode* | zvmoe* )
+ ;;
+ # This one is extra strict with allowed versions
+ sco3.2v2 | sco3.2v[4-9]* | sco5v6*)
+ # Don't forget version if it is 3.2v4 or newer.
+ ;;
+ none)
+ ;;
+ *)
+ echo Invalid configuration \`"$1"\': OS \`"$os"\' not recognized 1>&2
+ exit 1
+ ;;
+esac
+
+# As a final step for OS-related things, validate the OS-kernel combination
+# (given a valid OS), if there is a kernel.
+case $kernel-$os in
+ linux-gnu* | linux-dietlibc* | linux-android* | linux-newlib* | linux-musl* | linux-uclibc* )
+ ;;
+ -dietlibc* | -newlib* | -musl* | -uclibc* )
+ # These are just libc implementations, not actual OSes, and thus
+ # require a kernel.
+ echo "Invalid configuration \`$1': libc \`$os' needs explicit kernel." 1>&2
+ exit 1
+ ;;
+ kfreebsd*-gnu* | kopensolaris*-gnu*)
+ ;;
+ nto-qnx*)
+ ;;
+ *-eabi* | *-gnueabi*)
+ ;;
+ -*)
+ # Blank kernel with real OS is always fine.
+ ;;
+ *-*)
+ echo "Invalid configuration \`$1': Kernel \`$kernel' not known to work with OS \`$os'." 1>&2
+ exit 1
+ ;;
+esac
+
# Here we handle the case where we know the os, and the CPU type, but not the
# manufacturer. We pick the logical manufacturer.
case $vendor in
unknown)
- case $os in
- riscix*)
+ case $cpu-$os in
+ *-riscix*)
vendor=acorn
;;
- sunos*)
+ *-sunos*)
vendor=sun
;;
- cnk*|-aix*)
+ *-cnk* | *-aix*)
vendor=ibm
;;
- beos*)
+ *-beos*)
vendor=be
;;
- hpux*)
+ *-hpux*)
vendor=hp
;;
- mpeix*)
+ *-mpeix*)
vendor=hp
;;
- hiux*)
+ *-hiux*)
vendor=hitachi
;;
- unos*)
+ *-unos*)
vendor=crds
;;
- dgux*)
+ *-dgux*)
vendor=dg
;;
- luna*)
+ *-luna*)
vendor=omron
;;
- genix*)
+ *-genix*)
vendor=ns
;;
- clix*)
+ *-clix*)
vendor=intergraph
;;
- mvs* | opened*)
+ *-mvs* | *-opened*)
+ vendor=ibm
+ ;;
+ *-os400*)
vendor=ibm
;;
- os400*)
+ s390-* | s390x-*)
vendor=ibm
;;
- ptx*)
+ *-ptx*)
vendor=sequent
;;
- tpf*)
+ *-tpf*)
vendor=ibm
;;
- vxsim* | vxworks* | windiss*)
+ *-vxsim* | *-vxworks* | *-windiss*)
vendor=wrs
;;
- aux*)
+ *-aux*)
vendor=apple
;;
- hms*)
+ *-hms*)
vendor=hitachi
;;
- mpw* | macos*)
+ *-mpw* | *-macos*)
vendor=apple
;;
- *mint | mint[0-9]* | *MiNT | MiNT[0-9]*)
+ *-*mint | *-mint[0-9]* | *-*MiNT | *-MiNT[0-9]*)
vendor=atari
;;
- vos*)
+ *-vos*)
vendor=stratus
;;
esac
;;
esac
-echo "$cpu-$vendor-$os"
+echo "$cpu-$vendor-${kernel:+$kernel-}$os"
exit
# Local variables:
diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog
index 511276757f5..be8082e7ffd 100755
--- a/build-aux/gitlog-to-changelog
+++ b/build-aux/gitlog-to-changelog
@@ -31,11 +31,11 @@
# are valid code in both sh and perl. When executed by sh, they re-execute
# the script through the perl program found in $PATH. The '-x' option
# is essential as well; without it, perl would re-execute the script
-# through /bin/sh. When executed by perl, the next two lines are a no-op.
+# through /bin/sh. When executed by perl, the next two lines are a no-op.
eval 'exec perl -wSx "$0" "$@"'
if 0;
-my $VERSION = '2018-03-07 03:47'; # UTC
+my $VERSION = '2020-04-04 15:07'; # UTC
# The definition above must lie within the first 8 lines in order
# for the Emacs time-stamp write hook (at end) to update it.
# If you change this file with Emacs, please let the write hook
diff --git a/build-aux/install-sh b/build-aux/install-sh
index 20d8b2eaea9..b34a8fc5ab9 100755
--- a/build-aux/install-sh
+++ b/build-aux/install-sh
@@ -1,7 +1,7 @@
#!/bin/sh
# install - install a program, script, or datafile
-scriptversion=2018-03-11.20; # UTC
+scriptversion=2020-07-26.22; # UTC
# This originates from X11R5 (mit/util/scripts/install.sh), which was
# later released in X11R6 (xc/config/util/install.sh) with the
@@ -69,6 +69,10 @@ posix_mkdir=
# Desired mode of installed file.
mode=0755
+# Create dirs (including intermediate dirs) using mode 755.
+# This is like GNU 'install' as of coreutils 8.32 (2020).
+mkdir_umask=22
+
chgrpcmd=
chmodcmd=$chmodprog
chowncmd=
@@ -301,22 +305,6 @@ do
if test $dstdir_status != 0; then
case $posix_mkdir in
'')
- # Create intermediate dirs using mode 755 as modified by the umask.
- # This is like FreeBSD 'install' as of 1997-10-28.
- umask=`umask`
- case $stripcmd.$umask in
- # Optimize common cases.
- *[2367][2367]) mkdir_umask=$umask;;
- .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;;
-
- *[0-7])
- mkdir_umask=`expr $umask + 22 \
- - $umask % 100 % 40 + $umask % 20 \
- - $umask % 10 % 4 + $umask % 2
- `;;
- *) mkdir_umask=$umask,go-w;;
- esac
-
# With -d, create the new directory with the user-specified mode.
# Otherwise, rely on $mkdir_umask.
if test -n "$dir_arg"; then
@@ -326,52 +314,49 @@ do
fi
posix_mkdir=false
- case $umask in
- *[123567][0-7][0-7])
- # POSIX mkdir -p sets u+wx bits regardless of umask, which
- # is incompatible with FreeBSD 'install' when (umask & 300) != 0.
- ;;
- *)
- # Note that $RANDOM variable is not portable (e.g. dash); Use it
- # here however when possible just to lower collision chance.
- tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
-
- trap 'ret=$?; rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" 2>/dev/null; exit $ret' 0
-
- # Because "mkdir -p" follows existing symlinks and we likely work
- # directly in world-writeable /tmp, make sure that the '$tmpdir'
- # directory is successfully created first before we actually test
- # 'mkdir -p' feature.
- if (umask $mkdir_umask &&
- $mkdirprog $mkdir_mode "$tmpdir" &&
- exec $mkdirprog $mkdir_mode -p -- "$tmpdir/a/b") >/dev/null 2>&1
- then
- if test -z "$dir_arg" || {
- # Check for POSIX incompatibilities with -m.
- # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
- # other-writable bit of parent directory when it shouldn't.
- # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
- test_tmpdir="$tmpdir/a"
- ls_ld_tmpdir=`ls -ld "$test_tmpdir"`
- case $ls_ld_tmpdir in
- d????-?r-*) different_mode=700;;
- d????-?--*) different_mode=755;;
- *) false;;
- esac &&
- $mkdirprog -m$different_mode -p -- "$test_tmpdir" && {
- ls_ld_tmpdir_1=`ls -ld "$test_tmpdir"`
- test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
- }
- }
- then posix_mkdir=:
- fi
- rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir"
- else
- # Remove any dirs left behind by ancient mkdir implementations.
- rmdir ./$mkdir_mode ./-p ./-- "$tmpdir" 2>/dev/null
- fi
- trap '' 0;;
- esac;;
+ # The $RANDOM variable is not portable (e.g., dash). Use it
+ # here however when possible just to lower collision chance.
+ tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
+
+ trap '
+ ret=$?
+ rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" 2>/dev/null
+ exit $ret
+ ' 0
+
+ # Because "mkdir -p" follows existing symlinks and we likely work
+ # directly in world-writeable /tmp, make sure that the '$tmpdir'
+ # directory is successfully created first before we actually test
+ # 'mkdir -p'.
+ if (umask $mkdir_umask &&
+ $mkdirprog $mkdir_mode "$tmpdir" &&
+ exec $mkdirprog $mkdir_mode -p -- "$tmpdir/a/b") >/dev/null 2>&1
+ then
+ if test -z "$dir_arg" || {
+ # Check for POSIX incompatibilities with -m.
+ # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
+ # other-writable bit of parent directory when it shouldn't.
+ # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
+ test_tmpdir="$tmpdir/a"
+ ls_ld_tmpdir=`ls -ld "$test_tmpdir"`
+ case $ls_ld_tmpdir in
+ d????-?r-*) different_mode=700;;
+ d????-?--*) different_mode=755;;
+ *) false;;
+ esac &&
+ $mkdirprog -m$different_mode -p -- "$test_tmpdir" && {
+ ls_ld_tmpdir_1=`ls -ld "$test_tmpdir"`
+ test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
+ }
+ }
+ then posix_mkdir=:
+ fi
+ rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir"
+ else
+ # Remove any dirs left behind by ancient mkdir implementations.
+ rmdir ./$mkdir_mode ./-p ./-- "$tmpdir" 2>/dev/null
+ fi
+ trap '' 0;;
esac
if
@@ -382,7 +367,7 @@ do
then :
else
- # The umask is ridiculous, or mkdir does not conform to POSIX,
+ # mkdir does not conform to POSIX,
# or it failed possibly due to a race condition. Create the
# directory the slow way, step by step, checking for races as we go.
@@ -411,7 +396,7 @@ do
prefixes=
else
if $posix_mkdir; then
- (umask=$mkdir_umask &&
+ (umask $mkdir_umask &&
$doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
# Don't fail if two instances are running concurrently.
test -d "$prefix" || exit 1
diff --git a/build-aux/update-copyright b/build-aux/update-copyright
index 4f79b56be78..d9b7f683a08 100755
--- a/build-aux/update-copyright
+++ b/build-aux/update-copyright
@@ -133,11 +133,11 @@
# are valid code in both sh and perl. When executed by sh, they re-execute
# the script through the perl program found in $PATH. The '-x' option
# is essential as well; without it, perl would re-execute the script
-# through /bin/sh. When executed by perl, the next two lines are a no-op.
+# through /bin/sh. When executed by perl, the next two lines are a no-op.
eval 'exec perl -wSx -0777 -pi "$0" "$@"'
if 0;
-my $VERSION = '2018-03-07.03:47'; # UTC
+my $VERSION = '2020-04-04.15:07'; # UTC
# The definition above must lie within the first 8 lines in order
# for the Emacs time-stamp write hook (at end) to update it.
# If you change this file with Emacs, please let the write hook
diff --git a/build-aux/update-subdirs b/build-aux/update-subdirs
index 336029fb710..96712f0b32e 100755
--- a/build-aux/update-subdirs
+++ b/build-aux/update-subdirs
@@ -26,7 +26,7 @@ for file in *; do
*.elc | *.el | term | RCS | CVS | Old | . | .. | =* | *~ | *.orig | *.rej)
;;
*)
- if [ -d $file ]; then
+ if [ -d "$file" ]; then
if [ "$file" = "obsolete" ]; then
subdirs="$subdirs \"$file\""
else
diff --git a/configure.ac b/configure.ac
index ff159726aa2..f0c8e5210f9 100644
--- a/configure.ac
+++ b/configure.ac
@@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
AC_PREREQ(2.65)
dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el.
-AC_INIT(GNU Emacs, 27.1.50, bug-gnu-emacs@gnu.org, , https://www.gnu.org/software/emacs/)
+AC_INIT(GNU Emacs, 28.0.50, bug-gnu-emacs@gnu.org, , https://www.gnu.org/software/emacs/)
dnl Set emacs_config_options to the options of 'configure', quoted for the shell,
dnl and then quoted again for a C string. Separate options with spaces.
@@ -219,6 +219,21 @@ AC_DEFUN([OPTION_DEFAULT_OFF], [dnl
m4_bpatsubst([with_$1], [[^0-9a-z]], [_])=no])dnl
])dnl
+dnl OPTION_DEFAULT_IFAVAILABLE(NAME, HELP-STRING)
+dnl Create a new --with option that defaults to 'ifavailable'.
+dnl NAME is the base name of the option. The shell variable with_NAME
+dnl will be set to either the user's value (if the option is
+dnl specified; 'yes' for a plain --with-NAME) or to 'ifavailable' (if the
+dnl option is not specified). Note that the shell variable name is
+dnl constructed as autoconf does, by replacing non-alphanumeric
+dnl characters with "_".
+dnl HELP-STRING is the help text for the option.
+AC_DEFUN([OPTION_DEFAULT_IFAVAILABLE], [dnl
+ AC_ARG_WITH([$1],[AS_HELP_STRING([--with-$1],[$2])],[],[dnl
+ m4_bpatsubst([with_$1], [[^0-9a-z]], [_])=ifavailable])dnl
+])dnl
+
+
dnl OPTION_DEFAULT_ON(NAME, HELP-STRING)
dnl Create a new --with option that defaults to $with_features.
dnl NAME is the base name of the option. The shell variable with_NAME
@@ -414,7 +429,11 @@ this option's value should be 'yes', 'no', 'lucid', 'athena', 'motif', 'gtk',
with_x_toolkit=$val
])
-OPTION_DEFAULT_OFF([wide-int], [prefer wide Emacs integers (typically 62-bit); allows buffer and string size up to 2GB on 32-bit hosts, at the cost of 10% to 30% slowdown of Lisp interpreter and larger memory footprint])
+OPTION_DEFAULT_OFF([wide-int],
+ [prefer wide Emacs integers (typically 62-bit);
+ on 32-bit hosts, this allows buffer and string size up to 2GB,
+ at the cost of 10% to 30% slowdown of Lisp interpreter
+ and larger memory footprint])
if test "$with_wide_int" = yes; then
AC_DEFINE([WIDE_EMACS_INT], 1, [Use long long for EMACS_INT if available.])
fi
@@ -430,10 +449,11 @@ OPTION_DEFAULT_ON([png],[don't compile with PNG image support])
OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support])
OPTION_DEFAULT_ON([lcms2],[don't compile with Little CMS support])
OPTION_DEFAULT_ON([libsystemd],[don't compile with libsystemd support])
-OPTION_DEFAULT_OFF([cairo],[compile with Cairo drawing])
+OPTION_DEFAULT_ON([cairo],[don't compile with Cairo drawing])
OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support])
OPTION_DEFAULT_OFF([imagemagick],[compile with ImageMagick image support])
-OPTION_DEFAULT_ON([json], [don't compile with native JSON support])
+OPTION_DEFAULT_ON([native-image-api], [don't use native image APIs (GDI+ on Windows)])
+OPTION_DEFAULT_IFAVAILABLE([json], [compile with native JSON support])
OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts])
OPTION_DEFAULT_ON([harfbuzz],[don't use HarfBuzz for text shaping])
@@ -443,6 +463,7 @@ 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([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])
AC_ARG_WITH([ns],[AS_HELP_STRING([--with-ns],
[use Nextstep (macOS Cocoa or GNUstep) windowing system.
On by default on macOS.])],[],[with_ns=maybe])
@@ -484,7 +505,7 @@ otherwise for the first of 'inotify', 'kqueue' or 'gfile' that is usable.])
[with_file_notification=$with_features])
OPTION_DEFAULT_OFF([xwidgets],
- [enable use of some gtk widgets in Emacs buffers (requires gtk3)])
+ [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.
@@ -703,7 +724,7 @@ case "${canonical}" in
*-apple-darwin* )
case "${canonical}" in
*-apple-darwin[0-9].*) unported=yes ;;
- i[3456]86-* | x86_64-* ) ;;
+ i[3456]86-* | x86_64-* | arm-* | aarch64-* ) ;;
* ) unported=yes ;;
esac
opsys=darwin
@@ -743,54 +764,28 @@ case "${canonical}" in
opsys=aix4-2
;;
- ## Suns
- *-sun-solaris* \
- | i[3456]86-*-solaris2* | i[3456]86-*-sunos5* \
- | x86_64-*-solaris2* | x86_64-*-sunos5*)
+ ## Solaris
+ *-*-solaris* | *-*-sunos*)
case "${canonical}" in
i[3456]86-*-* ) ;;
amd64-*-*|x86_64-*-*) ;;
sparc* ) ;;
* ) unported=yes ;;
esac
- case "${canonical}" in
- *-sunos5.[1-9][0-9]* | *-solaris2.[1-9][0-9]* )
- opsys=sol2-10
- emacs_check_sunpro_c=yes
- ;;
- *-sunos5.[1-5]* | *-solaris2.[1-5]* ) unported=yes ;;
- ## Note that Emacs 23.1's NEWS said the following would be dropped.
- *-sunos5.6* | *-solaris2.6* )
- opsys=sol2-6
- RANLIB="ar -ts"
- ;;
- ## 5.7 EOL Aug 2008, 5.8 EOL Mar 2012.
- *-sunos5.[7-9]* | *-solaris2.[7-9]* )
- opsys=sol2-6
- emacs_check_sunpro_c=yes
- ;;
- esac
+ opsys=solaris
## Watch out for a compiler that we know will not work.
- case "${canonical}" in
- *-solaris* | *-sunos5* )
- if [ "x$CC" = x/usr/ucb/cc ]; then
- ## /usr/ucb/cc doesn't work;
- ## we should find some other compiler that does work.
- unset CC
- fi
- ;;
- *) ;;
- esac
+ if [ "$CC" = /usr/ucb/cc ]; then
+ ## /usr/ucb/cc doesn't work;
+ ## we should find some other compiler that does work.
+ unset CC
+ fi
;;
## QNX Neutrino
*-nto-qnx* )
opsys=qnxnto
test -z "$CC" && CC=qcc
- CFLAGS="$CFLAGS -D__NO_EXT_QNX"
- if test "$with_unexec" = yes; then
- LDFLAGS="-N2MB $LDFLAGS"
- fi
+ LDFLAGS="-N2M $LDFLAGS"
;;
## Intel 386 machines where we don't care about the manufacturer.
@@ -882,11 +877,6 @@ for func in $ac_func_list; do
test $func = pthread_sigmask || AS_VAR_APPEND([funcs], [" $func"])
done
ac_func_list=$funcs
-# Use the system putenv even if it lacks GNU features, as we don't need them,
-# and the gnulib replacement runs afoul of a FreeBSD 10.1 bug; see Bug#19874.
-AC_CHECK_FUNCS_ONCE([putenv])
-AC_DEFUN([gl_FUNC_PUTENV],
- [test "$ac_cv_func_putenv" = yes || REPLACE_PUTENV=1])
# Emacs does not use the wchar or wctype-h modules.
AC_DEFUN([gt_TYPE_WINT_T],
[GNULIB_OVERRIDES_WINT_T=0
@@ -1030,14 +1020,20 @@ AS_IF([test $gl_gcc_warnings = no],
;;
esac
AS_IF([test $gl_gcc_warnings = yes],
- [WERROR_CFLAGS=-Werror])
-
- nw="$nw -Wcast-align -Wcast-align=strict" # Emacs is tricky with pointers.
+ [WERROR_CFLAGS=-Werror],
+ [# Use -fanalyzer and related options only if --enable-gcc-warnings,
+ # as they slow GCC considerably.
+ nw="$nw -fanalyzer -Wno-analyzer-double-free -Wno-analyzer-malloc-leak"
+ nw="$nw -Wno-analyzer-null-dereference -Wno-analyzer-use-after-free"
+ # Use -Wsuggest-attribute=malloc only if --enable-gcc-warnings,
+ # as it doesn't flag code that is wrong in any way.
+ nw="$nw -Wsuggest-attribute=malloc"])
+
+ nw="$nw -Wcast-align=strict" # Emacs is tricky with pointers.
nw="$nw -Wduplicated-branches" # Too many false alarms
nw="$nw -Wformat-overflow=2" # False alarms due to GCC bug 80776
nw="$nw -Wsystem-headers" # Don't let system headers trigger warnings
nw="$nw -Woverlength-strings" # Not a problem these days
- nw="$nw -Wformat-nonliteral" # we do this a lot
nw="$nw -Wvla" # Emacs uses <vla.h>.
nw="$nw -Wunused-const-variable=2" # lisp.h declares const objects.
nw="$nw -Winline" # OK to ignore 'inline'
@@ -1046,7 +1042,6 @@ AS_IF([test $gl_gcc_warnings = no],
nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning
nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations
nw="$nw -Wbad-function-cast" # These casts are no worse than others.
- nw="$nw -Wabi" # Not useful, perceived as noise
# Emacs doesn't care about shadowing; see
# <https://lists.gnu.org/r/emacs-diffs/2011-11/msg00265.html>.
@@ -1066,26 +1061,12 @@ AS_IF([test $gl_gcc_warnings = no],
# option problematic.
nw="$nw -Wsuggest-attribute=pure"
- # This part is merely for shortening the command line,
- # since -Wall implies -Wswitch.
- nw="$nw -Wswitch"
-
- # This part is merely for shortening the command line,
- # since -Wno-FOO needs to be added below regardless.
- nw="$nw -Wmissing-field-initializers"
- nw="$nw -Woverride-init"
- nw="$nw -Wtype-limits"
- nw="$nw -Wunused-parameter"
-
if test "$emacs_cv_clang" = yes; then
- nw="$nw -Wcast-align"
nw="$nw -Wdouble-promotion"
- nw="$nw -Wmissing-braces"
fi
- # These cause too much noise in the MinGW build
+ # This causes too much noise in the MinGW build.
if test $opsys = mingw32; then
- nw="$nw -Wpointer-sign"
nw="$nw -Wsuggest-attribute=format"
fi
@@ -1251,18 +1232,12 @@ emacs_cv_ln_s_fileonly='cp -p'
dnl On MinGW, ensure we will call the MSYS /bin/ln.exe, not some
dnl random program in the current directory.
if (echo >conf$$.file) 2>/dev/null; then
- if ln -s conf$$.file conf$$ 2>/dev/null; then
- if test "$opsys" = "mingw32"; then
- emacs_cv_ln_s_fileonly='/bin/ln -s'
- else
- emacs_cv_ln_s_fileonly='ln -s'
- fi
+ if test "$opsys" = "mingw32"; then
+ emacs_cv_ln_s_fileonly=/bin/ln
+ elif ln -s conf$$.file conf$$ 2>/dev/null; then
+ emacs_cv_ln_s_fileonly='ln -s'
elif ln conf$$.file conf$$ 2>/dev/null; then
- if test "$opsys" = "mingw32"; then
- emacs_cv_ln_s_fileonly=/bin/ln
- else
- emacs_cv_ln_s_fileonly=ln
- fi
+ emacs_cv_ln_s_fileonly=ln
fi
fi
@@ -1494,20 +1469,18 @@ case "$opsys" in
mingw32)
UNEXEC_OBJ=unexw32.o
;;
- sol2-10)
+ solaris)
# Use the Solaris dldump() function, called from unexsol.c, to dump
# emacs, instead of the generic ELF dump code found in unexelf.c.
# The resulting binary has a complete symbol table, and is better
# for debugging and other observability tools (debuggers, pstack, etc).
- #
- # It is likely that dldump() works with older Solaris too, but this has
- # not been tested, so for now this change is for Solaris 10 or newer.
UNEXEC_OBJ=unexsol.o
;;
*)
UNEXEC_OBJ=unexelf.o
;;
esac
+AC_SUBST(UNEXEC_OBJ)
LD_SWITCH_SYSTEM=
test "$with_unexec" = no || case "$opsys" in
@@ -1561,8 +1534,6 @@ C_SWITCH_MACHINE=
test $with_unexec = yes &&
case $canonical in
alpha*)
- AC_CHECK_DECL([__ELF__])
- if test "$ac_cv_have_decl___ELF__" = "yes"; then
## With ELF, make sure that all common symbols get allocated to in the
## data section. Otherwise, the dump of temacs may miss variables in
## the shared library that have been initialized. For example, with
@@ -1573,18 +1544,10 @@ case $canonical in
else
AC_MSG_ERROR([Non-GCC compilers are not supported.])
fi
- else
- dnl This was the unexalpha.c case. Removed in 24.1, 2010-07-24,
- dnl albeit under the mistaken assumption that said file
- dnl was no longer used.
- AC_MSG_ERROR([Non-ELF systems are not supported since Emacs 24.1.])
- fi
;;
esac
AC_SUBST(C_SWITCH_MACHINE)
-AC_SUBST(UNEXEC_OBJ)
-
C_SWITCH_SYSTEM=
## Some programs in src produce warnings saying certain subprograms
## are too complex and need a MAXMEM value greater than 2000 for
@@ -1613,7 +1576,7 @@ case "$opsys" in
qnxnto) LIBS_SYSTEM="-lsocket" ;;
- sol2*) LIBS_SYSTEM="-lsocket -lnsl" ;;
+ solaris) LIBS_SYSTEM="-lsocket -lnsl" ;;
## Motif needs -lgen.
unixware) LIBS_SYSTEM="-lsocket -lnsl -lelf -lgen" ;;
@@ -1674,7 +1637,7 @@ case $opsys in
SYSTEM_TYPE=berkeley-unix
;;
- sol2* | unixware )
+ solaris | unixware )
SYSTEM_TYPE=usg-unix-v
;;
@@ -1767,7 +1730,8 @@ AC_CHECK_HEADERS_ONCE(
sys/sysinfo.h
coff.h pty.h
sys/resource.h
- sys/utsname.h pwd.h utmp.h util.h)
+ sys/utsname.h pwd.h utmp.h util.h
+ sanitizer/lsan_interface.h)
AC_CACHE_CHECK([for ADDR_NO_RANDOMIZE],
[emacs_cv_personality_addr_no_randomize],
@@ -1806,13 +1770,6 @@ 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_CHECK_DECLS([sys_siglist], [], [], [[#include <signal.h>
- ]])
-if test $ac_cv_have_decl_sys_siglist != yes; then
- # For Tru64, at least:
- AC_CHECK_DECLS([__sys_siglist], [], [], [[#include <signal.h>
- ]])
-fi
AC_HEADER_SYS_WAIT
AC_CHECK_HEADERS_ONCE(sys/socket.h)
@@ -1929,6 +1886,8 @@ else
bitmapdir=${bmd_acc#:}
fi
+NATIVE_IMAGE_API=no
+
test "${with_ns}" = maybe && test "${opsys}" != darwin && with_ns=no
HAVE_NS=no
NS_GNUSTEP_CONFIG=no
@@ -1938,7 +1897,7 @@ tmp_CPPFLAGS="$CPPFLAGS"
tmp_CFLAGS="$CFLAGS"
CPPFLAGS="$CPPFLAGS -x objective-c"
CFLAGS="$CFLAGS -x objective-c"
-GNU_OBJC_CFLAGS=
+GNU_OBJC_CFLAGS=""
LIBS_GNUSTEP=
if test "${with_ns}" != no; then
# macfont.o requires macuvs.h which is absent after 'make extraclean',
@@ -1954,7 +1913,7 @@ if test "${with_ns}" != no; then
elif flags=$( (gnustep-config --objc-flags) 2>/dev/null); then
NS_IMPL_GNUSTEP=yes
NS_GNUSTEP_CONFIG=yes
- GNU_OBJC_CFLAGS=$flags
+ GNU_OBJC_CFLAGS="$flags"
LIBS_GNUSTEP=$(gnustep-config --gui-libs) || exit
elif test -f $GNUSTEP_CONFIG_FILE; then
NS_IMPL_GNUSTEP=yes
@@ -1999,7 +1958,7 @@ fail;
dnl _NATIVE_OBJC_EXCEPTIONS is used by the GNUstep headers.
AC_DEFINE(_NATIVE_OBJC_EXCEPTIONS, 1,
[Define if GNUstep uses ObjC exceptions.])
- GNU_OBJC_CFLAGS="-fobjc-exceptions"
+ GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -fobjc-exceptions"
fi
fi
if test $NS_IMPL_GNUSTEP = yes; then
@@ -2040,6 +1999,11 @@ Either fix this, or re-configure with the option '--without-ns'.])])
AC_MSG_ERROR([Mac OS X 10.6 or newer is required]);
fi
fi
+
+ if test "${with_native_image_api}" = yes; then
+ AC_DEFINE(HAVE_NATIVE_IMAGE_API, 1, [Define to use native OS APIs for images.])
+ NATIVE_IMAGE_API="yes (ns)"
+ fi
fi
AC_SUBST(LIBS_GNUSTEP)
@@ -2050,7 +2014,7 @@ NS_OBJ=
NS_OBJC_OBJ=
if test "${HAVE_NS}" = yes; then
if test "$with_toolkit_scroll_bars" = "no"; then
- AC_MSG_ERROR([Non-toolkit scroll bars are not implemented for Nextstep.])
+ AC_MSG_WARN([Non-toolkit scroll bars are not implemented for Nextstep.])
fi
window_system=nextstep
@@ -2099,6 +2063,20 @@ if test "${HAVE_NS}" = yes; then
AC_DEFINE(NATIVE_OBJC_INSTANCETYPE, 1,
[Define if ObjC compiler supports instancetype natively.])
fi
+
+ AC_CACHE_CHECK(
+ [if the Objective C compiler defaults to C99],
+ [emacs_cv_objc_c99],
+ [AC_LANG_PUSH([Objective C])
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([], [[for (int i = 0;;);]])],
+ emacs_cv_objc_c99=yes,
+ emacs_cv_objc_c99=no)
+ AC_LANG_POP([Objective C])])
+
+ if test x$emacs_cv_objc_c99 = xno ; then
+ GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -std=c99"
+ fi
fi
HAVE_W32=no
@@ -2175,6 +2153,13 @@ if test "${HAVE_W32}" = "yes"; then
W32_RES_LINK="-Wl,emacs.res"
else
W32_OBJ="$W32_OBJ w32.o w32console.o w32heap.o w32inevt.o w32proc.o"
+ dnl FIXME: This should probably be supported for Cygwin/w32 as
+ dnl well, but the Cygwin build needs to link against -lgdiplus
+ if test "${with_native_image_api}" = yes; then
+ AC_DEFINE(HAVE_NATIVE_IMAGE_API, 1, [Define to use native OS APIs for images.])
+ NATIVE_IMAGE_API="yes (w32)"
+ W32_OBJ="$W32_OBJ w32image.o"
+ fi
W32_LIBS="$W32_LIBS -lwinmm -lusp10 -lgdi32 -lcomdlg32"
W32_LIBS="$W32_LIBS -lmpr -lwinspool -lole32 -lcomctl32"
W32_RES_LINK="\$(EMACSRES)"
@@ -2303,7 +2288,7 @@ system_malloc=yes
test $with_unexec = yes &&
case "$opsys" in
## darwin ld insists on the use of malloc routines in the System framework.
- darwin | mingw32 | nacl | sol2-10) ;;
+ darwin | mingw32 | nacl | solaris) ;;
cygwin | qnxnto | freebsd)
hybrid_malloc=yes
system_malloc= ;;
@@ -2439,7 +2424,7 @@ if test "$ac_cv_header_pthread_h" && test "$opsys" != "mingw32"; then
# need special flags to disable these optimizations. For example, the
# definition of 'errno' in <errno.h>.
case $opsys in
- hpux* | sol*)
+ hpux* | solaris)
AC_DEFINE([_REENTRANT], 1,
[Define to 1 if your system requires this in multithreaded code.]);;
aix4-2)
@@ -2569,7 +2554,7 @@ fail;
## inoue@ainet.or.jp says Solaris has a bug related to X11R6-style
## XIM support.
case "$opsys" in
- sol2-*) : ;;
+ solaris) : ;;
*) AC_DEFINE(HAVE_X11R6_XIM, 1,
[Define if you have usable X11R6-style XIM support.])
;;
@@ -2792,20 +2777,34 @@ fi
dnl Enable xwidgets if GTK3 and WebKitGTK+ are available.
+dnl Enable xwidgets if macOS Cocoa and WebKit framework are available.
HAVE_XWIDGETS=no
XWIDGETS_OBJ=
if test "$with_xwidgets" != "no"; then
- test "$USE_GTK_TOOLKIT" = "GTK3" && test "$window_system" != "none" ||
- AC_MSG_ERROR([xwidgets requested but gtk3 not used.])
+ if test "$USE_GTK_TOOLKIT" = "GTK3" && test "$window_system" != "none"; then
+ WEBKIT_REQUIRED=2.12
+ WEBKIT_MODULES="webkit2gtk-4.0 >= $WEBKIT_REQUIRED"
+ EMACS_CHECK_MODULES([WEBKIT], [$WEBKIT_MODULES])
+ HAVE_XWIDGETS=$HAVE_WEBKIT
+ XWIDGETS_OBJ="xwidget.o"
+ elif test "${NS_IMPL_COCOA}" = "yes"; then
+ dnl FIXME: Check framework WebKit2
+ dnl WEBKIT_REQUIRED=M.m.p
+ WEBKIT_LIBS="-Wl,-framework -Wl,WebKit"
+ WEBKIT_CFLAGS="-I/System/Library/Frameworks/WebKit.framework/Headers"
+ HAVE_WEBKIT="yes"
+ HAVE_XWIDGETS=$HAVE_WEBKIT
+ XWIDGETS_OBJ="xwidget.o"
+ NS_OBJC_OBJ="$NS_OBJC_OBJ nsxwidget.o"
+ dnl Update NS_OBJC_OBJ with added nsxwidget.o
+ AC_SUBST(NS_OBJC_OBJ)
+ else
+ AC_MSG_ERROR([xwidgets requested, it requires GTK3 as X window toolkit or macOS Cocoa as window system.])
+ fi
- WEBKIT_REQUIRED=2.12
- WEBKIT_MODULES="webkit2gtk-4.0 >= $WEBKIT_REQUIRED"
- EMACS_CHECK_MODULES([WEBKIT], [$WEBKIT_MODULES])
- HAVE_XWIDGETS=$HAVE_WEBKIT
test $HAVE_XWIDGETS = yes ||
- AC_MSG_ERROR([xwidgets requested but WebKitGTK+ not found.])
+ AC_MSG_ERROR([xwidgets requested but WebKitGTK+ or WebKit framework not found.])
- XWIDGETS_OBJ=xwidget.o
AC_DEFINE([HAVE_XWIDGETS], 1, [Define to 1 if you have xwidgets support.])
fi
AC_SUBST(XWIDGETS_OBJ)
@@ -2950,7 +2949,7 @@ AC_SUBST(LIBSYSTEMD_CFLAGS)
HAVE_JSON=no
JSON_OBJ=
-if test "${with_json}" = yes; then
+if test "${with_json}" != no; then
EMACS_CHECK_MODULES([JSON], [jansson >= 2.7],
[HAVE_JSON=yes], [HAVE_JSON=no])
if test "${HAVE_JSON}" = yes; then
@@ -3309,14 +3308,13 @@ if test "${HAVE_X11}" = "yes"; then
EMACS_CHECK_MODULES(CAIRO, $CAIRO_MODULE)
if test $HAVE_CAIRO = yes; then
AC_DEFINE(USE_CAIRO, 1, [Define to 1 if using cairo.])
+ CFLAGS="$CFLAGS $CAIRO_CFLAGS"
+ LIBS="$LIBS $CAIRO_LIBS"
+ AC_SUBST(CAIRO_CFLAGS)
+ AC_SUBST(CAIRO_LIBS)
else
- AC_MSG_ERROR([cairo requested but not found.])
+ AC_MSG_WARN([cairo requested but not found.])
fi
-
- CFLAGS="$CFLAGS $CAIRO_CFLAGS"
- LIBS="$LIBS $CAIRO_LIBS"
- AC_SUBST(CAIRO_CFLAGS)
- AC_SUBST(CAIRO_LIBS)
fi
fi
@@ -3382,8 +3380,6 @@ if test "${HAVE_X11}" = "yes"; then
fi # "$HAVE_XFT" != no
fi # "x${with_xft}" != "xno"
- ## We used to allow building with FreeType and without Xft.
- ## However, the ftx font backend driver is not in good shape.
if test "$HAVE_XFT" != "yes"; then
dnl For the "Does Emacs use" message at the end.
HAVE_XFT=no
@@ -3589,9 +3585,8 @@ AC_SUBST(LIBXPM)
### Use -ljpeg if available, unless '--with-jpeg=no'.
HAVE_JPEG=no
LIBJPEG=
-if test "${NS_IMPL_COCOA}" = yes; then
- : # Cocoa provides its own jpeg support, so do nothing.
-elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then
+if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes" \
+ || test "${HAVE_NS}" = "yes"; then
if test "${with_jpeg}" != "no"; then
AC_CACHE_CHECK([for jpeglib 6b or later],
[emacs_cv_jpeglib],
@@ -3676,8 +3671,13 @@ HAVE_MODULES=no
MODULES_OBJ=
case $opsys in
cygwin|mingw32) MODULES_SUFFIX=".dll" ;;
+ darwin) MODULES_SUFFIX=".dylib" ;;
*) MODULES_SUFFIX=".so" ;;
esac
+case "${opsys}" in
+ darwin) MODULES_SECONDARY_SUFFIX='.so' ;;
+ *) MODULES_SECONDARY_SUFFIX='' ;;
+esac
if test "${with_modules}" != "no"; then
case $opsys in
gnu|gnu-linux)
@@ -3708,19 +3708,26 @@ if test "${HAVE_MODULES}" = yes; then
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])
+ if test -n "${MODULES_SECONDARY_SUFFIX}"; then
+ AC_DEFINE_UNQUOTED(MODULES_SECONDARY_SUFFIX, "$MODULES_SECONDARY_SUFFIX",
+ [Alternative system extension for dynamic libraries.])
+ fi
fi
AC_SUBST(MODULES_OBJ)
AC_SUBST(LIBMODULES)
AC_SUBST(HAVE_MODULES)
AC_SUBST(MODULES_SUFFIX)
+AC_SUBST(MODULES_SECONDARY_SUFFIX)
AC_CONFIG_FILES([src/emacs-module.h])
AC_SUBST_FILE([module_env_snippet_25])
AC_SUBST_FILE([module_env_snippet_26])
AC_SUBST_FILE([module_env_snippet_27])
+AC_SUBST_FILE([module_env_snippet_28])
module_env_snippet_25="$srcdir/src/module-env-25.h"
module_env_snippet_26="$srcdir/src/module-env-26.h"
module_env_snippet_27="$srcdir/src/module-env-27.h"
+module_env_snippet_28="$srcdir/src/module-env-28.h"
emacs_major_version="${PACKAGE_VERSION%%.*}"
AC_SUBST(emacs_major_version)
@@ -3728,13 +3735,12 @@ AC_SUBST(emacs_major_version)
HAVE_PNG=no
LIBPNG=
PNG_CFLAGS=
-if test "${NS_IMPL_COCOA}" = yes; then
- : # Cocoa provides its own png support, so do nothing.
-elif test "${with_png}" != no; then
+if test "${with_png}" != no; then
# mingw32 loads the library dynamically.
if test "$opsys" = mingw32; then
AC_CHECK_HEADER([png.h], [HAVE_PNG=yes])
- elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then
+ elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes" \
+ || test "${HAVE_NS}" = "yes"; then
EMACS_CHECK_MODULES([PNG], [libpng >= 1.0.0])
if test $HAVE_PNG = yes; then
LIBPNG=$PNG_LIBS
@@ -3808,7 +3814,8 @@ if test "${opsys}" = "mingw32"; then
if test "${HAVE_TIFF}" = "yes"; then
AC_DEFINE(HAVE_TIFF, 1, [Define to 1 if you have the tiff library (-ltiff).])
fi
-elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then
+elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes" \
+ || test "${HAVE_NS}" = "yes"; then
if test "${with_tiff}" != "no"; then
AC_CHECK_HEADER(tiffio.h,
[tifflibs="-lz -lm"
@@ -3837,7 +3844,7 @@ if test "${opsys}" = "mingw32"; then
AC_DEFINE(HAVE_GIF, 1, [Define to 1 if you have a gif (or ungif) library.])
fi
elif test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no" \
- || test "${HAVE_W32}" = "yes"; then
+ || test "${HAVE_W32}" = "yes" || test "${HAVE_NS}" = "yes"; then
AC_CHECK_HEADER(gif_lib.h,
# EGifPutExtensionLast only exists from version libungif-4.1.0b1.
# Earlier versions can crash Emacs, but version 5.0 removes EGifPutExtensionLast.
@@ -3893,6 +3900,11 @@ case $with_gnutls,$HAVE_GNUTLS in
*) MISSING="$MISSING gnutls"
WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-gnutls=ifavailable";;
esac
+case $with_json,$HAVE_JSON in
+ no,* | ifavailable,* | *,yes) ;;
+ *) MISSING="$MISSING json"
+ WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-json=ifavailable";;
+esac
if test "X${MISSING}" != X; then
AC_MSG_ERROR([The following required libraries were not found:
$MISSING
@@ -4023,11 +4035,13 @@ AC_SUBST(XFIXES_LIBS)
### Use Xdbe (-lXdbe) if available
HAVE_XDBE=no
if test "${HAVE_X11}" = "yes"; then
- AC_CHECK_HEADER(X11/extensions/Xdbe.h,
- [AC_CHECK_LIB(Xext, XdbeAllocateBackBufferName, HAVE_XDBE=yes)],
- [],
- [#include <X11/Xlib.h>
- ])
+ if test "${with_xdbe}" != "no"; then
+ AC_CHECK_HEADER(X11/extensions/Xdbe.h,
+ [AC_CHECK_LIB(Xext, XdbeAllocateBackBufferName, HAVE_XDBE=yes)],
+ [],
+ [#include <X11/Xlib.h>
+ ])
+ fi
if test $HAVE_XDBE = yes; then
XDBE_LIBS=-lXext
fi
@@ -4180,7 +4194,8 @@ pthread_sigmask strsignal setitimer timer_getoverrun \
sendto recvfrom getsockname getifaddrs freeifaddrs \
gai_strerror sync \
getpwent endpwent getgrent endgrent \
-cfmakeraw cfsetspeed __executable_start log2 pthread_setname_np)
+cfmakeraw cfsetspeed __executable_start log2 pthread_setname_np \
+pthread_set_name_np)
LIBS=$OLD_LIBS
if test "$ac_cv_func_pthread_setname_np" = "yes"; then
@@ -4219,6 +4234,12 @@ dnl No need to check for posix_memalign if aligned_alloc works.
AC_CHECK_FUNCS([aligned_alloc posix_memalign], [break])
AC_CHECK_DECLS([aligned_alloc], [], [], [[#include <stdlib.h>]])
+case $with_unexec,$canonical in
+ yes,alpha*)
+ AC_CHECK_DECL([__ELF__], [],
+ [AC_MSG_ERROR([Non-ELF systems are not supported on this platform.])]);;
+esac
+
# Dump loading
AC_CHECK_FUNCS([posix_madvise])
@@ -4505,40 +4526,16 @@ AC_SUBST(KRB5LIB)
AC_SUBST(DESLIB)
AC_SUBST(KRB4LIB)
-AC_ARG_WITH([libgmp],
- [AS_HELP_STRING([--without-libgmp],
- [don't use the GNU Multiple Precision (GMP) library;
- this is the default on systems lacking libgmp.])])
-GMP_LIB=
-GMP_OBJ=mini-gmp-emacs.o
-HAVE_GMP=no
-case $with_libgmp in
- no) ;;
- yes) HAVE_GMP=yes GMP_LIB=-lgmp;;
- *) AC_CHECK_HEADERS([gmp.h],
- [OLIBS=$LIBS
- AC_SEARCH_LIBS([__gmpz_roinit_n], [gmp])
- LIBS=$OLIBS
- case $ac_cv_search___gmpz_roinit_n in
- 'none needed') HAVE_GMP=yes;;
- -*) HAVE_GMP=yes GMP_LIB=$ac_cv_search___gmpz_roinit_n;;
- esac]);;
-esac
-if test "$HAVE_GMP" = yes; then
- GMP_OBJ=
- AC_DEFINE([HAVE_GMP], 1, [Define to 1 if you have recent-enough GMP.])
-fi
-AC_SUBST([GMP_LIB])
-AC_SUBST([GMP_OBJ])
-
AC_CHECK_HEADERS(valgrind/valgrind.h)
AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.h>]])
-AC_CHECK_FUNCS_ONCE([sbrk])
+AC_CHECK_FUNCS_ONCE([__lsan_ignore_object sbrk])
AC_FUNC_FORK
+dnl AC_CHECK_FUNCS_ONCE wouldn’t be right for snprintf, which needs
+dnl the current CFLAGS etc.
AC_CHECK_FUNCS(snprintf)
dnl Check for glib. This differs from other library checks in that
@@ -4713,7 +4710,7 @@ if test "$USE_X_TOOLKIT" != "none"; then
fi
case $opsys in
- sol2* | unixware )
+ solaris | unixware )
dnl Some SVr4s don't define NSIG in sys/signal.h for ANSI environments;
dnl instead, there's a system variable _sys_nsig. Unfortunately, we
dnl need the constant to dimension an array. So wire in the appropriate
@@ -4726,7 +4723,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 | sol2* | unixware )
+ hpux* | nacl | openbsd | solaris | unixware )
emacs_broken_SIGIO=yes
;;
@@ -4775,7 +4772,7 @@ case $opsys in
esac
case $opsys in
- gnu-* | sol2-10 )
+ gnu-* | solaris )
dnl FIXME Can't we test if this exists (eg /proc/$$)?
AC_DEFINE(HAVE_PROCFS, 1, [Define if you have the /proc filesystem.])
;;
@@ -4870,11 +4867,11 @@ case $opsys in
AC_DEFINE(PTY_TTY_NAME_SPRINTF, [])
;;
- gnu | openbsd | qnxnto )
+ gnu | qnxnto )
AC_DEFINE(FIRST_PTY_LETTER, ['p'])
;;
- gnu-linux | gnu-kfreebsd | dragonfly | freebsd | netbsd | darwin | nacl )
+ gnu-linux | gnu-kfreebsd | dragonfly | freebsd | openbsd | netbsd | darwin | nacl )
dnl if HAVE_GRANTPT
if test "x$ac_cv_func_grantpt" = xyes; then
AC_DEFINE(UNIX98_PTYS, 1, [Define if the system has Unix98 PTYs.])
@@ -4904,7 +4901,7 @@ case $opsys in
AC_DEFINE(PTY_TTY_NAME_SPRINTF, [sprintf (pty_name, "/dev/pty/tty%c%x", c, i);])
;;
- sol2* )
+ solaris )
dnl On SysVr4, grantpt(3) forks a subprocess, so do not use
dnl O_CLOEXEC when opening the pty, and keep the SIGCHLD handler
dnl from intercepting that death. If any child but grantpt's should die
@@ -4914,7 +4911,7 @@ case $opsys in
;;
unixware )
- dnl Comments are as per sol2*.
+ dnl Comments are as per solaris.
AC_DEFINE(PTY_OPEN, [fd = open (pty_name, O_RDWR | O_NONBLOCK)])
AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal("could not grant slave pty"); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, PTY_NAME_SIZE, "%s", ptyname); }])
;;
@@ -4922,7 +4919,7 @@ esac
case $opsys in
- sol2* | unixware )
+ solaris | unixware )
dnl This change means that we don't loop through allocate_pty too
dnl many times in the (rare) event of a failure.
AC_DEFINE(FIRST_PTY_LETTER, ['z'])
@@ -5017,7 +5014,7 @@ if test x$GCC = xyes; then
AC_DEFINE(GC_SETJMP_WORKS, 1)
else
case $opsys in
- aix* | dragonfly | freebsd | netbsd | openbsd | sol2* )
+ aix* | dragonfly | freebsd | netbsd | openbsd | solaris )
AC_DEFINE(GC_SETJMP_WORKS, 1)
;;
esac
@@ -5064,7 +5061,7 @@ case $emacs_cv_func_sigsetjmp,$emacs_cv_alternate_stack,$opsys in
esac
case $opsys in
- sol2* | unixware )
+ solaris | unixware )
dnl TIOCGPGRP is broken in SysVr4, so we can't send signals to PTY
dnl subprocesses the usual way. But TIOCSIGNAL does work for PTYs,
dnl and this is all we need.
@@ -5074,7 +5071,7 @@ esac
case $opsys in
- hpux* | sol2* )
+ hpux* | solaris )
dnl Used in xfaces.c.
AC_DEFINE(XOS_NEEDS_TIME_H, 1, [Compensate for a bug in Xos.h on
some systems, where it requires time.h.])
@@ -5129,7 +5126,7 @@ case $opsys in
fi
;;
- sol2*)
+ solaris)
AC_DEFINE(USG, [])
AC_DEFINE(USG5_4, [])
AC_DEFINE(SOLARIS2, [], [Define if the system is Solaris.])
@@ -5194,7 +5191,7 @@ case $opsys in
reopen it in the child.])
;;
- sol2-10)
+ solaris)
AC_DEFINE(_STRUCTURED_PROC, 1, [Needed for system_process_attributes
on Solaris.])
;;
@@ -5287,9 +5284,9 @@ if test "${HAVE_X_WINDOWS}" = "yes" ; then
if test "$HAVE_CAIRO" = "yes"; then
FONT_OBJ="$FONT_OBJ ftfont.o ftcrfont.o"
elif test "$HAVE_XFT" = "yes"; then
- FONT_OBJ="$FONT_OBJ ftfont.o xftfont.o ftxfont.o"
+ FONT_OBJ="$FONT_OBJ ftfont.o xftfont.o"
elif test "$HAVE_FREETYPE" = "yes"; then
- FONT_OBJ="$FONT_OBJ ftfont.o ftxfont.o"
+ FONT_OBJ="$FONT_OBJ ftfont.o"
fi
fi
if test "${HAVE_HARFBUZZ}" = "yes" ; then
@@ -5698,6 +5695,11 @@ done
AC_DEFINE_UNQUOTED(EMACS_CONFIG_FEATURES, "${emacs_config_features}",
[Summary of some of the main features enabled by configure.])
+if test -z "$GMP_H"; then
+ HAVE_GMP=yes
+else
+ HAVE_GMP=no
+fi
AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D}
Does Emacs use -lXpm? ${HAVE_XPM}
Does Emacs use -ljpeg? ${HAVE_JPEG}
@@ -5708,6 +5710,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D
Does Emacs use cairo? ${HAVE_CAIRO}
Does Emacs use -llcms2? ${HAVE_LCMS2}
Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK}
+ Does Emacs use native APIs for images? ${NATIVE_IMAGE_API}
Does Emacs support sound? ${HAVE_SOUND}
Does Emacs use -lgpm? ${HAVE_GPM}
Does Emacs use -ldbus? ${HAVE_DBUS}
@@ -5725,11 +5728,11 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D
Does Emacs use -lxft? ${HAVE_XFT}
Does Emacs use -lsystemd? ${HAVE_LIBSYSTEMD}
Does Emacs use -ljansson? ${HAVE_JSON}
- Does Emacs use -lgmp? ${HAVE_GMP}
+ Does Emacs use the GMP library? ${HAVE_GMP}
Does Emacs directly use zlib? ${HAVE_ZLIB}
Does Emacs have dynamic modules support? ${HAVE_MODULES}
Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}
- Does Emacs support Xwidgets (requires gtk3)? ${HAVE_XWIDGETS}
+ Does Emacs support Xwidgets? ${HAVE_XWIDGETS}
Does Emacs have threading support in lisp? ${threads_enabled}
Does Emacs support the portable dumper? ${with_pdumper}
Does Emacs support legacy unexec dumping? ${with_unexec}
@@ -5905,6 +5908,21 @@ you can continue to support by using '$0 --with-pop'.])
esac
fi
+if test "${HAVE_XFT}" = yes; then
+ AC_MSG_WARN([This configuration uses libXft, which has a number of
+ font rendering issues, and is being considered for removal in the
+ next release of Emacs. Please consider using Cairo graphics +
+ HarfBuzz text shaping instead (they are auto-detected if the
+ relevant development headers are installed).])
+fi
+
+if test "${HAVE_CAIRO}" = "yes" && test "${HAVE_HARFBUZZ}" = no; then
+ AC_MSG_WARN([This configuration uses the Cairo graphics library,
+ but not the HarfBuzz font shaping library. We recommend the use
+ of HarfBuzz when using Cairo, please install HarfBuzz development
+ packages.])
+fi
+
# Let plain 'make' work.
test "$MAKE" = make || test -f makefile || cat >makefile <<EOF
.POSIX:
diff --git a/doc/emacs/abbrevs.texi b/doc/emacs/abbrevs.texi
index 21bf8c53325..e3766aae9e8 100644
--- a/doc/emacs/abbrevs.texi
+++ b/doc/emacs/abbrevs.texi
@@ -28,6 +28,7 @@ Automatic Typing}.
* Abbrev Concepts:: Fundamentals of defined abbrevs.
* Defining Abbrevs:: Defining an abbrev, so it will expand when typed.
* Expanding Abbrevs:: Controlling expansion: prefixes, canceling expansion.
+* Abbrevs Suggestions:: Get automatic suggestions about defined abbrevs.
* Editing Abbrevs:: Viewing or editing the entire list of defined abbrevs.
* Saving Abbrevs:: Saving the entire list of abbrevs for another session.
* Dynamic Abbrevs:: Abbreviations for words already in the buffer.
@@ -223,6 +224,38 @@ changing this function you can make arbitrary changes to
the abbrev expansion. @xref{Abbrev Expansion,,, elisp, The Emacs Lisp
Reference Manual}.
+@node Abbrevs Suggestions
+@section Abbrevs Suggestions
+
+ You can get abbrev suggestions when you manually type text for which
+there is currently an active defined abbrev. For example, if there is
+an abbrev @samp{foo} with the expansion @samp{find outer otter}, and
+you manually type @samp{find outer otter}, Emacs can notice this and
+show a hint in the echo area when you have stopped typing.
+
+@vindex abbrev-suggest
+ To enable the abbrev suggestion feature, customize the option
+@code{abbrev-suggest} to a non-@code{nil} value.
+
+@vindex abbrev-suggest-hint-threshold
+ The variable @code{abbrev-suggest-hint-threshold} controls when to
+suggest an abbrev to the user. This variable defines the minimum
+savings (in terms of the number of characters the user will not have
+to type) required for Emacs to suggest using an abbrev. For example,
+if the user types @samp{foo bar} (seven characters) and there is an
+abbrev @samp{fubar} defined (five characters), the user will not get
+any suggestion unless the threshold is set to the number 2 or lower.
+With the default value 3, the user would not get any suggestion in
+this example, because the savings in using the abbrev are below
+the threshold. If you always want to get abbrev suggestions, set this
+variable's value to zero.
+
+@findex abbrev-suggest-show-report
+ The command @code{abbrev-suggest-show-report} displays a buffer with
+all the abbrev suggestions shown during the current editing session.
+This can be useful if you get several abbrev suggestions and don't
+remember them all.
+
@node Editing Abbrevs
@section Examining and Editing Abbrevs
diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi
index abb385f53d5..2e03d0c04a3 100644
--- a/doc/emacs/basic.texi
+++ b/doc/emacs/basic.texi
@@ -115,7 +115,7 @@ just like digits. Case is ignored.
starting with @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, @kbd{C-x 8 ]}, @kbd{C-x 8 @{} and @kbd{C-x 8 @}} insert the
+Similarly, @w{@kbd{C-x 8 ]}}, @kbd{C-x 8 @{} and @kbd{C-x 8 @}} insert the
curved quotes @t{’}, @t{“} and @t{”}, respectively. Also, a working
@key{Alt} key acts like @kbd{C-x 8} (unless followed by @key{RET});
e.g., @kbd{A-[} acts like @kbd{C-x 8 [} and inserts @t{‘}. To see
@@ -311,13 +311,16 @@ Position 1 is the beginning of the buffer.
@kindex M-g M-g
@kindex M-g g
@findex goto-line
+@findex goto-line-relative
Read a number @var{n} and move point to the beginning of line number
@var{n} (@code{goto-line}). Line 1 is the beginning of the buffer. If
point is on or just after a number in the buffer, that is the default
for @var{n}. Just type @key{RET} in the minibuffer to use it. You can
also specify @var{n} by giving @kbd{M-g M-g} a numeric prefix argument.
@xref{Select Buffer}, for the behavior of @kbd{M-g M-g} when you give it
-a plain prefix argument.
+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.
@item M-g @key{TAB}
@kindex M-g TAB
@@ -461,6 +464,15 @@ Normally, this command undoes the last change, moving point back to
where it was before the change. The undo command applies only to
changes in the buffer; you can't use it to undo cursor motion.
+ On a terminal that supports the @key{Control} modifier on all other
+keys, the easiest way to invoke @code{undo} is with @kbd{C-/}, since
+that doesn't need the @key{Shift} modifier. On terminals which allow
+only the ASCII control characters, @kbd{C-/} does not exist, but for
+many of them @kbd{C-/} still works because it actually sends @kbd{C-_}
+to Emacs, while many others allow you to omit the @key{Shift} modifier
+when you type @kbd{C-_} (in effect pressing @kbd{C--}), making that
+the most convenient way to invoke @code{undo}.
+
Although each editing command usually makes a separate entry in the
undo records, very simple commands may be grouped together.
Sometimes, an entry may cover just part of a complex command.
diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi
index 89ed470c055..537c6536085 100644
--- a/doc/emacs/buffers.texi
+++ b/doc/emacs/buffers.texi
@@ -697,6 +697,17 @@ forward order after the file name, as in @samp{file|top/middle}. If
@code{uniquify-buffer-name-style} is set to @code{nil}, the buffer
names simply get @samp{<2>}, @samp{<3>}, etc.@: appended.
+ The value of @code{uniquify-buffer-name-style} can be set to a
+customized function with two arguments @var{base} and
+@var{extra-strings} where @var{base} is a string and
+@var{extra-strings} is a list of strings. For example the current
+implementation for @code{post-forward-angle-brackets} could be:
+
+@example
+(defun my-post-forward-angle-brackets (base extra-string)
+ (concat base \"<\" (mapconcat #'identity extra-string \"/\") \">\"))
+@end example
+
Which rule to follow for putting the directory names in the buffer
name is not very important if you are going to @emph{look} at the
buffer names before you type one. But as an experienced user, if you
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index fa60ce26621..5f7d9b7ab8c 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -427,11 +427,16 @@ M-n}}, @key{RET}, and so forth, just like compilation errors.
@xref{Compilation Mode}, for detailed description of commands and key
bindings available in the @file{*grep*} buffer.
+@vindex grep-match-regexp
Some grep programs accept a @samp{--color} option to output special
markers around matches for the purpose of highlighting. You can make
use of this feature by setting @code{grep-highlight-matches} to
@code{t}. When displaying a match in the source buffer, the exact
match will be highlighted, instead of the entire source line.
+Highlighting is provided via matching the @acronym{ANSI} escape
+sequences emitted by @command{grep}. The matching of the sequences is
+controlled by @code{grep-match-regexp}, which can be customized to
+accommodate different @command{grep} programs.
As with compilation commands (@pxref{Compilation}), while the grep
command runs, the mode line shows the running number of matches found
@@ -975,9 +980,27 @@ displays the following frame layout:
@end group
@end smallexample
+@findex gdb-save-window-configuration
+@findex gdb-load-window-configuration
+@vindex gdb-default-window-configuration-file
+@vindex gdb-window-configuration-directory
+ You can customize the window layout based on the one above and save
+that layout to a file using @code{gdb-save-window-configuration}.
+Then you can later load this layout back using
+@code{gdb-load-window-configuration}. (Internally, Emacs uses the
+term window configuration instead of window layout.) You can set your
+custom layout as the default one used by @code{gdb-many-windows} by
+customizing @code{gdb-default-window-configuration-file}. If it is
+not an absolute file name, GDB looks under
+@code{gdb-window-configuration-directory} for the file.
+@code{gdb-window-configuration-directory} defaults to
+@code{user-emacs-directory} (@pxref{Find Init}).
+
+
@findex gdb-restore-windows
@findex gdb-many-windows
- If you ever change the window layout, you can restore the many-windows
+@vindex gdb-restore-window-configuration-after-quit
+ If you ever change the window layout, you can restore the default
layout by typing @kbd{M-x gdb-restore-windows}. To toggle
between the many windows layout and a simple layout with just the GUD
interaction buffer and a source file, type @kbd{M-x gdb-many-windows}.
@@ -988,7 +1011,13 @@ interaction buffer and a source file, type @kbd{M-x gdb-many-windows}.
of windows on your original frame will not be affected. A separate
frame for GDB sessions can come in especially handy if you work on a
text-mode terminal, where the screen estate for windows could be at a
-premium.
+premium. If you choose to start GDB in the same frame, consider
+setting @code{gdb-restore-window-configuration-after-quit} to a
+non-@code{nil} value. Your original layout will then be restored
+after GDB quits. Use @code{t} to always restore; use
+@code{if-gdb-many-windows} to restore only when
+@code{gdb-many-windows} is non-@code{nil}; use @code{if-gdb-show-main}
+to restore only when @code{gdb-show-main} is non-@code{nil}.
You may also specify additional GDB-related buffers to display,
either in the same frame or a different one. Select the buffers you
@@ -998,6 +1027,14 @@ is the relevant buffer type, such as @samp{breakpoints}. You can do
the same with the menu bar, with the @samp{GDB-Windows} and
@samp{GDB-Frames} sub-menus of the @samp{GUD} menu.
+@vindex gdb-max-source-window-count
+@vindex gdb-display-source-buffer-action
+By default, GDB uses at most one window to display the source file.
+You can make it use more windows by customizing
+@code{gdb-max-source-window-count}. You can also customize
+@code{gdb-display-source-buffer-action} to control how GDB displays
+source files.
+
When you finish debugging, kill the GUD interaction buffer with
@kbd{C-x k}, which will also kill all the buffers associated with the
session. However you need not do this if, after editing and
@@ -1536,13 +1573,6 @@ Automatic loading also occurs when completing names for
prefix being completed. To disable this feature, change the variable
@code{help-enable-completion-autoload} to @code{nil}.
-@vindex load-dangerous-libraries
-@cindex Lisp files byte-compiled by XEmacs
- By default, Emacs refuses to load compiled Lisp files which were
-compiled with XEmacs, a modified version of Emacs---they can cause
-Emacs to crash. Set the variable @code{load-dangerous-libraries} to
-@code{t} if you want to try loading them.
-
Once you put your library in a directory where Emacs can find and
load it, you may wish to make it available at startup. This is useful
when the library defines features that should be available
diff --git a/doc/emacs/calendar.texi b/doc/emacs/calendar.texi
index fe51ad35d77..e5ee7e94bcf 100644
--- a/doc/emacs/calendar.texi
+++ b/doc/emacs/calendar.texi
@@ -625,6 +625,10 @@ your time zone. Emacs displays the times of sunrise and sunset
@emph{corrected for daylight saving time}. @xref{Daylight Saving},
for how daylight saving time is determined.
+@vindex calendar-time-zone-style
+ If you want to display numerical time zones (like @samp{"+0100"})
+instead of symbolic ones (like @samp{"CET"}), set this to @code{numeric}.
+
As a user, you might find it convenient to set the calendar location
variables for your usual physical location in your @file{.emacs} file.
If you are a system administrator, you may want to set these variables
diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi
index 850a802753d..3dd1fe9a308 100644
--- a/doc/emacs/cmdargs.texi
+++ b/doc/emacs/cmdargs.texi
@@ -495,7 +495,14 @@ variables to be set, but it uses their values if they are set.
@item CDPATH
@vindex CDPATH@r{, environment variable}
Used by the @code{cd} command to search for the directory you specify,
-when you specify a relative directory,
+when you specify a relative directory.
+@item COLORTERM
+@vindex COLORTERM@r{, environment variable}
+If this variable is set to the value @samp{truecolor}, it tells Emacs
+to use 24-bit true color on text-mode displays even if the terminfo
+database is not installed. Emacs will use built-in commands to
+request true color by RGB values instead of the missing terminfo
+information.
@item DBUS_SESSION_BUS_ADDRESS
@vindex DBUS_SESSION_BUS_ADDRESS@r{, environment variable}
Used by D-Bus when Emacs is compiled with it. Usually, there is no
@@ -565,12 +572,6 @@ is found there.
@item HOSTNAME
@vindex HOSTNAME@r{, environment variable}
The name of the machine that Emacs is running on.
-@c complete.el is obsolete since 24.1.
-@ignore
-@item INCPATH
-A colon-separated list of directories. Used by the @code{complete} package
-to search for files.
-@end ignore
@item INFOPATH
@vindex INFOPATH@r{, environment variable}
A colon-separated list of directories in which to search for Info files.
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index 6e2e045dddf..81874a04aa7 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -1630,6 +1630,10 @@ characters are actually defined by this map.
@item
@vindex mode-specific-map
@code{mode-specific-map} is for characters that follow @kbd{C-c}.
+@item
+@vindex project-prefix-map
+@code{project-prefix-map} is for characters that follow @kbd{C-x p},
+used for project-related commands (@pxref{Projects}).
@end itemize
@node Local Keymaps
@@ -2601,6 +2605,7 @@ the function or facility is available, like this:
(if (fboundp 'blink-cursor-mode)
(blink-cursor-mode 0))
+@c FIXME: Find better example since `set-coding-priority' is removed.
(if (boundp 'coding-category-utf-8)
(set-coding-priority '(coding-category-utf-8)))
@end example
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 4ff1dc1bd94..fdc4703e86f 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -79,6 +79,29 @@ The former lists all the files with extension @samp{.el} in directory
@samp{foo}. The latter lists the files with extension @samp{.el}
in all the subdirectories of @samp{foo}.
+@cindex globstar, in Dired
+On Posix systems, when the system shell supports @dfn{globstar}, a
+recursive globbing feature, and that support is enabled, you can use
+recursive globbing in Dired:
+
+@example
+C-x d ~/foo/**/*.el @key{RET}
+@end example
+
+This command produces a directory listing with all the files with
+extension @samp{.el}, descending recursively in all the subdirectories
+of @samp{foo}. Note that there are small differences in the
+implementation of globstar between different shells. Check your shell
+manual to know the expected behavior.
+
+@vindex dired-maybe-use-globstar
+@vindex dired-enable-globstar-in-shell
+If the shell supports globstar, but that support is disabled by
+default, you can still let Dired use this feature by customizing
+@code{dired-maybe-use-globstar} to a non-@code{nil} value; then Dired
+will enable globstar for those shells for which it knows how (see
+@code{dired-enable-globstar-in-shell} for the list of those shells).
+
The usual history and completion commands can be used in the minibuffer;
in particular, @kbd{M-n} puts the name of the visited file (if any) in
the minibuffer (@pxref{Minibuffer History}).
@@ -86,6 +109,16 @@ the minibuffer (@pxref{Minibuffer History}).
You can also invoke Dired by giving @kbd{C-x C-f} (@code{find-file})
a directory's name.
+@findex dired-jump
+@findex dired-jump-other-window
+@kindex C-x C-j
+@kindex C-x 4 C-j
+ Typing @kbd{C-x C-j} (@code{dired-jump}) in any buffer will open a
+Dired buffer and move point to the line corresponding to the current
+file. In Dired, move up a level and go to the previous directory's
+line. Typing @kbd{C-x 4 C-j} (@code{dired-jump-other-window} has the
+same effect but opens a new window for the Dired buffer.
+
The variable @code{dired-listing-switches} specifies the options to
give to @command{ls} for listing the directory; this string
@emph{must} contain @samp{-l}. If you use a prefix argument with the
@@ -96,6 +129,17 @@ options (that is, single characters) requiring no arguments, and long
options (starting with @samp{--}) whose arguments are specified with
@samp{=}.
+@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
+determine whether the switches indicate sorting by name or date, and
+will say so in the mode line. If the @code{dired-switches-in-mode-line}
+variable is @code{as-is}, the switches will be shown verbatim. If
+this variable's value is an integer, the switch display will be
+truncated to that length. This variable can also be a function, which
+will be called with @code{dired-actual-switches} as the only
+parameter, and should return a string to display in the mode line.
+
@vindex dired-use-ls-dired
If your @command{ls} program supports the @samp{--dired} option,
Dired automatically passes it that option; this causes @command{ls} to
@@ -694,6 +738,14 @@ The variable @code{dired-recursive-copies} controls whether to copy
directories recursively (like @samp{cp -r}). The default is
@code{top}, which means to ask before recursively copying a directory.
+@vindex dired-copy-dereference
+@cindex follow symbolic links
+@cindex dereference symbolic links
+The variable @code{dired-copy-dereference} controls whether to copy
+symbolic links as links or after dereferencing (like @samp{cp -L}).
+The default is @code{nil}, which means that the symbolic links are
+copied by creating new ones.
+
@item D
@findex dired-do-delete
@kindex D @r{(Dired)}
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index a4040d986e1..6f1bc802b85 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -1334,6 +1334,10 @@ customize the variable @code{whitespace-line-column}.
@item newline
Highlight newlines.
+@item missing-newline-at-eof
+Highlight the final character if the buffer doesn't end with a newline
+character.
+
@item empty
Highlight empty lines at the beginning and/or end of the buffer.
@@ -1448,9 +1452,10 @@ the displayed column number to count from one, you may set
@cindex narrowing, and line number display
If you have narrowed the buffer (@pxref{Narrowing}), the displayed
line number is relative to the accessible portion of the buffer.
-Thus, it isn't suitable as an argument to @code{goto-line}. (Use
-@code{what-line} command to see the line number relative to the whole
-file.)
+Thus, it isn't suitable as an argument to @code{goto-line}. (The
+command @code{what-line} shows the line number relative to the whole
+file.) You can use @code{goto-line-relative} command to move point to
+the line relative to the accessible portion of the narrowed buffer.
@vindex line-number-display-limit
If the buffer is very large (larger than the value of
@@ -1667,6 +1672,8 @@ Customization}). (The other attributes of this face have no effect;
the text shown under the cursor is drawn using the frame's background
color.) To change its shape, customize the buffer-local variable
@code{cursor-type}; possible values are @code{box} (the default),
+@code{(box . @var{size})} (box cursor becoming a hollow box under
+masked images larger than @var{size} pixels in either dimension),
@code{hollow} (a hollow box), @code{bar} (a vertical bar), @code{(bar
. @var{n})} (a vertical bar @var{n} pixels wide), @code{hbar} (a
horizontal bar), @code{(hbar . @var{n})} (a horizontal bar @var{n}
@@ -1802,6 +1809,29 @@ logical lines, so having a fringe indicator for each wrapped line
would be visually distracting. You can change this by customizing the
variable @code{visual-line-fringe-indicators}.
+@vindex word-wrap-by-category
+@findex modify-category-entry
+@findex char-category-set
+@findex category-set-mnemonics
+ By default, Emacs only breaks lines after whitespace characters.
+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
+(@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
+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
+report. You can add categories to a character using the command
+@code{modify-category-entry}.
+
@node Display Custom
@section Customization of Display
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index a28b16aa39e..bd40e10052d 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -856,6 +856,12 @@ Customizing VC
* CVS Options:: Options for CVS.
@end ifnottex
+Projects
+
+* Project File Commands:: Commands for handling project files.
+* Project Buffer Commands:: Commands for handling project buffers.
+* Switching Projects:: Switching between projects.
+
Change Logs
* Change Log Commands:: Commands for editing change log files.
@@ -901,6 +907,7 @@ Abbrevs
* Abbrev Concepts:: Fundamentals of defined abbrevs.
* Defining Abbrevs:: Defining an abbrev, so it will expand when typed.
* Expanding Abbrevs:: Controlling expansion: prefixes, canceling expansion.
+* Abbrevs Suggestions:: Get automatic suggestions about defined abbrevs.
* Editing Abbrevs:: Viewing or editing the entire list of defined abbrevs.
* Saving Abbrevs:: Saving the entire list of abbrevs for another session.
* Dynamic Abbrevs:: Abbreviations for words already in the buffer.
@@ -1278,11 +1285,12 @@ programmer, but if you are not interested in customizing, you can
ignore the customization hints.
This is primarily a reference manual, but can also be used as a
-primer. If you are new to Emacs, we recommend you start with
-the integrated, learn-by-doing tutorial, before reading the manual. To
-run the tutorial, start Emacs and type @kbd{C-h t}. The tutorial
-describes commands, tells you when to try them, and explains the
-results. The tutorial is available in several languages.
+primer. If you are new to Emacs, we recommend you start with the
+integrated, learn-by-doing tutorial, before reading the manual. To
+run the tutorial, start Emacs and type @kbd{C-h t} (which is ``control
+h and then t''). The tutorial describes commands, tells you when to
+try them, and explains the results. The tutorial is available in
+several languages.
On first reading, just skim chapters 1 and 2, which describe the
notational conventions of the manual and the general appearance of the
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 5998326ffef..51e8bd1382f 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -921,6 +921,7 @@ Manual}). For customizations, see the Custom group @code{time-stamp}.
@node Reverting
@section Reverting a Buffer
@findex revert-buffer
+@findex revert-buffer-with-fine-grain
@cindex drastic changes
@cindex reread a file
@@ -941,6 +942,19 @@ reverted changes as a single modification to the buffer's undo history
aliases to bring the reverted changes back, if you happen to change
your mind.
+@vindex revert-buffer-with-fine-grain-max-seconds
+ To revert a buffer more conservatively, you can use the command
+@code{revert-buffer-with-fine-grain}. This command acts like
+@code{revert-buffer}, but it tries to be as non-destructive as
+possible, making an effort to preserve all markers, properties and
+overlays in the buffer. Since reverting this way can be very slow
+when you have made a large number of changes, you can modify the
+variable @code{revert-buffer-with-fine-grain-max-seconds} to
+specify a maximum amount of seconds that replacing the buffer
+contents this way should take. Note that it is not ensured that the
+whole execution of @code{revert-buffer-with-fine-grain} won't take
+longer than this.
+
Some kinds of buffers that are not associated with files, such as
Dired buffers, can also be reverted. For them, reverting means
recalculating their contents. Buffers created explicitly with
@@ -2149,7 +2163,12 @@ To reset all transformations to the initial state, use
@findex image-previous-file
You can press @kbd{n} (@code{image-next-file}) and @kbd{p}
(@code{image-previous-file}) to visit the next image file and the
-previous image file in the same directory, respectively.
+previous image file in the same directory, respectively. These
+commands will consult the ``parent'' dired buffer to determine what
+the next/previous image file is. These commands also work when
+opening a file from archive files (like zip or tar files), and will
+then instead consult the archive mode buffer. If neither an archive
+nor a dired ``parent'' buffer can be found, a dired buffer is opened.
@findex image-mode-mark-file
@findex image-mode-unmark-file
diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi
index dc643e19a4b..db77ae4ec26 100644
--- a/doc/emacs/fixit.texi
+++ b/doc/emacs/fixit.texi
@@ -66,6 +66,7 @@ changes have already been undone, the undo command signals an error.
@cindex redo
@findex undo-only
+@findex undo-redo
Any command other than an undo command breaks the sequence of undo
commands. Starting from that moment, the entire sequence of undo
commands that you have just performed are themselves placed into the
@@ -76,7 +77,9 @@ undo commands.
Alternatively, if you want to resume undoing, without redoing
previous undo commands, use @kbd{M-x undo-only}. This is like
-@code{undo}, but will not redo changes you have just undone.
+@code{undo}, but will not redo changes you have just undone. To
+complement it, @kbd{M-x undo-redo} will undo previous undo commands
+(and will not record itself as an undoable command).
If you notice that a buffer has been modified accidentally, the
easiest way to recover is to type @kbd{C-/} repeatedly until the stars
@@ -274,6 +277,10 @@ Check and correct spelling in the region.
@item M-x ispell-message
Check and correct spelling in a draft mail message, excluding cited
material.
+@item M-x ispell-comments-and-strings
+Check and correct spelling of comments and strings in the buffer or region.
+@item M-x ispell-comment-or-string-at-point
+Check the comment or string at point.
@item M-x ispell-change-dictionary @key{RET} @var{dict} @key{RET}
Restart the spell-checker process, using @var{dict} as the dictionary.
@item M-x ispell-kill-ispell
@@ -301,6 +308,8 @@ region; @pxref{Disabled Transient Mark}.)
@findex ispell
@findex ispell-buffer
@findex ispell-region
+@findex ispell-comments-and-strings
+@findex ispell-comment-or-string-at-point
@cindex spell-checking the active region
Similarly, the command @kbd{M-x ispell} performs spell-checking in
the region if one is active, or in the entire buffer otherwise. The
@@ -309,7 +318,10 @@ explicitly perform spell-checking on the entire buffer or the region
respectively. To check spelling in an email message you are writing,
use @w{@kbd{M-x ispell-message}}; that command checks the whole buffer,
except for material that is indented or appears to be cited from other
-messages. @xref{Sending Mail}.
+messages. @xref{Sending Mail}. When dealing with source code, you
+can use @kbd{M-x ispell-comments-and-strings} or @w{@kbd{M-x
+ispell-comment-or-string-at-point}} to check only comments or string
+literals.
When one of these commands encounters what appears to be an
incorrect word, it asks you what to do. It usually displays a list of
@@ -442,12 +454,14 @@ use @code{flyspell-region} or @code{flyspell-buffer} for that.
@findex flyspell-correct-word-before-point
When Flyspell mode highlights a word as misspelled, you can click on
it with @kbd{mouse-2} (@code{flyspell-correct-word}) to display a menu
-of possible corrections and actions. In addition, @kbd{C-.} or
+of possible corrections and actions. If you want this menu on
+@kbd{mouse-3} instead, customize the variable
+@code{flyspell-use-mouse-3-for-menu}. In addition, @kbd{C-.} or
@kbd{@key{ESC}-@key{TAB}} (@code{flyspell-auto-correct-word}) will
propose various successive corrections for the word at point, and
-@w{@kbd{C-c $}} (@code{flyspell-correct-word-before-point}) will pop up a
-menu of possible corrections. Of course, you can always correct the
-misspelled word by editing it manually in any way you like.
+@w{@kbd{C-c $}} (@code{flyspell-correct-word-before-point}) will pop
+up a menu of possible corrections. Of course, you can always correct
+the misspelled word by editing it manually in any way you like.
@findex flyspell-prog-mode
Flyspell Prog mode works just like ordinary Flyspell mode, except
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index e0eabe38d06..1a44d8dc628 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -214,22 +214,24 @@ speed is linked to how fast you move the wheel. This mode also
supports increasing or decreasing the height of the default face, by
default bound to scrolling with the @key{Ctrl} modifier.
+Emacs also supports horizontal scrolling with the @key{Shift} modifier.
+
@vindex mouse-wheel-tilt-scroll
@vindex mouse-wheel-flip-direction
-Emacs can also support horizontal scrolling if your mouse's wheel can
-be tilted, or if your touchpad supports it. This feature is off by
-default; the variable @code{mouse-wheel-tilt-scroll} turns it on, if
-you customize it to a non-@code{nil} value. By default, tilting the
-mouse wheel scrolls the window's view horizontally in the direction of
-the tilt: e.g., tilting to the right scrolls the window to the right,
-so that the text displayed in the window moves horizontally to the
-left. If you'd like to reverse the direction of horizontal scrolling,
-customize the variable @code{mouse-wheel-flip-direction} to a
-non-@code{nil} value.
+If your mouse's wheel can be tilted, or if your touchpad supports it,
+then you can also enable horizontal scrolling by customizing the
+variable @code{mouse-wheel-tilt-scroll} to a non-@code{nil} value.
+By default, tilting the mouse wheel scrolls the window's view
+horizontally in the direction of the tilt: e.g., tilting to the right
+scrolls the window to the right, so that the text displayed in the
+window moves horizontally to the left. If you'd like to reverse the
+direction of horizontal scrolling, customize the variable
+@code{mouse-wheel-flip-direction} to a non-@code{nil} value.
When the mouse pointer is over an image in Image mode, @pxref{Image Mode},
scrolling the mouse wheel with the @key{Ctrl} modifier scales the image
-under the mouse pointer.
+under the mouse pointer, and scrolling the mouse wheel with the
+@key{Shift} modifier scrolls the image horizontally.
@node Word and Line Mouse
@@ -366,9 +368,13 @@ 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}):
-@c FIXME: `mouse-popup-menubar-stuff' is obsolete since 23.1.
@smallexample
-(global-set-key [mouse-3] 'mouse-popup-menubar-stuff)
+(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
@node Mode Line Mouse
@@ -439,29 +445,40 @@ buffer to select:
@kindex C-x 5 2
@findex make-frame-command
Create a new frame (@code{make-frame-command}).
+
@item C-x 5 b @var{bufname} @key{RET}
Select buffer @var{bufname} in another frame. This runs
@code{switch-to-buffer-other-frame}.
+
@item C-x 5 f @var{filename} @key{RET}
Visit file @var{filename} and select its buffer in another frame. This
runs @code{find-file-other-frame}. @xref{Visiting}.
+
@item C-x 5 d @var{directory} @key{RET}
Select a Dired buffer for directory @var{directory} in another frame.
This runs @code{dired-other-frame}. @xref{Dired}.
+
@item C-x 5 m
Start composing a mail message in another frame. This runs
@code{compose-mail-other-frame}. It is the other-frame variant of
@kbd{C-x m}. @xref{Sending Mail}.
+
@item C-x 5 .
Find the definition of an identifier in another frame. This runs
@code{xref-find-definitions-other-frame}, the multiple-frame variant
of @kbd{M-.}. @xref{Xref}.
+
@item C-x 5 r @var{filename} @key{RET}
@kindex C-x 5 r
@findex find-file-read-only-other-frame
Visit file @var{filename} read-only, and select its buffer in another
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.
@end table
You can control the appearance and behavior of the newly-created
@@ -1316,6 +1333,11 @@ runs @code{find-file-other-tab}. @xref{Visiting}.
@item C-x t d @var{directory} @key{RET}
Select a Dired buffer for directory @var{directory} in another tab.
This runs @code{dired-other-tab}. @xref{Dired}.
+
+@item C-x t t
+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 tab.
@end table
@vindex tab-bar-new-tab-choice
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi
index 06ddc11158b..232b611f416 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -220,6 +220,16 @@ documentation string of the command it runs.
command is not on any key, that means you must use @kbd{M-x} to run
it. @kbd{C-h w} runs the command @code{where-is}.
+@findex button-describe
+@findex widget-describe
+ Some modes in Emacs use various buttons (@pxref{Buttons,,,elisp, The
+Emacs Lisp Reference Manual}) and widgets
+(@pxref{Introduction,,,widget, Emacs Widgets}) that can be clicked to
+perform some action. To find out what function is ultimately invoked
+by these buttons, Emacs provides the @code{button-describe} and
+@code{widget-describe} commands, that should be run with point over
+the button.
+
@node Name Help
@section Help by Command or Variable Name
@@ -563,10 +573,13 @@ command works depend on the major mode.
@kindex C-h l
@findex view-lossage
+@findex lossage-size
If something surprising happens, and you are not sure what you typed,
use @kbd{C-h l} (@code{view-lossage}). @kbd{C-h l} displays your last
-300 input keystrokes and the commands they invoked. If you see
-commands that you are not familiar with, you can use @kbd{C-h k} or
+input keystrokes and the commands they invoked. By default, Emacs
+stores the last 300 keystrokes; if you wish, you can change this number with
+the command @code{lossage-size}.
+If you see commands that you are not familiar with, you can use @kbd{C-h k} or
@kbd{C-h f} to find out what they do.
@kindex C-h e
@@ -607,6 +620,11 @@ 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.)
+@findex describe-keymap
+Finally, @kbd{M-x describe-keymap} prompts for the name of a keymap,
+with completion, and displays a listing of all key bindings in that
+keymap.
+
@node Help Files
@section Help Files
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 6b1f35e6158..bd7dbb6f515 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -577,7 +577,9 @@ regions to the primary selection entirely.
To insert the primary selection into an Emacs buffer, click
@kbd{mouse-2} (@code{mouse-yank-primary}) where you want to insert it.
-@xref{Mouse Commands}.
+@xref{Mouse Commands}. You can also use the normal Emacs yank command
+(@kbd{C-y}) to insert this text if @code{select-enable-primary} is set
+(@pxref{Clipboard}).
@cindex MS-Windows, and primary selection
MS-Windows provides no primary selection, but Emacs emulates it
diff --git a/doc/emacs/m-x.texi b/doc/emacs/m-x.texi
index fc2d2d8c84d..b18c334acf4 100644
--- a/doc/emacs/m-x.texi
+++ b/doc/emacs/m-x.texi
@@ -72,6 +72,10 @@ number, in which case Emacs will show the binding for that many
seconds before removing it from display. The default behavior is to
display the binding for 2 seconds.
+Additionally, when @code{suggest-key-bindings} is non-@code{nil}, the
+completion list of @kbd{M-x} shows equivalent key bindings for all
+commands that have them.
+
@vindex extended-command-suggest-shorter
Commands that don't have key bindings, can still be invoked after
typing less than their full name at the @samp{M-x} prompt. Emacs
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index e8b5608c62a..1f10b68b8a7 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1656,8 +1656,53 @@ support additional types of projects.
the project back-end. For example, the VC back-end doesn't consider
``ignored'' files (@pxref{VC Ignore}) to be part of the project.
+@menu
+* Project File Commands:: Commands for handling project files.
+* Project Buffer Commands:: Commands for handling project buffers.
+* Switching Projects:: Switching between projects.
+@end menu
+
+@node Project File Commands
+@subsection Project Commands That Operate on Files
+
+@table @kbd
+@item C-x p f
+Visit a file that belongs to the current project
+(@code{project-find-file}).
+@item C-x p g
+Find matches for a regexp in all files that belong to the current
+project (@code{project-find-regexp}).
+@item M-x project-search
+Interactively search for regexp matches in all files that belong to
+the current project.
+@item C-x p r
+Perform query-replace for a regexp in all files that belong to the
+current project (@code{project-query-replace-regexp}).
+@item C-x p d
+Run Dired in the current project's root directory
+(@code{project-dired}).
+@item C-x p v
+Run @code{vc-dir} in the current project's root directory
+(@code{project-vc-dir}).
+@item C-x p s
+Start an inferior shell in the current project's root directory
+(@code{project-shell}).
+@item C-x p e
+Start Eshell in the current project's root directory
+(@code{project-eshell}).
+@item C-x p c
+Run compilation in the current project's root directory
+(@code{project-compile}).
+@item C-x p !
+Run shell command in the current project's root directory
+(@code{project-shell-command}).
+@item C-x p &
+Run shell command asynchronously in the current project's root
+directory (@code{project-async-shell-command}).
+@end table
+
Emacs provides commands for handling project files conveniently.
-This section describes these commands.
+This subsection describes these commands.
@cindex current project
All of the commands described here share the notion of the
@@ -1668,25 +1713,26 @@ doesn't seem to belong to a recognizable project, these commands
prompt you for the project directory.
@findex project-find-file
- The command @code{project-find-file} is a convenient way of visiting
-files (@pxref{Visiting}) that belong to the current project. Unlike
-@kbd{C-x C-f}, this command doesn't require to type the full file name
-of the file to visit, you can type only the file's base name (i.e.,
-omit the leading directories). In addition, the completion candidates
-considered by the command include only the files belonging to the
-current project, and nothing else. If there's a file name at point,
-this command offers that file as the default to visit.
+ The command @kbd{C-x p f} (@code{project-find-file}) is a convenient
+way of visiting files (@pxref{Visiting}) that belong to the current
+project. Unlike @kbd{C-x C-f}, this command doesn't require to type
+the full file name of the file to visit, you can type only the file's
+base name (i.e., omit the leading directories). In addition, the
+completion candidates considered by the command include only the files
+belonging to the current project, and nothing else. If there's a file
+name at point, this command offers that file as the default to visit.
@findex project-find-regexp
- The command @code{project-find-regexp} is similar to @code{rgrep}
-(@pxref{Grep Searching}), but it searches only the files that belong
-to the current project. The command prompts for the regular
-expression to search, and pops up an Xref mode buffer with the search
-results, where you can select a match using the Xref mode commands
-(@pxref{Xref Commands}). When invoked with a prefix argument, this
-command additionally prompts for the base directory from which to
-start the search; this allows, for example, to limit the search only
-to project files under a certain subdirectory of the project root.
+ The command @kbd{C-x p g} (@code{project-find-regexp}) is similar to
+@code{rgrep} (@pxref{Grep Searching}), but it searches only the files
+that belong to the current project. The command prompts for the
+regular expression to search, and pops up an Xref mode buffer with the
+search results, where you can select a match using the Xref mode
+commands (@pxref{Xref Commands}). When invoked with a prefix
+argument, this command additionally prompts for the base directory
+from which to start the search; this allows, for example, to limit the
+search only to project files under a certain subdirectory of the
+project root.
@findex project-search
@kbd{M-x project-search} is an interactive variant of
@@ -1698,13 +1744,101 @@ matched file. To find the rest of the matches, type @w{@kbd{M-x
fileloop-continue @key{RET}}}.
@findex project-query-replace-regexp
- @kbd{M-x project-query-replace-regexp} is similar to
+ @kbd{C-x p r} (@code{project-query-replace-regexp}) is similar to
@code{project-search}, but it prompts you for whether to replace each
match it finds, like @code{query-replace} does (@pxref{Query
Replace}), and continues to the next match after you respond. If your
response causes Emacs to exit the query-replace loop, you can later
continue with @w{@kbd{M-x fileloop-continue @key{RET}}}.
+@findex project-dired
+ The command @kbd{C-x p d} (@code{project-dired}) opens a Dired
+buffer (@pxref{Dired}) listing the files in the current project's root
+directory.
+
+@findex project-vc-dir
+ The command @kbd{C-x p v} (@code{project-vc-dir}) opens a VC
+Directory buffer (@pxref{VC Directory Mode}) listing the version
+control statuses of the files in a directory tree under the current
+project's root directory.
+
+@findex project-shell
+ The command @kbd{C-x p s} (@code{project-shell}) starts a shell
+session (@pxref{Shell}) in a new buffer with the current project's
+root as the working directory.
+
+@findex project-eshell
+ The command @kbd{C-x p e} (@code{project-eshell}) starts an Eshell
+session in a new buffer with the current project's root as the working
+directory. @xref{Top,Eshell,Eshell, eshell, Eshell: The Emacs Shell}.
+
+@findex project-compile
+ The command @kbd{C-x p c} (@code{project-compile}) runs compilation
+(@pxref{Compilation}) in the current project's root directory.
+
+@findex project-shell-command
+ The command @kbd{C-x p !} (@code{project-shell-command}) runs
+@code{shell-command} in the current project's root directory.
+
+@findex project-async-shell-command
+ The command @kbd{C-x p &} (@code{project-async-shell-command}) runs
+@code{async-shell-command} in the current project's root directory.
+
+@node Project Buffer Commands
+@subsection Project Commands That Operate on Buffers
+
+@table @kbd
+@item C-x p b
+Switch to another buffer belonging to the current project
+(@code{project-switch-to-buffer}).
+@item C-x p k
+Kill all live buffers that belong to the current project
+(@code{project-kill-buffers}).
+@end table
+
+@findex project-switch-to-buffer
+ Working on a project could potentially involve having many buffers
+visiting files that belong to the project, and also buffers that
+belong to the project, but don't visit any files (like the
+@file{*compilation*} buffer created by @code{project-compile}). The
+command @kbd{C-x p b} (@code{project-switch-to-buffer}) helps you
+switch between buffers that belong to the current project by prompting
+for a buffer to switch and considering only the current project's
+buffers as candidates for completion.
+
+@findex project-kill-buffers
+@vindex project-kill-buffer-conditions
+ When you finish working on the project, you may wish to kill all the
+buffers that belong to the project, to keep your Emacs session
+smaller. The command @kbd{C-x p k} (@code{project-kill-buffers})
+accomplishes that: it kills all the buffers that belong to the current
+project that satisfy any of @code{project-kill-buffer-conditions}.
+
+@node Switching Projects
+@subsection Switching Projects
+
+@table @kbd
+@item C-x p p
+Run an Emacs command for another project (@code{project-switch-project}).
+@end table
+
+@findex project-switch-project
+@vindex project-switch-commands
+ Commands that operate on project files (@pxref{Project File
+Commands}) will conveniently prompt you for a project directory when
+no project is current. When you are inside some project, but you want
+to operate on a different project, use the @kbd{C-x p p} command
+(@code{project-switch-project}). This command prompts you to choose a
+directory among known project roots, and then displays the menu of
+available commands to operate on the project you choose. The variable
+@code{project-switch-commands} controls which commands are available
+in the menu, and which key invokes each command.
+
+@vindex project-list-file
+ The variable @code{project-list-file} names the file in which Emacs
+records the list of known projects. It defaults to the file
+@file{projects} in @code{user-emacs-directory} (@pxref{Find Init}).
+
@node Change Log
@section Change Logs
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 2f02c702512..4865ee17518 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -245,13 +245,13 @@ Do an incremental search on the selected article buffer
(@code{gnus-summary-isearch-article}), as if you switched to the
buffer and typed @kbd{C-s} (@pxref{Incremental Search}).
-@kindex M-s @r{(Gnus Summary mode)}
+@kindex M-s M-s @r{(Gnus Summary mode)}
@findex gnus-summary-search-article-forward
@item M-s @var{regexp} @key{RET}
Search forward for articles containing a match for @var{regexp}
(@code{gnus-summary-search-article-forward}).
-@kindex M-r @r{(Gnus Summary mode)}
+@kindex M-s M-r @r{(Gnus Summary mode)}
@findex gnus-summary-search-article-backward
@item M-r @var{regexp} @key{RET}
Search back for articles containing a match for @var{regexp}
@@ -724,12 +724,13 @@ See the Eshell Info manual, which is distributed with Emacs.
@kindex M-!
@findex shell-command
+@vindex shell-command-buffer-name
@kbd{M-!} (@code{shell-command}) reads a line of text using the
minibuffer and executes it as a shell command, in a subshell made just
for that command. Standard input for the command comes from the null
device. If the shell command produces any output, the output appears
-either in the echo area (if it is short), or in an Emacs buffer named
-@file{*Shell Command Output*}, displayed in another window (if the
+either in the echo area (if it is short), or in the @samp{"*Shell
+Command Output*"} (@code{shell-command-buffer-name}) buffer (if the
output is long). The variables @code{resize-mini-windows} and
@code{max-mini-window-height} (@pxref{Minibuffer Edit}) control when
Emacs should consider the output to be too long for the echo area.
@@ -758,15 +759,17 @@ which is impossible to ignore.
@kindex M-&
@findex async-shell-command
+@vindex shell-command-buffer-name-async
A shell command that ends in @samp{&} is executed
@dfn{asynchronously}, and you can continue to use Emacs as it runs.
You can also type @kbd{M-&} (@code{async-shell-command}) to execute a
shell command asynchronously; this is exactly like calling @kbd{M-!}
with a trailing @samp{&}, except that you do not need the @samp{&}.
-The default output buffer for asynchronous shell commands is named
-@samp{*Async Shell Command*}. Emacs inserts the output into this
-buffer as it comes in, whether or not the buffer is visible in a
-window.
+The output from asynchronous shell commands, by default, goes into the
+@samp{"*Async Shell Command*"} buffer
+(@code{shell-command-buffer-name-async}). Emacs inserts the output
+into this buffer as it comes in, whether or not the buffer is visible
+in a window.
@vindex async-shell-command-buffer
If you want to run more than one asynchronous shell command at the
@@ -804,7 +807,7 @@ old region and replaces it with the output from the shell command.
see what keys are in the buffer. If the buffer contains a GnuPG key,
type @kbd{C-x h M-| gpg @key{RET}} to feed the entire buffer contents
to @command{gpg}. This will output the list of keys to the
-@file{*Shell Command Output*} buffer.
+buffer whose name is the value of @code{shell-command-buffer-name}.
@vindex shell-file-name
The above commands use the shell specified by the variable
@@ -2920,9 +2923,17 @@ you might like to bind to keys, such as @code{browse-url-at-point} and
You can customize Browse-URL's behavior via various options in the
@code{browse-url} Customize group. In particular, the option
@code{browse-url-mailto-function} lets you define how to follow
-@samp{mailto:} URLs, while @code{browse-url-browser-function} lets you
-define how to follow other types of URLs. For more information, view
-the package commentary by typing @kbd{C-h P browse-url @key{RET}}.
+@samp{mailto:} URLs, while @code{browse-url-browser-function}
+specifies your default browser.
+
+@vindex browse-url-handlers
+ You can define that certain URLs are browsed with other functions by
+customizing @code{browse-url-handlers}, an alist of regular
+expressions or predicates paired with functions to browse matching
+URLs.
+
+For more information, view the package commentary by typing @kbd{C-h P
+browse-url @key{RET}}.
@node Goto Address mode
@subsection Activating URLs
@@ -2934,6 +2945,9 @@ the package commentary by typing @kbd{C-h P browse-url @key{RET}}.
@table @kbd
@item M-x goto-address-mode
Activate URLs and e-mail addresses in the current buffer.
+
+@item M-x global-goto-address-mode
+Activate @code{goto-address-mode} in all buffers.
@end table
@kindex C-c RET @r{(Goto Address mode)}
@@ -3014,6 +3028,11 @@ point (@code{dired-at-point}).
@code{find-file-read-only-other-frame}.
@item C-x 5 d @var{directory} @key{RET}
@code{ffap-dired-other-frame}, analogous to @code{dired-other-frame}.
+@kindex C-x t C-f @r{(FFAP)}
+@item C-x t C-f @var{filename} @key{return}
+@code{ffap-other-tab}, analogous to @code{find-file-other-tab}.
+@item C-x t C-r @var{filename} @key{return}
+@code{ffap-read-only-other-tab}, analogous to @code{find-file-read-only-other-tab}.
@item M-x ffap-next
Search buffer for next file name or URL, then find that file or URL.
@item S-mouse-3
diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi
index 3275fded565..48492ab2f22 100644
--- a/doc/emacs/msdos.texi
+++ b/doc/emacs/msdos.texi
@@ -712,6 +712,21 @@ is @code{t}, which means these keys produce @code{AltGr}; setting it
to @code{nil} causes @key{AltGr} or the equivalent key combination to
be interpreted as the combination of @key{Ctrl} and @key{Meta}
modifiers.
+
+@cindex IME, MS-Windows
+@findex w32-set-ime-open-status
+ Some versions of MS-Windows, typically East Asian localized Windows,
+enable the Input Method Manager (@acronym{IMM}) that allows
+applications to communicate with the Input Method Editor
+(@acronym{IME}), the native Windows input method service. Emacs uses
+the @acronym{IME} when available to allow users to input East Asian
+non-@acronym{ASCII} characters, similarly to Emacs's built-in input
+methods (@pxref{Input Methods}). However, in some situations the
+@acronym{IME} can get in the way if it interprets simple
+@acronym{ASCII} keys you input as part of a key sequence that
+designates a non-@acronym{ASCII} character. The @acronym{IME} can be
+temporarily turned off and then on again by using the
+@code{w32-set-ime-open-status} function.
@end ifnottex
@node Windows Mouse
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index 0f07d286cda..b78019020a6 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -202,7 +202,7 @@ terminal, the code(s) sent to the terminal.
@item
If the character was composed on display with any following characters
to form one or more grapheme clusters, the composition information:
-the font glyphs if the frame is on a graphical display, else the
+the font glyphs if the frame is on a graphical display, and the
characters that were composed.
@item
@@ -1215,11 +1215,8 @@ system can encode.
If @code{file-name-coding-system} is @code{nil}, Emacs uses a
default coding system determined by the selected language environment,
-and stored in the @code{default-file-name-coding-system} variable.
-@c FIXME? Is this correct? What is the "default language environment"?
-In the default language environment, non-@acronym{ASCII} characters in
-file names are not encoded specially; they appear in the file system
-using the internal Emacs representation.
+and stored in the @code{default-file-name-coding-system} variable
+(normally UTF-8).
@cindex file-name encoding, MS-Windows
@vindex w32-unicode-filenames
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index 517d2b75aa2..453d9eb4010 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -165,27 +165,6 @@ Refresh the package list (@code{revert-buffer}). This fetches the
list of available packages from the package archive again, and
redisplays the package list.
-@item / k
-@kindex / k @r{(Package Menu)}
-@findex package-menu-filter-by-keyword
-Filter the package list by keyword
-(@code{package-menu-filter-by-keyword}). This prompts for a keyword
-(e.g., @samp{games}), then shows only the packages that relate to that
-keyword.
-
-@item / n
-@kindex / n @r{(Package Menu)}
-@findex package-menu-filter-by-name
-Filter the package list by name (@code{package-menu-filter-by-name}).
-This prompts for a string, then shows only the packages whose names
-match a regexp with that value.
-
-@item / /
-@kindex / / @r{(Package Menu)}
-@findex package-menu-clear-filter
-Clear filter currently applied to the package list
-(@code{package-menu-clear-filter}).
-
@item H
@kindex H @r{(Package Menu)}
@findex package-menu-hide-package
@@ -200,6 +179,54 @@ pressing @key{RET} to the prompt will hide the current package.
@findex package-menu-toggle-hiding
Toggle visibility of old versions of packages and also of versions
from lower-priority archives (@code{package-menu-toggle-hiding}).
+
+@item / a
+@kindex / a @r{(Package Menu)}
+@findex package-menu-filter-by-archive
+Filter package list by archive (@code{package-menu-filter-by-archive}).
+This prompts for a package archive (e.g., @samp{gnu}), then shows only
+packages from that archive.
+
+@item / k
+@kindex / k @r{(Package Menu)}
+@findex package-menu-filter-by-keyword
+Filter package list by keyword (@code{package-menu-filter-by-keyword}).
+This prompts for a keyword (e.g., @samp{games}), then shows only
+packages with that keyword.
+
+@item / n
+@kindex / n @r{(Package Menu)}
+@findex package-menu-filter-by-name
+Filter package list by name (@code{package-menu-filter-by-name}).
+This prompts for a regular expression, then shows only packages
+with names matching that regexp.
+
+@item / s
+@kindex / s @r{(Package Menu)}
+@findex package-menu-filter-by-status
+Filter package list by status (@code{package-menu-filter-by-status}).
+This prompts for one or more statuses (e.g., @samp{available}), then
+shows only packages with matching status.
+
+@item / v
+@kindex / v @r{(Package Menu)}
+@findex package-menu-filter-by-version
+Filter package list by version (@code{package-menu-filter-by-version}).
+This prompts first for one of the qualifiers @samp{<}, @samp{>} or
+@samp{=}, and then a package version, and shows packages that has a
+lower, equal or higher version than the one specified.
+
+@item / m
+@kindex / m @r{(Package Menu)}
+@findex package-menu-filter-marked
+Filter package list by non-empty mark (@code{package-menu-filter-marked}).
+This shows only the packages that have been marked to be installed or deleted.
+
+@item / /
+@kindex / / @r{(Package Menu)}
+@findex package-menu-filter-clear
+Clear filter currently applied to the package list
+(@code{package-menu-filter-clear}).
@end table
@noindent
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index b976f2e7b12..f0dd62dad45 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -1269,9 +1269,35 @@ information whenever there is a Lisp function or variable at point;
for a function, it shows the argument list, and for a variable it
shows the first line of the variable's documentation string. To
toggle ElDoc mode, type @kbd{M-x eldoc-mode}. There's also a Global
-ElDoc mode, which is turned on by default, and affects buffers, such
-as @samp{*scratch*}, whose major mode is Emacs Lisp or Lisp
-Interaction (@w{@kbd{M-x global-eldoc-mode}} to turn it off globally).
+ElDoc mode, which is turned on by default, and affects buffers whose
+major mode sets the variables described below. Use @w{@kbd{M-x
+global-eldoc-mode}} to turn it off globally.
+
+@vindex eldoc-documentation-strategy
+@vindex eldoc-documentation-functions
+ These variables can be used to configure ElDoc mode:
+
+@table @code
+@item eldoc-documentation-strategy
+This variable holds the function which is used to retrieve
+documentation for the item at point from the functions in the hook
+@code{eldoc-documentation-functions}. By default,
+@code{eldoc-documentation-strategy} returns the first documentation
+string produced by the @code{eldoc-documentation-functions} hook, but
+it may be customized to compose those functions' results in other
+ways.
+
+@item eldoc-documentation-functions
+This abnormal hook holds documentation functions. It acts as a
+collection of backends for ElDoc. This is what modes should use to
+register their documentation functions with ElDoc.
+
+@vindex eldoc-display-truncation-message
+@item eldoc-display-truncation-message
+If non-@code{nil} (the default), display a verbose message about how
+to view a complete documentation (if it has been truncated in the echo
+area). If @code{nil}, just mark truncated messages with @samp{...}.
+@end table
@node Hideshow
@section Hideshow minor mode
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index 2e094f3ad92..d982a9e8787 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -1977,6 +1977,19 @@ performs case folding and lax-whitespace matching.
using the @code{isearch} face. This highlighting can be disabled by
setting the variable @code{search-highlight} to @code{nil}.
+@vindex search-highlight-submatches
+ When searching for regular expressions (with @kbd{C-M-s}, for
+instance), subexpressions receive special highlighting depending on
+the @code{search-highlight-submatches} variable. If this variable's
+value is @code{nil}, no special highlighting is done, but if the value
+is non-@code{nil}, text that matches @samp{\( @dots{} \)} constructs
+(a.k.a.@: ``subexpressions'') in the regular expression will be
+highlighted with distinct faces, named @code{isearch-group-odd}
+for the odd group matches, and @code{isearch-group-even}
+for the even group matches. For instance, when searching for
+@samp{foo-\([0-9]+\)}, the part matched by @samp{[0-9]+} will be
+highlighted with the @code{isearch-group-odd} face.
+
@cindex lazy highlighting customizations
@vindex isearch-lazy-highlight
@cindex @code{lazy-highlight} face
diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi
index 33f67f2b442..dbd1a075573 100644
--- a/doc/emacs/trouble.texi
+++ b/doc/emacs/trouble.texi
@@ -721,18 +721,24 @@ will be sent to the Emacs maintainers at
@ifhtml
@url{https://lists.gnu.org/mailman/listinfo/bug-gnu-emacs, bug-gnu-emacs}.
@end ifhtml
-(If you want to suggest an improvement or new feature, use the same
-address.) If you cannot send mail from inside Emacs, you can copy the
+If you cannot send mail from inside Emacs, you can copy the
text of your report to your normal mail client (if your system
supports it, you can type @kbd{C-c M-i} to have Emacs do this for you)
and send it to that address. Or you can simply send an email to that
address describing the problem.
-Your report will be sent to the @samp{bug-gnu-emacs} mailing list, and
-stored in the GNU Bug Tracker at @url{https://debbugs.gnu.org}. Please
-include a valid reply email address, in case we need to ask you for
-more information about your report. Submissions are moderated, so
-there may be a delay before your report appears.
+If you want to submit code to Emacs (to fix a problem or implement a
+new feature), the easiest way to do this is to send a patch to the
+Emacs issue tracker. This is done with the @kbd{M-x
+submit-emacs-patch} command, and works much the same as when reporting
+bugs.
+
+In any case, your report will be sent to the @samp{bug-gnu-emacs}
+mailing list, and stored in the GNU Bug Tracker at
+@url{https://debbugs.gnu.org}. Please include a valid reply email
+address, in case we need to ask you for more information about your
+report. Submissions are moderated, so there may be a delay before
+your report appears.
You do not need to know how the GNU Bug Tracker works in order to
report a bug, but if you want to, you can read the tracker's online
diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi
index 4c67660b92d..bc1dcd7f419 100644
--- a/doc/emacs/windows.texi
+++ b/doc/emacs/windows.texi
@@ -251,9 +251,19 @@ Mail}), but in another window (@code{compose-mail-other-window}).
Find the definition of an identifier, similar to @kbd{M-.}
(@pxref{Xref}), but in another window
(@code{xref-find-definitions-other-window}).
+
@item C-x 4 r @var{filename} @key{RET}
Visit file @var{filename} read-only, and select its buffer in another
window (@code{find-file-read-only-other-window}). @xref{Visiting}.
+
+@item C-x 4 4
+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 window.
+
+@item C-x 4 1
+This general prefix command requests the buffer of the next command
+to be displayed in the same window.
@end table
@node Change Window
diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi
index e6c54efba73..9aefe1da17a 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -929,7 +929,7 @@ GNU Emacs Lisp is largely inspired by Maclisp, which was written at MIT
in the 1960s. It is somewhat inspired by Common Lisp, which became a
standard in the 1980s. However, Emacs Lisp is much simpler than Common
Lisp. (The standard Emacs distribution contains an optional extensions
-file, @file{cl.el}, that adds many Common Lisp features to Emacs Lisp.)
+file, @file{cl-lib.el}, that adds many Common Lisp features to Emacs Lisp.)
@node Note for Novices
@unnumberedsec A Note for Novices
diff --git a/doc/lispref/backups.texi b/doc/lispref/backups.texi
index 4ed1a10fcf6..379279575ca 100644
--- a/doc/lispref/backups.texi
+++ b/doc/lispref/backups.texi
@@ -414,10 +414,16 @@ version that the caller should consider deleting now.
@end smallexample
@end defun
-@c Emacs 19 feature
+@defun file-backup-file-names filename
+This function returns a list of all the backup file names for
+@var{filename}, or @code{nil} if there are none. The files are sorted
+by modification time, descending, so that the most recent files are
+first.
+@end defun
+
@defun file-newest-backup filename
-This function returns the name of the most recent backup file for
-@var{filename}, or @code{nil} if that file has no backup files.
+This function returns the first element of the list returned by
+@code{file-backup-file-names}.
Some file comparison commands use this function so that they can
automatically compare a file with its most recent backup.
@@ -460,6 +466,32 @@ Auto Save mode is enabled if @code{buffer-auto-save-file-name} is
non-@code{nil} and @code{buffer-saved-size} (see below) is non-zero.
@end deffn
+@defvar auto-save-file-name-transforms
+This variable lists transforms to apply to buffer's file name before
+making the auto-save file name.
+
+Each transform is a list of the form @w{@code{(@var{regexp}
+@var{replacement} [@var{uniquify}])}}. @var{regexp} is a regular
+expression to match against the file name; if it matches,
+@code{replace-match} is used to replace the matching part with
+@var{replacement}. If the optional element @var{uniquify} is non-nil,
+the auto-save file name is constructed by concatenating the directory
+part of the transformed file name with the buffer's file name in which
+all directory separators were changed to @samp{!} to prevent clashes.
+(This will not work correctly if your filesystem truncates the
+resulting name.)
+
+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.
+
+The default value is set up to put the auto-save files of remote files
+into the temporary directory (@pxref{Unique File Names}).
+
+On MS-DOS filesystems without long names this variable is always
+ignored.
+@end defvar
+
@defun auto-save-file-name-p filename
This function returns a non-@code{nil} value if @var{filename} is a
string that could be the name of an auto-save file. It assumes
@@ -481,21 +513,6 @@ name. The argument @var{filename} should not contain a directory part.
@result{} nil
@end group
@end example
-
-The standard definition of this function is as follows:
-
-@example
-@group
-(defun auto-save-file-name-p (filename)
- "Return non-nil if FILENAME can be yielded by..."
- (string-match "^#.*#$" filename))
-@end group
-@end example
-
-This function exists so that you can customize it if you wish to
-change the naming convention for auto-save files. If you redefine it,
-be sure to redefine the function @code{make-auto-save-file-name}
-correspondingly.
@end defun
@defun make-auto-save-file-name
@@ -511,31 +528,6 @@ function should check that variable first.
@result{} "/xcssun/users/rms/lewis/#backups.texi#"
@end group
@end example
-
-Here is a simplified version of the standard definition of this
-function:
-
-@example
-@group
-(defun make-auto-save-file-name ()
- "Return file name to use for auto-saves \
-of current buffer.."
- (if buffer-file-name
-@end group
-@group
- (concat
- (file-name-directory buffer-file-name)
- "#"
- (file-name-nondirectory buffer-file-name)
- "#")
- (expand-file-name
- (concat "#%" (buffer-name) "#"))))
-@end group
-@end example
-
-This exists as a separate function so that you can redefine it to
-customize the naming convention for auto-save files. Be sure to
-change @code{auto-save-file-name-p} in a corresponding way.
@end defun
@defopt auto-save-visited-file-name
diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi
index 2a72276bc56..85912470795 100644
--- a/doc/lispref/customize.texi
+++ b/doc/lispref/customize.texi
@@ -124,6 +124,11 @@ Link to the documentation of a variable; @var{variable} is a string
which specifies the name of the variable to describe with
@code{describe-variable} when the user invokes this link.
+@item (face-link @var{face})
+Link to the documentation of a face; @var{face} is a string which
+specifies the name of the face to describe with @code{describe-face}
+when the user invokes this link.
+
@item (custom-group-link @var{group})
Link to another customization group. Invoking it creates a new
customization buffer for @var{group}.
@@ -358,6 +363,10 @@ This is meaningful only for certain types, currently including
@code{hook}, @code{plist} and @code{alist}. See the definition of the
individual types for a description of how to use @code{:options}.
+Re-evaluating a @code{defcustom} form with a different @code{:options}
+value does not clear the values added by previous evaluations, or
+added by calls to @code{custom-add-frequent-value} (see below).
+
@item :set @var{setfunction}
@kindex set@r{, @code{defcustom} keyword}
Specify @var{setfunction} as the way to change the value of this
@@ -485,6 +494,10 @@ list of reasonable values.
The precise effect of adding a value depends on the customization type
of @var{symbol}.
+
+Since evaluating a @code{defcustom} form does not clear values added
+previously, Lisp programs can use this function to add values for user
+options not yet defined.
@end defun
Internally, @code{defcustom} uses the symbol property
@@ -1189,6 +1202,13 @@ current value is valid for the widget. Otherwise, it should return
the widget containing the invalid data, and set that widget's
@code{:error} property to a string explaining the error.
+@item :type-error @var{string}
+@kindex type-error@r{, customization keyword}
+@var{string} should be a string that describes why a value doesn't
+match the type, as determined by the @code{:match} function. When the
+@code{:match} function returns @code{nil}, the widget's @code{:error}
+property will be set to @var{string}.
+
@ignore
@item :indent @var{columns}
Indent this item by @var{columns} columns. The indentation is used for
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index be2de000c35..7d1c14c8169 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -1318,12 +1318,6 @@ the buffer specified by @var{buffer-or-name} current for running
@var{body}.
@end defmac
-@defmac with-displayed-buffer-window buffer-or-name action quit-function &rest body
-This macro is like @code{with-current-buffer-window} but unlike that
-displays the buffer specified by @var{buffer-or-name} @emph{before}
-running @var{body}.
-@end defmac
-
A window showing a temporary buffer can be fitted to the size of that
buffer using the following mode:
@@ -2462,12 +2456,15 @@ Draw a box with lines of width 1, in the foreground color.
@item @var{color}
Draw a box with lines of width 1, in color @var{color}.
-@item @code{(:line-width @var{width} :color @var{color} :style @var{style})}
-This way you can explicitly specify all aspects of the box. The value
-@var{width} specifies the width of the lines to draw; it defaults to
-1. A negative width @minus{}@var{n} means to draw a line of width @var{n}
-whose top and bottom parts occupy the space of the underlying text,
-thus avoiding any increase in the character height.
+@item @code{(:line-width (@var{vwidth} . @var{hwidth}) :color @var{color} :style @var{style})}
+This way you can explicitly specify all aspects of the box. The values
+@var{vwidth} and @var{hwidth} specifies respectively the width of the
+vertical and horizontal lines to draw; they default to (1 . 1).
+A negative horizontal or vertical width @minus{}@var{n} means to draw a line
+of width @var{n} that occupies the space of the underlying text, thus
+avoiding any increase in the character height or width. For simplification
+the width could be specified with only a single number @var{n} instead
+of a list, such case is equivalent to @code{((abs @var{n}) . @var{n})}.
The value @var{color} specifies the color to draw with. The default is
the foreground color of the face for simple boxes, and the background
@@ -5578,6 +5575,15 @@ The value, @var{width}, specifies the width of the image, in pixels.
@item :height @var{height}
The value, @var{height}, specifies the height of the image, in pixels.
+Note that @code{:width} and @code{:height} can only be used if passing
+in data that doesn't specify the width and height (e.g., a string or a
+vector containing the bits of the image). @acronym{XBM} files usually
+specify this themselves, and it's an error to use these two properties
+on these files. Also note that @code{:width} and @code{:height} are
+used by most other image formats to specify what the displayed image
+is supposed to be, which usually means performing some sort of
+scaling. This isn't supported for @acronym{XBM} images.
+
@item :stride @var{stride}
The number of bool vector entries stored for each row; the smallest
multiple of 8 greater than or equal to @var{width}.
@@ -6923,6 +6929,9 @@ such as @code{forward-button} and @code{backward-button} are
additionally available in the keymap stored in
@code{button-buffer-map}; a mode which uses buttons may want to use
@code{button-buffer-map} as a parent keymap for its keymap.
+Alternatively, the @code{button-mode} can be switched on for much the
+same effect: It's a minor mode that does nothing else than install
+@code{button-buffer-map} as a minor mode keymap.
If the button has a non-@code{nil} @code{follow-link} property, and
@code{mouse-1-click-follows-link} is set, a quick @key{mouse-1} click
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index b5b5ea0a645..6404e068dae 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -1362,6 +1362,11 @@ while matching the remainder of the specifications at this level. This
is primarily used to generate more specific syntax error messages. See
@ref{Backtracking}, for more details. Also see the @code{let} example.
+@item &error
+@code{&error} should be followed by a string, an error message, in the
+edebug-spec; it aborts the instrumentation, displaying the message in
+the minibuffer.
+
@item @var{other-symbol}
@cindex indirect specifications
Any other symbol in a specification list may be a predicate or an
@@ -1433,6 +1438,16 @@ 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{&})
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 6ca2834fbd4..92cbc2a1c91 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -928,7 +928,7 @@ also checks that the file's group would be unchanged.
This function does not follow symbolic links.
@end defun
-@defun file-modes filename
+@defun file-modes filename &optional flag
@cindex mode bits
@cindex file permissions
@cindex permissions, file
@@ -946,12 +946,19 @@ The highest possible value is 4095 (7777 octal), meaning that everyone
has read, write, and execute permission, the @acronym{SUID} bit is set
for both others and group, and the sticky bit is set.
+By default this function follows symbolic links. However, if the
+optional argument @var{flag} is the symbol @code{nofollow}, this
+function does not follow @var{filename} if it is a symbolic link;
+this can help prevent inadvertently obtaining the mode bits of a file
+somewhere else, and is more consistent with @code{file-attributes}
+(@pxref{File Attributes}).
+
@xref{Changing Files}, for the @code{set-file-modes} function, which
can be used to set these permissions.
@example
@group
-(file-modes "~/junk/diffs")
+(file-modes "~/junk/diffs" 'nofollow)
@result{} 492 ; @r{Decimal integer.}
@end group
@group
@@ -960,7 +967,7 @@ can be used to set these permissions.
@end group
@group
-(set-file-modes "~/junk/diffs" #o666)
+(set-file-modes "~/junk/diffs" #o666 'nofollow)
@result{} nil
@end group
@@ -1801,9 +1808,17 @@ See also @code{delete-directory} in @ref{Create/Delete Dirs}.
@cindex file permissions, setting
@cindex permissions, file
@cindex file modes, setting
-@deffn Command set-file-modes filename mode
+@deffn Command set-file-modes filename mode &optional flag
This function sets the @dfn{file mode} (or @dfn{permissions}) of
-@var{filename} to @var{mode}. This function follows symbolic links.
+@var{filename} to @var{mode}.
+
+By default this function follows symbolic links. However, if the
+optional argument @var{flag} is the symbol @code{nofollow}, this
+function does not follow @var{filename} if it is a symbolic link;
+this can help prevent inadvertently changing the mode bits of a file
+somewhere else. On platforms that do not support changing mode bits
+on a symbolic link, this function signals an error when @var{filename}
+is a symbolic link and @var{flag} is @code{nofollow}.
If called non-interactively, @var{mode} must be an integer. Only the
lowest 12 bits of the integer are used; on most systems, only the
@@ -1811,7 +1826,7 @@ lowest 9 bits are meaningful. You can use the Lisp construct for
octal numbers to enter @var{mode}. For example,
@example
-(set-file-modes #o644)
+(set-file-modes "myfile" #o644 'nofollow)
@end example
@noindent
@@ -1894,11 +1909,24 @@ omitted or @code{nil}, it defaults to 0, i.e., no access rights at
all.
@end defun
-@defun set-file-times filename &optional time
+@defun file-modes-number-to-symbolic modes
+This function converts a numeric file mode specification in
+@var{modes} into the equivalent symbolic form.
+@end defun
+
+@defun set-file-times filename &optional time flag
This function sets the access and modification times of @var{filename}
to @var{time}. The return value is @code{t} if the times are successfully
set, otherwise it is @code{nil}. @var{time} defaults to the current
time and must be a time value (@pxref{Time of Day}).
+
+By default this function follows symbolic links. However, if the
+optional argument @var{flag} is the symbol @code{nofollow}, this
+function does not follow @var{filename} if it is a symbolic link;
+this can help prevent inadvertently changing the times of a file
+somewhere else. On platforms that do not support changing times
+on a symbolic link, this function signals an error when @var{filename}
+is a symbolic link and @var{flag} is @code{nofollow}.
@end defun
@defun set-file-extended-attributes filename attribute-alist
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index ae61b269520..22d32c00d9b 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -2193,10 +2193,11 @@ it and see if it works.)
@vindex ns-appearance@r{, a frame parameter}
@item ns-appearance
Only available on macOS, if set to @code{dark} draw this frame's
-window-system window using the ``vibrant dark'' theme, otherwise use
-the system default. The ``vibrant dark'' theme can be used to set the
-toolbar and scrollbars to a dark appearance when using an Emacs theme
-with a dark background.
+window-system window using the ``vibrant dark'' theme, and if set to
+@code{light} use the ``aqua'' theme, otherwise use the system default.
+The ``vibrant dark'' theme can be used to set the toolbar and
+scrollbars to a dark appearance when using an Emacs theme with a dark
+background.
@vindex ns-transparent-titlebar@r{, a frame parameter}
@item ns-transparent-titlebar
@@ -2220,6 +2221,9 @@ How to display the cursor. Legitimate values are:
@table @code
@item box
Display a filled box. (This is the default.)
+@item (box . @var{size})
+Display a filled box. However, display it as a hollow box if point is
+under masked image larger than @var{size} pixels in either dimension.
@item hollow
Display a hollow box.
@item nil
@@ -3872,13 +3876,15 @@ detailed knowledge of what types other applications use for drag and
drop.
@vindex dnd-protocol-alist
+@vindex browse-url-handlers
+@vindex browse-url-default-handlers
When an URL is dropped on Emacs it may be a file, but it may also be
another URL type (https, etc.). Emacs first checks
@code{dnd-protocol-alist} to determine what to do with the URL@. If
-there is no match there and if @code{browse-url-browser-function} is
-an alist, Emacs looks for a match there. If no match is found the
-text for the URL is inserted. If you want to alter Emacs behavior,
-you can customize these variables.
+there is no match there, Emacs looks for a match in
+@code{browse-url-handlers} and @code{browse-url-default-handlers}. If
+still no match has been found, the text for the URL is inserted. If
+you want to alter Emacs behavior, you can customize these variables.
@node Color Names
@section Color Names
@@ -3970,11 +3976,11 @@ If @var{color} is not defined, the value is @code{nil}.
(color-values "black")
@result{} (0 0 0)
(color-values "white")
- @result{} (65280 65280 65280)
+ @result{} (65535 65535 65535)
(color-values "red")
- @result{} (65280 0 0)
+ @result{} (65535 0 0)
(color-values "pink")
- @result{} (65280 49152 51968)
+ @result{} (65535 49344 52171)
(color-values "hungry")
@result{} nil
@end example
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 2898cb4d2b4..e8e22078d9b 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -762,6 +762,11 @@ arguments, rather than a single list. We say that @code{apply}
@dfn{spreads} this list so that each individual element becomes an
argument.
+@code{apply} with a single argument is special: the first element of
+the argument, which must be a non-empty list, is called as a function
+with the remaining elements as individual arguments. Passing two or
+more arguments will be faster.
+
@code{apply} returns the result of calling @var{function}. As with
@code{funcall}, @var{function} must either be a Lisp function or a
primitive function; special forms and macros do not make sense in
@@ -789,6 +794,11 @@ primitive function; special forms and macros do not make sense in
(apply 'append '((a b c) nil (x y z) nil))
@result{} (a b c x y z)
@end group
+
+@group
+(apply '(+ 3 4))
+ @result{} 7
+@end group
@end example
For an interesting example of using @code{apply}, see @ref{Definition
@@ -2163,15 +2173,24 @@ the backquote (@pxref{Backquote}), but quotes code and accepts only
@end defmac
@defmac inline-letevals (bindings@dots{}) body@dots{}
-This is similar to @code{let} (@pxref{Local Variables}): it sets up
-local variables as specified by @var{bindings}, and then evaluates
-@var{body} with those bindings in effect. Each element of
-@var{bindings} should be either a symbol or a list of the form
-@w{@code{(@var{var} @var{expr})}}; the result is to evaluate
-@var{expr} and bind @var{var} to the result. The tail of
-@var{bindings} can be either @code{nil} or a symbol which should hold
-a list of arguments, in which case each argument is evaluated, and the
-symbol is bound to the resulting list.
+This provides a convenient way to ensure that the arguments to an
+inlined function are evaluated exactly once, as well as to create
+local variables.
+
+It's similar to @code{let} (@pxref{Local Variables}): It sets up local
+variables as specified by @var{bindings}, and then evaluates
+@var{body} with those bindings in effect.
+
+Each element of @var{bindings} should be either a symbol or a list of
+the form @w{@code{(@var{var} @var{expr})}}; the result is to evaluate
+@var{expr} and bind @var{var} to the result. However, when an element
+of @var{bindings} is just a symbol @var{var}, the result of evaluating
+@var{var} is re-bound to @var{var} (which is quite different from the
+way @code{let} works).
+
+The tail of @var{bindings} can be either @code{nil} or a symbol which
+should hold a list of arguments, in which case each argument is
+evaluated, and the symbol is bound to the resulting list.
@end defmac
@defmac inline-const-p expression
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index 9b3c4fcb23d..d4505d5c3ff 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -220,7 +220,8 @@ in the *Help* buffer."
@group
;; @r{Display the data.}
- (help-setup-xref (list 'describe-symbols pattern) (interactive-p))
+ (help-setup-xref (list 'describe-symbols pattern)
+ (called-interactively-p 'interactive))
(with-help-window (help-buffer)
(mapcar describe-func (sort sym-list 'string<)))))
@end group
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index e5b535bdab2..fed9612e329 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -1228,9 +1228,9 @@ the @var{runtime} structure with the value compiled into the module:
@example
int
-emacs_module_init (struct emacs_runtime *ert)
+emacs_module_init (struct emacs_runtime *runtime)
@{
- if (ert->size < sizeof (*ert))
+ if (runtime->size < sizeof (*runtime))
return 1;
@}
@end example
@@ -1247,7 +1247,7 @@ assumes it is part of the @code{emacs_module_init} function shown
above:
@example
- emacs_env *env = ert->get_environment (ert);
+ emacs_env *env = runtime->get_environment (runtime);
if (env->size < sizeof (*env))
return 2;
@end example
@@ -1264,7 +1264,7 @@ Emacs, by comparing the size of the environment passed by Emacs with
known sizes, like this:
@example
- emacs_env *env = ert->get_environment (ert);
+ emacs_env *env = runtime->get_environment (runtime);
if (env->size >= sizeof (struct emacs_env_26))
emacs_version = 26; /* Emacs 26 or later. */
else if (env->size >= sizeof (struct emacs_env_25))
@@ -1314,7 +1314,8 @@ subsection describes how to write such @dfn{module functions}.
A module function has the following general form and signature:
-@deftypefn Function emacs_value module_func (emacs_env *@var{env}, ptrdiff_t @var{nargs}, emacs_value *@var{args}, void *@var{data})
+@deftypefn Function emacs_value emacs_function (emacs_env *@var{env}, ptrdiff_t @var{nargs}, emacs_value *@var{args}, void *@var{data})
+@tindex emacs_function
The @var{env} argument provides a pointer to the @acronym{API}
environment, needed to access Emacs objects and functions. The
@var{nargs} argument is the required number of arguments, which can be
@@ -1323,7 +1324,7 @@ of the argument number), and @var{args} is a pointer to the array of
the function arguments. The argument @var{data} points to additional
data required by the function, which was arranged when
@code{make_function} (see below) was called to create an Emacs
-function from @code{module_func}.
+function from @code{emacs_function}.
Module functions use the type @code{emacs_value} to communicate Lisp
objects between Emacs and the module (@pxref{Module Values}). The
@@ -1338,6 +1339,10 @@ However, if the user typed @kbd{C-g}, or if the module function or its
callees signaled an error or exited nonlocally (@pxref{Module
Nonlocal}), Emacs will ignore the returned value and quit or throw as
it does when Lisp code encounters the same situations.
+
+The header @file{emacs-module.h} provides the type
+@code{emacs_function} as an alias type for a function pointer to a
+module function.
@end deftypefn
After writing your C code for a module function, you should make a
@@ -1348,11 +1353,11 @@ normally done in the module initialization function (@pxref{module
initialization function}), after verifying the @acronym{API}
compatibility.
-@deftypefn Function emacs_value make_function (emacs_env *@var{env}, ptrdiff_t @var{min_arity}, ptrdiff_t @var{max_arity}, subr @var{func}, const char *@var{docstring}, void *@var{data})
+@deftypefn Function emacs_value make_function (emacs_env *@var{env}, ptrdiff_t @var{min_arity}, ptrdiff_t @var{max_arity}, emacs_function @var{func}, const char *@var{docstring}, void *@var{data})
@vindex emacs_variadic_function
This returns an Emacs function created from the C function @var{func},
-whose signature is as described for @code{module_func} above (assumed
-here to be @code{typedef}'ed as @code{subr}). The arguments
+whose signature is as described for @code{emacs_function} above.
+The arguments
@var{min_arity} and @var{max_arity} specify the minimum and maximum
number of arguments that @var{func} can accept. The @var{max_arity}
argument can have the special value @code{emacs_variadic_function},
@@ -1388,7 +1393,7 @@ Combining the above steps, code that arranges for a C function
look like this, as part of the module initialization function:
@example
- emacs_env *env = ert->get_environment (ert);
+ emacs_env *env = runtime->get_environment (runtime);
emacs_value func = env->make_function (env, min_arity, max_arity,
module_func, docstring, data);
emacs_value symbol = env->intern (env, "module-func");
@@ -1420,28 +1425,94 @@ violations of the above requirements. @xref{Initial Options,,,emacs,
The GNU Emacs Manual}.
Using the module @acronym{API}, it is possible to define more complex
-function and data types: interactive functions, inline functions,
-macros, etc. However, the resulting C code will be cumbersome and
-hard to read. Therefore, we recommend that you limit the module code
-which creates functions and data structures to the absolute minimum,
-and leave the rest for a Lisp package that will accompany your module,
-because doing these additional tasks in Lisp is much easier, and will
-produce a much more readable code. For example, given a module
-function @code{module-func} defined as above, one way of making an
-interactive command @code{module-cmd} based on it is with the
-following simple Lisp wrapper:
+function and data types: inline functions, macros, etc. However, the
+resulting C code will be cumbersome and hard to read. Therefore, we
+recommend that you limit the module code which creates functions and
+data structures to the absolute minimum, and leave the rest for a Lisp
+package that will accompany your module, because doing these
+additional tasks in Lisp is much easier, and will produce a much more
+readable code. For example, given a module function
+@code{module-func} defined as above, one way of making a macro
+@code{module-macro} based on it is with the following simple Lisp
+wrapper:
@lisp
-(defun module-cmd (&rest args)
- "Documentation string for the command."
- (interactive @var{spec})
- (apply 'module-func args))
+(defmacro module-macro (&rest args)
+ "Documentation string for the macro."
+ (module-func args))
@end lisp
The Lisp package which goes with your module could then load the
module using the @code{load} primitive (@pxref{Dynamic Modules}) when
the package is loaded into Emacs.
+By default, module functions created by @code{make_function} are not
+interactive. To make them interactive, you can use the following
+function.
+
+@deftypefun void make_interactive (emacs_env *@var{env}, emacs_value @var{function}, emacs_value @var{spec})
+This function, which is available since Emacs 28, makes the function
+@var{function} interactive using the interactive specification
+@var{spec}. Emacs interprets @var{spec} like the argument to the
+@code{interactive} form. @ref{Using Interactive}, and
+@pxref{Interactive Codes}. @var{function} must be an Emacs module
+function returned by @code{make_function}.
+@end deftypefun
+
+Note that there is no native module support for retrieving the
+interactive specification of a module function. Use the function
+@code{interactive-form} for that. @ref{Using Interactive}. It is not
+possible to make a module function non-interactive once you have made
+it interactive using @code{make_interactive}.
+
+@anchor{Module Function Finalizers}
+If you want to run some code when a module function object (i.e., an
+object returned by @code{make_function}) is garbage-collected, you can
+install a @dfn{function finalizer}. Function finalizers are available
+since Emacs 28. For example, if you have passed some heap-allocated
+structure to the @var{data} argument of @code{make_function}, you can
+use the finalizer to deallocate the structure. @xref{Basic
+Allocation,,,libc}, and @pxref{Freeing after Malloc,,,libc}. The
+finalizer function has the following signature:
+
+@example
+void finalizer (void *@var{data})
+@end example
+
+Here, @var{data} receives the value passed to @var{data} when calling
+@code{make_function}. Note that the finalizer can't interact with
+Emacs in any way.
+
+Directly after calling @code{make_function}, the newly-created
+function doesn't have a finalizer. Use @code{set_function_finalizer}
+to add one, if desired.
+
+@deftypefun void emacs_finalizer (void *@var{ptr})
+The header @file{emacs-module.h} provides the type
+@code{emacs_finalizer} as a type alias for an Emacs finalizer
+function.
+@end deftypefun
+
+@deftypefun emacs_finalizer get_function_finalizer (emacs_env *@var{env}, emacs_value @var{arg})
+This function, which is available since Emacs 28, returns the function
+finalizer associated with the module function represented by
+@var{arg}. @var{arg} must refer to a module function, that is, an
+object returned by @code{make_function}. If no finalizer is
+associated with the function, @code{NULL} is returned.
+@end deftypefun
+
+@deftypefun void set_function_finalizer (emacs_env *@var{env}, emacs_value @var{arg}, emacs_finalizer @var{fin})
+This function, which is available since Emacs 28, sets the function
+finalizer associated with the module function represented by @var{arg}
+to @var{fin}. @var{arg} must refer to a module function, that is, an
+object returned by @code{make_function}. @var{fin} can either be
+@code{NULL} to clear @var{arg}'s function finalizer, or a pointer to a
+function to be called when the object represented by @var{arg} is
+garbage-collected. At most one function finalizer can be set per
+function; if @var{arg} already has a finalizer, it is replaced by
+@var{fin}.
+@end deftypefun
+
@node Module Values
@subsection Conversion Between Lisp and Module Values
@cindex module values, conversion
@@ -1541,12 +1612,11 @@ This function returns the value of a Lisp float specified by
@var{arg}, as a C @code{double} value.
@end deftypefn
-@deftypefn Function struct timespec extract_time (emacs_env *@var{env}, emacs_value @var{time})
-This function, which is available since Emacs 27, interprets
-@var{time} as an Emacs Lisp time value and returns the corresponding
-@code{struct timespec}. @xref{Time of Day}. @code{struct timespec}
-represents a timestamp with nanosecond precision. It has the
-following members:
+@deftypefn Function struct timespec extract_time (emacs_env *@var{env}, emacs_value @var{arg})
+This function, which is available since Emacs 27, interprets @var{arg}
+as an Emacs Lisp time value and returns the corresponding @code{struct
+timespec}. @xref{Time of Day}. @code{struct timespec} represents a
+timestamp with nanosecond precision. It has the following members:
@table @code
@item time_t tv_sec
@@ -1744,9 +1814,9 @@ next_prime (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
@}
int
-emacs_module_init (struct emacs_runtime *ert)
+emacs_module_init (struct emacs_runtime *runtime)
@{
- emacs_env *env = ert->get_environment (ert);
+ emacs_env *env = runtime->get_environment (runtime);
emacs_value symbol = env->intern (env, "next-prime");
emacs_value func
= env->make_function (env, 1, 1, next_prime, NULL, NULL);
@@ -1773,16 +1843,15 @@ there's no requirement that @var{time} be normalized. This means that
@code{@var{time}.tv_nsec} can be negative or larger than 999,999,999.
@end deftypefn
-@deftypefn Function emacs_value make_string (emacs_env *@var{env}, const char *@var{str}, ptrdiff_t @var{strlen})
+@deftypefn Function emacs_value make_string (emacs_env *@var{env}, const char *@var{str}, ptrdiff_t @var{len})
This function creates an Emacs string from C text string pointed by
@var{str} whose length in bytes, not including the terminating null
-byte, is @var{strlen}. The original string in @var{str} can be either
-an @acronym{ASCII} string or a UTF-8 encoded non-@acronym{ASCII}
-string; it can include embedded null bytes, and doesn't have to end in
-a terminating null byte at @code{@var{str}[@var{strlen}]}. The
-function raises the @code{overflow-error} error condition if
-@var{strlen} is negative or exceeds the maximum length of an Emacs
-string.
+byte, is @var{len}. The original string in @var{str} can be either an
+@acronym{ASCII} string or a UTF-8 encoded non-@acronym{ASCII} string;
+it can include embedded null bytes, and doesn't have to end in a
+terminating null byte at @code{@var{str}[@var{len}]}. The function
+raises the @code{overflow-error} error condition if @var{len} is
+negative or exceeds the maximum length of an Emacs string.
@end deftypefn
The @acronym{API} does not provide functions to manipulate Lisp data
@@ -1839,27 +1908,32 @@ garbage-collected. Don't run any expensive code in a finalizer,
because GC must finish quickly to keep Emacs responsive.
@end deftypefn
-@deftypefn Function void *get_user_ptr (emacs_env *@var{env}, emacs_value val)
+@deftypefn Function void *get_user_ptr (emacs_env *@var{env}, emacs_value @var{arg})
This function extracts the C pointer from the Lisp object represented
-by @var{val}.
+by @var{arg}.
@end deftypefn
-@deftypefn Function void set_user_ptr (emacs_env *@var{env}, emacs_value @var{value}, void *@var{ptr})
+@deftypefn Function void set_user_ptr (emacs_env *@var{env}, emacs_value @var{arg}, void *@var{ptr})
This function sets the C pointer embedded in the @code{user-ptr}
-object represented by @var{value} to @var{ptr}.
+object represented by @var{arg} to @var{ptr}.
@end deftypefn
-@deftypefn Function emacs_finalizer get_user_finalizer (emacs_env *@var{env}, emacs_value val)
+@deftypefn Function emacs_finalizer get_user_finalizer (emacs_env *@var{env}, emacs_value @var{arg})
This function returns the finalizer of the @code{user-ptr} object
-represented by @var{val}, or @code{NULL} if it doesn't have a finalizer.
+represented by @var{arg}, or @code{NULL} if it doesn't have a
+finalizer.
@end deftypefn
-@deftypefn Function void set_user_finalizer (emacs_env *@var{env}, emacs_value @var{val}, emacs_finalizer @var{fin})
+@deftypefn Function void set_user_finalizer (emacs_env *@var{env}, emacs_value @var{arg}, emacs_finalizer @var{fin})
This function changes the finalizer of the @code{user-ptr} object
-represented by @var{val} to be @var{fin}. If @var{fin} is a
-@code{NULL} pointer, the @code{user-ptr} object will have no finalizer.
+represented by @var{arg} to be @var{fin}. If @var{fin} is a
+@code{NULL} pointer, the @code{user-ptr} object will have no
+finalizer.
@end deftypefn
+Note that the @code{emacs_finalizer} type works for both user pointer
+an module function finalizers. @xref{Module Function Finalizers}.
+
@node Module Misc
@subsection Miscellaneous Convenience Functions for Modules
@@ -1870,20 +1944,20 @@ be called via the @code{emacs_env} pointer. Description of functions
that were introduced after Emacs 25 calls out the first version where
they became available.
-@deftypefn Function bool eq (emacs_env *@var{env}, emacs_value @var{val1}, emacs_value @var{val2})
+@deftypefn Function bool eq (emacs_env *@var{env}, emacs_value @var{a}, emacs_value @var{b})
This function returns @code{true} if the Lisp objects represented by
-@var{val1} and @var{val2} are identical, @code{false} otherwise. This
-is the same as the Lisp function @code{eq} (@pxref{Equality
-Predicates}), but avoids the need to intern the objects represented by
-the arguments.
+@var{a} and @var{b} are identical, @code{false} otherwise. This is
+the same as the Lisp function @code{eq} (@pxref{Equality Predicates}),
+but avoids the need to intern the objects represented by the
+arguments.
There are no @acronym{API} functions for other equality predicates, so
you will need to use @code{intern} and @code{funcall}, described
below, to perform more complex equality tests.
@end deftypefn
-@deftypefn Function bool is_not_nil (emacs_env *@var{env}, emacs_value @var{val})
-This function tests whether the Lisp object represented by @var{val}
+@deftypefn Function bool is_not_nil (emacs_env *@var{env}, emacs_value @var{arg})
+This function tests whether the Lisp object represented by @var{arg}
is non-@code{nil}; it returns @code{true} or @code{false} accordingly.
Note that you could implement an equivalent test by using
@@ -1892,12 +1966,12 @@ then use @code{eq}, described above, to test for equality. But using
this function is more convenient.
@end deftypefn
-@deftypefn Function emacs_value type_of (emacs_env *@var{env}, emacs_value @code{object})
-This function returns the type of @var{object} as a value that
-represents a symbol: @code{string} for a string, @code{integer} for an
-integer, @code{process} for a process, etc. @xref{Type Predicates}.
-You can use @code{intern} and @code{eq} to compare against known type
-symbols, if your code needs to depend on the object type.
+@deftypefn Function emacs_value type_of (emacs_env *@var{env}, emacs_value @code{arg})
+This function returns the type of @var{arg} as a value that represents
+a symbol: @code{string} for a string, @code{integer} for an integer,
+@code{process} for a process, etc. @xref{Type Predicates}. You can
+use @code{intern} and @code{eq} to compare against known type symbols,
+if your code needs to depend on the object type.
@end deftypefn
@anchor{intern}
@@ -1917,8 +1991,7 @@ calling the more powerful Emacs @code{intern} function
emacs_value fintern = env->intern (env, "intern");
emacs_value sym_name =
env->make_string (env, name_str, strlen (name_str));
-emacs_value intern_args[] = @{ sym_name, env->intern (env, "nil") @};
-emacs_value symbol = env->funcall (env, fintern, 2, intern_args);
+emacs_value symbol = env->funcall (env, fintern, 1, &sym_name);
@end example
@end deftypefn
@@ -1967,6 +2040,20 @@ variable values and buffer content may have been modified in arbitrary
ways.
@end deftypefn
+@anchor{open_channel}
+@deftypefun int open_channel (emacs_env *@var{env}, emacs_value @var{pipe_process})
+This function, which is available since Emacs 28, opens a channel to
+an existing pipe process. @var{pipe_process} must refer to an
+existing pipe process created by @code{make-pipe-process}. @ref{Pipe
+Processes}. If successful, the return value will be a new file
+descriptor that you can use to write to the pipe. Unlike all other
+module functions, you can use the returned file descriptor from
+arbitrary threads, even if no module environment is active. You can
+use the @code{write} function to write to the file descriptor. Once
+done, close the file descriptor using @code{close}. @ref{Low-Level
+I/O,,,libc}.
+@end deftypefun
+
@node Module Nonlocal
@subsection Nonlocal Exits in Modules
@cindex nonlocal exits, in modules
@@ -2071,11 +2158,12 @@ One use of this function is when you want to re-throw a non-local exit
from one of the called @acronym{API} or Lisp functions.
@end deftypefn
-@deftypefn Function void non_local_exit_signal (emacs_env *@var{env}, emacs_value @var{error}, emacs_value @var{data})
-This function signals the error represented by @var{error} with the
-specified error data @var{data}. The module function should return
-soon after calling this function. This function could be useful,
-e.g., for signaling errors from module functions to Emacs.
+@deftypefn Function void non_local_exit_signal (emacs_env *@var{env}, emacs_value @var{symbol}, emacs_value @var{data})
+This function signals the error represented by the error symbol
+@var{symbol} with the specified error data @var{data}. The module
+function should return soon after calling this function. This
+function could be useful, e.g., for signaling errors from module
+functions to Emacs.
@end deftypefn
diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi
index 0dc7c804e72..a4b479597ea 100644
--- a/doc/lispref/intro.texi
+++ b/doc/lispref/intro.texi
@@ -87,7 +87,9 @@ you are criticizing.
@cindex bugs
@cindex suggestions
-Please send comments and corrections using @kbd{M-x report-emacs-bug}.
+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}).
@node Lisp History
@section Lisp History
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 1e81fb1dc52..130ff0d8671 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -1846,8 +1846,11 @@ local map.
@cindex scanning keymaps
@cindex keymaps, scanning
- This section describes functions used to scan all the current keymaps
-for the sake of printing help information.
+ This section describes functions used to scan all the current
+keymaps for the sake of printing help information. To display the
+bindings in a particular keymap, you can use the
+@code{describe-keymap} command (@pxref{Misc Help, , Other Help
+Commands, emacs, The GNU Emacs Manual})
@defun accessible-keymaps keymap &optional prefix
This function returns a list of all the keymaps that can be reached (via
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index 2739d10ece9..aa6ef307b18 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -577,7 +577,7 @@ macro, then an error is signaled with data @code{"Autoloading failed to
define function @var{function-name}"}.
@findex update-file-autoloads
-@findex update-directory-autoloads
+@findex make-directory-autoloads
@cindex magic autoload comment
@cindex autoload cookie
@anchor{autoload cookie}
@@ -590,7 +590,7 @@ writes a corresponding @code{autoload} call into @file{loaddefs.el}.
file generated by @code{update-file-autoloads} can be changed from the
above defaults, see below.)
Building Emacs loads @file{loaddefs.el} and thus calls @code{autoload}.
-@kbd{M-x update-directory-autoloads} is even more powerful; it updates
+@kbd{M-x make-directory-autoloads} is even more powerful; it updates
autoloads for all files in the current directory.
The same magic comment can copy any kind of form into
@@ -1170,10 +1170,13 @@ extension, a.k.a.@: ``suffix''. This suffix is platform-dependent.
@defvar module-file-suffix
This variable holds the system-dependent value of the file-name
-extension of the module files. Its value is @file{.so} on POSIX hosts
-and @file{.dll} on MS-Windows.
+extension of the module files. Its value is @file{.so} on POSIX
+hosts, @file{.dylib} on macOS, and @file{.dll} on MS-Windows.
@end defvar
+ On macOS, dynamic modules can also have the suffix @file{.so} in
+addition to @file{.dylib}.
+
@findex emacs_module_init
@vindex plugin_is_GPL_compatible
Every dynamic module should export a C-callable function named
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index ecab882fed7..d00acd0ded3 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -316,8 +316,22 @@ input before returning it. However,
@code{read-no-blanks-input} (see below), as well as
@code{read-minibuffer} and related functions (@pxref{Object from
Minibuffer,, Reading Lisp Objects With the Minibuffer}), and all
-functions that do minibuffer input with completion, discard text
-properties unconditionally, regardless of the value of this variable.
+functions that do minibuffer input with completion, remove the @code{face}
+property unconditionally, regardless of the value of this variable.
+
+If this variable is non-@code{nil}, most text properties on strings
+from the completion table are preserved---but only on the part of the
+strings that were completed.
+
+@lisp
+(let ((minibuffer-allow-text-properties t))
+ (completing-read "String: " (list (propertize "foobar" 'data 'zot))))
+=> #("foobar" 3 6 (data zot))
+@end lisp
+
+In this example, the user typed @samp{foo} and then hit the @kbd{TAB}
+key, so the text properties are only preserved on the last three
+characters.
@end defvar
@defvar minibuffer-local-map
@@ -411,6 +425,39 @@ following bindings, in addition to those of @code{minibuffer-local-map}:
@end table
@end defvar
+@vindex minibuffer-default-prompt-format
+@defun format-prompt prompt default &rest format-args
+Format @var{prompt} with default value @var{default} according to the
+@code{minibuffer-default-prompt-format} variable.
+
+@code{minibuffer-default-prompt-format} is a format string (defaulting
+to @samp{" (default %s)"} that says how the ``default'' bit in prompts
+like @samp{"Local filename (default somefile): "} are to be formatted.
+
+To allow the users to customize how this is displayed, code that
+prompts the user for a value (and has a default) should look something
+along the lines of this code snippet:
+
+@lisp
+(read-file-name
+ (format-prompt "Local filename" file)
+ nil file)
+@end lisp
+
+If @var{format-args} is @code{nil}, @var{prompt} is used as a literal
+string. If @var{format-args} is non-@code{nil}, @var{prompt} is used
+as a format control string, and @var{prompt} and @var{format-args} are
+passed to @code{format} (@pxref{Formatting Strings}).
+
+@code{minibuffer-default-prompt-format} can be @samp{""}, in which
+case no default values are displayed.
+
+If @var{default} is @code{nil}, there is no default value, and
+therefore no ``default value'' string is included in the result value.
+If @var{default} is a non-@code{nil} list, the first element of the
+list is used in the prompt.
+@end defun
+
@node Object from Minibuffer
@section Reading Lisp Objects with the Minibuffer
@cindex minibuffer input, reading lisp objects
@@ -646,6 +693,15 @@ A history list for variable-name arguments read by
@code{read-variable}.
@end defvar
+@defvar read-number-history
+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.
+@end defvar
+
@c Less common: coding-system-history, input-method-history,
@c command-history, grep-history, grep-find-history,
@c read-envvar-name-history, setenv-history, yes-or-no-p-history.
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index de40fa7f963..be2ee5721c2 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -469,9 +469,10 @@ variable @code{imenu-generic-expression}, for the two variables
@code{imenu-create-index-function} (@pxref{Imenu}).
@item
-The mode can specify a local value for
-@code{eldoc-documentation-function} to tell ElDoc mode how to handle
-this mode.
+The mode can tell ElDoc mode how to retrieve different types of
+documentation for whatever is at point, by adding one or more
+buffer-local entries to the special hook
+@code{eldoc-documentation-functions}.
@item
The mode can specify how to complete various keywords by adding one or
@@ -1352,19 +1353,11 @@ illustrate how these modes are written.
@end smallexample
The three modes for Lisp share much of their code. For instance,
-each calls the following function to set various variables:
-
-@smallexample
-@group
-(defun lisp-mode-variables (&optional syntax keywords-case-insensitive elisp)
- (when syntax
- (set-syntax-table lisp-mode-syntax-table))
- @dots{}
-@end group
-@end smallexample
+Lisp mode and Emacs Lisp mode inherit from Lisp Data mode and Lisp
+Interaction Mode inherits from Emacs Lisp mode.
@noindent
-Amongst other things, this function sets up the @code{comment-start}
+Amongst other things, Lisp Data mode sets up the @code{comment-start}
variable to handle Lisp comments:
@smallexample
@@ -1414,7 +1407,7 @@ Finally, here is the major mode command for Lisp mode:
@smallexample
@group
-(define-derived-mode lisp-mode prog-mode "Lisp"
+(define-derived-mode lisp-mode lisp-data-mode "Lisp"
"Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
Commands:
Delete converts tabs to spaces as it moves back.
@@ -1425,10 +1418,9 @@ Note that `run-lisp' may be used either to start an inferior Lisp job
or to switch back to an existing one."
@end group
@group
- (lisp-mode-variables nil t)
(setq-local find-tag-default-function 'lisp-find-tag-default)
(setq-local comment-start-skip
- "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
(setq imenu-case-fold-search t))
@end group
@end smallexample
@@ -2174,6 +2166,29 @@ Mode line construct for miscellaneous information. By default, this
shows the information specified by @code{global-mode-string}.
@end defvar
+@defvar mode-line-position-line-format
+The format used to display line numbers when @code{line-number-mode}
+(@pxref{Optional Mode Line,,, emacs, The GNU Emacs Manual}) is
+switched on. @samp{%l} in the format will be replaced with the line
+number.
+@end defvar
+
+@defvar mode-line-position-column-format
+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}.
+@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.
+@end defvar
+
@defvar minor-mode-alist
@anchor{Definition of minor-mode-alist}
This variable holds an association list whose elements specify how the
@@ -2674,6 +2689,7 @@ Setting this variable makes it buffer-local in the current buffer.
@node Font Lock Mode
@section Font Lock Mode
@cindex Font Lock mode
+@cindex syntax highlighting and coloring
@dfn{Font Lock mode} is a buffer-local minor mode that automatically
attaches @code{face} properties to certain parts of the buffer based on
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 5c5f89eb433..83066744121 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -2339,8 +2339,12 @@ same sequence of character codes and all these codes are in the range
@end group
@end example
-However, two distinct buffers are never considered @code{equal}, even if
-their textual contents are the same.
+The @code{equal} function recursively compares the contents of objects
+if they are integers, strings, markers, vectors, bool-vectors,
+byte-code function objects, char-tables, records, or font objects.
+Other objects are considered @code{equal} only if they are @code{eq}.
+For example, two distinct buffers are never considered @code{equal},
+even if their textual contents are the same.
@end defun
For @code{equal}, equality is defined recursively; for example, given
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index b31ab87ff17..504f0dfb23e 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1701,7 +1701,8 @@ following form:
@noindent
The format of this list is the same as what @code{decode-time} accepts
(@pxref{Time Conversion}), and is described in more detail there. Any
-element that cannot be determined from the input will be set to
+@code{dst} element that cannot be determined from the input is set to
+@minus{}1, and any other unknown element is set to
@code{nil}. The argument @var{string} should resemble an RFC 822 (or later) or
ISO 8601 string, like ``Fri, 25 Mar 2016 16:24:56 +0100'' or
``1998-09-12T12:21:54-0200'', but this function will attempt to parse
@@ -2193,9 +2194,9 @@ cause anything special to happen.
@findex list-timers
The @code{list-timers} command lists all the currently active timers.
-There's only one command available in the buffer displayed: @kbd{c}
-(@code{timer-list-cancel}) that will cancel the timer on the line
-under point.
+The command @kbd{c} (@code{timer-list-cancel}) will cancel the timer
+on the line under point. You can sort the list by column using the
+command @kbd{S} (@code{tabulated-list-sort}).
@node Idle Timers
@section Idle Timers
@@ -2686,9 +2687,9 @@ Emacs is restarted by the session manager.
@group
(defun save-yourself-test ()
- (insert "(save-current-buffer
- (switch-to-buffer \"*scratch*\")
- (insert \"I am restored\"))")
+ (insert
+ (format "%S" '(with-current-buffer "*scratch*"
+ (insert "I am restored"))))
nil)
@end group
@end example
@@ -3137,7 +3138,7 @@ being reported. For example:
@end group
@group
-(set-file-modes "/tmp/foo" (default-file-modes))
+(set-file-modes "/tmp/foo" (default-file-modes) 'nofollow)
@result{} Event (35025468 attribute-changed "/tmp/foo")
@end group
@end example
diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi
index d7856ce73e3..751adcff5a8 100644
--- a/doc/lispref/positions.texi
+++ b/doc/lispref/positions.texi
@@ -332,6 +332,8 @@ if provided; otherwise @var{n} defaults to @code{nil}.
@node Text Lines
@subsection Motion by Text Lines
@cindex lines
+@cindex logical lines, moving by
+@cindex physical lines, moving by
Text lines are portions of the buffer delimited by newline characters,
which are regarded as part of the previous line. The first text line
@@ -411,7 +413,7 @@ function counts that line as one line successfully moved.
In an interactive call, @var{count} is the numeric prefix argument.
@end deffn
-@defun count-lines start end
+@defun count-lines start end &optional ignore-invisible-lines
@cindex lines in region
@anchor{Definition of count-lines}
This function returns the number of lines between the positions
@@ -420,6 +422,9 @@ This function returns the number of lines between the positions
1, even if @var{start} and @var{end} are on the same line. This is
because the text between them, considered in isolation, must contain at
least one line unless it is empty.
+
+If the optional @var{ignore-invisible-lines} is non-@code{nil},
+invisible lines will not be included in the count.
@end defun
@deffn Command count-words start end
@@ -515,6 +520,7 @@ beginning or end of a line.
@node Screen Lines
@subsection Motion by Screen Lines
@cindex screen lines, moving by
+@cindex visual lines, moving by
The line functions in the previous section count text lines, delimited
only by newline characters. By contrast, these functions count screen
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 6970f718ee0..855df4b9260 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -477,6 +477,22 @@ You should only ever change this variable with a let-binding; never
with @code{setq}.
@end defvar
+@defopt process-file-return-signal-string
+This user option indicates whether a call of @code{process-file}
+returns a string describing the signal interrupting a remote process.
+
+When a process returns an exit code greater than 128, it is
+interpreted as a signal. @code{process-file} requires to return a
+string describing this signal.
+
+Since there are processes violating this rule, returning exit codes
+greater than 128 which are not bound to a signal, @code{process-file}
+returns always the exit code as natural number for remote processes.
+Setting this user option to non-nil forces @code{process-file} to
+interpret such exit codes as signals, and to return a corresponding
+string.
+@end defopt
+
@defun call-process-region start end program &optional delete destination display &rest args
This function sends the text from @var{start} to @var{end} as
standard input to a process running @var{program}. It deletes the text
@@ -587,6 +603,11 @@ This function works by calling @code{call-process}, so program output
is decoded in the same way as for @code{call-process}.
@end defun
+@defun process-lines-ignore-status program &rest args
+This function is just like @code{process-lines}, but does not signal
+an error if @var{program} exits with a non-zero exit status.
+@end defun
+
@node Asynchronous Processes
@section Creating an Asynchronous Process
@cindex asynchronous subprocess
@@ -743,6 +764,7 @@ Some file name handlers may not support @code{make-process}. In such
cases, this function does nothing and returns @code{nil}.
@end defun
+@anchor{Pipe Processes}
@defun make-pipe-process &rest args
This function creates a bidirectional pipe which can be attached to a
child process. This is useful with the @code{:stderr} keyword of
@@ -1554,7 +1576,8 @@ from previous output.
@defun set-process-buffer process buffer
This function sets the buffer associated with @var{process} to
@var{buffer}. If @var{buffer} is @code{nil}, the process becomes
-associated with no buffer.
+associated with no buffer; if non-@code{nil}, the process mark will be
+set to point to the end of @var{buffer}.
@end defun
@defun get-buffer-process buffer-or-name
@@ -2426,18 +2449,15 @@ server is stopped; a non-@code{nil} value means yes.
@cindex encrypted network connections
@cindex @acronym{TLS} network connections
@cindex @acronym{STARTTLS} network connections
-Emacs can create encrypted network connections, using either built-in
-or external support. The built-in support uses the GnuTLS
-Transport Layer Security Library; see
+Emacs can create encrypted network connections, using the built-in
+support for the GnuTLS Transport Layer Security Library; see
@uref{https://www.gnu.org/software/gnutls/, the GnuTLS project page}.
If your Emacs was compiled with GnuTLS support, the function
@code{gnutls-available-p} is defined and returns non-@code{nil}. For
more details, @pxref{Top,, Overview, emacs-gnutls, The Emacs-GnuTLS manual}.
-The external support uses the @file{starttls.el} library, which
-requires a helper utility such as @command{gnutls-cli} to be installed
-on the system. The @code{open-network-stream} function can
-transparently handle the details of creating encrypted connections for
-you, using whatever support is available.
+The @code{open-network-stream} function can transparently handle the
+details of creating encrypted connections for you, using whatever
+support is available.
@defun open-network-stream name buffer host service &rest parameters
This function opens a TCP connection, with optional encryption, and
@@ -2465,6 +2485,12 @@ that are mainly relevant to encrypted connections:
@item :nowait @var{boolean}
If non-@code{nil}, try to make an asynchronous connection.
+@item :coding @var{coding}
+Use this to set the coding systems used by the network process, in
+preference to binding @code{coding-system-for-read} or
+@code{coding-system-for-write}. @xref{Network Processes}, for
+details.
+
@item :type @var{type}
The type of connection. Options are:
@@ -2491,7 +2517,10 @@ If non-@code{nil}, always ask for the server's capabilities, even when
doing a @samp{plain} connection.
@item :capability-command @var{capability-command}
-Command string to query the host capabilities.
+Command to query the host capabilities. This can either be a string
+(which will then be sent verbatim to the server), or a function
+(called with a single parameter; the "greeting" from the server when
+connecting), and should return a string.
@item :end-of-command @var{regexp}
@itemx :end-of-capability @var{regexp}
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index c8a12bdd66b..592b876644c 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -342,7 +342,7 @@ this choice, the rest of the regexp matches successfully.
long time, if they lead to ambiguous matching. For
example, trying to match the regular expression @samp{\(x+y*\)*a}
against the string @samp{xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxz} could
-take hours before it ultimately fails. Emacs must try each way of
+take hours before it ultimately fails. Emacs may try each way of
grouping the @samp{x}s before concluding that none of them can work.
In general, avoid expressions that can match the same string in
multiple ways.
@@ -2542,7 +2542,7 @@ and replace them, the best way is to write an explicit loop using
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 a function to do
+if you want to do it efficiently. So Emacs provides two functions to do
this.
@defun replace-regexp-in-string regexp rep string &optional fixedcase literal subexp start
@@ -2566,6 +2566,13 @@ replacement string. The match data at this point are the result
of matching @var{regexp} against a substring of @var{string}.
@end defun
+@defun string-replace fromstring tostring instring
+This function replaces all occurrences of @var{fromstring} with
+@var{tostring} in @var{instring} and returns the result. It may
+return one of its arguments unchanged, a constant string or a new
+string. Case is significant, and text properties are ignored.
+@end defun
+
If you want to write a command along the lines of @code{query-replace},
you can use @code{perform-replace} to do the work.
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 0dc47f30c43..0f157c39d63 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -656,6 +656,16 @@ optional argument @var{ignore-case} is non-@code{nil}, the comparison
ignores case differences.
@end defun
+@defun string-search needle haystack &optional start-pos
+Return the position of the first instance of @var{needle} in
+@var{haystack}, both of which are strings. If @var{start-pos} is
+non-@code{nil}, start searching from that position in @var{needle}.
+Return @code{nil} if no match was found.
+This function only considers the characters in the strings when doing
+the comparison; text properties are ignored. Matching is always
+case-sensitive.
+@end defun
+
@defun compare-strings string1 start1 end1 string2 start2 end2 &optional ignore-case
This function compares a specified part of @var{string1} with a
specified part of @var{string2}. The specified part of @var{string1}
@@ -1157,7 +1167,7 @@ The function @code{format-spec} described in this section performs a
similar function to @code{format}, except it operates on format
control strings that use arbitrary specification characters.
-@defun format-spec template spec-alist &optional only-present
+@defun format-spec template spec-alist &optional ignore-missing
This function returns a string produced from the format string
@var{template} according to conversions specified in @var{spec-alist},
which is an alist (@pxref{Association Lists}) of the form
@@ -1190,12 +1200,15 @@ The order of specifications in @var{template} need not correspond to
the order of associations in @var{spec-alist}.
@end itemize
-The optional argument @var{only-present} indicates how to handle
+The optional argument @var{ignore-missing} indicates how to handle
specification characters in @var{template} that are not found in
@var{spec-alist}. If it is @code{nil} or omitted, the function
-signals an error. Otherwise, those format specifications and any
-occurrences of @samp{%%} in @var{template} are left verbatim in the
-output, including their text properties, if any.
+signals an error; if it is @code{ignore}, those format specifications
+are left verbatim in the output, including their text properties, if
+any; if it is @code{delete}, those format specifications are removed
+from the output; any other non-@code{nil} value is handled like
+@code{ignore}, but any occurrences of @samp{%%} are also left verbatim
+in the output.
@end defun
The syntax of format specifications accepted by @code{format-spec} is
@@ -1243,7 +1256,7 @@ the right rather than the left.
@item <
This flag causes the substitution to be truncated on the left to the
-given width, if specified.
+given width and precision, if specified.
@item >
This flag causes the substitution to be truncated on the right to the
@@ -1262,9 +1275,12 @@ The result of using contradictory flags (for instance, both upper and
lower case) is undefined.
As is the case with @code{format}, a format specification can include
-a width, which is a decimal number that appears after any flags. If a
-substitution contains fewer characters than its specified width, it is
-padded on the left:
+a width, which is a decimal number that appears after any flags, and a
+precision, which is a decimal-point @samp{.} followed by a decimal
+number that appears after any flags and width.
+
+If a substitution contains fewer characters than its specified width,
+it is padded on the left:
@example
@group
@@ -1274,6 +1290,17 @@ padded on the left:
@end group
@end example
+If a substitution contains more characters than its specified
+precision, it is truncated on the right:
+
+@example
+@group
+(format-spec "%.2a is truncated on the right"
+ '((?a . "alpha")))
+ @result{} "al is truncated on the right"
+@end group
+@end example
+
Here is a more complicated example that combines several
aforementioned features:
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index c4e92bdcedb..722c044b1a1 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -4813,11 +4813,9 @@ When @var{noerror} is non-@code{nil}, this function silently uses
@code{raw-text} coding instead.
@item (@code{iv-auto} @var{length})
-This will generate an IV (Initialization Vector) of the specified
-length using the GnuTLS @code{GNUTLS_RND_NONCE} generator and pass it
-to the function. This ensures that the IV is unpredictable and
-unlikely to be reused in the same session. The actual value of the IV
-is returned by the function as described below.
+This generates a random IV (Initialization Vector) of the specified
+length and passes it to the function. This ensures that the IV is
+unpredictable and unlikely to be reused in the same session.
@end table
@@ -5101,6 +5099,9 @@ The following are functions for altering the @acronym{DOM}.
@item dom-set-attribute @var{node} @var{attribute} @var{value}
Set the @var{attribute} of the node to @var{value}.
+@item dom-remove-attribute @var{node} @var{attribute}
+Remove @var{attribute} from @var{node}.
+
@item dom-append-child @var{node} @var{child}
Append @var{child} as the last child of @var{node}.
@@ -5153,6 +5154,11 @@ Utility functions:
@item dom-pp @var{dom} &optional @var{remove-empty}
Pretty-print @var{dom} at point. If @var{remove-empty}, don't print
textual nodes that just contain white-space.
+
+@item dom-print @var{dom} &optional @var{pretty} @var{xml}
+Print @var{dom} at point. If @var{xml} is non-@code{nil}, print as
+@acronym{XML}; otherwise, print as @acronym{HTML}. If @var{pretty} is
+non-@code{nil}, indent the @acronym{HTML}/@acronym{XML} logically.
@end table
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi
index 5b09b2ccea6..1826e8f7b42 100644
--- a/doc/lispref/tips.texi
+++ b/doc/lispref/tips.texi
@@ -918,29 +918,56 @@ values. It is much better to convert such comments to documentation
strings, though.
@item ;;;
-Comments that start with three semicolons, @samp{;;;}, should start at
-the left margin. We use them
-for comments which should be considered a
-heading by Outline minor mode. By default, comments starting with
-at least three semicolons (followed by a single space and a
-non-whitespace character) are considered headings, comments starting
-with two or fewer are not. Historically, triple-semicolon comments have
-also been used for commenting out lines within a function, but this use
-is discouraged.
-
-When commenting out entire functions, use two semicolons.
-
-@item ;;;;
-Comments that start with four (or more) semicolons, @samp{;;;;},
-should be aligned to the left margin and are used for headings of
-major sections of a program. For example:
+
+Comments that start with three (or more) semicolons, @samp{;;;},
+should start at the left margin. We use them for comments that should
+be considered a heading by Outline minor mode. By default, comments
+starting with at least three semicolons (followed by a single space
+and a non-whitespace character) are considered section headings,
+comments starting with two or fewer are not.
+
+(Historically, triple-semicolon comments have also been used for
+commenting out lines within a function, but this use is discouraged in
+favor of using just two semicolons. This also applies when commenting
+out entire functions; when doing that use two semicolons as well.)
+
+Three semicolons are used for top-level sections, four for
+sub-sections, five for sub-sub-sections and so on.
+
+Typically libraries have at least four top-level sections. For
+example when the bodies of all of these sections are hidden:
@smallexample
-;;;; The kill ring
+@group
+;;; backquote.el --- implement the ` Lisp construct...
+;;; Commentary:...
+;;; Code:...
+;;; backquote.el ends here
+@end group
@end smallexample
-If you wish to have sub-headings under these heading, use more
-semicolons to nest these sub-headings.
+(In a sense the last line is not a section heading as it must
+never be followed by any text; after all it marks the end of the
+file.)
+
+For longer libraries it is advisable to split the code into multiple
+sections. This can be done by splitting the @samp{Code:} section into
+multiple sub-sections. Even though that was the only recommended
+approach for a long time, many people have chosen to use multiple
+top-level code sections instead. You may chose either style.
+
+Using multiple top-level code sections has the advantage that it
+avoids introducing an additional nesting level but it also means that
+the section named @samp{Code} does not contain all the code, which is
+awkward. To avoid that, you should put no code at all inside that
+section; that way it can be considered a seperator instead of a
+section heading.
+
+Finally, we recommend that you don't end headings with a colon or any
+other punctuation for that matter. For historic reasons the
+@samp{Code:} and @samp{Commentary:} headings end with a colon, but we
+recommend that you don't do the same for other headings anyway.
+
@end table
@noindent
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index abcd4bbd0f7..94c8c88796f 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -2585,8 +2585,11 @@ implemented this way:
(macroexp-let2* nil ((start from) (end to))
(funcall do `(substring ,getter ,start ,end)
(lambda (v)
- (funcall setter `(cl--set-substring
- ,getter ,start ,end ,v))))))))
+ (macroexp-let2 nil v v
+ `(progn
+ ,(funcall setter `(cl--set-substring
+ ,getter ,start ,end ,v))
+ ,v))))))))
@end example
@end defmac
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index a19f123c658..5ec23a9c876 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -3048,6 +3048,16 @@ since there is no guarantee that an arbitrary caller of
@code{display-buffer} will be able to handle the case that no window
will display the buffer. @code{display-buffer-no-window} is the only
action function that cares about this entry.
+
+@vindex body-function@r{, a buffer display action alist entry}
+@item body-function
+The value must be a function taking one argument (a displayed window).
+This function can be used to fill the displayed window's body with
+some contents that might depend on dimensions of the displayed window.
+It is called @emph{after} the buffer is displayed, and @emph{before}
+the entries @code{window-height}, @code{window-width} and
+@code{preserve-size} are applied that could resize the window to fit
+it to the inserted contents.
@end table
By convention, the entries @code{window-height}, @code{window-width}
@@ -5916,10 +5926,6 @@ This function compares two window configurations as regards the
structure of windows, but ignores the values of point and the
saved scrolling positions---it can return @code{t} even if those
aspects differ.
-
-The function @code{equal} can also compare two window configurations; it
-regards configurations as unequal if they differ in any respect, even a
-saved point.
@end defun
@defun window-configuration-frame config
diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi
index 61dc62e7711..f8fcb642901 100644
--- a/doc/misc/auth.texi
+++ b/doc/misc/auth.texi
@@ -227,6 +227,11 @@ machine YOURMACHINE login YOU password SMTPPASSWORD port 433
machine YOURMACHINE login YOU password GENERALPASSWORD
@end example
+If you wish to specify a particular SMTP authentication method to use
+with a machine, you can use the @code{smtp-auth} keyword.
+@xref{Authentication,, Authentication, smtpmail, Emacs SMTP Library},
+for available methods.
+
For url-auth authentication (HTTP/HTTPS), you need to put this in your
netrc file:
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index f9196f808e7..a356cecf2b7 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -34743,15 +34743,15 @@ is defined by
@smallexample
(put 'calcFunc-ln\' 'math-derivative-1
- (function (lambda (u) (math-div 1 u))))
+ (lambda (u) (math-div 1 u)))
@end smallexample
The two-argument @code{log} function has two derivatives,
@smallexample
(put 'calcFunc-log\' 'math-derivative-2 ; d(log(x,b)) / dx
- (function (lambda (x b) ... )))
+ (lambda (x b) ... ))
(put 'calcFunc-log\'2 'math-derivative-2 ; d(log(x,b)) / db
- (function (lambda (x b) ... )))
+ (lambda (x b) ... ))
@end smallexample
@end defun
@@ -34818,7 +34818,7 @@ as properties in a manner similar to derivatives:
@smallexample
(put 'calcFunc-ln 'math-inverse
- (function (lambda (x) (list 'calcFunc-exp x))))
+ (lambda (x) (list 'calcFunc-exp x)))
@end smallexample
This function can call @samp{(math-solve-get-sign @var{x})} to create
@@ -35164,16 +35164,7 @@ which are called at various times. Calc defines a number of hooks
that help you to customize it in various ways. Calc uses the Lisp
function @code{run-hooks} to invoke the hooks shown below. Several
other customization-related variables are also described here.
-
-@defvar calc-load-hook
-This hook is called at the end of @file{calc.el}, after the file has
-been loaded, before any functions in it have been called, but after
-@code{calc-mode-map} and similar variables have been set up.
-@end defvar
-
-@defvar calc-ext-load-hook
-This hook is called at the end of @file{calc-ext.el}.
-@end defvar
+To run code after Calc has loaded, use @code{with-eval-after-load}.
@defvar calc-start-hook
This hook is called as the last step in a @kbd{M-x calc} command.
diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi
index 544ff853351..adc233d99dd 100644
--- a/doc/misc/cc-mode.texi
+++ b/doc/misc/cc-mode.texi
@@ -350,11 +350,12 @@ Line-Up Functions
* Misc Line-Up::
-Customizing Macros
+Custom Macros
* Macro Backslashes::
* Macros with ;::
* Noise Macros::
+* Indenting Directives::
@end detailmenu
@end menu
@@ -1023,9 +1024,7 @@ These key sequences are not bound in AWK Mode, which doesn't have
preprocessor statements.
@item @kbd{M-x c-backward-into-nomenclature}
-@itemx @kbd{M-x c-forward-into-nomenclature}
@findex c-backward-into-nomenclature
-@findex c-forward-into-nomenclature
@findex backward-into-nomenclature @r{(c-)}
@findex forward-into-nomenclature @r{(c-)}
A popular programming style, especially for object-oriented languages
@@ -2131,6 +2130,11 @@ For Pike autodoc markup, the standard in Pike.
@item gtkdoc
@cindex GtkDoc markup
For GtkDoc markup, widely used in the Gnome community.
+
+@item doxygen
+@cindex Doxygen markup
+For Doxygen markup, which can be used with C, C++, Java and variety of
+other languages.
@end table
The above is by no means complete. If you'd like to see support for
@@ -6389,6 +6393,26 @@ function is the same as specifying a list @code{(c-lineup-assignments
@comment ------------------------------------------------------------
+@defun c-lineup-ternary-bodies
+@findex lineup-ternary-bodies @r{(c-)}
+Line up true and false branches of a ternary operator
+(i.e. @code{?:}). More precisely, if the line starts with a colon
+which is a part of a said operator, align it with corresponding
+question mark. For example:
+
+@example
+@group
+return arg % 2 == 0 ? arg / 2
+ : (3 * arg + 1); @hereFn{c-lineup-ternary-bodies}
+@end group
+@end example
+
+@workswith @code{arglist-cont}, @code{arglist-cont-nonempty} and
+@code{statement-cont}.
+@end defun
+
+@comment ------------------------------------------------------------
+
@defun c-lineup-cascaded-calls
@findex lineup-cascaded-calls @r{(c-)}
Line up ``cascaded calls'' under each other. If the line begins with
@@ -6949,6 +6973,10 @@ is @code{nil}, all lines inside macro definitions are analyzed as
@code{cpp-macro-cont}.
@end defopt
+Sometimes you may want to indent particular directives
+(e.g. @code{#pragma}) as though they were statements. To do this, see
+@ref{Indenting Directives}.
+
Because a macro can expand into anything at all, near where one is
invoked @ccmode{} can only indent and fontify code heuristically.
Sometimes it gets it wrong. Usually you should try to design your
@@ -6965,6 +6993,7 @@ Macros}.
* Macro Backslashes::
* Macros with ;::
* Noise Macros::
+* Indenting Directives::
@end menu
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -7074,7 +7103,7 @@ initialization code, after the mode hooks have run.
@end defun
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Noise Macros, , Macros with ;, Custom Macros
+@node Noise Macros, Indenting Directives, Macros with ;, Custom Macros
@comment node-name, next, previous, up
@section Noise Macros
@cindex noise macros
@@ -7131,6 +7160,48 @@ after the mode hooks have run.
@end defun
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+@node Indenting Directives, , Noise Macros, Custom Macros
+@comment node-name, next, previous, up
+@section Indenting Directives
+@cindex Indenting Directives
+@cindex Indenting #pragma
+@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+Sometimes you may want to indent particular preprocessor directives
+(e.g. @code{#pragma}) as though they were statements. To do this,
+first set up @code{c-cpp-indent-to-body-directives} to include the
+directive name(s), then enable the ``indent to body'' feature with
+@code{c-toggle-cpp-indent-to-body}.
+
+@defopt c-cpp-indent-to-body-directives
+@vindex cpp-indent-to-body-directives (c-)
+This variable is a list of names of CPP directives (not including the
+introducing @samp{#}) which will be indented as though statements.
+Each element is a string, and must be a valid identifier. The default
+value is @code{("pragma")}.
+
+If you add more directives to this variable, or remove directives from
+it, whilst ``indent to body'' is active, you need to re-enable the
+feature by calling @code{c-toggle-cpp-indent-to-body} for these
+changes to take effect@footnote{Note that the removal of directives
+doesn't work satisfactorally on XEmacs or on very old versions of
+Emacs}.
+@end defopt
+
+@defun c-toggle-cpp-indent-to-body
+@findex toggle-cpp-indent-to-body (c-)
+With @kbd{M-x c-toggle-cpp-indent-to-body}, you enable or disable the
+``indent to body'' feature. When called programmatically, it takes an
+optional numerical argument. A positive value will enable the
+feature, a zero or negative value will disable it.
+
+You should set up @code{c-cpp-indent-to-body-directives} before
+calling this function, since the function sets internal state which
+depends on that variable.
+@end defun
+
+
+@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@node Odds and Ends, Sample Init File, Custom Macros, Top
@comment node-name, next, previous, up
@chapter Odds and Ends
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index b5f26e004b0..2b38544dc87 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -4818,7 +4818,7 @@ For example:
@example
(defun make-adder (n)
(lexical-let ((n n))
- (function (lambda (m) (+ n m)))))
+ (lambda (m) (+ n m))))
(setq add17 (make-adder 17))
(funcall add17 4)
@result{} 21
diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index 167d2bd5ac1..4b2eab4eb76 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -59,10 +59,11 @@ another. An overview of D-Bus can be found at
* Type Conversion:: Mapping Lisp types and D-Bus types.
* Synchronous Methods:: Calling methods in a blocking way.
* Asynchronous Methods:: Calling methods non-blocking.
-* Receiving Method Calls:: Offering own methods.
+* Register Objects:: Offering own services.
* Signals:: Sending and receiving signals.
* Alternative Buses:: Alternative buses and environments.
* Errors and Events:: Errors and events.
+* Monitoring Events:: Monitoring events.
* Index:: Index including concepts, functions, variables.
* GNU Free Documentation License:: The license for this documentation.
@@ -162,12 +163,13 @@ registered names. Internally they use the basic interface
@defun dbus-list-activatable-names &optional bus
This function returns the D-Bus service names, which can be activated
-for @var{bus}. It must be either the symbol @code{:system} (the
-default) or the symbol @code{:session}. An activatable service is
+for @var{bus}. It must be either the keyword @code{:system} (the
+default) or the keyword @code{:session}. An activatable service is
described in a service registration file. Under GNU/Linux, such files
are located at @file{/usr/share/dbus-1/system-services/} (for the
@code{:system} bus) or @file{/usr/share/dbus-1/services/}. An
-activatable service is not necessarily registered at @var{bus} already.
+activatable service is not necessarily registered at @var{bus}
+already.
The result is a list of strings, which is @code{nil} when there are no
activatable service names at all. Example:
@@ -186,7 +188,7 @@ there are no registered service names at all. Well known names are
strings like @samp{org.freedesktop.DBus}. Names starting with
@samp{:} are unique names for services.
-@var{bus} must be either the symbol @code{:system} or the symbol
+@var{bus} must be either the keyword @code{:system} or the keyword
@code{:session}.
@end defun
@@ -196,7 +198,7 @@ known name in @var{bus}. A service has a known name if it doesn't
start with @samp{:}. The result is a list of strings, which is
@code{nil} when there are no known names at all.
-@var{bus} must be either the symbol @code{:system} or the symbol
+@var{bus} must be either the keyword @code{:system} or the keyword
@code{:session}.
@end defun
@@ -206,7 +208,7 @@ For a given service, registered at D-Bus @var{bus} under the name
result is a list of strings, or @code{nil} when there are no queued
names for @var{service} at all.
-@var{bus} must be either the symbol @code{:system} or the symbol
+@var{bus} must be either the keyword @code{:system} or the keyword
@code{:session}. @var{service} must be a known service name as
string.
@end defun
@@ -217,7 +219,7 @@ For a given service, registered at D-Bus @var{bus} under the name
owner. The result is a string, or @code{nil} when there is no name
owner of @var{service}.
-@var{bus} must be either the symbol @code{:system} or the symbol
+@var{bus} must be either the keyword @code{:system} or the keyword
@code{:session}. @var{service} must be a known service name as
string.
@end defun
@@ -228,7 +230,7 @@ registered at D-Bus @var{bus}. If @var{service} has not yet started,
it is autostarted if possible. The result is either @code{t} or
@code{nil}.
-@var{bus} must be either the symbol @code{:system} or the symbol
+@var{bus} must be either the keyword @code{:system} or the keyword
@code{:session}. @var{service} must be a string. @var{timeout}, a
nonnegative integer, specifies the maximum number of milliseconds
before @code{dbus-ping} must return. The default value is 25,000.
@@ -256,7 +258,7 @@ it, you can instead write:
This function returns the unique name, under which Emacs is registered
at D-Bus @var{bus}, as a string.
-@var{bus} must be either the symbol @code{:system} or the symbol
+@var{bus} must be either the keyword @code{:system} or the keyword
@code{:session}.
@end defun
@@ -375,7 +377,7 @@ must be strings.
This function returns all interfaces and sub-nodes of @var{service},
registered at object path @var{path} at bus @var{bus}.
-@var{bus} must be either the symbol @code{:system} or the symbol
+@var{bus} must be either the keyword @code{:system} or the keyword
@code{:session}. @var{service} must be a known service name, and
@var{path} must be a valid object path. The last two parameters are
strings. The result, the introspection data, is a string in XML
@@ -732,8 +734,8 @@ A @var{property} value can be retrieved by the function
@defun dbus-get-property bus service path interface property
This function returns the value of @var{property} of @var{interface}.
It will be checked at @var{bus}, @var{service}, @var{path}. The
-result can be any valid D-Bus value, or @code{nil} if there is no
-@var{property}. Example:
+result can be any valid D-Bus value. If there is no @var{property},
+or @var{property} cannot be read, an error is raised. Example:
@lisp
(dbus-get-property
@@ -744,26 +746,28 @@ result can be any valid D-Bus value, or @code{nil} if there is no
@end lisp
@end defun
-@defun dbus-set-property bus service path interface property value
+@defun dbus-set-property bus service path interface property [type] value
This function sets the value of @var{property} of @var{interface} to
@var{value}. It will be checked at @var{bus}, @var{service},
-@var{path}. When the value is successfully set, this function returns
-@var{value}. Otherwise, it returns @code{nil}. Example:
+@var{path}. @var{value} can be preceded by a @var{type} keyword.
+When the value is successfully set, this function returns @var{value}.
+Example:
@lisp
(dbus-set-property
:session "org.kde.kaccess" "/MainApplication"
- "com.trolltech.Qt.QApplication" "doubleClickInterval" 500)
+ "com.trolltech.Qt.QApplication" "doubleClickInterval" :uint16 500)
@result{} 500
@end lisp
@end defun
@defun dbus-get-all-properties bus service path interface
-This function returns all properties of @var{interface}. It will be
-checked at @var{bus}, @var{service}, @var{path}. The result is a list
-of cons. Every cons contains the name of the property, and its value.
-If there are no properties, @code{nil} is returned. Example:
+This function returns all readable properties of @var{interface}. It
+will be checked at @var{bus}, @var{service}, @var{path}. The result
+is a list of cons cells. Every cons cell contains the name of the
+property, and its value. If there are no properties, @code{nil} is
+returned. Example:
@lisp
(dbus-get-all-properties
@@ -781,9 +785,9 @@ If there are no properties, @code{nil} is returned. Example:
@defun dbus-get-all-managed-objects bus service path
This function returns all objects at @var{bus}, @var{service},
@var{path}, and the children of @var{path}. The result is a list of
-objects. Every object is a cons of an existing path name, and the
-list of available interface objects. An interface object is another
-cons, whose car is the interface name and cdr is the list of
+objects. Every object is a cons cell of an existing path name, and
+the list of available interface objects. An interface object is
+another cons, whose car is the interface name and cdr is the list of
properties as returned by @code{dbus-get-all-properties} for that path
and interface. Example:
@@ -997,8 +1001,8 @@ Other Lisp objects, like symbols or hash tables, are not accepted as
input parameters.
If it is necessary to use another D-Bus type, a corresponding type
-symbol can be prepended to the corresponding Lisp object. Basic D-Bus
-types are represented by the type symbols @code{:byte},
+keyword can be prepended to the corresponding Lisp object. Basic
+D-Bus types are represented by the type keywords @code{:byte},
@code{:boolean}, @code{:int16}, @code{:uint16}, @code{:int32},
@code{:uint32}, @code{:int64}, @code{:uint64}, @code{:double},
@code{:string}, @code{:object-path}, @code{:signature} and
@@ -1023,15 +1027,22 @@ but different to
(dbus-call-method @dots{} :int32 @var{nat-number} :signature @var{string})
@end lisp
-The value for a byte D-Bus type can be any integer in the range 0
-through 255. If a character is used as argument, modifiers
-represented outside this range are stripped off. For example,
-@code{:byte ?x} is equal to @code{:byte ?\M-x}, but it is not equal to
-@code{:byte ?\C-x} or @code{:byte ?\M-\C-x}. Signed and unsigned
-integer D-Bus types expect a corresponding integer value.
+The value for a D-Bus byte type can be any natural number. If the
+number is larger than 255, it is truncated to the least significant
+byte. For example, @code{:byte 1025} is equal to @code{:byte 1}. If
+a character is used as argument, modifiers represented outside this
+range are stripped off. For example, @code{:byte ?x} is equal to
+@code{:byte ?\M-x}, but it is not equal to @code{:byte ?\C-x} or
+@code{:byte ?\M-\C-x}.
+
+Signed and unsigned D-Bus integer types expect a corresponding integer
+value. A unix file descriptor is restricted to the values 0@dots{}9.
+
+If typed explicitly, a non-@code{nil} boolean value like
+@code{:boolean 'symbol} is handled like @code{t} or @code{:boolean t}.
A D-Bus compound type is always represented as a list. The @sc{car}
-of this list can be the type symbol @code{:array}, @code{:variant},
+of this list can be the type keyword @code{:array}, @code{:variant},
@code{:struct} or @code{:dict-entry}, which would result in a
corresponding D-Bus container. @code{:array} is optional, because
this is the default compound D-Bus type for a list.
@@ -1069,7 +1080,7 @@ elements of this array. Example:
(format ; Body.
"This is a test notification, raised from\n%S" (emacs-version))
'(:array) ; No actions (empty array of strings).
- '(:array :signature "@{sv@}") ; No hints
+ '(:array :signature "@{sv@}") ; No hints
; (empty array of dictionary entries).
:int32 -1) ; Default timeout.
@@ -1206,7 +1217,7 @@ parameters from the object.
@defun dbus-call-method bus service path interface method &optional :timeout timeout &rest args
@anchor{dbus-call-method}
This function calls @var{method} on the D-Bus @var{bus}. @var{bus} is
-either the symbol @code{:system} or the symbol @code{:session}.
+either the keyword @code{:system} or the keyword @code{:session}.
@var{service} is the D-Bus service name to be used. @var{path} is the
D-Bus object path, @var{service} is registered at. @var{interface} is
@@ -1299,8 +1310,8 @@ emulate the @code{lshal} command on GNU/Linux systems:
@defun dbus-call-method-asynchronously bus service path interface method handler &optional :timeout timeout &rest args
This function calls @var{method} on the D-Bus @var{bus}
-asynchronously. @var{bus} is either the symbol @code{:system} or the
-symbol @code{:session}.
+asynchronously. @var{bus} is either the keyword @code{:system} or the
+keyword @code{:session}.
@var{service} is the D-Bus service name to be used. @var{path} is the
D-Bus object path, @var{service} is registered at. @var{interface} is
@@ -1340,11 +1351,17 @@ message arrives, and @var{handler} is called. Example:
@end defun
-@node Receiving Method Calls
-@chapter Offering own methods.
+@node Register Objects
+@chapter Offering own services.
@cindex method calls, returning
@cindex returning method calls
+@c https://wiki.ubuntu.com/DebuggingDBus
+
+You can offer an own service in D-Bus, which will be visible by other
+D-Bus clients. See @uref{https://dbus.freedesktop.org/doc/dbus-api-design.html}
+for a discussion of the design.
+
In order to register methods on the D-Bus, Emacs has to request a well
known name on the D-Bus under which it will be available for other
clients. Names on the D-Bus can be registered and unregistered using
@@ -1354,7 +1371,7 @@ the following functions:
This function registers the known name @var{service} on D-Bus
@var{bus}.
-@var{bus} is either the symbol @code{:system} or the symbol
+@var{bus} is either the keyword @code{:system} or the keyword
@code{:session}.
@var{service} is the service name to be registered on the D-Bus. It
@@ -1390,7 +1407,7 @@ We already are the primary owner.
This function unregisters all objects from D-Bus @var{bus}, that were
registered by Emacs for @var{service}.
-@var{bus} is either the symbol @code{:system} or the symbol
+@var{bus} is either the keyword @code{:system} or the keyword
@code{:session}.
@var{service} is the D-Bus service name of the D-Bus. It must be a
@@ -1437,7 +1454,7 @@ The interface namespace @code{org.gnu.Emacs} used by Emacs.
With this function, an application registers @var{method} on the D-Bus
@var{bus}.
-@var{bus} is either the symbol @code{:system} or the symbol
+@var{bus} is either the keyword @code{:system} or the keyword
@code{:session}.
@var{service} is the D-Bus service name of the D-Bus object
@@ -1462,7 +1479,15 @@ cons cell, @var{handler} can return this object directly, instead of
returning a list containing the object.
If @var{handler} returns a reply message with an empty argument list,
-@var{handler} must return the symbol @code{:ignore}.
+@var{handler} must return the keyword @code{:ignore} in order to
+distinguish it from @code{nil} (the boolean false).
+
+If @var{handler} detects an error, it shall return the list
+@code{(:error @var{error-name} @var{error-message})}.
+@var{error-name} is a namespaced string which characterizes the error
+type, and @var{error-message} is a free text string. Alternatively,
+any Emacs signal @code{dbus-error} in @var{handler} raises a D-Bus
+error message with the error name @samp{org.freedesktop.DBus.Error.Failed}.
When @var{dont-register-service} is non-@code{nil}, the known name
@var{service} is not registered. This means that other D-Bus clients
@@ -1512,17 +1537,20 @@ could use the command line tool @code{dbus-send} in a shell:
boolean true
@end example
-You can indicate an error by raising the Emacs signal
-@code{dbus-error}. The handler above could be changed like this:
+You can indicate an error by returning an @code{:error} list reply, or
+by raising the Emacs signal @code{dbus-error}. The handler above
+could be changed like this:
@lisp
(defun my-dbus-method-handler (&rest args)
- (unless (and (= (length args) 1) (stringp (car args)))
- (signal 'dbus-error (list (format "Wrong argument list: %S" args))))
- (condition-case err
- (find-file (car args))
- (error (signal 'dbus-error (cdr err))))
- t)
+ (if (not (and (= (length args) 1) (stringp (car args))))
+ (list :error
+ "org.freedesktop.TextEditor.Error.InvalidArgs"
+ (format "Wrong argument list: %S" args))
+ (condition-case err
+ (find-file (car args))
+ (error (signal 'dbus-error (cdr err))))
+ t))
@end lisp
The test then runs
@@ -1534,16 +1562,27 @@ The test then runs
"org.freedesktop.TextEditor.OpenFile" \
string:"/etc/hosts" string:"/etc/passwd"
-@print{} Error org.freedesktop.DBus.Error.Failed:
+@print{} Error org.freedesktop.TextEditor.Error.InvalidArgs:
Wrong argument list: ("/etc/hosts" "/etc/passwd")
@end example
+
+@example
+# dbus-send --session --print-reply \
+ --dest="org.freedesktop.TextEditor" \
+ "/org/freedesktop/TextEditor" \
+ "org.freedesktop.TextEditor.OpenFile" \
+ string:"/etc/crypttab"
+
+@print{} Error org.freedesktop.DBus.Error.Failed:
+ D-Bus error: "File is not readable", "/etc/crypttab"
+@end example
@end defun
-@defun dbus-register-property bus service path interface property access value &optional emits-signal dont-register-service
+@defun dbus-register-property bus service path interface property access [type] value &optional emits-signal dont-register-service
With this function, an application declares a @var{property} on the D-Bus
@var{bus}.
-@var{bus} is either the symbol @code{:system} or the symbol
+@var{bus} is either the keyword @code{:system} or the keyword
@code{:session}.
@var{service} is the D-Bus service name of the D-Bus. It must be a
@@ -1556,14 +1595,18 @@ discussion of @var{dont-register-service} below).
@var{property} is the name of the property of @var{interface}.
@var{access} indicates, whether the property can be changed by other
-services via D-Bus. It must be either the symbol @code{:read} or
-@code{:readwrite}. @var{value} is the initial value of the property,
-it can be of any valid type (@xref{dbus-call-method}, for details).
+services via D-Bus. It must be either the keyword @code{:read},
+@code{:write} or @code{:readwrite}.
+
+@var{value} is the initial value of the property, it can be of any
+valid type (@xref{dbus-call-method}, for details). @var{value} can be
+preceded by a @var{type} keyword.
If @var{property} already exists on @var{path}, it will be
overwritten. For properties with access type @code{:read} this is the
only way to change their values. Properties with access type
-@code{:readwrite} can be changed by @code{dbus-set-property}.
+@code{:write} or @code{:readwrite} can be changed by
+@code{dbus-set-property}.
The interface @samp{org.freedesktop.DBus.Properties} is added to
@var{path}, including a default handler for the @samp{Get},
@@ -1666,7 +1709,7 @@ This function is similar to @code{dbus-call-method}. The difference
is, that there are no returning output parameters.
The function emits @var{signal} on the D-Bus @var{bus}. @var{bus} is
-either the symbol @code{:system} or the symbol @code{:session}. It
+either the keyword @code{:system} or the keyword @code{:session}. It
doesn't matter whether another object has registered for @var{signal}.
Signals can be unicast or broadcast messages. For broadcast messages,
@@ -1694,7 +1737,7 @@ arguments. They are converted into D-Bus types as described in
With this function, an application registers for a signal on the D-Bus
@var{bus}.
-@var{bus} is either the symbol @code{:system} or the symbol
+@var{bus} is either the keyword @code{:system} or the keyword
@code{:session}.
@var{service} is the D-Bus service name used by the sending D-Bus
@@ -1796,18 +1839,17 @@ Until now, we have spoken about the system and the session buses,
which are the default buses to be connected to. However, it is
possible to connect to any bus with a known address. This is a UNIX
domain or TCP/IP socket. Everywhere, where a @var{bus} is mentioned
-as argument of a function (the symbol @code{:system} or the symbol
+as argument of a function (the keyword @code{:system} or the keyword
@code{:session}), this address can be used instead. The connection to
this bus must be initialized first.
@defun dbus-init-bus bus &optional private
This function establishes the connection to D-Bus @var{bus}.
-@var{bus} can be either the symbol @code{:system} or the symbol
+@var{bus} can be either the keyword @code{:system} or the keyword
@code{:session}, or it can be a string denoting the address of the
-corresponding bus. For the system and session buses, this function
-is called when loading @file{dbus.el}, there is no need to call it
-again.
+corresponding bus. For the system and session buses, this function is
+called when loading @file{dbus.el}, there is no need to call it again.
The function returns the number of connections this Emacs session has
established to the @var{bus} under the same unique name
@@ -1819,11 +1861,12 @@ established.
When @var{private} is non-@code{nil}, a new connection is established
instead of reusing an existing one. It results in a new unique name
-at the bus. This can be used, if it is necessary to distinguish from
-another connection used in the same Emacs process, like the one
-established by GTK+. It should be used with care for at least the
-@code{:system} and @code{:session} buses, because other Emacs Lisp
-packages might already use this connection to those buses.
+at the @var{bus}. This can be used, if it is necessary to distinguish
+from another connection used in the same Emacs process, like the one
+established by GTK+. If @var{bus} is the keyword @code{:system} or
+the keyword @code{:session}, the new private connection is identified
+by the keywords @code{:system-private} or @code{:session-private},
+respectively.
Example: You initialize a connection to the AT-SPI bus on your host:
@@ -1866,7 +1909,7 @@ is supported depends on the bus daemon configuration, however.
This function sets the value of the @var{bus} environment
@var{variable} to @var{value}.
-@var{bus} is either a Lisp symbol, @code{:system} or @code{:session},
+@var{bus} is either a Lisp keyword, @code{:system} or @code{:session},
or a string denoting the bus address. Both @var{variable} and
@var{value} should be strings.
@@ -1922,8 +1965,9 @@ appended to the @code{dbus-error}.
@defspec dbus-ignore-errors forms@dots{}
This executes @var{forms} exactly like a @code{progn}, except that
-@code{dbus-error} errors are ignored during the @var{forms}. These
-errors can be made visible when @code{dbus-debug} is set to @code{t}.
+@code{dbus-error} errors are ignored during the @var{forms} (the macro
+returns @code{nil} then). These errors can be made visible when
+@code{dbus-debug} is set to non-@code{nil}.
@end defspec
Incoming D-Bus messages are handled as Emacs events, @pxref{Misc
@@ -1931,27 +1975,37 @@ Events, , , elisp}. They are retrieved only, when Emacs runs in
interactive mode. The generated event has this form:
@lisp
-(dbus-event @var{bus} @var{type} @var{serial} @var{service} @var{path} @var{interface} @var{member} @var{handler}
- &rest @var{args})
+(dbus-event @var{bus} @var{type} @var{serial} @var{service} @var{destination} @var{path} @var{interface} @var{member}
+ @var{handler} &rest @var{args})
@end lisp
@var{bus} identifies the D-Bus the message is coming from. It is
-either the symbol @code{:system} or the symbol @code{:session}.
+either a Lisp keyword, @code{:system}, @code{:session},
+@code{:system-private} or @code{:session-private}, or a string
+denoting the bus address.
@var{type} is the D-Bus message type which has caused the event. It
can be @code{dbus-message-type-invalid},
@code{dbus-message-type-method-call},
@code{dbus-message-type-method-return},
@code{dbus-message-type-error}, or @code{dbus-message-type-signal}.
-@var{serial} is the serial number of the received D-Bus message.
+@var{serial} is the serial number of the received D-Bus message,
+unless @var{type} is equal @code{dbus-message-type-error}.
@var{service} and @var{path} are the unique name and the object path
-of the D-Bus object emitting the message. @var{interface} and
-@var{member} denote the message which has been sent.
+of the D-Bus object emitting the message. @var{destination} is the
+D-Bus name the message is dedicated to, or @code{nil} in case the
+message is a broadcast signal.
+
+@var{interface} and @var{member} denote the message which has been
+sent. When @var{type} is @code{dbus-message-type-error}, @var{member}
+is the error name.
@var{handler} is the callback function which has been registered for
-this message (@pxref{Signals}). When a @code{dbus-event} event
-arrives, @var{handler} is called with @var{args} as arguments.
+this message (@pxref{Signals}). @var{args} are the typed arguments as
+returned from the message. They are passed to @var{handler} without
+type information, when it is called during event handling in
+@code{dbus-handle-event}.
In order to inspect the @code{dbus-event} data, you could extend the
definition of the callback function in @ref{Signals}:
@@ -1966,7 +2020,7 @@ callback function in order to retrieve the information from the event.
@defun dbus-event-bus-name event
This function returns the bus name @var{event} is coming from. The
-result is either the symbol @code{:system} or the symbol
+result is either the keyword @code{:system} or the keyword
@code{:session}.
@end defun
@@ -1985,6 +2039,11 @@ This function returns the unique name of the D-Bus object @var{event}
is coming from.
@end defun
+@defun dbus-event-destination-name event
+This function returns the unique name of the D-Bus object @var{event}
+is dedicated to.
+@end defun
+
@defun dbus-event-path-name event
This function returns the object path of the D-Bus object @var{event}
is coming from.
@@ -2000,10 +2059,20 @@ This function returns the member name of the D-Bus object @var{event}
is coming from. It is either a signal name or a method name.
@end defun
+@defun dbus-event-handler event
+This function returns the handler the D-Bus object @var{event} is
+applied with.
+@end defun
+
+@defun dbus-event-arguments event
+This function returns the arguments the D-Bus object @var{event} is
+carrying on.
+@end defun
+
D-Bus errors are not propagated during event handling, because it is
usually not desired. D-Bus errors in events can be made visible by
-setting the variable @code{dbus-debug} to @code{t}. They can also be
-handled by a hook function.
+setting the variable @code{dbus-debug} to non-@code{nil}. They can
+also be handled by a hook function.
@defvar dbus-event-error-functions
This hook variable keeps a list of functions, which are called when a
@@ -2030,6 +2099,54 @@ D-Bus applications running. They should therefore check carefully,
whether a given D-Bus error is related to them.
+@node Monitoring Events
+@chapter Monitoring events.
+@cindex monitoring
+
+@defun dbus-register-monitor bus &optional handler &key type sender destination path interface member
+This function registers @var{handler} for monitor events on the D-Bus
+@var{bus}.
+
+@var{bus} is either a Lisp keyword, @code{:system} or @code{:session},
+or a string denoting the bus address.
+
+@findex dbus-monitor-handler
+@var{handler} is the function to be called when a monitor event
+arrives. It is called with the `args' slot of the monitor event,
+which are stripped off the type keywords. If @var{handler} is
+@code{nil}, the default handler @code{dbus-monitor-handler} is
+applied. This default handler behaves similar to the
+@command{dbus-monitor} program.
+
+The other arguments are keyword-value pairs. @code{:type @var{type}}
+defines the message type to be monitored. If given, it must be equal
+one of the strings @samp{method_call}, @samp{method_return},
+@samp{error} or @samp{signal}.
+
+@code{:sender @var{sender}} and @code{:destination @var{destination}}
+are D-Bus names. They can be unique names, or well-known service
+names.
+
+@code{:path @var{path}} is the D-Bus object to be monitored.
+@code{:interface @var{interface}} is the name of an interface, and
+@code{:member @var{member}} is either a method name, a signal name, or
+an error name.
+
+The following form shows all D-Bus events on the session bus in buffer
+@samp{*D-Bus Monitor*}:
+
+@lisp
+(dbus-register-monitor :session)
+@end lisp
+
+And this form restricts the monitoring on D-Bus errors:
+
+@lisp
+(dbus-register-monitor :session nil :type "error")
+@end lisp
+@end defun
+
+
@node Index
@unnumbered Index
diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi
index 5965da16bb7..243b59b242a 100644
--- a/doc/misc/dired-x.texi
+++ b/doc/misc/dired-x.texi
@@ -150,10 +150,8 @@ Commands using file marking
@noindent
@file{dired-x.el} binds some functions to keys in Dired Mode (@pxref{Key
-Index}) and also binds @kbd{C-x C-j} and @kbd{C-x 4 C-j} @emph{globally} to
-@code{dired-jump} (@pxref{Miscellaneous Commands}). Optionally, it
-also binds @kbd{C-x C-f} and @kbd{C-x 4 C-f} to
-@code{dired-x-find-file} and @code{dired-x-find-file-other-window},
+Index}). Optionally, it also binds @kbd{C-x C-f} and @kbd{C-x 4 C-f}
+to @code{dired-x-find-file} and @code{dired-x-find-file-other-window},
respectively (@pxref{Find File At Point}).
@node Technical Details
@@ -185,13 +183,12 @@ In your @file{~/.emacs} file, or in the system-wide initialization file
@file{default.el} in the @file{site-lisp} directory, put
@example
-(add-hook 'dired-load-hook
- (lambda ()
- (load "dired-x")
- ;; Set dired-x global variables here. For example:
- ;; (setq dired-guess-shell-gnutar "gtar")
- ;; (setq dired-x-hands-off-my-keys nil)
- ))
+(with-eval-after-load 'dired
+ (require 'dired-x)
+ ;; Set dired-x global variables here. For example:
+ ;; (setq dired-guess-shell-gnutar "gtar")
+ ;; (setq dired-x-hands-off-my-keys nil)
+ ))
(add-hook 'dired-mode-hook
(lambda ()
;; Set dired-x buffer-local variables here. For example:
@@ -205,32 +202,10 @@ when you first type @kbd{C-x d}).
@ifnottex
@menu
-* Optional Installation Dired Jump::
* Optional Installation File At Point::
@end menu
@end ifnottex
-@node Optional Installation Dired Jump
-@section Optional Installation Dired Jump
-
-@cindex autoloading @code{dired-jump} and @code{dired-jump-other-window}
-
-In order to have @code{dired-jump} and @code{dired-jump-other-window}
-(@pxref{Miscellaneous Commands}) work @emph{before} @code{dired} and
-@code{dired-x} have been properly loaded you should set-up an autoload
-for these functions. In your @file{.emacs} file put
-
-@example
-(autoload 'dired-jump "dired-x"
- "Jump to Dired buffer corresponding to current buffer." t)
-
-(autoload 'dired-jump-other-window "dired-x"
- "Like \\[dired-jump] (dired-jump) but in other window." t)
-
-(define-key global-map "\C-x\C-j" 'dired-jump)
-(define-key global-map "\C-x4\C-j" 'dired-jump-other-window)
-@end example
-
@node Optional Installation File At Point
@section Optional Installation File At Point
@@ -242,12 +217,10 @@ If you choose to have @file{dired-x.el} bind @code{dired-x-find-file} over
or call @code{dired-x-bind-find-file} after changing the value.
@example
-(add-hook 'dired-load-hook
- (lambda ()
- ;; Bind dired-x-find-file.
- (setq dired-x-hands-off-my-keys nil)
- (load "dired-x")
- ))
+(with-eval-after-load 'dired
+ ;; Bind dired-x-find-file.
+ (setq dired-x-hands-off-my-keys nil)
+ (require 'dired-x))
@end example
@node Omitting Files in Dired
@@ -294,8 +267,8 @@ Marked files are never omitted.
@end table
@noindent
-In order to make Dired Omit work you first need to load @file{dired-x.el}
-inside @code{dired-load-hook} (@pxref{Installation}) and then evaluate
+In order to make Dired Omit work you need to load @file{dired-x}
+after loading @file{dired} (@pxref{Installation}) and then evaluate
@code{(dired-omit-mode 1)} in some way (@pxref{Omitting Variables}).
@ifnottex
@@ -410,7 +383,7 @@ The default value is @kbd{C-o}.
@item
@cindex RCS files, how to omit them in Dired
@cindex omitting RCS files in Dired
-If you wish to avoid seeing RCS files and the @file{RCS} directory, then put
+If you wish to avoid seeing RCS files and the @file{RCS} directory, then use
@example
(setq dired-omit-files
@@ -418,7 +391,7 @@ If you wish to avoid seeing RCS files and the @file{RCS} directory, then put
@end example
@noindent
-in the @code{dired-load-hook} (@pxref{Installation}). This assumes
+after loading @file{dired-x} (@pxref{Installation}). This assumes
@code{dired-omit-localp} has its default value of @code{no-dir} to make the
@code{^}-anchored matches work. As a slower alternative, with
@code{dired-omit-localp} set to @code{nil}, you can use @code{/} instead of
@@ -429,7 +402,7 @@ in the @code{dired-load-hook} (@pxref{Installation}). This assumes
@cindex omitting tib files in Dired
If you use @code{tib}, the bibliography program for use with @TeX{} and
@LaTeX{}, and you
-want to omit the @file{INDEX} and the @file{*-t.tex} files, then put
+want to omit the @file{INDEX} and the @file{*-t.tex} files, then use
@example
(setq dired-omit-files
@@ -437,13 +410,13 @@ want to omit the @file{INDEX} and the @file{*-t.tex} files, then put
@end example
@noindent
-in the @code{dired-load-hook} (@pxref{Installation}).
+after loading @file{dired-x} (@pxref{Installation}).
@item
@cindex dot files, how to omit them in Dired
@cindex omitting dot files in Dired
If you do not wish to see @samp{dot} files (files starting with a @file{.}),
-then put
+then use
@example
(setq dired-omit-files
@@ -451,7 +424,7 @@ then put
@end example
@noindent
-in the @code{dired-load-hook} (@pxref{Installation}). (Of course, a
+after loading @file{dired-x} (@pxref{Installation}). (Of course, a
better way to achieve this particular goal is simply to omit @samp{-a} from
@code{dired-listing-switches}.)
@@ -830,7 +803,7 @@ When installed @file{dired-x} will substitute @code{dired-x-find-file} for
(normally bound to @kbd{C-x 4 C-f}).
In order to use this feature, you will need to set
-@code{dired-x-hands-off-my-keys} to @code{nil} inside @code{dired-load-hook}
+@code{dired-x-hands-off-my-keys} to @code{nil} before loading @file{dired-x}
(@pxref{Optional Installation File At Point}).
@table @code
@@ -922,28 +895,6 @@ inserted subdirectories.
@table @code
-@item dired-jump
-@findex dired-jump
-@kindex C-x C-j
-@cindex jumping to Dired listing containing file.
-Bound to @kbd{C-x C-j}. Jump back to Dired: If in a file, edit the current
-directory and move to file's line. If in Dired already, pop up a level and
-go to old directory's line. In case the proper Dired file line cannot be
-found, refresh the Dired buffer and try again.
-
-@item dired-jump-other-window
-@findex dired-jump-other-window
-@kindex C-x 4 C-j
-Bound to @kbd{C-x 4 C-j}. Like @code{dired-jump}, but to other window.
-
-These functions can be autoloaded so they work even though @file{dired-x.el}
-has not been loaded yet (@pxref{Optional Installation Dired Jump}).
-
-@vindex dired-bind-jump
-If the variable @code{dired-bind-jump} is @code{nil}, @code{dired-jump} will not be
-bound to @kbd{C-x C-j} and @code{dired-jump-other-window} will not be bound to
-@kbd{C-x 4 C-j}.
-
@item dired-vm
@cindex reading mail.
@kindex V
diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi
index 99ba89b0d7f..1ef13716b11 100644
--- a/doc/misc/ediff.texi
+++ b/doc/misc/ediff.texi
@@ -1197,10 +1197,6 @@ refer to Emacs manual for the information on how to set Emacs X resources.
The bulk of customization can be done via the following hooks:
@table @code
-@item ediff-load-hook
-@vindex ediff-load-hook
-This hook can be used to change defaults after Ediff is loaded.
-
@item ediff-before-setup-hook
@vindex ediff-before-setup-hook
Hook that is run just before Ediff rearranges windows to its liking.
@@ -1211,8 +1207,8 @@ Can be used to save windows configuration.
@vindex ediff-mode-map
This hook can be used to alter bindings in Ediff's keymap,
@code{ediff-mode-map}. These hooks are
-run right after the default bindings are set but before
-@code{ediff-load-hook}. The regular user needs not be concerned with this
+run right after the default bindings are set.
+The regular user needs not be concerned with this
hook---it is provided for implementers of other Emacs packages built on top
of Ediff.
@@ -1545,12 +1541,13 @@ directly (using @kbd{j}) to any numbered
difference.
Users can supply their own functions to specify how Ediff should do
-selective browsing. To change the default Ediff function, add a function to
-@code{ediff-load-hook} which will do the following assignments:
+selective browsing. To change the default Ediff function, use
+something like the following:
@example
-(setq ediff-hide-regexp-matches-function 'your-hide-function)
-(setq ediff-focus-on-regexp-matches-function 'your-focus-function)
+(with-eval-after-load 'ediff
+ (setq ediff-hide-regexp-matches-function 'your-hide-function)
+ (setq ediff-focus-on-regexp-matches-function 'your-focus-function))
@end example
@strong{Useful hint}: To specify a regexp that matches everything, don't
@@ -1728,23 +1725,17 @@ difference region in buffer A (this face is not a good choice, by the way).
If you are unhappy with just @emph{some} of the aspects of the default
faces, you can modify them when Ediff is being loaded using
-@code{ediff-load-hook}. For instance:
+@code{with-eval-after-load}. For instance:
@smallexample
-(add-hook 'ediff-load-hook
- (lambda ()
- (set-face-foreground
- ediff-current-diff-face-B "blue")
- (set-face-background
- ediff-current-diff-face-B "red")
- (make-face-italic
- ediff-current-diff-face-B)))
+(with-eval-after-load 'ediff
+ (set-face-foreground
+ ediff-current-diff-face-B "blue")
+ (set-face-background
+ ediff-current-diff-face-B "red")
+ (make-face-italic ediff-current-diff-face-B))
@end smallexample
-@strong{Please note:} to set Ediff's faces, use only @code{copy-face}
-or @code{set/make-face-@dots{}} as shown above. Emacs's low-level
-face-manipulation functions should be avoided.
-
@node Narrowing
@section Narrowing
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index f948a489f44..3c1244101f4 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -1595,6 +1595,10 @@ xterm-direct2 xterm with direct-color indexing (old)
xterm-direct xterm with direct-color indexing
@end example
+If Terminfo database is not available, but 24-bit direct color mode is
+supported, it can still be enabled by defining the environment
+variable @env{COLORTERM} to @samp{truecolor}.
+
Terminals with @samp{RGB} capability treat pixels #000001 - #000007 as
indexed colors to maintain backward compatibility with applications
that are unaware of direct color mode. Therefore the seven darkest
@@ -2515,9 +2519,8 @@ To avoid seeing backup files (and other ``uninteresting'' files) in Dired,
load @code{dired-x} by adding the following to your @file{.emacs} file:
@lisp
-(add-hook 'dired-load-hook
- (lambda ()
- (require 'dired-x)))
+(with-eval-after-load 'dired
+ (require 'dired-x))
@end lisp
With @code{dired-x} loaded, @kbd{M-o} toggles omitting in each dired buffer.
@@ -3461,7 +3464,6 @@ see @ref{Packages that do not come with Emacs}.
@cindex Finding other packages
@cindex Lisp packages that do not come with Emacs
@cindex Packages, those that do not come with Emacs
-@cindex Emacs Lisp List
@cindex Emacs Lisp Archive
The easiest way to add more features to your Emacs is to use the
@@ -3497,10 +3499,6 @@ The @uref{https://emacswiki.org, Emacs Wiki} contains pointers to some
additional extensions. @uref{https://wikemacs.org, WikEmacs} is an
alternative wiki for Emacs.
-@uref{http://www.damtp.cam.ac.uk/user/sje30/emacs/ell.html, The Emacs
-Lisp List (ELL)}, has pointers to many Emacs Lisp files, but at time
-of writing it is no longer being updated.
-
It is impossible for us to list here all the sites that offer Emacs
Lisp packages. If you are interested in a specific feature, then
after checking Emacs itself and GNU ELPA, a web search is often the
@@ -4189,7 +4187,7 @@ You can get the old behavior by binding @kbd{SPC} to
(define-key minibuffer-local-filename-completion-map (kbd "SPC")
'minibuffer-complete-word)
-(define-key minibuffer-local-must-match-filename-map (kbd "SPC")
+(define-key minibuffer-local-filename-must-match-map (kbd "SPC")
'minibuffer-complete-word)
@end lisp
diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi
index aceaff051e3..8dd394cb848 100644
--- a/doc/misc/eieio.texi
+++ b/doc/misc/eieio.texi
@@ -698,6 +698,27 @@ 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.
+
+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 defmac
+
+@defmac oref-default class slot
+@anchor{oref-default}
+This macro returns the value of the class-allocated @var{slot} from
+@var{class}.
+
+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 defmac
+
@defmac oset object slot value
This macro sets the value behind @var{slot} to @var{value} in
@var{object}. It returns @var{value}.
@@ -716,17 +737,6 @@ changed, this can be arranged by simply executing this bit of code:
@end example
@end defmac
-@defmac oref obj slot
-@anchor{oref}
-Retrieve the value stored in @var{obj} in the slot named by @var{slot}.
-Slot is the name of the slot when created by @dfn{defclass}.
-@end defmac
-
-@defmac oref-default class slot
-@anchor{oref-default}
-Get the value of the class-allocated @var{slot} from @var{class}.
-@end defmac
-
The following accessors are defined by CLOS to reference or modify
slot values, and use the previously mentioned set/ref routines.
diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi
index 7c57cc032c7..bb13ebdf238 100644
--- a/doc/misc/emacs-gnutls.texi
+++ b/doc/misc/emacs-gnutls.texi
@@ -190,7 +190,7 @@ the connection process.
The optional @var{parameters} argument is a list of keywords and
values. The only keywords which currently have any effect are
-@code{:client-certificate} and @code{:nowait}.
+@code{:client-certificate}, @code{:nowait}, and @code{:coding}.
Passing @w{@code{:client certificate t}} triggers looking up of client
certificates matching @var{host} and @var{service} using the
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index 42a7750b9ac..9180b4ec205 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -472,6 +472,13 @@ the case if you save it to disk and launch it in a different way
to launch any external programs, set this variable to @code{nil} or
@code{ask}.
+@item mm-inline-font-lock
+@vindex mm-inline-font-lock
+If non-@code{nil}, inlined parts that support font locking (for
+instance, patches or code snippets) will be font-locked. This may be
+overriden by callers that have their own ways of enabling/inhibiting
+font locking.
+
@end table
@node Files and Directories
@@ -686,8 +693,17 @@ Valid values are @samp{inline} and @samp{attachment}
@item encoding
Valid values are @samp{7bit}, @samp{8bit}, @samp{quoted-printable} and
-@samp{base64} (@code{Content-Transfer-Encoding}). @xref{Charset
-Translation}.
+@samp{base64}. @xref{Charset
+Translation}. This parameter says what
+@code{Content-Transfer-Encoding} to use when sending the part, and is
+normally computed automatically.
+
+@item data-encoding
+This parameter says what encoding has been used on the data, and the
+data will be decoded before use. Valid values are
+@samp{quoted-printable} and @samp{base64}. This is useful when you
+have a part with binary data (for instance an image) inserted directly
+into the Message buffer inside the @samp{"<#part>...<#/part>"} tags.
@item description
A description of the part (@code{Content-Description}).
@@ -917,7 +933,7 @@ Here's an example:
@lisp
(add-to-list 'gnus-newsgroup-variables 'mm-coding-system-priorities)
(setq gnus-parameters
- (nconc
+ (append
;; Some charsets are just examples!
'(("^cn\\." ;; Chinese
(mm-coding-system-priorities
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index 57f713635f8..c33ca0ea02c 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -159,6 +159,9 @@ The following persons have made contributions to Eshell.
@itemize @bullet
@item
+John Wiegley is the original author of Eshell.
+
+@item
Eli Zaretskii made it possible for Eshell to run without requiring
asynchronous subprocess support. This is important for MS-DOS, which
does not have such support.
diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi
index 701340ed6e2..69a8512f175 100644
--- a/doc/misc/eudc.texi
+++ b/doc/misc/eudc.texi
@@ -83,6 +83,8 @@ Currently supported back-ends are:
LDAP, Lightweight Directory Access Protocol
@item
BBDB, Big Brother's Insidious Database
+@item
+macOS Contacts
@end itemize
The main features of the EUDC interface are:
@@ -107,6 +109,7 @@ Interface to BBDB to let you insert server records into your own BBDB database
@menu
* LDAP:: What is LDAP ?
* BBDB:: What is BBDB ?
+* macOS Contacts:: What is macOS Contacts ?
@end menu
@@ -159,6 +162,17 @@ queries on multiple servers.
EUDC also offers a means to insert results from directory queries into
your own local BBDB (@pxref{Creating BBDB Records})
+
+@node macOS Contacts
+@section macOS Contacts
+
+This EUDC back end considers macOS Contacts as a directory server just
+like LDAP, though the macOS Contacts application always runs locally
+on your machine. The Contacts application was previously called
+Address Book; the EUDC macOS Contacts back end also works on those
+older versions.
+
+
@node Installation
@chapter Installation
@@ -185,6 +199,7 @@ email composition buffers (@pxref{Inline Query Expansion})
@menu
* LDAP Configuration:: EUDC needs external support for LDAP
+* macOS Contacts Configuration:: Enable the macOS Contacts backend
@end menu
@node LDAP Configuration
@@ -379,6 +394,39 @@ The @command{ldapsearch} command is formatted such that it can be
copied and pasted into a terminal. Set the @command{ldapsearch} debug
level to 5 by appending @code{-d 5} to the command line.
+
+@node macOS Contacts Configuration
+@section macOS Contacts Configuration
+
+macOS Contacts support is added by means of @file{eudcb-mab.el}, or
+@file{eudcb-macos-contacts.el} which are part of Emacs.
+
+To enable a macOS Contacts backend, first `require' the respective
+library to load it, and then set the `eudc-server' to localhost in
+your init file:
+@lisp
+(require 'eudcb-macos-contacts)
+(eudc-macos-contacts-set-server "localhost")
+@end lisp
+
+@file{eudcb-macos-contacts.el} uses the public scripting interfaces
+offered by the Contacts app via the macOS Open Scripting Architecture
+(OSA). To accomplish this, @file{eudcb-macos-contacts.el} uses an
+external command line utility named osascript, which is included with
+all macOS versions since 10.0 (which was released 2001).
+@file{eudcb-macos-contacts.el} is hence recommended for all new
+configurations.
+
+@file{eudcb-mab.el} reverse engineers the format of the database file
+used by the macOS Contacts app, and accesses its contents directly.
+While this may promise some performance advantages, it comes at the
+cost of using an undocumented interface. Hence, users of
+@file{eudcb-mab.el} are recommended to double check the compatibility
+of @file{eudcb-mab.el} before upgrading to a new version of macOS.
+@file{eudcb-mab.el} is retained for backwards compatibility with
+existing configurations, and may be removed in a future release.
+
+
@node Usage
@chapter Usage
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index faccd96f723..1bccbd7261a 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -52,6 +52,7 @@ modify this GNU manual.''
* Overview::
* Basics::
* Advanced::
+* Command Line::
Appendices
* History and Acknowledgments::
@@ -141,7 +142,9 @@ HTML-specified colors or not. This sets the @code{shr-use-colors} variable.
A URL can be downloaded with @kbd{d} (@code{eww-download}). This
will download the link under point if there is one, or else the URL of
the current page. The file will be written to the directory specified
-in @code{eww-download-directory} (default: @file{~/Downloads/}).
+by @code{eww-download-directory} (default: @file{~/Downloads/}, if it
+exists; otherwise as specified by the @samp{DOWNLOAD} @acronym{XDG}
+directory)).
@findex eww-back-url
@findex eww-forward-url
@@ -215,6 +218,22 @@ in an external browser by customizing
@node Advanced
@chapter Advanced
+@findex eww-retrieve-command
+ EWW normally uses @code{url-retrieve} to fetch the @acronym{HTML}
+before rendering it. It can sometimes be convenient to use an
+external program to do this, and @code{eww-retrieve-command} should
+then be a list that specifies a command and the parameters. For
+instance, to use the Chromium browser, you could say something like
+this:
+
+@lisp
+(setq eww-retrieve-command
+ '("chromium" "--headless" "--dump-dom"))
+@end lisp
+
+The command should return the @acronym{HTML} on standard output, and
+the data should use @acronym{UTF-8} as the charset.
+
@findex eww-view-source
@kindex v
@cindex Viewing Source
@@ -289,6 +308,14 @@ contrast. If that is still too low for you, you can customize the
variables @code{shr-color-visible-distance-min} and
@code{shr-color-visible-luminance-min} to get a better contrast.
+@vindex shr-max-width
+@vindex shr-width
+ By default, the max width used when rendering is 120 characters, but
+this can be adjusted by changing the @code{shr-max-width} variable.
+If a specified width is preferred no matter what the width of the
+window is, @code{shr-width} can be set. If both variables are
+@code{nil}, the window width will always be used.
+
@vindex shr-discard-aria-hidden
@cindex @code{aria-hidden}, HTML attribute
The HTML attribute @code{aria-hidden} is meant to tell screen
@@ -333,6 +360,21 @@ thus allowing for the use of the usual substitutions, such as
@code{\[eww-reload]} for the current key binding of the
@code{eww-reload} command.
+@node Command Line
+@chapter Command Line Usage
+
+It can be convenient to start eww directly from the command line. The
+@code{eww-browse} function can be used for that:
+
+@example
+emacs -f eww-browse https://gnu.org
+@end example
+
+This also allows registering Emacs as a @acronym{MIME} handler for the
+@samp{"text/x-uri"} media type. How to do that varies between
+systems, but typically you'd register the handler to call @samp{"emacs
+-f eww-browse %u"}.
+
@node History and Acknowledgments
@appendix History and Acknowledgments
diff --git a/doc/misc/gnus-coding.texi b/doc/misc/gnus-coding.texi
index 55320bf4c32..9a14a95f797 100644
--- a/doc/misc/gnus-coding.texi
+++ b/doc/misc/gnus-coding.texi
@@ -96,16 +96,6 @@ Read passwords from user, possibly using a password cache.
@c As of 2005-10-21...
There are no Gnus dependencies in this file.
-@item tls.el
-TLS/SSL support via wrapper around GnuTLS
-@c As of 2005-10-21...
-There are no Gnus dependencies in this file.
-
-@item pgg*.el
-Glue for the various PGP implementations.
-@c As of 2005-10-21...
-There are no Gnus dependencies in these files.
-
@item sha1.el
SHA1 Secure Hash Algorithm.
@c As of 2007-08-25...
diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi
index 9c1d2d0160a..6e2aedae716 100644
--- a/doc/misc/gnus-faq.texi
+++ b/doc/misc/gnus-faq.texi
@@ -1757,7 +1757,7 @@ more then one article."
(let ((archive-name
(format
"nnml:1.%s"
- (replace-in-string gnus-newsgroup-name "^.*:" ""))))
+ (replace-regexp-in-string "^.*:" "" gnus-newsgroup-name))))
(gnus-summary-copy-article n archive-name)))
@end example
@noindent
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index a96be30cd61..a1c8b327f26 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -402,6 +402,7 @@ This manual corresponds to Gnus v5.13
@end iftex
@menu
+* Don't Panic:: Your first 20 minutes with Gnus.
* Starting Up:: Finding news can be a pain.
* Group Buffer:: Selecting, subscribing and killing groups.
* Summary Buffer:: Reading, saving and posting articles.
@@ -436,7 +437,7 @@ Starting Gnus
* Finding the News:: Choosing a method for getting news.
* The Server is Down:: How can I read my mail then?
-* Slave Gnusae:: You can have more than one Gnus active at a time.
+* Child Gnusae:: You can have more than one Gnus active at a time.
* Fetching a Group:: Starting Gnus just to read a group.
* New Groups:: What is Gnus supposed to do with new groups?
* Changing Servers:: You may want to move from one server to another.
@@ -640,7 +641,7 @@ Select Methods
* Getting Mail:: Reading your personal mail with Gnus.
* Browsing the Web:: Getting messages from a plethora of Web sources.
* Other Sources:: Reading directories, files.
-* Combined Groups:: Combining groups into one group.
+* Virtual Groups:: Combining articles from multiple sources.
* Email Based Diary:: Using mails to manage diary events in Gnus.
* Gnus Unplugged:: Reading news and mail offline.
@@ -715,9 +716,10 @@ Document Groups
* Document Server Internals:: How to add your own document types.
-Combined Groups
+Virtual Groups
-* Virtual Groups:: Combining articles from many groups.
+* Selection Groups:: Articles selected from many places.
+* Combined Groups:: Combining multiple groups.
Email Based Diary
@@ -827,6 +829,7 @@ Various
* Spam Package:: A package for filtering and processing spam.
* The Gnus Registry:: A package for tracking messages by Message-ID.
* The Gnus Cloud:: A package for synchronizing Gnus marks.
+* D-Bus Integration:: Closing Gnus servers on system sleep.
* Other modes:: Interaction with other modes.
* Various Various:: Things that are really various.
@@ -946,6 +949,140 @@ Emacs for Heathens
@end detailmenu
@end menu
+@node Don't Panic
+@chapter Don't Panic
+@cindex don't panic
+@cindex introduction to Gnus
+
+Welcome, gentle user, to the Gnus newsreader and email client! Gnus
+is unlike most clients, in part because of its endless
+configurability, in part because of its historical origins. Gnus is
+now a fully-featured email client, but it began life as a Usenet-style
+newsreader, and its genes are still newsreader genes. Thus it behaves
+a little differently than most mail clients.
+
+The typical assumptions of a newsreader are:
+
+@enumerate
+@item
+The server offers a potentially enormous number of newsgroups on a
+variety of subjects. The user may only be interested in some of those
+groups, and more interested in some than others.
+@item
+Many groups see a high volume of articles, and the user won't want to
+read all of them. Mechanisms are needed for foregrounding interesting
+articles, and backgrounding uninteresting articles.
+@item
+Once a group has been scanned and dealt with by the user, it's
+unlikely to be of further interest until new articles come in.
+@end enumerate
+
+These assumptions lead to certain default Gnus behaviors:
+
+@enumerate
+@item
+Not all interesting groups are equally interesting, thus groups have
+varying degrees of ``subscribedness'', with different behavior
+depending on ``how subscribed'' a group is.
+@item
+There are many commands and tools for scoring and sorting articles,
+or otherwise sweeping them under the rug.
+@item
+Gnus will only show you groups with unread or ticked articles;
+groups with no new articles are hidden.
+@item
+When entering a group, only unread or ticked articles are shown,
+all other articles are hidden.
+@end enumerate
+
+If this seems draconian, think of it as Automatic Inbox Zero. This is
+the way Gnus works by default. It is possible to make it work more
+like an email client (always showing read groups and read articles),
+but that takes some effort on the part of the user.
+
+The brief introduction below should be enough to get you off the
+ground.
+
+@heading The Basics of Servers, Groups, and Articles
+@cindex servers
+@cindex groups
+@cindex articles
+
+The fundamental building blocks of Gnus are @dfn{servers},
+@dfn{groups}, and @dfn{articles}. Servers can be local or remote.
+Each server maintains a list of groups, and those groups contain
+articles. Because Gnus presents a unified interface to a wide variety
+of servers, the vocabulary doesn't always quite line up (see @ref{FAQ
+- Glossary}, for a more complete glossary). Thus a local maildir is
+referred to as a ``server'' (@pxref{Finding the News}) the same as a
+Usenet or IMAP server is; ``groups'' (@pxref{Group Buffer}) might mean
+an NNTP group, IMAP folder, or local mail directory; and an
+``article'' (@pxref{Summary Buffer}) might elsewhere be known as a
+message or an email. Gnus employs unified terms for all these things.
+
+Servers fall into two general categories: ``news-like'', meaning that
+the articles are part of a public archive and can't be manipulated by
+the user; and ``mail-like'', meaning that the articles are owned by
+the user, who can freely edit them, move them around, and delete
+them.
+
+For news-like servers, which typically offer hundreds or thousands of
+groups, it's important to be able to subscribe to a subset of those
+groups. For mail-like servers, the user is generally automatically
+subscribed to all groups (though IMAP, for example, also allows
+selective subscription). To change group subscription, enter the
+Server buffer (with @kbd{^}) and press @kbd{@key{RET}} on the server
+in question. From here, Gnus provides commands to change or toggle
+your group subscriptions (@pxref{Browse Foreign Server}).
+
+A Gnus installation is basically just a list of one or more servers,
+plus the user's subscribed groups from those servers, plus articles in
+those groups.
+
+Servers can be added and configured in two places: in the user's
+gnus.el startup file, using the @code{gnus-select-method} and
+@code{gnus-secondary-select-methods} options, or within Gnus itself
+using interactive commands in the Server buffer. @xref{Finding
+the News}, for details.
+
+
+@heading Fetching Mail
+
+New mail has to come from somewhere. Some servers, such as NNTP or
+IMAP, are themselves responsible for fetching newly-arrived articles.
+Others, such as maildir or mbox servers, only store articles and don't
+fetch them from anywhere.
+
+In the latter case, Gnus provides for @code{mail sources}: places
+where new mail is fetched from. A mail source might be a local spool,
+or a remote POP server, or some other source of incoming articles.
+Mail sources are usually configured globally, but can be specified
+per-group (@pxref{Mail Sources} for more information).
+
+@xref{Scanning New Messages}, for details on fetching new mail.
+
+@heading Viewing Mail
+
+By default, Gnus's Group buffer only displays groups with unread
+articles. It is always possible to display all the groups temporarily
+with @kbd{L}, and to configure Gnus to always display some groups
+(@pxref{Listing Groups}).
+
+@xref{Selecting a Group}, for how to enter a group, and @pxref{Summary
+Buffer} for what to do once you're there.
+
+@heading Sending Mail
+
+New message composition can be initiated from the Group buffer
+(@pxref{Misc Group Stuff}). If you're in a Summary buffer, you can
+compose replies and forward emails in addition to starting new
+messages, see @ref{Summary Mail Commands}, for details.
+
+For information about what happens once you've started composing a
+message, see @ref{Composing Messages}. For information on setting up
+@acronym{SMTP} servers in particular, see @ref{Mail Variables, ,Mail
+Variables,message,Message manual}.
+
@node Starting Up
@chapter Starting Gnus
@cindex starting up
@@ -975,7 +1112,7 @@ terminology section (@pxref{Terminology}).
@menu
* Finding the News:: Choosing a method for getting news.
* The Server is Down:: How can I read my mail then?
-* Slave Gnusae:: You can have more than one Gnus active at a time.
+* Child Gnusae:: You can have more than one Gnus active at a time.
* New Groups:: What is Gnus supposed to do with new groups?
* Changing Servers:: You may want to move from one server to another.
* Startup Files:: Those pesky startup files---@file{.newsrc}.
@@ -1089,9 +1226,9 @@ your primary server---instead, it will just activate all groups on level
levels.) Also @pxref{Group Levels}.
-@node Slave Gnusae
-@section Slave Gnusae
-@cindex slave
+@node Child Gnusae
+@section Child Gnusae
+@cindex child
You might want to run more than one Emacs with more than one Gnus at the
same time. If you are using different @file{.newsrc} files (e.g., if you
@@ -1102,31 +1239,27 @@ The problem appears when you want to run two Gnusae that use the same
@file{.newsrc} file.
To work around that problem some, we here at the Think-Tank at the Gnus
-Towers have come up with a new concept: @dfn{Masters} and
-@dfn{slaves}. (We have applied for a patent on this concept, and have
-taken out a copyright on those words. If you wish to use those words in
-conjunction with each other, you have to send $1 per usage instance to
-me. Usage of the patent (@dfn{Master/Slave Relationships In Computer
-Applications}) will be much more expensive, of course.)
-
-@findex gnus-slave
+Towers have come up with a new concept: @dfn{Parents} and
+@dfn{children}.
+
+@findex gnus-child
Anyway, you start one Gnus up the normal way with @kbd{M-x gnus} (or
-however you do it). Each subsequent slave Gnusae should be started with
-@kbd{M-x gnus-slave}. These slaves won't save normal @file{.newsrc}
-files, but instead save @dfn{slave files} that contain information only
-on what groups have been read in the slave session. When a master Gnus
-starts, it will read (and delete) these slave files, incorporating all
-information from them. (The slave files will be read in the sequence
+however you do it). Each subsequent child Gnusae should be started with
+@kbd{M-x gnus-child}. These children won't save normal @file{.newsrc}
+files, but instead save @dfn{child files} that contain information only
+on what groups have been read in the child session. When a parent Gnus
+starts, it will read (and delete) these child files, incorporating all
+information from them. (The child files will be read in the sequence
they were created, so the latest changes will have precedence.)
-Information from the slave files has, of course, precedence over the
-information in the normal (i.e., master) @file{.newsrc} file.
+Information from the child files has, of course, precedence over the
+information in the normal (i.e., parent) @file{.newsrc} file.
-If the @file{.newsrc*} files have not been saved in the master when the
-slave starts, you may be prompted as to whether to read an auto-save
-file. If you answer ``yes'', the unsaved changes to the master will be
-incorporated into the slave. If you answer ``no'', the slave may see some
-messages as unread that have been read in the master.
+If the @file{.newsrc*} files have not been saved in the parent when the
+child starts, you may be prompted as to whether to read an auto-save
+file. If you answer ``yes'', the unsaved changes to the parent will be
+incorporated into the child. If you answer ``no'', the child may see some
+messages as unread that have been read in the parent.
@@ -1562,12 +1695,6 @@ secondary select methods.
@table @code
-@item gnus-load-hook
-@vindex gnus-load-hook
-A hook run while Gnus is being loaded. Note that this hook will
-normally be run just once in each Emacs session, no matter how many
-times you start Gnus.
-
@item gnus-before-startup-hook
@vindex gnus-before-startup-hook
A hook called as the first thing when Gnus is started.
@@ -4840,6 +4967,15 @@ The address (from the @code{From} header). This works the same way as
the @code{a} spec.
@item L
Number of lines in the article.
+@item Z
+Retrieval Score Value (RSV) of the article; nil if not in an nnselect
+group.
+@item G
+Originating group name of the article; nil if not in an nnselect
+group.
+@item g
+Short form of the originating group name of the article; nil if not in
+an nnselect group.
@item c
Number of characters in the article. This specifier is not supported
in some methods (like nnfolder).
@@ -9069,6 +9205,9 @@ when filling.
@findex gnus-article-fill-long-lines
Fill long lines (@code{gnus-article-fill-long-lines}).
+You can give the command a numerical prefix to specify the width to use
+when filling.
+
@item W C
@kindex W C @r{(Summary)}
@findex gnus-article-capitalize-sentences
@@ -10277,12 +10416,20 @@ article (@code{gnus-summary-refer-references}).
@findex gnus-summary-refer-thread
@kindex A T @r{(Summary)}
Display the full thread where the current article appears
-(@code{gnus-summary-refer-thread}). This command has to fetch all the
-headers in the current group to work, so it usually takes a while. If
-you do it often, you may consider setting @code{gnus-fetch-old-headers}
-to @code{invisible} (@pxref{Filling In Threads}). This won't have any
-visible effects normally, but it'll make this command work a whole lot
-faster. Of course, it'll make group entry somewhat slow.
+(@code{gnus-summary-refer-thread}). By default this command looks for
+articles only in the current group. Some backends (currently only
+@code{nnimap}) know how to find articles in the thread directly. In
+other cases each header in the current group must be fetched and
+examined, so it usually takes a while. If you do it often, you may
+consider setting @code{gnus-fetch-old-headers} to @code{invisible}
+(@pxref{Filling In Threads}). This won't have any visible effects
+normally, but it'll make this command work a whole lot faster. Of
+course, it'll make group entry somewhat slow.
+
+@vindex gnus-refer-thread-use-search
+If @code{gnus-refer-thread-use-search} is non-nil then those backends
+that know how to find threads directly will search not just in the
+current group but all groups on the same server.
@vindex gnus-refer-thread-limit
The @code{gnus-refer-thread-limit} variable says how many old (i.e.,
@@ -10291,6 +10438,16 @@ fetch when doing this command. The default is 200. If @code{t}, all
the available headers will be fetched. This variable can be overridden
by giving the @kbd{A T} command a numerical prefix.
+@vindex gnus-refer-thread-limit-to-thread
+In most cases @code{gnus-refer-thread} adds any articles it finds to
+the current summary buffer. (When @code{gnus-refer-thread-use-search}
+is true and the initial referral starts from a summary buffer for a
+non-virtual group this may not be possible. In this case a new
+summary buffer is created holding a virtual group with the result of
+the thread search.) If @code{gnus-refer-thread-limit-to-thread} is
+non-nil then the summary buffer will be limited to articles in the
+thread.
+
@item M-^ (Summary)
@findex gnus-summary-refer-article
@kindex M-^ @r{(Summary)}
@@ -10900,14 +11057,14 @@ Go to the Gnus info node (@code{gnus-info-find-node}).
@table @kbd
-@item M-s
-@kindex M-s @r{(Summary)}
+@item M-s M-s
+@kindex M-s M-s @r{(Summary)}
@findex gnus-summary-search-article-forward
Search through all subsequent (raw) articles for a regexp
(@code{gnus-summary-search-article-forward}).
-@item M-r
-@kindex M-r @r{(Summary)}
+@item M-s M-r
+@kindex M-s M-r @r{(Summary)}
@findex gnus-summary-search-article-backward
Search through all previous (raw) articles for a regexp
(@code{gnus-summary-search-article-backward}).
@@ -11822,6 +11979,11 @@ anything that isn't a newsgroup. This means that no external images
will be fetched as a result of reading mail, so that nobody can use
web bugs (and the like) to track whether you've read email.
+@vindex gnus-global-groups
+If you have specific private groups that you want to have treated as
+if they were public groups, you can add the name of that group to the
+@code{gnus-global-groups} list.
+
Also @pxref{Misc Article} for @code{gnus-inhibit-images}.
@item gnus-html-cache-directory
@@ -13132,7 +13294,7 @@ The different methods all have their peculiarities, of course.
* Getting Mail:: Reading your personal mail with Gnus.
* Browsing the Web:: Getting messages from a plethora of Web sources.
* Other Sources:: Reading directories, files.
-* Combined Groups:: Combining groups into one group.
+* Virtual Groups:: Combining articles and groups together.
* Email Based Diary:: Using mails to manage diary events in Gnus.
* Gnus Unplugged:: Reading news and mail offline.
@end menu
@@ -17704,19 +17866,131 @@ methods, but want to only use secondary ones:
@end lisp
-@node Combined Groups
-@section Combined Groups
+@node Virtual Groups
+@section Virtual Groups
-Gnus allows combining a mixture of all the other group types into bigger
-groups.
+Gnus allows combining articles from many sources, and combinations of
+whole groups together into virtual groups.
@menu
-* Virtual Groups:: Combining articles from many groups.
+* Selection Groups:: Combining articles from many groups.
+* Combined Groups:: Combining multiple groups.
@end menu
-@node Virtual Groups
-@subsection Virtual Groups
+@node Selection Groups
+@subsection Select Groups
+@cindex nnselect
+@cindex select groups
+@cindex selecting articles
+
+
+Gnus provides the @dfn{nnselect} method for creating virtual groups
+composed of collections of messages, even when these messages come
+from groups that span multiple servers and backends. For the most
+part these virtual groups behave like any other group: messages may be
+threaded, marked, moved, deleted, copied, etc.; groups may be
+ephemeral or persistent; groups may be created via
+@code{gnus-group-make-group} or browsed as foreign via
+@code{gnus-group-browse-foreign-server}.
+
+The key to using an nnselect group is specifying the messages to
+include. Each nnselect group has a group parameter
+@code{nnselect-specs} which is an alist with two elements: a function
+@code{nnselect-function}; and arguments @code{nnselect-args} to be
+passed to the function, if any.
+
+The function @code{nnselect-function} must return a vector. Each
+element of this vector is in turn a 3-element vector corresponding to
+one message. The 3 elements are: the fully-qualified group name; the
+message number; and a "score" that can be used for additional sorting.
+The values for the score are arbitrary, and are not used directly by
+the nnselect method---they may, for example, all be set to 100.
+
+Here is an example:
+
+@lisp
+(nnselect-specs
+ (nnselect-function . identity)
+ (nnselect-args
+ . [["nnimap+work:mail" 595 100]
+ ["nnimap+home:sent" 223 100]
+ ["nntp+news.gmane.org:gmane.emacs.gnus.general" 23666 100]]))
+@end lisp
+
+The function is the identity and the argument is just the list of
+messages to include in the virtual group.
+
+Or we may wish to create a group from the results of a search query:
+
+@lisp
+(nnselect-specs
+ (nnselect-function . nnir-run-query)
+ (nnselect-args
+ (nnir-query-spec
+ (query . "FLAGGED")
+ (criteria . ""))
+ (nnir-group-spec
+ ("nnimap:home")
+ ("nnimap:work"))))
+@end lisp
+
+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:
+
+@lisp
+(defun my-recent-email (args)
+ (let ((query-spec
+ (list
+ (cons 'query
+ (format-time-string "SENTSINCE %d-%b-%Y"
+ (time-subtract (current-time)
+ (days-to-time (car args)))))
+ (cons 'criteria "")))
+ (group-spec (cadr args)))
+ (nnir-run-query (cons 'nnir-specs
+ (list (cons 'nnir-query-spec query-spec)
+ (cons 'nnir-group-spec group-spec))))))
+@end lisp
+
+Then the following @code{nnselect-specs}:
+
+@lisp
+(nnselect-specs
+ (nnselect-function . my-recent-email)
+ (nnselect-args . (7 (("nnimap:home") ("nnimap:work")))))
+@end lisp
+
+will provide a group composed of all messages on the home and work
+servers received in the last 7 days.
+
+Refreshing the selection of an nnselect group by running the
+@code{nnselect-function} may take a long time to complete.
+Consequently nnselect groups are not refreshed by default when
+@code{gnus-group-get-new-news} is invoked. In those cases where
+running the function is not too time-consuming, a non-@code{nil} group
+parameter of @code{nnselect-rescan} will allow automatic refreshing.
+A refresh can always be invoked manually through
+@code{gnus-group-get-new-news-this-group}.
+
+The nnir interface (@pxref{nnir}) includes engines for searching a
+variety of backends. While the details of each search engine vary,
+the result of an nnir search is always a vector of the sort used by
+the nnselect method, and the results of nnir queries are usually
+viewed using an nnselect group. Indeed the standard search function
+@code{gnus-group-read-ephemeral-search-group} just creates an
+ephemeral nnselect group with the appropriate nnir query as the
+@code{nnselect-specs}. nnir originally included both the search
+engines and the glue to connect search results to gnus. Over time
+this glue evolved into the nnselect method. The two had a mostly
+amicable parting so that nnselect could pursue its dream of becoming a
+fully functioning backend, but occasional conflicts may still linger.
+
+@node Combined Groups
+@subsection Combined Groups
@cindex nnvirtual
@cindex virtual groups
@cindex merging groups
@@ -19638,7 +19912,7 @@ Substring matching.
Fuzzy matching (@pxref{Fuzzy Matching}).
@item r
-Regexp matching
+Regexp matching.
@end table
@item date
@@ -19666,6 +19940,21 @@ Equal to number.
@item >
Greater than number.
@end table
+
+@item body-strings
+
+These match types are available on the @samp{head} and @code{body}
+``header types''.
+
+@table @kbd
+
+@item z
+Substring matching.
+
+@item p
+Regexp matching.
+@end table
+
@end table
@item
@@ -19701,7 +19990,8 @@ To make things a bit more complicated, there are shortcuts. If you use
a capital letter on either the second or third keys, Gnus will use
defaults for the remaining one or two keystrokes. The defaults are
``substring'' and ``temporary''. So @kbd{I A} is the same as @kbd{I a s
-t}, and @kbd{I a R} is the same as @kbd{I a r t}.
+t}, and @kbd{I a R} is the same as @kbd{I a r t}. (These shortcuts
+are not available for the body matches.)
These functions take both the numerical prefix and the symbolic prefix
(@pxref{Symbolic Prefixes}). A numerical prefix says how much to lower
@@ -20077,6 +20367,24 @@ this will match articles that were posted when it was April 1st where
the article was posted from. Time zones are such wholesome fun for the
whole family, eh?)
+Finally, two actually useful match types for dates: @code{<} and
+@code{>}. These will allow scoring on the relative age (in days) of
+the articles. Here's an example score file using the method:
+
+@example
+(("date"
+ (7 10 nil <)
+ (7 -10 nil >)
+ (14 -10 nil >)))
+@end example
+
+This results in articles less than a week old getting a 10 point
+increase, articles older than a week getting a 10 point decrease, and
+articles older than two weeks getting a cumulative 20 point decrease.
+
+The day can also be a floating point number: To score articles less
+than an hour old, you can say @samp{(0.04 10 nil <)}.
+
@item Head, Body, All
These three match keys use the same match types as the @code{From} (etc.)@:
header uses.
@@ -20107,6 +20415,36 @@ key will lead to creation of @file{ADAPT} files.)
@end enumerate
@cindex score file atoms
+@item score-fn
+The value of this entry should be one or more user-defined function
+names in parentheses. Each function will be called in order and the
+returned value is required to be an integer.
+
+@example
+(score-fn (custom-scoring))
+@end example
+
+The user-defined function is called with an associative list with the
+keys @code{number subject from date id refs chars lines xref extra}
+followed by the article's score before the function is run.
+
+The following (somewhat contrived) example shows how to use a
+user-defined function that increases an article's score by 10 if the
+year of the article's date is also mentioned in its subject.
+
+@example
+(defun custom-scoring (article-alist score)
+ (let ((subject (cdr (assoc 'subject article-alist)))
+ (date (cdr (assoc 'date article-alist))))
+ (if (string-match (number-to-string
+ (nth 5 (parse-time-string date)))
+ subject)
+ 10)))
+@end example
+
+@code{score-fn} entries are permanent and can only be added or
+modified directly in the @code{SCORE} file.
+
@item mark
The value of this entry should be a number. Any articles with a score
lower than this number will be marked as read.
@@ -21108,14 +21446,25 @@ four days, Gnus will decay the scores four times, for instance.
@chapter Searching
@cindex searching
-FIXME: Add a brief overview of Gnus search capabilities. A brief
-comparison of nnir, nnmairix, contrib/gnus-namazu would be nice
-as well.
-
-This chapter describes tools for searching groups and servers for
-articles matching a query and then retrieving those articles. Gnus
-provides a simpler mechanism for searching through articles in a summary buffer
-to find those matching a pattern. @xref{Searching for Articles}.
+FIXME: A brief comparison of nnir, nnmairix, contrib/gnus-namazu would
+be nice.
+
+Gnus has various ways of finding articles that match certain criteria
+(from a particular author, on a certain subject, etc.). The simplest
+method is to enter a group and then either "limit" the summary buffer
+to the desired articles using the limiting commands (@pxref{Limiting}),
+or searching through messages in the summary buffer (@pxref{Searching
+for Articles}).
+
+Limiting commands and summary buffer searching work on subsets of the
+articles already fetched from the servers, and these commands won't
+query the server for additional articles. While simple, these methods
+are therefore inadequate if the desired articles span multiple groups,
+or if the group is so large that fetching all articles is impractical.
+Many backends (such as imap, notmuch, namazu, etc.) provide their own
+facilities to search for articles directly on the server and Gnus can
+take advantage of these methods. This chapter describes tools for
+searching groups and servers for articles matching a query.
@menu
* nnir:: Searching with various engines.
@@ -21145,7 +21494,7 @@ through mail and news repositories. Different backends (like
interface.
The @code{nnimap} search engine should work with no configuration.
-Other engines require a local index that needs to be created and
+Other engines may require a local index that needs to be created and
maintained outside of Gnus.
@@ -21153,23 +21502,29 @@ maintained outside of Gnus.
@subsection Basic Usage
In the group buffer typing @kbd{G G} will search the group on the
-current line by calling @code{gnus-group-make-nnir-group}. This prompts
-for a query string, creates an ephemeral @code{nnir} group containing
-the articles that match this query, and takes you to a summary buffer
-showing these articles. Articles may then be read, moved and deleted
-using the usual commands.
-
-The @code{nnir} group made in this way is an @code{ephemeral} group,
-and some changes are not permanent: aside from reading, moving, and
-deleting, you can't act on the original article. But there is an
-alternative: you can @emph{warp} (i.e., jump) to the original group
-for the article on the current line with @kbd{A W}, aka
-@code{gnus-warp-to-article}. Even better, the function
-@code{gnus-summary-refer-thread}, bound by default in summary buffers
-to @kbd{A T}, will first warp to the original group before it works
-its magic and includes all the articles in the thread. From here you
-can read, move and delete articles, but also copy them, alter article
-marks, whatever. Go nuts.
+current line by calling @code{gnus-group-read-ephemeral-search-group}.
+This prompts for a query string, creates an ephemeral @code{nnselect}
+group containing the articles that match this query, and takes you to
+a summary buffer showing these articles. Articles may then be read,
+moved and deleted using the usual commands.
+
+The @code{nnselect} group made in this way is @code{ephemeral}: it
+will disappear upon exit from the group. However changes made in the
+group are permanently reflected in the real groups from which the
+articles are drawn. If you want to create a @emph{persistent} group
+that sticks around after exit from the summary buffer, you can call
+@code{gnus-group-make-search-group} (bound to @kbd{G g}).
+
+So you just performed a search whose results are so fabulous you
+wished you had done a persistent search rather than an ephemeral one?
+No problem; you can create such a group by calling
+@code{gnus-summary-make-group-from-search} (bound to @kbd{C-c C-p})
+from the ephemeral summary buffer.
+
+It is occasionally convenient to view articles found through searching
+in their original group. You can @emph{warp} (i.e., jump) to the
+original group for the article on the current line with @kbd{A W}, aka
+@code{gnus-warp-to-article}.
You say you want to search more than just the group on the current line?
No problem: just process-mark the groups you want to search. You want
@@ -21177,16 +21532,17 @@ even more? Calling for an nnir search with the cursor on a topic heading
will search all the groups under that heading.
Still not enough? OK, in the server buffer
-@code{gnus-group-make-nnir-group} (now bound to @kbd{G}) will search all
-groups from the server on the current line. Too much? Want to ignore
-certain groups when searching, like spam groups? Just customize
-@code{nnir-ignored-newsgroups}.
+@code{gnus-group-read-ephemeral-search-group} (now bound to @kbd{G})
+will search all groups from the server on the current line. Too much?
+Want to ignore certain groups when searching, like spam groups? Just
+customize @code{nnir-ignored-newsgroups}.
One more thing: individual search engines may have special search
-features. You can access these special features by giving a prefix-arg
-to @code{gnus-group-make-nnir-group}. If you are searching multiple
-groups with different search engines you will be prompted for the
-special search features for each engine separately.
+features. You can access these special features by giving a
+prefix-arg to @code{gnus-group-read-ephemeral-search-group}. If you
+are searching multiple groups with different search engines you will
+be prompted for the special search features for each engine
+separately.
@node Setting up nnir
@@ -21241,8 +21597,7 @@ variable is set to use the @code{imap} engine for all servers using the
your servers with an @code{nnimap} backend you could change this to
@lisp
-'((nnimap . namazu)
- (nntp . gmane))
+'((nnimap . namazu))
@end lisp
@node The imap Engine
@@ -21445,7 +21800,7 @@ This engine is obsolete.
@item nnir-method-default-engines
Alist of pairs of server backends and search engines. The default
-associations are
+association is
@example
(nnimap . imap)
@end example
@@ -21454,32 +21809,6 @@ associations are
A regexp to match newsgroups in the active file that should be skipped
when searching all groups on a server.
-@item nnir-summary-line-format
-The format specification to be used for lines in an nnir summary buffer.
-All the items from @code{gnus-summary-line-format} are available, along with
-three items unique to nnir summary buffers:
-
-@example
-%Z Search retrieval score value (integer)
-%G Article original full group name (string)
-%g Article original short group name (string)
-@end example
-
-If @code{nil} (the default) this will use @code{gnus-summary-line-format}.
-
-@item nnir-retrieve-headers-override-function
-If non-@code{nil}, a function that retrieves article headers rather than using
-the gnus built-in function. This function takes an article list and
-group as arguments and populates the @code{nntp-server-buffer} with the
-retrieved headers. It should then return either 'nov or 'headers
-indicating the retrieved header format. Failure to retrieve headers
-should return @code{nil}.
-
-If this variable is @code{nil}, or if the provided function returns
-@code{nil} for a search result, @code{gnus-retrieve-headers} will be
-called instead."
-
-
@end table
@@ -22204,6 +22533,7 @@ to you, using @kbd{G b u} and updating the group will usually fix this.
* Spam Package:: A package for filtering and processing spam.
* The Gnus Registry:: A package for tracking messages by Message-ID.
* The Gnus Cloud:: A package for synchronizing Gnus marks.
+* D-Bus Integration:: Closing Gnus servers on system sleep.
* Other modes:: Interaction with other modes.
* Various Various:: Things that are really various.
@end menu
@@ -26257,6 +26587,26 @@ CloudSynchronizationDataPack(TM)s. It's easiest to set this from the
Server buffer (@pxref{Gnus Cloud Setup}).
@end defvar
+@node D-Bus Integration
+@section D-Bus Integration
+@cindex dbus
+@cindex D-Bus
+@cindex gnus-dbus
+@cindex system sleep
+@cindex closing servers automatically
+@cindex hung connections
+
+When using laptops or other systems that have a sleep or hibernate
+functionality, it's possible for long-running server connections to
+become ``hung'', requiring the user to manually close and re-open the
+connections after the system resumes. On systems compiled with D-Bus
+support (check the value of @code{(featurep 'dbusbind)}), Gnus can
+register a D-Bus signal to automatically close all server connections
+before the system goes to sleep. To enable this, set
+@code{gnus-dbus-close-on-sleep} to a non-nil value.
+
+For more information about D-Bus and Emacs, @pxref{Top,,, dbus, D-Bus integration in Emacs}.
+
@node Other modes
@section Interaction with other modes
@@ -27898,7 +28248,7 @@ The revised Gnus @acronym{FAQ} is included in the manual,
@acronym{TLS} wrapper shipped with Gnus
@acronym{TLS}/@acronym{SSL} is now supported in @acronym{IMAP} and
-@acronym{NNTP} via @file{tls.el} and GnuTLS.
+@acronym{NNTP} via GnuTLS.
@item
Improved anti-spam features.
@@ -28474,9 +28824,9 @@ entry.
The format spec @code{%C} for positioning point has changed to @code{%*}.
@item
-@code{gnus-slave-unplugged}
+@code{gnus-child-unplugged}
-A new command which starts Gnus offline in slave mode.
+A new command which starts Gnus offline in child mode.
@end itemize
diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi
index 547b16622fc..5cb6b19181c 100644
--- a/doc/misc/idlwave.texi
+++ b/doc/misc/idlwave.texi
@@ -1805,8 +1805,8 @@ Structure tag completion is not enabled by default. To enable it,
simply add the following to your @file{.emacs}:
@lisp
- (add-hook 'idlwave-load-hook
- (lambda () (require 'idlw-complete-structtag)))
+(with-eval-after-load 'idlwave
+ (require 'idlw-complete-structtag))
@end lisp
Once enabled, you'll also be able to access online help on the structure
@@ -2360,10 +2360,6 @@ is first called.
Normal hook. Executed when a buffer is put into @code{idlwave-mode}.
@end defopt
-@defopt idlwave-load-hook
-Normal hook. Executed when @file{idlwave.el} is loaded.
-@end defopt
-
@node The IDLWAVE Shell
@chapter The IDLWAVE Shell
@cindex IDLWAVE shell
diff --git a/doc/misc/ido.texi b/doc/misc/ido.texi
index 74d0bdd29fc..7cc4edd2865 100644
--- a/doc/misc/ido.texi
+++ b/doc/misc/ido.texi
@@ -590,7 +590,7 @@ Now you can customize @code{completion-ignored-extensions} as well.
Go ahead and add all the useless object files, backup files, shared
library files and other computing flotsam you don't want Ido to show.
-@strong{Note:} Ido will still complete the ignored elements
+@strong{Please note:} Ido will still complete the ignored elements
if it would otherwise not show any other matches. So if you type out
the name of an ignored file, Ido will still let you open it just fine.
diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index bdd31b1fe49..b192822fac6 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/message.texi
@@ -99,6 +99,7 @@ sending it.
* Resending:: Resending a mail message.
* Bouncing:: Bouncing a mail message.
* Mailing Lists:: Send mail to mailing lists.
+* System Mailer Setup:: Using Message as the system mailer.
@end menu
You can customize the Message Mode tool bar, see @kbd{M-x
@@ -529,6 +530,29 @@ It is considered good netiquette to honor MFT, as it is assumed the
fellow who posted a message knows where the followups need to go
better than you do.
+
+@node System Mailer Setup
+@section System Mailer Setup
+@cindex mailto:
+
+Emacs can be set up as the system mailer, so that Emacs is opened when
+you click on @samp{mailto:} links in other programs.
+
+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"}.
+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.
+
+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
+@samp{"larsi@@gnus.org"} and the @samp{Subject:} header with
+@samp{"This is a test"}.
+
+
@node Commands
@chapter Commands
@@ -883,6 +907,18 @@ is a list, valid members are @code{type}, @code{description} and
@code{nil}, don't ask for options. If it is @code{t}, ask the user
whether or not to specify options.
+@vindex message-screenshot-command
+@findex message-insert-screenshot
+@cindex screenshots
+@kindex C-c C-p
+If your system supports it, you can also insert screenshots directly
+into the Message buffer. The @kbd{C-c C-p}
+(@code{message-insert-screenshot}) command inserts the image into the
+buffer as an @acronym{MML} part, and puts an image text property on
+top. The @code{message-screenshot-command} variable says what
+external command to use to take the screenshot. It defaults to
+@code{"import png:-"}, which is an ImageMagick command.
+
You can also create arbitrarily complex multiparts using the @acronym{MML}
language (@pxref{Composing, , Composing, emacs-mime, The Emacs MIME
Manual}).
@@ -1006,6 +1042,7 @@ and/or encrypted messages as explained in the following.
* Signing and encryption:: Signing and encrypting commands.
* Using S/MIME:: Using S/MIME
* Using OpenPGP:: Using OpenPGP
+* OpenPGP Header:: Adding OpenPGP headers to messages.
* Passphrase caching:: How to cache passphrases
* PGP Compatibility:: Compatibility with older implementations
* Encrypt-to-self:: Reading your own encrypted messages
@@ -1215,6 +1252,29 @@ according to two different standards, namely @acronym{PGP} or
@code{mml-default-sign-method} determine which variant to prefer,
@acronym{PGP/MIME} by default.
+@node OpenPGP Header
+@subsection OpenPGP Header
+
+The @samp{OpenPGP} header can be used to provide information about the
+sender's OpenPGP key. This is a formalization and modernization of
+the non-standard @samp{X-PGP-Key} (etc.) headers that have been in use
+for a long time. For more details, see
+@uref{https://tools.ietf.org/html/draft-josefsson-openpgp-mailnews-header}.
+
+@vindex message-openpgp-header
+To use this in Message, say:
+
+@lisp
+(add-hook 'message-header-setup-hook 'message-add-openpgp-header)
+@end lisp
+
+@noindent
+then customize the @code{message-openpgp-header} variable according to
+your PGP setup. The variable is a list of the key ID, the key URL or
+ASCII armored key, and the protection preference, one of
+@samp{"unprotected"}, @samp{"sign"}, @samp{"encrypt"} or
+@samp{"signencrypt"}.
+
@node Passphrase caching
@subsection Passphrase caching
@@ -2236,8 +2296,11 @@ String to mark the end of some inserted text.
String to be inserted at the end of the message buffer. If @code{t}
(which is the default), the @code{message-signature-file} file will be
inserted instead. If a function, the result from the function will be
-used instead. If a form, the result from the form will be used instead.
-If this variable is @code{nil}, no signature will be inserted at all.
+used instead. If a form, the result from the form will be used
+instead. If this variable is @code{nil}, no signature will be
+inserted at all, but you can still insert your
+@code{message-signature-file} by hand when desired, using the
+@kbd{C-c C-w} (@code{message-insert-signature}) command.
@item message-signature-file
@vindex message-signature-file
diff --git a/doc/misc/org.texi b/doc/misc/org.texi
index 6f6fcd640d0..495d562f50b 100644
--- a/doc/misc/org.texi
+++ b/doc/misc/org.texi
@@ -3979,10 +3979,9 @@ key bindings for this are really too long; you might want to bind
this also to @kbd{M-n} and @kbd{M-p}.
@lisp
-(add-hook 'org-load-hook
- (lambda ()
- (define-key org-mode-map "\M-n" 'org-next-link)
- (define-key org-mode-map "\M-p" 'org-previous-link)))
+(with-eval-after-load 'org
+ (define-key org-mode-map "\M-n" 'org-next-link)
+ (define-key org-mode-map "\M-p" 'org-previous-link))
@end lisp
@end table
diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi
index 013c5639a1e..0dab5241517 100644
--- a/doc/misc/reftex.texi
+++ b/doc/misc/reftex.texi
@@ -2896,9 +2896,8 @@ default. If you want to have these key bindings available, set in your
Note that this variable has to be set before @RefTeX{} is loaded to
have an effect.
-@vindex reftex-load-hook
-Changing and adding to @RefTeX{}'s key bindings is best done in the hook
-@code{reftex-load-hook}. For information on the keymaps
+Changing and adding to @RefTeX{}'s key bindings is best done using
+@code{with-eval-after-load}. For information on the keymaps
which should be used to add keys, see @ref{Keymaps and Hooks}.
@node Faces
@@ -5320,10 +5319,6 @@ argument.
The keymap for @RefTeX{} mode.
@end deffn
-@deffn {Normal Hook} reftex-load-hook
-Normal hook which is being run when loading @file{reftex.el}.
-@end deffn
-
@deffn {Normal Hook} reftex-mode-hook
Normal hook which is being run when turning on @RefTeX{} mode.
@end deffn
diff --git a/doc/misc/sem-user.texi b/doc/misc/sem-user.texi
index c02887d104a..d151cee02cc 100644
--- a/doc/misc/sem-user.texi
+++ b/doc/misc/sem-user.texi
@@ -1068,7 +1068,7 @@ You can integrate @semantic{} with the Speedbar.
line to your init file:
@example
-(add-hook 'speedbar-load-hook (lambda () (require 'semantic/sb)))
+(with-eval-after-load 'speedbar (require 'semantic/sb))
@end example
@noindent
diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi
index 99612d5c8fb..f4367b35377 100644
--- a/doc/misc/smtpmail.texi
+++ b/doc/misc/smtpmail.texi
@@ -267,10 +267,12 @@ file, @pxref{Top,,auth-source, auth, Emacs auth-source Library}.
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@. It tries each of them, in that order,
-until one succeeds. The first uses a form of encryption to obscure
-your password, while the other two do not.
-
+them: CRAM-MD5, PLAIN, and LOGIN, 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
+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.
@node Encryption
@chapter Encryption
@@ -295,26 +297,11 @@ encrypted connection if the server supports it. Other possible values
are: @code{starttls} to insist on STARTTLS; @code{ssl} to use TLS/SSL;
and @code{plain} for no encryption.
-Use of any form of TLS/SSL requires support in Emacs. You can either
-use the built-in support (in Emacs 24.1 and later), or the
-@file{starttls.el} Lisp library. The built-in support uses the GnuTLS
-@footnote{@url{https://www.gnu.org/software/gnutls/}} library.
-If your Emacs has GnuTLS support built-in, the function
+Use of any form of TLS/SSL requires support in Emacs. You can use the
+built-in support for the GnuTLS
+@footnote{@url{https://www.gnu.org/software/gnutls/}} library. If your
+Emacs has GnuTLS support built-in, the function
@code{gnutls-available-p} is defined and returns non-@code{nil}.
-Otherwise, you must use the @file{starttls.el} library (see that file for
-more information on customization options, etc.). The Lisp library
-requires one of the following external tools to be installed:
-
-@enumerate
-@item
-The GnuTLS command line tool @samp{gnutls-cli}, which you can get from
-@url{https://www.gnu.org/software/gnutls/}. This is the recommended
-tool, mainly because it can verify server certificates.
-
-@item
-The @samp{starttls} external program, which you can get from
-@file{starttls-*.tar.gz} from @uref{ftp://ftp.opaopa.org/pub/elisp/}.
-@end enumerate
@cindex certificates
@cindex keys
diff --git a/doc/misc/speedbar.texi b/doc/misc/speedbar.texi
index 57ad0220103..c9c3daf963b 100644
--- a/doc/misc/speedbar.texi
+++ b/doc/misc/speedbar.texi
@@ -828,9 +828,6 @@ Hooks run when speedbar visits a file in the selected frame.
@cindex @code{speedbar-visiting-tag-hook}
@item speedbar-visiting-tag-hook
Hooks run when speedbar visits a tag in the selected frame.
-@cindex @code{speedbar-load-hook}
-@item speedbar-load-hook
-Hooks run when speedbar is loaded.
@cindex @code{speedbar-reconfigure-keymaps-hook}
@item speedbar-reconfigure-keymaps-hook
Hooks run when the keymaps are regenerated. Keymaps are reconfigured
@@ -913,12 +910,11 @@ bindings:
This function creates a special keymap for use in speedbar.
@item
-Call your install function, or assign it to a hook like this:
+Call your install function, like this:
@smallexample
-(if (featurep 'speedbar)
- (@var{name}-install-speedbar-variables)
- (add-hook 'speedbar-load-hook '@var{name}-install-speedbar-variables))
+(with-eval-after-load 'speedbar
+ (@var{name}-install-speedbar-variables))
@end smallexample
@item
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index 254fab92c86..0d2a1fdbc8f 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -3,9 +3,9 @@
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
-\def\texinfoversion{2019-09-24.13}
+\def\texinfoversion{2020-06-25.17}
%
-% Copyright 1985--1986, 1988, 1990--2020 Free Software Foundation, Inc.
+% Copyright 1985, 1986, 1988, 1990-2020 Free Software Foundation, Inc.
%
% This texinfo.tex file is free software: you can redistribute it and/or
% modify it under the terms of the GNU General Public License as
@@ -33,7 +33,7 @@
% The texinfo.tex in any given distribution could well be out
% of date, so if that's what you're using, please check.
%
-% Send bug reports to bug-texinfo@gnu.org. Please include including a
+% Send bug reports to bug-texinfo@gnu.org. Please include a
% complete document in each bug report with which we can reproduce the
% problem. Patches are, of course, greatly appreciated.
%
@@ -349,36 +349,21 @@
\ifodd\pageno \advance\hoffset by \bindingoffset
\else \advance\hoffset by -\bindingoffset\fi
%
+ \checkchapterpage
+ %
% Retrieve the information for the headings from the marks in the page,
% and call Plain TeX's \makeheadline and \makefootline, which use the
% values in \headline and \footline.
%
- % This is used to check if we are on the first page of a chapter.
- \ifcase1\the\savedtopmark\fi
- \let\prevchaptername\thischaptername
- \ifcase0\firstmark\fi
- \let\curchaptername\thischaptername
- %
- \ifodd\pageno \getoddheadingmarks \else \getevenheadingmarks \fi
- %
- \ifx\curchaptername\prevchaptername
- \let\thischapterheading\thischapter
- \else
- % \thischapterheading is the same as \thischapter except it is blank
- % for the first page of a chapter. This is to prevent the chapter name
- % being shown twice.
- \def\thischapterheading{}%
- \fi
- %
% Common context changes for both heading and footing.
% Do this outside of the \shipout so @code etc. will be expanded in
% the headline as they should be, not taken literally (outputting ''code).
- \def\commmonheadfootline{\let\hsize=\txipagewidth \texinfochars}
- %
- \global\setbox\headlinebox = \vbox{\commmonheadfootline \makeheadline}%
+ \def\commonheadfootline{\let\hsize=\txipagewidth \texinfochars}
%
+ \ifodd\pageno \getoddheadingmarks \else \getevenheadingmarks \fi
+ \global\setbox\headlinebox = \vbox{\commonheadfootline \makeheadline}%
\ifodd\pageno \getoddfootingmarks \else \getevenfootingmarks \fi
- \global\setbox\footlinebox = \vbox{\commmonheadfootline \makefootline}%
+ \global\setbox\footlinebox = \vbox{\commonheadfootline \makefootline}%
%
{%
% Set context for writing to auxiliary files like index files.
@@ -423,6 +408,22 @@
\ifr@ggedbottom \kern-\dimen@ \vfil \fi}
}
+% Check if we are on the first page of a chapter. Used for printing headings.
+\newif\ifchapterpage
+\def\checkchapterpage{%
+ % Get the chapter that was current at the end of the last page
+ \ifcase1\the\savedtopmark\fi
+ \let\prevchaptername\thischaptername
+ %
+ \ifodd\pageno \getoddheadingmarks \else \getevenheadingmarks \fi
+ \let\curchaptername\thischaptername
+ %
+ \ifx\curchaptername\prevchaptername
+ \chapterpagefalse
+ \else
+ \chapterpagetrue
+ \fi
+}
% Argument parsing
@@ -1010,7 +1011,7 @@ where each line of input produces a line of output.}
\let\setfilename=\comment
% @bye.
-\outer\def\bye{\pagealignmacro\tracingstats=1\ptexend}
+\outer\def\bye{\chappager\pagelabels\tracingstats=1\ptexend}
\message{pdf,}
@@ -1137,6 +1138,45 @@ where each line of input produces a line of output.}
\fi
+% Output page labels information.
+% See PDF reference v.1.7 p.594, section 8.3.1.
+\ifpdf
+\def\pagelabels{%
+ \def\title{0 << /P (T-) /S /D >>}%
+ \edef\roman{\the\romancount << /S /r >>}%
+ \edef\arabic{\the\arabiccount << /S /D >>}%
+ %
+ % Page label ranges must be increasing. Remove any duplicates.
+ % (There is a slight chance of this being wrong if e.g. there is
+ % a @contents but no @titlepage, etc.)
+ %
+ \ifnum\romancount=0 \def\roman{}\fi
+ \ifnum\arabiccount=0 \def\title{}%
+ \else
+ \ifnum\romancount=\arabiccount \def\roman{}\fi
+ \fi
+ %
+ \ifnum\romancount<\arabiccount
+ \pdfcatalog{/PageLabels << /Nums [\title \roman \arabic ] >> }\relax
+ \else
+ \pdfcatalog{/PageLabels << /Nums [\title \arabic \roman ] >> }\relax
+ \fi
+}
+\else
+ \let\pagelabels\relax
+\fi
+
+\newcount\pagecount \pagecount=0
+\newcount\romancount \romancount=0
+\newcount\arabiccount \arabiccount=0
+\ifpdf
+ \let\ptxadvancepageno\advancepageno
+ \def\advancepageno{%
+ \ptxadvancepageno\global\advance\pagecount by 1
+ }
+\fi
+
+
% PDF uses PostScript string constants for the names of xref targets,
% for display in the outlines, and in other places. Thus, we have to
% double any backslashes. Otherwise, a name like "\node" will be
@@ -1427,7 +1467,13 @@ output) for that.)}
% subentries, which we calculated on our first read of the .toc above.
%
% We use the node names as the destinations.
+ %
+ % Currently we prefix the section name with the section number
+ % for chapter and appendix headings only in order to avoid too much
+ % horizontal space being required in the PDF viewer.
\def\numchapentry##1##2##3##4{%
+ \dopdfoutline{##2 ##1}{count-\expnumber{chap##2}}{##3}{##4}}%
+ \def\unnchapentry##1##2##3##4{%
\dopdfoutline{##1}{count-\expnumber{chap##2}}{##3}{##4}}%
\def\numsecentry##1##2##3##4{%
\dopdfoutline{##1}{count-\expnumber{sec##2}}{##3}{##4}}%
@@ -1669,9 +1715,13 @@ output) for that.)}
% Therefore, we read toc only once.
%
% We use node names as destinations.
+ %
+ % Currently we prefix the section name with the section number
+ % for chapter and appendix headings only in order to avoid too much
+ % horizontal space being required in the PDF viewer.
\def\partentry##1##2##3##4{}% ignore parts in the outlines
\def\numchapentry##1##2##3##4{%
- \dopdfoutline{##1}{1}{##3}{##4}}%
+ \dopdfoutline{##2 ##1}{1}{##3}{##4}}%
\def\numsecentry##1##2##3##4{%
\dopdfoutline{##1}{2}{##3}{##4}}%
\def\numsubsecentry##1##2##3##4{%
@@ -1683,7 +1733,8 @@ output) for that.)}
\let\appsecentry\numsecentry%
\let\appsubsecentry\numsubsecentry%
\let\appsubsubsecentry\numsubsubsecentry%
- \let\unnchapentry\numchapentry%
+ \def\unnchapentry##1##2##3##4{%
+ \dopdfoutline{##1}{1}{##3}{##4}}%
\let\unnsecentry\numsecentry%
\let\unnsubsecentry\numsubsecentry%
\let\unnsubsubsecentry\numsubsubsecentry%
@@ -2496,7 +2547,7 @@ end
\def\it{\fam=\itfam \setfontstyle{it}}
\def\sl{\fam=\slfam \setfontstyle{sl}}
\def\bf{\fam=\bffam \setfontstyle{bf}}\def\bfstylename{bf}
-\def\tt{\fam=\ttfam \setfontstyle{tt}}
+\def\tt{\fam=\ttfam \setfontstyle{tt}}\def\ttstylename{tt}
% Texinfo sort of supports the sans serif font style, which plain TeX does not.
% So we set up a \sf.
@@ -3107,9 +3158,9 @@ end
% preferable one choice is over the other.
\def\urefallowbreak{%
\allowbreak
- \hskip 0pt plus 4 em\relax
- \penalty100
- \hskip 0pt plus -4 em\relax
+ \hskip 0pt plus 2 em\relax
+ \penalty300
+ \hskip 0pt plus -2 em\relax
}
\urefbreakstyle after
@@ -3509,7 +3560,7 @@ end
% @pounds{} is a sterling sign, which Knuth put in the CM italic font.
%
-\def\pounds{{\it\$}}
+\def\pounds{\ifmonospace{\ecfont\char"BF}\else{\it\$}\fi}
% @euro{} comes from a separate font, depending on the current style.
% We use the free feym* fonts from the eurosym package by Henrik
@@ -3658,11 +3709,19 @@ end
\fi
% Quotes.
-\chardef\quotedblleft="5C
-\chardef\quotedblright=`\"
\chardef\quoteleft=`\`
\chardef\quoteright=`\'
+% only change font for tt for correct kerning and to avoid using
+% \ecfont unless necessary.
+\def\quotedblleft{%
+ \ifmonospace{\ecfont\char"10}\else{\char"5C}\fi
+}
+
+\def\quotedblright{%
+ \ifmonospace{\ecfont\char"11}\else{\char`\"}\fi
+}
+
\message{page headings,}
@@ -3784,12 +3843,19 @@ end
\newtoks\evenheadline % headline on even pages
\newtoks\oddheadline % headline on odd pages
+\newtoks\evenchapheadline% headline on even pages with a new chapter
+\newtoks\oddchapheadline % headline on odd pages with a new chapter
\newtoks\evenfootline % footline on even pages
\newtoks\oddfootline % footline on odd pages
% Now make \makeheadline and \makefootline in Plain TeX use those variables
-\headline={{\textfonts\rm \ifodd\pageno \the\oddheadline
- \else \the\evenheadline \fi}}
+\headline={{\textfonts\rm
+ \ifchapterpage
+ \ifodd\pageno\the\oddchapheadline\else\the\evenchapheadline\fi
+ \else
+ \ifodd\pageno\the\oddheadline\else\the\evenheadline\fi
+ \fi}}
+
\footline={{\textfonts\rm \ifodd\pageno \the\oddfootline
\else \the\evenfootline \fi}\HEADINGShook}
\let\HEADINGShook=\relax
@@ -3805,12 +3871,14 @@ end
\def\evenheading{\parsearg\evenheadingxxx}
\def\evenheadingxxx #1{\evenheadingyyy #1\|\|\|\|\finish}
\def\evenheadingyyy #1\|#2\|#3\|#4\finish{%
-\global\evenheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+ \global\evenheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}
+ \global\evenchapheadline=\evenheadline}
\def\oddheading{\parsearg\oddheadingxxx}
\def\oddheadingxxx #1{\oddheadingyyy #1\|\|\|\|\finish}
\def\oddheadingyyy #1\|#2\|#3\|#4\finish{%
-\global\oddheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+ \global\oddheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}%
+ \global\oddchapheadline=\oddheadline}
\parseargdef\everyheading{\oddheadingxxx{#1}\evenheadingxxx{#1}}%
@@ -3877,37 +3945,34 @@ end
\parseargdef\headings{\csname HEADINGS#1\endcsname}
\def\headingsoff{% non-global headings elimination
- \evenheadline={\hfil}\evenfootline={\hfil}%
- \oddheadline={\hfil}\oddfootline={\hfil}%
+ \evenheadline={\hfil}\evenfootline={\hfil}\evenchapheadline={\hfil}%
+ \oddheadline={\hfil}\oddfootline={\hfil}\oddchapheadline={\hfil}%
}
\def\HEADINGSoff{{\globaldefs=1 \headingsoff}} % global setting
\HEADINGSoff % it's the default
% When we turn headings on, set the page number to 1.
+\def\pageone{
+ \global\pageno=1
+ \global\arabiccount = \pagecount
+}
+
% For double-sided printing, put current file name in lower left corner,
% chapter name on inside top of right hand pages, document
% title on inside top of left hand pages, and page numbers on outside top
% edge of all pages.
\def\HEADINGSdouble{%
-\global\pageno=1
-\global\evenfootline={\hfil}
-\global\oddfootline={\hfil}
-\global\evenheadline={\line{\folio\hfil\thistitle}}
-\global\oddheadline={\line{\thischapterheading\hfil\folio}}
-\global\let\contentsalignmacro = \chapoddpage
+\pageone
+\HEADINGSdoublex
}
\let\contentsalignmacro = \chappager
% For single-sided printing, chapter title goes across top left of page,
% page number on top right.
\def\HEADINGSsingle{%
-\global\pageno=1
-\global\evenfootline={\hfil}
-\global\oddfootline={\hfil}
-\global\evenheadline={\line{\thischapterheading\hfil\folio}}
-\global\oddheadline={\line{\thischapterheading\hfil\folio}}
-\global\let\contentsalignmacro = \chappager
+\pageone
+\HEADINGSsinglex
}
\def\HEADINGSon{\HEADINGSdouble}
@@ -3917,7 +3982,9 @@ end
\global\evenfootline={\hfil}
\global\oddfootline={\hfil}
\global\evenheadline={\line{\folio\hfil\thistitle}}
-\global\oddheadline={\line{\thischapterheading\hfil\folio}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+\global\evenchapheadline={\line{\folio\hfil}}
+\global\oddchapheadline={\line{\hfil\folio}}
\global\let\contentsalignmacro = \chapoddpage
}
@@ -3925,8 +3992,22 @@ end
\def\HEADINGSsinglex{%
\global\evenfootline={\hfil}
\global\oddfootline={\hfil}
-\global\evenheadline={\line{\thischapterheading\hfil\folio}}
-\global\oddheadline={\line{\thischapterheading\hfil\folio}}
+\global\evenheadline={\line{\thischapter\hfil\folio}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+\global\evenchapheadline={\line{\hfil\folio}}
+\global\oddchapheadline={\line{\hfil\folio}}
+\global\let\contentsalignmacro = \chappager
+}
+
+% for @setchapternewpage off
+\def\HEADINGSsinglechapoff{%
+\pageone
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\thischapter\hfil\folio}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+\global\evenchapheadline=\evenheadline
+\global\oddchapheadline=\oddheadline
\global\let\contentsalignmacro = \chappager
}
@@ -4841,7 +4922,7 @@ end
% like the previous two, but they put @code around the argument.
\def\docodeindex#1{\edef\indexname{#1}\parsearg\docodeindexxxx}
-\def\docodeindexxxx #1{\doind{\indexname}{\code{#1}}}
+\def\docodeindexxxx #1{\docind{\indexname}{#1}}
% Used for the aux, toc and index files to prevent expansion of Texinfo
@@ -5117,64 +5198,66 @@ end
\let\lbracechar\{%
\let\rbracechar\}%
%
+ %
+ \let\do\indexnofontsdef
+ %
% Non-English letters.
- \def\AA{AA}%
- \def\AE{AE}%
- \def\DH{DZZ}%
- \def\L{L}%
- \def\OE{OE}%
- \def\O{O}%
- \def\TH{TH}%
- \def\aa{aa}%
- \def\ae{ae}%
- \def\dh{dzz}%
- \def\exclamdown{!}%
- \def\l{l}%
- \def\oe{oe}%
- \def\ordf{a}%
- \def\ordm{o}%
- \def\o{o}%
- \def\questiondown{?}%
- \def\ss{ss}%
- \def\th{th}%
- %
- \def\LaTeX{LaTeX}%
- \def\TeX{TeX}%
- %
- % Assorted special characters. \defglyph gives the control sequence a
- % definition that removes the {} that follows its use.
- \defglyph\atchar{@}%
- \defglyph\arrow{->}%
- \defglyph\bullet{bullet}%
- \defglyph\comma{,}%
- \defglyph\copyright{copyright}%
- \defglyph\dots{...}%
- \defglyph\enddots{...}%
- \defglyph\equiv{==}%
- \defglyph\error{error}%
- \defglyph\euro{euro}%
- \defglyph\expansion{==>}%
- \defglyph\geq{>=}%
- \defglyph\guillemetleft{<<}%
- \defglyph\guillemetright{>>}%
- \defglyph\guilsinglleft{<}%
- \defglyph\guilsinglright{>}%
- \defglyph\leq{<=}%
- \defglyph\lbracechar{\{}%
- \defglyph\minus{-}%
- \defglyph\point{.}%
- \defglyph\pounds{pounds}%
- \defglyph\print{-|}%
- \defglyph\quotedblbase{"}%
- \defglyph\quotedblleft{"}%
- \defglyph\quotedblright{"}%
- \defglyph\quoteleft{`}%
- \defglyph\quoteright{'}%
- \defglyph\quotesinglbase{,}%
- \defglyph\rbracechar{\}}%
- \defglyph\registeredsymbol{R}%
- \defglyph\result{=>}%
- \defglyph\textdegree{o}%
+ \do\AA{AA}%
+ \do\AE{AE}%
+ \do\DH{DZZ}%
+ \do\L{L}%
+ \do\OE{OE}%
+ \do\O{O}%
+ \do\TH{TH}%
+ \do\aa{aa}%
+ \do\ae{ae}%
+ \do\dh{dzz}%
+ \do\exclamdown{!}%
+ \do\l{l}%
+ \do\oe{oe}%
+ \do\ordf{a}%
+ \do\ordm{o}%
+ \do\o{o}%
+ \do\questiondown{?}%
+ \do\ss{ss}%
+ \do\th{th}%
+ %
+ \do\LaTeX{LaTeX}%
+ \do\TeX{TeX}%
+ %
+ % Assorted special characters.
+ \do\atchar{@}%
+ \do\arrow{->}%
+ \do\bullet{bullet}%
+ \do\comma{,}%
+ \do\copyright{copyright}%
+ \do\dots{...}%
+ \do\enddots{...}%
+ \do\equiv{==}%
+ \do\error{error}%
+ \do\euro{euro}%
+ \do\expansion{==>}%
+ \do\geq{>=}%
+ \do\guillemetleft{<<}%
+ \do\guillemetright{>>}%
+ \do\guilsinglleft{<}%
+ \do\guilsinglright{>}%
+ \do\leq{<=}%
+ \do\lbracechar{\{}%
+ \do\minus{-}%
+ \do\point{.}%
+ \do\pounds{pounds}%
+ \do\print{-|}%
+ \do\quotedblbase{"}%
+ \do\quotedblleft{"}%
+ \do\quotedblright{"}%
+ \do\quoteleft{`}%
+ \do\quoteright{'}%
+ \do\quotesinglbase{,}%
+ \do\rbracechar{\}}%
+ \do\registeredsymbol{R}%
+ \do\result{=>}%
+ \do\textdegree{o}%
%
% We need to get rid of all macros, leaving only the arguments (if present).
% Of course this is not nearly correct, but it is the best we can do for now.
@@ -5189,7 +5272,10 @@ end
\macrolist
\let\value\indexnofontsvalue
}
-\def\defglyph#1#2{\def#1##1{#2}} % see above
+
+% Give the control sequence a definition that removes the {} that follows
+% its use, e.g. @AA{} -> AA
+\def\indexnofontsdef#1#2{\def#1##1{#2}}%
@@ -5208,6 +5294,20 @@ end
\fi
}
+% Same as \doind, but for code indices
+\def\docind#1#2{%
+ \iflinks
+ {%
+ %
+ \requireopenindexfile{#1}%
+ \edef\writeto{\csname#1indfile\endcsname}%
+ %
+ \def\indextext{#2}%
+ \safewhatsit\docindwrite
+ }%
+ \fi
+}
+
% Check if an index file has been opened, and if not, open it.
\def\requireopenindexfile#1{%
\ifnum\csname #1indfile\endcsname=0
@@ -5274,6 +5374,9 @@ end
% trim spaces.
\edef\trimmed{\segment}%
\edef\trimmed{\expandafter\eatspaces\expandafter{\trimmed}}%
+ \ifincodeindex
+ \edef\trimmed{\noexpand\code{\trimmed}}%
+ \fi
%
\xdef\bracedtext{\bracedtext{\trimmed}}%
%
@@ -5339,7 +5442,12 @@ end
% Write the entry in \indextext to the index file.
%
-\def\doindwrite{%
+
+\newif\ifincodeindex
+\def\doindwrite{\incodeindexfalse\doindwritex}
+\def\docindwrite{\incodeindextrue\doindwritex}
+
+\def\doindwritex{%
\maybemarginindex
%
\atdummies
@@ -5559,7 +5667,11 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\else
\begindoublecolumns
\catcode`\\=0\relax
- \catcode`\@=12\relax
+ %
+ % Make @ an escape character to give macros a chance to work. This
+ % should work because we (hopefully) don't otherwise use @ in index files.
+ %\catcode`\@=12\relax
+ \catcode`\@=0\relax
\input \jobname.\indexname s
\enddoublecolumns
\fi
@@ -6401,18 +6513,16 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\def\CHAPPAGoff{%
\global\let\contentsalignmacro = \chappager
\global\let\pchapsepmacro=\chapbreak
-\global\let\pagealignmacro=\chappager}
+\global\def\HEADINGSon{\HEADINGSsinglechapoff}}
\def\CHAPPAGon{%
\global\let\contentsalignmacro = \chappager
\global\let\pchapsepmacro=\chappager
-\global\let\pagealignmacro=\chappager
\global\def\HEADINGSon{\HEADINGSsingle}}
\def\CHAPPAGodd{%
\global\let\contentsalignmacro = \chapoddpage
\global\let\pchapsepmacro=\chapoddpage
-\global\let\pagealignmacro=\chapoddpage
\global\def\HEADINGSon{\HEADINGSdouble}}
\CHAPPAGon
@@ -6777,9 +6887,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
%
\def\startcontents#1{%
% If @setchapternewpage on, and @headings double, the contents should
- % start on an odd page, unlike chapters. Thus, we maintain
- % \contentsalignmacro in parallel with \pagealignmacro.
- % From: Torbjorn Granlund <tege@matematik.su.se>
+ % start on an odd page, unlike chapters.
\contentsalignmacro
\immediate\closeout\tocfile
%
@@ -6794,6 +6902,9 @@ might help (with 'rm \jobname.?? \jobname.??s')%
%
% Roman numerals for page numbers.
\ifnum \pageno>0 \global\pageno = \lastnegativepageno \fi
+ \def\thistitle{}% no title in double-sided headings
+ % Record where the Roman numerals started.
+ \ifnum\romancount=0 \global\romancount=\pagecount \fi
}
% redefined for the two-volume lispref. We always output on
@@ -6816,8 +6927,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\fi
\closein 1
\endgroup
- \lastnegativepageno = \pageno
- \global\pageno = \savepageno
+ \contentsendroman
}
% And just the chapters.
@@ -6852,10 +6962,20 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\vfill \eject
\contentsalignmacro % in case @setchapternewpage odd is in effect
\endgroup
+ \contentsendroman
+}
+\let\shortcontents = \summarycontents
+
+% Get ready to use Arabic numerals again
+\def\contentsendroman{%
\lastnegativepageno = \pageno
\global\pageno = \savepageno
+ %
+ % If \romancount > \arabiccount, the contents are at the end of the
+ % document. Otherwise, advance where the Arabic numerals start for
+ % the page numbers.
+ \ifnum\romancount>\arabiccount\else\global\arabiccount=\pagecount\fi
}
-\let\shortcontents = \summarycontents
% Typeset the label for a chapter or appendix for the short contents.
% The arg is, e.g., `A' for an appendix, or `3' for a chapter.
@@ -7444,13 +7564,9 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\newdimen\tabw \setbox0=\hbox{\tt\space} \tabw=8\wd0 % tab amount
%
% We typeset each line of the verbatim in an \hbox, so we can handle
-% tabs. The \global is in case the verbatim line starts with an accent,
-% or some other command that starts with a begin-group. Otherwise, the
-% entire \verbbox would disappear at the corresponding end-group, before
-% it is typeset. Meanwhile, we can't have nested verbatim commands
-% (can we?), so the \global won't be overwriting itself.
+% tabs.
\newbox\verbbox
-\def\starttabbox{\global\setbox\verbbox=\hbox\bgroup}
+\def\starttabbox{\setbox\verbbox=\hbox\bgroup}
%
\begingroup
\catcode`\^^I=\active
@@ -7461,7 +7577,8 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\divide\dimen\verbbox by\tabw
\multiply\dimen\verbbox by\tabw % compute previous multiple of \tabw
\advance\dimen\verbbox by\tabw % advance to next multiple of \tabw
- \wd\verbbox=\dimen\verbbox \box\verbbox \starttabbox
+ \wd\verbbox=\dimen\verbbox
+ \leavevmode\box\verbbox \starttabbox
}%
}
\endgroup
@@ -7471,9 +7588,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\let\nonarrowing = t%
\nonfillstart
\tt % easiest (and conventionally used) font for verbatim
- % The \leavevmode here is for blank lines. Otherwise, we would
- % never \starttabbox and the \egroup would end verbatim mode.
- \def\par{\leavevmode\egroup\box\verbbox\endgraf}%
+ \def\par{\egroup\leavevmode\box\verbbox\endgraf\starttabbox}%
\tabexpand
\setupmarkupstyle{verbatim}%
% Respect line breaks,
@@ -7481,7 +7596,6 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% make each space count.
% Must do in this order:
\obeylines \uncatcodespecials \sepspaces
- \everypar{\starttabbox}%
}
% Do the @verb magic: verbatim text is quoted by unique
@@ -7516,9 +7630,12 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% ignore everything up to the first ^^M, that's the newline at the end
% of the @verbatim input line itself. Otherwise we get an extra blank
% line in the output.
- \xdef\doverbatim#1^^M#2@end verbatim{#2\noexpand\end\gobble verbatim}%
+ \xdef\doverbatim#1^^M#2@end verbatim{%
+ \starttabbox#2\egroup\noexpand\end\gobble verbatim}%
% We really want {...\end verbatim} in the body of the macro, but
% without the active space; thus we have to use \xdef and \gobble.
+ % The \egroup ends the \verbbox started at the end of the last line in
+ % the block.
\endgroup
%
\envdef\verbatim{%
@@ -7540,7 +7657,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\wlog{texinfo.tex: doing @verbatiminclude of #1^^J}%
\edef\tmp{\noexpand\input #1 }
\expandafter
- }\tmp
+ }\expandafter\starttabbox\tmp\egroup
\afterenvbreak
}%
}
@@ -7690,7 +7807,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% If SUBTOPIC is present, precede it with a space, and call \doind.
% (At some time during the 20th century, this made a two-level entry in an
% index such as the operation index. Nobody seemed to notice the change in
-% behavior though.)
+% behaviour though.)
\def\dosubind#1#2#3{%
\def\thirdarg{#3}%
\ifx\thirdarg\empty
@@ -8955,17 +9072,11 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\else
% Reference within this manual.
%
- % _ (for example) has to be the character _ for the purposes of the
- % control sequence corresponding to the node, but it has to expand
- % into the usual \leavevmode...\vrule stuff for purposes of
- % printing. So we \turnoffactive for the \refx-snt, back on for the
- % printing, back off for the \refx-pg.
- {\turnoffactive
- % Only output a following space if the -snt ref is nonempty; for
- % @unnumbered and @anchor, it won't be.
- \setbox2 = \hbox{\ignorespaces \refx{#1-snt}{}}%
- \ifdim \wd2 > 0pt \refx{#1-snt}\space\fi
- }%
+ % Only output a following space if the -snt ref is nonempty; for
+ % @unnumbered and @anchor, it won't be.
+ \setbox2 = \hbox{\ignorespaces \refx{#1-snt}{}}%
+ \ifdim \wd2 > 0pt \refx{#1-snt}\space\fi
+ %
% output the `[mynode]' via the macro below so it can be overridden.
\xrefprintnodename\printedrefname
%
@@ -9055,7 +9166,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\requireauxfile
{%
\indexnofonts
- \otherbackslash
+ \turnoffactive
\def\value##1{##1}%
\expandafter\global\expandafter\let\expandafter\thisrefX
\csname XR#1\endcsname
@@ -10712,6 +10823,8 @@ directory should work if nowhere else does.}
\DeclareUnicodeCharacter{0233}{\=y}%
\DeclareUnicodeCharacter{0237}{\dotless{j}}%
%
+ \DeclareUnicodeCharacter{02BC}{'}%
+ %
\DeclareUnicodeCharacter{02DB}{\ogonek{ }}%
%
% Greek letters upper case
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 27390983343..1b5339b8d26 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -46,7 +46,7 @@ copy and modify this GNU manual.''
@node Top, Overview, (dir), (dir)
@top @value{tramp} @value{trampver} User Manual
-This file documents @value{tramp} @value{trampver}, a remote file
+This file documents @w{@value{tramp} @value{trampver}}, a remote file
editing package for Emacs.
@value{tramp} stands for ``Transparent Remote (file) Access, Multiple
@@ -59,7 +59,7 @@ local and the remote host, whereas @value{tramp} uses a combination of
@command{ssh}/@command{scp}.
You can find the latest version of this document on the web at
-@uref{https://www.gnu.org/software/tramp/}.
+@uref{@value{trampurl}}.
@ifhtml
The latest release of @value{tramp} is available for
@@ -141,6 +141,7 @@ Configuring @value{tramp} for use
* Remote shell setup:: Remote shell setup hints.
* Android shell setup:: Android shell setup hints.
* Auto-save and Backup:: Auto-save and Backup.
+* Keeping files encrypted:: Protect remote files by encryption.
* Windows setup hints:: Issues with Cygwin ssh.
Using @value{tramp}
@@ -238,7 +239,7 @@ included in the file name portion, @value{tramp} sends the login name
followed by a newline.
@item
-The remote host may then prompt for a password or pass phrase (for
+The remote host may then prompt for a password or passphrase (for
@command{rsh} or for @command{telnet}). @value{tramp} displays the
password prompt in the minibuffer. @value{tramp} then sends whatever
is entered to the remote host, followed by a newline.
@@ -312,7 +313,7 @@ behind the scenes when you open a file with @value{tramp}.
@cindex GNU ELPA
@vindex tramp-version
-@value{tramp} is included as part of Emacs (since Emacs 22.1).
+@value{tramp} is included as part of Emacs (since @w{Emacs 22.1}).
@value{tramp} is also freely packaged for download on the Internet at
@uref{https://ftp.gnu.org/gnu/tramp/}. The version number of
@@ -324,9 +325,9 @@ A @value{tramp} release, which is packaged with Emacs, could differ
slightly from the corresponding standalone release. This is because
it isn't always possible to synchronize release dates between Emacs
and @value{tramp}. Such version numbers have the Emacs version number
-as suffix, like ``2.4.3.27.1''. This means @value{tramp} 2.4.3 as
-integrated in Emacs 27.1. A complete list of @value{tramp} versions
-packaged with Emacs can be retrieved by
+as suffix, like ``2.4.3.27.1''. This means @w{@value{tramp} 2.4.3} as
+integrated in @w{Emacs 27.1}. A complete list of @value{tramp}
+versions packaged with Emacs can be retrieved by
@vindex customize-package-emacs-version-alist
@lisp
@@ -557,13 +558,16 @@ of the local file name is the share exported by the remote host,
@cindex method @option{davs}
@cindex @option{dav} method
@cindex @option{davs} method
+@cindex method @option{media}
+@cindex @option{media} method
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}},
@file{@trampfn{afp,user@@host,/path/to/file}} (accessing Apple's AFP
-file system), @file{@trampfn{dav,user@@host,/path/to/file}} and
-@file{@trampfn{davs,user@@host,/path/to/file}} (for WebDAV shares).
+file system), @file{@trampfn{dav,user@@host,/path/to/file}},
+@file{@trampfn{davs,user@@host,/path/to/file}} (for WebDAV shares) and
+@file{@trampfn{media,device,/path/to/file}} (for media devices).
@anchor{Quick Start Guide: GNOME Online Accounts based methods}
@@ -664,6 +668,7 @@ might be used in your init file:
* Remote shell setup:: Remote shell setup hints.
* Android shell setup:: Android shell setup hints.
* Auto-save and Backup:: Auto-save and Backup.
+* Keeping files encrypted:: Protect remote files by encryption.
* Windows setup hints:: Issues with Cygwin ssh.
@end menu
@@ -1126,7 +1131,8 @@ Emacs.
@value{tramp} does not require a host name part of the remote file
name when a single Android device is connected to @command{adb}.
@value{tramp} instead uses @file{@trampfn{adb,,}} as the default name.
-@command{adb devices} shows available host names.
+@command{adb devices}, run in a shell outside Emacs, shows available
+host names.
@option{adb} method normally does not need user name to authenticate
on the Android device because it runs under the @command{adbd}
@@ -1179,9 +1185,6 @@ for accessing the system storage, you shall prefer this.
@ref{GVFS-based methods} for example, methods @option{gdrive} and
@option{nextcloud}.
-@strong{Note}: The @option{rclone} method is experimental, don't use
-it in production systems!
-
@end table
@@ -1227,6 +1230,7 @@ supported by these methods. See method @option{nextcloud} for
handling them.
@item @option{gdrive}
+@cindex @acronym{GNOME} Online Accounts
@cindex method @option{gdrive}
@cindex @option{gdrive} method
@cindex google drive
@@ -1242,8 +1246,26 @@ Since Google Drive uses cryptic blob file names internally,
could produce unexpected behavior in case two files in the same
directory have the same @code{display-name}, such a situation must be avoided.
+@item @option{media}
+@cindex method @option{media}
+@cindex @option{media} method
+@cindex media
+
+Media devices, like cell phones, tablets, cameras, can be accessed via
+the @option{media} method. Just the device name is needed in order to
+specify the host in the file name. However, the device must already
+be connected via USB, before accessing it. Possible device names are
+visible via host name completion, @ref{File name completion}.
+
+Depending on the device type, the access could be read-only. Some
+devices are accessible under different names in parallel, offering
+different parts of their file system.
+
+@value{tramp} does not require a host name as part of the remote file
+name when a single media device is connected. @value{tramp} instead
+uses @file{@trampfn{media,,}} as the default name.
+
@item @option{nextcloud}
-@cindex @acronym{GNOME} Online Accounts
@cindex method @option{nextcloud}
@cindex @option{nextcloud} method
@cindex nextcloud
@@ -1267,11 +1289,11 @@ that for security reasons refuse @command{ssh} connections.
@defopt tramp-gvfs-methods
This user option is a list of external methods for @acronym{GVFS}@.
By default, this list includes @option{afp}, @option{dav},
-@option{davs}, @option{gdrive}, @option{nextcloud} and @option{sftp}.
-Other methods to include are @option{ftp}, @option{http},
-@option{https} and @option{smb}. These methods are not intended to be
-used directly as @acronym{GVFS}-based method. Instead, they are added
-here for the benefit of @ref{Archive file names}.
+@option{davs}, @option{gdrive}, @option{media}, @option{nextcloud} and
+@option{sftp}. Other methods to include are @option{ftp},
+@option{http}, @option{https} and @option{smb}. These methods are not
+intended to be used directly as @acronym{GVFS}-based method. Instead,
+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
@@ -1600,7 +1622,7 @@ support this command.
@subsection Tunneling with ssh
-With ssh, you could use the @code{ProxyCommand} entry in
+With @command{ssh}, you could use the @option{ProxyCommand} entry in
@file{~/.ssh/config}:
@example
@@ -1642,7 +1664,7 @@ suitable settings. Refer to the Lisp documentation of that variable,
accessible with @kbd{C-h v tramp-methods @key{RET}}.
In the ELPA archives, there are several examples of such extensions.
-They can be installed with Emacs' Package Manager. This includes
+They can be installed with Emacs's Package Manager. This includes
@table @samp
@c @item anything-tramp
@@ -1708,6 +1730,7 @@ Convenience method to access vagrant boxes. It is often used in
multi-hop file names like
@file{@value{prefix}vagrant@value{postfixhop}box|sudo@value{postfixhop}box@value{postfix}/path/to/file},
where @samp{box} is the name of the vagrant box.
+
@end table
@@ -1779,8 +1802,8 @@ in such files, it can return host names only.
@item @code{tramp-parse-sconfig}
@findex tramp-parse-sconfig
-This function returns the host nicknames defined by @code{Host} entries
-in @file{~/.ssh/config} style files.
+This function returns the host nicknames defined by @option{Host}
+entries in @file{~/.ssh/config} style files.
@item @code{tramp-parse-shostkeys}
@findex tramp-parse-shostkeys
@@ -2030,6 +2053,13 @@ The temporary directory on the remote host. If not specified, the
default value is @t{"/data/local/tmp"} for the @option{adb} method,
@t{"/C$/Temp"} for the @option{smb} method, and @t{"/tmp"} otherwise.
+@item @t{"direct-async-process"}
+
+When this property is non-@code{nil}, an alternative, more performant
+implementation of @code{make-process} and
+@code{start-file-process} is applied. @ref{Improving performance of
+asynchronous remote processes} for a discussion of constraints.
+
@item @t{"posix"}
Connections using the @option{smb} method check, whether the remote
@@ -2075,7 +2105,7 @@ To improve performance and accuracy of remote file access,
@file{/usr/bin}, which are reasonable for most hosts. To accommodate
differences in hosts and paths, for example, @file{/bin:/usr/bin} on
Debian GNU/Linux or
-@file{/usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin} on
+@file{/usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/developerstudio12.6/bin} on
Solaris, @value{tramp} queries the remote host with @command{getconf
PATH} and updates the symbol @code{tramp-default-remote-path}.
@@ -2102,8 +2132,8 @@ preserves the path value, which can be used to update
shell supports the login argument @samp{-l}.
@end defopt
-Starting with Emacs 26, @code{tramp-remote-path} can be set per host
-via connection-local
+Starting with @w{Emacs 26}, @code{tramp-remote-path} can be set per
+host via connection-local
@ifinfo
variables, @xref{Connection Variables, , , emacs}.
@end ifinfo
@@ -2250,6 +2280,12 @@ example below:
@end group
@end lisp
+@vindex password-word-equivalents
+This user option is, by default, initialised from
+@code{password-word-equivalents} when @value{tramp} is loaded, and it
+is usually more convenient to add new passphrases to that user option
+instead of altering this user option.
+
Similar localization may be necessary for handling wrong password
prompts, for which @value{tramp} uses @code{tramp-wrong-passwd-regexp}.
@@ -2435,10 +2471,9 @@ overwrite as follows:
@lisp
@group
-(add-to-list
- 'tramp-connection-properties
- `(,(regexp-quote "192.168.0.1")
- "remote-copy-args" (("-l") ("%r"))))
+(add-to-list 'tramp-connection-properties
+ `(,(regexp-quote "192.168.0.1")
+ "remote-copy-args" (("-l") ("%r"))))
@end group
@end lisp
@@ -2457,7 +2492,7 @@ where @samp{192.168.0.1} is the remote host IP address
Android devices provide a restricted shell access through an USB
connection. The local host must have the @command{adb} program
installed. Usually, it is sufficient to open the file
-@file{@trampfn{adb,,/}}. Then you can navigate in the filesystem via
+@file{@trampfn{adb,,/}}. Then you can navigate in the file system via
@code{dired}.
Alternatively, applications such as @code{Termux} or @code{SSHDroid}
@@ -2632,6 +2667,117 @@ 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.
+
+@node Keeping files encrypted
+@section Protect remote files by encryption
+@cindex Encrypt remote directories
+
+@strong{Note}: File encryption in @value{tramp} is experimental, don't
+use it in production systems!
+
+Sometimes, it is desirable to protect files located on remote
+directories, like cloud storages. In order to do this, you might
+instruct @value{tramp} to encrypt all files copied to a given remote
+directory, and to decrypt such files when accessing. This includes
+both file contents and file names.
+
+@value{tramp} does this transparently. Although both files and file
+names are encrypted on the remote side, they are accessible inside
+Emacs as they wouldn't be transformed as such.
+
+@cindex @command{encfs}
+@cindex @command{encfsctl}
+Internally, @value{tramp} uses the @command{encfs} package.
+Therefore, this feature is available only if this package is installed
+on the local host. @value{tramp} does not keep and @samp{encfs
+mountpoint} permanently. Instead, it encrypts / decrypts files and
+file names on the fly, using @command{encfsctl}.
+
+@deffn Command tramp-crypt-add-directory name
+This command marks the existing remote directory @var{name} for
+encryption. Files in that directory and all subdirectories will be
+encrypted before copying to, and decrypted after copying from that
+directory. File and directory names will be also encrypted.
+@end deffn
+
+@defopt tramp-crypt-encfs-option
+If a remote directory is marked for encryption, it is initialized via
+@command{encfs} the very first time a file in this directory is
+accessed. This user option controls, which default @command{encfs}
+configuration option will be selected, it can be @t{"--standard"}
+or @t{"--paranoia"}. See the @samp{encfs(1)} man page for details.
+
+However, @value{tramp} must adapt these configuration sets. The
+@code{chainedNameIV} configuration option must be disabled; otherwise
+@value{tramp} couldn't handle file name encryption transparently.
+@end defopt
+
+A password protected @option{encfs} configuration file is created the
+very first time you access an encrypted remote directory. It is kept
+in your @code{user-emacs-directory} with the url-encoded directory
+name as part of the basename, and @file{encfs6.xml} as suffix. If
+you, for example, mark the remote directory
+@file{@trampfn{nextcloud,user@@host,/path/to/dir}} for encryption, the
+configuration file is saved as
+@file{tramp-%2Fnextcloud%3Auser%40host%3A%2Fpath%2Fto%2Fdir%2F.encfs6.xml}
+in @code{user-emacs-directory}. Do not loose this file and the
+corresponding password; otherwise there is no way to decrypt your
+encrypted files.
+
+@defopt tramp-crypt-save-encfs-config-remote
+If this user option is non-@code{nil} (the default), the @option{encfs}
+configuration file @file{.encfs6.xml} is also kept in the encrypted
+remote directory. It depends on you, whether you regard the password
+protection of this file as sufficient. The advantage would be, that
+such a remote directory could be accessed by different Emacs sessions,
+different users, without presharing the configuration file between the
+users.
+@end defopt
+
+The command @command{encfsctl}, the workhorse for encryption /
+decryption, needs the configuration file password every call.
+Therefore, it is recommend to cache this password in Emacs. This can
+be done using @code{auth-sources}, @ref{Using an authentication file}.
+An entry needs the url-encoded directory name as machine, your local
+user name as user, and the password. The port is optional, if given
+it must be the string @t{"crypt"}. The example above would require
+the following entry in the authentication file (@t{"yourname"} is the
+result of @code{(user-login-name)}):
+
+@example
+machine %2Fnextcloud%3Auser%40host%3A%2Fpath%2Fto%2Fdir%2F \
+ login yourname port crypt password geheim
+@end example
+
+If you use a remote file name with a quoted localname part, this
+localname and the corresponding file will not be encrypted /
+decrypted. If you have an encrypted remote directory
+@file{@trampfn{nextcloud,user@@host,/path/to/dir}}, the command
+
+@example
+@kbd{C-x d @trampfn{nextcloud,user@@host,/path/to/dir}}
+@end example
+
+@noindent
+will show the directory listing with the plain file names, and the
+command
+
+@example
+@kbd{C-x d @trampfn{nextcloud,user@@host,/:/path/to/dir}}
+@end example
+
+@noindent
+will show the directory listing with the encrypted file names, and
+visiting a file will show its encrypted contents. However, it is
+highly discouraged to mix encrypted and not encrypted files in the
+same directory.
+
+@deffn Command tramp-crypt-add-directory name
+If a remote directory shall not include encrypted files anymore, it
+must be indicated by this command.
+@end deffn
+
+
@node Windows setup hints
@section Issues with Cygwin ssh
@cindex cygwin, issues
@@ -2665,10 +2811,10 @@ Wiki} it is explained how to use the helper program
@cindex @option{scpx} method with cygwin
When using the @option{scpx} access method, Emacs may call
-@command{scp} with MS Windows file naming, such as @code{c:/foo}. But
+@command{scp} with MS Windows file naming, such as @file{c:/foo}. But
the version of @command{scp} that is installed with Cygwin does not
know about MS Windows file naming, which causes it to incorrectly look
-for a host named @code{c}.
+for a host named @samp{c}.
A workaround: write a wrapper script for @option{scp} to convert
Windows file names to Cygwin file names.
@@ -2944,10 +3090,10 @@ Example:
@end example
During file name completion, remote directory contents are re-read
-regularly to account for any changes in the filesystem that may affect
-the completion candidates. Such re-reads can account for changes to
-the file system by applications outside Emacs (@pxref{Connection
-caching}).
+regularly to account for any changes in the file system that may
+affect the completion candidates. Such re-reads can account for
+changes to the file system by applications outside Emacs
+(@pxref{Connection caching}).
@defopt tramp-completion-reread-directory-timeout
The timeout is number of seconds since last remote command for
@@ -3040,7 +3186,7 @@ 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
-@code{process-file-return-signal-string} is non-nil,
+@code{process-file-return-signal-string} is non-@code{nil},
@code{process-file} regards all exit codes greater than 128 as an
indication that the process has been interrupted, and returns a
respective string.
@@ -3171,8 +3317,8 @@ whatever reason, then replace @code{(getenv "DISPLAY")} with a
hard-coded, fixed name. Note that using @code{:0} for X11 display name
here will not work as expected.
-An alternate approach is specify @code{ForwardX11 yes} or
-@code{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local
+An alternate approach is specify @option{ForwardX11 yes} or
+@option{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local
host.
@@ -3187,8 +3333,8 @@ ensures the correct name of the remote shell program.
When @code{explicit-shell-file-name} is equal to @code{nil}, calling
@code{shell} interactively will prompt for a shell name.
-Starting with Emacs 26, you could use connection-local variables for
-setting different values of @code{explicit-shell-file-name} for
+Starting with @w{Emacs 26}, you could use connection-local variables
+for setting different values of @code{explicit-shell-file-name} for
different remote hosts.
@ifinfo
@xref{Connection Variables, , , emacs}.
@@ -3238,30 +3384,30 @@ host. Example:
@end group
@end example
-@command{tail} command outputs continuously to the local buffer,
-@file{*Async Shell Command*}
+@command{tail} command outputs continuously to the local buffer whose
+name is the value of the variable @code{shell-command-buffer-name-async}.
@kbd{M-x auto-revert-tail-mode @key{RET}} runs similarly showing
continuous output.
@vindex shell-file-name
@vindex shell-command-switch
-@code{shell-command} uses the variables @code{shell-file-name} and
-@code{shell-command-switch} in order to determine which shell to run.
-For remote hosts, their default values are @file{/bin/sh} and
-@option{-c}, respectively (except for the @option{adb} method, which
-uses @file{/system/bin/sh}). Like the variables in the previous
-section, these variables can be changed via connection-local
-variables.
+@code{shell-command} uses the user option @code{shell-file-name} and
+the variable @code{shell-command-switch} in order to determine which
+shell to run. For remote hosts, their default values are
+@file{/bin/sh} and @option{-c}, respectively (except for the
+@option{adb} method, which uses @file{/system/bin/sh}). Like the
+variables in the previous section, these variables can be changed via
+connection-local variables.
@vindex async-shell-command-width
@vindex COLUMNS@r{, environment variable}
-If Emacs supports the variable @code{async-shell-command-width} (since
-Emacs 27), @value{tramp} cares about its value for asynchronous shell
-commands. It specifies the number of display columns for command
-output. For synchronous shell commands, a similar effect can be
-achieved by adding the environment variable @env{COLUMNS} to
-@code{tramp-remote-process-environment}.
+If Emacs supports the user option @code{async-shell-command-width}
+(since @w{Emacs 27}), @value{tramp} cares about its value for
+asynchronous shell commands. It specifies the number of display
+columns for command output. For synchronous shell commands, a similar
+effect can be achieved by adding the environment variable
+@env{COLUMNS} to @code{tramp-remote-process-environment}.
@subsection Running @code{eshell} on a remote host
@@ -3393,6 +3539,77 @@ To open @command{powershell} as a remote shell, use this:
@end lisp
+@anchor{Improving performance of asynchronous remote processes}
+@subsection Improving performance of asynchronous remote processes
+@cindex Asynchronous remote processes
+@findex make-process
+@findex start-file-process
+
+@value{tramp}'s implementation of @code{make-process} and
+@code{start-file-process} requires a serious overhead for
+initialization, every process invocation. This is needed for handling
+interactive dialogues when connecting the remote host (like providing
+a password), and initial environment setup.
+
+Sometimes, this is not needed. Instead of starting a remote shell and
+running the command afterwards, it is sufficient to run the command
+directly. @value{tramp} supports this by an alternative
+implementation of @code{make-process} and @code{start-file-process}.
+This is triggered by the connection property
+@t{"direct-async-process"}, @xref{Predefined connection information},
+which must be set to a non-@code{nil} value. Example:
+
+@lisp
+@group
+(add-to-list 'tramp-connection-properties
+ (list (regexp-quote "@trampfn{ssh,user@@host,}")
+ "direct-async-process" t))
+@end group
+@end lisp
+
+Using direct asynchronous processes in @value{tramp} is not possible,
+if the remote host is connected via multiple hops
+(@pxref{Multi-hops}). In this case, @value{tramp} falls back to its
+classical implementation.
+
+Furthermore, this approach has the following limitations:
+
+@itemize
+@item
+It works only for connection methods defined in @file{tramp-sh.el} and
+@file{tramp-adb.el}.
+
+@item
+It does not support interactive user authentication. With
+@option{ssh}-based methods, this can be avoided by using a password
+agent like @command{ssh-agent}, using public key authentication, or
+using @option{ControlMaster} options.
+
+@item
+It cannot be killed via @code{interrupt-process}.
+
+@item
+It does not report the remote terminal name via @code{process-tty-name}.
+
+@item
+It does not set process property @code{remote-pid}.
+
+@item
+It does not use @code{tramp-remote-path} and
+@code{tramp-remote-process-environment}.
+
+@item
+It does not set environment variable @env{INSIDE_EMACS}.
+@end itemize
+
+In order to gain even more performance, it is recommended to bind
+@code{tramp-verbose} to 0 when running @code{make-process} or
+@code{start-file-process}. Furthermore, you might set
+@code{tramp-use-ssh-controlmaster-options} to @code{nil} in order to
+bypass @value{tramp}'s handling of the @option{ControlMaster} options,
+and use your own settings in @file{~/.ssh/config}.
+
+
@node Cleanup remote connections
@section Cleanup remote connections
@cindex cleanup
@@ -3464,8 +3681,8 @@ On all buffers, which have a @code{buffer-file-name} matching
prompted for modification in the minibuffer. The buffers are marked
modified, and must be saved explicitly.
-If user option @code{tramp-confirm-rename-file-names} is nil, changing
-the file name happens without confirmation. This requires a
+If user option @code{tramp-confirm-rename-file-names} is @code{nil},
+changing the file name happens without confirmation. This requires a
matching entry in @code{tramp-default-rename-alist}.
Remote buffers related to the remote connection identified by
@@ -3504,8 +3721,8 @@ Tramp infers by default, such as @samp{@trampfn{method,user@@host,}}).
name of @code{source} when calling @code{tramp-rename-files}.
@code{source} could also be a Lisp form, which will be evaluated. The
-result must be a string or nil, which is interpreted as a regular
-expression which always matches.
+result must be a string or @code{nil}, which is interpreted as a
+regular expression which always matches.
Example entries:
@@ -3879,8 +4096,8 @@ Where is the latest @value{tramp}?
@item
Which systems does it work on?
-The package works successfully on Emacs 24, Emacs 25, Emacs 26, Emacs
-27, and Emacs 28.
+The package works successfully on @w{Emacs 25}, @w{Emacs 26}, @w{Emacs
+27}, and @w{Emacs 28}.
While Unix and Unix-like systems are the primary remote targets,
@value{tramp} has equal success connecting to other platforms, such as
@@ -4085,17 +4302,17 @@ Host *
@item
-@value{tramp} does not use default @command{ssh} @code{ControlPath}
+@value{tramp} does not use default @command{ssh} @option{ControlPath}
-@value{tramp} overwrites @code{ControlPath} settings when initiating
+@value{tramp} overwrites @option{ControlPath} settings when initiating
@command{ssh} sessions. @value{tramp} does this to fend off a stall
if a master session opened outside the Emacs session is no longer
open. That is why @value{tramp} prompts for the password again even
if there is an @command{ssh} already open.
@vindex tramp-ssh-controlmaster-options
-Some @command{ssh} versions support a @code{ControlPersist} option,
-which allows you to set the @code{ControlPath} provided the variable
+Some @command{ssh} versions support a @option{ControlPersist} option,
+which allows you to set the @option{ControlPath} provided the variable
@code{tramp-ssh-controlmaster-options} is customized as follows:
@lisp
@@ -4120,12 +4337,16 @@ this @code{nil} setting:
(customize-set-variable 'tramp-use-ssh-controlmaster-options nil)
@end lisp
+This shall also be set to @code{nil} if you use the
+@option{ProxyCommand} or @option{ProxyJump} options in your
+@command{ssh} configuration.
+
@item
On multi-hop connections, @value{tramp} does not use @command{ssh}
-@code{ControlMaster}
+@option{ControlMaster}
-In order to use the @code{ControlMaster} option, @value{tramp} must
+In order to use the @option{ControlMaster} option, @value{tramp} must
check whether the @command{ssh} client supports this option. This is
only possible on the local host, for the first hop. @value{tramp}
does not use this option on proxy hosts.
@@ -4142,13 +4363,13 @@ Host *
@end group
@end example
-Check @command{man ssh_config} whether these options are supported on
-your proxy host.
+Check the @samp{ssh_config(5)} man page whether these options are
+supported on your proxy host.
@item
@value{tramp} does not connect to Samba or MS Windows hosts running
-SMB1 connection protocol.
+SMB1 connection protocol
@vindex tramp-smb-options
Recent versions of @command{smbclient} do not support old connection
@@ -4234,7 +4455,7 @@ Host indication in the mode line?
@cindex @value{tramp} theme
@vindex tramp-theme-face-remapping-alist
-Install @file{tramp-theme} from GNU ELPA via Emacs' Package Manager.
+Install @file{tramp-theme} from GNU ELPA via Emacs's Package Manager.
Enable it via @kbd{M-x load-theme @key{RET} tramp @key{RET}}. Further
customization is explained in user option
@code{tramp-theme-face-remapping-alist}.
@@ -4375,7 +4596,7 @@ completion can further reduce key strokes: @kbd{C-x C-f
@value{prefix}ssh@value{postfixhop}x @key{TAB}}.
@item
-Use environment variables to expand long strings
+Use environment variables to expand long strings:
For long file names, set up environment variables that are expanded in
the minibuffer. Environment variables are set either outside Emacs or
@@ -4421,9 +4642,8 @@ Abbreviation list expansion can be used to reduce typing long file names:
@lisp
@group
-(add-to-list
- 'directory-abbrev-alist
- '("^/xy" . "@trampfn{ssh,news@@news.my.domain,/opt/news/etc/}"))
+(add-to-list 'directory-abbrev-alist
+ '("^/xy" . "@trampfn{ssh,news@@news.my.domain,/opt/news/etc/}"))
@end group
@end lisp
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index cc3c768fe6e..dbebbc36812 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -8,9 +8,10 @@
@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.4.5-pre
+@set trampver 2.5.0-pre
+@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
-@set emacsver 24.4
+@set emacsver 25.1
@c Other flags from configuration.
@set instprefix /usr/local
diff --git a/doc/misc/url.texi b/doc/misc/url.texi
index 8d9b1024070..0304ff4b9f1 100644
--- a/doc/misc/url.texi
+++ b/doc/misc/url.texi
@@ -1312,8 +1312,6 @@ repeated visits do not require repeated domain lookups.
@end defopt
@defopt url-max-password-attempts
@end defopt
-@defopt url-temporary-directory
-@end defopt
@defopt url-show-status
@end defopt
@defopt url-confirmation-func
diff --git a/doc/misc/viper.texi b/doc/misc/viper.texi
index 9ce809e7d4d..661eb7c947a 100644
--- a/doc/misc/viper.texi
+++ b/doc/misc/viper.texi
@@ -1752,10 +1752,10 @@ state. If @code{nil}, the cursor stays where it was before the switch.
@item viper-always t
@code{t} means: leave it to Viper to decide when a buffer must be brought
up in Vi state,
-Insert state, or Emacs state. This heuristics works well in virtually all
-cases. @code{nil} means you either has to invoke @code{viper-mode} manually
+Insert state, or Emacs state. This heuristic works well in virtually all
+cases. @code{nil} means you either have to invoke @code{viper-mode} manually
for each buffer (or you can add @code{viper-mode} to the appropriate major mode
-hooks using @code{viper-load-hook}).
+hooks using @code{with-eval-after-load}).
This option must be set in your Viper customization file.
@item viper-custom-file-name "~/.emacs.d/viper"
@@ -1903,9 +1903,6 @@ List of (parameterless) functions called just after entering Replace state
@item viper-emacs-state-hook nil
List of (parameterless) functions called just after switching from Vi state
to Emacs state.
-@item viper-load-hook nil
-List of (parameterless) functions called just after loading Viper. This is
-the last chance to do customization before Viper is up and running.
@end table
@noindent
You can reset some of these constants in Viper with the Ex command @kbd{:set}
diff --git a/etc/AUTHORS b/etc/AUTHORS
index c2b5d9ddd2b..3e91efb570e 100644
--- a/etc/AUTHORS
+++ b/etc/AUTHORS
@@ -127,84 +127,18 @@ Albert L. Ting: changed gnus-group.el mail-hist.el
Aleksei Gusev: changed progmodes/compile.el
-Alexander Becher: changed vc-annotate.el
+Alexandru Harsanyi: changed soap-client.el soap-inspect.el emacs3.py
+ vc-hooks.el vc.el xml.el
-Alexander Gramiak: changed w32term.c xterm.c nsterm.m dispextern.h
- xdisp.c frame.c image.c nsgui.h w32gui.h xfns.c frame.el termhooks.h
- w32fns.c w32term.h faces.el nsterm.h xfaces.c xterm.h frame.h xfont.c
- configure.ac and 65 other files
-
-Alexander Haeckel: changed getset.el
-
-Alexander Klimov: changed files.el calc-graph.el files.texi man.el rx.el
- sendmail.el
-
-Alexander Kreuzer: changed nnrss.el
-
-Alexander Kuleshov: changed dns-mode.el files.texi image-mode.el
- keyboard.c ld-script.el xdisp.c
-
-Alexander L. Belikoff: wrote erc.el
-
-Alexander Pohoyda: co-wrote mail/rmailmm.el
-and changed rmailsum.el man.el rmail.el sendmail.el
-
-Alexander Shopov: changed code-pages.el
-
-Alexander Vorobiev: changed org-compat.el
-
-Alexander Zhuckov: changed ebrowse.c
-
-Alexandre Garreau: changed message.el
-
-Alexandre Julliard: wrote vc-git.el
-and changed vc.el ewoc.el
-
-Alexandre Oliva: wrote gnus-mlspl.el
-and changed unexelf.c format.el iris4d.h iris5d.h regex.c unexsgi.c
-
-Alexandre Veyrenc: changed fr-refcard.tex
-
-Alexandru Harsanyi: wrote soap-client.el soap-inspect.el
-and changed emacs3.py vc-hooks.el vc.el xml.el
-
-Alex Branham: changed checkdoc.el bibtex.el em-rebind.el esh-util.el
- indent.el js.el lpr.el message.el subr.el text.texi .dir-locals.el
- auth-source-pass.el bug-reference.el comint.el conf-mode-tests.el
- conf-mode.el dired-x.el dired.el ediff-diff.el ediff-help.el
- ediff-hook.el and 41 other files
-
-Alex Coventry: changed files.el
-
-Alex Dunn: changed subr-tests.el subr.el
-
-Alexei Khlebnikov: changed autorevert.el vc-git.el
-
-Alex Gramiak: changed prolog.el terminal.c
-
-Alex Kosorukoff: changed org-capture.el
-
-Alex Murray: changed erc-desktop-notifications.el network-stream.el
-
-Alex Ott: changed TUTORIAL.ru ede/files.el ru-refcard.tex base.el
- cedet-files.el cpp-root.el ede.el ede/generic.el idle.el ispell.el
- semantic/format.el
-
-Alex Reed: changed verilog-mode.el
-
-Alex Rezinsky: wrote which-func.el
-
-Alex Schroeder: wrote ansi-color.el cus-theme.el erc-compat.el
- erc-hecomplete.el erc-join.el erc-lang.el erc-ring.el master.el
- spam-stat.el sql.el
+Alex Gramiak: wrote ansi-color.el conf-mode-tests.el cus-theme.el
+ erc-compat.el erc-hecomplete.el erc-join.el erc-lang.el erc-ring.el
+ erc.el gnus-mlspl.el master.el soap-client.el soap-inspect.el
+ spam-stat.el sql.el vc-git.el which-func.el
and co-wrote longlines.el mail/rmailmm.el
-and changed erc.el erc-track.el erc-button.el erc-stamp.el erc-match.el
- erc-autoaway.el erc-nickserv.el rcirc.texi Makefile erc-autojoin.el
- erc-fill.el erc-pcomplete.el erc-complete.el erc-ibuffer.el
- erc-members.el rmail.el comint.el custom.el erc-bbdb.el erc-chess.el
- erc-ezbounce.el and 35 other files
-
-Alex Shinn: changed files.el
+and changed erc-track.el erc-button.el w32term.c xterm.c erc-stamp.el
+ nsterm.m xdisp.c dispextern.h frame.c image.c nsgui.h w32gui.h xfns.c
+ erc-match.el frame.el termhooks.h w32fns.c Makefile TUTORIAL.ru
+ erc-autoaway.el erc-nickserv.el and 215 other files
Alfred Correira: changed generic-x.el
@@ -254,7 +188,7 @@ and changed nsterm.m nsfns.m nsmenu.m nsterm.h font-lock.el nsimage.m
Anders Waldenborg: changed emacsclient.c
-Andrea Corallo: changed flymake.texi map-tests.el map.el
+Andrea Corallo: changed map-tests.el map.el
Andrea Rossetti: changed ruler-mode.el
@@ -366,7 +300,7 @@ Andrey Slusar: changed gnus-async.el gnus.el
Andrey Zhdanov: changed gud.el
Andrii Kolomoiets: changed vc-hg.el progmodes/python.el vc-git.el vc.el
- cyril-util.el maintaining.texi vc-svn.el
+ maintaining.texi vc-svn.el
Andrzej Lichnerowicz: wrote ob-io.el
@@ -487,11 +421,11 @@ Bartosz Duszel: changed allout.el bib-mode.el cc-cmds.el hexl.el icon.el
sendmail.el ses.el simple.el verilog-mode.el vi.el vip.el viper-cmd.el
xscheme.el
-Basil L. Contovounesios: changed simple.el message.el subr.el text.texi
- gravatar.el modes.texi custom.el customize.texi display.texi eww.el
- files.texi gnus-group.el gnus-sum.el gnus-win.el internals.texi
- window.c bibtex.el button.el gnus-art.el gnus-msg.el gnus.texi
- and 182 other files
+Basil L. Contovounesios: changed simple.el message.el subr.el gravatar.el
+ custom.el gnus-group.el gnus-sum.el gnus-win.el internals.texi
+ modes.texi text.texi window.c bibtex.el button.el customize.texi
+ display.texi eww.el gnus-art.el gnus-msg.el gnus.texi lists.texi
+ and 150 other files
Bastian Beischer: changed semantic/complete.el include.el mru-bookmark.el
refs.el senator.el
@@ -577,8 +511,6 @@ and changed mh-customize.el mh-search.el mh-alias.el mh-e.texi Makefile
Bjarte Johansen: wrote ob-sed.el
-Björn Holby: changed vhdl-mode.el
-
Björn Lindström: changed rcirc.texi
Bjørn Mork: changed nnimap.el gnus-agent.el message.el mml2015.el
@@ -903,7 +835,7 @@ Claudio Fontana: changed Makefile.in leim/Makefile.in lib-src/Makefile.in
Clément Pit--Claudel: changed debugging.texi emacs-lisp/debug.el eval.c
progmodes/python.el subr-tests.el subr.el url-http.el url-vars.el
-Clément Pit-Claudel: changed display.texi keyboard.c text.texi xdisp.c
+Clément Pit-Claudel: changed keyboard.c text.texi
Colin Marquardt: changed gnus.el message.el
@@ -1357,9 +1289,9 @@ Dmitry Gutov: wrote elisp-mode-tests.el jit-lock-tests.el json-tests.el
vc-hg-tests.el xref-tests.el
and changed ruby-mode.el xref.el project.el vc-git.el elisp-mode.el
etags.el ruby-mode-tests.el js.el package.el vc-hg.el vc.el
- symref/grep.el log-edit.el simple.el dired-aux.el minibuffer.el
+ symref/grep.el log-edit.el dired-aux.el simple.el minibuffer.el
menu-bar.el package-test.el progmodes/grep.el vc-svn.el eldoc.el
- and 112 other files
+ and 111 other files
Dmitry Kurochkin: changed isearch.el
@@ -1445,9 +1377,9 @@ Eli Zaretskii: wrote [bidirectional display in xdisp.c]
chartab-tests.el coding-tests.el doc-tests.el etags-tests.el rxvt.el
tty-colors.el
and changed xdisp.c msdos.c w32.c display.texi w32fns.c simple.el
- files.el fileio.c keyboard.c w32term.c emacs.c w32proc.c files.texi
+ files.el fileio.c keyboard.c w32term.c w32proc.c emacs.c files.texi
text.texi dispnew.c frames.texi lisp.h dispextern.h window.c process.c
- term.c and 1191 other files
+ term.c and 1188 other files
Emanuele Giaquinta: changed configure.ac rxvt.el charset.c etags.c
fontset.c frame.el gnus-faq.texi loadup.el lread.c sh-script.el
@@ -1901,7 +1833,7 @@ Gregor Schmid: changed intervals.c intervals.h tcl-mode.el textprop.c
Gregory Chernov: changed nnslashdot.el
-Grégory Mounié: changed display.texi hi-lock.el man.el xfns.c
+Grégory Mounié: changed display.texi hi-lock.el man.el
Gregory Neil Shapiro: changed mailabbrev.el
@@ -2149,10 +2081,6 @@ Jaesup Kwak: changed xwidget.c
Jaeyoun Chung: changed hangul3.el hanja3.el gnus-mule.el hangul.el
-Jakub-W: changed calculator.el
-
-J. Alexander Branham: wrote conf-mode-tests.el
-
Jambunathan K: wrote ox-odt.el
and co-wrote ox-html.el
and changed org-lparse.el org.el org.texi ox.el icomplete.el
@@ -2439,8 +2367,8 @@ João Távora: wrote elec-pair.el electric-tests.el flymake-cc.el
and changed flymake.el flymake-proc.el icomplete.el minibuffer.el
flymake-tests.el flymake.texi elisp-mode.el flymake-elisp.el
electric.el flymake-ui.el text.texi json-tests.el tex-mode.el
- errors-and-warnings.c json.c xref.el auth-source-pass.el buffers.texi
- linum.el maintaining.texi message.el and 30 other files
+ errors-and-warnings.c json.c xref.el auth-source-pass.el linum.el
+ maintaining.texi message.el progmodes/python.el and 30 other files
Jochen Hein: changed gnus-art.el
@@ -2718,8 +2646,8 @@ and changed tramp-gvfs.el tramp-sh.el comint.el em-unix.el esh-util.el
Juri Linkov: wrote files-x.el misearch.el replace-tests.el tab-bar.el
tab-line.el
and changed isearch.el info.el simple.el replace.el dired.el dired-aux.el
- progmodes/grep.el image-mode.el progmodes/compile.el startup.el subr.el
- diff-mode.el files.el menu-bar.el faces.el display.texi bindings.el
+ progmodes/grep.el progmodes/compile.el startup.el subr.el diff-mode.el
+ files.el menu-bar.el faces.el bindings.el display.texi image-mode.el
desktop.el comint.el minibuffer.el search.texi and 419 other files
Jussi Lahdenniemi: changed w32fns.c ms-w32.h msdos.texi w32.c w32.h
@@ -3116,8 +3044,6 @@ Leonard Randall: changed org-bibtex.el reftex-parse.el
Leo P. White: changed eieio-custom.el
-Leo Vivier: changed dired-aux.el
-
Levin Du: changed parse-time.el org-clock.el
Le Wang: changed org-src.el comint.el hilit-chg.el misc.el
@@ -3141,8 +3067,8 @@ Luca Capello: changed mm-encode.el
Lucas Werkmeister: changed emacs.c emacs.service
Lucid, Inc.: changed byte-opt.el byte-run.el bytecode.c bytecomp.el
- delsel.el disass.el faces.el font-lock.el lmenu.el mailabbrev.el
- select.el xfaces.c xselect.c
+ delsel.el disass.el faces.el font-lock.el mailabbrev.el select.el
+ xfaces.c xselect.c
Luc Teirlinck: wrote help-at-pt.el
and changed files.el autorevert.el cus-edit.el subr.el simple.el
@@ -3443,7 +3369,7 @@ Matthias Dahl: changed faces.el process.c process.h
Matthias Förste: changed files.el
Matthias Meulien: changed bookmark.el progmodes/python.el buff-menu.el
- prog-mode.el simple.el tab-bar.el tabify.el vc-dir.el vc-git.el
+ prog-mode.el simple.el tabify.el vc-dir.el vc-git.el
Matthias Wiehl: changed gnus.el
@@ -3462,7 +3388,7 @@ Mattias Engdegård: changed rx.el searching.texi rx-tests.el autorevert.el
calc-tests.el regexp-opt.el filenotify.el subr.el files.el
progmodes/compile.el mouse.el bytecomp.el compile-tests.el
autorevert-tests.el byte-opt.el bytecomp-tests.el calc-alg.el
- compilation.txt dired.el font.c regex-emacs.c and 170 other files
+ compilation.txt dired.el font.c regex-emacs.c and 161 other files
Matt Lundin: changed org-agenda.el org.el org-bibtex.el org-footnote.el
ox-publish.el org-bbdb.el org-datetree.el org-gnus.el
@@ -3493,14 +3419,14 @@ Micah Anderson: changed spook.lines
Michael Albinus: wrote autorevert-tests.el dbus-tests.el dbus.el
filenotify-tests.el filenotify.el files-x-tests.el secrets-tests.el
secrets.el shadowfile-tests.el tramp-archive-tests.el tramp-archive.el
- tramp-cmds.el tramp-compat.el tramp-ftp.el tramp-gvfs.el
+ tramp-cmds.el tramp-compat.el tramp-crypt.el tramp-ftp.el tramp-gvfs.el
tramp-integration.el tramp-rclone.el tramp-smb.el tramp-sudoedit.el
tramp-tests.el url-tramp-tests.el url-tramp.el vc-tests.el zeroconf.el
and co-wrote tramp-cache.el tramp-sh.el tramp.el
and changed tramp.texi tramp-adb.el trampver.el trampver.texi dbusbind.c
file-notify-tests.el files.el ange-ftp.el files.texi dbus.texi
autorevert.el tramp-fish.el kqueue.c tramp-gw.el tramp-imap.el os.texi
- xesam.el configure.ac lisp.h shell.el gfilenotify.c and 254 other files
+ xesam.el configure.ac lisp.h shell.el gfilenotify.c and 253 other files
Michael Ben-Gershon: changed acorn.h configure.ac riscix1-1.h riscix1-2.h
unexec.c
@@ -3830,7 +3756,7 @@ Nicolas Petton: wrote map-tests.el map.el seq-tests.el seq.el
thunk-tests.el thunk.el url-handlers-test.el
and co-wrote auth-source-pass.el auth-source-tests.el subr-tests.el
and changed README configure.ac sed2v2.inp authors.el sequences.texi
- README.W32 emacs.png HISTORY emacs23.png arc-mode.el cl-extra.el
+ README.W32 emacs.png emacs23.png HISTORY arc-mode.el cl-extra.el
emacs.svg manoj-dark-theme.el Emacs.icns Makefile.in auth-source.el
emacs.ico fns.c make-tarball.txt obarray-tests.el obarray.el
and 37 other files
@@ -3882,7 +3808,7 @@ Noam Postavsky: changed progmodes/python.el lisp-mode.el bytecomp.el
lisp-mode-tests.el term.el xdisp.c eval.c cl-macs.el data.c
emacs-lisp/debug.el simple.el help-fns.el modes.texi subr.el
elisp-mode.el ert.el isearch.el processes.texi cl-print.el diff-mode.el
- ffap.el and 360 other files
+ ffap.el and 359 other files
Nobuyoshi Nakada: co-wrote ruby-mode.el
and changed ruby-mode-tests.el
@@ -3990,9 +3916,9 @@ and changed imenu.el make-mode.el
Paul Eggert: wrote rcs2log
and co-wrote cal-dst.el
and changed lisp.h configure.ac alloc.c process.c fileio.c editfns.c
- xdisp.c sysdep.c image.c keyboard.c emacs.c data.c fns.c lread.c
+ xdisp.c sysdep.c image.c keyboard.c data.c emacs.c fns.c lread.c
xterm.c eval.c callproc.c Makefile.in frame.c buffer.c gnulib-comp.m4
- and 1822 other files
+ and 1813 other files
Paul Fisher: changed fns.c
@@ -4176,13 +4102,13 @@ Philipp Stephani: wrote callint-tests.el checkdoc-tests.el
cl-preloaded-tests.el ediff-diff-tests.el eval-tests.el ido-tests.el
lread-tests.el mouse-tests.el startup-tests.el xt-mouse-tests.el
and changed emacs-module.c emacs-module-tests.el json.c json-tests.el
- mod-test.c eval.c lisp.h lread.c nsterm.m configure.ac bytecomp.el
- internals.texi gtkutil.c emacs-module.h.in files.el alloc.c editfns.c
- electric-tests.el electric.el test/Makefile.in emacs.c
- and 129 other files
+ eval.c mod-test.c lisp.h lread.c nsterm.m configure.ac bytecomp.el
+ internals.texi gtkutil.c emacs-module.h.in files.el alloc.c
+ electric-tests.el electric.el test/Makefile.in editfns.c emacs.c
+ and 127 other files
Phillip Lord: wrote ps-print-tests.el
-and changed build-zips.sh lisp/Makefile.in build-dep-zips.py undo.c
+and changed build-zips.sh lisp/Makefile.in undo.c build-dep-zips.py
simple.el test/Makefile.in Makefile Makefile.in emacs.nsi keyboard.c
viper-cmd.el README-windows-binaries README.W32 elisp-mode-tests.el
ldefs-clean.el loadup.el README-scripts autoload.el
@@ -4222,10 +4148,10 @@ Piotr Trojanek: changed gnutls.c process.c
Piotr Zieliński: wrote org-mouse.el
-Pip Cet: changed fns.c display.texi xdisp.c xterm.c composite.c
- dispextern.h frame.el gtkutil.c image.c indent.c json-tests.el json.c
- mail-utils.el nsterm.m simple.el subr.el text.texi textprop.c
- timer-list.el tty-colors-tests.el tty-colors.el and 4 other files
+Pip Cet: changed fns.c display.texi xdisp.c xterm.c dispextern.h frame.el
+ gtkutil.c image.c json-tests.el json.c mail-utils.el nsterm.m simple.el
+ subr.el text.texi textprop.c timer-list.el tty-colors-tests.el
+ tty-colors.el url-http.el xfaces.c xterm.h
Pontus Michael: changed simple.el
@@ -4263,8 +4189,7 @@ Rajappa Iyer: changed gnus-salt.el
Raja R. Harinath: changed gnus-salt.el nnml.el
-Rajesh Vaidheeswarran: wrote old-whitespace.el
-and changed whitespace.el ffap.el
+Rajesh Vaidheeswarran: changed whitespace.el ffap.el
Ralf Angeli: wrote scroll-lock.el
and changed w32fns.c reftex-cite.el gnus-art.el reftex-toc.el reftex.el
@@ -4337,7 +4262,7 @@ Ricardo Wurmus: changed xwidget.el xwidget.c configure.ac xwidget.h
Riccardo Murri: changed vc-bzr.el tls.el
-Richard Copley: changed Makefile.in epaths.in epaths.nt gdb-mi.el sort.el
+Richard Copley: changed Makefile.in epaths.in epaths.nt gdb-mi.el
text.texi
Richard Dawe: changed config.in src/Makefile.in
@@ -4347,7 +4272,7 @@ Richard G. Bielawski: changed modes.texi paren.el
Richard Hoskins: changed message.el
Richard Kim: wrote wisent/python.el
-and changed bovine.texi db-global.el gud.el loading.texi python-wy.el
+and changed bovine.texi db-global.el loading.texi python-wy.el
texnfo-upd.el wisent.texi
Richard King: wrote filelock.c uniquify.el userlock.el
@@ -4423,9 +4348,9 @@ Robert P. Goldman: changed org.texi ob-exp.el org.el ox-latex.el
Robert Pluim: wrote nsm-tests.el
and changed process.c ftfont.c gtkutil.c processes.texi vc-git.el
configure.ac font.c network-stream.el nsm.el process-tests.el xfns.c
- custom.texi dispextern.h files.texi ftcrfont.c gnus-icalendar.el
- gnutls.el gtkutil.h network-stream-tests.el nsterm.m text.texi
- and 92 other files
+ dispextern.h files.texi ftcrfont.c gnus-icalendar.el gnutls.el
+ gtkutil.h network-stream-tests.el nsterm.m text.texi w32.c
+ and 90 other files
Robert Thorpe: changed cus-start.el indent.el
@@ -4716,9 +4641,12 @@ Sidney Markowitz: changed doctor.el nsmenu.m
Sigbjorn Finne: changed gnus-srvr.el
-Simen Heggestøyl: wrote asm-mode-tests.el autoinsert-tests.el
- color-tests.el css-mode-tests.el dom-tests.el makesum-tests.el
- page-tests.el paren-tests.el ring-tests.el rot13-tests.el sql-tests.el
+Simen Heggestøyl: wrote apropos-tests.el asm-mode-tests.el
+ autoconf-tests.el autoinsert-tests.el check-declare-tests.el
+ color-tests.el css-mode-tests.el dom-tests.el elide-head-tests.el
+ glasses-tests.el help-mode-tests.el makesum-tests.el page-tests.el
+ paren-tests.el po-tests.el ring-tests.el rot13-tests.el sql-tests.el
+ webjump-tests.el
and changed css-mode.el css-mode.css json-tests.el json.el sgml-mode.el
scss-mode.scss page.el ring.el rot13.el scheme.el sql.el asm-mode.el
autoinsert.el color.el files.el js.el less-css-mode.el
@@ -4728,8 +4656,9 @@ and changed css-mode.el css-mode.css json-tests.el json.el sgml-mode.el
Simona Arizanova: changed help.el
Simon Josefsson: wrote dig.el dns-mode.el flow-fill.el fringe.el imap.el
- mml-sec.el mml-smime.el password-cache.el rfc2104.el sieve-mode.el
- sieve.el smime.el starttls.el tls.el url-imap.el
+ mml-sec.el mml-smime.el password-cache.el rfc2104.el
+ sasl-scram-sha256.el sieve-mode.el sieve.el smime.el starttls.el tls.el
+ url-imap.el
and co-wrote gnus-sieve.el gssapi.el mml1991.el nnfolder.el nnimap.el
nnml.el sieve-manage.el
and changed message.el gnus-sum.el gnus-art.el smtpmail.el pgg-gpg.el
@@ -4738,8 +4667,6 @@ and changed message.el gnus-sum.el gnus-art.el smtpmail.el pgg-gpg.el
gnus-int.el gnus.el hashcash.el mm-view.el password.el
and 101 other files
-Simon Lang: changed misterioso-theme.el
-
Simon Law: changed delsel.el electric.el
Simon Leinen: changed Makefile.in smtpmail.el Makefile cm.c cm.h hpux9.h
@@ -4779,13 +4706,15 @@ Stefan Bruda: co-wrote prolog.el
Stefan Guath: changed find-dired.el
-Stefan Kangas: wrote bookmark-tests.el delim-col-tests.el morse-tests.el
- paragraphs-tests.el password-cache-tests.el studly-tests.el
- tabify-tests.el timezone-tests.el underline-tests.el uudecode-tests.el
+Stefan Kangas: wrote bookmark-tests.el cal-julian-tests.el
+ delim-col-tests.el lunar-tests.el misc-tests.el morse-tests.el
+ paragraphs-tests.el password-cache-tests.el qp-tests.el
+ rfc2045-tests.el studly-tests.el tabify-tests.el timezone-tests.el
+ underline-tests.el uudecode-tests.el
and changed bookmark.el package.el efaq.texi package.texi ibuffer.el
mwheel.el cperl-mode.el fns.c gud.el simple.el subr.el autoinsert.el
- comint-tests.el control.texi cus-edit.el delim-col.el dired-aux.el
- dired-x.el em-term.el ert.texi flow-fill.el and 153 other files
+ comint-tests.el cus-edit.el delim-col.el dired-aux.el dired-x.el
+ em-term.el ert.texi flow-fill.el frames.texi and 147 other files
Stefan Merten: co-wrote rst.el
@@ -4801,7 +4730,7 @@ and co-wrote font-lock.el gitmerge.el pcvs.el
and changed subr.el simple.el keyboard.c bytecomp.el files.el lisp.h
cl-macs.el vc.el xdisp.c alloc.c eval.c sh-script.el
progmodes/compile.el keymap.c tex-mode.el buffer.c newcomment.el
- window.c lread.c fileio.c help-fns.el and 1373 other files
+ window.c lread.c fileio.c help-fns.el and 1372 other files
Stefano Facchini: changed gtkutil.c
@@ -4820,9 +4749,10 @@ Stefan Wiens: changed gnus-sum.el
Steinar Bang: changed gnus-setup.el imap.el
Štěpán Němec: changed INSTALL calc-ext.el checkdoc.el cl.texi comint.el
- edebug.texi font-lock.el functions.texi gnus-sum.el gnus.texi insdel.c
+ edebug.texi font-lock.el functions.texi gnus-sum.el insdel.c
leim-ext.el loading.texi maps.texi mark.texi message.texi mini.texi
- minibuf.texi misc.texi programs.texi subr.el and 8 other files
+ minibuf.texi misc.texi programs.texi subr.el text.texi
+ and 7 other files
Stephan Stahl: changed which-func.el buff-menu.el buffer.c dired-x.texi
ediff-mult.el
@@ -4835,7 +4765,7 @@ and changed wdired.el todo-mode.texi diary-lib.el wdired-tests.el
dired-tests.el doc-view.el files.el minibuffer.el dired.el frames.texi
hl-line.el info.el menu-bar.el mouse.el otodo-mode.el subr.el
.gitattributes TUTORIAL allout.el artist.el compile.texi
- and 44 other files
+ and 43 other files
Stephen C. Gilardi: changed configure.ac
@@ -4987,7 +4917,7 @@ and changed reftex-vars.el tex-mode.el gnus.texi reftex-cite.el
tsdh-dark-theme.el tsdh-light-theme.el gnus-sum.el file-notify-tests.el
reftex.el misc.texi org-gnus.el prog-mode.el subword.el image-mode.el
json.el lisp-mode.el cc-cmds.el display.texi em-term.el emacsbug.el
- files.el and 83 other files
+ files.el and 82 other files
Tatsuya Ichikawa: changed gnus-agent.el gnus-cache.el
@@ -5307,8 +5237,6 @@ Valentin Gatien-Baron: changed emacs-module.c
Valentin Wüstholz: changed org.el
-Valery Alexeev: changed cyril-util.el cyrillic.el
-
Van L: changed subr.el
Vasilij Schneidermann: changed cus-start.el eww.el cc-mode.el
@@ -5368,8 +5296,6 @@ and changed erc-backend.el erc.el erc-services.el hexl.el emacs.c
erc-button.el erc-capab.el erc-join.el htmlfontify.texi sh-script.el
xterm.c xterm.h
-Vladimir Alexiev: changed arc-mode.el nnvirtual.el tmm.el
-
Vladimir Kazanov: changed java.srt
Vladimir Lomov: changed ox-html.el
@@ -5544,6 +5470,8 @@ Yuan Fu: changed gdb-mi.el
Yuanle Song: changed rng-xsd.el
+Yue Daian: wrote cl-font-lock.el
+
Yu-ji Hosokawa: changed README.W32
Yukihiro Matsumoto: co-wrote ruby-mode.el
diff --git a/etc/MACHINES b/etc/MACHINES
index 1bb244b49b0..78e9cef0fd7 100644
--- a/etc/MACHINES
+++ b/etc/MACHINES
@@ -81,25 +81,26 @@ the list at the end of this file.
** Solaris
- On Solaris it is also possible to use either GCC or Solaris Studio
- to build Emacs, by pointing ./configure to the right compiler:
+ On Solaris it is also possible to use either GCC or Oracle Developer
+ Studio to build Emacs, by pointing ./configure to the right compiler:
- ./configure CC='/usr/sfw/bin/gcc' # GCC
- ./configure CC='cc' # Solaris Studio
+ ./configure # Defaults to 'gcc' if available.
+ ./configure CC='cc' # Oracle Developer Studio
- On Solaris, do not use /usr/ucb/cc. Use /opt/SUNWspro/bin/cc. Make
- sure that /usr/ccs/bin and /opt/SUNWspro/bin are in your PATH before
- /usr/ucb. (Most free software packages have the same requirement on
- Solaris.) With this compiler, use '/opt/SUNWspro/bin/cc -E' as the
+ On Solaris, do not use /usr/ucb/cc. Use Oracle Developer Studio.
+ Make sure that /usr/ccs/bin and the Oracle Developer Studio bin
+ directory (e.g., /opt/developerstudio12.6/bin) are in your PATH
+ before /usr/ucb. (Most free software packages have the same
+ requirement on Solaris.) With this compiler, use 'cc -E' as the
preprocessor. If this inserts extra whitespace into its output (see
- the PROBLEMS file) then add the option '-Xs'.
+ the PROBLEMS file), add the option '-Xs'.
To build a 64-bit Emacs (with larger maximum buffer size) on a
- Solaris system which supports 64-bit executables, specify the -m64
+ Solaris system that defaults to 32-bit executables, specify the -m64
compiler option. For example:
- ./configure CC='/usr/sfw/bin/gcc -m64' # GCC
- ./configure CC='cc -m64' # Solaris Studio
+ ./configure CC='gcc -m64' # GCC
+ ./configure CC='cc -m64' # Oracle Developer Studio
* Obsolete platforms
diff --git a/etc/NEWS b/etc/NEWS
index 33e7ebec83f..d5b1496bbab 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -6,10 +6,10 @@ See the end of the file for license conditions.
Please send Emacs bug reports to 'bug-gnu-emacs@gnu.org'.
If possible, use 'M-x report-emacs-bug'.
-This file is about changes in Emacs version 27.
+This file is about changes in Emacs version 28.
See file HISTORY for a list of GNU Emacs versions and release dates.
-See files NEWS.26, NEWS.25, ..., NEWS.18, and NEWS.1-17 for changes
+See files NEWS.27, NEWS.26, ..., NEWS.18, and NEWS.1-17 for changes
in older Emacs versions.
You can narrow news to a specific version by calling 'view-emacs-news'
@@ -22,3197 +22,1634 @@ 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
+* Installation Changes in Emacs 28.1
+
+** Cairo graphics library is now used by default if found.
+'--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
+removed support for bitmapped fonts, this may require you to adjust
+your font settings.
+
+Note also that 'FontBackend' settings in ".Xdefaults" or
+".Xresources", or 'font-backend' frame parameter settings in your init
+files, may need to be adjusted, as 'xft' is no longer a valid backend
+when using Cairo. Use 'ftcrhb' if your Emacs was built with HarfBuzz
+text shaping support, and 'ftcr' otherwise. You can determine this by
+checking 'system-configuration-features'. The 'ftcr' backend will
+still be available when HarfBuzz is supported, but will not be used by
+default. We strongly recommend building with HarBuzz support. 'x' is
+still a valid backend.
+
+---
+** Building without double buffering support.
+'configure --with-xdbe=no' can now be used to disable double buffering
+at build time.
+
+---
+** 'configure' now warns about building with libXft support.
+libXft is unmaintained, and causes a number of problems with modern
+fonts including but not limited to crashes; support for it may be
+removed in a future version of Emacs. Please consider using
+Cairo + HarfBuzz instead.
+
+---
+** 'configure' now warns about not using HarfBuzz if using Cairo.
+We want to encourage people to use the most modern font features
+available, and this is the Cairo graphics library + HarfBuzz for font
+shaping, so 'configure' now recommends that combination.
+
+---
+** The ftx font backend driver has been removed.
+It was declared obsolete in Emacs 27.1.
+
+---
+** 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.
+
+---
+** Emacs no longer supports old OpenBSD systems.
+OpenBSD 5.3 and older releases are no longer supported, as they lack
+proper pty support that Emacs needs.
-* Startup Changes in Emacs 27.2
+* Startup Changes in Emacs 28.1
-
-* Changes in Emacs 27.2
-
-This is a bug-fix release with no new features.
-
-
-* Editing Changes in Emacs 27.2
-
-
-* Changes in Specialized Modes and Packages in Emacs 27.2
-
-
-* New Modes and Packages in Emacs 27.2
-
-
-* Incompatible Lisp Changes in Emacs 27.2
-
-
-* Lisp Changes in Emacs 27.2
+** 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".
-* Changes in Emacs 27.2 on Non-Free Operating Systems
-
-
-* Installation Changes in Emacs 27.1
-
-** Emacs now uses GMP, the GNU Multiple Precision library.
-By default, if 'configure' does not find a suitable libgmp, it
-arranges for the included mini-gmp library to be built and used.
-The new configure option '--without-libgmp' uses mini-gmp even if a
-suitable libgmp is available.
-
-** Emacs can now use HarfBuzz as its shaping engine.
-The new configure option '--with-harfbuzz' adds support for the
-HarfBuzz text shaping engine. It is on by default; use './configure
---without-harfbuzz' to build without it. The HarfBuzz text shaping is
-available via new font backend drivers 'xfthb' and 'ftcrhb' for Xft
-and Cairo drawings, respectively, and via the 'harfbuzz' backend on
-MS-Windows. The HarfBuzz text shaping is preferred to the previously
-supported ones, so the font backends that use older shaping engines
-(FLT on GNU and Unix systems and Uniscribe on MS-Windows) are not
-enabled by default; they can be enabled via the 'font-backend' frame
-parameter or via X resources.
-
-** The new configure option '--with-json' adds native support for JSON.
-This uses the Jansson library. The option is on by default; use
-'./configure --with-json=no' to build without Jansson support. The
-new JSON functions 'json-serialize', 'json-insert',
-'json-parse-string', and 'json-parse-buffer' are typically much faster
-than their Lisp counterparts from json.el.
-
-** The configure option '--with-cairo' is no longer experimental.
-This builds Emacs with Cairo drawing, and supports built-in printing
-when Emacs is built with GTK+. Some severe bugs in this build were
-fixed, and we can therefore offer this to users without caveats. Note
-that building with Cairo enabled results in using Pango instead of
-libXft for font support, and that Pango 1.44 has removed support for
-bitmapped fonts.
-
-** Emacs now uses a "portable dumper" instead of unexec.
-This improves compatibility with memory allocation on modern systems,
-and in particular better supports the Address Space Layout
-Randomization (ASLR) feature, a security technique used by most modern
-operating systems.
-
-When built with the portable dumping support (which is the default),
-Emacs looks for the "emacs.pdmp" file, generated during the build, in
-its data directory at startup, and loads the dumped state from there.
-The new command-line argument '--dump-file=FILE' allows specifying a
-non-default ".pdmp" file to load the state from; see the node
-"(emacs) Initial Options" in the Emacs manual for more information.
-
-An Emacs started via a dump file can create a new dump file only if it
-was invoked with the '-batch' option. (This is a temporary
-limitation; we plan on lifting it in a future release.)
-
-Although the portable dumper has been tested, it may have a bug on
-unusual platforms. If you require traditional unexec dumping you can
-use the configure-time option '--with-dumping=unexec'; however, please
-file a bug report describing the situation, as unexec dumping is
-deprecated, and we plan on removing it in some future release.
-
-** The new configure option '--enable-checking=structs' attempts to
-check that the portable dumper code has been updated to match the last
-change to one of the data structures that it relies on.
-
-** The configure options '--enable-checking=conslist' and
-'--enable-checking=xmallocoverrun' have been withdrawn. The former
-made Emacs irredeemably slow, and the latter made it crash. Neither
-option was useful with modern debugging tools such as AddressSanitizer.
-(See "etc/DEBUG" for the details of using the modern replacements of the
-removed configure options.)
-
-** Emacs no longer defaults to using ImageMagick to display images.
-This is due to security and stability concerns with ImageMagick. To
-override the default, use 'configure --with-imagemagick'.
-
-** Several configure options now accept an option-argument 'ifavailable'.
-For example, './configure --with-xpm=ifavailable' now configures Emacs
-to attempt to use libxpm but to continue building even if libxpm is
-absent. The other affected options are '--with-gif', '--with-gnutls',
-'--with-jpeg', '--with-png', and '--with-tiff'.
-
-** The 'etags' program now uses the C library's regular expression matcher.
-If it's possible, 'etags' will use the regexp matcher from the
-system's standard C library, otherwise it will be linked with a
-compatible regex substitute. This lets developers maintain Emacs's
-own regex code without having to also support other programs. The new
-configure option '--without-included-regex' forces 'etags' to use the C
-library's regex matcher even if the regex substitute ordinarily would
-be used to work around compatibility problems.
-
-** Emacs has been ported to the '-fcheck-pointer-bounds' option of GCC.
-This causes Emacs to check bounds of some arrays addressed by its
-internal pointers, which can be helpful when debugging the Emacs
-interpreter or modules that it uses. If your platform supports it you
-can enable it when configuring, e.g., './configure CFLAGS="-g3 -O2
--mmpx -fcheck-pointer-bounds"' on Intel MPX platforms.
-
-** Emacs now normally uses a C pointer type instead of a C integer
-type to implement Lisp_Object, which is the fundamental machine word
-type internal to the Emacs Lisp interpreter. This change aims to
-catch typos and supports '-fcheck-pointer-bounds'. The configure
-option '--enable-check-lisp-object-type' is therefore no longer as
-useful and so is no longer enabled by default in developer builds,
-to reduce differences between developer and production builds.
-
-** The distribution tarball now has test cases; 'make check' runs them.
-This is intended mostly to help developers.
-
-** Emacs now requires GTK 2.24 and GTK 3.10 for the GTK 2 and GTK 3
-builds respectively.
-
-** New make target 'help' shows a summary of common make targets.
-
-** Emacs now builds with dynamic module support by default.
-Pass '--without-modules' to 'configure' to disable dynamic module
-support.
-
-** The ftx font backend driver is now obsolete and will be removed in
-Emacs 28.
-
-
-* Startup Changes in Emacs 27.1
-
-** Emacs can now use the XDG convention for init files.
-The 'XDG_CONFIG_HOME' environment variable (which defaults to
-"~/.config") specifies the XDG configuration parent directory. Emacs
-checks for "init.el" and other configuration files inside the "emacs"
-subdirectory of 'XDG_CONFIG_HOME', i.e. "$XDG_CONFIG_HOME/emacs/init.el"
-
-However, Emacs will still initially look for init files in their
-traditional locations if "~/.emacs.d" or "~/.emacs" exist, even if
-"$XDG_CONFIG_HOME/emacs" also exists. This means that you must delete
-or rename any existing "~/.emacs.d" and "~/.emacs" to enable use of
-the XDG directory.
-
-If "~/.emacs.d" does not exist, and Emacs has decided to use it
-(i.e. "$XDG_CONFIG_HOME/emacs" does not exist), Emacs will create it.
-Emacs will never create "$XDG_CONFIG_HOME/emacs".
-
-Whichever directory Emacs decides to use, it will set
-'user-emacs-directory' to point to it.
-
-** Emacs can now be configured using an early init file.
-The file is called "early-init.el", in 'user-emacs-directory'. It is
-loaded very early in the startup process: before graphical elements
-such as the tool bar are initialized, and before the package manager
-is initialized. The primary purpose is to allow customizing how the
-package system is initialized given that initialization now happens
-before loading the regular init file (see below).
-
-We recommend against putting any customizations in this file that
-don't need to be set up before initializing installed add-on packages,
-because the early init file is read too early into the startup
-process, and some important parts of the Emacs session, such as
-'window-system' and other GUI features, are not yet set up, which could
-make some customization fail to work.
-
-** Installed packages are now activated *before* loading the init file.
-As a result of this change, it is no longer necessary to call
-'package-initialize' in your init file.
-
-Previously, a call to 'package-initialize' was automatically inserted
-into the init file when Emacs was started. This call can now safely
-be removed. Alternatively, if you want to ensure that your init file
-is still compatible with earlier versions of Emacs, change it to:
-
-(when (< emacs-major-version 27)
- (package-initialize))
-
-However, if your init file changes the values of 'package-load-list'
-or 'package-user-dir', or sets 'package-enable-at-startup' to nil then
-it won't work right without some adjustment:
-- You can move that code to the early init file (see above), so those
- settings apply before Emacs tries to activate the packages.
-- You can use the new 'package-quickstart' so activation of packages
- does not need to pay attention to 'package-load-list' or
- 'package-user-dir' any more.
-
-** Emacs now notifies systemd when startup finishes or shutdown begins.
-Units that are ordered after 'emacs.service' will only be started
-after Emacs has finished initialization and is ready for use, and
-Emacs needs to be built with systemd support. (If your Emacs is
-installed in a non-standard location and you copied the emacs.service
-file to e.g. "~/.config/systemd/user/", you will need to copy the new
-version of the file again.)
-
-
-* Changes in Emacs 27.1
-
-** Emacs now supports Unicode Standard version 13.0.
-
-** Emacs now supports resizing and rotating images without ImageMagick.
-All modern systems support this feature. (On GNU and Unix systems,
-Cairo drawing or the XRender extension to X11 is required for this to
-be available; the configure script will test for it and, if found,
-enable scaling.)
-
-The new function 'image-transforms-p' can be used to test whether any
-given frame supports these capabilities.
-
-** The Network Security Manager now allows more fine-grained control
-of what checks to run via the 'network-security-protocol-checks'
-user option.
-
-** TLS connections have their security tightened by default.
-Most of the checks for outdated, believed-to-be-weak TLS algorithms
-and ciphers are now switched on by default. (In addition, several new
-TLS weaknesses are now warned about.) By default, the NSM will
-flag connections using these weak algorithms and ask users whether to
-allow them. To get the old behavior back (where certificates are
-checked for validity, but no warnings about weak cryptography are
-issued), you can either set 'network-security-protocol-checks' to nil,
-or adjust the elements in that user option to only happen on the 'high'
-security level (assuming you use the 'medium' level).
-
-** New user option 'nsm-trust-local-network'.
-Allows skipping Network Security Manager checks for hosts on your
-local subnet(s). It defaults to nil. Usually, there should be no
-need to set this non-nil, and doing that risks opening your local
-network connections to attacks. So be sure you know what you are
-doing before changing the value.
-
-** Native GnuTLS connections can now use client certificates.
-Previously, this support was only available when using the external
-'gnutls-cli' or 'starttls' command. Call 'open-network-stream' with
-':client-certificate t' to trigger looking up of per-server
-certificates via 'auth-source'.
-
-** New user option 'network-stream-use-client-certificates'.
-When non-nil, 'open-network-stream' performs lookups of client
-certificates using 'auth-source' as if ':client-certificate t' were
-specified if there is no explicit ':client-certificate' parameter.
-Defaults to nil.
-
-** 'next/previous-multiframe-window' have been renamed.
-The new names are as follows:
-
- 'next-multiframe-window' -> 'next-window-any-frame'
- 'previous-multiframe-window' -> 'previous-window-any-frame'
-
-The old function names are maintained as aliases for backward
-compatibility.
-
-** emacsclient
-*** emacsclient now supports the 'EMACS_SOCKET_NAME' environment variable.
-The command-line argument '--socket-name' overrides it.
-(The same behavior as for the pre-existing 'EMACS_SERVER_FILE' variable.)
-
-*** Emacs and emacsclient now default to "$XDG_RUNTIME_DIR/emacs".
-This is used as the directory for client/server sockets, if Emacs is
-running on a platform or environment that sets the 'XDG_RUNTIME_DIR'
-environment variable to indicate where session sockets should go.
-To get the old, less-secure behavior, you can set the
-'EMACS_SOCKET_NAME' environment variable to an appropriate value.
-
-*** When run by root, emacsclient no longer connects to non-root sockets.
-(Instead you can use Tramp methods to run root commands in a non-root Emacs.)
-
-** 'xft-ignore-color-fonts' now ignores even more color fonts.
-There are color fonts that managed to bypass the existing checks,
-causing XFT crashes, they are now filtered out. Setting
-'xft-ignore-color-fonts' to nil removes those checks, which might
-require setting 'face-ignored-fonts' to filter out problematic fonts.
-Known problematic fonts are "Noto Color Emoji" and "Emoji One".
-
-** The GTK+ font chooser now respects 'face-ignored-fonts'.
-When using 'menu-set-font' under GTK3, the available fonts are now
-matched against 'face-ignored-fonts'.
-
-** The GTK+ font chooser now remembers the previously selected settings.
-It now remembers the name, size, style, etc.
-
-** New user option 'what-cursor-show-names'.
-When non-nil, 'what-cursor-position' will show the name of the character
-in addition to the decimal/hex/octal representation. Default nil.
-
-** New function 'network-lookup-address-info'.
-This does IPv4 and/or IPv6 address lookups on hostnames.
-
-** 'network-interface-list' can now return IPv4 and IPv6 addresses.
-IPv4 and IPv6 addresses are now returned by default if available,
-optionally including netmask/broadcast address information.
-
-** Control of the threshold for using the 'distant-foreground' color.
-The threshold for color distance below which the 'distant-foreground'
-color of the face will be used instead of the foreground color can now
-be controlled via the new variable 'face-near-same-color-threshold'.
-The default value is 30000, as the previously hard-coded threshold.
-
-** The function 'read-passwd' uses "*" as default character to hide passwords.
-
-** The function 'read-answer' now accepts not only single character
-answers, but also function keys like 'F1', character events such as
-'C-M-h', and control characters like 'C-h'.
-
-** Lexical binding is now used by default when evaluating interactive Elisp.
-More specifically, 'lexical-binding' is now used by default for 'M-:'
-and '--eval' (including in evaluations invoked from 'emacsclient' via
-its '--eval' command-line option), as well as in
-'lisp-interaction-mode' and 'ielm-mode', used in the "*scratch*" and
-"*ielm*" buffers.
-
-We envision that most Lisp code is already either written with
-lexical-binding in mind, or will work unchanged under
-lexical-binding. If, for some reason, your code used in 'M-:' or
-'--eval' doesn't work as result of this change, either modify the code
-to work with lexical binding, or wrap it in an extra level of 'eval'.
-For example, --eval "FORM" becomes --eval "(eval 'FORM)" (note the extra
-quote in 'FORM).
-
-** The new user option 'tooltip-resize-echo-area' avoids truncating
-tooltip text on GUI frames when tooltips are displayed in the echo
-area. Instead, it resizes the echo area as needed to accommodate the
-full tool-tip text.
-
-** Show mode line tooltips only if the corresponding action applies.
-Customize the user option 'mode-line-default-help-echo' to restore the
-old behavior where the tooltip text is also shown when the
-corresponding action does not apply.
-
-** New hook 'server-after-make-frame-hook'.
-This hook is a convenient place to perform initializations in daemon
-mode which require GUI features to be available. One example is
-restoration of the previous session using the desktop.el package: put
-the call to 'desktop-read' in this hook, if you want the GUI settings
-to be restored, or if desktop.el needs to interact with you during
-restoration of the session.
-
-** The functions 'set-frame-height' and 'set-frame-width' are now
-commands, and will set the currently selected frame to the height/
-width specified by the numeric prefix.
-
-** New function 'logcount' calculates an integer's Hamming weight.
-
-** New function 'libxml-available-p'.
-This function returns non-nil if libxml support is both compiled in
-and available at run time. Lisp programs should use this function to
-detect built-in libxml support, instead of testing for that
-indirectly, e.g., by checking that functions like
-'libxml-parse-html-region' return nil.
-
-** 'libxml-parse-xml-region' and 'libxml-parse-html-region' take
-a parameter that's called DISCARD-COMMENTS, but it really only
-discards the top-level comment. Therefore this parameter is now
-obsolete, and the new utility function 'xml-remove-comments' can be
-used to remove comments before calling the libxml functions to parse
-the data.
-
-** A new DOM (the XML/HTML document structure returned by functions
-such as 'libxml-parse-html-region') traversal function has been added:
-'dom-search', which takes a DOM and a predicate and returns all nodes
-that match.
-
-** New function 'fill-polish-nobreak-p', to be used in 'fill-nobreak-predicate'.
-It blocks line breaking after a one-letter word, also in the case when
-this word is preceded by a non-space, but non-alphanumeric character.
-
-** The limit on repetitions in regexps has been raised to 2^16-1.
-It was previously limited to 2^15-1. For example, the following
-regular expression was previously invalid, but is now accepted:
-
- x\{32768\}
-
-** The German prefix and postfix input methods now support Capital sharp S.
-
-** New input methods 'hawaiian-postfix' and 'hawaiian-prefix'.
-
-** New input methods 'georgian-qwerty' and 'georgian-nuskhuri'.
-
-** New input methods for several variants of the Sami language.
-The Sami input methods include: 'norwegian-sami-prefix',
-'bergsland-hasselbrink-sami-prefix', 'southern-sami-prefix',
-'ume-sami-prefix', 'northern-sami-prefix', 'inari-sami-prefix',
-'skolt-sami-prefix', and 'kildin-sami-prefix'.
-
-** Japanese environments use UTF-8 by default.
-In Japanese environments that do not specify encodings and are not
-based on MS-Windows, the default encoding is now utf-8 instead of
-japanese-iso-8bit.
-
-** New function 'exec-path'.
-This function by default returns the value of the corresponding
-user option, but can optionally return the equivalent of 'exec-path'
-from a remote host.
-
-** The function 'executable-find' supports an optional argument REMOTE.
-This triggers searching for the program on the remote host as indicated by
-'default-directory'.
-
-** New user option 'auto-save-no-message'.
-When set to t, no message will be shown when auto-saving (default
-value: nil).
-
-** The value of 'make-cursor-line-fully-visible' can now be a function.
-In addition to nil or non-nil, the value can now be a predicate
-function. Follow mode uses this to control scrolling of its windows
-when the last screen line in a window is not fully visible.
-
-** New variable 'emacs-repository-branch'.
-It reports the git branch from which Emacs was built.
-
-** New user option 'switch-to-buffer-obey-display-actions'.
-When non-nil, 'switch-to-buffer' uses 'pop-to-buffer-same-window' that
-respects display actions specified by 'display-buffer-alist' and
-'display-buffer-overriding-action'.
-
-** The user option 'switch-to-visible-buffer' is now obsolete.
-Customize 'switch-to-prev-buffer-skip' instead.
-
-** New user option 'switch-to-prev-buffer-skip'.
-This user option allows specifying the set of buffers that may be
-shown by 'switch-to-prev-buffer' and 'switch-to-next-buffer' more
-stringently than the now obsolete 'switch-to-visible-buffer'.
-
-** New 'flex' completion style.
-An implementation of popular "flex/fuzzy/scatter" completion which
-matches strings where the pattern appears as a subsequence. Put
-simply, makes "foo" complete to both "barfoo" and "frodo". Add 'flex'
-to 'completion-styles' or 'completion-category-overrides' to use it.
-
-** The 'completion-common-part' face is now visible by default.
-
-** New face attribute ':extend' to control face extension at EOL.
-The new face attribute ':extend' controls whether to use the face for
-displaying the empty space beyond end of line (EOL) till the edge of
-the window. By default, this attribute is non-nil only for a small
-number of faces, notably, 'region'; any other face that crosses end of
-line will not affect the display of the empty space at EOL. This is
-to make Emacs behave more like other GUI applications with respect to
-displaying faces that cross line boundaries.
-
-This attribute behaves specially when theme definitions are applied:
-if the theme doesn't specify an explicit value of this attribute for a
-face, the value from the original face definition is inherited.
-Consequently, a theme generally shouldn't specify this attribute
-unless it has a good reason to do so.
-
-** Connection-local variables
-*** Connection-local variables are applied by default like file-local
-and directory-local variables.
-
-*** The macro 'with-connection-local-variables' has been renamed from
-'with-connection-local-profiles'. No argument PROFILES needed any longer.
-
-** New user option 'next-error-verbose' controls when 'next-error'
-outputs a message about the error locus.
-
-** New user option 'grep-search-path' defines the directories searched for
-grep hits (this used to be controlled by 'compilation-search-path').
-
-** New user option 'emacs-lisp-compilation-search-path' defines the
-directories searched for byte-compiler error messages (this used to
-be controlled by 'compilation-search-path').
-
-** Multicolor fonts such as "Noto Color Emoji" can be displayed on
-Emacs configured with Cairo drawing and linked with cairo >= 1.16.0.
-
-** Emacs now optionally displays a fill column indicator.
-This is similar to what 'fill-column-indicator' package provides, but
-much faster and compatible with 'show-trailing-whitespace'.
-
-Customize the buffer-local user options 'display-fill-column-indicator'
-and 'display-fill-column-indicator-character' to activate the
-indicator.
-
-The indicator is not displayed at all in minibuffer windows and
-in tooltips, as it is not useful there.
-
-There are 2 new buffer local variables and 1 face to customize this
-mode, they are described in the manual "(emacs) Display".
-
-** 'progress-reporter-update' now accepts an optional suffix string to display.
-
-** New user option 'xref-file-name-display' controls the display of
-file names in xref buffers.
-
-** New user option 'byte-count-to-string-function'.
-It is used for displaying file sizes and disk space in some cases.
-
-** Emacs now interprets RGB triplets like HTML, SVG, and CSS do.
-The X convention previously used differed slightly, particularly for
-RGB triplets with a single hexadecimal digit per component.
-
-** The toolbar now shows the equivalent key binding in its tooltips.
-
-** The File menu-bar menu was re-arranged.
-Print menu items moved to submenu, and also added the new entries for tabs.
-
-** 'scroll-lock-mode' is now bound to the 'Scroll_Lock' key globally.
-Note that this key binding will not work on MS-Windows systems if
-'w32-scroll-lock-modifier' is non-nil.
-
-** 'global-set-key', called interactively, now no longer downcases a
-key binding with an upper case letter - if you can type it, you can
-bind it.
-
-** 'read-from-minibuffer' now works with buffer-local history variables.
-The HIST argument of 'read-from-minibuffer' now works correctly with
-buffer-local variables. This means that different buffers can have
-their own separated input history list if desired.
-
-** 'backup-by-copying-when-privileged-mismatch' applies to file gid, too.
-In addition to checking the file owner uid, Emacs also checks that the
-group gid is not greater than 'backup-by-copying-when-privileged-mismatch';
-if so, 'backup-by-copying-when-mismatch' will be forced on.
+* Changes in Emacs 28.1
+
+---
+** Support for the 'strike-through' face attribute on TTY frames.
+If your terminal's termcap or terminfo database entry has the 'smxx'
+capability defined, Emacs will now emit the prescribed escape
+sequences necessary to render faces with the 'strike-through'
+attribute on TTY frames.
+
++++
+*** Emacs now defaults to UTF-8 instead of ISO-8859-1.
+This is only for the default, where the user has set no 'LANG' (or
+similar) variable or environment. This change should lead to no
+user-visible changes for normal usage.
+
++++
+** New variables that hold default buffer names for shell output.
+The new constants 'shell-command-buffer-name' and
+'shell-command-buffer-name-async' store the default buffer names
+for the output of, respectively, synchronous and async shell
+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
+dimension.
+
++++
+** New user option 'word-wrap-by-category'.
+When word-wrap is enabled, and this option is non-nil, that allows
+Emacs to break lines after more characters than just whitespace
+characters. In particular, this significantly improves word-wrapping
+for CJK text mixed with Latin text.
+
+---
+** Improved language transliteration in Malayalam input methods.
+Added a new Mozhi scheme. The inapplicable ITRANS scheme is now
+deprecated. Errors in the Inscript method were corrected.
+
+---
+** Rudimentary support for the 'st' terminal emulator.
+Emacs now supports 256 color display on the 'st' terminal emulator.
+
+---
+** Mouse wheel scrolling now works on more parts of frame's display.
+When using 'mwheel-mode', the mouse wheel will now scroll also when
+the mouse cursor is on the scroll bars, fringes, margins, header line,
+and mode line. ('mwheel-mode' is enabled by default on most graphical
+displays.)
+
+---
+** Mouse wheel scrolling now defaults to one line at a time.
+
++++
+** Mouse wheel scrolling with Shift modifier now scrolls horizontally.
+This works in text buffers and over images.
+
+---
+** 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
+the current buffer and the text "GNU Emacs" instead of the value of
+'invocation-name'. To get the old behavior back, add the following to
+your init file:
+
+ (setq frame-title-format '(multiple-frames "%b"
+ ("" invocation-name "@" system-name)))
+
+** recentf
+
+---
+*** 'recentf-auto-cleanup' time string now repeats.
+When 'recentf-auto-cleanup' is set to a time string, it now repeats
+every day, rather than only running once after the mode is turned on.
-* Editing Changes in Emacs 27.1
-
-** When asked to visit a large file, Emacs now offers to visit it literally.
-Previously, Emacs would only ask for confirmation before visiting
-large files. Now it also offers a third alternative: to visit the
-file literally, as in 'find-file-literally', which speeds up
-navigation and editing of large files.
-
-** 'zap-to-char' now uses the history of characters you used to zap to.
-'zap-to-char' uses the new 'read-char-from-minibuffer' function to allow
-navigating through the history of characters that have been input.
-This is mostly useful for characters that have complex input methods
-where inputting the character again may involve many keystrokes.
-
-** 'save-some-buffers' now has a new action in the prompt: 'C-f' will
-exit the command and switch to the buffer currently being asked about.
-
-** More commands support noncontiguous rectangular regions, namely
-'upcase-dwim', 'downcase-dwim', 'capitalize-dwim', 'capitalize-region',
-'upcase-initials-region', 'replace-string', 'replace-regexp', and
-'delimit-columns-region'.
-
-** The new 'amalgamating-undo-limit' variable can be used to control
-how many changes should be amalgamated when using the 'undo' command.
-
-** The 'newline-and-indent' command (commonly bound to 'RET' in many
-modes) now takes an optional numeric argument to specify how many
-times is should insert newlines (and indent).
-
-** New command 'make-empty-file'.
-
-** New variable 'x-wait-for-event-timeout'.
-This controls how long Emacs will wait for updates to the graphical
-state to take effect (making a frame visible, for example).
-
-** New user option 'electric-quote-replace-double'.
-This option controls whether '"' is replaced in 'electric-quote-mode',
-in addition to other quote characters. If non-nil, ASCII double-quote
-characters that quote text "like this" are replaced by double
-typographic quotes, “like this”, in text modes, and in comments in
-non-text modes.
-
-** New user option 'flyspell-case-fold-duplications'.
-This option controls whether Flyspell mode considers consecutive words
-to be duplicates if they are not in the same case. If non-nil, the
-default, words are considered to be duplicates even if their letters'
-case does not match.
-
-** 'write-abbrev-file' now includes special properties.
-'write-abbrev-file' now writes special properties like ':case-fixed'
-for abbrevs that have them.
-
-** 'write-abbrev-file' skips empty tables.
-'write-abbrev-file' now skips inserting a 'define-abbrev-table' form for
-tables which do not have any non-system abbrevs to save.
-
-** The new functions and commands 'text-property-search-forward' and
-'text-property-search-backward' have been added. These provide an
-interface that's more like functions like 'search-forward'.
-
-** 'add-dir-local-variable' now uses dotted pair notation syntax to
-write alists of variables to ".dir-locals.el". This is the same
-syntax that you can see in the example of a ".dir-locals.el" file in
-the node "(emacs) Directory Variables" of the user manual.
-
-** Network connections using 'local' can now use IPv6.
-'make-network-process' now uses the correct loopback address when
-asked to use ":host 'local" and ":family 'ipv6".
-
-** The new function 'replace-region-contents' replaces the current
-region using a given replacement-function in a non-destructive manner
-(in terms of 'replace-buffer-contents').
-
-** The command 'replace-buffer-contents' now has two optional
-arguments mitigating performance issues when operating on huge
-buffers.
-
-** Dragging 'C-M-mouse-1' now marks rectangular regions.
-
-** The command 'delete-indentation' now operates on the active region.
-If the region is active, the command joins all the lines in the
-region. When there's no active region, the command works on the
-current and the previous or the next line, as before.
-
-** You can now change the font size with the mouse wheel.
-Scrolling the mouse wheel with the Ctrl key pressed will now act the
-same as the 'C-x C-+' and 'C-x C--' commands.
+* Editing Changes in Emacs 28.1
+
+---
+** 'eval-expression' now no longer signals an error on incomplete expressions.
+Previously, typing 'M-: ( RET' would result in Emacs saying "End of
+file during parsing" and dropping out of the minibuffer. The user
+would have to type 'M-: M-p' to edit and redo the expression. Now
+Emacs will echo the message and allow the user to continue editing.
+
++++
+** New command 'undo-redo'.
+It undoes previous undo commands, but doesn't record itself as an
+undoable command.
+
++++
+** 'read-number' now has its own history variable.
+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.
+
++++
+** New command 'goto-line-relative' to use in a narrowed buffer.
+It moves point to the line relative to the accessible portion of the
+narrowed buffer. 'M-g M-g' in Info is rebound to this command.
+When 'widen-automatically' is non-nil, 'goto-line' widens the narrowed
+buffer to be able to move point to the inaccessible portion.
+
++++
+** When 'suggest-key-bindings' is non-nil, the completion list of 'M-x'
+shows equivalent key bindings for all commands that have them.
+
+---
+** Movement commands in 'gomoku-mode' are fixed.
+'gomoku-move-sw' and 'gomoku-move-ne' now work correctly, and
+horizontal movements now stop at the edge of the board.
+
+** Autosaving via 'auto-save-visited-mode' can now be inhibited by
+setting the variable 'auto-save-visited-mode' buffer-locally to nil.
+
+** New commands to describe buttons and widgets have been added.
+'widget-describe' (on a widget) will pop up a help buffer and give a
+description of the properties. Likewise 'button-describe' does the
+same for a button.
+
+** Obsolete commands 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
+obsolescence fact and shows the new name of the command.
+
++++
+** New command 'revert-buffer-with-fine-grain'.
+Revert a buffer trying to be as non-destructive as possible,
+preserving markers, properties and overlays. The new variable
+'revert-buffer-with-fine-grain-max-seconds' specifies the maximum
+number of seconds that 'revert-buffer-with-fine-grain' should spend
+trying to be non-destructive.
-* Changes in Specialized Modes and Packages in Emacs 27.1
-
-** New HTML mode skeleton 'html-id-anchor'.
-This new command (which inserts an <a id="foo">_</a> skeleton) is
-bound to 'C-c C-c #'.
-
-** New command 'font-lock-debug-fontify'.
-This is an interactive convenience function to be used when developing
-font locking for a mode. It recomputes the font locking data and then
-re-fontifies the buffer.
-
-** Font Lock is smarter about fontifying unterminated strings and comments.
-When you type a quote that starts a string, or a comment delimiter
-that starts a comment, font-lock will not immediately refontify the
-following characters in 'font-lock-string-face' or
-'font-lock-comment-face'. Instead, it will delay the fontification
-beyond the current line to give you a chance to close the string or
-comment. This is controlled by the new user option
-'jit-lock-antiblink-grace', which specifies the delay in seconds. The
-default is 2 seconds; set to nil to get back the old behavior.
+* Changes in Specialized Modes and Packages in Emacs 28.1
-** The 'C' command in 'tar-mode' will now preserve the timestamp of
-the extracted file if the new user option 'tar-copy-preserve-time' is
-non-nil.
+** Ruby mode
-** 'autoconf-mode' is now used instead of 'm4-mode' for the
-"acinclude.m4" / "aclocal.m4" / "acsite.m4" files.
+*** '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.
-** On GNU/Linux, 'M-x battery' will now list all batteries, no matter
-what they're named, and the 'battery-linux-sysfs-regexp' variable has
-been removed.
+---
+** Specific warnings can now be disabled from the warning buffer.
+When a warning is displayed to the user, the resulting buffer now has
+buttons which allow making permanent changes to the treatment of that
+warning. Automatic showing of the warning can be disabled (although
+it is still logged to the *Messages* buffer), or the warning can be
+disabled entirely.
-** The 'list-processes' command now includes port numbers in the
-network connection information (in addition to the host name).
+** mspool.el
-** The 'cl' package is now officially deprecated in favor of 'cl-lib'.
+---
+*** Autoload the main entry point 'mspool-show'.
-** desktop
+** Windows
-*** When called interactively with a prefix arg 'C-u', 'desktop-read'
-now prompts the user for the directory containing the desktop file.
+*** The key prefix 'C-x 4 1' displays next command buffer in the same window.
+It's bound to the command 'same-window-prefix' that requests the buffer
+of the next command to be displayed in the same window.
-** display-line-numbers-mode
+*** The key prefix 'C-x 4 4' displays next command buffer in a new window.
+It's bound to the command 'other-window-prefix' that requests the buffer
+of the next command to be displayed in a new window.
-*** New faces 'line-number-major-tick' and 'line-number-minor-tick',
-and user options 'display-line-numbers-major-tick' and
-'display-line-numbers-minor-tick' can be used to highlight the line
-numbers of lines multiple of certain numbers.
-
-*** New variable 'display-line-numbers-offset', when non-zero, adds
-an offset to absolute line numbers.
-
-** winner
-
-*** A new user option, 'winner-boring-buffers-regexp', has been added.
-
-** table
-
-*** 'table-generate-source' now supports wiki and mediawiki.
-This command can now output wiki and mediawiki format tables.
-
-** telnet-mode
-
-*** Reverting a buffer in 'telnet-mode' will restart a closed connection.
-
-** goto-addr
-
-*** A way to more conveniently specify what URI address schemes should
-be ignored has been added via the 'goto-address-uri-schemes-ignored'
-variable.
-
-** tex-mode
-
-*** 'latex-noindent-commands' controls indentation of certain commands.
-You can use this new user option to control indentation of arguments of
-\emph, \footnote, and similar commands.
-
-** byte compiler
-
-*** 'byte-compile-dynamic' is now obsolete.
-This is because on the one hand it suffers from misbehavior in corner
-cases that have plagued it for years, and on the other hand experience
-indicates that it doesn't bring any measurable benefit.
-
-*** The 'g' keystroke in "*Compile-Log*" buffers has been bound to a
-new command that will recompile the file previously compiled with 'M-x
-byte-compile-file' and the like.
-
-** compile.el
-
-*** In 'compilation-error-regexp-alist', 'line' (and 'end-line') can
-be functions.
-
-*** 'compilation-context-lines' can now take the value t; this is like
-nil, but instead of scrolling the current line to the top of the
-screen when there is no left fringe, it inserts a visible arrow before
-column zero.
-
-*** The new 'compilation-transform-file-match-alist' user option can
-be used to transform file name matches compilation output, and remove
-known false positives being recognized as warnings/errors.
-
-** cl-lib.el
-
-*** 'cl-defstruct' has a new ':noinline' argument to prevent inlining
-its functions.
-
-*** 'cl-defstruct' slots accept a ':documentation' property.
-
-*** 'cl-values-list' will now signal an error if its argument isn't a list.
-
-** doc-view.el
-
-*** New commands 'doc-view-presentation' and 'doc-view-fit-window-to-page'.
-
-*** Added support for password-protected PDF files.
-
-*** A new user option 'doc-view-pdftotext-program-args' has been added
-to allow controlling how the conversion to text is done.
-
-*** The prefix key 's' was changed to 'c' for slicing commands
-to avoid conflicts with 'image-mode' key 's'. The new key 'c' still
-has good mnemonics of "cut", "clip", "crop".
-
-** Ido
-
-*** New user option 'ido-big-directories' to mark directories whose
-names match certain regular expressions as big. Ido won't attempt to
-list the contents of such directories when completing file names.
-
-** Minibuffer
-
-*** New user option 'minibuffer-beginning-of-buffer-movement'.
-This option allows control of how the 'M-<' command works in
-the minibuffer. If non-nil, point will move to the end of the prompt
-(if point is after the end of the prompt). The default is nil, which
-preserves the original behavior of 'M-<' moving to the beginning of
-the prompt.
-
-*** When the minibuffer is active, echo-area messages are displayed at
-the end of the minibuffer instead of hiding the minibuffer by the echo
-area display. The new user option 'minibuffer-message-clear-timeout'
-controls how messages displayed in this situation are removed from the
-minibuffer. To revert to previous behavior, where echo-area messages
-temporarily overwrote the minibuffer contents until the user typed
-something, set 'set-message-function' and 'clear-message-function' to
-nil.
-
-*** Minibuffer now uses 'minibuffer-message' to display error messages
-at the end of the active minibuffer. To disable this, remove
-'minibuffer-error-initialize' from 'minibuffer-setup-hook'.
-
-*** 'y-or-n-p' now uses the minibuffer to read 'y' or 'n' answer.
-
-*** Some commands that previously used 'read-char-choice' now read
-a character using the minibuffer by 'read-char-from-minibuffer'.
-
-** map.el
-
-*** Now also understands plists.
-*** Now defined via generic functions that can be extended via 'cl-defmethod'.
-*** Deprecate the 'map-put' macro in favor of a new 'map-put!' function.
-*** 'map-contains-key' now returns a boolean rather than the key.
-*** Deprecate the 'testfn' args of 'map-elt' and 'map-contains-key'.
-*** New generic function 'map-insert'.
-*** The 'type' arg can be a list '(hash-table :key1 VAL1 :key2 VAL2 ...)'.
-
-** seq.el
-New convenience functions 'seq-first' and 'seq-rest' give easy access
-to respectively the first and all but the first elements of sequences.
+** Frames
-The new predicate function 'seq-contains-p' should be used instead of
-the now obsolete 'seq-contains'.
+*** 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.
-** Follow mode
-In the current follow group of windows, "ghost" cursors are no longer
-displayed in the non-selected follow windows. To get the old behavior
-back, customize 'follow-hide-ghost-cursors' to nil.
+** Tab Bars
-** New variable 'warning-fill-column' for 'display-warning'.
+*** The key prefix 'C-x t t' displays next command buffer in a new tab.
+It's bound to the command 'other-tab-prefix' that requests the buffer
+of the next command to be displayed in a new tab.
-** Windmove
++++
+*** New command 'C-x t C-r' to open file read-only in other tab.
-*** 'windmove-create-window' when non-nil makes a new window.
-This happens upon moving off the edge of the frame.
+*** The tab bar is frame-local when 'tab-bar-show' is a number.
+Show/hide the tab bar independently for each frame, according to the
+value of 'tab-bar-show'.
-*** Windmove supports directional window display and selection.
-The new command 'windmove-display-default-keybindings' binds default
-keys with provided modifiers (by default, Shift-Meta) to the commands
-that display the next buffer in the window at the specified direction.
-This is like 'windmove-default-keybindings' that binds keys to commands
-that select the window in the specified direction, but additionally it
-displays the buffer from the next command in that window. For example,
-'S-M-right C-h i' displays the "*Info*" buffer in the right window,
-creating the window if necessary. A special key can be customized to
-display the buffer in the same window, for example, 'S-M-0 C-h e'
-displays the "*Messages*" buffer in the same window. 'S-M-t C-h r'
-displays the Emacs manual in a new tab.
+---
+*** 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.
-*** Windmove also supports directional window deletion.
-The new command 'windmove-delete-default-keybindings' binds default
-keys with provided prefix (by default, 'C-x') and modifiers (by default,
-'Shift') to the commands that delete the window in the specified
-direction. For example, 'C-x S-down' deletes the window below.
-With a prefix arg 'C-u', also kills the buffer in that window.
-With 'M-0', deletes the selected window and selects the window
-that was in the specified direction.
+** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and
+'previous-error-no-select' bound to 'p'.
-*** New command 'windmove-swap-states-in-direction' binds default keys
-to the commands that swap the states of the selected window with the
-window in the specified direction.
+** EIEIO
-*** Windmove code no longer used is now obsolete.
-That includes the user option 'windmove-window-distance-delta' and the
-functions 'windmove-coord-add', 'windmove-constrain-to-range',
-'windmove-constrain-around-range', 'windmove-frame-edges',
-'windmove-constrain-loc-for-movement', 'windmove-wrap-loc-for-movement',
-'windmove-reference-loc' and 'windmove-other-window-loc'.
++++
+*** The macro 'oref-default' can now be used with 'setf'.
+It is now defined as a generalized variable that can be used with
+'setf' to modify the value stored in a given class slot.
-** Octave mode
-The mode is automatically enabled in files that start with the
-'function' keyword.
+** New minor mode 'cl-font-lock-built-in-mode' for 'lisp-mode'.
+The mode provides refined highlighting of built-in functions, types,
+and variables.
-** project.el
+** Archive mode
-*** New commands 'project-search' and 'project-query-replace-regexp'.
+*** Can now modify members of 'ar' archives.
-*** New user option 'project-read-file-name-function'.
+*** Display of summaries unified between backends.
-** Etags
+*** New user option 'archive-hidden-columns' and command
+'archive-hideshow-column'. These let you control which columns are
+displayed and which are kept hidden.
-*** 'next-file' is now an obsolete alias of 'tags-next-file'.
+---
+*** New command bound to 'C': 'archive-copy-file'.
+This command extracts the file under point and writes the data to a
+file.
-*** 'tags-loop-revert-buffers' is an obsolete alias of
-'fileloop-revert-buffers'.
+** Emacs Lisp mode
-*** The 'tags-loop-continue' function along with the
-'tags-loop-operate' and 'tags-loop-scan' variables are now obsolete;
-use the new 'fileloop-initialize' and 'fileloop-continue' functions
-instead.
+*** The mode-line now indicates whether we're using lexical or dynamic scoping.
-*** etags is now able to read Zstandard-compressed files.
+*** A space between an open paren and a symbol changes the indentation rule.
+The presence of a space between an open paren and a symbol now is
+taken as a statement by the programmer that this should be indented
+as a data list rather than as a piece of code.
-** bibtex
+** Calendar
-*** New commands 'bibtex-next-entry' and 'bibtex-previous-entry'.
-In 'bibtex-mode-map', 'forward-paragraph' and 'backward-paragraph' are
-remapped to these, respectively.
++++
+*** New user option 'calendar-time-zone-style'.
+If 'numeric', calendar functions (eg 'calendar-sunrise-sunset') that display
+time zones will use a form like "+0100" instead of "CET".
** Dired
-*** New command 'dired-create-empty-file'.
-
-*** New command 'dired-number-of-marked-files'.
-It is by default bound to '* N'.
-
-*** The marking commands now report how many files were marked by the
-command itself, not how many files are marked in total.
-
-*** The new user option 'dired-create-destination-dirs' controls whether
-'dired-do-copy' and 'dired-rename-file' should create non-existent
-directories in the destination.
-
-*** 'dired-dwim-target' can be customized to prefer either the next window,
-or one of the most recently visited windows with a Dired buffer.
-
-*** When the new user option 'dired-vc-rename-file' is non-nil,
-Dired performs file renaming using underlying version control system.
-
-*** Zstandard compression is now supported for 'dired-do-compress' and
-'dired-do-compress-to'.
-
-*** On systems that support suid/guid files, Dired now fontifies the
-permissions of such files with a special face 'dired-set-id'.
-
-*** A new face, 'dired-special', is used to highlight sockets, named
-pipes, block devices and character devices.
-
-** Find-Dired
-
-*** New user option 'find-dired-refine-function'.
-The default value is 'find-dired-sort-by-filename'.
-
-*** New sorting options for the user option 'find-ls-option'.
++++
+*** New user option 'dired-switches-in-mode-line'.
+This variable controls how 'ls' switches are displayed in the mode
+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.
+
+---
+*** Broken and circular links are shown with the 'dired-broken-symlink' face.
+
+*** '=' ('dired-diff') will now put all backup files into the 'M-n' history.
+When using '=' on a file with backup files, the default file to use
+for diffing is the newest backup file. You can now use 'M-n' to quickly
+select a different backup file instead.
+
++++
+*** New user option 'dired-maybe-use-globstar'.
+If set, enables globstar (recursive globbing) in shells that support
+this feature, but turn it off by default. This allows producing
+directory listings with files matching a wildcard in all the
+subdirectories of a given directory. The new variable
+'dired-enable-globstar-in-shell' lists which shells can have globstar
+enabled, and how to enable it.
+
++++
+*** New user option 'dired-copy-dereference'.
+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-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
+region. The values 'file' and 'line' of this user option define the
+details of marking the file at the end of the region.
+
+*** State changing VC operations are supported in Dired on files and
+directories with the help of new command 'dired-vc-next-action'.
+
++++
+*** 'dired-jump' and 'dired-jump-other-window' moved from 'dired-x' to 'dired'.
+The 'dired-jump' and 'dired-jump-other-window' commands have been
+moved from the 'dired-x' package to 'dired'. The user option
+'dired-bind-jump' no longer has any effect and is now obsolete.
+The commands are now bound to 'C-x C-j' and 'C-x 4 C-j' by default.
+
+To get the old behavior of 'dired-bind-jump' back and unbind the above
+keys, add the following to your init file:
+
+(global-set-key "\C-x\C-j" nil)
+(global-set-key "\C-x4\C-j" nil)
** Change Logs and VC
-*** New user option 'vc-tor'.
-When non-nil, this user option causes the VC commands to communicate
-with the repository via Tor's proxy, using the 'torsocks' wrapper
-script. The default is nil.
-
-*** New command 'log-edit-generate-changelog-from-diff', bound to 'C-c C-w'.
-This generates ChangeLog entries from the VC fileset diff.
-
-*** Recording ChangeLog entries doesn't require an actual file.
-If a ChangeLog file doesn't exist, and if the new user option
-'add-log-dont-create-changelog-file' is non-nil (which is the
-default), commands such as 'C-x 4 a' will add log entries to a
-suitable named temporary buffer. (An existing ChangeLog file will
-still be used if it exists.) Set the user option to nil to get the
-previous behavior of always creating a buffer that visits a ChangeLog
-file.
-
-*** The new 'd' command ('vc-dir-clean-files') in 'vc-dir-mode'
-buffers will delete the marked files (or if no files are marked, the
-file under point). This command does not notify the VC backend, and
-is mostly useful for unregistered files.
-
-*** 'vc-dir-ignore' now takes a prefix argument to ignore all marked files.
-
-*** New user option 'vc-git-grep-template'.
-This new user option allows customizing the default arguments passed to
-'git-grep' when 'vc-git-grep' is used.
-
-*** Command 'vc-git-stash' now respects marks in the "*vc-dir*" buffer.
-When some files are marked, only those are stashed.
-When no files are marked, all modified files are stashed, as before.
-
-*** 'vc-dir' now shows a button allowing you to hide the stash list.
-Controlled by user option 'vc-git-show-stash'. Default t means show
-the entire list as before. An integer value limits the list length
-(but still allows you to show the entire list via the button).
-
-*** '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.
-
-*** The new hook 'vc-retrieve-tag-hook' runs after retrieving a tag.
-
-*** 'vc-hg' now invokes 'smerge-mode' when visiting files.
-Code that attempted to invoke 'smerge-mode' when visiting an Hg file
-with conflicts existed in earlier versions of Emacs, but incorrectly
-never detected a conflict due to invalid assumptions about cached
-values.
-
-*** The Hg (Mercurial) back-end now supports 'vc-region-history'.
-The 'C-x v h' command now works in buffers that visit files controlled
-by Hg.
-
-*** The Hg (Mercurial) back-end now prompts for revision to merge when
-you invoke 'C-x v m' ('vc-merge').
-
-*** The Hg (Mercurial) back-end now uses tags, branches and bookmarks
-instead of revision numbers as completion candidates when it prompts
-for a revision.
-
-*** New user option 'vc-hg-revert-switches'.
-It specifies switches to pass to Hg's 'revert' command.
-
-*** 'C-u C-x v D' ('vc-root-version-diff') prompts for two revisions
-and compares their entire trees.
-
-*** 'C-x v M D' ('vc-diff-mergebase') and 'C-x v M L' ('vc-log-mergebase')
-print diffs and logs between the merge base (common ancestor) of two
-given revisions.
-
-*** New command 'vc-log-search' asks for a pattern, searches it
-in the revision log, and displays matched log entries in the
-log buffer. For example, 'M-x vc-log-search RET bug#36644 RET'
-displays all entries whose log messages match the bug number.
-With a prefix argument asks for a command, so for example,
-'C-u M-x vc-log-search RET git log -1 f302475 RET' will display
-just one log entry found by its revision number.
-
-*** It is now possible to display a specific revision given by its ID.
-If you invoke 'C-x v L' ('vc-print-root-log') with a numeric argument
-of 1, as in 'C-1 C-x v L' or 'C-u 1 C-x v L', it asks for a revision
-ID, and shows its log entry together with the diffs introduced by the
-revision's commit. (For some less capable VCSes, only the log entry
-is shown.)
-
-*** New user option 'vc-find-revision-no-save'.
-With non-nil, 'vc-find-revision' doesn't write the created buffer to file.
-
-*** 'C-x v =' can now mimic Magit's diff format.
-Set the new user option 'diff-font-lock-prettify' to t for that, see
-below under "Diff mode".
-
-*** The 'diff' function arguments OLD and NEW may each be a buffer
-rather than a file, in non-interactive calls. This change was made in
-Emacs 24.1, but wasn't documented until now.
-
-*** New command 'diff-buffers' interactively diffs two buffers.
-
-** Diff mode
-
-*** Hunks are now automatically refined by font-lock.
-To disable refinement, set the new user option 'diff-refine' to nil.
-To get back the old behavior where hunks are refined as you navigate
-through a diff, set 'diff-refine' to the symbol 'navigate'.
-
-*** 'diff-auto-refine-mode' is deprecated in favor of 'diff-refine'.
-It is no longer enabled by default and binding it no longer has any
-effect.
-
-*** Better syntax highlighting of Diff hunks.
-Fragments of source in Diff hunks are now by default highlighted
-according to the appropriate major mode. Customize the new user
-option 'diff-font-lock-syntax' to nil to disable this.
-
-*** File headers can be shortened, mimicking Magit's diff format.
-To enable it, set the new user option 'diff-font-lock-prettify' to t.
-On GUI frames, this option also displays the insertion and deletion
-indicators on the left fringe.
-
-*** Prefix arg of 'diff-goto-source' means jump to the old revision
-of the file under version control if point is on an old changed line,
-or to the new revision of the file otherwise.
-
-** Texinfo
-
-*** New function for inserting '@pxref', '@xref', or '@ref' commands.
-The function 'texinfo-insert-dwim-@ref', bound to 'C-c C-c r' by
-default, inserts one of three types of references based on the text
-surrounding point, namely '@pxref' near a parenthesis, '@xref' at the
-start of a sentence or at '(point-min)', else '@ref'.
-
-** Browse-url
-
-*** The function 'browse-url-emacs' can now visit a URL in selected window.
-It now treats the optional 2nd argument to mean that the URL should be
-shown in the currently selected window.
-
-*** A new function, 'browse-url-add-buttons' can be used to add clickable
-links to most ordinary special-mode buffers that display text that
-have URLs embedded. 'browse-url-button-regexp' controls what's
-considered a button.
-
-*** New user option 'browse-url-secondary-browser-function'.
-It can be set to a function that invokes an alternative browser.
-
-** Comint
-
-*** 'send-invisible' is now an obsolete alias for 'comint-send-invisible'.
-Also, 'shell-strip-ctrl-m' is declared obsolete.
-
-*** 'C-c .' ('comint-insert-previous-argument') no longer interprets '&'.
-This feature caused problems when '&&' was present in the previous
-command. Since this command emulates 'M-.' in Bash and zsh, neither
-of which treats '&' specially, the feature was removed for
-compatibility with these shells.
-
-*** 'comint-insert-previous-argument' can now count arguments from the end.
-By default, invoking 'C-c .' with a numeric argument N would copy the
-Nth argument, counting from the first one. But if the new user option
-'comint-insert-previous-argument-from-end' is non-nil, it will copy
-the Nth argument counting from the last one. Thus 'C-c .' can now
-better emulate 'M-.' in both Bash and zsh, since the former counts
-from the beginning of the arguments, while the latter counts from the
-end.
-
-*** 'comint-run' can now accept a list of switches to pass to the program.
-'C-u M-x comint-run' will prompt for the switches interactively.
-
-*** Abnormal hook 'comint-password-function' has been added.
-This hook permits a derived mode to supply a password for the
-underlying command interpreter without prompting the user. For
-example, in 'sql-mode', the password for connecting to the database may
-be stored in the connection wallet and may be passed on the command
-line to start the SQL interpreter. This is a potential security flaw
-that could expose user's database passwords on the command line
-through the use of a process list (Bug#8427). With this hook, it is
-possible to not pass the password on the command line and wait for the
-program to prompt for the password. When it does so, the password can
-be supplied to the SQL interpreter without involving the user just as
-if it had been supplied on the command line.
-
-** SQL
-
-*** SQL Indent Minor Mode
-SQL Mode now supports the ELPA 'sql-indent' package for assisting
-sophisticated SQL indenting rules. Note, however, that SQL is not
-like other programming languages like C, Java, or Python where code is
-sparse and rules for formatting are fairly well established. Instead
-SQL is more like COBOL (from which it came) and code tends to be very
-dense and line ending decisions driven by syntax and line length
-considerations to make readable code. Experienced SQL developers may
-prefer to rely upon existing Emacs facilities for formatting code but
-the 'sql-indent' package provides facilities to aid more casual SQL
-developers layout queries and complex expressions.
-
-**** 'sql-use-indent-support' (default t) enables SQL indentation support.
-The 'sql-indent' package from ELPA must be installed to get the
-indentation support in 'sql-mode' and 'sql-interactive-mode'.
-
-**** 'sql-mode-hook' and 'sql-interactive-mode-hook' changed.
-Both hook variables have had 'sql-indent-enable' added to their
-default values. If you have existing customizations to these
-variables, you should make sure that the new default entry is
-included.
-
-*** Connection Wallet
-Database passwords can now by stored in NETRC or JSON data files that
-may optionally be encrypted. When establishing an interactive session
-with the database via 'sql-connect' or a product specific function,
-like 'sql-mysql' or 'sql-postgres', the password wallet will be
-searched for the password. The 'sql-product', 'sql-server',
-'sql-database', and the 'sql-username' will be used to identify the
-appropriate authorization. This eliminates the discouraged practice of
-embedding database passwords in your Emacs initialization.
-
-See the 'auth-source' module for complete documentation on the file
-formats. By default, the wallet file is expected to be in the
-'user-emacs-directory', named "sql-wallet" or ".sql-wallet", with
-".json" (JSON) or no (NETRC) suffix. Both file formats can optionally
-be encrypted with GPG by adding an additional ".gpg" suffix.
-
-** Term
-
-*** 'term-read-noecho' is now obsolete, use 'read-passwd' instead.
-
-*** 'serial-term' now takes an optional parameter to leave the
-emulator in line mode.
-
-** Flymake
-
-*** The variable 'flymake-diagnostic-types-alist' is obsolete.
-You should instead set properties on known diagnostic symbols, like
-':error' and ':warning', as demonstrated in the Flymake manual.
-
-*** New user option 'flymake-start-on-save-buffer'.
-Control whether Flymake starts checking the buffer on save.
-
-*** Flymake and backend functions may exchange hints about buffer changes.
-This enables more efficient backends. See the docstring of
-'flymake-diagnostic-functions' or the Flymake manual for details.
-
-*** 'flymake-start-syntax-check-on-newline' is now obsolete,
-use 'post-self-insert-hook' to check on newline.
-
-** Ruby
-
-*** The Rubocop Flymake diagnostic function will only run Lint cops if
-it can't find the config file.
-
-*** Rubocop is called with 'bundle exec' if Gemfile mentions it.
-
-*** New command 'ruby-find-library-file' bound to 'C-c C-f'.
-
-** Package
-
-*** Warn if "footer line" is missing, but still install package.
-package.el used to refuse to install a package without the so-called
-"footer line", which appears at the very end of the file:
-
-;;; FILENAME ends here
-
-package.el will now install packages without this line, but it will
-issue a warning. To avoid this warning, packages should keep the
-"footer line".
-
-Note that versions of Emacs older than 27.1 will not only refuse to
-install packages without such a line -- they will be unable to parse
-package data. It is therefore recommended to keep this line.
+*** More VC commands can be used from non-file buffers.
+The relevant commands are those that don't change the VC state.
+The non-file buffers which can use VC commands are those that have
+their 'default-directory' under VC.
-*** Change of 'package-check-signature' for packages with multiple sigs.
-In previous Emacsen, t checked that all signatures are valid.
-Now t only checks that at least one signature is valid and the new 'all'
-value needs to be used if you want to enforce that all signatures
-are valid. This only affects packages with multiple signatures.
+*** New command 'vc-dir-root' uses the root directory without asking.
-*** The meaning of 'allow-unsigned' in 'package-check-signature' has
-changed slightly: If a usable OpenPGP configuration can't be found
-(for instance, if gpg isn't installed), it now has the same meaning as
-nil.
+*** New commands 'vc-dir-mark-registered-files' (bound to '* r') and
+'vc-dir-mark-unregistered-files'.
-*** New function 'package-get-version' lets packages query their own version.
-Example use in auctex.el: '(defconst auctex-version (package-get-version))'
+*** Support for bookmark.el.
+Bookmark locations can refer to VC directory buffers.
-*** New 'package-quickstart' feature.
-When 'package-quickstart' is non-nil, package.el precomputes a big
-autoloads file so that activation of packages can be done much faster,
-which can speed up your startup significantly.
-It also causes user options like 'package-user-dir' and
-'package-load-list' to be consulted when 'package-quickstart-refresh'
-is run rather than at startup so you don't need to set them in your
-early init file.
+---
+*** New user option 'vc-hg-create-bookmark'.
+It controls whether a bookmark or branch will be created when you
+invoke 'C-u C-x v s' ('vc-create-tag').
-*** New function 'package-activate-all'.
+---
+*** 'vc-hg' now uses 'hg summary' to populate extra 'vc-dir' headers.
-*** New functions for filtering packages list.
-A new function has been added which allows users to filter the
-packages list by name: 'package-menu-filter-by-name'. By default, it
-is bound to '/ n'. Additionally, the function
-'package-menu-filter-by-keyword' has been renamed from
-'package-menu-filter'. Its keybinding has also been changed to '/ k'
-(from 'f'). To clear any of the two filters, the user can now call
-the 'package-menu-clear-filter' function, bound to '/ /' by default.
-
-*** Imenu support has been added to 'package-menu-mode'.
-
-*** The package list can now be sorted by version or description.
-
-*** In Package Menu, 'g' now updates package data from archives.
-Previously, 'g' invoked 'tabulated-list-revert' which did not update
-the cached archive data. It is now bound to 'revert-buffer', which
-will update the data.
-
-'package-menu-refresh' is an obsolete alias for 'revert-buffer'.
-
-** Info
-
-*** Clicking on the left/right arrow icon in the Info tool-bar while
-holding down the Ctrl key pops up a menu of previously visited Info nodes
-where you can select a node to go back (like in browsers).
-
-*** Info can now follow 'file://' protocol URLs.
-The 'file://' URLs in Info documents can now be followed by passing
-them to the 'browse-url' function, like the other protocols: 'ftp',
-'http', and 'https'. This allows having references to local HTML
-files, for example.
-
-** Display of man pages now limits the width for formatting pages.
-The new user option 'Man-width-max' (80 by default) limits the number
-of columns passed to the 'man' program for formatting man pages. This
-is to enhance readability when man pages are displayed in very wide
-windows (which are customary with today's large displays).
-
-** Xref
-
-*** New command 'xref-find-definitions-at-mouse'.
-This command finds definitions of the identifier at the place of a
-mouse click event, and is intended to be bound to a mouse event.
-
-*** Changing 'xref-marker-ring-length' works after xref.el is loaded.
-Previously, setting 'xref-marker-ring-length' would only take effect
-if set before xref.el was loaded.
-
-*** 'xref-find-definitions' now sets the mark at the buffer position
-where it was invoked.
-
-*** New xref faces 'xref-file-header', 'xref-line-number', 'xref-match'.
-
-*** New user option 'xref-show-definitions-function'.
-It encapsulates the logic pertinent to showing the result of
-'xref-find-definitions'. The user can change it to customize its
-behavior and the display of results.
-
-*** Search results show the buffer even for one hit.
-The search-type Xref commands (e.g. 'xref-find-references' or
-'project-find-regexp') now show the results buffer even when there is
-only one hit. This can be altered by changing 'xref-show-xrefs-function'.
-
-*** Xref buffers support refreshing the search results.
-A new command 'xref-revert-buffer' is bound to 'g'.
-
-*** Imenu support has been added to 'xref--xref-buffer-mode'.
-
-*** New generic method 'xref-backend-identifier-completion-ignore-case'.
-Using it, the etags backend now honors 'tags-case-fold-search' during
-identifier completion.
-
-** Checkdoc
-
-*** Checkdoc can now optionally spell-check doc strings.
-Invoking 'checkdoc-buffer' with a non-nil TAKE-NOTES argument
-(interactively, with a prefix arg) will now spell-check the doc
-strings and report all the spelling mistakes.
-
-** Icomplete
-
-*** New minor mode Fido mode.
-This mode is based on Icomplete, and its name stands for "Fake Ido".
-The point of this mode is to be an 'ido-mode' workalike, providing
-most of the functionality present in 'ido-mode' that is not in
-Icomplete, which is much more compatible with all of Emacs's
-completion facilities.
-
-** Ecomplete
-
-*** The Ecomplete sorting has changed to a decay-based algorithm.
-This can be controlled by the new 'ecomplete-sort-predicate' user option.
-
-*** The 'ecomplete-database-file' file is now placed in
-"~/.emacs.d/ecompleterc" by default. Of course it will still find it
-if you have it in "~/.ecompleterc".
+---
+*** New user option 'vc-git-revision-complete-only-branches'.
+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.
** Gnus
-*** 'mm-uu-diff-groups-regexp' now defaults to matching all groups,
-which means that "git am" diffs are recognized everywhere.
-
-*** Two new Gnus summary mode navigation commands have been added,
-bound to the '[' and ']' keys: 'gnus-summary-prev-unseen-article' and
-'gnus-summary-next-unseen-article'. These take you (respectively) to
-the previous unseen or next unseen article. (These are the ones that
-are marked with "." in the summary mode lines.)
-
-*** The Gnus user variable 'nnimap-expunge' supports three new values:
-'never' for never expunging messages, 'immediately' for immediately
-expunging deleted messages, and 'on-exit' to expunge deleted articles
-when exiting the group's summary buffer. Setting 'nnimap-expunge' to
-nil or t is still supported but not recommended, since it may
-result in Gnus expunging all messages that have been flagged as
-deleted by any IMAP client (rather than just those that have been
-deleted by Gnus).
-
-*** New user option 'gnus-use-atomic-windows' makes Gnus window layouts atomic.
-See the "(elisp) Atomic Windows" node of the Elisp manual for details.
-
-*** There's a new value for 'gnus-article-date-headers',
-'combined-local-lapsed', which will show both the time (in the local
-timezone) and the lapsed time.
-
-*** Gnus now maps imaps to 993 only on old MS-Windows versions.
-The nnimap backend used to do this unconditionally to work around
-problems on old versions of MS-Windows. This is now done only for
-Windows XP and older.
-
-*** The nnimap backend now has support for IMAP namespaces.
-This feature can be enabled by setting the new 'nnimap-use-namespaces'
-server variable to non-nil.
-
-*** A prefix argument to 'gnus-summary-limit-to-score' will limit in reverse.
-Limit to articles with score "at or below" the SCORE argument rather
-than "at or above".
-
-*** The function 'gnus-score-find-favorite-words' has been renamed
-from 'gnus-score-find-favourite-words'.
-
-*** Gmane has been removed as an nnir backend, since Gmane no longer
-has a search engine.
-
-*** Splitting mail on common mailing list headers has been added.
-See the concept index in the Gnus manual for the 'match-list' entry.
-
-*** nil is no longer an allowed value for 'mm-text-html-renderer'.
-
-*** The default value of 'mm-inline-large-images' has changed from nil
-to 'resize', which means that large images will be resized instead of
-displayed with an external program by default.
-
-*** A new Gnus summary mode command, 'S A' ('gnus-summary-attach-article')
-can be used to attach the current article(s) to a pre-existing Message
-buffer, or create a new Message buffer with the article(s) attached.
-
-*** A new Gnus summary mode command, 'w' ('gnus-summary-browse-url')
-scans the article buffer for URLs, and offers them to the user to open
-with 'browse-url'.
-
-*** New user option 'nnir-notmuch-filter-group-names-function'.
-This option controls whether and how to use Gnus search groups as
-'path:' search terms to 'notmuch'.
-
-*** The buttons in the Gnus article buffer were formerly widgets
-(i.e., buttons from widget.el). This has now changed, and they are
-now buttons (from button.el), and commands like 'TAB' now search for
-buttons instead of widgets. There should be no user-visible changes,
-but out-of-tree code that relied on widgets being present might now
-fail.
-
-** erc
-
-*** New hook 'erc-insert-done-hook'.
-This hook is called after strings have been inserted into the buffer,
-and is free to alter point and window configurations, as it's not
-called from inside a 'save-excursion', as opposed to 'erc-insert-post-hook'.
-
-*** 'erc-button-google-url' has been renamed to 'erc-button-search-url'
-and its value has been changed to Duck Duck Go.
++++
+*** New user option 'gnus-global-groups'.
+Gnus handles private groups differently from public (i.e., NNTP-like)
+groups. Most importantly, Gnus doesn't download external images from
+mail-like groups. This can be overridden by putting group names in
+'gnus-global-groups': Any group present in that list will be treated
+like a public group.
+
++++
+*** New scoring types for the Date header.
+You can now score based on the relative age of an article with the new
+'<' and '>' date scoring types.
+
++++
+*** User-defined scoring is now possible.
+The new type is 'score-fn'. More information in the Gnus manual node
+"(gnus) Score File Format".
+
++++
+*** New backend 'nnselect'.
+The newly added 'nnselect' backend allows creating groups from an
+arbitrary list of articles that may come from multiple groups and
+servers. These groups generally behave like any other group: they may
+be ephemeral or persistent, and allow article marking, moving,
+deletion, etc. 'nnselect' groups may be created like any other group,
+but there are three convenience functions for the common case of
+obtaining the list of articles as a result of a search:
+'gnus-group-make-search-group' ('G g') that will prompt for an 'nnir'
+search query and create a persistent group for that search;
+'gnus-group-read-ephemeral-search-group' ('G G') that will prompt for
+an 'nnir' search query and create an ephemeral group for that search;
+and 'gnus-summary-make-group-from-search' ('C-c C-p') that will create
+a persistent group with the search parameters of a current ephemeral
+search group.
+
+As part of this addition, the user option 'nnir-summary-line-format'
+has been removed; its functionality is now available directly in the
+'gnus-summary-line-format' specs '%G' and '%g'. The user option
+'gnus-refer-thread-use-nnir' has been renamed to
+'gnus-refer-thread-use-search'.
+
++++
+*** New user option 'gnus-dbus-close-on-sleep'.
+On systems with D-Bus support, it is now possible to register a signal
+to close all Gnus servers before the system sleeps.
+
++++
+*** The key binding of 'gnus-summary-search-article-forward' has changed.
+This command was previously on 'M-s' and shadowed the global 'M-s'
+search prefix. The command has now been moved to 'M-s M-s'. (For
+consistency, the 'M-s M-r' key binding has been added for the
+'gnus-summary-search-article-backward' command.)
+
+---
+*** The value of "all" in the 'large-newsgroup-initial' group parameter changes.
+It was previously nil, which didn't work, because nil is
+indistinguishable from not being present. The new value for "all" is
+the symbol 'all'.
+
++++
+*** The name of dependent Gnus sessions has changed from "slave" to "child".
+The names of the commands 'gnus-slave', 'gnus-slave-no-server' and
+'gnus-slave-unplugged' have changed to 'gnus-child',
+'gnus-child-no-server' and 'gnus-child-unplugged' respectively.
+
++++
+*** The 'W Q' summary mode command now takes a numerical prefix to
+allow adjusting the fill width.
+
++++
+*** New variable 'mm-inline-font-lock'.
+This variable is supposed to be bound by callers to determine whether
+inline MIME parts (that support it) are supposed to be font-locked or
+not.
-*** 'erc-send-pre-hook' and 'erc-send-this' have been obsoleted.
-The user option to use instead to alter text to be sent is now
-'erc-pre-send-functions'.
-
-*** Improve matching/highlighting of nicknames.
-Open and close parenthesis and apostrophe are not considered valid
-nick characters anymore, matching the given grammar in RFC 2812
-section 2.3.1. This enables correct matching and highlighting of
-nicks when they are surrounded by parentheses, like "(nick)", and when
-adjacent to an apostrophe, like "nick's".
-
-*** Set 'erc-button-url-regexp' to 'browse-url-button-regexp'
-which better handles surrounding pair of parentheses.
-
-*** New function 'erc-switch-to-buffer-other-window'
-which is like 'erc-switch-to-buffer', but opens the buffer in another
-window.
-
-*** New function 'erc-track-switch-buffer-other-window'
-which is like 'erc-track-switch-buffer', but opens the buffer in
-another window.
-
-** EUDC
-
-*** XEmacs support has been removed.
-
-** eww/shr
-
-*** The new user option 'shr-cookie-policy' can be used to control
-when to use cookies when fetching embedded images. The default is to
-use them when the images are from the same domain as the main HTML
-document.
-
-*** The 'eww' command can now create a new EWW buffer.
-Invoking the command with a prefix argument will cause it to create a
-new EWW buffer for the URL instead of reusing the default one.
-
-*** Clicking with the Ctrl key or 'C-u RET' on a link opens a new tab
-when tab-bar-mode is enabled.
-
-*** The 'd' ('eww-download') command now falls back to current page's URL.
-If this command is invoked with no URL at point, it now downloads the
-current page instead of signaling an error.
-
-*** When opening external links in eww/shr (typically with the
-'C-u RET' keystroke on a link), the link will be flashed with the new
-'shr-selected-link' face to give the user feedback that the command
-has been executed.
-
-*** New user option 'shr-discard-aria-hidden'.
-If set, shr will not render tags with attribute 'aria-hidden="true"'.
-This attribute is meant to tell screen readers to ignore a tag.
-
-*** 'shr-external-browser' has been made into an obsolete alias
-of 'browse-url-secondary-browser-function'.
-
-*** 'shr-tag-ol' now respects the ordered list 'start' attribute.
-
-*** The following tags are now handled: '<code>', '<abbr>', and '<acronym>'.
-
-** Htmlfontify
-
-*** The functions 'hfy-color', 'hfy-color-vals' and
-'hfy-fallback-color-values' and the variables 'hfy-fallback-color-map'
-and 'hfy-rgb-txt-color-map' have been renamed from names that used
-'colour' instead of 'color'.
+** Message
-** Enriched mode supports the 'charset' text property.
-You can add or modify the 'charset' text properties of text using the
-'Edit->Text Properties->Special Properties' menu, or by invoking the
-'facemenu-set-charset' command. Documents in Enriched mode will be
-saved with the charset properties, and those properties will be
-restored when the file is visited.
++++
+*** Message now supports the OpenPGP header.
+To generate these headers, add the new function
+'message-add-openpgp-header' to 'message-send-hook'. The header will
+be generated according to the new 'message-openpgp-header' variable.
+
+---
+*** A change to how "Mail-Copies-To: never" is handled.
+If a user has specified "Mail-Copies-To: never", and Message was asked
+to do a "wide reply", some other arbitrary recipient would end up in
+the resulting "To" header, while the remaining recipients would be put
+in the "Cc" header. This is somewhat misleading, as it looks like
+you're responding to a specific person in particular. This has been
+changed so that all the recipients are put in the "To" header in these
+instances.
+
++++
+*** New command to start Emacs in Message mode to send an email.
+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".
+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".
+
+---
+*** Change to default value of 'message-draft-headers' user option.
+The 'Date' symbol has been removed from the default value, meaning that
+draft or delayed messages will get a date reflecting when the message
+was sent. To restore the original behavior of dating a message
+from when it is first saved or delayed, add the symbol 'Date' back to
+this user option.
+
++++
+*** New command to take screenshots.
+In Message mode buffers, the 'C-c C-p' ('message-insert-screenshot')
+command has been added. It depends on using an external program to
+take the actual screenshot, and defaults to "ImageMagick import".
** Smtpmail
-*** Authentication mechanisms can be added via external packages, by
-defining new 'cl-defmethod' of 'smtpmail-try-auth-method'.
-
-*** To always force smtpmail to send credentials over on the first
-attempt when communicating with the SMTP server(s), the
-'smtpmail-servers-requiring-authorization' user option can be used.
-
-*** smtpmail will now try resending mail when getting a transient "4xx"
-error message from the SMTP server. The new 'smtpmail-retries'
-user option says how many times to retry.
-
-** Footnote mode
-
-*** Support Hebrew-style footnotes.
-
-*** Footnote text lines are now aligned.
-Can be controlled via the new user option 'footnote-align-to-fn-text'.
-
-** CSS mode
-
-*** A new command 'css-cycle-color-format' for cycling between color
-formats (e.g. "black" => "#000000" => "rgb(0, 0, 0)") has been added,
-bound to 'C-c C-f'.
-
-*** CSS mode, SCSS mode, and Less CSS mode now have support for Imenu.
-
-** SGML mode
-
-*** 'sgml-quote' now handles double quotes and apostrophes
-when escaping text and in addition all numeric entities when
-unescaping text.
-
-** Python mode
-
-*** Python mode supports three different font lock decoration levels.
-The maximum level is used by default; customize
-'font-lock-maximum-decoration' to tone down the decoration.
-
-*** New user option 'python-pdbtrack-kill-buffers'.
-If non-nil, the default, buffers opened during pdbtracking session are
-killed when pdbtracking session is finished.
-
-*** New function 'python-shell-send-statement.
-It sends the statement delimited by 'python-nav-beginning-of-statement'
-and 'python-nav-end-of-statement' to the inferior Python process.
-
-** Help
-
-*** Descriptions of variables and functions give an estimated first release
-where the variable or function appeared in Emacs.
-
-*** Output format of 'C-h l' ('view-lossage') has changed.
-For convenience, 'view-lossage' now displays the last keystrokes
-and commands in the same format as the edit buffer of
-'edit-last-kbd-macro'. This makes it possible to copy the lines from
-the buffer generated by 'view-lossage' to the "*Edit Macro*" buffer
-created by 'edit-last-kbd-macro', and to save the macro by 'C-c C-c'.
-
-*** The list of help commands produced by 'C-h C-h' ('help-for-help')
-can now be searched via 'C-s'.
-
-** Ibuffer
-
-*** New filter 'ibuffer-filter-by-process'; bound to '/ E'.
-
-*** All mode filters can now accept a list of symbols.
-This means you can now easily filter several major modes, as well
-as a single mode.
-
-** Search and Replace
-
-*** Isearch supports a prefix argument for 'C-s' ('isearch-repeat-forward')
-and 'C-r' ('isearch-repeat-backward'). With a prefix argument, these
-commands repeat the search for the specified occurrence of the search string.
-A negative argument repeats the search in the opposite direction.
-This makes possible also to use a prefix argument for 'M-s .'
-('isearch-forward-symbol-at-point') to find the next Nth symbol.
-Also a prefix argument is supported for 'isearch-yank-until-char',
-'isearch-yank-word-or-char', 'isearch-yank-symbol-or-char'.
-
-*** To go to the first/last occurrence of the current search string
-is possible now with new commands 'isearch-beginning-of-buffer' and
-'isearch-end-of-buffer' bound to 'M-s M-<' and 'M-s M->' in Isearch.
-With a numeric argument, they go to the Nth absolute occurrence
-counting from the beginning/end of the buffer. This complements
-'C-s'/'C-r' that searches for the next Nth relative occurrence
-with a numeric argument.
-
-*** 'isearch-lazy-count' shows the current match number and total number
-of matches in the Isearch prompt. User options
-'lazy-count-prefix-format' and 'lazy-count-suffix-format' define the
-format of the current and the total number of matches in the prompt's
-prefix and suffix, respectively.
-
-*** 'lazy-highlight-buffer' highlights matches in the full buffer.
-It is useful in combination with 'lazy-highlight-cleanup' customized to nil
-to leave matches highlighted in the whole buffer after exiting isearch.
-Also when 'lazy-highlight-buffer' prepares highlighting in the buffer,
-navigation through the matches without flickering is more smooth.
-'lazy-highlight-buffer-max-at-a-time' controls the number of matches to
-highlight in one iteration while processing the full buffer.
-
-*** New isearch bindings.
-'C-M-z' invokes new function 'isearch-yank-until-char', which yanks
-everything from point up to but not including the specified
-character into the search string. This is especially useful for
-keyboard macros.
-
-'C-M-w' in isearch changed from 'isearch-del-char' to the new function
-'isearch-yank-symbol-or-char'. 'isearch-del-char' is now bound to
-'C-M-d'.
-
-'M-s h l' invokes 'highlight-lines-matching-regexp' using the search
-string to highlight lines matching the search string. This is similar
-to the existing binding 'M-s h r' ('highlight-regexp') that highlights
-JUST the search string.
-
-*** New user option 'isearch-yank-on-move' provides options t and 'shift'
-to extend the search string by yanking text that ends at the new
-position after moving point in the current buffer. 'shift' extends
-the search string by motion commands while holding down the shift key.
-
-*** 'isearch-allow-scroll' provides a new option 'unlimited' to allow
-scrolling any distance off screen.
-
-*** Isearch now remembers the regexp-based search mode for words/symbols
-and case-sensitivity together with search strings in the search ring.
-
-*** Isearch now has its own tool-bar and menu-bar menu.
-
-*** 'flush-lines' prints and returns the number of deleted matching lines.
-
-*** 'char-fold-to-regexp' now matches more variants of a base character.
-The table used to check for equivalence of characters is now built
-using the complete chain of unicode decompositions of a character,
-rather than stopping after one level, such that searching for
-e.g. "GREEK SMALL LETTER IOTA" will now also find "GREEK SMALL LETTER
-IOTA WITH OXIA".
-
-*** New char-folding options: 'char-fold-include' lets you add ad hoc
-foldings, 'char-fold-exclude' to remove foldings from default decomposition,
-and 'char-fold-symmetric' to search for any of an equivalence class of
-characters. For example, with a nil value of 'char-fold-symmetric'
-you can search for "e" to find "é", but not vice versa. With a non-nil
-value you can search for either, for example, you can search for "é"
-to find "e".
-
-** Debugger
-
-*** The Lisp Debugger is now based on 'backtrace-mode'.
-Backtrace mode adds fontification and commands for changing the
-appearance of backtrace frames. See the node "(elisp) Backtraces" in
-the Elisp manual for documentation of the new mode and its commands.
-
-** Edebug
-
-*** 'edebug-eval-last-sexp' and 'edebug-eval-print-last-sexp' interactively
-now take a zero prefix analogously to the non-Edebug counterparts.
-
-*** New faces 'edebug-enabled-breakpoint' and 'edebug-disabled-breakpoint'.
-When setting breakpoints in Edebug, an overlay with these faces are
-placed over the point in question, depending on whether they are
-enabled or not.
-
-*** New command 'edebug-toggle-disable-breakpoint'.
-This command allows you to disable a breakpoint temporarily. This is
-mainly useful with breakpoints that are conditional and would take
-some time to recreate.
-
-*** New command 'edebug-unset-breakpoints'.
-To clear all breakpoints in the current form, the 'U' command in
-'edebug-mode', or 'M-x edebug-unset-breakpoints' can be used.
-
-*** Re-instrumenting a function with Edebug will now try to preserve
-previously-set breakpoints. However, if the code has changed
-substantially, this may not be possible.
-
-*** New command 'edebug-remove-instrumentation'.
-This command removes Edebug instrumentation from all functions that
-have been instrumented.
-
-*** The runtime behavior of Edebug's instrumentation can be changed
-using the new variables 'edebug-behavior-alist',
-'edebug-after-instrumentation-function' and
-'edebug-new-definition-function'. Edebug's behavior can be changed
-globally or for individual definitions.
-
-*** Edebug's backtrace buffer now uses 'backtrace-mode'.
-Backtrace mode adds fontification, links and commands for changing the
-appearance of backtrace frames. See the node "(elisp) Backtraces" in
-the Elisp manual for documentation of the new mode and its commands.
-
-The binding of 'd' in Edebug's keymap is now 'edebug-pop-to-backtrace'
-which replaces 'edebug-backtrace'. Consequently Edebug's backtrace
-windows now behave like those of the Lisp Debugger and of ERT, in that
-when they appear they will be the selected window.
-
-The new 'backtrace-goto-source' command, bound to 's', works in
-Edebug's backtraces on backtrace frames whose source code has
-been instrumented by Edebug.
-
-** Enhanced xterm support
-
-*** New user option 'xterm-set-window-title' controls whether Emacs sets
-the XTerm window title. This feature is experimental and is disabled
-by default.
++++
+*** 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'.
** Grep
-*** 'rgrep', 'lgrep' and 'zrgrep' now hide part of the command line
-that contains a list of ignored directories and files.
-Clicking on the button with ellipsis unhides it.
-The abbreviation can be disabled by the new user option
-'grep-find-abbreviate'. The new command
-'grep-find-toggle-abbreviation' toggles it interactively.
-
-*** 'grep-find-use-xargs' is now customizable with sorting options.
++++
+*** New variable 'grep-match-regexp' matches grep markers to highlight.
+grep emits SGR ANSI escape sequences to color its output. The new variable
+'grep-match-regexp' holds the regular expression to match the appropriate
+markers in order to provide highlighting in the source buffer. The variable
+can be customized to accommodate other grep-like tools.
-** ERT
-
-*** New variable 'ert-quiet' allows making ERT output in batch mode
-less verbose by removing non-essential information.
-
-*** ERT's backtrace buffer now uses 'backtrace-mode'.
-Backtrace mode adds fontification and commands for changing the
-appearance of backtrace frames. See the node "(elisp) Backtraces" in
-the Elisp manual for documentation of the new mode and its commands.
+** Help
-** Gamegrid
++++
+*** New command 'describe-keymap' describes keybindings in a keymap.
-*** Gamegrid now determines its default glyph size based on display
-dimensions, instead of always using 16 pixels. As a result, Tetris,
-Snake and Pong are better playable on HiDPI displays.
++++
+** New command 'lossage-size'.
+It allows users to set the maximum number of keystrokes and commands
+recorded for the purpose of 'view-lossage'.
-*** 'gamegrid-add-score' can now sort scores from lower to higher.
-This is useful for games where lower scores are better, like time-based games.
+---
+*** The command 'view-lossage' can now be invoked from the menu bar.
+The menu-bar Help menu now has a "Show Recent Inputs" item under the
+"Describe" sub-menu.
-** Filecache
+** Ispell
-*** Completing file names in the minibuffer via 'C-TAB' now uses the
-styles as configured by the user option 'completion-styles'.
++++
+*** 'ispell-comments-and-strings' now accepts START and END arguments,
+defaulting to active region when used interactively.
-** New macros 'thunk-let' and 'thunk-let*'.
-These macros are analogue to 'let' and 'let*', but create bindings that
-are evaluated lazily.
++++
+*** New command 'ispell-comment-or-string-at-point' is provided.
-** next-error
+---
+** The old non-SMIE indentation of 'sh-mode' has been removed.
-*** New user option 'next-error-find-buffer-function'.
-The value should be a function that determines how to find the
-next buffer to be used by 'next-error' and 'previous-error'. The
-default is to use the last buffer that navigated to the current
-error.
+---
+** The sb-image.el library is now marked obsolete.
+This file was a compatibility kludge which is no longer needed.
-*** New command 'next-error-select-buffer'.
-It can be used to set any buffer as the next one to be used by
-'next-error' and 'previous-error'.
+---
+** Lisp mode now uses 'common-lisp-indent-function'.
+To revert to the previous behavior,
+'(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'.
-** nxml-mode
+** Edebug
-*** The default value of 'nxml-sexp-element-flag' is now t.
-This means that pressing 'C-M-SPACE' now selects the entire tree by
-default, and not just the opening element.
++++
+*** Edebug specification lists can use the new keyword '&error', which
+unconditionally aborts the current edebug instrumentation with the
+supplied error message.
+
+*** Edebug specification lists can use the new keyword ':unique',
+which appends a unique suffix to the Edebug name of the current
+definition.
+
+** ElDoc
+
++++
+*** New user option 'eldoc-display-truncation-message'.
+If non-nil (the default), eldoc will display a message saying
+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.
+
++++
+*** New hook 'eldoc-documentation-functions'.
+This hook is intended to be used for registering doc string functions.
+These functions don't need to produce the doc string right away, they
+may arrange for it to be produced asynchronously. The results of all
+doc string functions are accessible to the user through the user
+option 'eldoc-documentation-strategy'.
+
++++
+*** 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.
+The user option replaces 'eldoc-documentation-function', which is now
+obsolete.
+
+*** 'eldoc-echo-area-use-multiline-p' is now handled by ElDoc.
+The user option 'eldoc-echo-area-use-multiline-p' is now handled
+by the ElDoc library itself. Functions in
+'eldoc-documentation-functions' don't need to worry about consulting
+it when producing a doc string.
** Eshell
-*** TAB completion uses the standard 'completion-at-point' rather than
-'pcomplete'. Its UI is slightly different but can be customized to
-behave similarly, e.g. Pcomplete's default cycling can be obtained
-with '(setq completion-cycle-threshold 5)'.
-
-*** Expansion of history event designators is disabled by default.
-To restore the old behavior, use
-
- (add-hook 'eshell-expand-input-functions
- #'eshell-expand-history-references)
-
-*** The function 'eshell-uniquify-list' has been renamed from
-'eshell-uniqify-list'.
-
-*** The function 'eshell/kill' is now able to handle signal switches.
-Previously 'eshell/kill' would fail if provided a kill signal to send
-to the process. It now accepts signals specified either by name or by
-its number.
-
-*** Emacs now follows symlinks in history-related files.
-The files specified by 'eshell-history-file-name' and
-'eshell-last-dir-ring-file-name' can include symlinks; these are now
-followed when Emacs writes the relevant history variables to the disk.
-
-** Shell
-
-*** Program name completion inside remote shells works now as expected.
-
-*** The user option 'shell-file-name' can be set now as connection-local
-variable for remote shells. It still defaults to "/bin/sh".
-
-** Single shell commands
-
-*** New values of 'shell-command-dont-erase-buffer'.
-This user option can now have the value 'erase' to force to erase the
-output buffer before execution of the command, even if the output goes
-to the current buffer. Additional values 'beg-last-out',
-'end-last-out', and 'save-point' control where to put point in the
-output buffer after inserting the 'shell-command' output.
-
-*** The new functions 'shell-command-save-pos-or-erase' and
-'shell-command-set-point-after-cmd' control how point is handled
-between two consecutive shell commands in the same output buffer.
-
-*** 'async-shell-command-width' defines the number of display columns
-available for output of asynchronous shell commands.
+---
+*** Environment variable 'INSIDE_EMACS' is now copied to subprocesses.
+Its value equals the result of evaluating '(format "%s,eshell" emacs-version)'.
-*** Prompt for shell commands can now show the current directory.
-Customize the new user option 'shell-command-prompt-show-cwd' to enable it.
+---
+*** Eshell no longer re-initializes its keymap every call.
+This allows users to use (define-key eshell-mode-map ...) as usual.
+Some modules have their own minor mode now to account for these
+changes.
-** Pcomplete
-
-*** The 'pcomplete' command is now obsolete.
-The Pcomplete functionality can be obtained via 'completion-at-point'
-instead, by adding 'pcomplete-completions-at-point' to
-'completion-at-point-functions'.
-
-*** The function 'pcomplete-uniquify-list' has been renamed from
-'pcomplete-uniqify-list'.
-
-*** 'pcomplete/make' now completes on targets in included files, recursively.
-To recover the previous behavior, set new user option
-'pcmpl-gnu-makefile-includes' to nil.
-
-** Auth-source
-
-*** The Secret Service backend supports the ':create' key now.
+** EUDC
-*** ".authinfo" and ".netrc" files now use a new mode: 'authinfo-mode'.
-This is just like 'fundamental-mode', except that it hides passwords
-under a "****" display property. When the cursor moves to this text,
-the real password is revealed (via 'reveal-mode'). The new
-'authinfo-hidden' user option can be used to control what to hide.
++++
+*** New macOS Contacts backend.
+This backend works on newer versions of macOS and is generally
+preferred over the eudcb-mab.el backend.
** Tramp
-*** New connection method "nextcloud", which allows accessing OwnCloud
-or NextCloud hosted files and directories.
-
-*** New connection method "rclone", which allows accessing system
-storages via the 'rclone' program. This feature is experimental.
-
-*** New connection method "sudoedit", which allows editing local files
-with different user credentials. Contrary to the "sudo" method, no
-session is run permanently in the background. This is for security
-reasons.
-
-*** Connection methods "obex" and "synce" have been removed, because they
-are obsoleted in GVFS.
-
-*** Validated passwords are saved by auth-source backends which support this.
-
-*** During user and host name completion in the minibuffer, results
-from auth-source search are taken into account. This can be disabled
-by setting the user option 'tramp-completion-use-auth-sources' to nil.
-
-*** The user option 'tramp-ignored-file-name-regexp' allows disabling
-Tramp for some look-alike remote file names.
-
-*** For some connection methods, like "su" or "sudo", the host name in
-multi-hop file names must match the previous hop. Default host names
-are adjusted to the host name from the previous hop.
-
-*** A timeout has been added for the connection methods "sudo" and "doas".
-The underlying session is disabled when the timeout expires. This is
-for security reasons.
-
-*** For some connection methods, like "sshx" or "plink", it is
-possible to configure the remote login shell. This avoids problems
-with remote hosts, where "/bin/sh" is a link to a shell which
-cooperates badly with Tramp.
-
-*** New commands 'tramp-rename-files' and 'tramp-rename-these-files'.
-They allow saving remote files somewhere else when the corresponding
-host is not reachable anymore.
-
-** Rcirc
-
-*** New user option 'rcirc-url-max-length'.
-Setting this option to an integer causes URLs displayed in Rcirc
-buffers to be truncated to that many characters.
-
-*** The default '/quit' and '/part' reasons are now configurable.
-Two new user options are provided for this:
-'rcirc-default-part-reason' and 'rcirc-default-quit-reason'.
-
-** Register
++++
+*** New connection method "media", which allows accessing media devices
+like cell phones, tablets or cameras.
+
++++
+*** New command 'tramp-crypt-add-directory'.
+This command marks a remote directory to contain only encrypted files.
+See the "(tramp) Keeping files encrypted" node of the Tramp manual for
+details. This feature is experimental.
+
++++
+*** Support of direct asynchronous process invocation.
+When Tramp connection property "direct-async-process" is set to
+non-nil for a given connection, 'make-process' and 'start-file-process'
+calls are performed directly as in "ssh ... <command>". This avoids
+initialization performance penalties. See the "(tramp) Improving
+performance of asynchronous remote processes" node of the Tramp manual
+for details, and also for a discussion or restrictions. This feature
+is experimental.
+
+** Tempo
+
+---
+*** 'tempo-define-template' can now re-assign templates to tags.
+Previously, assigning a new template to an already defined tag had no
+effect.
-*** The return value of method 'register-val-describe' includes the
-names of buffers shown by the windows of a window configuration.
+** map.el
-** Message
+*** Pcase 'map' pattern added keyword symbols abbreviation.
+A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym',
+equivalent to '(map (:sym sym))'.
-*** Completion of email addresses can use the standard completion UI.
-This is controlled by 'message-expand-name-standard-ui'.
-With the standard UI the different sources (ecomplete, bbdb, and eudc)
-are matched together and try to obey 'completion-styles'.
-It should work for other completion front ends like Company.
+** Package
-*** 'message-mode' now supports highlighting citations of different depths.
-This can be customized via the new user option
-'message-cite-level-function' and the new 'message-cited-text-*' faces.
++++
+*** New commands to filter the package list.
+The filter command key bindings are as follows:
+
+key binding
+--- -------
+/ a package-menu-filter-by-archive
+/ k package-menu-filter-by-keyword
+/ n package-menu-filter-by-name
+/ s package-menu-filter-by-status
+/ v package-menu-filter-by-version
+/ m package-menu-filter-marked
+/ / package-menu-filter-clear
+
+---
+*** Column widths in 'list-packages' display can now be customized.
+See the new user options 'package-name-column-width',
+'package-version-column-width', 'package-status-column-width', and
+'package-archive-column-width'.
+
+** gdb-mi
+
++++
+*** 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,
+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'.
+
++++
+*** gdb-mi now has a better logic for displaying source buffers.
+Now GDB only uses one source window to display source file by default.
+Customize 'gdb-max-source-window-count' to use more than one window.
+Control source file display by 'gdb-display-source-buffer-action'.
-*** Messages can now be systematically encrypted
-when the PGP keyring contains a public key for every recipient. To
-achieve this, add 'message-sign-encrypt-if-all-keys-available' to
-'message-send-hook'.
+** Gravatar
-*** When replying a message that have addresses on the form
-'"foo@bar.com" <foo@bar.com>', Message will elide the repeated "name"
-from the address field in the response.
+---
+*** New user option 'gravatar-service' for host to query for gravatars.
+Defaults to 'libravatar', with 'unicornify' and 'gravatar' as options.
-*** The default of 'message-forward-as-mime' has changed from t to nil
-as it has been reported that many recipients can't read forwards that
-are formatted as MIME digests.
+** Compilation mode
-*** 'message-forward-included-headers' has changed its default to
-exclude most headers when forwarding.
+*** 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
+required, but the recommended solution is to use a correctly matching
+regexp instead.
-*** 'mml-secure-openpgp-sign-with-sender' sets also "gpg --sender".
-When 'mml-secure-openpgp-sign-with-sender' is non-nil, message sender's
-email address (in addition to its old behavior) will also be used to
-set gpg's "--sender email@domain" option.
+---
+*** Messages from ShellCheck are now recognized.
-The option is useful for two reasons when verifying the signature:
+---
+*** Messages from Visual Studio that mention column numbers are now recognized.
- 1. GnuPG's TOFU statistics are updated for the specific user id
- (email) only. See gpg(1) man page about "--sender".
+** Hi Lock mode
- 2. GnuPG's "--auto-key-retrieve" functionality can use WKD (web key
- directory) method for finding the signer's key. You need GnuPG
- 2.2.17 to fully benefit from this feature. See gpg(1) man page for
- "--auto-key-retrieve".
+---
+*** Matching in 'hi-lock-mode' is case-sensitive when regexp contains
+upper case characters and 'search-upper-case' is non-nil.
+'highlight-phrase' also uses 'search-whitespace-regexp'
+to substitute spaces in regexp search.
-*** The 'mail-from-style' variable is now obsolete.
-According to RFC 5322, only the 'angles' value is valid.
+---
+*** The default value of 'hi-lock-highlight-range' was enlarged.
+The new default value is 2000000 (2 megabytes).
-** EasyPG
+** Whitespace mode
-*** 'epa-pinentry-mode' is renamed to 'epg-pinentry-mode'.
-It now applies to epg functions as well as epa functions.
++++
+*** New style 'missing-newline-at-eof'.
+If present in 'whitespace-style' (as it is by default), the final
+character in the buffer will be highlighted if the buffer doesn't end
+with a newline.
-*** The alias functions 'epa--encode-coding-string',
-'epa--decode-coding-string', and 'epa--select-safe-coding-system' have
-been removed. Use 'encode-coding-string', 'decode-coding-string', and
-'select-safe-coding-system' instead.
+** Texinfo
-*** 'epg-context' structure supports now 'sender' slot.
-The value of the new 'sender' slot (if a string) is used to set gpg's
-"--sender" option. This feature is used by
-'mml-secure-openpgp-sign-with-sender'. See gpg(1) manual page about
-"--sender" for more information.
+---
+*** New user option 'texinfo-texi2dvi-options'.
+This is used when invoking 'texi2dvi' from 'texinfo-tex-buffer'.
-*** 'epg-find-configuration' no longer finds GnuPG 2.0 through 2.1.5.
-Previously, it found these versions by mistake. The intent was to
-find GnuPG 2.1.6 or later, or find GnuPG 1.4.3 or later within the
-GnuPG 1 series.
+---
+*** New commands for moving in and between environments.
+An "environment" is something that ends with '@end'. The commands are
+'C-c C-c C-f' (next end), 'C-c C-c C-b' (previous end),
+'C-c C-c C-n' (next start) and 'C-c C-c C-p' (previous start), as well
+as 'C-c .', which will alternate between the start and the end of the
+current environment.
** Rmail
-*** New user option 'rmail-output-reset-deleted-flag'.
-If this option is non-nil, messages appended to an output file by the
-'rmail-output' command have their Deleted flag reset.
-
-*** The command 'rmail-summary-by-senders' with an empty argument
-selects the messages to summarize with a regexp that matches the
-sender of the current message.
-
-** Threads
-
-*** New variable 'main-thread' holds Emacs's main thread.
-This is handy in Lisp programs that run on a non-main thread and want
-to signal the main thread, e.g., when they encounter an error.
-
-*** 'thread-join' now returns the result of the finished thread.
-
-*** 'thread-signal' does not propagate errors to the main thread.
-Instead, error messages are just printed in the main thread.
-
-*** 'thread-alive-p' is now obsolete, use 'thread-live-p' instead.
-
-*** New command 'list-threads' shows Lisp threads.
-See the current list of live threads in a tabulated-list buffer which
-automatically updates. In the buffer, you can use 's q' or 's e' to
-signal a thread with quit or error respectively, or get a snapshot
-backtrace with 'b'.
-
-** thingatpt.el
-
-*** 'thing-at-point' supports a new "thing" called 'uuid'.
-A symbol 'uuid' can be passed to 'thing-at-point' and it returns the
-UUID at point.
-
-*** 'number-at-point' will now recognize hex numbers like 0xAb09 and #xAb09
-and return them as numbers.
-
-*** 'word-at-point' and 'sentence-at-point' accept NO-PROPERTIES.
-Just like 'thing-at-point' itself.
-
-** Interactive automatic highlighting
-
-*** 'highlight-regexp' can now highlight subexpressions.
-The new command accepts a prefix numeric argument to choose the
-subexpression.
-
-** Mouse display of minor mode menu
-
-*** 'minor-mode-menu-from-indicator' now displays full minor mode name.
-When there is no menu for a mode, display the mode name after the
-indicator instead of just the indicator (which is sometimes cryptic).
-
-** rx
-
-*** rx now handles raw bytes in character alternatives correctly,
-when given in a string. Previously, '(any "\x80-\xff")' would match
-characters U+0080...U+00FF. Now the expression matches raw bytes in
-the 128...255 range, as expected.
-
-*** The rx 'or' and 'seq' forms no longer require any arguments.
-'(or)' produces a regexp that never matches anything, while '(seq)'
-matches the empty string, each being an identity for the operation.
-This also works for their aliases: '|' for 'or'; ':', 'and' and
-'sequence' for 'seq'.
-The symbol 'unmatchable' can be used as an alternative to '(or)'.
-
-*** 'regexp' and new 'literal' accept arbitrary lisp as arguments.
-In this case, 'rx' will generate code which produces a regexp string
-at run time, instead of a constant string.
-
-*** New rx extension mechanism: 'rx-define', 'rx-let', 'rx-let-eval'.
-These macros add new forms to the rx notation.
-
-*** 'anychar' is now an alias for 'anything'.
-Both match any single character; 'anychar' is more descriptive.
-
-*** New 'intersection' form for character sets.
-With 'or' and 'not', it can be used to compose character-matching
-expressions from simpler parts.
-
-*** 'not' now accepts more argument types.
-The argument can now also be a character, a single-character string,
-an 'intersection' form, or an 'or' form whose arguments each match a
-single character.
-
-*** Nested 'or' forms of strings guarantee a longest match.
-For example, '(or (or "IN" "OUT") (or "INPUT" "OUTPUT"))' now matches
-the whole string "INPUT" if present, not just "IN". Previously, this
-was only guaranteed inside a single 'or' form of string literals.
-
-** Frames
-
-*** New command 'make-frame-on-monitor' makes a frame on the specified monitor.
-
-*** New value of 'minibuffer' frame parameter 'child-frame'.
-This allows creating and immediately parenting a minibuffer-only child
-frame when making a frame.
-
-*** New predicates 'display-blink-cursor-p' and 'display-symbol-keys-p'.
-These predicates are to be preferred over 'display-graphic-p' when
-testing for blinking cursor capability and the capability to have
-symbols (e.g., '[return]', '[tab]', '[backspace]') as keys respectively.
-
-** Tabulated List mode
-
-*** New user options for tabulated list sort indicators.
-You can now customize which sorting indicator character to display
-near the current column in Tabulated Lists (see user options
-'tabulated-list-gui-sort-indicator-asc',
-'tabulated-list-gui-sort-indicator-desc',
-'tabulated-list-tty-sort-indicator-asc', and
-'tabulated-list-tty-sort-indicator-desc').
-
-*** Two new commands and keystrokes have been added to the tabulated
-list mode: 'w' (which widens the current column) and 'c' which makes
-the current column contract.
-
-*** New function 'tabulated-list-clear-all-tags'.
-This function clears all tags from the padding area in the current
-buffer. Tags are typically added by calling 'tabulated-list-put-tag'.
-
-** Text mode
-
-*** 'text-mode-variant' is now obsolete, use 'derived-mode-p' instead.
-
-** CUA mode
-
-*** New user option 'cua-rectangle-terminal-modifier-key'.
-This user option allows for the customization of the modifier key used
-in a terminal frame.
-
-** JS mode
-
-*** JSX syntax is now automatically detected and enabled.
-If a file imports Facebook's 'React' library, or if the file uses the
-extension ".jsx", then various features supporting XML-like syntax
-will be supported in 'js-mode' and derivative modes. ('js-jsx-mode'
-no longer needs to be enabled.)
-
-*** New user option 'js-jsx-detect-syntax' disables automatic detection.
-This is turned on by default.
-
-*** New user option 'js-jsx-syntax' enables JSX syntax unconditionally.
-This is off by default.
-
-*** New variable 'js-jsx-regexps' controls JSX detection.
+---
+*** New user option 'rmail-re-abbrevs'.
+Its default value matches localized abbreviations of the "reply"
+prefix on the Subject line in various languages.
-*** JSX syntax is now highlighted like SGML.
+** Apropos
-*** JSX code is properly indented in many more scenarios.
-Previously, JSX indentation usually only worked when an element was
-wrapped in parenthesis (e.g. in a 'return' statement or a function
-call). It would also fail in many intricate cases. Now, indentation
-should work anywhere without parenthesis; many more intricacies are
-supported; and, indentation conventions align more closely with those
-of the React developer community (see 'js-jsx-align->-with-<'),
-otherwise still adhering to SGML conventions.
+*** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'.
+These new navigation commands are bound to 'n' and 'p' in
+'apropos-mode'.
-*** New user option 'js-jsx-align->-with-<' controls '>' indents.
-Commonly in JSX code, a '>' on its own line is indented at the same
-level as its opening '<'. This is the new default for JSX. This
-behavior is slightly different than that used by SGML in Emacs, where
-'>' is indented at the same level as attributes, which was also the
-old default for JSX.
+*** New command 'apropos-function'.
+This works like 'C-u M-x apropos-command' but is more discoverable.
-This is turned on by default. To get back the old default indentation
-behavior of aligning '>' with attributes, set 'js-jsx-align->-with-<'
-to nil.
-
-*** Indentation uses 'js-indent-level' instead of 'sgml-basic-offset'.
-Since JSX is a syntax extension of JavaScript, it makes the most sense
-for JSX expressions to be indented the same number of spaces as other
-JS expressions. This is a breaking change, but it probably aligns
-with how you'd expect this indentation to behave. If you want JSX to
-be indented like JS, you won't need to change your config.
-
-The old behavior can be emulated by controlling JSX indentation
-independently of JS, by setting 'js-jsx-indent-level'.
-
-*** New user option 'js-jsx-indent-level' for different JSX indentation.
-If you wish to indent JSX by a different number of spaces than JS, set
-this user option to the desired number.
-
-*** New user option 'js-jsx-attribute-offset' for JSX attribute indents.
-
-*** New variable 'js-syntactic-mode-name' controls mode name display.
-Previously, the mode name was simply 'JavaScript'. Now, when a syntax
-extension like JSX is enabled, the mode name is 'JavaScript[JSX]'.
-Set this variable to nil to disable the new behavior.
-
-*** New function 'js-use-syntactic-mode-name' for deriving modes.
-Packages deriving from 'js-mode' with 'define-derived-mode' should
-call this function to add enabled syntax extensions to their mode
-name, too.
-
-** Autorevert
-
-*** New user option 'auto-revert-avoid-polling' for saving power.
-When set to a non-nil value, buffers in Auto Revert mode are no longer
-polled for changes periodically. This reduces the power consumption
-of an idle Emacs, but may fail on some network file systems; set
-'auto-revert-notify-exclude-dir-regexp' to match files where
-notification is not supported. The default value is nil.
-
-*** New variable 'buffer-auto-revert-by-notification'.
-A major mode can declare that notification on the buffer's default
-directory is sufficient to know when updates are required, by setting
-the new variable 'buffer-auto-revert-by-notification' to a non-nil
-value. Auto Revert mode can use this information to avoid polling the
-buffer periodically when 'auto-revert-avoid-polling' is non-nil.
-
-*** 'global-auto-revert-ignore-buffer' can now also be a predicate
-function that can be used for more fine-grained control of which
-buffers to auto-revert.
-
-** auth-source-pass
-
-*** New user option 'auth-source-pass-filename'.
-Allows setting the path to the password-store, defaults to
-"~/.password-store".
-
-*** New user option 'auth-source-pass-port-separator'.
-Specifies separator between host and port, defaults to colon ":".
-
-*** Minimize the number of decryptions during password lookup.
-This makes the package usable with physical tokens requiring touching
-a sensor for every decryption.
-
-*** 'auth-source-pass-get' is now autoloaded.
-
-** Bookmarks
-
-*** 'bookmark-file' and 'bookmark-old-default-file' are now obsolete
-aliases of 'bookmark-default-file'.
-
-*** New user option 'bookmark-watch-bookmark-file'.
-When non-nil, watch whether the bookmark file has changed on disk.
-
-*** The old bookmark file format is no longer supported.
-This bookmark file format has not been used in Emacs since at least
-version 19.34, released in 1996, and will no longer be automatically
-converted to the new bookmark file format.
-
-The following functions are now declared obsolete:
-'bookmark-grok-file-format-version',
-'bookmark-maybe-upgrade-file-format',
-'bookmark-upgrade-file-format-from-0', and
-'bookmark-upgrade-version-0-alist'.
-
-** The mantemp.el library is now marked obsolete.
-This library generates manual C++ template instantiations. It should
-no longer be useful on modern compilers, which do this automatically.
-
-** Ispell
-
-*** New hook 'ispell-change-dictionary-hook'.
-This runs after changing the dictionary and could be used to
-automatically spellcheck a buffer when changing language without
-needing to advice 'ispell-change-dictionary'.
-
-** scroll-lock
-
-*** New command 'scroll-lock-next-line-always-scroll'.
-This command is bound to 'S-down' and scrolls the buffer up in
-particular when the end of the buffer is visible in the window.
-
-** mwheel.el
-
-*** 'mwheel-install' is now obsolete.
-Use 'mouse-wheel-mode' instead. Note that 'mouse-wheel-mode' is
-already enabled by default on most graphical displays.
-
-** Gravatar
-
-*** 'gravatar-cache-ttl' is now a number of seconds.
-The previously used timestamp format of a list of integers is still
-supported, but is deprecated. The default value has not changed.
-
-*** 'gravatar-size' can now be nil.
-This results in the use of Gravatar's default size of 80 pixels.
-
-*** The default fallback gravatar is now configurable.
-This is possible using the new user options 'gravatar-default-image'
-and 'gravatar-force-default'.
-
-** ada-mode
-
-*** The built-in ada-mode is now deleted. The GNU ELPA package is a
-good replacement, even in very large source files.
-
-** time-stamp
-
-*** New '%5z' conversion for 'time-stamp-format' gives time zone offset.
-Specifying '%5z' in 'time-stamp-format' or 'time-stamp-pattern'
-expands to the time zone offset, e.g., '+0100'. The time zone used is
-specified by 'time-stamp-time-zone'.
-
-Because this feature is new in Emacs 27.1, do not use it in the local
-variables section of any file that might be edited by an older version
-of Emacs.
-
-*** Some conversions recommended for 'time-stamp-format' have changed.
-The new documented/recommended %-conversions are closer to those
-used by 'format-time-string' and are compatible at least as far back
-as Emacs 22.1 (released in 2007).
-
-Uppercase abbreviated day name of week: was %3A, now %#a
-Full day name of week: was %:a, now %:A
-Uppercase abbreviated month name: was %3B, now %#b
-Full month name: was %:b, now %:B
-Four-digit year: was %:y, now %Y
-Lowercase timezone name: was %z, now %#Z
-Fully-qualified host name: was %s, now %Q
-Unqualified host name: (was none), now %q
-Login name: was %u, now %l
-User's full name: was %U, now %L
+** CC Mode
-Merely having '(add-hook 'before-save-hook 'time-stamp)' in your
-Emacs init file does not expose you to this change. However,
-if you set 'time-stamp-format' or 'time-stamp-pattern' with a
-file-local variable, you may need to update the value.
+*** Added support for Doxygen documentation style.
+'doxygen' is now a valid 'c-doc-comment-style' which recognises all
+comment styles supported by Doxygen (namely '///', '//!', '/** … */'
+and '/*! … */'. 'gtkdoc' remains the default for C and C++ modes; to
+use 'doxygen' by default one might evaluate:
+
+ (setq-default c-doc-comment-style
+ '((java-mode . javadoc)
+ (pike-mode . autodoc)
+ (c-mode . doxygen)
+ (c++-mode . doxygen)))
+
+or use it in a custom 'c-style'.
+
+*** Added support to line up '?' and ':' of a ternary operator.
+The new 'c-lineup-ternary-bodies' function can be used as a lineup
+function to align question mark and colon which are part of a ternary
+operator ('?:'). For example:
+
+ return arg % 2 == 0 ? arg / 2
+ : (3 * arg + 1);
+
+To enable, add it to appropriate entries in 'c-offsets-alist', e.g.:
+
+ (c-set-offset 'arglist-cont '(c-lineup-ternary-bodies
+ c-lineup-gcc-asm-reg))
+ (c-set-offset 'arglist-cont-nonempty '(c-lineup-ternary-bodies
+ c-lineup-gcc-asm-reg
+ c-lineup-arglist))
+ (c-set-offset 'statement-cont '(c-lineup-ternary-bodies +))
+
+** browse-url
+
+*** Added support for custom URL handlers.
+There is a new variable 'browse-url-default-handlers' and a user
+option 'browse-url-handlers' being alists with '(REGEXP-OR-PREDICATE
+. FUNCTION)' entries allowing to define different browsing FUNCTIONs
+depending on the URL to be browsed. The variable is for default
+handlers provided by Emacs itself or external packages, the user
+option is for the user (and allows for overriding the default
+handlers).
+
+Formerly, one could do the same by setting
+'browse-url-browser-function' to such an alist. This usage is still
+supported but deprecated.
+
+*** Categorization of browsing commands in internal vs. external.
+All standard browsing commands such as 'browse-url-firefox',
+'browse-url-mail', or 'eww' have been categorized into internal (URL
+is browsed in Emacs) or external (an external application is spawned
+with the URL). This is done by adding a 'browse-url-browser-kind'
+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 the conkeror browser is now obsolete.
+
+*** Support for the Mosaic browser has been removed.
+This support has been obsolete since 25.1.
+
+** SHR
+
+---
+*** The command 'shr-browse-url' now supports custom mailto handlers.
+Clicking on or otherwise following a 'mailto:' link in a HTML buffer
+rendered by SHR previously invoked the command 'browse-url-mailto'.
+This is still the case by default, but if you customize
+'browse-url-mailto-function' or 'browse-url-handlers' to call some
+other function, it will now be called instead of the default.
+
++++
+*** New user option 'shr-max-width'.
+If this user option is non-nil, and 'shr-width' is nil, then SHR will
+use the value of 'shr-max-width' to limit the width of the rendered
+HTML. The default is 120 characters, so even if you have very wide
+frames, HTML text will be rendered more narrowly, which usually leads
+to a more readable text. Set this user option to nil to get the
+previous behavior of rendering as wide as the 'window-width' allows.
+If 'shr-width' is non-nil, it overrides this variable.
+
+** Images
+
+---
+*** Animated images stop automatically under high CPU pressure sooner.
+Previously, an animated image would stop animating if any single image
+took more than two seconds to display. The new algorithm maintains a
+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.
+These commands would previously display the next/previous image in
+alphabetical 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
+mode buffer.
+
+---
+*** 'image-converter' is now restricted to formats in 'auto-mode-alist'.
+When using external image converters, the external program is queried
+for what formats it supports. This list may contain formats that are
+problematic in some contexts (like PDFs), so this list is now filtered
+based on 'auto-mode-alist'. Only file names that map to 'image-mode'
+are now supported.
+
+---
+*** The background and foreground of images now default to face colors.
+When an image doesn't specify a foreground or background color, Emacs
+now uses colors from the face used to draw the surrounding text
+instead of the frame's default colors.
+
+To load images with the default frame colors use the ':foreground' and
+':background' image attributes, for example:
+
+ (create-image "filename" nil nil
+ :foreground (face-attribute 'default :foreground)
+ :background (face-attribute 'default :background))
+
+This change only affects image types that support foreground and
+background colors or transparency, such as xbm, pbm, svg, png and gif.
+
+** EWW
+
++++
+*** New user option 'eww-retrieve-command'.
+This can be used to download data via an external command. If nil
+(the default), then 'url-retrieve' is used.
+
++++
+*** New Emacs command line convenience command.
+The 'eww-browse' command has been added, which allows you to register
+Emacs as a MIME handler for "text/x-uri", and will call 'eww' on the
+supplied URL. Usage example: "emacs -f eww-browse https://gnu.org".
+
++++
+*** 'eww-download-directory' will now use the XDG location, if defined.
+However, if "~/Downloads/" already exists, that will continue to be
+used.
+
+---
+*** The command 'eww-follow-link' now supports custom mailto handlers.
+The function that is invoked when clicking on or otherwise following a
+'mailto:' link in an EWW buffer can now be customized. For more
+information, see the related entry about 'shr-browse-url' above.
+
+** Project
+
+*** New user option 'project-vc-merge-submodules'.
+
+*** Project commands now have their own history.
+Previously used project directories are now suggested by all commands
+that prompt for a project directory.
+
++++
+*** New prefix keymap 'project-prefix-map'.
+Key sequences that invoke project-related commands start with the
+prefix 'C-x p'. Type "C-x p C-h" to show the full list.
+
++++
+*** New commands 'project-dired', 'project-vc-dir', 'project-shell',
+'project-eshell'. These commands run Dired/VC-Dir and Shell/Eshell in
+a project's root directory, respectively.
+
++++
+*** New command 'project-compile'.
+This command runs compilation in the current project's root
+directory.
+
++++
+*** New command 'project-switch-project'.
+This command lets you "switch" to another project and run a project
+command chosen from a dispatch menu.
+
++++
+*** New commands 'project-shell-command' and 'project-async-shell-command'.
+These commands run 'shell-command' and 'async-shell-command' in a
+project's root directory, respectively.
+
++++
+*** New user option 'project-list-file'.
+
+** json.el
+
+---
+*** JSON number parsing is now stricter.
+Numbers with a leading plus sign, leading zeros, or a missing integer
+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.
+
+** xml.el
+
+*** XML serialization functions now reject invalid characters.
+Previously 'xml-print' would produce invalid XML when given a string
+with characters that are not valid in XML (see
+https://www.w3.org/TR/xml/#charsets). Now it rejects such strings.
-** mode-local
+** erc
-*** Declare 'define-overload' and 'define-child-mode' as obsolete.
+---
+*** The '/ignore' command will now ask for a timeout to stop ignoring the user.
+Allowed inputs are seconds or ISO8601-like periods like "1h" or "4h30m".
+
+---
+*** ERC now recognizes 'C-]' for italic text.
+Italic text is displayed in the new 'erc-italic-face'.
+
+---
+*** The erc-compat.el library is now marked obsolete.
+This file contained ERC compatibility code for Emacs 21 and XEmacs
+which is no longer needed.
+
+---
+*** erc-match.el now supports 'message' highlight type (not including the nick).
+The 'erc-current-nick-highlight-type', 'erc-pal-highlight-type',
+'erc-fool-highlight-type', 'erc-keyword-highlight-type', and
+'erc-dangerous-host-highlight-type' variables now support a 'message'
+type for highlighting the entire message but not the sender's nick.
+
+*** erc-status-sidebar.el is now part of ERC.
+The 'erc-status-sidebar' package which provides a HexChat-like
+activity overview sidebar for joined IRC channels is now part of ERC.
+
+** Battery
+
+---
+*** UPower is now the default battery status backend when available.
+UPower support via the function 'battery-upower' was added in Emacs
+26.1, but was disabled by default. It is now the default value of
+'battery-status-function' when the system provides a UPower D-Bus
+service. The user options 'battery-upower-device' and
+'battery-upower-subscribe' control which power sources to query and
+whether to respond to status change notifications in addition to
+polling, respectively.
+
+---
+*** A richer syntax can be used to format battery status information.
+The user options 'battery-mode-line-format' and
+'battery-echo-area-format' now support the full formatting syntax of
+the function 'format-spec' documented under node "(elisp) Custom Format
+Strings". The new syntax includes specifiers for padding and
+truncation, amongst other things.
+
+** bug-reference.el
+
+---
+*** Bug reference mode auto-setup. If 'bug-reference-mode' or
+'bug-reference-prog-mode' have been activated, their respective hook
+has been run and still 'bug-reference-bug-regexp' and
+'bug-reference-url-format' aren't both set, it tries to guess
+appropriate values for those two variables. There are three guessing
+mechanisms so far: based on version control information of the current
+buffer's file, based on newsgroup/mail-folder name and several news
+and mail message headers in Gnus buffers, and based on IRC channel and
+network in rcirc and ERC buffers. All mechanisms are extensible with
+custom rules, see the variables 'bug-reference-setup-from-vc-alist',
+'bug-reference-setup-from-mail-alist', and
+'bug-reference-setup-from-irc-alist'.
+
+** HTML Mode
+
+---
+*** A new skeleton for adding relative URLs has been added.
+It's bound to the 'C-c C-c f' keystroke, and prompts for a local file
+name.
+
+---
+** Recentf
+The recentf files are no longer backed up.
+
+** Calc
+
+---
+*** The behavior when doing forward-delete has been changed.
+Previously, using the 'C-d' command would delete the final number in
+the input field, no matter where point was. This has been changed to
+work more traditionally, with 'C-d' deleting the next character.
+Likewise, point isn't moved to the end of the string before inserting
+digits.
+
+** term-mode
+
+---
+*** New user option 'term-scroll-snap-to-bottom'.
+By default, 'term' and 'ansi-term' will now recenter the buffer so
+that the prompt is on the final line in the window. Setting this new
+user option to nil inhibits this behavior.
+
+---
+*** New user option 'term-set-terminal-size'
+If non-nil, the 'LINES' and 'COLUMNS' environment variables will be set
+based on the current window size. In previous versions of Emacs, this
+was always done (and that could lead to odd displays when resizing the
+window after starting). This variable defaults to nil.
+
+** Miscellaneous
+
+---
+*** 'zap-up-to-char' now uses 'read-char-from-minibuffer'.
+This allows navigating through the history of characters that have
+been input. This is mostly useful for characters that have complex
+input methods where inputting the character again may involve many
+keystrokes.
+
++++
+*** Interactive regular expression search now uses faces for sub-groups.
+E.g., 'C-M-s foo-\([0-9]+\)' will now use the 'isearch-group-odd' face
+on the part of the regexp that matches the sub-expression "[0-9]+".
+The even group matches are highlighted with the 'isearch-group-even' face.
+This is controlled by the 'search-highlight-submatches' user option.
+This feature is available only on terminals that have enough colors to
+distinguish between sub-expression highlighting.
+
+---
+*** New user option 'reveal-auto-hide'.
+If non-nil (the default), revealed text is automatically hidden when
+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 command 'submit-emacs-patch'.
+This works like 'report-emacs-bug', but is more geared towards sending
+patches to the Emacs issue tracker.
+
++++
+*** New minor mode 'button-mode'.
+This minor mode does nothing else than install 'button-buffer-map' as
+a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate
+to buttons), and can be used in any view-mode-like buffer that has
+buttons in it.
+
+---
+*** 'icomplete-show-matches-on-no-input' behavior change.
+Previously, choosing a different completion with commands like 'C-.'
+and then hitting 'RET' would choose the default completion. Doing
+this will now choose the completion under point.
+
++++
+*** The user can now customize how "default" values are prompted for.
+The new utility function 'format-prompt' has been added which uses the
+new 'minibuffer-default-prompt-format' user option to format "default"
+prompts. This means that prompts that look like "Enter a number
+(default 10)" can be customized to look like, for instance, "Enter a
+number [10]", or not have the default displayed at all, like "Enter a
+number". (This requires that all callers are altered to use
+'format-prompt', though.)
+
+---
+*** New 'diff-mode' font locking face 'diff-error'.
+This face is used for error messages from diff.
+
++++
+*** New global mode 'global-goto-address-mode'.
+This will enable 'goto-address-mode' in all buffers.
+
+---
+*** 'C-s' in 'M-x' now searches over completions again.
+In Emacs 23, typing 'M-x' ('read-extended-command') and then 'C-s' (to
+do an interactive search) would search over possible completions.
+This was lost in Emacs 24, but is now back again.
+
+---
+*** 'M-x report-emacs-bug' will no longer include "Recent messages" section.
+These were taken from the "*Messages*" buffer, and may inadvertently
+leak information from the reporting user.
+
+---
+*** 'count-windows' now takes an optional parameter ALL-FRAMES.
+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.
+
+---
+*** Two new commands for centering in 'doc-view-mode'.
+The new commands 'doc-view-center-page-horizontally' (bound to 'c h')
+and 'doc-view-center-page-vertically' (bound to 'c v') center the page
+horizontally and vertically, respectively.
+
+---
+*** Change in meaning of 'icomplete-show-matches-on-no-input'.
+Previously, choosing a different completion with commands like 'C-.'
+and then hitting 'RET' would choose the default completion. Doing this
+will now choose the completion under point instead.
+
+---
+*** The width of the buffer-name column in 'list-buffers' is now dynamic.
+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.
+
+** xwidget-webkit mode
+
+*** New xwidget commands.
+'xwidget-webkit-uri' (return the current URL), 'xwidget-webkit-title'
+(return the current title), and 'xwidget-webkit-goto-history' (goto a
+point in history).
+
+*** Pixel-based scrolling.
+The 'xwidget-webkit-scroll-up', 'xwidget-webkit-scroll-down' commands
+now supports scrolling arbitrary pixel values. It now treats the
+optional 2nd argument as the pixel values to scroll.
+
+*** New commands for scrolling.
+The new commands 'xwidget-webkit-scroll-up-line',
+'xwidget-webkit-scroll-down-line', 'xwidget-webkit-scroll-forward',
+'xwidget-webkit-scroll-backward' can be used to scroll webkit by the
+height of lines or width of chars.
+
+*** New user option 'xwidget-webkit-bookmark-jump-new-session'.
+When non-nil, use a new xwidget webkit session after bookmark jump.
+Otherwise, it will use 'xwidget-webkit-last-session'.
+
+** Flyspell mode
+
++++
+*** Corrections and actions menu can be optionally bound to 'mouse-3'.
+When Flyspell mode highlights a word as misspelled, you can click on
+it to display a menu of possible corrections and actions. You can now
+easily bind this menu to 'down-mouse-3' (usually the right mouse button)
+instead of 'mouse-2' (the default) by customizing the new user option
+'flyspell-use-mouse-3-for-menu'.
+
+---
+*** The current dictionary is now displayed in the minor mode lighter.
+Clicking the dictionary name changes the current dictionary.
+
+** Time
+
+---
+*** 'display-time-world' has been renamed to 'world-clock'.
+'world-clock' creates a buffer with an updating time display using
+several time zones. It is hoped that the new names are more
+discoverable.
+
+The following commands have been renamed:
+
+ 'display-time-world' to 'world-clock'
+ 'display-time-world-mode' to 'world-clock-mode'
+ 'display-time-world-display' to 'world-clock-display'
+ 'display-time-world-timer' to 'world-clock-update'
+
+The following user options have been renamed:
+
+ 'display-time-world-list' to 'world-clock-list'
+ 'display-time-world-time-format' to 'world-clock-time-format'
+ 'display-time-world-buffer-name' to 'world-clock-buffer-name'
+ 'display-time-world-timer-enable' to 'world-clock-timer-enable'
+ 'display-time-world-timer-second' to 'world-clock-timer-second'
+
+The old names are now obsolete.
+
+** D-Bus
+
++++
+*** Property values can be typed explicitly.
+'dbus-register-property' and 'dbus-set-property' accept now optional
+type symbols. Both functions propagate D-Bus errors.
+
++++
+*** Registered properties can have the new access type ':write'.
+
++++
+*** In case of problems, handlers can emit proper D-Bus error messages now.
+
++++
+*** D-Bus errors, which have been converted from incoming D-Bus error
+messages, contain the error name of that message now.
+
+---
+*** D-Bus messages can be monitored with new function 'dbus-register-monitor'.
+
+---
+*** 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
+'dbus-event-*' accessor functions.
-*** Rename several internal functions to use a 'mode-local-' prefix.
+** CPerl Mode
-** CC Mode
+---
+*** The command 'cperl-set-style' offers the new value "PBP".
+This value customizes Emacs to use the style recommended in Damian
+Conway's book "Perl Best Practices" for indentation and formatting
+of conditionals.
-*** You can now flag "wrong style" comments with 'font-lock-warning-face'.
-To do this, use 'c-toggle-comment-style', if needed, to set the desired
-default comment style (block or line); then set the user option
-'c-mark-wrong-style-of-comment' to non-nil.
+** Abbrev mode
-** Mailcap
++++
+*** Emacs can now suggest to use an abbrev based on text you type.
+A new user option, 'abbrev-suggest', enables the new abbrev suggestion
+feature. When enabled, if a user manually types a piece of text that
+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.
-*** The new function 'mailcap-file-name-to-mime-type' has been added.
-It's a simple convenience function for looking up MIME types based on
-file name extensions.
+
+* New Modes and Packages in Emacs 28.1
-*** The default way the list of possible external viewers for MIME
-types is sorted and chosen has changed. Earlier, the most specific
-viewer was chosen, even if there was a general override in "~/.mailcap".
-For instance, if "/etc/mailcap" has an entry for "image/gif", that one
-will be chosen even if you have an entry for "image/*" in your
-"~/.mailcap" file. But with the new method, entries from "~/.mailcap"
-overrides all system and Emacs-provided defaults. To get the old
-method back, set 'mailcap-prefer-mailcap-viewers' to nil.
+** Lisp Data mode
-** MH-E
+The new command 'lisp-data-mode' enables a major mode for buffers
+composed of Lisp symbolic expressions that do not form a computer
+program. The ".dir-locals.el" file is automatically set to use this
+mode, as are other data files produced by Emacs.
-*** The hook 'mh-show-mode-hook' is now called before the message is inserted.
-Functions that want to affect the message text (for example, to change
-highlighting) can no longer use 'mh-show-mode-hook', because the
-message contents will not yet have been inserted when the hook is
-called. Such functions should now be attached to 'mh-show-hook'.
+** hierarchy.el
-** URL
+It's a library to create, query, navigate and display hierarchy structures.
-*** The 'file:' handler no longer looks for "index.html" in
-directories if you ask it for a "file:///dir" URL. Since this is a
-low-level library, such decisions (if they are to be made at all) are
-left to higher-level functions.
+** New themes 'modus-vivendi' and 'modus-operandi'.
+These themes are designed for colour-contrast accessibility. You can
+load the new themes using 'M-x customize-themes' or 'load-theme' from
+your init file.
-* New Modes and Packages in Emacs 27.1
+* Incompatible Editing Changes in Emacs 28.1
-** Tab Bars
+** In 'nroff-mode', 'center-line' is now bound to 'M-o M-s'.
+The original key binding was 'M-s', which interfered with I-search,
+since the latter uses 'M-s' as a prefix key of the search prefix map.
-*** Tab Bar mode
-The new command 'tab-bar-mode' enables the tab bar at the top of each
-frame (including TTY frames), where you can use tabs to switch between
-named persistent window configurations.
-
-The 'C-x t' sequence is the new prefix key for tab-related commands:
-'C-x t 2' creates a new tab; 'C-x t 0' deletes the current tab;
-'C-x t b' switches to buffer in another tab; 'C-x t f' and 'C-x t C-f'
-edit file in another tab; and 'C-TAB' and 'S-C-TAB' switch to the next
-or previous tab. You can also switch between tabs and create/delete
-tabs with a mouse.
-
-Tab-related commands are available even when 'tab-bar-mode' is
-disabled: by default, they enable 'tab-bar-mode' in that case.
-
-The X resource "tabBar", class "TabBar" enables the tab bar
-when its value is "on", "yes" or "1".
-
-The user option 'tab-bar-position' specifies where to show the tab bar.
-
-Tab-related commands can be used even without the tab bar when
-'tab-bar-mode' is disabled by a nil value of the user option
-'tab-bar-show'. Without the tab bar you can switch between tabs
-using completion on tab names, or using 'tab-switcher'.
-
-Read the new Info node "(emacs) Tab Bars" for full description
-of all related features.
-
-*** Tab Line mode
-The new command 'global-tab-line-mode' enables the tab line above each
-window, which you can use to switch buffers in the window. Selecting
-the previous window-local tab is the same as typing 'C-x <LEFT>'
-('previous-buffer'), selecting the next tab is the same as 'C-x <RIGHT>'
-('next-buffer'). Both commands support a numeric prefix argument as
-a repeat count. Clicking on the plus icon adds a new buffer to the
-window-local tab line of buffers. Using the mouse wheel on the tab
-line scrolls tabs.
-
-Read the new Info node "(emacs) Tab Line" for full description
-of all related features.
-
-** fileloop.el lets one setup multifile operations like search&replace.
-
-** Emacs can now visit files in archives as if they were directories.
-This feature uses Tramp and works only on systems which support GVFS,
-i.e. GNU/Linux, roughly spoken. See the node "(tramp) Archive file
-names" in the Tramp manual for full documentation of these facilities.
-
-** New library for writing JSONRPC applications (https://jsonrpc.org).
-The 'jsonrpc' library enables writing Emacs Lisp applications that
-rely on this protocol. Since the protocol is designed to be
-transport-agnostic, the library provides an API to implement new
-transport strategies as well as a separate API to use them. A
-transport implementation for process-based communication, such as is
-used by the Language Server Protocol (LSP), is readily available.
-
-** Backtrace mode improves viewing of Elisp backtraces.
-Backtrace mode adds pretty printing, fontification and ellipsis
-expansion to backtrace buffers produced by the Lisp debugger, Edebug
-and ERT. See the node "(elisp) Backtraces" in the Elisp manual for
-documentation of the new mode and its commands.
-
-** so-long.el helps to mitigate performance problems with long lines.
-When 'global-so-long-mode' has been enabled, visiting a file with very
-long lines will (subject to configuration) cause the user's preferred
-'so-long-action' to be automatically invoked (by default, the buffer's
-major mode is replaced by 'so-long-mode'). In extreme cases this can
-prevent delays of several minutes, and make Emacs responsive almost
-immediately. Type 'M-x so-long-commentary' for full documentation.
+** 'vc-print-branch-log' shows the change log for BRANCH from its root
+directory instead of the default directory.
-* Incompatible Lisp Changes in Emacs 27.1
-
-** Incomplete destructive splicing support has been removed.
-Support for Common Lisp style destructive splicing (",.") was
-incomplete and broken for a long time. It has now been removed.
-
-This means that backquote substitution now works for identifiers
-starting with a period ("."). Consider the following example:
-
- (let ((.foo 42)) `,.foo)
-
-In the past, this would have incorrectly evaluated to '(\,\. foo)',
-but will now instead evaluate to '42'.
-
-** The REGEXP in 'magic-mode-alist' is now matched case-sensitively.
-Likewise for 'magic-fallback-mode-alist'.
-
-** 'add-hook' does not always add to the front or the end any more.
-The replacement of 'append' with 'depth' implies that the function is
-not always added to the very front (when append/depth is nil) or the
-very end (when append/depth is t) any more because other functions on
-the hook may have specified higher/lower depths. This makes it
-possible to control the ordering of functions more precisely, as was
-already possible in 'add-function' and 'advice-add'.
-
-** In 'compilation-error-regexp-alist' the old undocumented feature
-where 'line' could be a function of 2 arguments has been dropped.
-
-** 'define-fringe-bitmap' is always defined, even when Emacs is built
-without any GUI support.
-
-** Just loading a theme's file no longer activates the theme's settings.
-Loading a theme with 'M-x load-theme' still activates the theme, as it
-did before. However, loading the theme's file with 'M-x load-file',
-or using 'require' or 'load' in a Lisp program, doesn't actually apply
-the theme's settings until you either invoke 'M-x enable-theme' or
-type 'M-x load-theme'. (In a Lisp program, calling 'enable-theme' or
-invoking 'load-theme' with NO-ENABLE argument omitted or nil has the
-same effect of activating a theme whose file has been loaded.) The
-special case of the 'user' theme is an exception: it is frequently
-used for ad-hoc customizations, so the settings of that theme are by
-default applied immediately.
-
-The variable 'custom--inhibit-theme-enable' controls this behavior;
-its default value changed in Emacs 27.1.
-
-** The REPETITIONS argument of 'benchmark-run' can now also be a variable.
-
-** Interpretation of relative 'HOME' directory has changed.
-If "$HOME" is set to a relative file name, 'expand-file-name' now
-interprets it relative to the directory where Emacs was started, not
-relative to the 'default-directory' of the current buffer. We recommend
-always setting "$HOME" to an absolute file name, so that its meaning is
-independent of where Emacs was started.
-
-** 'file-name-absolute-p' no longer considers "~foo" to be an absolute
-file name if there is no user named "foo".
-
-** The FILENAME argument to 'file-name-base' is now mandatory and no
-longer defaults to 'buffer-file-name'.
-
-** File metadata primitives now signal an error if I/O, access, or
-other serious errors prevent them from determining the result.
-Formerly, these functions often (though not always) silently returned
-nil. For example, if there is an access error, I/O error or low-level
-integer overflow when getting the attributes of a file F,
-'(file-attributes F)' now signals an error instead of returning nil.
-These functions still behave as before if the only problem is that the
-file does not exist. The affected primitives are
-'directory-files-and-attributes', 'file-acl', 'file-attributes',
-'file-modes', 'file-newer-than-file-p', 'file-selinux-context',
-'file-system-info', and 'set-visited-file-modtime'.
-
-** The function 'eldoc-message' now accepts a single argument.
-Programs that called it with multiple arguments before should pass
-them through 'format' first. Even that is discouraged: for ElDoc
-support, you should set 'eldoc-documentation-function' instead of
-calling 'eldoc-message' directly.
-
-** Old-style backquotes now generate an error.
-They have been generating warnings for a decade. To interpret
-old-style backquotes as new-style, bind the new variable
-'force-new-style-backquotes' to t.
-
-** Defining a Common Lisp structure using 'cl-defstruct' or
-'cl-struct-define' whose name clashes with a builtin type (e.g.,
-'integer' or 'hash-table') now signals an error.
-
-** When formatting a floating-point number as an octal or hexadecimal
-integer, Emacs now signals an error if the number is too large for the
-implementation to format.
-
-** 'logb' now returns infinity when given an infinite or zero argument,
-and returns a NaN when given a NaN. Formerly, it returned an extreme
-fixnum for such arguments.
-
-** Some functions and variables obsolete since Emacs 22 have been removed:
-'archive-mouse-extract', 'assoc-ignore-case', 'assoc-ignore-representation',
-'backward-text-line', 'blink-cursor', 'bookmark-exit-hooks',
-'c-opt-op-identitier-prefix', 'comint-use-prompt-regexp-instead-of-fields',
-'compilation-finish-function', 'count-text-lines', 'cperl-vc-header-alist',
-'custom-face-save-command', 'cvs-display-full-path', 'cvs-fileinfo->full-path',
-'delete-frame-hook', 'derived-mode-class', 'describe-char-after',
-'describe-project', 'desktop-basefilename', 'desktop-buffer-handlers',
-'desktop-buffer-misc-functions', 'desktop-buffer-modes-to-save',
-'desktop-enable', 'desktop-load-default', 'dired-omit-files-p',
-'disabled-command-hook', 'dungeon-mode-map', 'electric-nroff-mode',
-'electric-nroff-newline', 'electric-perl-terminator', 'executing-macro',
-'focus-frame', 'forward-text-line', 'generic-define-mswindows-modes',
-'generic-define-unix-modes', 'generic-font-lock-defaults',
-'goto-address-at-mouse', 'highlight-changes-colours',
-'ibuffer-elide-long-columns', 'ibuffer-hooks', 'ibuffer-mode-hooks',
-'icalendar-convert-diary-to-ical', 'icalendar-extract-ical-from-buffer',
-'imenu-always-use-completion-buffer-p', 'ipconfig-program',
-'ipconfig-program-options', 'isearch-lazy-highlight-cleanup',
-'isearch-lazy-highlight-initial-delay', 'isearch-lazy-highlight-interval',
-'isearch-lazy-highlight-max-at-a-time', 'iswitchb-use-fonts',
-'latin1-char-displayable-p', 'mouse-wheel-click-button',
-'mouse-wheel-down-button', 'mouse-wheel-up-button', 'new-frame',
-'pascal-outline', 'process-kill-without-query',
-'recentf-menu-append-commands-p', 'rmail-pop-password',
-'rmail-pop-password-required', 'savehist-load', 'set-default-font',
-'spam-list-of-processors', 'speedbar-add-ignored-path-regexp',
-'speedbar-buffers-line-path', 'speedbar-ignored-path-expressions',
-'speedbar-ignored-path-regexp', 'speedbar-line-path', 'speedbar-path-line',
-'timer-set-time-with-usecs', 'tooltip-gud-display', 'tooltip-gud-modes',
-'tooltip-gud-toggle-dereference', 'unfocus-frame', 'unload-hook-features-list',
-'update-autoloads-from-directories', 'vc-comment-ring', 'vc-comment-ring-index',
-'vc-comment-search-forward', 'vc-comment-search-reverse',
-'vc-comment-to-change-log', 'vc-diff-switches-list', 'vc-next-comment',
-'vc-previous-comment', 'view-todo', 'x-lost-selection-hooks',
-'x-sent-selection-hooks'.
-
-** Further functions and variables obsolete since Emacs 24 have been removed:
-'default-directory-alist', 'dired-default-directory',
-'dired-default-directory-alist', 'dired-enable-local-variables',
-'dired-hack-local-variables', 'dired-local-variables-file',
-'dired-omit-here-always'.
-
-** Garbage collection no longer treats miscellaneous objects specially;
-they are now allocated like any other pseudovector. As a result, the
-'garbage-collect' and 'memory-use-count' functions no longer return a
-'misc' component, and the 'misc-objects-consed' variable has been
-removed.
-
-** Reversed character ranges are no longer permitted in 'rx'.
-Previously, ranges where the starting character is greater than the
-ending character were silently omitted.
-For example, '(rx (any "@z-a" (?9 . ?0)))' would match '@' only.
-Now, such 'rx' expressions generate an error.
-
-** Internal 'rx' functions and variables have been removed,
-as a consequence of an improved implementation. Packages using
-these should use the public 'rx' and 'rx-to-string' instead.
-'rx-constituents' is still available for compatibility, but the new
-extension mechanism is preferred: 'rx-define', 'rx-let' and
-'rx-let-eval'.
-
-** 'text-mode' no longer sets the value of 'indent-line-function'.
-The global value of 'indent-line-function', which defaults to
-'indent-relative', will no longer be reset locally when turning on
-'text-mode'.
-
-To get back the old behavior, add a function to 'text-mode-hook' which
-performs '(setq-local indent-line-function #'indent-relative)'.
-
-** 'make-process' no longer accepts a non-nil ':stop' key. This has
-never worked reliably, and now causes an error.
-
-** 'eventp' no longer returns non-nil for lists whose car is nil.
-This is consistent with the fact that nil, though a symbol, is not a
-valid event type.
-
-** The obsolete package xesam.el (since Emacs 24) has been removed.
-
-** The XBM image handler now accepts a ':stride' argument, which should
-be specified in image specs representing the entire bitmap as a single
-bool vector.
-
-** 'regexp-quote' may return its argument string.
-If the argument needs no quoting, it can be returned instead of a copy.
-
-** Mouse scroll up and down with control key modifier changes font size.
-Previously, the control key modifier was used to scroll up or down by
-an amount which was close to near a full screen. This is now instead
-available by scrolling with the meta modifier key.
-
-To get the old behavior back, customize the user option
-'mouse-wheel-scroll-amount', or add the following to your init file:
-
-(customize-set-variable 'mouse-wheel-scroll-amount
- '(5 ((shift) . 1) ((control) . nil)))
-
-By default, the font size will be changed in the window that the mouse
-pointer is over. To change this behavior, you can customize the user
-option 'mouse-wheel-follow-mouse'. Note that this will also affect
-scrolling.
-
-** Mouse scroll up and down with control key modifier also works on images
-where it scales the image under the mouse pointer.
-
-** 'help-follow-symbol' now signals 'user-error' if point (or the
-position pointed to by the argument POS) is not in a symbol.
-
-** The options.el library has been removed.
-It was obsolete since Emacs 22.1, replaced by customize.
-
-** The tls.el and starttls.el libraries are now marked obsolete.
-Use of built-in libgnutls based functionality (described in the Emacs
-GnuTLS manual) is recommended instead.
-
-** The url-ns.el library is now marked obsolete.
-This library is used to open configuration files for the long defunct
-web browser Netscape, and is no longer relevant.
+* Incompatible Lisp Changes in Emacs 28.1
+
+** 'set-process-buffer' now updates the process mark.
+The mark will be set to point to the end of the new buffer.
+
++++
+** 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
+properties before returning. This affects things like 'completing-read'.
+
+** 'equal' no longer examines some contents of window configurations.
+Instead, it considers window configurations to be equal only if they
+are 'eq'. To compare contents, use 'compare-window-configurations'
+instead. This change helps fix a bug in 'sxhash-equal', which returned
+incorrect hashes for window configurations and some other objects.
+
+** When its first argument is a string, 'make-text-button' no longer
+modifies the string's text properties; instead, it uses and returns
+a copy of the string. This helps avoid trouble when strings are
+shared or constants.
+
+---
+** The obsolete function 'thread-alive-p' has been removed.
+
+** 'dns-query' now consistently uses Lisp integers to represent integers.
+Formerly it made an exception for integer components of SOA records,
+because SOA serial numbers can exceed fixnum ranges on 32-bit platforms.
+Emacs now supports bignums so this old glitch is no longer needed.
+
+---
+** The new function 'dns-query-asynchronous' has been added.
+It takes the same parameters as 'dns-query', but adds a callback
+parameter.
+
+** The Lisp variables 'previous-system-messages-locale' and
+'previous-system-time-locale' have been removed, as they were created
+by mistake and were not useful to Lisp code.
+
+** The 'load-dangerous-libraries' variable is now obsolete.
+It was used to allow loading Lisp libraries compiled by XEmacs, a
+modified version of Emacs which is no longer actively maintained.
+This is no longer supported, and setting this variable has no effect.
+
++++
+** The macro 'with-displayed-buffer-window' is now obsolete.
+Use macro 'with-current-buffer-window' with action alist entry 'body-function'.
+
+** The metamail.el library is now marked obsolete.
+
+---
+** Some obsolete variable and function aliases in dbus.el have been removed.
+In Emacs 24.3, the variable 'dbus-event-error-hooks' was renamed to
+'dbus-event-error-functions' and the function
+'dbus-call-method-non-blocking' was renamed to 'dbus-call-method'.
+The old names, which were kept as obsolete aliases of the new names,
+have now been removed.
+
+---
+** Some libraries obsolete since Emacs 23 have been removed:
+ledit.el, lmenu.el, lucid.el and old-whitespace.el.
+
+---
+** Some functions and variables obsolete since Emacs 23 have been removed:
+'GOLD-map', 'advertised-xscheme-send-previous-expression',
+'allout-init', 'bookmark-jump-noselect',
+'bookmark-read-annotation-text-func', 'buffer-menu-mode-hook',
+'c-forward-into-nomenclature', 'char-coding-system-table',
+'char-valid-p', 'charset-bytes', 'charset-id', 'charset-list',
+'choose-completion-delete-max-match', 'complete-in-turn',
+'completion-base-size', 'completion-common-substring',
+'crm-minibuffer-complete', 'crm-minibuffer-complete-and-exit',
+'crm-minibuffer-completion-help', 'custom-mode', 'custom-mode-hook',
+'define-mode-overload-implementation', 'detect-coding-with-priority',
+'dirtrack-debug', 'dirtrack-debug-toggle', 'dynamic-completion-table',
+'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',
+'semantic-after-toplevel-bovinate-hook',
+'semantic-before-idle-scheduler-reparse-hooks',
+'semantic-before-toplevel-bovination-hook',
+'semantic-bovinate-from-nonterminal-full',
+'semantic-bovinate-region-until-error', 'semantic-bovinate-toplevel',
+'semantic-bovination-working-type',
+'semantic-decorate-pending-decoration-hooks',
+'semantic-edits-incremental-reparse-failed-hooks',
+'semantic-eldoc-current-symbol-info', 'semantic-expand-nonterminal',
+'semantic-file-token-stream', 'semantic-find-dependency',
+'semantic-find-nonterminal', 'semantic-flex', 'semantic-flex-buffer',
+'semantic-flex-keyword-get', 'semantic-flex-keyword-p',
+'semantic-flex-keyword-put', 'semantic-flex-keywords',
+'semantic-flex-list', 'semantic-flex-make-keyword-table',
+'semantic-flex-map-keywords', 'semantic-flex-token-end',
+'semantic-flex-token-start', 'semantic-flex-token-text',
+'semantic-imenu-bucketize-type-parts',
+'semantic-imenu-expand-type-parts', 'semantic-imenu-expandable-token',
+'semantic-init-db-hooks', 'semantic-init-hooks',
+'semantic-init-mode-hooks', 'semantic-java-prototype-nonterminal',
+'semantic-nonterminal-abstract', 'semantic-nonterminal-full-name',
+'semantic-nonterminal-leaf', 'semantic-nonterminal-protection',
+'semantic-something-to-stream', 'semantic-tag-make-assoc-list',
+'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',
+'term-dynamic-simple-complete', 'tooltip-hook', 'tpu-have-ispell',
+'url-generate-unique-filename', 'url-temporary-directory',
+'vc-arch-command', 'vc-default-working-revision' (variable),
+'vc-mtn-command', 'vc-revert-buffer', 'vc-workfile-version',
+'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font',
+'wisent-lex-make-token-table'.
-* Lisp Changes in Emacs 27.1
-
-** Emacs Lisp integers can now be of arbitrary size.
-Emacs uses the GNU Multiple Precision (GMP) library to support
-integers whose size is too large to support natively. The integers
-supported natively are known as "fixnums", while the larger ones are
-"bignums". The new predicates 'bignump' and 'fixnump' can be used to
-distinguish between these two types of integers.
-
-All the arithmetic, comparison, and logical (a.k.a. "bitwise")
-operations where bignums make sense now support both fixnums and
-bignums. However, note that unlike fixnums, bignums will not compare
-equal with 'eq', you must use 'eql' instead. (Numerical comparison
-with '=' works on both, of course.)
-
-Since large bignums consume a lot of memory, Emacs limits the size of
-the largest bignum a Lisp program is allowed to create. The
-nonnegative value of the new variable 'integer-width' specifies the
-maximum number of bits allowed in a bignum. Emacs signals an integer
-overflow error if this limit is exceeded.
-
-Several primitive functions formerly returned floats or lists of
-integers to represent integers that did not fit into fixnums. These
-functions now simply return integers instead. Affected functions
-include functions like 'encode-char' that compute code-points, functions
-like 'file-attributes' that compute file sizes and other attributes,
-functions like 'process-id' that compute process IDs, and functions like
-'user-uid' and 'group-gid' that compute user and group IDs.
-
-** 'overflow-error' is now documented as a subcategory of 'range-error'.
-Formerly it was undocumented, and was (incorrectly) a subcategory
-of 'domain-error'.
-
-** Time values
-
-*** New function 'time-convert' converts Lisp time values to Lisp
-timestamps of various forms, including a new timestamp form '(TICKS
-. HZ)' where TICKS is an integer and HZ a positive integer denoting a
-clock frequency.
-
-*** Although the default timestamp format is still '(HI LO US PS)',
-it is planned to change in a future Emacs version, to exploit bignums.
-The documentation has been updated to mention that the timestamp
-format may change and that programs should use functions like
-'format-time-string', 'decode-time', and 'time-convert' rather than
-probing the innards of a timestamp directly, or creating a timestamp
-by hand.
-
-*** Decoded (calendrical) timestamps now have subsecond resolution.
-This affects 'decode-time', which generates these timestamps, as well
-as functions like 'encode-time' that accept them. The subsecond info
-is present as a '(TICKS . HZ)' value in the seconds element of a
-decoded timestamp, and 'decode-time' has a new optional FORM argument
-specifying the form of the seconds member. For example, if X is the
-timestamp '(1566009571321878186 . 1000000000)', which represents
-"2019-08-17 02:39:31.321878186 UTC", '(decode-time X t t)' returns
-'((31321878186 . 1000000000) 39 2 17 8 2019 6 nil 0)' instead of the
-traditional '(31 39 2 17 8 2019 6 nil 0)' returned by plain
-'(decode-time X t)'. Although the default FORM is currently
-'integer', which truncates the seconds to an integer and is the
-traditional behavior, this default may change in future Emacs
-versions, so callers requiring an integer should specify FORM
-explicitly.
-
-*** 'encode-time' supports a new API '(encode-time TIME)'.
-The old 'encode-time' API is still supported.
-
-*** A new package to parse ISO 8601 time, date, durations and
-intervals has been added. The main function to use is
-'iso8601-parse', but there's also 'iso8601-parse-date',
-'iso8601-parse-time', 'iso8601-parse-duration' and
-'iso8601-parse-interval'. All these functions return decoded time
-structures, except the final one, which returns three of them (start,
-end and duration).
-
-*** 'time-add', 'time-subtract', and 'time-less-p' now accept
-infinities and NaNs too, and propagate them or return nil like
-floating-point operators do. If both arguments are finite, these
-functions now return exact results instead of rounding in some cases,
-and they also avoid excess precision when that is easy.
-
-*** New function 'time-equal-p' compares time values for equality.
-
-*** 'format-time-string' supports a new conversion specifier flag '+'
-that acts like the '0' flag but also puts a '+' before nonnegative
-years containing more than four digits. This is for compatibility
-with POSIX.1-2017.
-
-*** To access (or alter) the elements of a decoded time value, the
-'decoded-time-second', 'decoded-time-minute', 'decoded-time-hour',
-'decoded-time-day', 'decoded-time-month', 'decoded-time-year',
-'decoded-time-weekday', 'decoded-time-dst' and 'decoded-time-zone'
-accessors can be used.
-
-*** The new functions 'date-days-in-month' (which will say how many
-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
-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
-if it is not known whether daylight saving time is in effect.
-Formerly they were inconsistent: 'encode-time' returned t in this
-situation, whereas 'parse-time-string' returned nil. Now they
-consistently use nil to mean that DST is not in effect, and use -1
-to mean that it is not known whether DST is in effect.
-
-** New macro 'benchmark-progn'.
-This macro works like 'progn', but messages how long it takes to
-evaluate the body forms. The value of the last form is the return
-value.
-
-** New function 'read-char-from-minibuffer'.
-This function works like 'read-char', but uses 'read-from-minibuffer'
-to read a character, so it maintains a history that can be navigated
-via usual minibuffer keystrokes 'M-p'/'M-n'.
-
-** New variables 'set-message-function' and 'clear-message-function'
-can be used to specify functions to show and clear messages that
-normally are displayed in the echo area.
-
-** 'setq-local' can now set an arbitrary number of variables, which
-makes the syntax more like 'setq'.
-
-** 'reveal-mode' can now also be used for more than to toggle between
-invisible and visible: It can also toggle 'display' properties in
-overlays. This is only done on 'display' properties that have the
-'reveal-toggle-invisible' property set.
-
-** 'process-contact' now takes an optional NO-BLOCK argument to allow
-not waiting for a process to be set up.
-
-** New variable 'read-process-output-max' controls sub-process throughput.
-This variable determines how many bytes can be read from a sub-process
-in one read operation. The default, 4096 bytes, was previously a
-hard-coded constant. Setting it to a larger value might enhance
-throughput of reading from sub-processes that produces vast
-(megabytes) amounts of data in one go.
-
-** The new user option 'quit-window-hook' is now run first when
-executing the 'quit-window' command.
-
-** The user options 'help-enable-completion-auto-load',
-'help-enable-auto-load' and 'vhdl-project-auto-load', as well as the
-function 'vhdl-auto-load-project' have been renamed to have "autoload"
-without the hyphen in their names. Obsolete aliases from the old
-names have been added.
-
-** Buttons (created with 'make-button' and related functions) can
-now use the 'button-data' property. If present, the data in this
-property will be passed on to the 'action' function instead of the
-button itself in 'button-activate'.
-
-** 'defcustom' now takes a ':local' keyword that can be either t or
-'permanent', which mean that the variable should be automatically
-buffer-local. 'permanent' also sets the variable's 'permanent-local'
-property.
-
-** The new macro 'with-suppressed-warnings' can be used to suppress
-specific byte-compile warnings.
-
-** The new macro 'ignore-error' is like 'ignore-errors', but takes a
-specific error condition, and will only ignore that condition. (This
-can also be a list of conditions.)
-
-** The new function 'byte-compile-info-message' can be used to output
-informational messages that look pleasing during the Emacs build.
-
-** New 'help-fns-describe-variable-functions' hook.
-It makes it possible to add metadata information to 'describe-variable'.
-
-** i18n (internationalization)
-
-*** 'ngettext' can be used now to return the right plural form
-according to the given numeric value.
-
-** 'inhibit-null-byte-detection' is renamed to 'inhibit-nul-byte-detection'.
-
-** 'self-insert-command' takes the char to insert as (optional) argument.
-
-** 'lookup-key' can take a list of keymaps as argument.
-
-** 'condition-case' now accepts t to match any error symbol.
-
-** New function 'proper-list-p'.
-Given a proper list as argument, this predicate returns its length;
-otherwise, it returns nil. 'format-proper-list-p' is now an obsolete
-alias for the new function.
-
-** 'define-minor-mode' automatically documents the meaning of ARG.
-
-** The function 'recenter' now accepts an additional optional argument.
-By default, calling 'recenter' will not redraw the frame even if
-'recenter-redisplay' is non-nil. Call 'recenter' with the new second
-argument non-nil to force redisplay per 'recenter-redisplay's value.
-
-** New functions 'major-mode-suspend' and 'major-mode-restore'.
-Use them when switching temporarily to another major mode, e.g. for
-'hexl-mode', or to switch between 'c-mode' and 'image-mode' in XPM.
-
-** New macro 'dolist-with-progress-reporter'.
-This works like 'dolist', but reports progress similar to
-'dotimes-with-progress-reporter'.
-
-** New hook 'after-delete-frame-functions'.
-This works like 'delete-frame-functions', but runs after the frame to
-be deleted has been made dead and removed from the frame list.
-
-** The function 'provided-mode-derived-p' was extended to support aliases.
-The function now returns non-nil when the argument MODE is derived
-from any alias of any of MODES.
-
-** New frame focus state inspection interface.
-The hooks 'focus-in-hook' and 'focus-out-hook' are now obsolete.
-Instead, attach to 'after-focus-change-function' using 'add-function'
-and inspect the focus state of each frame using 'frame-focus-state'.
-
-** Emacs now requests and recognizes focus-change notifications from TTYs.
-On terminal emulators that support the feature, Emacs can now support
-'focus-in-hook' and 'focus-out-hook' for TTY frames.
-
-** Window-specific face remapping.
-Face specifications (of the kind used in 'face-remapping-alist')
-now support filters, allowing faces to vary between different windows
-displaying the same buffer. See the node "(elisp) Face Remapping"
-of the Emacs Lisp Reference manual for more detail.
-
-** Window change functions have been redesigned.
-Hooks reacting to window changes run now only when redisplay detects
-that a change has actually occurred. Six hooks are now provided:
-'window-buffer-change-functions' (run after window buffers have
-changed), 'window-size-change-functions' (run after a window was
-assigned a new buffer or size), 'window-configuration-change-hook'
-(like the former but run also when a window was deleted),
-'window-selection-change-functions' (run when the selected window
-changed) and 'window-state-change-functions' and
-'window-state-change-hook' (run when any of the preceding ones is
-run). Applications can enforce running the latter two using the new
-function 'set-frame-window-state-change'. 'window-scroll-functions'
-are unaffected by these changes.
-
-In addition, a number of functions now allow the caller to detect what
-has changed since last redisplay: 'window-old-buffer' returns for any
-window the buffer it showed at that time. 'old-selected-window' and
-'old-selected-frame' return the window and frame that were selected
-during last redisplay. 'window-old-pixel-width' (renamed from
-'window-pixel-width-before-size-change'), 'window-old-pixel-height'
-(renamed from 'window-pixel-height-before-size-change'),
-'window-old-body-pixel-width' and 'window-old-body-pixel-height'
-return the total and body sizes of any window during last redisplay.
-
-Also 'run-window-configuration-change-hook' is declared obsolete.
-
-See the section "(elisp) Window Hooks" in the Elisp manual for a
-detailed explanation of the new behavior.
-
-** Scroll bar and fringe settings can now be made persistent for windows.
-The functions 'set-window-scroll-bars' and 'set-window-fringes' now
-have a new optional argument that makes the settings they produce
-reliably survive subsequent invocations of 'set-window-buffer'.
-
-** New user option 'resize-mini-frames'.
-This option allows automatically resizing minibuffer-only frames
-similarly to how minibuffer windows are resized on "normal" frames.
-
-** New buffer display action function 'display-buffer-in-direction'.
-This function allows specifying the location of the window chosen by
-'display-buffer' in various ways.
-
-** New buffer display action alist entry 'dedicated'.
-Such an entry allows specifying the dedicated status of a window
-created by 'display-buffer'.
-
-** New buffer display action alist entry 'window-min-height'.
-Such an entry allows specifying a minimum height of the window used
-for displaying a buffer. 'display-buffer-below-selected' is the only
-action function to respect it at the moment.
-
-** New buffer display action alist entry 'direction'.
-This entry is used to specify the location of the window chosen by
-'display-buffer-in-direction'.
-
-** Additional meaning of display action alist entry 'window'.
-A 'window' entry can now also specify a reference window for
-'display-buffer-in-direction'.
-
-** The function 'assoc-delete-all' now takes an optional predicate argument.
-
-** New function 'string-distance' to calculate the Levenshtein distance
-between two strings.
-
-** 'print-quoted' now defaults to t, so if you want to see
-'(quote x)' instead of 'x you will have to bind it to nil where applicable.
-
-** Numbers formatted via '%o' or '%x' are now formatted as signed integers.
-This avoids problems in calls like '(read (format "#x%x" -1))', and is
-more compatible with bignums. To get the traditional machine-dependent
-behavior, set the experimental variable 'binary-as-unsigned' to t,
-and if the new behavior breaks your code please email
-<32252@debbugs.gnu.org>. Because '%o' and '%x' can now format signed
-integers, they now support the '+' and space flags.
-
-** In Emacs Lisp mode, symbols with confusable quotes are highlighted.
-For example, the first character in '‘foo' would be highlighted in
-'font-lock-warning-face'.
-
-** Omitting variables after '&optional' and '&rest' is now allowed.
-For example '(defun foo (&optional))' is no longer an error. This is
-sometimes convenient when writing macros. See the ChangeLog entry
-titled "Allow '&rest' or '&optional' without following variable
-(Bug#29165)" for a full listing of which arglists are accepted across
-versions.
-
-** Internal parsing commands now use 'syntax-ppss' and disregard
-'open-paren-in-column-0-is-defun-start'. This affects mostly things like
-'forward-comment', 'scan-sexps', and 'forward-sexp' when parsing backward.
-The new variable 'comment-use-syntax-ppss' can be set to nil to recover
-the old behavior if needed.
-This also means that there is no longer any need to precede opening
-brackets at the start of a line inside documentation strings with a
-backslash, although there is no harm in doing so to make the code
-easier to edit with an older Emacs version.
-
-** New symbolic accessor functions for a parse state list.
-The new accessor functions 'ppss-depth', 'ppss-list-start',
-'ppss-last-sexp-start', 'ppss-string-terminator', 'comment-depth',
-'quoted-p', 'comment-style', 'comment-or-string-start', 'open-parens',
-and 'two-character-syntax' can be used on the list value returned by
-'parse-partial-sexp' and 'syntax-ppss'.
-
-** The 'server-name' and 'server-socket-dir' variables are set when a
-socket has been passed to Emacs.
-
-** The 'file-system-info' function is now available on all platforms.
-instead of just Microsoft platforms. This fixes a 'get-free-disk-space'
-bug on OS X 10.8 and later.
-
-** The function 'get-free-disk-space' returns now a non-nil value for
-remote systems, which support this check.
-
-** 'memory-limit' now returns a better estimate of memory consumption.
-
-** When interpreting 'gc-cons-percentage', Emacs now estimates the
-heap size more often and (we hope) more accurately. E.g., formerly
-'(progn (let ((gc-cons-percentage 0.8)) BODY1) BODY2)' continued to use
-the 0.8 value during BODY2 until the next garbage collection, but that
-is no longer true. Applications may need to re-tune their GC tricks.
-
-** New macro 'combine-change-calls' arranges to call the change hooks
-('before-change-functions' and 'after-change-functions') just once
-each around a sequence of lisp forms, given a region. This is
-useful when a function makes a possibly large number of repetitive
-changes and the change hooks are time consuming.
-
-** 'eql', 'make-hash-table', etc. now treat NaNs consistently.
-Formerly, some of these functions ignored signs and significands of
-NaNs. Now, all these functions treat NaN signs and significands as
-significant. For example, '(eql 0.0e+NaN -0.0e+NaN)' now returns nil
-because the two NaNs have different signs; formerly it returned t.
-Also, Emacs now reads and prints NaN significands; e.g., if X is a
-NaN, '(format "%s" X)' now returns "0.0e+NaN", "1.0e+NaN", etc.,
-depending on X's significand.
-
-** The function 'make-string' accepts an additional optional argument.
-If the optional third argument is non-nil, 'make-string' will produce
-a multibyte string even if its second argument is an ASCII character.
-
-** '(format "%d" X)' no longer mishandles a floating-point number X that
-does not fit in a machine integer.
-
-** New coding-system 'ibm038'.
-This is the International EBCDIC encoding, also available as aliases
-'ebcdic-int' and 'cp038'.
-
-** New JSON parsing and serialization functions 'json-serialize',
-'json-insert', 'json-parse-string', and 'json-parse-buffer'. These
-are implemented in C using the Jansson library.
-
-** New function 'ring-resize'.
-'ring-resize' can be used to grow or shrink a ring.
-
-** New function 'flatten-tree'.
-'flatten-list' is provided as an alias. These functions take a tree
-and 'flatten' it such that the result is a list of all the terminal
-nodes.
-
-** 'zlib-decompress-region' can partially decompress corrupted data.
-If the new optional ALLOW-PARTIAL argument is passed, then the data
-that was decompressed successfully before failing will be inserted
-into the buffer.
-
-** Image mode
-
-*** New library Exif.
-An Exif library has been added that can parse JPEG files and output
-data about creation times and orientation and the like.
-'exif-parse-file' and 'exif-parse-buffer' are the main interface
-functions.
-
-*** 'image-mode' now uses this library to automatically rotate images
-according to the orientation in the Exif data, if any.
-
-*** The command 'image-rotate' now accepts a prefix argument.
-With a prefix argument, 'image-rotate' now rotates the image at point
-90 degrees counter-clockwise, instead of the default clockwise.
-
-*** In 'image-mode' the image is resized automatically to fit in window.
-By default, the image will resize upon first display and whenever the
-window's dimensions change. Two user options 'image-auto-resize' and
-'image-auto-resize-on-window-resize' control the resizing behavior
-(including the possibility to disable auto-resizing). A new prefix
-key 's' contains the commands that can be used to fit the image to the
-window manually.
-
-*** Some 'image-mode' variables are now buffer-local.
-The image parameters 'image-transform-rotation',
-'image-transform-scale' and 'image-transform-resize' are now declared
-buffer-local, so each buffer could have its own values for these
-parameters.
-
-*** Three new 'image-mode' commands have been added: 'm', which marks
-the file in the dired buffer(s) for the directory the file is in; 'u',
-which unmarks the file; and 'w', which pushes the current buffer's file
-name to the kill ring.
-
-*** New library image-converter.
-If you need to view exotic image formats for which Emacs doesn't have
-native support, customize the new user option
-'image-use-external-converter' to t. If your system has
-GraphicsMagick, ImageMagick or 'ffmpeg' installed, they will then be
-used to convert images automatically before displaying them.
-
-*** 'auto-mode-alist' now includes many of the types typically
-supported by the external image converters, like WEPB, BMP and ICO.
-These now default to using 'image-mode'.
-
-*** 'imagemagick-types-inhibit' disables using ImageMagick by default.
-'image-mode' started using ImageMagick by default for all images
-some years back. It now respects 'imagemagick-types-inhibit' as a way
-to disable that.
-
-** Modules
-
-*** The function 'load' now behaves correctly when loading modules.
-Specifically, it puts the module name into 'load-history', prints
-loading messages if requested, and protects against recursive loads.
-
-*** New module environment function 'process_input' to process user
-input while module code is running.
-
-*** New module environment functions 'make_time' and 'extract_time' to
-convert between timespec structures and Emacs Lisp time values.
-
-*** New module environment functions 'make_big_integer' and
-'extract_big_integer' to create and extract arbitrary-size integer
-values.
-
-*** emacs-module.h now defines a macro 'EMACS_MAJOR_VERSION' that expands
-to the major version of the latest Emacs supported by the header.
-
-** The function 'read-variable' now uses its own history list.
-The history of variable names read by 'read-variable' is recorded in
-the new variable 'custom-variable-history'.
-
-** The functions 'string-to-unibyte' and 'string-to-multibyte' are no
-longer declared obsolete. We have found that there are legitimate use
-cases for these functions, where there's no better alternative. We
-believe that the incorrect uses of these functions all but disappeared
-by now, so we are un-obsoleting them.
-
-** New function 'group-name' returns a group name corresponding to GID.
-
-** 'make-process' now takes a keyword argument ':file-handler'; if
-that is non-nil, it will look for a file name handler for the current
-buffer's 'default-directory' and invoke that file name handler to make
-the process. That way 'make-process' can start remote processes.
-
-** '(locale-info 'paper)' now returns the paper size on systems that support it.
-This is currently supported on GNUish hosts and on modern versions of
-MS-Windows.
-
-** The function 'regexp-opt', when given an empty list of strings, now
-returns a regexp that never matches anything, which is an identity for
-this operation. Previously, the empty string was returned in this
-case.
-
-** New constant 'regexp-unmatchable' contains a never-matching regexp.
-It is a convenient and readable way to specify a regexp that should
-not match anything, and is as fast as any such regexp can be.
-
-** New functions to handle the URL variant of base-64 encoding.
-New functions 'base64url-encode-string' and 'base64url-encode-region'
-implement the url-variant of base-64 encoding as defined in RFC4648.
-
-The functions 'base64-decode-string' and 'base64-decode-region' now
-accept an optional argument to decode the URL variant of base-64
-encoding.
-
-** The function 'file-size-human-readable' accepts more optional arguments.
-The new third argument is a string put between the number and unit; it
-defaults to the empty string. The new fourth argument is a string
-representing the unit to use; it defaults to "B" when the second
-argument is 'iec' and the empty string otherwise. We recommend a
-space or non-breaking space as third argument, and "B" as fourth
-argument, circumstances allowing.
-
-** 'format-spec' has been expanded with several modifiers to allow
-greater flexibility when customizing variables. The modifiers include
-zero-padding, upper- and lower-casing, and limiting the length of the
-interpolated strings. The function has now also been documented in
-the Emacs Lisp manual.
-
-** 'directory-files-recursively' can now take an optional PREDICATE
-parameter to control descending into subdirectories, and a
-FOLLOW-SYMLINK parameter to say that symbolic links that point to
-other directories should be followed.
-
-** New function 'xor' returns the boolean exclusive-or of its args.
-The function was previously defined in array.el, but has been moved to
-subr.el so that it is available by default. It now always returns the
-non-nil argument when the other is nil. Several duplicates of 'xor'
-in other packages are now obsolete aliases of 'xor'.
-
-** 'define-globalized-minor-mode' now takes BODY forms.
-
-** New text property 'help-echo-inhibit-substitution'.
-Setting this on the first character of a help string disables
-conversions via 'substitute-command-keys'.
-
-** New text property 'minibuffer-message'.
-Setting this on a character of the minibuffer text will display the
-temporary echo messages before that character, when messages need to
-be displayed while minibuffer is active.
-
-** 'undo' can be made to ignore the active region for a command
-by setting 'undo-inhibit-region' symbol property of that command to
-non-nil. This is used by 'mouse-drag-region' to make the effect
-easier to undo immediately afterwards.
-
-** When called interactively, 'next-buffer' and 'previous-buffer' now
-signal 'user-error' if there is no buffer to switch to.
+* Lisp Changes in Emacs 28.1
+
++++
+*** New command 'make-directory-autoloads'.
+This does the same as the old command 'update-directory-autoloads',
+but has different semantics: Instead of passing in the output file via
+the dynamically bound 'generated-autoload-file' variable, the output
+file is now a explicit parameter.
+
++++
+*** New function 'string-search'.
+This function takes two string parameters and returns the position of
+the first instance of the former string in the latter.
+
++++
+*** New function 'string-replace'.
+This function works along the line of 'replace-regexp-in-string', but
+matching on strings instead of regexps, and does not change the global
+match state.
+
++++
+*** New function 'process-lines-ignore-status'.
+This is like 'process-lines', but does not signal an error if the
+return status is non-zero. 'process-lines-handling-status' has also
+been added, and takes a callback to handle the return status.
+
+---
+*** 'ascii' is now a coding system alias for 'us-ascii'.
+
++++
+*** New function 'file-backup-file-names'.
+This function returns the list of file names of all the backup files
+of its file argument.
+
++++
+** The 'count-lines' function now takes an optional parameter to
+ignore invisible lines.
+
+---
+** 'count-words' now crosses field boundaries.
+Originally, 'count-words' would stop counting at the first field
+boundary it encountered; now it keeps counting all the way to the
+region's (or buffer's) end.
+
+---
+** New function 'custom-add-choice'.
+This function can be used by modes to add elements to the
+'choice' customization type of a variable.
+
++++
+** New function 'file-modes-number-to-symbolic' to convert a numeric
+file mode specification into symbolic form.
+
+** New macro 'dlet' to dynamically bind variables.
+
+** The variable 'force-new-style-backquotes' has been removed.
+This removes the final remaining trace of old-style backquotes.
+
+** The module header 'emacs-module.h' now contains type aliases
+'emacs_function' and 'emacs_finalizer' for module functions and
+finalizers, respectively.
+
+** Module functions can now be made interactive.
+Use 'make_interactive' to give a module function an interactive
+specification.
+
+** Module functions can now install an optional finalizer that is
+called when the function object is garbage-collected. Use
+'set_function_finalizer' to set the finalizer and
+'get_function_finalizer' to retrieve it.
+
+** Modules can now open a channel to an existing pipe process using
+the new module function 'open_channel'. Modules can use this
+functionality to asynchronously send data back to Emacs.
+
+** 'file-modes', 'set-file-modes', and 'set-file-times' now have an
+optional argument specifying whether to follow symbolic links.
+
+** 'parse-time-string' can now parse ISO 8601 format strings,
+such as "2020-01-15T16:12:21-08:00".
+
+---
+** The new function 'decoded-time-period' has been added.
+It interprets a decoded time structure as a period and returns the
+equivalent period in seconds.
+
++++
+** The new function 'dom-remove-attribute' has been added.
+
++++
+** The new function 'dom-print' has been added.
+
+---
+** 'make-network-process', 'make-serial-process' ':coding' behavior change.
+Previously, passing ':coding nil' to either of these functions would
+override any non-nil binding for 'coding-system-for-read' and
+'coding-system-for-write'. For consistency with 'make-process' and
+'make-pipe-process', passing ':coding nil' is now ignored. No code in
+Emacs depended on the previous behavior; if you really want the
+process' coding-system to be nil, use 'set-process-coding-system'
+after the process has been created, or pass in ':coding '(nil nil)'.
+
++++
+** 'open-network-stream' now accepts a ':coding' argument.
+This allows specifying the coding systems used by a network process
+for encoding and decoding without having to bind
+'coding-system-for-{read,write}' or call 'set-process-coding-system'.
+
++++
+** 'open-network-stream' can now take a ':capability-command' that's a function.
+The function is called with the greeting from the server as its only
+parameter, and allows sending different TLS capability commands to the
+server based on that greeting.
+
++++
+** 'open-gnutls-stream' now also accepts a ':coding' argument.
+
++++
+** New user option 'process-file-return-signal-string'.
+It controls, whether 'process-file' returns a string when a remote
+process is interrupted by a signal.
+
++++
+** The behavior of 'format-spec' is now closer to that of 'format'.
+In order for the two functions to behave more consistently,
+'format-spec' now pads and truncates based on string width rather than
+length, and also supports format specifications that include a
+truncating precision field, such as "%.2a".
+
+---
+** New function 'color-values-from-color-spec'.
+This can be used to parse RGB color specs in several formats and
+convert them to a list '(R G B)' of primary color values.
+
+---
+** User option 'uniquify-buffer-name-style' can now be a function.
+This user option can be one of the predefined styles or a function to
+personalize the uniquified buffer name.
+
-* Changes in Emacs 27.1 on Non-Free Operating Systems
-
-** Battery status is now supported in all Cygwin builds.
-Previously it was supported only in the Cygwin-w32 build.
-
-** Emacs now handles key combinations involving the macOS "command"
-and "option" modifier keys more correctly.
-
-** MacOS modifier key behavior is now more adjustable.
-The behavior of the macOS "Option", "Command", "Control" and
-"Function" keys can now be specified separately for use with
-ordinary keys, function keys and mouse clicks. This allows using them
-in their standard macOS way for composing characters.
-
-** The special handling of 'frame-title-format' on NS where setting it
-to t would enable the macOS proxy icon has been replaced with a
-separate variable, 'ns-use-proxy-icon'. 'frame-title-format' will now
-work as on other platforms.
-
-** New primitive 'w32-read-registry'.
-This primitive lets Lisp programs access the MS-Windows Registry by
-retrieving values stored under a given key. It is intended to be used
-for supporting features such as XDG-like location of important files
-and directories.
-
-** The default value of 'w32-pipe-read-delay' is now zero.
-This speeds up reading output from sub-processes that produce a lot of
-data.
-
-This variable may need to be non-zero only when running DOS programs
-as Emacs subprocesses, which by now is not supported on modern
-versions of MS-Windows. Set this variable to 50 if for some reason
-you need the old behavior (and please report such situations to Emacs
-developers).
-
-** New variable 'w32-multibyte-code-page'.
-This variable holds the value of the multibyte code page used by the
-system. It is usually zero, which indicates that 'w32-ansi-code-page'
-is being used, except in Far Eastern locales. When this variable is
-non-zero, Emacs at startup sets 'locale-coding-system' to the
-corresponding encoding, instead of using 'w32-ansi-code-page'.
-
-** The default value of 'inhibit-compacting-font-caches' is t on MS-Windows.
-Experience shows that compacting font caches causes more trouble on
-MS-Windows than it helps.
-
-** Font lookup on MS-Windows was improved to support rare scripts.
-To activate the improvement, run the new function
-'w32-find-non-USB-fonts' once per Emacs session, or assign to the new
-variable 'w32-non-USB-fonts' the list of scripts and the corresponding
-fonts. See the documentation of this function and variable in the
-Emacs manual for more details.
-
-** On NS the behavior of drag and drop can now be modified by use of
-modifier keys in line with Apples guidelines. This makes the drag and
-drop behavior more consistent, as previously the sending application
-was able to 'set' modifiers without the knowledge of the user.
-
-** On NS multicolor font display is enabled again since it is also
-implemented in Emacs on free operating systems via Cairo drawing.
+* Changes in Emacs 28.1 on Non-Free Operating Systems
+
+---
+** On macOS, Xwidget is now supported.
+If Emacs was built with xwidget support, you can access the embedded
+webkit browser with 'M-x xwidget-webkit-browse-url'. Viewing two
+instances of xwidget webkit is not supported.
+
+*** Downloading files from xwidget-webkit is now supported.
+The new variable 'xwidget-webkit-download-dir' says where to download to.
+
+*** New functions for xwidget-webkit mode
+'xwidget-webkit-clone-and-split-below',
+'xwidget-webkit-clone-and-split-right'.
+
+*** New variable 'xwidget-webkit-enable-plugins'.
+
++++
+** On macOS, Emacs can now load dynamic modules with a ".dylib" suffix.
+'module-file-suffix' now has the value ".dylib" on macOS, but the
+".so" suffix is supported as well.
+
++++
+** On MS-Windows, Emacs can now toggle the IME.
+A new function 'w32-set-ime-open-status' can now be used to disable
+and enable the MS-Windows native Input Method Editor (IME) at run
+time. A companion function 'w32-get-ime-open-status' returns the
+current IME activation status.
+
++++
+** On MS-Windows, Emacs can now use the native image API to display images.
+Emacs can now use the MS-Windows GDI+ library to load and display
+images in JPEG, PNG, GIF and TIFF formats. This support is enabled
+unless Emacs was configured '--without-native-image-api'.
+
+This feature is experimental, and needs to be turned on to be used.
+To turn this on, set the variable 'w32-use-native-image-API' to a
+non-nil value. Please report any bugs you find while using the native
+image API via 'M-x report-emacs-bug'.
+
+---
+** The user option 'make-pointer-invisible' is now honored on macOS.
----------------------------------------------------------------------
diff --git a/etc/NEWS.27 b/etc/NEWS.27
new file mode 100644
index 00000000000..149bd32fc01
--- /dev/null
+++ b/etc/NEWS.27
@@ -0,0 +1,3210 @@
+GNU Emacs NEWS -- history of user-visible changes.
+
+Copyright (C) 2017-2020 Free Software Foundation, Inc.
+See the end of the file for license conditions.
+
+Please send Emacs bug reports to 'bug-gnu-emacs@gnu.org'.
+If possible, use 'M-x report-emacs-bug'.
+
+This file is about changes in Emacs version 27.
+
+See file HISTORY for a list of GNU Emacs versions and release dates.
+See files NEWS.26, NEWS.25, ..., NEWS.18, and NEWS.1-17 for changes
+in older Emacs versions.
+
+You can narrow news to a specific version by calling 'view-emacs-news'
+with a prefix argument or by typing 'C-u C-h C-n'.
+
+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.1
+
+** Emacs now uses GMP, the GNU Multiple Precision library.
+By default, if 'configure' does not find a suitable libgmp, it
+arranges for the included mini-gmp library to be built and used.
+The new configure option '--without-libgmp' uses mini-gmp even if a
+suitable libgmp is available.
+
+** Emacs can now use HarfBuzz as its shaping engine.
+The new configure option '--with-harfbuzz' adds support for the
+HarfBuzz text shaping engine. It is on by default; use './configure
+--without-harfbuzz' to build without it. The HarfBuzz text shaping is
+available via new font backend drivers 'xfthb' and 'ftcrhb' for Xft
+and Cairo drawings, respectively, and via the 'harfbuzz' backend on
+MS-Windows. The HarfBuzz text shaping is preferred to the previously
+supported ones, so the font backends that use older shaping engines
+(FLT on GNU and Unix systems and Uniscribe on MS-Windows) are not
+enabled by default; they can be enabled via the 'font-backend' frame
+parameter or via X resources.
+
+** The new configure option '--with-json' adds native support for JSON.
+This uses the Jansson library. The option is on by default; use
+'./configure --with-json=no' to build without Jansson support. The
+new JSON functions 'json-serialize', 'json-insert',
+'json-parse-string', and 'json-parse-buffer' are typically much faster
+than their Lisp counterparts from json.el.
+
+** The configure option '--with-cairo' is no longer experimental.
+This builds Emacs with Cairo drawing, and supports built-in printing
+when Emacs is built with GTK+. Some severe bugs in this build were
+fixed, and we can therefore offer this to users without caveats. Note
+that building with Cairo enabled results in using Pango instead of
+libXft for font support, and that Pango 1.44 has removed support for
+bitmapped fonts.
+
+** Emacs now uses a "portable dumper" instead of unexec.
+This improves compatibility with memory allocation on modern systems,
+and in particular better supports the Address Space Layout
+Randomization (ASLR) feature, a security technique used by most modern
+operating systems.
+
+When built with the portable dumping support (which is the default),
+Emacs looks for the "emacs.pdmp" file, generated during the build, in
+its data directory at startup, and loads the dumped state from there.
+The new command-line argument '--dump-file=FILE' allows specifying a
+non-default ".pdmp" file to load the state from; see the node
+"(emacs) Initial Options" in the Emacs manual for more information.
+
+An Emacs started via a dump file can create a new dump file only if it
+was invoked with the '-batch' option. (This is a temporary
+limitation; we plan on lifting it in a future release.)
+
+Although the portable dumper has been tested, it may have a bug on
+unusual platforms. If you require traditional unexec dumping you can
+use the configure-time option '--with-dumping=unexec'; however, please
+file a bug report describing the situation, as unexec dumping is
+deprecated, and we plan on removing it in some future release.
+
+** The new configure option '--enable-checking=structs' attempts to
+check that the portable dumper code has been updated to match the last
+change to one of the data structures that it relies on.
+
+** The configure options '--enable-checking=conslist' and
+'--enable-checking=xmallocoverrun' have been withdrawn. The former
+made Emacs irredeemably slow, and the latter made it crash. Neither
+option was useful with modern debugging tools such as AddressSanitizer.
+(See "etc/DEBUG" for the details of using the modern replacements of the
+removed configure options.)
+
+** Emacs no longer defaults to using ImageMagick to display images.
+This is due to security and stability concerns with ImageMagick. To
+override the default, use 'configure --with-imagemagick'.
+
+** Several configure options now accept an option-argument 'ifavailable'.
+For example, './configure --with-xpm=ifavailable' now configures Emacs
+to attempt to use libxpm but to continue building even if libxpm is
+absent. The other affected options are '--with-gif', '--with-gnutls',
+'--with-jpeg', '--with-png', and '--with-tiff'.
+
+** The 'etags' program now uses the C library's regular expression matcher.
+If it's possible, 'etags' will use the regexp matcher from the
+system's standard C library, otherwise it will be linked with a
+compatible regex substitute. This lets developers maintain Emacs's
+own regex code without having to also support other programs. The new
+configure option '--without-included-regex' forces 'etags' to use the C
+library's regex matcher even if the regex substitute ordinarily would
+be used to work around compatibility problems.
+
+** Emacs has been ported to the '-fcheck-pointer-bounds' option of GCC.
+This causes Emacs to check bounds of some arrays addressed by its
+internal pointers, which can be helpful when debugging the Emacs
+interpreter or modules that it uses. If your platform supports it you
+can enable it when configuring, e.g., './configure CFLAGS="-g3 -O2
+-mmpx -fcheck-pointer-bounds"' on Intel MPX platforms.
+
+** Emacs now normally uses a C pointer type instead of a C integer
+type to implement Lisp_Object, which is the fundamental machine word
+type internal to the Emacs Lisp interpreter. This change aims to
+catch typos and supports '-fcheck-pointer-bounds'. The configure
+option '--enable-check-lisp-object-type' is therefore no longer as
+useful and so is no longer enabled by default in developer builds,
+to reduce differences between developer and production builds.
+
+** The distribution tarball now has test cases; 'make check' runs them.
+This is intended mostly to help developers.
+
+** Emacs now requires GTK 2.24 and GTK 3.10 for the GTK 2 and GTK 3
+builds respectively.
+
+** New make target 'help' shows a summary of common make targets.
+
+** Emacs now builds with dynamic module support by default.
+Pass '--without-modules' to 'configure' to disable dynamic module
+support.
+
+** The ftx font backend driver is now obsolete and will be removed in
+Emacs 28.
+
+
+* Startup Changes in Emacs 27.1
+
+** Emacs can now use the XDG convention for init files.
+The 'XDG_CONFIG_HOME' environment variable (which defaults to
+"~/.config") specifies the XDG configuration parent directory. Emacs
+checks for "init.el" and other configuration files inside the "emacs"
+subdirectory of 'XDG_CONFIG_HOME', i.e. "$XDG_CONFIG_HOME/emacs/init.el"
+
+However, Emacs will still initially look for init files in their
+traditional locations if "~/.emacs.d" or "~/.emacs" exist, even if
+"$XDG_CONFIG_HOME/emacs" also exists. This means that you must delete
+or rename any existing "~/.emacs.d" and "~/.emacs" to enable use of
+the XDG directory.
+
+If "~/.emacs.d" does not exist, and Emacs has decided to use it
+(i.e. "$XDG_CONFIG_HOME/emacs" does not exist), Emacs will create it.
+Emacs will never create "$XDG_CONFIG_HOME/emacs".
+
+Whichever directory Emacs decides to use, it will set
+'user-emacs-directory' to point to it.
+
+** Emacs can now be configured using an early init file.
+The file is called "early-init.el", in 'user-emacs-directory'. It is
+loaded very early in the startup process: before graphical elements
+such as the tool bar are initialized, and before the package manager
+is initialized. The primary purpose is to allow customizing how the
+package system is initialized given that initialization now happens
+before loading the regular init file (see below).
+
+We recommend against putting any customizations in this file that
+don't need to be set up before initializing installed add-on packages,
+because the early init file is read too early into the startup
+process, and some important parts of the Emacs session, such as
+'window-system' and other GUI features, are not yet set up, which could
+make some customization fail to work.
+
+** Installed packages are now activated *before* loading the init file.
+As a result of this change, it is no longer necessary to call
+'package-initialize' in your init file.
+
+Previously, a call to 'package-initialize' was automatically inserted
+into the init file when Emacs was started. This call can now safely
+be removed. Alternatively, if you want to ensure that your init file
+is still compatible with earlier versions of Emacs, change it to:
+
+(when (< emacs-major-version 27)
+ (package-initialize))
+
+However, if your init file changes the values of 'package-load-list'
+or 'package-user-dir', or sets 'package-enable-at-startup' to nil then
+it won't work right without some adjustment:
+- You can move that code to the early init file (see above), so those
+ settings apply before Emacs tries to activate the packages.
+- You can use the new 'package-quickstart' so activation of packages
+ does not need to pay attention to 'package-load-list' or
+ 'package-user-dir' any more.
+
+** Emacs now notifies systemd when startup finishes or shutdown begins.
+Units that are ordered after 'emacs.service' will only be started
+after Emacs has finished initialization and is ready for use, and
+Emacs needs to be built with systemd support. (If your Emacs is
+installed in a non-standard location and you copied the emacs.service
+file to e.g. "~/.config/systemd/user/", you will need to copy the new
+version of the file again.)
+
+
+* Changes in Emacs 27.1
+
+** Emacs now supports Unicode Standard version 13.0.
+
+** Emacs now supports resizing and rotating images without ImageMagick.
+All modern systems support this feature. (On GNU and Unix systems,
+Cairo drawing or the XRender extension to X11 is required for this to
+be available; the configure script will test for it and, if found,
+enable scaling.)
+
+The new function 'image-transforms-p' can be used to test whether any
+given frame supports these capabilities.
+
+** The Network Security Manager now allows more fine-grained control
+of what checks to run via the 'network-security-protocol-checks'
+user option.
+
+** TLS connections have their security tightened by default.
+Most of the checks for outdated, believed-to-be-weak TLS algorithms
+and ciphers are now switched on by default. (In addition, several new
+TLS weaknesses are now warned about.) By default, the NSM will
+flag connections using these weak algorithms and ask users whether to
+allow them. To get the old behavior back (where certificates are
+checked for validity, but no warnings about weak cryptography are
+issued), you can either set 'network-security-protocol-checks' to nil,
+or adjust the elements in that user option to only happen on the 'high'
+security level (assuming you use the 'medium' level).
+
+** New user option 'nsm-trust-local-network'.
+Allows skipping Network Security Manager checks for hosts on your
+local subnet(s). It defaults to nil. Usually, there should be no
+need to set this non-nil, and doing that risks opening your local
+network connections to attacks. So be sure you know what you are
+doing before changing the value.
+
+** Native GnuTLS connections can now use client certificates.
+Previously, this support was only available when using the external
+'gnutls-cli' or 'starttls' command. Call 'open-network-stream' with
+':client-certificate t' to trigger looking up of per-server
+certificates via 'auth-source'.
+
+** New user option 'network-stream-use-client-certificates'.
+When non-nil, 'open-network-stream' performs lookups of client
+certificates using 'auth-source' as if ':client-certificate t' were
+specified if there is no explicit ':client-certificate' parameter.
+Defaults to nil.
+
+** 'next/previous-multiframe-window' have been renamed.
+The new names are as follows:
+
+ 'next-multiframe-window' -> 'next-window-any-frame'
+ 'previous-multiframe-window' -> 'previous-window-any-frame'
+
+The old function names are maintained as aliases for backward
+compatibility.
+
+** emacsclient
+*** emacsclient now supports the 'EMACS_SOCKET_NAME' environment variable.
+The command-line argument '--socket-name' overrides it.
+(The same behavior as for the pre-existing 'EMACS_SERVER_FILE' variable.)
+
+*** Emacs and emacsclient now default to "$XDG_RUNTIME_DIR/emacs".
+This is used as the directory for client/server sockets, if Emacs is
+running on a platform or environment that sets the 'XDG_RUNTIME_DIR'
+environment variable to indicate where session sockets should go.
+To get the old, less-secure behavior, you can set the
+'EMACS_SOCKET_NAME' environment variable to an appropriate value.
+
+*** When run by root, emacsclient no longer connects to non-root sockets.
+(Instead you can use Tramp methods to run root commands in a non-root Emacs.)
+
+** 'xft-ignore-color-fonts' now ignores even more color fonts.
+There are color fonts that managed to bypass the existing checks,
+causing XFT crashes, they are now filtered out. Setting
+'xft-ignore-color-fonts' to nil removes those checks, which might
+require setting 'face-ignored-fonts' to filter out problematic fonts.
+Known problematic fonts are "Noto Color Emoji" and "Emoji One".
+
+** The GTK+ font chooser now respects 'face-ignored-fonts'.
+When using 'menu-set-font' under GTK3, the available fonts are now
+matched against 'face-ignored-fonts'.
+
+** The GTK+ font chooser now remembers the previously selected settings.
+It now remembers the name, size, style, etc.
+
+** New user option 'what-cursor-show-names'.
+When non-nil, 'what-cursor-position' will show the name of the character
+in addition to the decimal/hex/octal representation. Default nil.
+
+** New function 'network-lookup-address-info'.
+This does IPv4 and/or IPv6 address lookups on hostnames.
+
+** 'network-interface-list' can now return IPv4 and IPv6 addresses.
+IPv4 and IPv6 addresses are now returned by default if available,
+optionally including netmask/broadcast address information.
+
+** Control of the threshold for using the 'distant-foreground' color.
+The threshold for color distance below which the 'distant-foreground'
+color of the face will be used instead of the foreground color can now
+be controlled via the new variable 'face-near-same-color-threshold'.
+The default value is 30000, as the previously hard-coded threshold.
+
+** The function 'read-passwd' uses "*" as default character to hide passwords.
+
+** The function 'read-answer' now accepts not only single character
+answers, but also function keys like 'F1', character events such as
+'C-M-h', and control characters like 'C-h'.
+
+** Lexical binding is now used by default when evaluating interactive Elisp.
+More specifically, 'lexical-binding' is now used by default for 'M-:'
+and '--eval' (including in evaluations invoked from 'emacsclient' via
+its '--eval' command-line option), as well as in
+'lisp-interaction-mode' and 'ielm-mode', used in the "*scratch*" and
+"*ielm*" buffers.
+
+We envision that most Lisp code is already either written with
+lexical-binding in mind, or will work unchanged under
+lexical-binding. If, for some reason, your code used in 'M-:' or
+'--eval' doesn't work as result of this change, either modify the code
+to work with lexical binding, or wrap it in an extra level of 'eval'.
+For example, --eval "FORM" becomes --eval "(eval 'FORM)" (note the extra
+quote in 'FORM).
+
+** The new user option 'tooltip-resize-echo-area' avoids truncating
+tooltip text on GUI frames when tooltips are displayed in the echo
+area. Instead, it resizes the echo area as needed to accommodate the
+full tool-tip text.
+
+** Show mode line tooltips only if the corresponding action applies.
+Customize the user option 'mode-line-default-help-echo' to restore the
+old behavior where the tooltip text is also shown when the
+corresponding action does not apply.
+
+** New hook 'server-after-make-frame-hook'.
+This hook is a convenient place to perform initializations in daemon
+mode which require GUI features to be available. One example is
+restoration of the previous session using the desktop.el package: put
+the call to 'desktop-read' in this hook, if you want the GUI settings
+to be restored, or if desktop.el needs to interact with you during
+restoration of the session.
+
+** The functions 'set-frame-height' and 'set-frame-width' are now
+commands, and will set the currently selected frame to the height/
+width specified by the numeric prefix.
+
+** New function 'logcount' calculates an integer's Hamming weight.
+
+** New function 'libxml-available-p'.
+This function returns non-nil if libxml support is both compiled in
+and available at run time. Lisp programs should use this function to
+detect built-in libxml support, instead of testing for that
+indirectly, e.g., by checking that functions like
+'libxml-parse-html-region' return nil.
+
+** 'libxml-parse-xml-region' and 'libxml-parse-html-region' take
+a parameter that's called DISCARD-COMMENTS, but it really only
+discards the top-level comment. Therefore this parameter is now
+obsolete, and the new utility function 'xml-remove-comments' can be
+used to remove comments before calling the libxml functions to parse
+the data.
+
+** A new DOM (the XML/HTML document structure returned by functions
+such as 'libxml-parse-html-region') traversal function has been added:
+'dom-search', which takes a DOM and a predicate and returns all nodes
+that match.
+
+** New function 'fill-polish-nobreak-p', to be used in 'fill-nobreak-predicate'.
+It blocks line breaking after a one-letter word, also in the case when
+this word is preceded by a non-space, but non-alphanumeric character.
+
+** The limit on repetitions in regexps has been raised to 2^16-1.
+It was previously limited to 2^15-1. For example, the following
+regular expression was previously invalid, but is now accepted:
+
+ x\{32768\}
+
+** The German prefix and postfix input methods now support Capital sharp S.
+
+** New input methods 'hawaiian-postfix' and 'hawaiian-prefix'.
+
+** New input methods 'georgian-qwerty' and 'georgian-nuskhuri'.
+
+** New input methods for several variants of the Sami language.
+The Sami input methods include: 'norwegian-sami-prefix',
+'bergsland-hasselbrink-sami-prefix', 'southern-sami-prefix',
+'ume-sami-prefix', 'northern-sami-prefix', 'inari-sami-prefix',
+'skolt-sami-prefix', and 'kildin-sami-prefix'.
+
+** Japanese environments use UTF-8 by default.
+In Japanese environments that do not specify encodings and are not
+based on MS-Windows, the default encoding is now utf-8 instead of
+japanese-iso-8bit.
+
+** New function 'exec-path'.
+This function by default returns the value of the corresponding
+user option, but can optionally return the equivalent of 'exec-path'
+from a remote host.
+
+** The function 'executable-find' supports an optional argument REMOTE.
+This triggers searching for the program on the remote host as indicated by
+'default-directory'.
+
+** New user option 'auto-save-no-message'.
+When set to t, no message will be shown when auto-saving (default
+value: nil).
+
+** The value of 'make-cursor-line-fully-visible' can now be a function.
+In addition to nil or non-nil, the value can now be a predicate
+function. Follow mode uses this to control scrolling of its windows
+when the last screen line in a window is not fully visible.
+
+** New variable 'emacs-repository-branch'.
+It reports the git branch from which Emacs was built.
+
+** New user option 'switch-to-buffer-obey-display-actions'.
+When non-nil, 'switch-to-buffer' uses 'pop-to-buffer-same-window' that
+respects display actions specified by 'display-buffer-alist' and
+'display-buffer-overriding-action'.
+
+** The user option 'switch-to-visible-buffer' is now obsolete.
+Customize 'switch-to-prev-buffer-skip' instead.
+
+** New user option 'switch-to-prev-buffer-skip'.
+This user option allows specifying the set of buffers that may be
+shown by 'switch-to-prev-buffer' and 'switch-to-next-buffer' more
+stringently than the now obsolete 'switch-to-visible-buffer'.
+
+** New 'flex' completion style.
+An implementation of popular "flex/fuzzy/scatter" completion which
+matches strings where the pattern appears as a subsequence. Put
+simply, makes "foo" complete to both "barfoo" and "frodo". Add 'flex'
+to 'completion-styles' or 'completion-category-overrides' to use it.
+
+** The 'completion-common-part' face is now visible by default.
+
+** New face attribute ':extend' to control face extension at EOL.
+The new face attribute ':extend' controls whether to use the face for
+displaying the empty space beyond end of line (EOL) till the edge of
+the window. By default, this attribute is non-nil only for a small
+number of faces, notably, 'region'; any other face that crosses end of
+line will not affect the display of the empty space at EOL. This is
+to make Emacs behave more like other GUI applications with respect to
+displaying faces that cross line boundaries.
+
+This attribute behaves specially when theme definitions are applied:
+if the theme doesn't specify an explicit value of this attribute for a
+face, the value from the original face definition is inherited.
+Consequently, a theme generally shouldn't specify this attribute
+unless it has a good reason to do so.
+
+** Connection-local variables
+*** Connection-local variables are applied by default like file-local
+and directory-local variables.
+
+*** The macro 'with-connection-local-variables' has been renamed from
+'with-connection-local-profiles'. No argument PROFILES needed any longer.
+
+** New user option 'next-error-verbose' controls when 'next-error'
+outputs a message about the error locus.
+
+** New user option 'grep-search-path' defines the directories searched for
+grep hits (this used to be controlled by 'compilation-search-path').
+
+** New user option 'emacs-lisp-compilation-search-path' defines the
+directories searched for byte-compiler error messages (this used to
+be controlled by 'compilation-search-path').
+
+** Multicolor fonts such as "Noto Color Emoji" can be displayed on
+Emacs configured with Cairo drawing and linked with cairo >= 1.16.0.
+
+** Emacs now optionally displays a fill column indicator.
+This is similar to what 'fill-column-indicator' package provides, but
+much faster and compatible with 'show-trailing-whitespace'.
+
+Customize the buffer-local user options 'display-fill-column-indicator'
+and 'display-fill-column-indicator-character' to activate the
+indicator.
+
+The indicator is not displayed at all in minibuffer windows and
+in tooltips, as it is not useful there.
+
+There are 2 new buffer local variables and 1 face to customize this
+mode, they are described in the manual "(emacs) Display".
+
+** 'progress-reporter-update' now accepts an optional suffix string to display.
+
+** New user option 'xref-file-name-display' controls the display of
+file names in xref buffers.
+
+** New user option 'byte-count-to-string-function'.
+It is used for displaying file sizes and disk space in some cases.
+
+** Emacs now interprets RGB triplets like HTML, SVG, and CSS do.
+The X convention previously used differed slightly, particularly for
+RGB triplets with a single hexadecimal digit per component.
+
+** The toolbar now shows the equivalent key binding in its tooltips.
+
+** The File menu-bar menu was re-arranged.
+Print menu items moved to submenu, and also added the new entries for tabs.
+
+** 'scroll-lock-mode' is now bound to the 'Scroll_Lock' key globally.
+Note that this key binding will not work on MS-Windows systems if
+'w32-scroll-lock-modifier' is non-nil.
+
+** 'global-set-key', called interactively, now no longer downcases a
+key binding with an upper case letter - if you can type it, you can
+bind it.
+
+** 'read-from-minibuffer' now works with buffer-local history variables.
+The HIST argument of 'read-from-minibuffer' now works correctly with
+buffer-local variables. This means that different buffers can have
+their own separated input history list if desired.
+
+** 'backup-by-copying-when-privileged-mismatch' applies to file gid, too.
+In addition to checking the file owner uid, Emacs also checks that the
+group gid is not greater than 'backup-by-copying-when-privileged-mismatch';
+if so, 'backup-by-copying-when-mismatch' will be forced on.
+
+
+* Editing Changes in Emacs 27.1
+
+** When asked to visit a large file, Emacs now offers to visit it literally.
+Previously, Emacs would only ask for confirmation before visiting
+large files. Now it also offers a third alternative: to visit the
+file literally, as in 'find-file-literally', which speeds up
+navigation and editing of large files.
+
+** 'zap-to-char' now uses the history of characters you used to zap to.
+'zap-to-char' uses the new 'read-char-from-minibuffer' function to allow
+navigating through the history of characters that have been input.
+This is mostly useful for characters that have complex input methods
+where inputting the character again may involve many keystrokes.
+
+** 'save-some-buffers' now has a new action in the prompt: 'C-f' will
+exit the command and switch to the buffer currently being asked about.
+
+** More commands support noncontiguous rectangular regions, namely
+'upcase-dwim', 'downcase-dwim', 'capitalize-dwim', 'capitalize-region',
+'upcase-initials-region', 'replace-string', 'replace-regexp', and
+'delimit-columns-region'.
+
+** The new 'amalgamating-undo-limit' variable can be used to control
+how many changes should be amalgamated when using the 'undo' command.
+
+** The 'newline-and-indent' command (commonly bound to 'RET' in many
+modes) now takes an optional numeric argument to specify how many
+times is should insert newlines (and indent).
+
+** New command 'make-empty-file'.
+
+** New variable 'x-wait-for-event-timeout'.
+This controls how long Emacs will wait for updates to the graphical
+state to take effect (making a frame visible, for example).
+
+** New user option 'electric-quote-replace-double'.
+This option controls whether '"' is replaced in 'electric-quote-mode',
+in addition to other quote characters. If non-nil, ASCII double-quote
+characters that quote text "like this" are replaced by double
+typographic quotes, “like this”, in text modes, and in comments in
+non-text modes.
+
+** New user option 'flyspell-case-fold-duplications'.
+This option controls whether Flyspell mode considers consecutive words
+to be duplicates if they are not in the same case. If non-nil, the
+default, words are considered to be duplicates even if their letters'
+case does not match.
+
+** 'write-abbrev-file' now includes special properties.
+'write-abbrev-file' now writes special properties like ':case-fixed'
+for abbrevs that have them.
+
+** 'write-abbrev-file' skips empty tables.
+'write-abbrev-file' now skips inserting a 'define-abbrev-table' form for
+tables which do not have any non-system abbrevs to save.
+
+** The new functions and commands 'text-property-search-forward' and
+'text-property-search-backward' have been added. These provide an
+interface that's more like functions like 'search-forward'.
+
+** 'add-dir-local-variable' now uses dotted pair notation syntax to
+write alists of variables to ".dir-locals.el". This is the same
+syntax that you can see in the example of a ".dir-locals.el" file in
+the node "(emacs) Directory Variables" of the user manual.
+
+** Network connections using 'local' can now use IPv6.
+'make-network-process' now uses the correct loopback address when
+asked to use ":host 'local" and ":family 'ipv6".
+
+** The new function 'replace-region-contents' replaces the current
+region using a given replacement-function in a non-destructive manner
+(in terms of 'replace-buffer-contents').
+
+** The command 'replace-buffer-contents' now has two optional
+arguments mitigating performance issues when operating on huge
+buffers.
+
+** Dragging 'C-M-mouse-1' now marks rectangular regions.
+
+** The command 'delete-indentation' now operates on the active region.
+If the region is active, the command joins all the lines in the
+region. When there's no active region, the command works on the
+current and the previous or the next line, as before.
+
+** You can now change the font size with the mouse wheel.
+Scrolling the mouse wheel with the Ctrl key pressed will now act the
+same as the 'C-x C-+' and 'C-x C--' commands.
+
+
+* Changes in Specialized Modes and Packages in Emacs 27.1
+
+** New HTML mode skeleton 'html-id-anchor'.
+This new command (which inserts an <a id="foo">_</a> skeleton) is
+bound to 'C-c C-c #'.
+
+** New command 'font-lock-debug-fontify'.
+This is an interactive convenience function to be used when developing
+font locking for a mode. It recomputes the font locking data and then
+re-fontifies the buffer.
+
+** Font Lock is smarter about fontifying unterminated strings and comments.
+When you type a quote that starts a string, or a comment delimiter
+that starts a comment, font-lock will not immediately refontify the
+following characters in 'font-lock-string-face' or
+'font-lock-comment-face'. Instead, it will delay the fontification
+beyond the current line to give you a chance to close the string or
+comment. This is controlled by the new user option
+'jit-lock-antiblink-grace', which specifies the delay in seconds. The
+default is 2 seconds; set to nil to get back the old behavior.
+
+** The 'C' command in 'tar-mode' will now preserve the timestamp of
+the extracted file if the new user option 'tar-copy-preserve-time' is
+non-nil.
+
+** 'autoconf-mode' is now used instead of 'm4-mode' for the
+"acinclude.m4" / "aclocal.m4" / "acsite.m4" files.
+
+** On GNU/Linux, 'M-x battery' will now list all batteries, no matter
+what they're named, and the 'battery-linux-sysfs-regexp' variable has
+been removed.
+
+** The 'list-processes' command now includes port numbers in the
+network connection information (in addition to the host name).
+
+** The 'cl' package is now officially deprecated in favor of 'cl-lib'.
+
+** desktop
+
+*** When called interactively with a prefix arg 'C-u', 'desktop-read'
+now prompts the user for the directory containing the desktop file.
+
+** display-line-numbers-mode
+
+*** New faces 'line-number-major-tick' and 'line-number-minor-tick',
+and user options 'display-line-numbers-major-tick' and
+'display-line-numbers-minor-tick' can be used to highlight the line
+numbers of lines multiple of certain numbers.
+
+*** New variable 'display-line-numbers-offset', when non-zero, adds
+an offset to absolute line numbers.
+
+** winner
+
+*** A new user option, 'winner-boring-buffers-regexp', has been added.
+
+** table
+
+*** 'table-generate-source' now supports wiki and mediawiki.
+This command can now output wiki and mediawiki format tables.
+
+** telnet-mode
+
+*** Reverting a buffer in 'telnet-mode' will restart a closed connection.
+
+** goto-addr
+
+*** A way to more conveniently specify what URI address schemes should
+be ignored has been added via the 'goto-address-uri-schemes-ignored'
+variable.
+
+** tex-mode
+
+*** 'latex-noindent-commands' controls indentation of certain commands.
+You can use this new user option to control indentation of arguments of
+\emph, \footnote, and similar commands.
+
+** byte compiler
+
+*** 'byte-compile-dynamic' is now obsolete.
+This is because on the one hand it suffers from misbehavior in corner
+cases that have plagued it for years, and on the other hand experience
+indicates that it doesn't bring any measurable benefit.
+
+*** The 'g' keystroke in "*Compile-Log*" buffers has been bound to a
+new command that will recompile the file previously compiled with 'M-x
+byte-compile-file' and the like.
+
+** compile.el
+
+*** In 'compilation-error-regexp-alist', 'line' (and 'end-line') can
+be functions.
+
+*** 'compilation-context-lines' can now take the value t; this is like
+nil, but instead of scrolling the current line to the top of the
+screen when there is no left fringe, it inserts a visible arrow before
+column zero.
+
+*** The new 'compilation-transform-file-match-alist' user option can
+be used to transform file name matches compilation output, and remove
+known false positives being recognized as warnings/errors.
+
+** cl-lib.el
+
+*** 'cl-defstruct' has a new ':noinline' argument to prevent inlining
+its functions.
+
+*** 'cl-defstruct' slots accept a ':documentation' property.
+
+*** 'cl-values-list' will now signal an error if its argument isn't a list.
+
+** doc-view.el
+
+*** New commands 'doc-view-presentation' and 'doc-view-fit-window-to-page'.
+
+*** Added support for password-protected PDF files.
+
+*** A new user option 'doc-view-pdftotext-program-args' has been added
+to allow controlling how the conversion to text is done.
+
+*** The prefix key 's' was changed to 'c' for slicing commands
+to avoid conflicts with 'image-mode' key 's'. The new key 'c' still
+has good mnemonics of "cut", "clip", "crop".
+
+** Ido
+
+*** New user option 'ido-big-directories' to mark directories whose
+names match certain regular expressions as big. Ido won't attempt to
+list the contents of such directories when completing file names.
+
+** Minibuffer
+
+*** New user option 'minibuffer-beginning-of-buffer-movement'.
+This option allows control of how the 'M-<' command works in
+the minibuffer. If non-nil, point will move to the end of the prompt
+(if point is after the end of the prompt). The default is nil, which
+preserves the original behavior of 'M-<' moving to the beginning of
+the prompt.
+
+*** When the minibuffer is active, echo-area messages are displayed at
+the end of the minibuffer instead of hiding the minibuffer by the echo
+area display. The new user option 'minibuffer-message-clear-timeout'
+controls how messages displayed in this situation are removed from the
+minibuffer. To revert to previous behavior, where echo-area messages
+temporarily overwrote the minibuffer contents until the user typed
+something, set 'set-message-function' and 'clear-message-function' to
+nil.
+
+*** Minibuffer now uses 'minibuffer-message' to display error messages
+at the end of the active minibuffer. To disable this, remove
+'minibuffer-error-initialize' from 'minibuffer-setup-hook'.
+
+*** 'y-or-n-p' now uses the minibuffer to read 'y' or 'n' answer.
+
+*** Some commands that previously used 'read-char-choice' now read
+a character using the minibuffer by 'read-char-from-minibuffer'.
+
+** map.el
+
+*** Now also understands plists.
+*** Now defined via generic functions that can be extended via 'cl-defmethod'.
+*** Deprecate the 'map-put' macro in favor of a new 'map-put!' function.
+*** 'map-contains-key' now returns a boolean rather than the key.
+*** Deprecate the 'testfn' args of 'map-elt' and 'map-contains-key'.
+*** New generic function 'map-insert'.
+*** The 'type' arg can be a list '(hash-table :key1 VAL1 :key2 VAL2 ...)'.
+
+** seq.el
+New convenience functions 'seq-first' and 'seq-rest' give easy access
+to respectively the first and all but the first elements of sequences.
+
+The new predicate function 'seq-contains-p' should be used instead of
+the now obsolete 'seq-contains'.
+
+** Follow mode
+In the current follow group of windows, "ghost" cursors are no longer
+displayed in the non-selected follow windows. To get the old behavior
+back, customize 'follow-hide-ghost-cursors' to nil.
+
+** New variable 'warning-fill-column' for 'display-warning'.
+
+** Windmove
+
+*** 'windmove-create-window' when non-nil makes a new window.
+This happens upon moving off the edge of the frame.
+
+*** Windmove supports directional window display and selection.
+The new command 'windmove-display-default-keybindings' binds default
+keys with provided modifiers (by default, Shift-Meta) to the commands
+that display the next buffer in the window at the specified direction.
+This is like 'windmove-default-keybindings' that binds keys to commands
+that select the window in the specified direction, but additionally it
+displays the buffer from the next command in that window. For example,
+'S-M-right C-h i' displays the "*Info*" buffer in the right window,
+creating the window if necessary. A special key can be customized to
+display the buffer in the same window, for example, 'S-M-0 C-h e'
+displays the "*Messages*" buffer in the same window. 'S-M-t C-h r'
+displays the Emacs manual in a new tab.
+
+*** Windmove also supports directional window deletion.
+The new command 'windmove-delete-default-keybindings' binds default
+keys with provided prefix (by default, 'C-x') and modifiers (by default,
+'Shift') to the commands that delete the window in the specified
+direction. For example, 'C-x S-down' deletes the window below.
+With a prefix arg 'C-u', also kills the buffer in that window.
+With 'M-0', deletes the selected window and selects the window
+that was in the specified direction.
+
+*** New command 'windmove-swap-states-in-direction' binds default keys
+to the commands that swap the states of the selected window with the
+window in the specified direction.
+
+*** Windmove code no longer used is now obsolete.
+That includes the user option 'windmove-window-distance-delta' and the
+functions 'windmove-coord-add', 'windmove-constrain-to-range',
+'windmove-constrain-around-range', 'windmove-frame-edges',
+'windmove-constrain-loc-for-movement', 'windmove-wrap-loc-for-movement',
+'windmove-reference-loc' and 'windmove-other-window-loc'.
+
+** Octave mode
+The mode is automatically enabled in files that start with the
+'function' keyword.
+
+** project.el
+
+*** New commands 'project-search' and 'project-query-replace-regexp'.
+
+*** New user option 'project-read-file-name-function'.
+
+** Etags
+
+*** 'next-file' is now an obsolete alias of 'tags-next-file'.
+
+*** 'tags-loop-revert-buffers' is an obsolete alias of
+'fileloop-revert-buffers'.
+
+*** The 'tags-loop-continue' function along with the
+'tags-loop-operate' and 'tags-loop-scan' variables are now obsolete;
+use the new 'fileloop-initialize' and 'fileloop-continue' functions
+instead.
+
+*** etags is now able to read Zstandard-compressed files.
+
+** bibtex
+
+*** New commands 'bibtex-next-entry' and 'bibtex-previous-entry'.
+In 'bibtex-mode-map', 'forward-paragraph' and 'backward-paragraph' are
+remapped to these, respectively.
+
+** Dired
+
+*** New command 'dired-create-empty-file'.
+
+*** New command 'dired-number-of-marked-files'.
+It is by default bound to '* N'.
+
+*** The marking commands now report how many files were marked by the
+command itself, not how many files are marked in total.
+
+*** The new user option 'dired-create-destination-dirs' controls whether
+'dired-do-copy' and 'dired-rename-file' should create non-existent
+directories in the destination.
+
+*** 'dired-dwim-target' can be customized to prefer either the next window,
+or one of the most recently visited windows with a Dired buffer.
+
+*** When the new user option 'dired-vc-rename-file' is non-nil,
+Dired performs file renaming using underlying version control system.
+
+*** Zstandard compression is now supported for 'dired-do-compress' and
+'dired-do-compress-to'.
+
+*** On systems that support suid/guid files, Dired now fontifies the
+permissions of such files with a special face 'dired-set-id'.
+
+*** A new face, 'dired-special', is used to highlight sockets, named
+pipes, block devices and character devices.
+
+** Find-Dired
+
+*** New user option 'find-dired-refine-function'.
+The default value is 'find-dired-sort-by-filename'.
+
+*** New sorting options for the user option 'find-ls-option'.
+
+** Change Logs and VC
+
+*** New user option 'vc-tor'.
+When non-nil, this user option causes the VC commands to communicate
+with the repository via Tor's proxy, using the 'torsocks' wrapper
+script. The default is nil.
+
+*** New command 'log-edit-generate-changelog-from-diff', bound to 'C-c C-w'.
+This generates ChangeLog entries from the VC fileset diff.
+
+*** Recording ChangeLog entries doesn't require an actual file.
+If a ChangeLog file doesn't exist, and if the new user option
+'add-log-dont-create-changelog-file' is non-nil (which is the
+default), commands such as 'C-x 4 a' will add log entries to a
+suitable named temporary buffer. (An existing ChangeLog file will
+still be used if it exists.) Set the user option to nil to get the
+previous behavior of always creating a buffer that visits a ChangeLog
+file.
+
+*** The new 'd' command ('vc-dir-clean-files') in 'vc-dir-mode'
+buffers will delete the marked files (or if no files are marked, the
+file under point). This command does not notify the VC backend, and
+is mostly useful for unregistered files.
+
+*** 'vc-dir-ignore' now takes a prefix argument to ignore all marked files.
+
+*** New user option 'vc-git-grep-template'.
+This new user option allows customizing the default arguments passed to
+'git-grep' when 'vc-git-grep' is used.
+
+*** Command 'vc-git-stash' now respects marks in the "*vc-dir*" buffer.
+When some files are marked, only those are stashed.
+When no files are marked, all modified files are stashed, as before.
+
+*** 'vc-dir' now shows a button allowing you to hide the stash list.
+Controlled by user option 'vc-git-show-stash'. Default t means show
+the entire list as before. An integer value limits the list length
+(but still allows you to show the entire list via the button).
+
+*** '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.
+
+*** The new hook 'vc-retrieve-tag-hook' runs after retrieving a tag.
+
+*** 'vc-hg' now invokes 'smerge-mode' when visiting files.
+Code that attempted to invoke 'smerge-mode' when visiting an Hg file
+with conflicts existed in earlier versions of Emacs, but incorrectly
+never detected a conflict due to invalid assumptions about cached
+values.
+
+*** The Hg (Mercurial) back-end now supports 'vc-region-history'.
+The 'C-x v h' command now works in buffers that visit files controlled
+by Hg.
+
+*** The Hg (Mercurial) back-end now prompts for revision to merge when
+you invoke 'C-x v m' ('vc-merge').
+
+*** The Hg (Mercurial) back-end now uses tags, branches and bookmarks
+instead of revision numbers as completion candidates when it prompts
+for a revision.
+
+*** New user option 'vc-hg-revert-switches'.
+It specifies switches to pass to Hg's 'revert' command.
+
+*** 'C-u C-x v D' ('vc-root-version-diff') prompts for two revisions
+and compares their entire trees.
+
+*** 'C-x v M D' ('vc-diff-mergebase') and 'C-x v M L' ('vc-log-mergebase')
+print diffs and logs between the merge base (common ancestor) of two
+given revisions.
+
+*** New command 'vc-log-search' asks for a pattern, searches it
+in the revision log, and displays matched log entries in the
+log buffer. For example, 'M-x vc-log-search RET bug#36644 RET'
+displays all entries whose log messages match the bug number.
+With a prefix argument asks for a command, so for example,
+'C-u M-x vc-log-search RET git log -1 f302475 RET' will display
+just one log entry found by its revision number.
+
+*** It is now possible to display a specific revision given by its ID.
+If you invoke 'C-x v L' ('vc-print-root-log') with a numeric argument
+of 1, as in 'C-1 C-x v L' or 'C-u 1 C-x v L', it asks for a revision
+ID, and shows its log entry together with the diffs introduced by the
+revision's commit. (For some less capable VCSes, only the log entry
+is shown.)
+
+*** New user option 'vc-find-revision-no-save'.
+With non-nil, 'vc-find-revision' doesn't write the created buffer to file.
+
+*** 'C-x v =' can now mimic Magit's diff format.
+Set the new user option 'diff-font-lock-prettify' to t for that, see
+below under "Diff mode".
+
+*** The 'diff' function arguments OLD and NEW may each be a buffer
+rather than a file, in non-interactive calls. This change was made in
+Emacs 24.1, but wasn't documented until now.
+
+*** New command 'diff-buffers' interactively diffs two buffers.
+
+** Diff mode
+
+*** Hunks are now automatically refined by font-lock.
+To disable refinement, set the new user option 'diff-refine' to nil.
+To get back the old behavior where hunks are refined as you navigate
+through a diff, set 'diff-refine' to the symbol 'navigate'.
+
+*** 'diff-auto-refine-mode' is deprecated in favor of 'diff-refine'.
+It is no longer enabled by default and binding it no longer has any
+effect.
+
+*** Better syntax highlighting of Diff hunks.
+Fragments of source in Diff hunks are now by default highlighted
+according to the appropriate major mode. Customize the new user
+option 'diff-font-lock-syntax' to nil to disable this.
+
+*** File headers can be shortened, mimicking Magit's diff format.
+To enable it, set the new user option 'diff-font-lock-prettify' to t.
+On GUI frames, this option also displays the insertion and deletion
+indicators on the left fringe.
+
+*** Prefix arg of 'diff-goto-source' means jump to the old revision
+of the file under version control if point is on an old changed line,
+or to the new revision of the file otherwise.
+
+** Texinfo
+
+*** New function for inserting '@pxref', '@xref', or '@ref' commands.
+The function 'texinfo-insert-dwim-@ref', bound to 'C-c C-c r' by
+default, inserts one of three types of references based on the text
+surrounding point, namely '@pxref' near a parenthesis, '@xref' at the
+start of a sentence or at '(point-min)', else '@ref'.
+
+** Browse-url
+
+*** The function 'browse-url-emacs' can now visit a URL in selected window.
+It now treats the optional 2nd argument to mean that the URL should be
+shown in the currently selected window.
+
+*** A new function, 'browse-url-add-buttons' can be used to add clickable
+links to most ordinary special-mode buffers that display text that
+have URLs embedded. 'browse-url-button-regexp' controls what's
+considered a button.
+
+*** New user option 'browse-url-secondary-browser-function'.
+It can be set to a function that invokes an alternative browser.
+
+** Comint
+
+*** 'send-invisible' is now an obsolete alias for 'comint-send-invisible'.
+Also, 'shell-strip-ctrl-m' is declared obsolete.
+
+*** 'C-c .' ('comint-insert-previous-argument') no longer interprets '&'.
+This feature caused problems when '&&' was present in the previous
+command. Since this command emulates 'M-.' in Bash and zsh, neither
+of which treats '&' specially, the feature was removed for
+compatibility with these shells.
+
+*** 'comint-insert-previous-argument' can now count arguments from the end.
+By default, invoking 'C-c .' with a numeric argument N would copy the
+Nth argument, counting from the first one. But if the new user option
+'comint-insert-previous-argument-from-end' is non-nil, it will copy
+the Nth argument counting from the last one. Thus 'C-c .' can now
+better emulate 'M-.' in both Bash and zsh, since the former counts
+from the beginning of the arguments, while the latter counts from the
+end.
+
+*** 'comint-run' can now accept a list of switches to pass to the program.
+'C-u M-x comint-run' will prompt for the switches interactively.
+
+*** Abnormal hook 'comint-password-function' has been added.
+This hook permits a derived mode to supply a password for the
+underlying command interpreter without prompting the user. For
+example, in 'sql-mode', the password for connecting to the database may
+be stored in the connection wallet and may be passed on the command
+line to start the SQL interpreter. This is a potential security flaw
+that could expose user's database passwords on the command line
+through the use of a process list (Bug#8427). With this hook, it is
+possible to not pass the password on the command line and wait for the
+program to prompt for the password. When it does so, the password can
+be supplied to the SQL interpreter without involving the user just as
+if it had been supplied on the command line.
+
+** SQL
+
+*** SQL Indent Minor Mode
+SQL Mode now supports the ELPA 'sql-indent' package for assisting
+sophisticated SQL indenting rules. Note, however, that SQL is not
+like other programming languages like C, Java, or Python where code is
+sparse and rules for formatting are fairly well established. Instead
+SQL is more like COBOL (from which it came) and code tends to be very
+dense and line ending decisions driven by syntax and line length
+considerations to make readable code. Experienced SQL developers may
+prefer to rely upon existing Emacs facilities for formatting code but
+the 'sql-indent' package provides facilities to aid more casual SQL
+developers layout queries and complex expressions.
+
+**** 'sql-use-indent-support' (default t) enables SQL indentation support.
+The 'sql-indent' package from ELPA must be installed to get the
+indentation support in 'sql-mode' and 'sql-interactive-mode'.
+
+**** 'sql-mode-hook' and 'sql-interactive-mode-hook' changed.
+Both hook variables have had 'sql-indent-enable' added to their
+default values. If you have existing customizations to these
+variables, you should make sure that the new default entry is
+included.
+
+*** Connection Wallet
+Database passwords can now by stored in NETRC or JSON data files that
+may optionally be encrypted. When establishing an interactive session
+with the database via 'sql-connect' or a product specific function,
+like 'sql-mysql' or 'sql-postgres', the password wallet will be
+searched for the password. The 'sql-product', 'sql-server',
+'sql-database', and the 'sql-username' will be used to identify the
+appropriate authorization. This eliminates the discouraged practice of
+embedding database passwords in your Emacs initialization.
+
+See the 'auth-source' module for complete documentation on the file
+formats. By default, the wallet file is expected to be in the
+'user-emacs-directory', named "sql-wallet" or ".sql-wallet", with
+".json" (JSON) or no (NETRC) suffix. Both file formats can optionally
+be encrypted with GPG by adding an additional ".gpg" suffix.
+
+** Term
+
+*** 'term-read-noecho' is now obsolete, use 'read-passwd' instead.
+
+*** 'serial-term' now takes an optional parameter to leave the
+emulator in line mode.
+
+** Flymake
+
+*** The variable 'flymake-diagnostic-types-alist' is obsolete.
+You should instead set properties on known diagnostic symbols, like
+':error' and ':warning', as demonstrated in the Flymake manual.
+
+*** New user option 'flymake-start-on-save-buffer'.
+Control whether Flymake starts checking the buffer on save.
+
+*** Flymake and backend functions may exchange hints about buffer changes.
+This enables more efficient backends. See the docstring of
+'flymake-diagnostic-functions' or the Flymake manual for details.
+
+*** 'flymake-start-syntax-check-on-newline' is now obsolete,
+use 'post-self-insert-hook' to check on newline.
+
+** Ruby
+
+*** The Rubocop Flymake diagnostic function will only run Lint cops if
+it can't find the config file.
+
+*** Rubocop is called with 'bundle exec' if Gemfile mentions it.
+
+*** New command 'ruby-find-library-file' bound to 'C-c C-f'.
+
+** Package
+
+*** Warn if "footer line" is missing, but still install package.
+package.el used to refuse to install a package without the so-called
+"footer line", which appears at the very end of the file:
+
+;;; FILENAME ends here
+
+package.el will now install packages without this line, but it will
+issue a warning. To avoid this warning, packages should keep the
+"footer line".
+
+Note that versions of Emacs older than 27.1 will not only refuse to
+install packages without such a line -- they will be unable to parse
+package data. It is therefore recommended to keep this line.
+
+*** Change of 'package-check-signature' for packages with multiple sigs.
+In previous Emacsen, t checked that all signatures are valid.
+Now t only checks that at least one signature is valid and the new 'all'
+value needs to be used if you want to enforce that all signatures
+are valid. This only affects packages with multiple signatures.
+
+*** The meaning of 'allow-unsigned' in 'package-check-signature' has
+changed slightly: If a usable OpenPGP configuration can't be found
+(for instance, if gpg isn't installed), it now has the same meaning as
+nil.
+
+*** New function 'package-get-version' lets packages query their own version.
+Example use in auctex.el: '(defconst auctex-version (package-get-version))'
+
+*** New 'package-quickstart' feature.
+When 'package-quickstart' is non-nil, package.el precomputes a big
+autoloads file so that activation of packages can be done much faster,
+which can speed up your startup significantly.
+It also causes user options like 'package-user-dir' and
+'package-load-list' to be consulted when 'package-quickstart-refresh'
+is run rather than at startup so you don't need to set them in your
+early init file.
+
+*** New function 'package-activate-all'.
+
+*** New functions for filtering packages list.
+A new function has been added which allows users to filter the
+packages list by name: 'package-menu-filter-by-name'. By default, it
+is bound to '/ n'. Additionally, the function
+'package-menu-filter-by-keyword' has been renamed from
+'package-menu-filter'. Its keybinding has also been changed to '/ k'
+(from 'f'). To clear any of the two filters, the user can now call
+the 'package-menu-clear-filter' function, bound to '/ /' by default.
+
+*** Imenu support has been added to 'package-menu-mode'.
+
+*** The package list can now be sorted by version or description.
+
+*** In Package Menu, 'g' now updates package data from archives.
+Previously, 'g' invoked 'tabulated-list-revert' which did not update
+the cached archive data. It is now bound to 'revert-buffer', which
+will update the data.
+
+'package-menu-refresh' is an obsolete alias for 'revert-buffer'.
+
+** Info
+
+*** Clicking on the left/right arrow icon in the Info tool-bar while
+holding down the Ctrl key pops up a menu of previously visited Info nodes
+where you can select a node to go back (like in browsers).
+
+*** Info can now follow 'file://' protocol URLs.
+The 'file://' URLs in Info documents can now be followed by passing
+them to the 'browse-url' function, like the other protocols: 'ftp',
+'http', and 'https'. This allows having references to local HTML
+files, for example.
+
+** Display of man pages now limits the width for formatting pages.
+The new user option 'Man-width-max' (80 by default) limits the number
+of columns passed to the 'man' program for formatting man pages. This
+is to enhance readability when man pages are displayed in very wide
+windows (which are customary with today's large displays).
+
+** Xref
+
+*** New command 'xref-find-definitions-at-mouse'.
+This command finds definitions of the identifier at the place of a
+mouse click event, and is intended to be bound to a mouse event.
+
+*** Changing 'xref-marker-ring-length' works after xref.el is loaded.
+Previously, setting 'xref-marker-ring-length' would only take effect
+if set before xref.el was loaded.
+
+*** 'xref-find-definitions' now sets the mark at the buffer position
+where it was invoked.
+
+*** New xref faces 'xref-file-header', 'xref-line-number', 'xref-match'.
+
+*** New user option 'xref-show-definitions-function'.
+It encapsulates the logic pertinent to showing the result of
+'xref-find-definitions'. The user can change it to customize its
+behavior and the display of results.
+
+*** Search results show the buffer even for one hit.
+The search-type Xref commands (e.g. 'xref-find-references' or
+'project-find-regexp') now show the results buffer even when there is
+only one hit. This can be altered by changing 'xref-show-xrefs-function'.
+
+*** Xref buffers support refreshing the search results.
+A new command 'xref-revert-buffer' is bound to 'g'.
+
+*** Imenu support has been added to 'xref--xref-buffer-mode'.
+
+*** New generic method 'xref-backend-identifier-completion-ignore-case'.
+Using it, the etags backend now honors 'tags-case-fold-search' during
+identifier completion.
+
+** Checkdoc
+
+*** Checkdoc can now optionally spell-check doc strings.
+Invoking 'checkdoc-buffer' with a non-nil TAKE-NOTES argument
+(interactively, with a prefix arg) will now spell-check the doc
+strings and report all the spelling mistakes.
+
+** Icomplete
+
+*** New minor mode Fido mode.
+This mode is based on Icomplete, and its name stands for "Fake Ido".
+The point of this mode is to be an 'ido-mode' workalike, providing
+most of the functionality present in 'ido-mode' that is not in
+Icomplete, which is much more compatible with all of Emacs's
+completion facilities.
+
+** Ecomplete
+
+*** The Ecomplete sorting has changed to a decay-based algorithm.
+This can be controlled by the new 'ecomplete-sort-predicate' user option.
+
+*** The 'ecomplete-database-file' file is now placed in
+"~/.emacs.d/ecompleterc" by default. Of course it will still find it
+if you have it in "~/.ecompleterc".
+
+** Gnus
+
+*** 'mm-uu-diff-groups-regexp' now defaults to matching all groups,
+which means that "git am" diffs are recognized everywhere.
+
+*** Two new Gnus summary mode navigation commands have been added,
+bound to the '[' and ']' keys: 'gnus-summary-prev-unseen-article' and
+'gnus-summary-next-unseen-article'. These take you (respectively) to
+the previous unseen or next unseen article. (These are the ones that
+are marked with "." in the summary mode lines.)
+
+*** The Gnus user variable 'nnimap-expunge' supports three new values:
+'never' for never expunging messages, 'immediately' for immediately
+expunging deleted messages, and 'on-exit' to expunge deleted articles
+when exiting the group's summary buffer. Setting 'nnimap-expunge' to
+nil or t is still supported but not recommended, since it may
+result in Gnus expunging all messages that have been flagged as
+deleted by any IMAP client (rather than just those that have been
+deleted by Gnus).
+
+*** New user option 'gnus-use-atomic-windows' makes Gnus window layouts atomic.
+See the "(elisp) Atomic Windows" node of the Elisp manual for details.
+
+*** There's a new value for 'gnus-article-date-headers',
+'combined-local-lapsed', which will show both the time (in the local
+timezone) and the lapsed time.
+
+*** Gnus now maps imaps to 993 only on old MS-Windows versions.
+The nnimap backend used to do this unconditionally to work around
+problems on old versions of MS-Windows. This is now done only for
+Windows XP and older.
+
+*** The nnimap backend now has support for IMAP namespaces.
+This feature can be enabled by setting the new 'nnimap-use-namespaces'
+server variable to non-nil.
+
+*** A prefix argument to 'gnus-summary-limit-to-score' will limit in reverse.
+Limit to articles with score "at or below" the SCORE argument rather
+than "at or above".
+
+*** The function 'gnus-score-find-favorite-words' has been renamed
+from 'gnus-score-find-favourite-words'.
+
+*** Gmane has been removed as an nnir backend, since Gmane no longer
+has a search engine.
+
+*** Splitting mail on common mailing list headers has been added.
+See the concept index in the Gnus manual for the 'match-list' entry.
+
+*** nil is no longer an allowed value for 'mm-text-html-renderer'.
+
+*** The default value of 'mm-inline-large-images' has changed from nil
+to 'resize', which means that large images will be resized instead of
+displayed with an external program by default.
+
+*** A new Gnus summary mode command, 'S A' ('gnus-summary-attach-article')
+can be used to attach the current article(s) to a pre-existing Message
+buffer, or create a new Message buffer with the article(s) attached.
+
+*** A new Gnus summary mode command, 'w' ('gnus-summary-browse-url')
+scans the article buffer for URLs, and offers them to the user to open
+with 'browse-url'.
+
+*** New user option 'nnir-notmuch-filter-group-names-function'.
+This option controls whether and how to use Gnus search groups as
+'path:' search terms to 'notmuch'.
+
+*** The buttons in the Gnus article buffer were formerly widgets
+(i.e., buttons from widget.el). This has now changed, and they are
+now buttons (from button.el), and commands like 'TAB' now search for
+buttons instead of widgets. There should be no user-visible changes,
+but out-of-tree code that relied on widgets being present might now
+fail.
+
+** erc
+
+*** New hook 'erc-insert-done-hook'.
+This hook is called after strings have been inserted into the buffer,
+and is free to alter point and window configurations, as it's not
+called from inside a 'save-excursion', as opposed to 'erc-insert-post-hook'.
+
+*** 'erc-button-google-url' has been renamed to 'erc-button-search-url'
+and its value has been changed to Duck Duck Go.
+
+*** 'erc-send-pre-hook' and 'erc-send-this' have been obsoleted.
+The user option to use instead to alter text to be sent is now
+'erc-pre-send-functions'.
+
+*** Improve matching/highlighting of nicknames.
+Open and close parenthesis and apostrophe are not considered valid
+nick characters anymore, matching the given grammar in RFC 2812
+section 2.3.1. This enables correct matching and highlighting of
+nicks when they are surrounded by parentheses, like "(nick)", and when
+adjacent to an apostrophe, like "nick's".
+
+*** Set 'erc-button-url-regexp' to 'browse-url-button-regexp'
+which better handles surrounding pair of parentheses.
+
+*** New function 'erc-switch-to-buffer-other-window'
+which is like 'erc-switch-to-buffer', but opens the buffer in another
+window.
+
+*** New function 'erc-track-switch-buffer-other-window'
+which is like 'erc-track-switch-buffer', but opens the buffer in
+another window.
+
+** EUDC
+
+*** XEmacs support has been removed.
+
+** eww/shr
+
+*** The new user option 'shr-cookie-policy' can be used to control
+when to use cookies when fetching embedded images. The default is to
+use them when the images are from the same domain as the main HTML
+document.
+
+*** The 'eww' command can now create a new EWW buffer.
+Invoking the command with a prefix argument will cause it to create a
+new EWW buffer for the URL instead of reusing the default one.
+
+*** Clicking with the Ctrl key or 'C-u RET' on a link opens a new tab
+when tab-bar-mode is enabled.
+
+*** The 'd' ('eww-download') command now falls back to current page's URL.
+If this command is invoked with no URL at point, it now downloads the
+current page instead of signaling an error.
+
+*** When opening external links in eww/shr (typically with the
+'C-u RET' keystroke on a link), the link will be flashed with the new
+'shr-selected-link' face to give the user feedback that the command
+has been executed.
+
+*** New user option 'shr-discard-aria-hidden'.
+If set, shr will not render tags with attribute 'aria-hidden="true"'.
+This attribute is meant to tell screen readers to ignore a tag.
+
+*** 'shr-external-browser' has been made into an obsolete alias
+of 'browse-url-secondary-browser-function'.
+
+*** 'shr-tag-ol' now respects the ordered list 'start' attribute.
+
+*** The following tags are now handled: '<code>', '<abbr>', and '<acronym>'.
+
+** Htmlfontify
+
+*** The functions 'hfy-color', 'hfy-color-vals' and
+'hfy-fallback-color-values' and the variables 'hfy-fallback-color-map'
+and 'hfy-rgb-txt-color-map' have been renamed from names that used
+'colour' instead of 'color'.
+
+** Enriched mode supports the 'charset' text property.
+You can add or modify the 'charset' text properties of text using the
+'Edit->Text Properties->Special Properties' menu, or by invoking the
+'facemenu-set-charset' command. Documents in Enriched mode will be
+saved with the charset properties, and those properties will be
+restored when the file is visited.
+
+** Smtpmail
+
+*** Authentication mechanisms can be added via external packages, by
+defining new 'cl-defmethod' of 'smtpmail-try-auth-method'.
+
+*** To always force smtpmail to send credentials over on the first
+attempt when communicating with the SMTP server(s), the
+'smtpmail-servers-requiring-authorization' user option can be used.
+
+*** smtpmail will now try resending mail when getting a transient "4xx"
+error message from the SMTP server. The new 'smtpmail-retries'
+user option says how many times to retry.
+
+** Footnote mode
+
+*** Support Hebrew-style footnotes.
+
+*** Footnote text lines are now aligned.
+Can be controlled via the new user option 'footnote-align-to-fn-text'.
+
+** CSS mode
+
+*** A new command 'css-cycle-color-format' for cycling between color
+formats (e.g. "black" => "#000000" => "rgb(0, 0, 0)") has been added,
+bound to 'C-c C-f'.
+
+*** CSS mode, SCSS mode, and Less CSS mode now have support for Imenu.
+
+** SGML mode
+
+*** 'sgml-quote' now handles double quotes and apostrophes
+when escaping text and in addition all numeric entities when
+unescaping text.
+
+** Python mode
+
+*** Python mode supports three different font lock decoration levels.
+The maximum level is used by default; customize
+'font-lock-maximum-decoration' to tone down the decoration.
+
+*** New user option 'python-pdbtrack-kill-buffers'.
+If non-nil, the default, buffers opened during pdbtracking session are
+killed when pdbtracking session is finished.
+
+*** New function 'python-shell-send-statement.
+It sends the statement delimited by 'python-nav-beginning-of-statement'
+and 'python-nav-end-of-statement' to the inferior Python process.
+
+** Help
+
+*** Descriptions of variables and functions give an estimated first release
+where the variable or function appeared in Emacs.
+
+*** Output format of 'C-h l' ('view-lossage') has changed.
+For convenience, 'view-lossage' now displays the last keystrokes
+and commands in the same format as the edit buffer of
+'edit-last-kbd-macro'. This makes it possible to copy the lines from
+the buffer generated by 'view-lossage' to the "*Edit Macro*" buffer
+created by 'edit-last-kbd-macro', and to save the macro by 'C-c C-c'.
+
+*** The list of help commands produced by 'C-h C-h' ('help-for-help')
+can now be searched via 'C-s'.
+
+** Ibuffer
+
+*** New filter 'ibuffer-filter-by-process'; bound to '/ E'.
+
+*** All mode filters can now accept a list of symbols.
+This means you can now easily filter several major modes, as well
+as a single mode.
+
+** Search and Replace
+
+*** Isearch supports a prefix argument for 'C-s' ('isearch-repeat-forward')
+and 'C-r' ('isearch-repeat-backward'). With a prefix argument, these
+commands repeat the search for the specified occurrence of the search string.
+A negative argument repeats the search in the opposite direction.
+This makes possible also to use a prefix argument for 'M-s .'
+('isearch-forward-symbol-at-point') to find the next Nth symbol.
+Also a prefix argument is supported for 'isearch-yank-until-char',
+'isearch-yank-word-or-char', 'isearch-yank-symbol-or-char'.
+
+*** To go to the first/last occurrence of the current search string
+is possible now with new commands 'isearch-beginning-of-buffer' and
+'isearch-end-of-buffer' bound to 'M-s M-<' and 'M-s M->' in Isearch.
+With a numeric argument, they go to the Nth absolute occurrence
+counting from the beginning/end of the buffer. This complements
+'C-s'/'C-r' that searches for the next Nth relative occurrence
+with a numeric argument.
+
+*** 'isearch-lazy-count' shows the current match number and total number
+of matches in the Isearch prompt. User options
+'lazy-count-prefix-format' and 'lazy-count-suffix-format' define the
+format of the current and the total number of matches in the prompt's
+prefix and suffix, respectively.
+
+*** 'lazy-highlight-buffer' highlights matches in the full buffer.
+It is useful in combination with 'lazy-highlight-cleanup' customized to nil
+to leave matches highlighted in the whole buffer after exiting isearch.
+Also when 'lazy-highlight-buffer' prepares highlighting in the buffer,
+navigation through the matches without flickering is more smooth.
+'lazy-highlight-buffer-max-at-a-time' controls the number of matches to
+highlight in one iteration while processing the full buffer.
+
+*** New isearch bindings.
+'C-M-z' invokes new function 'isearch-yank-until-char', which yanks
+everything from point up to but not including the specified
+character into the search string. This is especially useful for
+keyboard macros.
+
+'C-M-w' in isearch changed from 'isearch-del-char' to the new function
+'isearch-yank-symbol-or-char'. 'isearch-del-char' is now bound to
+'C-M-d'.
+
+'M-s h l' invokes 'highlight-lines-matching-regexp' using the search
+string to highlight lines matching the search string. This is similar
+to the existing binding 'M-s h r' ('highlight-regexp') that highlights
+JUST the search string.
+
+*** New user option 'isearch-yank-on-move' provides options t and 'shift'
+to extend the search string by yanking text that ends at the new
+position after moving point in the current buffer. 'shift' extends
+the search string by motion commands while holding down the shift key.
+
+*** 'isearch-allow-scroll' provides a new option 'unlimited' to allow
+scrolling any distance off screen.
+
+*** Isearch now remembers the regexp-based search mode for words/symbols
+and case-sensitivity together with search strings in the search ring.
+
+*** Isearch now has its own tool-bar and menu-bar menu.
+
+*** 'flush-lines' prints and returns the number of deleted matching lines.
+
+*** 'char-fold-to-regexp' now matches more variants of a base character.
+The table used to check for equivalence of characters is now built
+using the complete chain of unicode decompositions of a character,
+rather than stopping after one level, such that searching for
+e.g. "GREEK SMALL LETTER IOTA" will now also find "GREEK SMALL LETTER
+IOTA WITH OXIA".
+
+*** New char-folding options: 'char-fold-include' lets you add ad hoc
+foldings, 'char-fold-exclude' to remove foldings from default decomposition,
+and 'char-fold-symmetric' to search for any of an equivalence class of
+characters. For example, with a nil value of 'char-fold-symmetric'
+you can search for "e" to find "é", but not vice versa. With a non-nil
+value you can search for either, for example, you can search for "é"
+to find "e".
+
+** Debugger
+
+*** The Lisp Debugger is now based on 'backtrace-mode'.
+Backtrace mode adds fontification and commands for changing the
+appearance of backtrace frames. See the node "(elisp) Backtraces" in
+the Elisp manual for documentation of the new mode and its commands.
+
+** Edebug
+
+*** 'edebug-eval-last-sexp' and 'edebug-eval-print-last-sexp' interactively
+now take a zero prefix analogously to the non-Edebug counterparts.
+
+*** New faces 'edebug-enabled-breakpoint' and 'edebug-disabled-breakpoint'.
+When setting breakpoints in Edebug, an overlay with these faces are
+placed over the point in question, depending on whether they are
+enabled or not.
+
+*** New command 'edebug-toggle-disable-breakpoint'.
+This command allows you to disable a breakpoint temporarily. This is
+mainly useful with breakpoints that are conditional and would take
+some time to recreate.
+
+*** New command 'edebug-unset-breakpoints'.
+To clear all breakpoints in the current form, the 'U' command in
+'edebug-mode', or 'M-x edebug-unset-breakpoints' can be used.
+
+*** Re-instrumenting a function with Edebug will now try to preserve
+previously-set breakpoints. However, if the code has changed
+substantially, this may not be possible.
+
+*** New command 'edebug-remove-instrumentation'.
+This command removes Edebug instrumentation from all functions that
+have been instrumented.
+
+*** The runtime behavior of Edebug's instrumentation can be changed
+using the new variables 'edebug-behavior-alist',
+'edebug-after-instrumentation-function' and
+'edebug-new-definition-function'. Edebug's behavior can be changed
+globally or for individual definitions.
+
+*** Edebug's backtrace buffer now uses 'backtrace-mode'.
+Backtrace mode adds fontification, links and commands for changing the
+appearance of backtrace frames. See the node "(elisp) Backtraces" in
+the Elisp manual for documentation of the new mode and its commands.
+
+The binding of 'd' in Edebug's keymap is now 'edebug-pop-to-backtrace'
+which replaces 'edebug-backtrace'. Consequently Edebug's backtrace
+windows now behave like those of the Lisp Debugger and of ERT, in that
+when they appear they will be the selected window.
+
+The new 'backtrace-goto-source' command, bound to 's', works in
+Edebug's backtraces on backtrace frames whose source code has
+been instrumented by Edebug.
+
+** Enhanced xterm support
+
+*** New user option 'xterm-set-window-title' controls whether Emacs sets
+the XTerm window title. This feature is experimental and is disabled
+by default.
+
+** Grep
+
+*** 'rgrep', 'lgrep' and 'zrgrep' now hide part of the command line
+that contains a list of ignored directories and files.
+Clicking on the button with ellipsis unhides it.
+The abbreviation can be disabled by the new user option
+'grep-find-abbreviate'. The new command
+'grep-find-toggle-abbreviation' toggles it interactively.
+
+*** 'grep-find-use-xargs' is now customizable with sorting options.
+
+** ERT
+
+*** New variable 'ert-quiet' allows making ERT output in batch mode
+less verbose by removing non-essential information.
+
+*** ERT's backtrace buffer now uses 'backtrace-mode'.
+Backtrace mode adds fontification and commands for changing the
+appearance of backtrace frames. See the node "(elisp) Backtraces" in
+the Elisp manual for documentation of the new mode and its commands.
+
+** Gamegrid
+
+*** Gamegrid now determines its default glyph size based on display
+dimensions, instead of always using 16 pixels. As a result, Tetris,
+Snake and Pong are better playable on HiDPI displays.
+
+*** 'gamegrid-add-score' can now sort scores from lower to higher.
+This is useful for games where lower scores are better, like time-based games.
+
+** Filecache
+
+*** Completing file names in the minibuffer via 'C-TAB' now uses the
+styles as configured by the user option 'completion-styles'.
+
+** New macros 'thunk-let' and 'thunk-let*'.
+These macros are analogue to 'let' and 'let*', but create bindings that
+are evaluated lazily.
+
+** next-error
+
+*** New user option 'next-error-find-buffer-function'.
+The value should be a function that determines how to find the
+next buffer to be used by 'next-error' and 'previous-error'. The
+default is to use the last buffer that navigated to the current
+error.
+
+*** New command 'next-error-select-buffer'.
+It can be used to set any buffer as the next one to be used by
+'next-error' and 'previous-error'.
+
+** nxml-mode
+
+*** The default value of 'nxml-sexp-element-flag' is now t.
+This means that pressing 'C-M-SPACE' now selects the entire tree by
+default, and not just the opening element.
+
+** Eshell
+
+*** TAB completion uses the standard 'completion-at-point' rather than
+'pcomplete'. Its UI is slightly different but can be customized to
+behave similarly, e.g. Pcomplete's default cycling can be obtained
+with '(setq completion-cycle-threshold 5)'.
+
+*** Expansion of history event designators is disabled by default.
+To restore the old behavior, use
+
+ (add-hook 'eshell-expand-input-functions
+ #'eshell-expand-history-references)
+
+*** The function 'eshell-uniquify-list' has been renamed from
+'eshell-uniqify-list'.
+
+*** The function 'eshell/kill' is now able to handle signal switches.
+Previously 'eshell/kill' would fail if provided a kill signal to send
+to the process. It now accepts signals specified either by name or by
+its number.
+
+*** Emacs now follows symlinks in history-related files.
+The files specified by 'eshell-history-file-name' and
+'eshell-last-dir-ring-file-name' can include symlinks; these are now
+followed when Emacs writes the relevant history variables to the disk.
+
+** Shell
+
+*** Program name completion inside remote shells works now as expected.
+
+*** The user option 'shell-file-name' can be set now as connection-local
+variable for remote shells. It still defaults to "/bin/sh".
+
+** Single shell commands
+
+*** New values of 'shell-command-dont-erase-buffer'.
+This user option can now have the value 'erase' to force to erase the
+output buffer before execution of the command, even if the output goes
+to the current buffer. Additional values 'beg-last-out',
+'end-last-out', and 'save-point' control where to put point in the
+output buffer after inserting the 'shell-command' output.
+
+*** The new functions 'shell-command-save-pos-or-erase' and
+'shell-command-set-point-after-cmd' control how point is handled
+between two consecutive shell commands in the same output buffer.
+
+*** 'async-shell-command-width' defines the number of display columns
+available for output of asynchronous shell commands.
+
+*** Prompt for shell commands can now show the current directory.
+Customize the new user option 'shell-command-prompt-show-cwd' to enable it.
+
+** Pcomplete
+
+*** The 'pcomplete' command is now obsolete.
+The Pcomplete functionality can be obtained via 'completion-at-point'
+instead, by adding 'pcomplete-completions-at-point' to
+'completion-at-point-functions'.
+
+*** The function 'pcomplete-uniquify-list' has been renamed from
+'pcomplete-uniqify-list'.
+
+*** 'pcomplete/make' now completes on targets in included files, recursively.
+To recover the previous behavior, set new user option
+'pcmpl-gnu-makefile-includes' to nil.
+
+** Auth-source
+
+*** The Secret Service backend supports the ':create' key now.
+
+*** ".authinfo" and ".netrc" files now use a new mode: 'authinfo-mode'.
+This is just like 'fundamental-mode', except that it hides passwords
+under a "****" display property. When the cursor moves to this text,
+the real password is revealed (via 'reveal-mode'). The new
+'authinfo-hidden' user option can be used to control what to hide.
+
+** Tramp
+
+*** New connection method "nextcloud", which allows accessing OwnCloud
+or NextCloud hosted files and directories.
+
+*** New connection method "rclone", which allows accessing system
+storages via the 'rclone' program. This feature is experimental.
+
+*** New connection method "sudoedit", which allows editing local files
+with different user credentials. Contrary to the "sudo" method, no
+session is run permanently in the background. This is for security
+reasons.
+
+*** Connection methods "obex" and "synce" have been removed, because they
+are obsoleted in GVFS.
+
+*** Validated passwords are saved by auth-source backends which support this.
+
+*** During user and host name completion in the minibuffer, results
+from auth-source search are taken into account. This can be disabled
+by setting the user option 'tramp-completion-use-auth-sources' to nil.
+
+*** The user option 'tramp-ignored-file-name-regexp' allows disabling
+Tramp for some look-alike remote file names.
+
+*** For some connection methods, like "su" or "sudo", the host name in
+multi-hop file names must match the previous hop. Default host names
+are adjusted to the host name from the previous hop.
+
+*** A timeout has been added for the connection methods "sudo" and "doas".
+The underlying session is disabled when the timeout expires. This is
+for security reasons.
+
+*** For some connection methods, like "sshx" or "plink", it is
+possible to configure the remote login shell. This avoids problems
+with remote hosts, where "/bin/sh" is a link to a shell which
+cooperates badly with Tramp.
+
+*** New commands 'tramp-rename-files' and 'tramp-rename-these-files'.
+They allow saving remote files somewhere else when the corresponding
+host is not reachable anymore.
+
+** Rcirc
+
+*** New user option 'rcirc-url-max-length'.
+Setting this option to an integer causes URLs displayed in Rcirc
+buffers to be truncated to that many characters.
+
+*** The default '/quit' and '/part' reasons are now configurable.
+Two new user options are provided for this:
+'rcirc-default-part-reason' and 'rcirc-default-quit-reason'.
+
+** Register
+
+*** The return value of method 'register-val-describe' includes the
+names of buffers shown by the windows of a window configuration.
+
+** Message
+
+*** Completion of email addresses can use the standard completion UI.
+This is controlled by 'message-expand-name-standard-ui'.
+With the standard UI the different sources (ecomplete, bbdb, and eudc)
+are matched together and try to obey 'completion-styles'.
+It should work for other completion front ends like Company.
+
+*** 'message-mode' now supports highlighting citations of different depths.
+This can be customized via the new user option
+'message-cite-level-function' and the new 'message-cited-text-*' faces.
+
+*** Messages can now be systematically encrypted
+when the PGP keyring contains a public key for every recipient. To
+achieve this, add 'message-sign-encrypt-if-all-keys-available' to
+'message-send-hook'.
+
+*** When replying a message that have addresses on the form
+'"foo@bar.com" <foo@bar.com>', Message will elide the repeated "name"
+from the address field in the response.
+
+*** The default of 'message-forward-as-mime' has changed from t to nil
+as it has been reported that many recipients can't read forwards that
+are formatted as MIME digests.
+
+*** 'message-forward-included-headers' has changed its default to
+exclude most headers when forwarding.
+
+*** 'mml-secure-openpgp-sign-with-sender' sets also "gpg --sender".
+When 'mml-secure-openpgp-sign-with-sender' is non-nil, message sender's
+email address (in addition to its old behavior) will also be used to
+set gpg's "--sender email@domain" option.
+
+The option is useful for two reasons when verifying the signature:
+
+ 1. GnuPG's TOFU statistics are updated for the specific user id
+ (email) only. See gpg(1) man page about "--sender".
+
+ 2. GnuPG's "--auto-key-retrieve" functionality can use WKD (web key
+ directory) method for finding the signer's key. You need GnuPG
+ 2.2.17 to fully benefit from this feature. See gpg(1) man page for
+ "--auto-key-retrieve".
+
+*** The 'mail-from-style' variable is now obsolete.
+According to RFC 5322, only the 'angles' value is valid.
+
+** EasyPG
+
+*** 'epa-pinentry-mode' is renamed to 'epg-pinentry-mode'.
+It now applies to epg functions as well as epa functions.
+
+*** The alias functions 'epa--encode-coding-string',
+'epa--decode-coding-string', and 'epa--select-safe-coding-system' have
+been removed. Use 'encode-coding-string', 'decode-coding-string', and
+'select-safe-coding-system' instead.
+
+*** 'epg-context' structure supports now 'sender' slot.
+The value of the new 'sender' slot (if a string) is used to set gpg's
+"--sender" option. This feature is used by
+'mml-secure-openpgp-sign-with-sender'. See gpg(1) manual page about
+"--sender" for more information.
+
+*** 'epg-find-configuration' no longer finds GnuPG 2.0 through 2.1.5.
+Previously, it found these versions by mistake. The intent was to
+find GnuPG 2.1.6 or later, or find GnuPG 1.4.3 or later within the
+GnuPG 1 series.
+
+** Rmail
+
+*** New user option 'rmail-output-reset-deleted-flag'.
+If this option is non-nil, messages appended to an output file by the
+'rmail-output' command have their Deleted flag reset.
+
+*** The command 'rmail-summary-by-senders' with an empty argument
+selects the messages to summarize with a regexp that matches the
+sender of the current message.
+
+** Threads
+
+*** New variable 'main-thread' holds Emacs's main thread.
+This is handy in Lisp programs that run on a non-main thread and want
+to signal the main thread, e.g., when they encounter an error.
+
+*** 'thread-join' now returns the result of the finished thread.
+
+*** 'thread-signal' does not propagate errors to the main thread.
+Instead, error messages are just printed in the main thread.
+
+*** 'thread-alive-p' is now obsolete, use 'thread-live-p' instead.
+
+*** New command 'list-threads' shows Lisp threads.
+See the current list of live threads in a tabulated-list buffer which
+automatically updates. In the buffer, you can use 's q' or 's e' to
+signal a thread with quit or error respectively, or get a snapshot
+backtrace with 'b'.
+
+** thingatpt.el
+
+*** 'thing-at-point' supports a new "thing" called 'uuid'.
+A symbol 'uuid' can be passed to 'thing-at-point' and it returns the
+UUID at point.
+
+*** 'number-at-point' will now recognize hex numbers like 0xAb09 and #xAb09
+and return them as numbers.
+
+*** 'word-at-point' and 'sentence-at-point' accept NO-PROPERTIES.
+Just like 'thing-at-point' itself.
+
+** Interactive automatic highlighting
+
+*** 'highlight-regexp' can now highlight subexpressions.
+The new command accepts a prefix numeric argument to choose the
+subexpression.
+
+** Mouse display of minor mode menu
+
+*** 'minor-mode-menu-from-indicator' now displays full minor mode name.
+When there is no menu for a mode, display the mode name after the
+indicator instead of just the indicator (which is sometimes cryptic).
+
+** rx
+
+*** rx now handles raw bytes in character alternatives correctly,
+when given in a string. Previously, '(any "\x80-\xff")' would match
+characters U+0080...U+00FF. Now the expression matches raw bytes in
+the 128...255 range, as expected.
+
+*** The rx 'or' and 'seq' forms no longer require any arguments.
+'(or)' produces a regexp that never matches anything, while '(seq)'
+matches the empty string, each being an identity for the operation.
+This also works for their aliases: '|' for 'or'; ':', 'and' and
+'sequence' for 'seq'.
+The symbol 'unmatchable' can be used as an alternative to '(or)'.
+
+*** 'regexp' and new 'literal' accept arbitrary lisp as arguments.
+In this case, 'rx' will generate code which produces a regexp string
+at run time, instead of a constant string.
+
+*** New rx extension mechanism: 'rx-define', 'rx-let', 'rx-let-eval'.
+These macros add new forms to the rx notation.
+
+*** 'anychar' is now an alias for 'anything'.
+Both match any single character; 'anychar' is more descriptive.
+
+*** New 'intersection' form for character sets.
+With 'or' and 'not', it can be used to compose character-matching
+expressions from simpler parts.
+
+*** 'not' now accepts more argument types.
+The argument can now also be a character, a single-character string,
+an 'intersection' form, or an 'or' form whose arguments each match a
+single character.
+
+*** Nested 'or' forms of strings guarantee a longest match.
+For example, '(or (or "IN" "OUT") (or "INPUT" "OUTPUT"))' now matches
+the whole string "INPUT" if present, not just "IN". Previously, this
+was only guaranteed inside a single 'or' form of string literals.
+
+** Frames
+
+*** New command 'make-frame-on-monitor' makes a frame on the specified monitor.
+
+*** New value of 'minibuffer' frame parameter 'child-frame'.
+This allows creating and immediately parenting a minibuffer-only child
+frame when making a frame.
+
+*** New predicates 'display-blink-cursor-p' and 'display-symbol-keys-p'.
+These predicates are to be preferred over 'display-graphic-p' when
+testing for blinking cursor capability and the capability to have
+symbols (e.g., '[return]', '[tab]', '[backspace]') as keys respectively.
+
+** Tabulated List mode
+
+*** New user options for tabulated list sort indicators.
+You can now customize which sorting indicator character to display
+near the current column in Tabulated Lists (see user options
+'tabulated-list-gui-sort-indicator-asc',
+'tabulated-list-gui-sort-indicator-desc',
+'tabulated-list-tty-sort-indicator-asc', and
+'tabulated-list-tty-sort-indicator-desc').
+
+*** Two new commands and keystrokes have been added to the tabulated
+list mode: 'w' (which widens the current column) and 'c' which makes
+the current column contract.
+
+*** New function 'tabulated-list-clear-all-tags'.
+This function clears all tags from the padding area in the current
+buffer. Tags are typically added by calling 'tabulated-list-put-tag'.
+
+** Text mode
+
+*** 'text-mode-variant' is now obsolete, use 'derived-mode-p' instead.
+
+** CUA mode
+
+*** New user option 'cua-rectangle-terminal-modifier-key'.
+This user option allows for the customization of the modifier key used
+in a terminal frame.
+
+** JS mode
+
+*** JSX syntax is now automatically detected and enabled.
+If a file imports Facebook's 'React' library, or if the file uses the
+extension ".jsx", then various features supporting XML-like syntax
+will be supported in 'js-mode' and derivative modes. ('js-jsx-mode'
+no longer needs to be enabled.)
+
+*** New user option 'js-jsx-detect-syntax' disables automatic detection.
+This is turned on by default.
+
+*** New user option 'js-jsx-syntax' enables JSX syntax unconditionally.
+This is off by default.
+
+*** New variable 'js-jsx-regexps' controls JSX detection.
+
+*** JSX syntax is now highlighted like SGML.
+
+*** JSX code is properly indented in many more scenarios.
+Previously, JSX indentation usually only worked when an element was
+wrapped in parenthesis (e.g. in a 'return' statement or a function
+call). It would also fail in many intricate cases. Now, indentation
+should work anywhere without parenthesis; many more intricacies are
+supported; and, indentation conventions align more closely with those
+of the React developer community (see 'js-jsx-align->-with-<'),
+otherwise still adhering to SGML conventions.
+
+*** New user option 'js-jsx-align->-with-<' controls '>' indents.
+Commonly in JSX code, a '>' on its own line is indented at the same
+level as its opening '<'. This is the new default for JSX. This
+behavior is slightly different than that used by SGML in Emacs, where
+'>' is indented at the same level as attributes, which was also the
+old default for JSX.
+
+This is turned on by default. To get back the old default indentation
+behavior of aligning '>' with attributes, set 'js-jsx-align->-with-<'
+to nil.
+
+*** Indentation uses 'js-indent-level' instead of 'sgml-basic-offset'.
+Since JSX is a syntax extension of JavaScript, it makes the most sense
+for JSX expressions to be indented the same number of spaces as other
+JS expressions. This is a breaking change, but it probably aligns
+with how you'd expect this indentation to behave. If you want JSX to
+be indented like JS, you won't need to change your config.
+
+The old behavior can be emulated by controlling JSX indentation
+independently of JS, by setting 'js-jsx-indent-level'.
+
+*** New user option 'js-jsx-indent-level' for different JSX indentation.
+If you wish to indent JSX by a different number of spaces than JS, set
+this user option to the desired number.
+
+*** New user option 'js-jsx-attribute-offset' for JSX attribute indents.
+
+*** New variable 'js-syntactic-mode-name' controls mode name display.
+Previously, the mode name was simply 'JavaScript'. Now, when a syntax
+extension like JSX is enabled, the mode name is 'JavaScript[JSX]'.
+Set this variable to nil to disable the new behavior.
+
+*** New function 'js-use-syntactic-mode-name' for deriving modes.
+Packages deriving from 'js-mode' with 'define-derived-mode' should
+call this function to add enabled syntax extensions to their mode
+name, too.
+
+** Autorevert
+
+*** New user option 'auto-revert-avoid-polling' for saving power.
+When set to a non-nil value, buffers in Auto Revert mode are no longer
+polled for changes periodically. This reduces the power consumption
+of an idle Emacs, but may fail on some network file systems; set
+'auto-revert-notify-exclude-dir-regexp' to match files where
+notification is not supported. The default value is nil.
+
+*** New variable 'buffer-auto-revert-by-notification'.
+A major mode can declare that notification on the buffer's default
+directory is sufficient to know when updates are required, by setting
+the new variable 'buffer-auto-revert-by-notification' to a non-nil
+value. Auto Revert mode can use this information to avoid polling the
+buffer periodically when 'auto-revert-avoid-polling' is non-nil.
+
+*** 'global-auto-revert-ignore-buffer' can now also be a predicate
+function that can be used for more fine-grained control of which
+buffers to auto-revert.
+
+** auth-source-pass
+
+*** New user option 'auth-source-pass-filename'.
+Allows setting the path to the password-store, defaults to
+"~/.password-store".
+
+*** New user option 'auth-source-pass-port-separator'.
+Specifies separator between host and port, defaults to colon ":".
+
+*** Minimize the number of decryptions during password lookup.
+This makes the package usable with physical tokens requiring touching
+a sensor for every decryption.
+
+*** 'auth-source-pass-get' is now autoloaded.
+
+** Bookmarks
+
+*** 'bookmark-file' and 'bookmark-old-default-file' are now obsolete
+aliases of 'bookmark-default-file'.
+
+*** New user option 'bookmark-watch-bookmark-file'.
+When non-nil, watch whether the bookmark file has changed on disk.
+
+*** The old bookmark file format is no longer supported.
+This bookmark file format has not been used in Emacs since at least
+version 19.34, released in 1996, and will no longer be automatically
+converted to the new bookmark file format.
+
+The following functions are now declared obsolete:
+'bookmark-grok-file-format-version',
+'bookmark-maybe-upgrade-file-format',
+'bookmark-upgrade-file-format-from-0', and
+'bookmark-upgrade-version-0-alist'.
+
+** The mantemp.el library is now marked obsolete.
+This library generates manual C++ template instantiations. It should
+no longer be useful on modern compilers, which do this automatically.
+
+** Ispell
+
+*** New hook 'ispell-change-dictionary-hook'.
+This runs after changing the dictionary and could be used to
+automatically spellcheck a buffer when changing language without
+needing to advice 'ispell-change-dictionary'.
+
+** scroll-lock
+
+*** New command 'scroll-lock-next-line-always-scroll'.
+This command is bound to 'S-down' and scrolls the buffer up in
+particular when the end of the buffer is visible in the window.
+
+** mwheel.el
+
+*** 'mwheel-install' is now obsolete.
+Use 'mouse-wheel-mode' instead. Note that 'mouse-wheel-mode' is
+already enabled by default on most graphical displays.
+
+** Gravatar
+
+*** 'gravatar-cache-ttl' is now a number of seconds.
+The previously used timestamp format of a list of integers is still
+supported, but is deprecated. The default value has not changed.
+
+*** 'gravatar-size' can now be nil.
+This results in the use of Gravatar's default size of 80 pixels.
+
+*** The default fallback gravatar is now configurable.
+This is possible using the new user options 'gravatar-default-image'
+and 'gravatar-force-default'.
+
+** ada-mode
+
+*** The built-in ada-mode is now deleted. The GNU ELPA package is a
+good replacement, even in very large source files.
+
+** time-stamp
+
+*** New '%5z' conversion for 'time-stamp-format' gives time zone offset.
+Specifying '%5z' in 'time-stamp-format' or 'time-stamp-pattern'
+expands to the time zone offset, e.g., '+0100'. The time zone used is
+specified by 'time-stamp-time-zone'.
+
+Because this feature is new in Emacs 27.1, do not use it in the local
+variables section of any file that might be edited by an older version
+of Emacs.
+
+*** Some conversions recommended for 'time-stamp-format' have changed.
+The new documented/recommended %-conversions are closer to those
+used by 'format-time-string' and are compatible at least as far back
+as Emacs 22.1 (released in 2007).
+
+Uppercase abbreviated day name of week: was %3A, now %#a
+Full day name of week: was %:a, now %:A
+Uppercase abbreviated month name: was %3B, now %#b
+Full month name: was %:b, now %:B
+Four-digit year: was %:y, now %Y
+Lowercase timezone name: was %z, now %#Z
+Fully-qualified host name: was %s, now %Q
+Unqualified host name: (was none), now %q
+Login name: was %u, now %l
+User's full name: was %U, now %L
+
+Merely having '(add-hook 'before-save-hook 'time-stamp)' in your
+Emacs init file does not expose you to this change. However,
+if you set 'time-stamp-format' or 'time-stamp-pattern' with a
+file-local variable, you may need to update the value.
+
+** mode-local
+
+*** Declare 'define-overload' and 'define-child-mode' as obsolete.
+
+*** Rename several internal functions to use a 'mode-local-' prefix.
+
+** CC Mode
+
+*** You can now flag "wrong style" comments with 'font-lock-warning-face'.
+To do this, use 'c-toggle-comment-style', if needed, to set the desired
+default comment style (block or line); then set the user option
+'c-mark-wrong-style-of-comment' to non-nil.
+
+** Mailcap
+
+*** The new function 'mailcap-file-name-to-mime-type' has been added.
+It's a simple convenience function for looking up MIME types based on
+file name extensions.
+
+*** The default way the list of possible external viewers for MIME
+types is sorted and chosen has changed. Earlier, the most specific
+viewer was chosen, even if there was a general override in "~/.mailcap".
+For instance, if "/etc/mailcap" has an entry for "image/gif", that one
+will be chosen even if you have an entry for "image/*" in your
+"~/.mailcap" file. But with the new method, entries from "~/.mailcap"
+overrides all system and Emacs-provided defaults. To get the old
+method back, set 'mailcap-prefer-mailcap-viewers' to nil.
+
+** MH-E
+
+*** The hook 'mh-show-mode-hook' is now called before the message is inserted.
+Functions that want to affect the message text (for example, to change
+highlighting) can no longer use 'mh-show-mode-hook', because the
+message contents will not yet have been inserted when the hook is
+called. Such functions should now be attached to 'mh-show-hook'.
+
+** URL
+
+*** The 'file:' handler no longer looks for "index.html" in
+directories if you ask it for a "file:///dir" URL. Since this is a
+low-level library, such decisions (if they are to be made at all) are
+left to higher-level functions.
+
+
+* New Modes and Packages in Emacs 27.1
+
+** Tab Bars
+
+*** Tab Bar mode
+The new command 'tab-bar-mode' enables the tab bar at the top of each
+frame (including TTY frames), where you can use tabs to switch between
+named persistent window configurations.
+
+The 'C-x t' sequence is the new prefix key for tab-related commands:
+'C-x t 2' creates a new tab; 'C-x t 0' deletes the current tab;
+'C-x t b' switches to buffer in another tab; 'C-x t f' and 'C-x t C-f'
+edit file in another tab; and 'C-TAB' and 'S-C-TAB' switch to the next
+or previous tab. You can also switch between tabs and create/delete
+tabs with a mouse.
+
+Tab-related commands are available even when 'tab-bar-mode' is
+disabled: by default, they enable 'tab-bar-mode' in that case.
+
+The X resource "tabBar", class "TabBar" enables the tab bar
+when its value is "on", "yes" or "1".
+
+The user option 'tab-bar-position' specifies where to show the tab bar.
+
+Tab-related commands can be used even without the tab bar when
+'tab-bar-mode' is disabled by a nil value of the user option
+'tab-bar-show'. Without the tab bar you can switch between tabs
+using completion on tab names, or using 'tab-switcher'.
+
+Read the new Info node "(emacs) Tab Bars" for full description
+of all related features.
+
+*** Tab Line mode
+The new command 'global-tab-line-mode' enables the tab line above each
+window, which you can use to switch buffers in the window. Selecting
+the previous window-local tab is the same as typing 'C-x <LEFT>'
+('previous-buffer'), selecting the next tab is the same as 'C-x <RIGHT>'
+('next-buffer'). Both commands support a numeric prefix argument as
+a repeat count. Clicking on the plus icon adds a new buffer to the
+window-local tab line of buffers. Using the mouse wheel on the tab
+line scrolls tabs.
+
+Read the new Info node "(emacs) Tab Line" for full description
+of all related features.
+
+** fileloop.el lets one setup multifile operations like search&replace.
+
+** Emacs can now visit files in archives as if they were directories.
+This feature uses Tramp and works only on systems which support GVFS,
+i.e. GNU/Linux, roughly spoken. See the node "(tramp) Archive file
+names" in the Tramp manual for full documentation of these facilities.
+
+** New library for writing JSONRPC applications (https://jsonrpc.org).
+The 'jsonrpc' library enables writing Emacs Lisp applications that
+rely on this protocol. Since the protocol is designed to be
+transport-agnostic, the library provides an API to implement new
+transport strategies as well as a separate API to use them. A
+transport implementation for process-based communication, such as is
+used by the Language Server Protocol (LSP), is readily available.
+
+** Backtrace mode improves viewing of Elisp backtraces.
+Backtrace mode adds pretty printing, fontification and ellipsis
+expansion to backtrace buffers produced by the Lisp debugger, Edebug
+and ERT. See the node "(elisp) Backtraces" in the Elisp manual for
+documentation of the new mode and its commands.
+
+** so-long.el helps to mitigate performance problems with long lines.
+When 'global-so-long-mode' has been enabled, visiting a file with very
+long lines will (subject to configuration) cause the user's preferred
+'so-long-action' to be automatically invoked (by default, the buffer's
+major mode is replaced by 'so-long-mode'). In extreme cases this can
+prevent delays of several minutes, and make Emacs responsive almost
+immediately. Type 'M-x so-long-commentary' for full documentation.
+
+
+* Incompatible Lisp Changes in Emacs 27.1
+
+** Incomplete destructive splicing support has been removed.
+Support for Common Lisp style destructive splicing (",.") was
+incomplete and broken for a long time. It has now been removed.
+
+This means that backquote substitution now works for identifiers
+starting with a period ("."). Consider the following example:
+
+ (let ((.foo 42)) `,.foo)
+
+In the past, this would have incorrectly evaluated to '(\,\. foo)',
+but will now instead evaluate to '42'.
+
+** The REGEXP in 'magic-mode-alist' is now matched case-sensitively.
+Likewise for 'magic-fallback-mode-alist'.
+
+** 'add-hook' does not always add to the front or the end any more.
+The replacement of 'append' with 'depth' implies that the function is
+not always added to the very front (when append/depth is nil) or the
+very end (when append/depth is t) any more because other functions on
+the hook may have specified higher/lower depths. This makes it
+possible to control the ordering of functions more precisely, as was
+already possible in 'add-function' and 'advice-add'.
+
+** In 'compilation-error-regexp-alist' the old undocumented feature
+where 'line' could be a function of 2 arguments has been dropped.
+
+** 'define-fringe-bitmap' is always defined, even when Emacs is built
+without any GUI support.
+
+** Just loading a theme's file no longer activates the theme's settings.
+Loading a theme with 'M-x load-theme' still activates the theme, as it
+did before. However, loading the theme's file with 'M-x load-file',
+or using 'require' or 'load' in a Lisp program, doesn't actually apply
+the theme's settings until you either invoke 'M-x enable-theme' or
+type 'M-x load-theme'. (In a Lisp program, calling 'enable-theme' or
+invoking 'load-theme' with NO-ENABLE argument omitted or nil has the
+same effect of activating a theme whose file has been loaded.) The
+special case of the 'user' theme is an exception: it is frequently
+used for ad-hoc customizations, so the settings of that theme are by
+default applied immediately.
+
+The variable 'custom--inhibit-theme-enable' controls this behavior;
+its default value changed in Emacs 27.1.
+
+** The REPETITIONS argument of 'benchmark-run' can now also be a variable.
+
+** Interpretation of relative 'HOME' directory has changed.
+If "$HOME" is set to a relative file name, 'expand-file-name' now
+interprets it relative to the directory where Emacs was started, not
+relative to the 'default-directory' of the current buffer. We recommend
+always setting "$HOME" to an absolute file name, so that its meaning is
+independent of where Emacs was started.
+
+** 'file-name-absolute-p' no longer considers "~foo" to be an absolute
+file name if there is no user named "foo".
+
+** The FILENAME argument to 'file-name-base' is now mandatory and no
+longer defaults to 'buffer-file-name'.
+
+** File metadata primitives now signal an error if I/O, access, or
+other serious errors prevent them from determining the result.
+Formerly, these functions often (though not always) silently returned
+nil. For example, if there is an access error, I/O error or low-level
+integer overflow when getting the attributes of a file F,
+'(file-attributes F)' now signals an error instead of returning nil.
+These functions still behave as before if the only problem is that the
+file does not exist. The affected primitives are
+'directory-files-and-attributes', 'file-acl', 'file-attributes',
+'file-modes', 'file-newer-than-file-p', 'file-selinux-context',
+'file-system-info', and 'set-visited-file-modtime'.
+
+** The function 'eldoc-message' now accepts a single argument.
+Programs that called it with multiple arguments before should pass
+them through 'format' first. Even that is discouraged: for ElDoc
+support, you should set 'eldoc-documentation-function' instead of
+calling 'eldoc-message' directly.
+
+** Old-style backquotes now generate an error.
+They have been generating warnings for a decade. To interpret
+old-style backquotes as new-style, bind the new variable
+'force-new-style-backquotes' to t.
+
+** Defining a Common Lisp structure using 'cl-defstruct' or
+'cl-struct-define' whose name clashes with a builtin type (e.g.,
+'integer' or 'hash-table') now signals an error.
+
+** When formatting a floating-point number as an octal or hexadecimal
+integer, Emacs now signals an error if the number is too large for the
+implementation to format.
+
+** 'logb' now returns infinity when given an infinite or zero argument,
+and returns a NaN when given a NaN. Formerly, it returned an extreme
+fixnum for such arguments.
+
+** Some functions and variables obsolete since Emacs 22 have been removed:
+'archive-mouse-extract', 'assoc-ignore-case', 'assoc-ignore-representation',
+'backward-text-line', 'blink-cursor', 'bookmark-exit-hooks',
+'c-opt-op-identitier-prefix', 'comint-use-prompt-regexp-instead-of-fields',
+'compilation-finish-function', 'count-text-lines', 'cperl-vc-header-alist',
+'custom-face-save-command', 'cvs-display-full-path', 'cvs-fileinfo->full-path',
+'delete-frame-hook', 'derived-mode-class', 'describe-char-after',
+'describe-project', 'desktop-basefilename', 'desktop-buffer-handlers',
+'desktop-buffer-misc-functions', 'desktop-buffer-modes-to-save',
+'desktop-enable', 'desktop-load-default', 'dired-omit-files-p',
+'disabled-command-hook', 'dungeon-mode-map', 'electric-nroff-mode',
+'electric-nroff-newline', 'electric-perl-terminator', 'executing-macro',
+'focus-frame', 'forward-text-line', 'generic-define-mswindows-modes',
+'generic-define-unix-modes', 'generic-font-lock-defaults',
+'goto-address-at-mouse', 'highlight-changes-colours',
+'ibuffer-elide-long-columns', 'ibuffer-hooks', 'ibuffer-mode-hooks',
+'icalendar-convert-diary-to-ical', 'icalendar-extract-ical-from-buffer',
+'imenu-always-use-completion-buffer-p', 'ipconfig-program',
+'ipconfig-program-options', 'isearch-lazy-highlight-cleanup',
+'isearch-lazy-highlight-initial-delay', 'isearch-lazy-highlight-interval',
+'isearch-lazy-highlight-max-at-a-time', 'iswitchb-use-fonts',
+'latin1-char-displayable-p', 'mouse-wheel-click-button',
+'mouse-wheel-down-button', 'mouse-wheel-up-button', 'new-frame',
+'pascal-outline', 'process-kill-without-query',
+'recentf-menu-append-commands-p', 'rmail-pop-password',
+'rmail-pop-password-required', 'savehist-load', 'set-default-font',
+'spam-list-of-processors', 'speedbar-add-ignored-path-regexp',
+'speedbar-buffers-line-path', 'speedbar-ignored-path-expressions',
+'speedbar-ignored-path-regexp', 'speedbar-line-path', 'speedbar-path-line',
+'timer-set-time-with-usecs', 'tooltip-gud-display', 'tooltip-gud-modes',
+'tooltip-gud-toggle-dereference', 'unfocus-frame', 'unload-hook-features-list',
+'update-autoloads-from-directories', 'vc-comment-ring', 'vc-comment-ring-index',
+'vc-comment-search-forward', 'vc-comment-search-reverse',
+'vc-comment-to-change-log', 'vc-diff-switches-list', 'vc-next-comment',
+'vc-previous-comment', 'view-todo', 'x-lost-selection-hooks',
+'x-sent-selection-hooks'.
+
+** Further functions and variables obsolete since Emacs 24 have been removed:
+'default-directory-alist', 'dired-default-directory',
+'dired-default-directory-alist', 'dired-enable-local-variables',
+'dired-hack-local-variables', 'dired-local-variables-file',
+'dired-omit-here-always'.
+
+** Garbage collection no longer treats miscellaneous objects specially;
+they are now allocated like any other pseudovector. As a result, the
+'garbage-collect' and 'memory-use-count' functions no longer return a
+'misc' component, and the 'misc-objects-consed' variable has been
+removed.
+
+** Reversed character ranges are no longer permitted in 'rx'.
+Previously, ranges where the starting character is greater than the
+ending character were silently omitted.
+For example, '(rx (any "@z-a" (?9 . ?0)))' would match '@' only.
+Now, such 'rx' expressions generate an error.
+
+** Internal 'rx' functions and variables have been removed,
+as a consequence of an improved implementation. Packages using
+these should use the public 'rx' and 'rx-to-string' instead.
+'rx-constituents' is still available for compatibility, but the new
+extension mechanism is preferred: 'rx-define', 'rx-let' and
+'rx-let-eval'.
+
+** 'text-mode' no longer sets the value of 'indent-line-function'.
+The global value of 'indent-line-function', which defaults to
+'indent-relative', will no longer be reset locally when turning on
+'text-mode'.
+
+To get back the old behavior, add a function to 'text-mode-hook' which
+performs '(setq-local indent-line-function #'indent-relative)'.
+
+** 'make-process' no longer accepts a non-nil ':stop' key. This has
+never worked reliably, and now causes an error.
+
+** 'eventp' no longer returns non-nil for lists whose car is nil.
+This is consistent with the fact that nil, though a symbol, is not a
+valid event type.
+
+** The obsolete package xesam.el (since Emacs 24) has been removed.
+
+** The XBM image handler now accepts a ':stride' argument, which should
+be specified in image specs representing the entire bitmap as a single
+bool vector.
+
+** 'regexp-quote' may return its argument string.
+If the argument needs no quoting, it can be returned instead of a copy.
+
+** Mouse scroll up and down with control key modifier changes font size.
+Previously, the control key modifier was used to scroll up or down by
+an amount which was close to near a full screen. This is now instead
+available by scrolling with the meta modifier key.
+
+To get the old behavior back, customize the user option
+'mouse-wheel-scroll-amount', or add the following to your init file:
+
+(customize-set-variable 'mouse-wheel-scroll-amount
+ '(5 ((shift) . 1) ((control) . nil)))
+
+By default, the font size will be changed in the window that the mouse
+pointer is over. To change this behavior, you can customize the user
+option 'mouse-wheel-follow-mouse'. Note that this will also affect
+scrolling.
+
+** Mouse scroll up and down with control key modifier also works on images
+where it scales the image under the mouse pointer.
+
+** 'help-follow-symbol' now signals 'user-error' if point (or the
+position pointed to by the argument POS) is not in a symbol.
+
+** The options.el library has been removed.
+It was obsolete since Emacs 22.1, replaced by customize.
+
+** The tls.el and starttls.el libraries are now marked obsolete.
+Use of built-in libgnutls based functionality (described in the Emacs
+GnuTLS manual) is recommended instead.
+
+** The url-ns.el library is now marked obsolete.
+This library is used to open configuration files for the long defunct
+web browser Netscape, and is no longer relevant.
+
+
+* Lisp Changes in Emacs 27.1
+
+** Emacs Lisp integers can now be of arbitrary size.
+Emacs uses the GNU Multiple Precision (GMP) library to support
+integers whose size is too large to support natively. The integers
+supported natively are known as "fixnums", while the larger ones are
+"bignums". The new predicates 'bignump' and 'fixnump' can be used to
+distinguish between these two types of integers.
+
+All the arithmetic, comparison, and logical (a.k.a. "bitwise")
+operations where bignums make sense now support both fixnums and
+bignums. However, note that unlike fixnums, bignums will not compare
+equal with 'eq', you must use 'eql' instead. (Numerical comparison
+with '=' works on both, of course.)
+
+Since large bignums consume a lot of memory, Emacs limits the size of
+the largest bignum a Lisp program is allowed to create. The
+nonnegative value of the new variable 'integer-width' specifies the
+maximum number of bits allowed in a bignum. Emacs signals an integer
+overflow error if this limit is exceeded.
+
+Several primitive functions formerly returned floats or lists of
+integers to represent integers that did not fit into fixnums. These
+functions now simply return integers instead. Affected functions
+include functions like 'encode-char' that compute code-points, functions
+like 'file-attributes' that compute file sizes and other attributes,
+functions like 'process-id' that compute process IDs, and functions like
+'user-uid' and 'group-gid' that compute user and group IDs.
+
+** 'overflow-error' is now documented as a subcategory of 'range-error'.
+Formerly it was undocumented, and was (incorrectly) a subcategory
+of 'domain-error'.
+
+** Time values
+
+*** New function 'time-convert' converts Lisp time values to Lisp
+timestamps of various forms, including a new timestamp form '(TICKS
+. HZ)' where TICKS is an integer and HZ a positive integer denoting a
+clock frequency.
+
+*** Although the default timestamp format is still '(HI LO US PS)',
+it is planned to change in a future Emacs version, to exploit bignums.
+The documentation has been updated to mention that the timestamp
+format may change and that programs should use functions like
+'format-time-string', 'decode-time', and 'time-convert' rather than
+probing the innards of a timestamp directly, or creating a timestamp
+by hand.
+
+*** Decoded (calendrical) timestamps now have subsecond resolution.
+This affects 'decode-time', which generates these timestamps, as well
+as functions like 'encode-time' that accept them. The subsecond info
+is present as a '(TICKS . HZ)' value in the seconds element of a
+decoded timestamp, and 'decode-time' has a new optional FORM argument
+specifying the form of the seconds member. For example, if X is the
+timestamp '(1566009571321878186 . 1000000000)', which represents
+"2019-08-17 02:39:31.321878186 UTC", '(decode-time X t t)' returns
+'((31321878186 . 1000000000) 39 2 17 8 2019 6 nil 0)' instead of the
+traditional '(31 39 2 17 8 2019 6 nil 0)' returned by plain
+'(decode-time X t)'. Although the default FORM is currently
+'integer', which truncates the seconds to an integer and is the
+traditional behavior, this default may change in future Emacs
+versions, so callers requiring an integer should specify FORM
+explicitly.
+
+*** 'encode-time' supports a new API '(encode-time TIME)'.
+The old 'encode-time' API is still supported.
+
+*** A new package to parse ISO 8601 time, date, durations and
+intervals has been added. The main function to use is
+'iso8601-parse', but there's also 'iso8601-parse-date',
+'iso8601-parse-time', 'iso8601-parse-duration' and
+'iso8601-parse-interval'. All these functions return decoded time
+structures, except the final one, which returns three of them (start,
+end and duration).
+
+*** 'time-add', 'time-subtract', and 'time-less-p' now accept
+infinities and NaNs too, and propagate them or return nil like
+floating-point operators do. If both arguments are finite, these
+functions now return exact results instead of rounding in some cases,
+and they also avoid excess precision when that is easy.
+
+*** New function 'time-equal-p' compares time values for equality.
+
+*** 'format-time-string' supports a new conversion specifier flag '+'
+that acts like the '0' flag but also puts a '+' before nonnegative
+years containing more than four digits. This is for compatibility
+with POSIX.1-2017.
+
+*** To access (or alter) the elements of a decoded time value, the
+'decoded-time-second', 'decoded-time-minute', 'decoded-time-hour',
+'decoded-time-day', 'decoded-time-month', 'decoded-time-year',
+'decoded-time-weekday', 'decoded-time-dst' and 'decoded-time-zone'
+accessors can be used.
+
+*** The new functions 'date-days-in-month' (which will say how many
+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
+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
+if it is not known whether daylight saving time is in effect.
+Formerly they were inconsistent: 'encode-time' returned t in this
+situation, whereas 'parse-time-string' returned nil. Now they
+consistently use nil to mean that DST is not in effect, and use -1
+to mean that it is not known whether DST is in effect.
+
+** New macro 'benchmark-progn'.
+This macro works like 'progn', but messages how long it takes to
+evaluate the body forms. The value of the last form is the return
+value.
+
+** New function 'read-char-from-minibuffer'.
+This function works like 'read-char', but uses 'read-from-minibuffer'
+to read a character, so it maintains a history that can be navigated
+via usual minibuffer keystrokes 'M-p'/'M-n'.
+
+** New variables 'set-message-function' and 'clear-message-function'
+can be used to specify functions to show and clear messages that
+normally are displayed in the echo area.
+
+** 'setq-local' can now set an arbitrary number of variables, which
+makes the syntax more like 'setq'.
+
+** 'reveal-mode' can now also be used for more than to toggle between
+invisible and visible: It can also toggle 'display' properties in
+overlays. This is only done on 'display' properties that have the
+'reveal-toggle-invisible' property set.
+
+** 'process-contact' now takes an optional NO-BLOCK argument to allow
+not waiting for a process to be set up.
+
+** New variable 'read-process-output-max' controls sub-process throughput.
+This variable determines how many bytes can be read from a sub-process
+in one read operation. The default, 4096 bytes, was previously a
+hard-coded constant. Setting it to a larger value might enhance
+throughput of reading from sub-processes that produces vast
+(megabytes) amounts of data in one go.
+
+** The new user option 'quit-window-hook' is now run first when
+executing the 'quit-window' command.
+
+** The user options 'help-enable-completion-auto-load',
+'help-enable-auto-load' and 'vhdl-project-auto-load', as well as the
+function 'vhdl-auto-load-project' have been renamed to have "autoload"
+without the hyphen in their names. Obsolete aliases from the old
+names have been added.
+
+** Buttons (created with 'make-button' and related functions) can
+now use the 'button-data' property. If present, the data in this
+property will be passed on to the 'action' function instead of the
+button itself in 'button-activate'.
+
+** 'defcustom' now takes a ':local' keyword that can be either t or
+'permanent', which mean that the variable should be automatically
+buffer-local. 'permanent' also sets the variable's 'permanent-local'
+property.
+
+** The new macro 'with-suppressed-warnings' can be used to suppress
+specific byte-compile warnings.
+
+** The new macro 'ignore-error' is like 'ignore-errors', but takes a
+specific error condition, and will only ignore that condition. (This
+can also be a list of conditions.)
+
+** The new function 'byte-compile-info-message' can be used to output
+informational messages that look pleasing during the Emacs build.
+
+** New 'help-fns-describe-variable-functions' hook.
+It makes it possible to add metadata information to 'describe-variable'.
+
+** i18n (internationalization)
+
+*** 'ngettext' can be used now to return the right plural form
+according to the given numeric value.
+
+** 'inhibit-null-byte-detection' is renamed to 'inhibit-nul-byte-detection'.
+
+** 'self-insert-command' takes the char to insert as (optional) argument.
+
+** 'lookup-key' can take a list of keymaps as argument.
+
+** 'condition-case' now accepts t to match any error symbol.
+
+** New function 'proper-list-p'.
+Given a proper list as argument, this predicate returns its length;
+otherwise, it returns nil. 'format-proper-list-p' is now an obsolete
+alias for the new function.
+
+** 'define-minor-mode' automatically documents the meaning of ARG.
+
+** The function 'recenter' now accepts an additional optional argument.
+By default, calling 'recenter' will not redraw the frame even if
+'recenter-redisplay' is non-nil. Call 'recenter' with the new second
+argument non-nil to force redisplay per 'recenter-redisplay's value.
+
+** New functions 'major-mode-suspend' and 'major-mode-restore'.
+Use them when switching temporarily to another major mode, e.g. for
+'hexl-mode', or to switch between 'c-mode' and 'image-mode' in XPM.
+
+** New macro 'dolist-with-progress-reporter'.
+This works like 'dolist', but reports progress similar to
+'dotimes-with-progress-reporter'.
+
+** New hook 'after-delete-frame-functions'.
+This works like 'delete-frame-functions', but runs after the frame to
+be deleted has been made dead and removed from the frame list.
+
+** The function 'provided-mode-derived-p' was extended to support aliases.
+The function now returns non-nil when the argument MODE is derived
+from any alias of any of MODES.
+
+** New frame focus state inspection interface.
+The hooks 'focus-in-hook' and 'focus-out-hook' are now obsolete.
+Instead, attach to 'after-focus-change-function' using 'add-function'
+and inspect the focus state of each frame using 'frame-focus-state'.
+
+** Emacs now requests and recognizes focus-change notifications from TTYs.
+On terminal emulators that support the feature, Emacs can now support
+'focus-in-hook' and 'focus-out-hook' for TTY frames.
+
+** Window-specific face remapping.
+Face specifications (of the kind used in 'face-remapping-alist')
+now support filters, allowing faces to vary between different windows
+displaying the same buffer. See the node "(elisp) Face Remapping"
+of the Emacs Lisp Reference manual for more detail.
+
+** Window change functions have been redesigned.
+Hooks reacting to window changes run now only when redisplay detects
+that a change has actually occurred. Six hooks are now provided:
+'window-buffer-change-functions' (run after window buffers have
+changed), 'window-size-change-functions' (run after a window was
+assigned a new buffer or size), 'window-configuration-change-hook'
+(like the former but run also when a window was deleted),
+'window-selection-change-functions' (run when the selected window
+changed) and 'window-state-change-functions' and
+'window-state-change-hook' (run when any of the preceding ones is
+run). Applications can enforce running the latter two using the new
+function 'set-frame-window-state-change'. 'window-scroll-functions'
+are unaffected by these changes.
+
+In addition, a number of functions now allow the caller to detect what
+has changed since last redisplay: 'window-old-buffer' returns for any
+window the buffer it showed at that time. 'old-selected-window' and
+'old-selected-frame' return the window and frame that were selected
+during last redisplay. 'window-old-pixel-width' (renamed from
+'window-pixel-width-before-size-change'), 'window-old-pixel-height'
+(renamed from 'window-pixel-height-before-size-change'),
+'window-old-body-pixel-width' and 'window-old-body-pixel-height'
+return the total and body sizes of any window during last redisplay.
+
+Also 'run-window-configuration-change-hook' is declared obsolete.
+
+See the section "(elisp) Window Hooks" in the Elisp manual for a
+detailed explanation of the new behavior.
+
+** Scroll bar and fringe settings can now be made persistent for windows.
+The functions 'set-window-scroll-bars' and 'set-window-fringes' now
+have a new optional argument that makes the settings they produce
+reliably survive subsequent invocations of 'set-window-buffer'.
+
+** New user option 'resize-mini-frames'.
+This option allows automatically resizing minibuffer-only frames
+similarly to how minibuffer windows are resized on "normal" frames.
+
+** New buffer display action function 'display-buffer-in-direction'.
+This function allows specifying the location of the window chosen by
+'display-buffer' in various ways.
+
+** New buffer display action alist entry 'dedicated'.
+Such an entry allows specifying the dedicated status of a window
+created by 'display-buffer'.
+
+** New buffer display action alist entry 'window-min-height'.
+Such an entry allows specifying a minimum height of the window used
+for displaying a buffer. 'display-buffer-below-selected' is the only
+action function to respect it at the moment.
+
+** New buffer display action alist entry 'direction'.
+This entry is used to specify the location of the window chosen by
+'display-buffer-in-direction'.
+
+** Additional meaning of display action alist entry 'window'.
+A 'window' entry can now also specify a reference window for
+'display-buffer-in-direction'.
+
+** The function 'assoc-delete-all' now takes an optional predicate argument.
+
+** New function 'string-distance' to calculate the Levenshtein distance
+between two strings.
+
+** 'print-quoted' now defaults to t, so if you want to see
+'(quote x)' instead of 'x you will have to bind it to nil where applicable.
+
+** Numbers formatted via '%o' or '%x' are now formatted as signed integers.
+This avoids problems in calls like '(read (format "#x%x" -1))', and is
+more compatible with bignums. To get the traditional machine-dependent
+behavior, set the experimental variable 'binary-as-unsigned' to t,
+and if the new behavior breaks your code please email
+<32252@debbugs.gnu.org>. Because '%o' and '%x' can now format signed
+integers, they now support the '+' and space flags.
+
+** In Emacs Lisp mode, symbols with confusable quotes are highlighted.
+For example, the first character in '‘foo' would be highlighted in
+'font-lock-warning-face'.
+
+** Omitting variables after '&optional' and '&rest' is now allowed.
+For example '(defun foo (&optional))' is no longer an error. This is
+sometimes convenient when writing macros. See the ChangeLog entry
+titled "Allow '&rest' or '&optional' without following variable
+(Bug#29165)" for a full listing of which arglists are accepted across
+versions.
+
+** Internal parsing commands now use 'syntax-ppss' and disregard
+'open-paren-in-column-0-is-defun-start'. This affects mostly things like
+'forward-comment', 'scan-sexps', and 'forward-sexp' when parsing backward.
+The new variable 'comment-use-syntax-ppss' can be set to nil to recover
+the old behavior if needed.
+This also means that there is no longer any need to precede opening
+brackets at the start of a line inside documentation strings with a
+backslash, although there is no harm in doing so to make the code
+easier to edit with an older Emacs version.
+
+** New symbolic accessor functions for a parse state list.
+The new accessor functions 'ppss-depth', 'ppss-list-start',
+'ppss-last-sexp-start', 'ppss-string-terminator', 'comment-depth',
+'quoted-p', 'comment-style', 'comment-or-string-start', 'open-parens',
+and 'two-character-syntax' can be used on the list value returned by
+'parse-partial-sexp' and 'syntax-ppss'.
+
+** The 'server-name' and 'server-socket-dir' variables are set when a
+socket has been passed to Emacs.
+
+** The 'file-system-info' function is now available on all platforms.
+instead of just Microsoft platforms. This fixes a 'get-free-disk-space'
+bug on OS X 10.8 and later.
+
+** The function 'get-free-disk-space' returns now a non-nil value for
+remote systems, which support this check.
+
+** 'memory-limit' now returns a better estimate of memory consumption.
+
+** When interpreting 'gc-cons-percentage', Emacs now estimates the
+heap size more often and (we hope) more accurately. E.g., formerly
+'(progn (let ((gc-cons-percentage 0.8)) BODY1) BODY2)' continued to use
+the 0.8 value during BODY2 until the next garbage collection, but that
+is no longer true. Applications may need to re-tune their GC tricks.
+
+** New macro 'combine-change-calls' arranges to call the change hooks
+('before-change-functions' and 'after-change-functions') just once
+each around a sequence of lisp forms, given a region. This is
+useful when a function makes a possibly large number of repetitive
+changes and the change hooks are time consuming.
+
+** 'eql', 'make-hash-table', etc. now treat NaNs consistently.
+Formerly, some of these functions ignored signs and significands of
+NaNs. Now, all these functions treat NaN signs and significands as
+significant. For example, '(eql 0.0e+NaN -0.0e+NaN)' now returns nil
+because the two NaNs have different signs; formerly it returned t.
+Also, Emacs now reads and prints NaN significands; e.g., if X is a
+NaN, '(format "%s" X)' now returns "0.0e+NaN", "1.0e+NaN", etc.,
+depending on X's significand.
+
+** The function 'make-string' accepts an additional optional argument.
+If the optional third argument is non-nil, 'make-string' will produce
+a multibyte string even if its second argument is an ASCII character.
+
+** '(format "%d" X)' no longer mishandles a floating-point number X that
+does not fit in a machine integer.
+
+** New coding-system 'ibm038'.
+This is the International EBCDIC encoding, also available as aliases
+'ebcdic-int' and 'cp038'.
+
+** New JSON parsing and serialization functions 'json-serialize',
+'json-insert', 'json-parse-string', and 'json-parse-buffer'. These
+are implemented in C using the Jansson library.
+
+** New function 'ring-resize'.
+'ring-resize' can be used to grow or shrink a ring.
+
+** New function 'flatten-tree'.
+'flatten-list' is provided as an alias. These functions take a tree
+and 'flatten' it such that the result is a list of all the terminal
+nodes.
+
+** 'zlib-decompress-region' can partially decompress corrupted data.
+If the new optional ALLOW-PARTIAL argument is passed, then the data
+that was decompressed successfully before failing will be inserted
+into the buffer.
+
+** Image mode
+
+*** New library Exif.
+An Exif library has been added that can parse JPEG files and output
+data about creation times and orientation and the like.
+'exif-parse-file' and 'exif-parse-buffer' are the main interface
+functions.
+
+*** 'image-mode' now uses this library to automatically rotate images
+according to the orientation in the Exif data, if any.
+
+*** The command 'image-rotate' now accepts a prefix argument.
+With a prefix argument, 'image-rotate' now rotates the image at point
+90 degrees counter-clockwise, instead of the default clockwise.
+
+*** In 'image-mode' the image is resized automatically to fit in window.
+By default, the image will resize upon first display and whenever the
+window's dimensions change. Two user options 'image-auto-resize' and
+'image-auto-resize-on-window-resize' control the resizing behavior
+(including the possibility to disable auto-resizing). A new prefix
+key 's' contains the commands that can be used to fit the image to the
+window manually.
+
+*** Some 'image-mode' variables are now buffer-local.
+The image parameters 'image-transform-rotation',
+'image-transform-scale' and 'image-transform-resize' are now declared
+buffer-local, so each buffer could have its own values for these
+parameters.
+
+*** Three new 'image-mode' commands have been added: 'm', which marks
+the file in the dired buffer(s) for the directory the file is in; 'u',
+which unmarks the file; and 'w', which pushes the current buffer's file
+name to the kill ring.
+
+*** New library image-converter.
+If you need to view exotic image formats for which Emacs doesn't have
+native support, customize the new user option
+'image-use-external-converter' to t. If your system has
+GraphicsMagick, ImageMagick or 'ffmpeg' installed, they will then be
+used to convert images automatically before displaying them.
+
+*** 'auto-mode-alist' now includes many of the types typically
+supported by the external image converters, like WEPB, BMP and ICO.
+These now default to using 'image-mode'.
+
+*** 'imagemagick-types-inhibit' disables using ImageMagick by default.
+'image-mode' started using ImageMagick by default for all images
+some years back. It now respects 'imagemagick-types-inhibit' as a way
+to disable that.
+
+** Modules
+
+*** The function 'load' now behaves correctly when loading modules.
+Specifically, it puts the module name into 'load-history', prints
+loading messages if requested, and protects against recursive loads.
+
+*** New module environment function 'process_input' to process user
+input while module code is running.
+
+*** New module environment functions 'make_time' and 'extract_time' to
+convert between timespec structures and Emacs Lisp time values.
+
+*** New module environment functions 'make_big_integer' and
+'extract_big_integer' to create and extract arbitrary-size integer
+values.
+
+*** emacs-module.h now defines a macro 'EMACS_MAJOR_VERSION' that expands
+to the major version of the latest Emacs supported by the header.
+
+** The function 'read-variable' now uses its own history list.
+The history of variable names read by 'read-variable' is recorded in
+the new variable 'custom-variable-history'.
+
+** The functions 'string-to-unibyte' and 'string-to-multibyte' are no
+longer declared obsolete. We have found that there are legitimate use
+cases for these functions, where there's no better alternative. We
+believe that the incorrect uses of these functions all but disappeared
+by now, so we are un-obsoleting them.
+
+** New function 'group-name' returns a group name corresponding to GID.
+
+** 'make-process' now takes a keyword argument ':file-handler'; if
+that is non-nil, it will look for a file name handler for the current
+buffer's 'default-directory' and invoke that file name handler to make
+the process. That way 'make-process' can start remote processes.
+
+** '(locale-info 'paper)' now returns the paper size on systems that support it.
+This is currently supported on GNUish hosts and on modern versions of
+MS-Windows.
+
+** The function 'regexp-opt', when given an empty list of strings, now
+returns a regexp that never matches anything, which is an identity for
+this operation. Previously, the empty string was returned in this
+case.
+
+** New constant 'regexp-unmatchable' contains a never-matching regexp.
+It is a convenient and readable way to specify a regexp that should
+not match anything, and is as fast as any such regexp can be.
+
+** New functions to handle the URL variant of base-64 encoding.
+New functions 'base64url-encode-string' and 'base64url-encode-region'
+implement the url-variant of base-64 encoding as defined in RFC4648.
+
+The functions 'base64-decode-string' and 'base64-decode-region' now
+accept an optional argument to decode the URL variant of base-64
+encoding.
+
+** The function 'file-size-human-readable' accepts more optional arguments.
+The new third argument is a string put between the number and unit; it
+defaults to the empty string. The new fourth argument is a string
+representing the unit to use; it defaults to "B" when the second
+argument is 'iec' and the empty string otherwise. We recommend a
+space or non-breaking space as third argument, and "B" as fourth
+argument, circumstances allowing.
+
+** 'format-spec' has been expanded with several modifiers to allow
+greater flexibility when customizing variables. The modifiers include
+zero-padding, upper- and lower-casing, and limiting the length of the
+interpolated strings. The function has now also been documented in
+the Emacs Lisp manual.
+
+** 'directory-files-recursively' can now take an optional PREDICATE
+parameter to control descending into subdirectories, and a
+FOLLOW-SYMLINK parameter to say that symbolic links that point to
+other directories should be followed.
+
+** New function 'xor' returns the boolean exclusive-or of its args.
+The function was previously defined in array.el, but has been moved to
+subr.el so that it is available by default. It now always returns the
+non-nil argument when the other is nil. Several duplicates of 'xor'
+in other packages are now obsolete aliases of 'xor'.
+
+** 'define-globalized-minor-mode' now takes BODY forms.
+
+** New text property 'help-echo-inhibit-substitution'.
+Setting this on the first character of a help string disables
+conversions via 'substitute-command-keys'.
+
+** New text property 'minibuffer-message'.
+Setting this on a character of the minibuffer text will display the
+temporary echo messages before that character, when messages need to
+be displayed while minibuffer is active.
+
+** 'undo' can be made to ignore the active region for a command
+by setting 'undo-inhibit-region' symbol property of that command to
+non-nil. This is used by 'mouse-drag-region' to make the effect
+easier to undo immediately afterwards.
+
+** When called interactively, 'next-buffer' and 'previous-buffer' now
+signal 'user-error' if there is no buffer to switch to.
+
+
+* Changes in Emacs 27.1 on Non-Free Operating Systems
+
+** Battery status is now supported in all Cygwin builds.
+Previously it was supported only in the Cygwin-w32 build.
+
+** Emacs now handles key combinations involving the macOS "command"
+and "option" modifier keys more correctly.
+
+** MacOS modifier key behavior is now more adjustable.
+The behavior of the macOS "Option", "Command", "Control" and
+"Function" keys can now be specified separately for use with
+ordinary keys, function keys and mouse clicks. This allows using them
+in their standard macOS way for composing characters.
+
+** The special handling of 'frame-title-format' on NS where setting it
+to t would enable the macOS proxy icon has been replaced with a
+separate variable, 'ns-use-proxy-icon'. 'frame-title-format' will now
+work as on other platforms.
+
+** New primitive 'w32-read-registry'.
+This primitive lets Lisp programs access the MS-Windows Registry by
+retrieving values stored under a given key. It is intended to be used
+for supporting features such as XDG-like location of important files
+and directories.
+
+** The default value of 'w32-pipe-read-delay' is now zero.
+This speeds up reading output from sub-processes that produce a lot of
+data.
+
+This variable may need to be non-zero only when running DOS programs
+as Emacs subprocesses, which by now is not supported on modern
+versions of MS-Windows. Set this variable to 50 if for some reason
+you need the old behavior (and please report such situations to Emacs
+developers).
+
+** New variable 'w32-multibyte-code-page'.
+This variable holds the value of the multibyte code page used by the
+system. It is usually zero, which indicates that 'w32-ansi-code-page'
+is being used, except in Far Eastern locales. When this variable is
+non-zero, Emacs at startup sets 'locale-coding-system' to the
+corresponding encoding, instead of using 'w32-ansi-code-page'.
+
+** The default value of 'inhibit-compacting-font-caches' is t on MS-Windows.
+Experience shows that compacting font caches causes more trouble on
+MS-Windows than it helps.
+
+** Font lookup on MS-Windows was improved to support rare scripts.
+To activate the improvement, run the new function
+'w32-find-non-USB-fonts' once per Emacs session, or assign to the new
+variable 'w32-non-USB-fonts' the list of scripts and the corresponding
+fonts. See the documentation of this function and variable in the
+Emacs manual for more details.
+
+** On NS the behavior of drag and drop can now be modified by use of
+modifier keys in line with Apples guidelines. This makes the drag and
+drop behavior more consistent, as previously the sending application
+was able to 'set' modifiers without the knowledge of the user.
+
+** On NS multicolor font display is enabled again since it is also
+implemented in Emacs on free operating systems via Cairo drawing.
+
+
+----------------------------------------------------------------------
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+
+Local variables:
+coding: utf-8
+mode: outline
+paragraph-separate: "[ ]*$"
+end:
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 32ac715e621..dada27fa55c 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -318,6 +318,83 @@ element from LD_LIBRARY_PATH before starting emacs proper.
Or you could recompile Emacs with an -Wl,-rpath option that
gives the location of the correct libotf.
+* Problems when reading or debugging Emacs C code
+
+Because Emacs does not install a copy of its C source code, users
+normally cannot easily read that code via commands like 'M-x
+describe-function' (C-h f) that display the definition of a function.
+However, some GNU/Linux systems provide separate packages containing
+this source code which can get C-h f to work if you are willing to do
+some tinkering, and some systems also provide packages containing
+debug info, which when combined with the source can be used to debug
+Emacs at the C level.
+
+** Debian-based source and debuginfo
+
+On recent Debian-based systems, you can obtain and use a source
+package of Emacs as follows.
+
+*** Add the appropriate URI to /etc/apt/sources.list.
+
+To do this, become superuser and uncomment or add the appropriate
+'deb-src' line. Details depend on the distribution.
+
+*** Execute a command like 'apt-get source emacs'.
+
+On older systems, append the top-level version number, e.g., 'apt-get
+source emacs25'. The target directory for unpacking the source tree
+is the current directory.
+
+*** Set find-function-C-source-directory accordingly.
+
+Once you have installed the source package, for example at
+/home/myself/deb-src/emacs-26.3, add the following line to your
+startup file:
+
+ (setq find-function-C-source-directory
+ "/home/myself/deb-src/emacs-26.3/src/")
+
+The installation directory of the Emacs source package will contain
+the exact package name and version number of Emacs that is installed
+on your system. If a new Emacs package is installed, the source
+package must be reinstalled as well, and the setting in your startup
+file must be updated.
+
+*** Debian-based debuginfo
+
+You can also install a debug package of Emacs with a command like
+'apt-get install emacs-dbg' (on older systems, 'apt-get install
+emacs25-dbg'). You need to arrange for GDB to find where you
+installed the source code, e.g., by using GDB's 'directory' command.
+
+** Red Hat-based source and debuginfo
+
+On recent Red Hat-based systems, you can install source and debug info
+via superuser commands like the following:
+
+ # Add the *-debuginfo repositories (exact command depends on system).
+ dnf config-manager --set-enabled fedora-debuginfo updates-debuginfo'
+
+ # Install Emacs source and debug info.
+ dnf install emacs-debugsource
+
+To get describe-function and similar commands to work, you can then
+add something like the following to your startup file:
+
+ (setq find-function-C-source-directory
+ "/usr/src/debug/emacs-26.3-1.fc31.x86_64/src/")
+
+However, the exact directory name will depend on the system, and you
+will need to both upgrade source and debug info when your system
+upgrades or patches Emacs, and change your startup file accordingly.
+
+** Source and debuginfo for other systems
+
+If your system follows neither the Debian nor the Red Hat patterns,
+you can obtain the source and debuginfo by obtaining the source code
+of Emacs, building Emacs with the appropriate debug flags enabled, and
+running the just-built Emacs.
+
* General runtime problems
** Lisp problems
@@ -342,27 +419,6 @@ EMACSLOADPATH overrides which directories the function "load" will search.
If you observe strange problems, check for this variable in your
environment.
-*** Using epop3.el package causes Emacs to signal an error.
-
-The error message might be something like this:
-
- "Lisp nesting exceeds max-lisp-eval-depth"
-
-This happens because epop3 redefines the function gethash, which is a
-built-in primitive beginning with Emacs 21.1. We don't have a patch
-for epop3 to fix it, but perhaps a newer version of epop3 corrects that.
-
-*** Buffers from 'with-output-to-temp-buffer' get set up in Help mode.
-
-Changes in Emacs 20.4 to the hooks used by that function cause
-problems for some packages, specifically BBDB. See the function's
-documentation for the hooks involved. BBDB 2.00.06 fixes the problem.
-
-*** The Hyperbole package causes *Help* buffers not to be displayed in
-Help mode due to setting 'temp-buffer-show-hook' rather than using
-'add-hook'. Using '(add-hook 'temp-buffer-show-hook 'help-mode-finish)'
-after loading Hyperbole should fix this.
-
** Keyboard problems
*** Unable to enter the M-| key on some German keyboards.
@@ -498,13 +554,6 @@ For example, simply moving through a file that contains hundreds of
thousands of characters per line is slow, and consumes a lot of CPU.
This is a known limitation of Emacs with no solution at this time.
-*** Emacs uses 100% of CPU time
-
-This was a known problem with some old versions of the Semantic package.
-The solution was to upgrade Semantic to version 2.0pre4 (distributed
-with CEDET 1.0pre4) or later. Note that Emacs includes Semantic since
-23.2, and this issue does not apply to the included version.
-
*** Display artifacts on GUI frames on X-based systems.
This is known to be caused by using double-buffering (which is enabled
@@ -1566,6 +1615,12 @@ even if you should be able to paste, and similar).
You can get back menus on each frame by starting emacs like this:
% env UBUNTU_MENUPROXY= emacs
+*** Mouse click coordinates not recognized correctly on multiple monitors.
+
+This happens on the proprietary X server ASTEC-X when the number of
+monitors is changed after the server has started. A workaround is to
+restart the X server after the monitor configuration has been changed.
+
* Runtime problems on character terminals
** The meta key does not work on xterm.
@@ -1888,11 +1943,6 @@ A few versions of the Linux kernel have timer bugs that break CPU
profiling; see Bug#34235. To fix the problem, upgrade to one of the
kernel versions 4.14.97, 4.19.19, or 4.20.6, or later.
-*** GNU/Linux: Process output is corrupted.
-
-There is a bug in Linux kernel 2.6.10 PTYs that can cause emacs to
-read corrupted process output.
-
*** GNU/Linux: Remote access to CVS with SSH causes file corruption.
If you access a remote CVS repository via SSH, files may be corrupted
@@ -2158,6 +2208,7 @@ We list bugs in current versions here. See also the section on legacy
systems.
*** On Solaris 10, Emacs crashes during the build process.
+(This applies only with './configure --with-unexec=yes', which is rare.)
This was reported for Emacs 25.2 on i386-pc-solaris2.10 with Sun
Studio 12 (Sun C 5.9) and with Oracle Developer Studio 12.6 (Sun C
5.15), and intermittently for sparc-sun-solaris2.10 with Oracle
@@ -2175,66 +2226,6 @@ Solaris. See Bug#26638.
This is a Solaris feature (at least on Intel x86 cpus). Type C-r
C-r C-t, to toggle whether C-x gets through to Emacs.
-*** Problem with remote X server on Suns.
-
-On a Sun, running Emacs on one machine with the X server on another
-may not work if you have used the unshared system libraries. This
-is because the unshared libraries fail to use YP for host name lookup.
-As a result, the host name you specify may not be recognized.
-
-*** Solaris 2.6: Emacs crashes with SIGBUS or SIGSEGV on Solaris after you delete a frame.
-
-We suspect that this is a bug in the X libraries provided by
-Sun. There is a report that one of these patches fixes the bug and
-makes the problem stop:
-
-105216-01 105393-01 105518-01 105621-01 105665-01 105615-02 105216-02
-105667-01 105401-08 105615-03 105621-02 105686-02 105736-01 105755-03
-106033-01 105379-01 105786-01 105181-04 105379-03 105786-04 105845-01
-105284-05 105669-02 105837-01 105837-02 105558-01 106125-02 105407-01
-
-Another person using a newer system (kernel patch level Generic_105181-06)
-suspects that the bug was fixed by one of these more recent patches:
-
-106040-07 SunOS 5.6: X Input & Output Method patch
-106222-01 OpenWindows 3.6: filemgr (ff.core) fixes
-105284-12 Motif 1.2.7: sparc Runtime library patch
-
-*** Solaris 7 or 8: Emacs reports a BadAtom error (from X)
-
-This happens when Emacs was built on some other version of Solaris.
-Rebuild it on Solaris 8.
-
-*** When using M-x dbx with the SparcWorks debugger, the 'up' and 'down'
-commands do not move the arrow in Emacs.
-
-You can fix this by adding the following line to '~/.dbxinit':
-
- dbxenv output_short_file_name off
-
-*** On Solaris, CTRL-t is ignored by Emacs when you use
-the fr.ISO-8859-15 locale (and maybe other related locales).
-
-You can fix this by editing the file:
-
- /usr/openwin/lib/locale/iso8859-15/Compose
-
-Near the bottom there is a line that reads:
-
- Ctrl<t> <quotedbl> <Y> : "\276" threequarters
-
-while it should read:
-
- Ctrl<T> <quotedbl> <Y> : "\276" threequarters
-
-Note the lower case <t>. Changing this line should make C-t work.
-
-*** On Solaris, Emacs fails to set menu-bar-update-hook on startup, with error
-"Error in menu-bar-update-hook: (error Point before start of properties)".
-This seems to be a GCC optimization bug that occurs for GCC 4.1.2 (-g
-and -g -O2) and GCC 4.2.3 (-g -O and -g -O2). You can fix this by
-compiling with GCC 4.2.3 or CC 5.7, with no optimizations.
-
* Runtime problems specific to MS-Windows
** Emacs on Windows 9X requires UNICOWS.DLL
@@ -2660,15 +2651,6 @@ If you do, please send it to bug-gnu-emacs@gnu.org so we can list it here.
Libxpm is available for macOS as part of the XQuartz project.
-** The color list can become corrupt.
-
-This can be seen when Emacs is run from the command line and produces
-output containing the text:
-
- non-keyed archive cannot be decoded by NSKeyedUnarchiver
-
-The solution is to delete '$HOME/Library/Colors/Emacs.clr'.
-
* Build-time problems
@@ -2678,13 +2660,13 @@ The solution is to delete '$HOME/Library/Colors/Emacs.clr'.
This indicates a mismatch between the C compiler and preprocessor that
configure is using. For example, on Solaris 10 trying to use
-CC=/opt/SUNWspro/bin/cc (the Sun Studio compiler) together with
-CPP=/usr/ccs/lib/cpp can result in errors of this form (you may also
-see the error '"/usr/include/sys/isa_defs.h", line 500: undefined control').
+CC=/opt/developerstudio12.6/bin/cc (the Oracle Developer Studio
+compiler) together with CPP=/usr/lib/cpp can result in errors of
+this form.
The solution is to tell configure to use the correct C preprocessor
-for your C compiler (CPP="/opt/SUNWspro/bin/cc -E" in the above
-example).
+for your C compiler (CPP="/opt/developerstudio12.6/bin/cc -E" in the
+above example).
** Compilation
@@ -2744,11 +2726,6 @@ library on these systems. The solution is to reconfigure Emacs while
disabling all the features that require libgio: rsvg, dbus, gconf, and
imagemagick.
-*** Building Emacs for Cygwin can fail with GCC 3
-
-As of Emacs 22.1, there have been stability problems with Cygwin
-builds of Emacs using GCC 3. Cygwin users are advised to use GCC 4.
-
*** Building Emacs 23.3 and later will fail under Cygwin 1.5.19
This is a consequence of a change to src/dired.c on 2010-07-27. The
@@ -3055,7 +3032,69 @@ This section covers bugs reported on very old hardware or software.
If you are using hardware and an operating system shipped after 2000,
it is unlikely you will see any of these.
-*** Solaris 2.x
+** Solaris
+
+*** Problem with remote X server on Suns.
+
+On a Sun, running Emacs on one machine with the X server on another
+may not work if you have used the unshared system libraries. This
+is because the unshared libraries fail to use YP for host name lookup.
+As a result, the host name you specify may not be recognized.
+
+*** Solaris 2.6: Emacs crashes with SIGBUS or SIGSEGV on Solaris after you delete a frame.
+
+We suspect that this is a bug in the X libraries provided by
+Sun. There is a report that one of these patches fixes the bug and
+makes the problem stop:
+
+105216-01 105393-01 105518-01 105621-01 105665-01 105615-02 105216-02
+105667-01 105401-08 105615-03 105621-02 105686-02 105736-01 105755-03
+106033-01 105379-01 105786-01 105181-04 105379-03 105786-04 105845-01
+105284-05 105669-02 105837-01 105837-02 105558-01 106125-02 105407-01
+
+Another person using a newer system (kernel patch level Generic_105181-06)
+suspects that the bug was fixed by one of these more recent patches:
+
+106040-07 SunOS 5.6: X Input & Output Method patch
+106222-01 OpenWindows 3.6: filemgr (ff.core) fixes
+105284-12 Motif 1.2.7: sparc Runtime library patch
+
+*** Solaris 7 or 8: Emacs reports a BadAtom error (from X)
+
+This happens when Emacs was built on some other version of Solaris.
+Rebuild it on Solaris 8.
+
+*** When using M-x dbx with the SparcWorks debugger, the 'up' and 'down'
+commands do not move the arrow in Emacs.
+
+You can fix this by adding the following line to '~/.dbxinit':
+
+ dbxenv output_short_file_name off
+
+*** On Solaris, CTRL-t is ignored by Emacs when you use
+the fr.ISO-8859-15 locale (and maybe other related locales).
+
+You can fix this by editing the file:
+
+ /usr/openwin/lib/locale/iso8859-15/Compose
+
+Near the bottom there is a line that reads:
+
+ Ctrl<t> <quotedbl> <Y> : "\276" threequarters
+
+while it should read:
+
+ Ctrl<T> <quotedbl> <Y> : "\276" threequarters
+
+Note the lower case <t>. Changing this line should make C-t work.
+
+*** On Solaris, Emacs fails to set menu-bar-update-hook on startup, with error
+"Error in menu-bar-update-hook: (error Point before start of properties)".
+This seems to be a GCC optimization bug that occurs for GCC 4.1.2 (-g
+and -g -O2) and GCC 4.2.3 (-g -O and -g -O2). You can fix this by
+compiling with GCC 4.2.3 or CC 5.7, with no optimizations.
+
+*** Other legacy Solaris problems
**** Strange results from format %d in a few cases, on a Sun.
diff --git a/etc/TODO b/etc/TODO
index 152a29964f3..467b08e0bf2 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -924,17 +924,14 @@ features of that interface could be implemented NS.
**** Smooth scrolling -- maybe not a good idea
Today, by default, scrolling with a trackpad makes the text move in
-steps of five lines. (Scrolling with SHIFT scrolls one line at a time.)
+steps of one line. (Scrolling with SHIFT scrolls horizontally.)
The "mac" port provides smooth, pixel-based, scrolling. This is a very
-popular features. However, there are drawbacks to this method: what
+popular feature. However, there are drawbacks to this method: what
happens if only a fraction of a line is visible at the top of a
window, is the partially visible text considered part of the window or
not? (Technically, what should 'window-start' return.)
-An alternative would be to make one-line scrolling the default on NS
-(or in Emacs in general).
-
Note: This feature might not be allowed to be implemented until also
implemented in Emacs for a free system.
diff --git a/etc/compilation.txt b/etc/compilation.txt
index ebce6a14d06..df0b82ebc92 100644
--- a/etc/compilation.txt
+++ b/etc/compilation.txt
@@ -237,6 +237,20 @@ Register 6 contains wrong type
==1332== by 0x8008621: main (vtest.c:180)
+* javac Java compiler
+
+symbol: javac
+
+Should also work when compiling Java with Gradle. We use the position
+of "^" in the third line as column number because no explicit value is
+present.
+
+Test.java:5: error: ';' expected
+ foo foo
+ ^
+1 error
+
+
* IBM jikes
symbols: jikes-file jikes-line
@@ -367,6 +381,7 @@ made it more strict about the error message that follows.
keyboard handler.c(537) : warning C4005: 'min' : macro redefinition
d:\tmp\test.c(23) : error C2143: syntax error : missing ';' before 'if'
d:\tmp\test.c(1145) : see declaration of 'nsRefPtr'
+c:\tmp\test.cpp(101,11): error C4101: 'bias0123': unreferenced local variable [c:\tmp\project.vcxproj]
1>test_main.cpp(29): error C2144: syntax error : 'int' should be preceded by ';'
1>test_main.cpp(29): error C4430: missing type specifier - int assumed. Note: C++ does not support default-int
1>
@@ -521,6 +536,14 @@ cc-1070 cc: WARNING File = linkl.c, Line = 38
cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 3
+* ShellCheck
+
+In autogen.sh line 38:
+autoconf_min=`sed -n 's/^ *AC_PREREQ(\([0-9\.]*\)).*/\1/p' configure.ac`
+^----------^ SC2034: autoconf_min appears unused. Verify use (or export if used externally).
+ ^-- SC2006: Use $(...) notation instead of legacy backticked `...`.
+
+
* Sun Ada (VADS, Solaris)
symbol: sun-ada
diff --git a/etc/edt-user.el b/etc/edt-user.el
index 0ecd818ec78..2852f936f22 100644
--- a/etc/edt-user.el
+++ b/etc/edt-user.el
@@ -1,4 +1,4 @@
-;;; edt-user.el --- Sample user customizations for Emacs EDT emulation
+;;; edt-user.el --- Sample user customizations for Emacs EDT emulation -*- lexical-binding: t -*-
;; Copyright (C) 1986, 1992-1993, 2000-2020 Free Software Foundation,
;; Inc.
diff --git a/etc/emacs-mail.desktop b/etc/emacs-mail.desktop
new file mode 100644
index 00000000000..3a96b9ec8c7
--- /dev/null
+++ b/etc/emacs-mail.desktop
@@ -0,0 +1,10 @@
+[Desktop Entry]
+Categories=Network;Email;
+Comment=GNU Emacs is an extensible, customizable text editor - and more
+Exec=emacs -f message-mailto %u
+Icon=emacs
+Name=Emacs (Mail)
+MimeType=x-scheme-handler/mailto;
+NoDisplay=false
+Terminal=false
+Type=Application
diff --git a/etc/emacs.service b/etc/emacs.service
index c99c6779f58..0dc2418269e 100644
--- a/etc/emacs.service
+++ b/etc/emacs.service
@@ -8,7 +8,7 @@ Documentation=info:emacs man:emacs(1) https://gnu.org/software/emacs/
[Service]
Type=notify
-ExecStart=emacs --fg-daemon
+ExecStart=@emacs emacsd --fg-daemon
ExecStop=emacsclient --eval "(kill-emacs)"
# The location of the SSH auth socket varies by distribution, and some
# set it from PAM, so don't override by default.
diff --git a/etc/emacsclient.desktop b/etc/emacsclient.desktop
new file mode 100644
index 00000000000..3feb83c7290
--- /dev/null
+++ b/etc/emacsclient.desktop
@@ -0,0 +1,12 @@
+[Desktop Entry]
+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
+Icon=emacs
+Type=Application
+Terminal=false
+Categories=Development;TextEditor;
+StartupWMClass=Emacsd
+Keywords=Text;Editor;
diff --git a/etc/forms/forms-d2.el b/etc/forms/forms-d2.el
index 67cdb9cd010..1b0d6426e03 100644
--- a/etc/forms/forms-d2.el
+++ b/etc/forms/forms-d2.el
@@ -1,4 +1,4 @@
-;;; forms-d2.el --- demo forms-mode
+;;; forms-d2.el --- demo forms-mode -*- lexical-binding:t -*-
;; Copyright (C) 1991, 1994-1997, 2001-2020 Free Software Foundation,
;; Inc.
diff --git a/etc/forms/forms-pass.el b/etc/forms/forms-pass.el
index 34d4548434b..0f4ab48247e 100644
--- a/etc/forms/forms-pass.el
+++ b/etc/forms/forms-pass.el
@@ -1,4 +1,4 @@
-;;; forms-pass.el --- passwd file demo for forms-mode
+;;; forms-pass.el --- passwd file demo for forms-mode -*- lexical-binding:t -*-
;; This file is part of GNU Emacs.
diff --git a/etc/refcards/cs-refcard.tex b/etc/refcards/cs-refcard.tex
index 3b299bdd3ea..5a3adb80b3b 100644
--- a/etc/refcards/cs-refcard.tex
+++ b/etc/refcards/cs-refcard.tex
@@ -494,7 +494,6 @@ z~minibufferu. Stiskněte \kbd{F10} pro aktivaci menu v~minibufferu.
\section{Tagy}
\key{najít tag (definici)}{M-.}
-\key{najít další výskyt tagu}{C-u M-.}
\metax{zadat soubor s novými tagy}{M-x visit-tags-table}
\metax{vyhledat reg.\ výraz v~souborech s~tagy}{M-x tags-search}
diff --git a/etc/refcards/cs-survival.tex b/etc/refcards/cs-survival.tex
index 21f27479ebf..699dd9054d6 100644
--- a/etc/refcards/cs-survival.tex
+++ b/etc/refcards/cs-survival.tex
@@ -255,7 +255,6 @@ proměnných, datových typů a dalšího. Pro vytvoření tabulky značek spus
příkaz `{\tt etags} {\it vstupní\_soubory}' v příkazovém interpretu.
\askip
\key{M-.} najdi definici
-\key{C-u M-.} najdi další výskyt definice
\key{M-*} běž tam, odkud byla volána poslední \kbd{M-.}
\mkey{M-x tags-query-replace} spusť query-replace na všech souborech
zaznamenaných v tabulce značek.
diff --git a/etc/refcards/de-refcard.tex b/etc/refcards/de-refcard.tex
index 6d972ee52b5..29ddf12d49f 100644
--- a/etc/refcards/de-refcard.tex
+++ b/etc/refcards/de-refcard.tex
@@ -497,7 +497,6 @@ und zu wiederholen, der im Minipuffer aus\-gef\"uhrt wurde. Dr\"u\-cken Sie
\section{Tags}
\key{Tag finden (Definition)}{M-.}
-\key{n\"achstes Vorkommen von Tag finden}{C-u M-.}
\metax{neue Tagsdatei angeben}{M-x visit-tags-table}
\metax{regul\"aren Ausdruck in Dateien suchen}{M-x tags-search}
diff --git a/etc/refcards/fr-refcard.tex b/etc/refcards/fr-refcard.tex
index 787556d386a..fe303ee8a51 100644
--- a/etc/refcards/fr-refcard.tex
+++ b/etc/refcards/fr-refcard.tex
@@ -500,7 +500,6 @@ utiliser la barre de menu sur un terminal en utilisant le mini-tampon.
\section{Tags}
\key{Trouver un tag (une d\'efinition)}{M-.}
-\key{Passer \`a l'occurrence suivante du tag}{C-u M-.}
\metax{Sp\'ecifier un autre fichier de tags}{M-x visit-tags-table}
\metax{Rechercher dans tous les fichiers des tags}{M-x tags-search}
diff --git a/etc/refcards/fr-survival.tex b/etc/refcards/fr-survival.tex
index 0aa5df3786c..1cd6852db83 100644
--- a/etc/refcards/fr-survival.tex
+++ b/etc/refcards/fr-survival.tex
@@ -251,7 +251,6 @@ types de donn\'ees et de tout ce qui peut \^etre pratique. Pour cr\'eer un
tel fichier, tapez `{\tt etags} {\it fichier\_entr\'ee}' \`a l'invite du shell.
\askip
\key{M-.} trouve une d\'efinition
-\key{C-u M-.} trouve l'occurrence suivante de la d\'efinition
\key{M-*} revient o\`u \kbd{M-.} a \'et\'e appel\'e pour la derni\`ere fois
\mkey{M-x tags-query-replace} lance query-replace sur tous les
fichiers enregistr\'es dans le tableau des marqueurs
diff --git a/etc/refcards/pl-refcard.tex b/etc/refcards/pl-refcard.tex
index 68acac973b0..2b92fb5545d 100644
--- a/etc/refcards/pl-refcard.tex
+++ b/etc/refcards/pl-refcard.tex
@@ -690,10 +690,8 @@ Napisz \kbd{F10} aby uaktywni/c menu w minibuforze.
\section{Tags}
%\key{find a tag (a definition)}{M-.}
-%\key{find next occurrence of tag}{C-u M-.}
%\metax{specify a new tags file}{M-x visit-tags-table}
\key{znajd/x okre/slenie (definicj/e)}{M-.}
-\key{znajd/x nast/epne wyst/apienie definicji}{C-u M-.}
\metax{podaj nowy plik TAGS}{M-x visit-tags-table}
%\metax{regexp search on all files in tags table}{M-x tags-search}
diff --git a/etc/refcards/pt-br-refcard.tex b/etc/refcards/pt-br-refcard.tex
index c75fd2f6406..d4e3123458f 100644
--- a/etc/refcards/pt-br-refcard.tex
+++ b/etc/refcards/pt-br-refcard.tex
@@ -506,7 +506,6 @@ utilizado. Tecle \kbd{F10} para ativar o menu.
\section{Tags}
\key{busca uma tag (uma defini{\c{c}}{\~a}o)}{M-.}
-\key{encontra a pr{\'o}xima ocorr{\^e}ncia da tag}{C-u M-.}
\metax{especifica um novo arquivo de tags}{M-x visit-tags-table}
\metax{busca por regexp em todos arquivos}{M-x tags-search}
diff --git a/etc/refcards/refcard.tex b/etc/refcards/refcard.tex
index afae238c783..6cac28fabbb 100644
--- a/etc/refcards/refcard.tex
+++ b/etc/refcards/refcard.tex
@@ -511,7 +511,6 @@ minibuffer. Type \kbd{F10} to activate menu bar items on text terminals.
\section{Tags}
\key{find a tag (a definition)}{M-.}
-\key{find next occurrence of tag}{C-u M-.}
\metax{specify a new tags file}{M-x visit-tags-table}
\metax{regexp search on all files in tags table}{M-x tags-search}
@@ -562,8 +561,8 @@ minibuffer. Type \kbd{F10} to activate menu bar items on text terminals.
\key{quote regular expression special character {\it c\/}}{\\{\it c}}
\key{alternative (``or'')}{\\|}
\key{grouping}{\\( {\rm$\ldots$} \\)}
-\key{shy grouping}{\\(:? {\rm$\ldots$} \\)}
-\key{explicit numbered grouping}{\\(:NUM {\rm$\ldots$} \\)}
+\key{shy grouping}{\\(?: {\rm$\ldots$} \\)}
+\key{explicit numbered grouping}{\\(?NUM: {\rm$\ldots$} \\)}
\key{same text as {\it n\/}th group}{\\{\it n}}
\key{at word break}{\\b}
\key{not at word break}{\\B}
diff --git a/etc/refcards/ru-refcard.tex b/etc/refcards/ru-refcard.tex
index ffa073f3da7..165c00d309c 100644
--- a/etc/refcards/ru-refcard.tex
+++ b/etc/refcards/ru-refcard.tex
@@ -40,7 +40,7 @@
\newlength{\ColThreeWidth}
\setlength{\ColThreeWidth}{25mm}
-\newcommand{\versionemacs}[0]{27} % version of Emacs this is for
+\newcommand{\versionemacs}[0]{28} % version of Emacs this is for
\newcommand{\cyear}[0]{2020} % copyright year
\newcommand\shortcopyrightnotice[0]{\vskip 1ex plus 2 fill
@@ -340,7 +340,6 @@ apropos: показать команды, соответствующие стр
\begin{tabular}{p{\ColWidth}l}
найти определение тега & \kbd{M-.} \\
-найти следующее вхождение тега & \kbd{C-u M-.} \\
использовать новый файл с тегами & \kbd{M-x visit-tags-table} \\
поиск по шаблону по всей таблице тегов & \kbd{M-x tags-search} \\
diff --git a/etc/refcards/sk-refcard.tex b/etc/refcards/sk-refcard.tex
index 9302e1825e7..b232ea8edf8 100644
--- a/etc/refcards/sk-refcard.tex
+++ b/etc/refcards/sk-refcard.tex
@@ -494,7 +494,6 @@ z~minibufferu. Stlačte \kbd{F10} pre aktiváciu menu v~minibufferi.
\section{Tagy}
\key{nájsť tag (definíciu)}{M-.}
-\key{nájsť ďalší výskyt tagu}{C-u M-.}
\metax{zadať súbor s novými tagmi}{M-x visit-tags-table}
\metax{vyhľadať reg.\ výraz v~súboroch s~tagmi}{M-x tags-search}
diff --git a/etc/refcards/sk-survival.tex b/etc/refcards/sk-survival.tex
index 5f06c2d11e2..8e5d85f4d39 100644
--- a/etc/refcards/sk-survival.tex
+++ b/etc/refcards/sk-survival.tex
@@ -258,7 +258,6 @@ premenných, dátových typov a iných. Pre vytvorenie tabuľky značiek spustit
príkaz `{\tt etags} {\it vstupné\_súbory}' v príkazovom interprétereri.
\askip
\key{M-.} nájdi definícu
-\key{C-u M-.} nájdi ďalší výskyt definície
\key{M-*} choď tam, odkiaľ bola volaná posledná \kbd{M-.}
\mkey{M-x tags-query-replace} spusti query-replace na všetkých súboroch
zaznamenaných v tabuľke značiek.
diff --git a/etc/refcards/survival.tex b/etc/refcards/survival.tex
index 5e73a45b2d7..24204e52006 100644
--- a/etc/refcards/survival.tex
+++ b/etc/refcards/survival.tex
@@ -243,7 +243,6 @@ else convenient. To create a tags table file, type
`{\tt etags} {\it input\_files}' as a shell command.
\askip
\key{M-.} find a definition
-\key{C-u M-.} find next occurrence of definition
\key{M-*} pop back to where \kbd{M-.} was last invoked
\mkey{M-x tags-query-replace} run query-replace on all files
recorded in tags table
diff --git a/etc/srecode/el.srt b/etc/srecode/el.srt
index 3473fb693c1..7d5c64c86c0 100644
--- a/etc/srecode/el.srt
+++ b/etc/srecode/el.srt
@@ -102,7 +102,7 @@ $<MODEFCN:declaration:function$
comment-start ";;"
comment-end "")
(set (make-local-variable 'comment-start-skip)
- "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
(set-syntax-table $MODESYM$-mode-syntax-table)
(use-local-map $MODESYM$-mode-map)
(set (make-local-variable 'font-lock-defaults)
diff --git a/etc/themes/adwaita-theme.el b/etc/themes/adwaita-theme.el
index dd886ea0c19..67a3b11763c 100644
--- a/etc/themes/adwaita-theme.el
+++ b/etc/themes/adwaita-theme.el
@@ -1,4 +1,4 @@
-;;; adwaita-theme.el --- Tango-based custom theme for faces
+;;; adwaita-theme.el --- Tango-based custom theme for faces -*- lexical-binding:t -*-
;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
diff --git a/etc/themes/deeper-blue-theme.el b/etc/themes/deeper-blue-theme.el
index 8dfe9e3617a..2557918ed7e 100644
--- a/etc/themes/deeper-blue-theme.el
+++ b/etc/themes/deeper-blue-theme.el
@@ -1,4 +1,4 @@
-;;; deeper-blue-theme.el --- Custom theme for faces
+;;; deeper-blue-theme.el --- Custom theme for faces -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
@@ -68,7 +68,6 @@
`(font-lock-comment-face ((,class (:foreground "gray50"))))
`(font-lock-constant-face ((,class (:foreground "DarkOliveGreen3"))))
`(font-lock-doc-face ((,class (:foreground "moccasin"))))
- `(font-lock-doc-string-face ((,class (:foreground "moccasin"))))
`(font-lock-function-name-face ((,class (:foreground "goldenrod"))))
`(font-lock-keyword-face ((,class (:foreground "DeepSkyBlue1"))))
`(font-lock-preprocessor-face ((,class (:foreground "gold"))))
diff --git a/etc/themes/dichromacy-theme.el b/etc/themes/dichromacy-theme.el
index ac862bc4338..89b5a4e4525 100644
--- a/etc/themes/dichromacy-theme.el
+++ b/etc/themes/dichromacy-theme.el
@@ -1,4 +1,4 @@
-;;; dichromacy-theme.el --- color theme suitable for color-blind users
+;;; dichromacy-theme.el --- color theme suitable for color-blind users -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el
index 4d8568b7d8f..f104c845ff6 100644
--- a/etc/themes/leuven-theme.el
+++ b/etc/themes/leuven-theme.el
@@ -1,10 +1,10 @@
-;;; leuven-theme.el --- Awesome Emacs color theme on white background
+;;; leuven-theme.el --- Awesome Emacs color theme on white background -*- lexical-binding:t -*-
;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")>
;; URL: https://github.com/fniessen/emacs-leuven-theme
-;; Version: 20170912.2328
+;; Version: 20200513.1928
;; Keywords: color theme
;; This file is part of GNU Emacs.
@@ -31,42 +31,98 @@
;;
;; (load-theme 'leuven t)
;;
-;; Requirements: Emacs 24.
+;; Requirements: Emacs 24+.
+;;
+;; NOTE -- Would you like implement a version of this for dark backgrounds,
+;; please do so! I'm willing to integrate it...
;;; Code:
+;;; Options.
+
+(defgroup leuven nil
+ "Leuven theme options.
+The theme has to be reloaded after changing anything in this group."
+ :group 'faces)
+
+(defcustom leuven-scale-outline-headlines t
+ "Scale `outline' (and `org') level-1 headlines.
+This can be nil for unscaled, t for using the theme default, or a scaling
+number."
+ :type '(choice
+ (const :tag "Unscaled" nil)
+ (const :tag "Default provided by theme" t)
+ (number :tag "Set scaling"))
+ :group 'leuven)
+
+(defcustom leuven-scale-org-agenda-structure t
+ "Scale Org agenda structure lines, like dates.
+This can be nil for unscaled, t for using the theme default, or a scaling
+number."
+ :type '(choice
+ (const :tag "Unscaled" nil)
+ (const :tag "Default provided by theme" t)
+ (number :tag "Set scaling")))
+
+(defun leuven-scale-font (control default-height)
+ "Function for splicing optional font heights into face descriptions.
+CONTROL can be a number, nil, or t. When t, use DEFAULT-HEIGHT."
+ (cond
+ ((numberp control) (list :height control))
+ ((eq t control) (list :height default-height))
+ (t nil)))
+
+;;; Theme Faces.
+
(deftheme leuven
"Face colors with a light background.
-Basic, Font Lock, Isearch, Gnus, Message, Diff, Ediff, Flyspell,
-Semantic, and Ansi-Color faces are included -- and much more...")
+Basic, Font Lock, Isearch, Gnus, Message, Org mode, Diff, Ediff,
+Flyspell, Semantic, and Ansi-Color faces are included -- and much
+more...")
(let ((class '((class color) (min-colors 89)))
- ;; Leuven generic colors
- (cancel '(:slant italic :strike-through t :foreground "gray55"))
+ ;; Leuven generic colors.
+ (cancel '(:slant italic :strike-through t :foreground "#A9A9A9"))
(clock-line '(:box (:line-width 1 :color "#335EA8") :foreground "black" :background "#EEC900"))
(code-block '(:foreground "#000088" :background "#FFFFE0"))
(code-inline '(:foreground "#006400" :background "#FDFFF7"))
(column '(:height 1.0 :weight normal :slant normal :underline nil :strike-through nil :foreground "#E6AD4F" :background "#FFF2DE"))
- (diff-added '(:foreground "#008000" :background "#DDFFDD"))
+ (completion-inline '(:weight normal :foreground "#C0C0C0" :inherit hl-line)) ; Like Google.
+ (completion-other-candidates '(:weight bold :foreground "black" :background "#EBF4FE"))
+ (completion-selected-candidate '(:weight bold :foreground "white" :background "#0052A4"))
+ (diff-added '(:background "#DDFFDD"))
(diff-changed '(:foreground "#0000FF" :background "#DDDDFF"))
- (diff-header '(:foreground "#800000" :background "#FFFFAF"))
+ (diff-header '(:weight bold :foreground "#800000" :background "#FFFFAF"))
(diff-hunk-header '(:foreground "#990099" :background "#FFEEFF"))
- (diff-none '(:foreground "gray33"))
- (diff-removed '(:foreground "#A60000" :background "#FFDDDD"))
+ (diff-none '(:foreground "#888888"))
+ (diff-refine-added '(:background "#97F295"))
+ (diff-refine-removed '(:background "#FFB6BA"))
+ (diff-removed '(:background "#FEE8E9"))
(directory '(:weight bold :foreground "blue" :background "#FFFFD2"))
- (highlight-line '(:background "#FFFFD7")) ; #F5F5F5
- (highlight-line-gnus '(:background "#DAEAFC")) ; defined in `gnus-leuven.el'
+ (file '(:foreground "black"))
+ (function-param '(:foreground "#247284"))
+ (grep-file-name '(:weight bold :foreground "#2A489E")) ; Used for grep hits.
+ (grep-line-number '(:weight bold :foreground "#A535AE"))
+ (highlight-blue '(:background "#E6ECFF"))
+ (highlight-blue2 '(:background "#E4F1F9"))
+ (highlight-gray '(:background "#E4E4E3"))
+ (highlight-green '(:background "#D5F1CF"))
+ (highlight-red '(:background "#FFC8C8"))
+ (highlight-yellow '(:background "#F6FECD"))
(link '(:weight normal :underline t :foreground "#006DAF"))
+ (link-no-underline '(:weight normal :foreground "#006DAF"))
(mail-header-name '(:family "Sans Serif" :weight normal :foreground "#A3A3A2"))
(mail-header-other '(:family "Sans Serif" :slant normal :foreground "#666666"))
- (mail-read '(:weight normal :foreground "#86878B"))
- (mail-ticked '(:weight bold :background "#FBE6EF"))
+ (mail-read '(:foreground "#8C8C8C"))
+ (mail-read-high '(:foreground "#808080"))
+ (mail-ticked '(:foreground "#FF3300"))
(mail-to '(:family "Sans Serif" :underline nil :foreground "#006DAF"))
- (mail-unread '(:weight bold :foreground "black"))
- (marked-line '(:weight bold :foreground "white" :background "red"))
- (match '(:weight bold :background "#FBE448")) ; occur patterns
- (ol1 '(:height 1.3 :weight bold :overline "#A7A7A7" :foreground "#3C3C3C" :background "#F0F0F0"))
+ (mail-unread '(:weight bold :foreground "#000000"))
+ (mail-unread-high '(:weight bold :foreground "#135985"))
+ (marked-line '(:foreground "#AA0000" :background "#FFAAAA"))
+ (match '(:weight bold :background "#FFFF00")) ; occur patterns + match in helm for files + match in Org files.
+ (ol1 `(,@(leuven-scale-font leuven-scale-outline-headlines 1.3) :weight bold :overline "#A7A7A7" :foreground "#3C3C3C" :background "#F0F0F0"))
(ol2 '(:height 1.0 :weight bold :overline "#123555" :foreground "#123555" :background "#E5F4FB"))
(ol3 '(:height 1.0 :weight bold :foreground "#005522" :background "#EFFFEF"))
(ol4 '(:height 1.0 :weight bold :slant normal :foreground "#EA6300"))
@@ -74,15 +130,22 @@ Semantic, and Ansi-Color faces are included -- and much more...")
(ol6 '(:height 1.0 :weight bold :slant italic :foreground "#0077CC"))
(ol7 '(:height 1.0 :weight bold :slant italic :foreground "#2EAE2C"))
(ol8 '(:height 1.0 :weight bold :slant italic :foreground "#FD8008"))
- (paren-matched '(:background "#99CCFF"))
- (paren-unmatched '(:underline "red" :foreground nil :background "#FFDCDC"))
- (region '(:background "#ABDFFA"))
+ (paren-matched '(:background "#C0E8C3")) ; Or take that green for region?
+ (paren-unmatched '(:weight bold :underline "red" :foreground "black" :background "#FFA5A5"))
+ (region '(:background "#8ED3FF"))
(shadow '(:foreground "#7F7F7F"))
(string '(:foreground "#008000")) ; or #D0372D
(subject '(:family "Sans Serif" :weight bold :foreground "black"))
- (symlink '(:foreground "deep sky blue"))
- (volatile-highlight '(:underline nil :background "#FFF876"))
- (vc-branch '(:box (:line-width 1 :color "#00CC33") :foreground "black" :background "#AAFFAA")))
+ (symlink '(:foreground "#1F8DD6"))
+ (tab '(:foreground "#E8E8E8" :background "white"))
+ (trailing '(:foreground "#E8E8E8" :background "#FFFFAB"))
+ (volatile-highlight '(:underline nil :foreground "white" :background "#9E3699"))
+ (volatile-highlight-supersize '(:height 1.1 :underline nil :foreground "white" :background "#9E3699")) ; flash-region
+ (vc-branch '(:box (:line-width 1 :color "#00CC33") :foreground "black" :background "#AAFFAA"))
+ (xml-attribute '(:foreground "#F36335"))
+ (xml-tag '(:foreground "#AE1B9A"))
+ (highlight-current-tag '(:background "#E8E8FF")) ; #EEF3F6 or #FFEB26
+ )
(custom-theme-set-faces
'leuven
@@ -91,46 +154,48 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(bold-italic ((,class (:weight bold :slant italic :foreground "black"))))
`(italic ((,class (:slant italic :foreground "#1A1A1A"))))
`(underline ((,class (:underline t))))
- `(cursor ((,class (:background "#0FB300"))))
+ `(cursor ((,class (:background "#21BDFF"))))
+
+ ;; Lucid toolkit emacs menus.
+ `(menu ((,class (:foreground "#FFFFFF" :background "#333333"))))
- ;; Highlighting faces
- `(fringe ((,class (:foreground "#9B9B9B" :background "#EDEDED"))))
- `(highlight ((,class ,volatile-highlight)))
+ ;; Highlighting faces.
+ `(fringe ((,class (:foreground "#4C9ED9" :background "white"))))
+ `(highlight ((,class ,highlight-blue)))
`(region ((,class ,region)))
- `(secondary-selection ((,class ,match))) ; used by Org-mode for highlighting matched entries and keywords
- `(isearch ((,class (:weight bold :underline "#FF9632" :foreground nil :background "#FDBD33"))))
- `(isearch-fail ((,class (:weight bold :foreground "black" :background "#FF9999"))))
- `(lazy-highlight ((,class (:underline "#FF9632" :background "#FFFF00")))) ; isearch others
- `(trailing-whitespace ((,class (:background "#FFFF57"))))
- `(whitespace-hspace ((,class (:foreground "#D2D2D2"))))
- `(whitespace-indentation ((,class (:foreground "#A1A1A1" :background "white"))))
+ `(secondary-selection ((,class ,match))) ; Used by Org-mode for highlighting matched entries and keywords.
+ `(isearch ((,class (:underline "black" :foreground "white" :background "#5974AB"))))
+ `(isearch-fail ((,class (:weight bold :foreground "black" :background "#FFCCCC"))))
+ `(lazy-highlight ((,class (:foreground "black" :background "#FFFF00")))) ; Isearch others (see `match').
+ `(trailing-whitespace ((,class ,trailing)))
+ `(query-replace ((,class (:inherit isearch))))
+ `(whitespace-hspace ((,class (:foreground "#D2D2D2")))) ; see also `nobreak-space'
+ `(whitespace-indentation ((,class ,tab)))
`(whitespace-line ((,class (:foreground "#CC0000" :background "#FFFF88"))))
- `(whitespace-tab ((,class (:foreground "#A1A1A1" :background "white"))))
- `(whitespace-trailing ((,class (:foreground "#B3B3B3" :background "#FFFF57"))))
+ `(whitespace-tab ((,class ,tab)))
+ `(whitespace-trailing ((,class ,trailing)))
- ;; Mode line faces
+ ;; Mode line faces.
`(mode-line ((,class (:box (:line-width 1 :color "#1A2F54") :foreground "#85CEEB" :background "#335EA8"))))
`(mode-line-inactive ((,class (:box (:line-width 1 :color "#4E4E4C") :foreground "#F0F0EF" :background "#9B9C97"))))
`(mode-line-buffer-id ((,class (:weight bold :foreground "white"))))
`(mode-line-emphasis ((,class (:weight bold :foreground "white"))))
`(mode-line-highlight ((,class (:foreground "yellow"))))
- ;; Escape and prompt faces
+ ;; Escape and prompt faces.
`(minibuffer-prompt ((,class (:weight bold :foreground "black" :background "gold"))))
`(minibuffer-noticeable-prompt ((,class (:weight bold :foreground "black" :background "gold"))))
`(escape-glyph ((,class (:foreground "#008ED1"))))
- `(homoglyph ((,class (:foreground "#008ED1"))))
`(error ((,class (:foreground "red"))))
`(warning ((,class (:weight bold :foreground "orange"))))
`(success ((,class (:foreground "green"))))
- ;; Font lock faces
+ ;; Font lock faces.
`(font-lock-builtin-face ((,class (:foreground "#006FE0"))))
`(font-lock-comment-delimiter-face ((,class (:foreground "#8D8D84")))) ; #696969
`(font-lock-comment-face ((,class (:slant italic :foreground "#8D8D84")))) ; #696969
`(font-lock-constant-face ((,class (:foreground "#D0372D"))))
`(font-lock-doc-face ((,class (:foreground "#036A07"))))
- ;; `(font-lock-doc-string-face ((,class (:foreground "#008000")))) ; XEmacs only, but is used for HTML exports from org2html (and not interactively)
`(font-lock-function-name-face ((,class (:weight normal :foreground "#006699"))))
`(font-lock-keyword-face ((,class (:bold nil :foreground "#0000FF")))) ; #3654DC
`(font-lock-preprocessor-face ((,class (:foreground "#808080"))))
@@ -141,32 +206,32 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(font-lock-variable-name-face ((,class (:weight normal :foreground "#BA36A5")))) ; #800080
`(font-lock-warning-face ((,class (:weight bold :foreground "red"))))
- ;; Button and link faces
+ ;; Button and link faces.
`(link ((,class ,link)))
`(link-visited ((,class (:underline t :foreground "#E5786D"))))
`(button ((,class (:underline t :foreground "#006DAF"))))
- `(header-line ((,class (:weight bold :underline "black" :overline "black" :foreground "black" :background "#FFFF88"))))
+ `(header-line ((,class (:box (:line-width 1 :color "black") :foreground "black" :background "#F0F0F0"))))
- ;; Gnus faces
+ ;; Gnus faces.
`(gnus-button ((,class (:weight normal))))
`(gnus-cite-attribution-face ((,class (:foreground "#5050B0"))))
- `(gnus-cite-face-1 ((,class (:foreground "#5050B0"))))
- `(gnus-cite-face-10 ((,class (:foreground "#990000"))))
- `(gnus-cite-face-2 ((,class (:foreground "#660066"))))
- `(gnus-cite-face-3 ((,class (:foreground "#007777"))))
- `(gnus-cite-face-4 ((,class (:foreground "#990000"))))
- `(gnus-cite-face-5 ((,class (:foreground "#000099"))))
- `(gnus-cite-face-6 ((,class (:foreground "#BB6600"))))
- `(gnus-cite-face-7 ((,class (:foreground "#5050B0"))))
- `(gnus-cite-face-8 ((,class (:foreground "#660066"))))
- `(gnus-cite-face-9 ((,class (:foreground "#007777"))))
+ `(gnus-cite-1 ((,class (:foreground "#5050B0" :background "#F6F6F6"))))
+ `(gnus-cite-2 ((,class (:foreground "#660066" :background "#F6F6F6"))))
+ `(gnus-cite-3 ((,class (:foreground "#007777" :background "#F6F6F6"))))
+ `(gnus-cite-4 ((,class (:foreground "#990000" :background "#F6F6F6"))))
+ `(gnus-cite-5 ((,class (:foreground "#000099" :background "#F6F6F6"))))
+ `(gnus-cite-6 ((,class (:foreground "#BB6600" :background "#F6F6F6"))))
+ `(gnus-cite-7 ((,class (:foreground "#5050B0" :background "#F6F6F6"))))
+ `(gnus-cite-8 ((,class (:foreground "#660066" :background "#F6F6F6"))))
+ `(gnus-cite-9 ((,class (:foreground "#007777" :background "#F6F6F6"))))
+ `(gnus-cite-10 ((,class (:foreground "#990000" :background "#F6F6F6"))))
`(gnus-emphasis-bold ((,class (:weight bold))))
`(gnus-emphasis-highlight-words ((,class (:foreground "yellow" :background "black"))))
`(gnus-group-mail-1 ((,class (:weight bold :foreground "#FF50B0"))))
`(gnus-group-mail-1-empty ((,class (:foreground "#5050B0"))))
`(gnus-group-mail-2 ((,class (:weight bold :foreground "#FF0066"))))
`(gnus-group-mail-2-empty ((,class (:foreground "#660066"))))
- `(gnus-group-mail-3 ((,class (:weight bold :foreground "black"))))
+ `(gnus-group-mail-3 ((,class ,mail-unread)))
`(gnus-group-mail-3-empty ((,class ,mail-read)))
`(gnus-group-mail-low ((,class ,cancel)))
`(gnus-group-mail-low-empty ((,class ,cancel)))
@@ -174,8 +239,8 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(gnus-group-news-1-empty ((,class (:foreground "#5050B0"))))
`(gnus-group-news-2 ((,class (:weight bold :foreground "#FF0066"))))
`(gnus-group-news-2-empty ((,class (:foreground "#660066"))))
- `(gnus-group-news-3 ((,class (:weight bold :foreground "black"))))
- `(gnus-group-news-3-empty ((,class (:foreground "#808080"))))
+ `(gnus-group-news-3 ((,class ,mail-unread)))
+ `(gnus-group-news-3-empty ((,class ,mail-read)))
`(gnus-group-news-4 ((,class (:weight bold :foreground "#FF0000"))))
`(gnus-group-news-4-empty ((,class (:foreground "#990000"))))
`(gnus-group-news-5 ((,class (:weight bold :foreground "#FF0099"))))
@@ -195,11 +260,11 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(gnus-signature ((,class (:slant italic :foreground "#8B8D8E"))))
`(gnus-splash ((,class (:foreground "#FF8C00"))))
`(gnus-summary-cancelled ((,class ,cancel)))
- `(gnus-summary-high-ancient ((,class (:weight normal :foreground "#808080" :background "#FFFFE6"))))
- `(gnus-summary-high-read ((,class (:weight normal :foreground "#999999" :background "#FFFFE6"))))
+ `(gnus-summary-high-ancient ((,class ,mail-unread-high)))
+ `(gnus-summary-high-read ((,class ,mail-read-high)))
`(gnus-summary-high-ticked ((,class ,mail-ticked)))
- `(gnus-summary-high-unread ((,class (:weight bold :foreground "black" :background "#FFFFCC"))))
- `(gnus-summary-low-ancient ((,class (:slant italic :foreground "gray55"))))
+ `(gnus-summary-high-unread ((,class ,mail-unread-high)))
+ `(gnus-summary-low-ancient ((,class (:slant italic :foreground "black"))))
`(gnus-summary-low-read ((,class (:slant italic :foreground "#999999" :background "#E0E0E0"))))
`(gnus-summary-low-ticked ((,class ,mail-ticked)))
`(gnus-summary-low-unread ((,class (:slant italic :foreground "black"))))
@@ -210,82 +275,105 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(gnus-summary-selected ((,class (:foreground "white" :background "#008CD7"))))
`(gnus-x-face ((,class (:foreground "black" :background "white"))))
- ;; Message faces
+ ;; Message faces.
`(message-header-name ((,class ,mail-header-name)))
`(message-header-cc ((,class ,mail-to)))
`(message-header-other ((,class ,mail-header-other)))
`(message-header-subject ((,class ,subject)))
`(message-header-to ((,class ,mail-to)))
- `(message-cited-text ((,class (:foreground "#5050B0"))))
+ `(message-cited-text ((,class (:foreground "#5050B0" :background "#F6F6F6"))))
`(message-separator ((,class (:family "Sans Serif" :weight normal :foreground "#BDC2C6"))))
`(message-header-newsgroups ((,class (:family "Sans Serif" :foreground "#3399CC"))))
`(message-header-xheader ((,class ,mail-header-other)))
`(message-mml ((,class (:foreground "forest green"))))
- ;; Diff
+ ;; Diff.
`(diff-added ((,class ,diff-added)))
`(diff-changed ((,class ,diff-changed)))
`(diff-context ((,class ,diff-none)))
`(diff-file-header ((,class ,diff-header)))
`(diff-file1-hunk-header ((,class (:foreground "dark magenta" :background "#EAF2F5"))))
`(diff-file2-hunk-header ((,class (:foreground "#2B7E2A" :background "#EAF2F5"))))
- `(diff-function ((,class (:foreground "darkgray"))))
+ `(diff-function ((,class (:foreground "#CC99CC"))))
`(diff-header ((,class ,diff-header)))
`(diff-hunk-header ((,class ,diff-hunk-header)))
`(diff-index ((,class ,diff-header)))
- `(diff-indicator-added ((,class (:background "#AAFFAA"))))
- `(diff-indicator-changed ((,class (:background "#8080FF"))))
- `(diff-indicator-removed ((,class (:background "#FFBBBB"))))
+ `(diff-indicator-added ((,class (:foreground "#3A993A" :background "#CDFFD8"))))
+ `(diff-indicator-changed ((,class (:background "#DBEDFF"))))
+ `(diff-indicator-removed ((,class (:foreground "#CC3333" :background "#FFDCE0"))))
+ `(diff-refine-added ((,class ,diff-refine-added)))
`(diff-refine-change ((,class (:background "#DDDDFF"))))
+ `(diff-refine-removed ((,class ,diff-refine-removed)))
`(diff-removed ((,class ,diff-removed)))
- ;; SMerge
+ ;; SMerge.
+ `(smerge-mine ((,class ,diff-changed)))
+ `(smerge-other ((,class ,diff-added)))
+ `(smerge-base ((,class ,diff-removed)))
+ `(smerge-markers ((,class (:background "#FFE5CC"))))
`(smerge-refined-change ((,class (:background "#AAAAFF"))))
- ;; Ediff
- `(ediff-current-diff-A ((,class (:foreground "gray33" :background "#FFDDDD"))))
- `(ediff-current-diff-B ((,class (:foreground "gray33" :background "#DDFFDD"))))
- `(ediff-current-diff-C ((,class (:foreground "black" :background "cyan"))))
- `(ediff-even-diff-A ((,class (:foreground "black" :background "light grey"))))
- `(ediff-even-diff-B ((,class (:foreground "black" :background "light grey"))))
- `(ediff-fine-diff-A ((,class (:foreground "#A60000" :background "#FFAAAA"))))
- `(ediff-fine-diff-B ((,class (:foreground "#008000" :background "#55FF55"))))
- `(ediff-odd-diff-A ((,class (:foreground "black" :background "light grey"))))
- `(ediff-odd-diff-B ((,class (:foreground "black" :background "light grey"))))
-
- ;; Flyspell
-;; (when (version< emacs-version "24.XXX")
- `(flyspell-duplicate ((,class (:underline "#008000" :inherit nil))))
- `(flyspell-incorrect ((,class (:underline "red" :inherit nil))))
-;; `(flyspell-duplicate ((,class (:underline (:style wave :color "#008000") :inherit nil))))
-;; `(flyspell-incorrect ((,class (:underline (:style wave :color "red") :inherit nil))))
-
- ;; ;; Semantic faces
+ ;; Ediff.
+ `(ediff-current-diff-A ((,class (:background "#FFDDDD"))))
+ `(ediff-current-diff-B ((,class (:background "#DDFFDD"))))
+ `(ediff-current-diff-C ((,class (:background "cyan"))))
+ `(ediff-even-diff-A ((,class (:background "light grey"))))
+ `(ediff-even-diff-B ((,class (:background "light grey"))))
+ `(ediff-fine-diff-A ((,class (:background "#FFAAAA"))))
+ `(ediff-fine-diff-B ((,class (:background "#55FF55"))))
+ `(ediff-odd-diff-A ((,class (:background "light grey"))))
+ `(ediff-odd-diff-B ((,class (:background "light grey"))))
+
+ ;; Flyspell.
+ (if (version< emacs-version "24.4")
+ `(flyspell-duplicate ((,class (:underline "#F4EB80" :inherit nil))))
+ `(flyspell-duplicate ((,class (:underline (:style wave :color "#F4EB80") :background "#FAF7CC" :inherit nil)))))
+ (if (version< emacs-version "24.4")
+ `(flyspell-incorrect ((,class (:underline "#FAA7A5" :inherit nil))))
+ `(flyspell-incorrect ((,class (:underline (:style wave :color "#FAA7A5") :background "#F4D7DA":inherit nil)))))
+
+ ;; ;; Semantic faces.
;; `(semantic-decoration-on-includes ((,class (:underline ,cham-4))))
;; `(semantic-decoration-on-private-members-face ((,class (:background ,alum-2))))
;; `(semantic-decoration-on-protected-members-face ((,class (:background ,alum-2))))
- ;; `(semantic-decoration-on-unknown-includes ((,class (:background ,choc-3))))
+ `(semantic-decoration-on-unknown-includes ((,class (:background "#FFF8F8"))))
;; `(semantic-decoration-on-unparsed-includes ((,class (:underline ,orange-3))))
- ;; `(semantic-tag-boundary-face ((,class (:overline ,blue-1))))
+ `(semantic-highlight-func-current-tag-face ((,class ,highlight-current-tag)))
+ `(semantic-tag-boundary-face ((,class (:overline "#777777")))) ; Method separator.
;; `(semantic-unmatched-syntax-face ((,class (:underline ,red-1))))
`(Info-title-1-face ((,class ,ol1)))
`(Info-title-2-face ((,class ,ol2)))
`(Info-title-3-face ((,class ,ol3)))
`(Info-title-4-face ((,class ,ol4)))
- `(ac-completion-face ((,class (:underline nil :foreground "#C0C0C0")))) ; like Google
- `(ace-jump-face-foreground ((,class (:foreground "black" :background "#FBE448"))))
+ `(ace-jump-face-foreground ((,class (:weight bold :foreground "black" :background "#FEA500"))))
+ `(ahs-face ((,class (:background "#E4E4FF"))))
+ `(ahs-definition-face ((,class (:background "#FFB6C6"))))
+ `(ahs-plugin-defalt-face ((,class (:background "#FFE4FF")))) ; Current.
+ `(anzu-match-1 ((,class (:foreground "black" :background "aquamarine"))))
+ `(anzu-match-2 ((,class (:foreground "black" :background "springgreen"))))
+ `(anzu-match-3 ((,class (:foreground "black" :background "red"))))
+ `(anzu-mode-line ((,class (:foreground "black" :background "#80FF80"))))
+ `(anzu-mode-line-no-match ((,class (:foreground "black" :background "#FF8080"))))
+ `(anzu-replace-highlight ((,class (:inherit query-replace))))
+ `(anzu-replace-to ((,class (:weight bold :foreground "#BD33FD" :background "#FDBD33"))))
`(auto-dim-other-buffers-face ((,class (:background "#F7F7F7"))))
+ `(avy-background-face ((,class (:background "#A9A9A9"))))
+ `(avy-lead-face ((,class (:weight bold :foreground "black" :background "#FEA500"))))
`(bbdb-company ((,class (:slant italic :foreground "steel blue"))))
`(bbdb-field-name ((,class (:weight bold :foreground "steel blue"))))
`(bbdb-field-value ((,class (:foreground "steel blue"))))
`(bbdb-name ((,class (:underline t :foreground "#FF6633"))))
- `(bmkp-light-autonamed ((,class (:background "#C2DDFD"))))
- `(bmkp-light-fringe-autonamed ((,class (:background "#90AFD5"))))
- `(bmkp-light-fringe-non-autonamed ((,class (:background "#D5FFD5"))))
- `(bmkp-light-non-autonamed ((,class (:background "#C4FFC4"))))
- `(browse-kill-ring-separator-face ((,class (:weight bold :foreground "slate gray"))))
+ `(bmkp-light-autonamed ((,class (:background "#F0F0F0"))))
+ `(bmkp-light-fringe-autonamed ((,class (:foreground "#5A5A5A" :background "#D4D4D4"))))
+ `(bmkp-light-fringe-non-autonamed ((,class (:foreground "#FFFFCC" :background "#01FFFB")))) ; default
+ `(bmkp-light-non-autonamed ((,class (:background "#BFFFFE"))))
+ `(bmkp-no-local ((,class (:background "pink"))))
+ `(browse-kill-ring-separator-face ((,class (:foreground "red"))))
+ `(calendar-month-header ((,class (:weight bold :foreground "#4F4A3D" :background "#FFFFCC"))))
`(calendar-today ((,class (:weight bold :foreground "#4F4A3D" :background "#FFFFCC"))))
+ `(calendar-weekday-header ((,class (:weight bold :foreground "#1662AF"))))
+ `(calendar-weekend-header ((,class (:weight bold :foreground "#4E4E4E"))))
`(cfw:face-annotation ((,class (:foreground "green" :background "red"))))
`(cfw:face-day-title ((,class (:foreground "#C9C9C9"))))
`(cfw:face-default-content ((,class (:foreground "#2952A3"))))
@@ -300,12 +388,14 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(cfw:face-sunday ((,class (:foreground "#4E4E4E" :background "white" :weight bold))))
`(cfw:face-title ((,class (:height 2.0 :foreground "#676767" :weight bold :inherit variable-pitch))))
`(cfw:face-today ((,class (:foreground "#4F4A3D" :background "#FFFFCC"))))
- `(cfw:face-today-title ((,class (:foreground "#4A95EB" :background "#FFFFCC"))))
+ `(cfw:face-today-title ((,class (:foreground "white" :background "#1766B1"))))
`(cfw:face-toolbar ((,class (:background "white"))))
`(cfw:face-toolbar-button-off ((,class (:foreground "#CFCFCF" :background "white"))))
`(cfw:face-toolbar-button-on ((,class (:foreground "#5E5E5E" :background "#F6F6F6"))))
- `(change-log-date-face ((,class (:foreground "purple"))))
+ `(change-log-date ((,class (:foreground "purple"))))
`(change-log-file ((,class (:weight bold :foreground "#4183C4"))))
+ `(change-log-list ((,class (:foreground "black" :background "#75EEC7"))))
+ `(change-log-name ((,class (:foreground "#008000"))))
`(circe-highlight-all-nicks-face ((,class (:foreground "blue" :background "#F0F0F0")))) ; other nick names
`(circe-highlight-nick-face ((,class (:foreground "#009300" :background "#F0F0F0")))) ; messages with my nick cited
`(circe-my-message-face ((,class (:foreground "#8B8B8B" :background "#F0F0F0"))))
@@ -315,15 +405,38 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(comint-highlight-input ((,class (:weight bold :foreground "#0000FF" :inherit nil))))
;; `(comint-highlight-prompt ((,class (:weight bold :foreground "black" :background "gold"))))
`(comint-highlight-prompt ((,class (:weight bold :foreground "#0000FF" :inherit nil))))
- `(company-preview-common ((,class (:foreground "#C0C0C0" :background "#FFFFD7")))) ; same background as highlight-line
- `(company-tooltip-annotation ((,class (:foreground "#999999" :background "cornsilk"))))
- `(company-tooltip-common ((,class (:weight bold :inherit company-tooltip))))
- `(company-tooltip-common-selection ((,class (:weight bold :inherit company-tooltip-selection))))
+
+ ;; `(ac-selection-face ((,class ,completion-selected-candidate)))
+ `(ac-selection-face ((,class (:weight bold :foreground "white" :background "orange")))) ; TEMP For diff'ing AC from Comp.
+ `(ac-candidate-face ((,class ,completion-other-candidates)))
+ `(ac-completion-face ((,class ,completion-inline)))
+ `(ac-candidate-mouse-face ((,class (:inherit highlight))))
+ `(popup-scroll-bar-background-face ((,class (:background "#EBF4FE"))))
+ `(popup-scroll-bar-foreground-face ((,class (:background "#D1DAE4")))) ; Scrollbar (visible).
+
+ `(company-tooltip-common-selection ((,class (:weight normal :foreground "#F9ECCC" :inherit company-tooltip-selection)))) ; Prefix + common part in tooltip (for selection).
+ `(company-tooltip-selection ((,class ,completion-selected-candidate))) ; Suffix in tooltip (for selection).
+ `(company-tooltip-annotation-selection ((,class (:weight normal :foreground "#F9ECCC")))) ; Annotation (for selection).
+
+ `(company-tooltip-common ((,class (:weight normal :foreground "#B000B0" :inherit company-tooltip)))) ; Prefix + common part in tooltip.
+ `(company-tooltip ((,class ,completion-other-candidates))) ; Suffix in tooltip.
+ `(company-tooltip-annotation ((,class (:weight normal :foreground "#2415FF")))) ; Annotation.
+
+ `(company-preview-common ((,class ,completion-inline)))
+
+ `(company-scrollbar-bg ((,class (:background "#EBF4FE"))))
+ `(company-scrollbar-fg ((,class (:background "#D1DAE4")))) ; Scrollbar (visible).
+
`(compare-windows ((,class (:background "#FFFF00"))))
- `(compilation-error ((,class (:weight bold :foreground "red"))))
- `(compilation-info ((,class (:weight bold :foreground "#2A489E")))) ; used for grep
- `(compilation-line-number ((,class (:weight bold :foreground "#A535AE"))))
+ ;; `(completions-common-part ((,class (:foreground "red" :weight bold))))
+ ;; `(completions-first-difference ((,class (:foreground "green" :weight bold))))
+ `(compilation-error ((,class (:weight bold :foreground "red")))) ; Used for grep error messages.
+ `(compilation-info ((,class (:weight bold :foreground "#6784d7"))))
+ `(compilation-line-number ((,class ,grep-line-number)))
`(compilation-warning ((,class (:weight bold :foreground "orange"))))
+ `(compilation-mode-line-exit ((,class (:weight bold :foreground "green")))) ; :exit[matched]
+ `(compilation-mode-line-fail ((,class (:weight bold :foreground "violet")))) ; :exit[no match]
+ `(compilation-mode-line-run ((,class (:weight bold :foreground "orange")))) ; :run
`(css-property ((,class (:foreground "#00AA00"))))
`(css-selector ((,class (:weight bold :foreground "blue"))))
`(custom-button ((,class (:box (:line-width 2 :style released-button) :foreground "black" :background "lightgrey"))))
@@ -349,11 +462,14 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(custom-variable-button ((,class (:weight bold :underline t))))
`(custom-variable-tag ((,class (:family "Sans Serif" :height 1.2 :weight bold :foreground "blue1"))))
`(custom-visibility ((,class ,link)))
- `(diff-hl-change ((,class (:foreground "blue3" :inherit diff-changed))))
- `(diff-hl-delete ((,class (:foreground "red3" :inherit diff-removed))))
- `(diff-hl-dired-change ((,class (:background "#FFA335" :foreground "black" :weight bold))))
+ `(diff-hl-change ((,class (:foreground "blue3" :background "#DBEDFF"))))
+ `(diff-hl-delete ((,class (:foreground "red3" :background "#FFDCE0"))))
+ `(diff-hl-dired-change ((,class (:weight bold :foreground "black" :background "#FFA335"))))
+ `(diff-hl-dired-delete ((,class (:weight bold :foreground "#D73915"))))
+ `(diff-hl-dired-ignored ((,class (:weight bold :foreground "white" :background "#C0BBAB"))))
+ `(diff-hl-dired-insert ((,class (:weight bold :foreground "#B9B9BA"))))
`(diff-hl-dired-unknown ((,class (:foreground "white" :background "#3F3BB4"))))
- `(diff-hl-insert ((,class (:foreground "green4" :inherit diff-added))))
+ `(diff-hl-insert ((,class (:foreground "green4" :background "#CDFFD8"))))
`(diff-hl-unknown ((,class (:foreground "white" :background "#3F3BB4"))))
`(diary-face ((,class (:foreground "#87C9FC"))))
`(dircolors-face-asm ((,class (:foreground "black"))))
@@ -386,17 +502,36 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(diredp-compressed-file-suffix ((,class (:foreground "red"))))
`(diredp-date-time ((,class (:foreground "purple"))))
`(diredp-dir-heading ((,class ,directory)))
+ `(diredp-dir-name ((,class ,directory)))
`(diredp-dir-priv ((,class ,directory)))
`(diredp-exec-priv ((,class (:background "#03C03C"))))
`(diredp-executable-tag ((,class (:foreground "ForestGreen" :background "white"))))
- `(diredp-file-name ((,class (:foreground "black"))))
+ `(diredp-file-name ((,class ,file)))
`(diredp-file-suffix ((,class (:foreground "#C0C0C0"))))
`(diredp-flag-mark-line ((,class ,marked-line)))
`(diredp-ignored-file-name ((,class ,shadow)))
`(diredp-read-priv ((,class (:background "#0A99FF"))))
`(diredp-write-priv ((,class (:foreground "white" :background "#FF4040"))))
+ `(eldoc-highlight-function-argument ((,class (:weight bold :foreground "red" :background "#FFE4FF"))))
+ `(elfeed-search-filter-face ((,class (:foreground "gray"))))
+ ;; `(eww-form-checkbox ((,class ())))
+ ;; `(eww-form-select ((,class ())))
+ ;; `(eww-form-submit ((,class ())))
+ `(eww-form-text ((,class (:weight bold :foreground "#40586F" :background "#A7CDF1"))))
+ ;; `(eww-form-textarea ((,class ())))
`(file-name-shadow ((,class ,shadow)))
+ `(flycheck-error ((,class (:underline (:color "#FE251E" :style wave) :weight bold :background "#FFE1E1"))))
+ `(flycheck-error-list-line-number ((,class (:foreground "#A535AE"))))
+ `(flycheck-fringe-error ((,class (:foreground "#FE251E"))))
+ `(flycheck-fringe-info ((,class (:foreground "#158A15"))))
+ `(flycheck-fringe-warning ((,class (:foreground "#F4A939"))))
+ `(flycheck-info ((,class (:underline (:color "#158A15" :style wave) :weight bold))))
+ `(flycheck-warning ((,class (:underline (:color "#F4A939" :style wave) :weight bold :background "#FFFFBE"))))
`(font-latex-bold-face ((,class (:weight bold :foreground "black"))))
+ `(fancy-narrow-blocked-face ((,class (:foreground "#9998A4"))))
+ `(flycheck-color-mode-line-error-face ((, class (:background "#CF5B56"))))
+ `(flycheck-color-mode-line-warning-face ((, class (:background "#EBC700"))))
+ `(flycheck-color-mode-line-info-face ((, class (:background "yellow"))))
`(font-latex-italic-face ((,class (:slant italic :foreground "#1A1A1A"))))
`(font-latex-math-face ((,class (:foreground "blue"))))
`(font-latex-sectioning-1-face ((,class (:family "Sans Serif" :height 2.7 :weight bold :foreground "cornflower blue"))))
@@ -409,36 +544,65 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(font-latex-verbatim-face ((,class (:foreground "#000088" :background "#FFFFE0" :inherit nil))))
`(git-commit-summary-face ((,class (:foreground "#000000"))))
`(git-commit-comment-face ((,class (:slant italic :foreground "#696969"))))
+ `(git-timemachine-commit ((,class ,diff-removed)))
+ `(git-timemachine-minibuffer-author-face ((,class ,diff-added)))
+ `(git-timemachine-minibuffer-detail-face ((,class ,diff-header)))
+ `(google-translate-text-face ((,class (:foreground "#777777" :background "#F5F5F5"))))
+ `(google-translate-phonetic-face ((,class (:inherit shadow))))
+ `(google-translate-translation-face ((,class (:weight normal :foreground "#3079ED" :background "#E3EAF2"))))
+ `(google-translate-suggestion-label-face ((,class (:foreground "red"))))
+ `(google-translate-suggestion-face ((,class (:slant italic :underline t))))
+ `(google-translate-listen-button-face ((,class (:height 0.8))))
`(helm-action ((,class (:foreground "black"))))
+ `(helm-bookmark-file ((,class ,file)))
`(helm-bookmarks-su-face ((,class (:foreground "red"))))
+ `(helm-buffer-directory ((,class ,directory)))
+ ;; `(helm-non-file-buffer ((,class (:slant italic :foreground "blue"))))
+ ;; `(helm-buffer-file ((,class (:foreground "#333333"))))
+ `(helm-buffer-modified ((,class (:slant italic :foreground "#BA36A5"))))
`(helm-buffer-process ((,class (:foreground "#008200"))))
`(helm-candidate-number ((,class (:foreground "black" :background "#FFFF66"))))
`(helm-dir-heading ((,class (:foreground "blue" :background "pink"))))
`(helm-dir-priv ((,class (:foreground "dark red" :background "light grey"))))
`(helm-ff-directory ((,class ,directory)))
+ `(helm-ff-dotted-directory ((,class ,directory)))
`(helm-ff-executable ((,class (:foreground "green3" :background "white"))))
`(helm-ff-file ((,class (:foreground "black"))))
`(helm-ff-invalid-symlink ((,class (:foreground "yellow" :background "red"))))
`(helm-ff-symlink ((,class ,symlink)))
`(helm-file-name ((,class (:foreground "blue"))))
`(helm-gentoo-match-face ((,class (:foreground "red"))))
+ `(helm-grep-file ((,class ,grep-file-name)))
+ `(helm-grep-lineno ((,class ,grep-line-number)))
`(helm-grep-match ((,class ,match)))
`(helm-grep-running ((,class (:weight bold :foreground "white"))))
- `(helm-grep-lineno ((,class ,shadow)))
`(helm-isearch-match ((,class (:background "#CCFFCC"))))
+ `(helm-lisp-show-completion ((,class ,volatile-highlight-supersize))) ; See `helm-dabbrev'.
+ ;; `(helm-ls-git-added-copied-face ((,class (:foreground ""))))
+ ;; `(helm-ls-git-added-modified-face ((,class (:foreground ""))))
+ ;; `(helm-ls-git-conflict-face ((,class (:foreground ""))))
+ ;; `(helm-ls-git-deleted-and-staged-face ((,class (:foreground ""))))
+ ;; `(helm-ls-git-deleted-not-staged-face ((,class (:foreground ""))))
+ ;; `(helm-ls-git-modified-and-staged-face ((,class (:foreground ""))))
+ `(helm-ls-git-modified-not-staged-face ((,class (:foreground "#BA36A5"))))
+ ;; `(helm-ls-git-renamed-modified-face ((,class (:foreground ""))))
+ ;; `(helm-ls-git-untracked-face ((,class (:foreground ""))))
`(helm-match ((,class ,match)))
`(helm-moccur-buffer ((,class (:foreground "#0066CC"))))
- `(helm-selection ((,class ,volatile-highlight)))
- `(helm-selection-line ((,class ,volatile-highlight)))
- `(helm-source-header ((,class (:family "Sans Serif" :height 1.3 :weight bold :foreground "white" :background "#2F69BF"))))
- `(helm-swoop-target-line-face ((,class ,volatile-highlight)))
+ `(helm-selection ((,class (:background "#3875D6" :foreground "white"))))
+ `(helm-selection-line ((,class ,highlight-gray))) ; ???
+ `(helm-separator ((,class (:foreground "red"))))
+ `(helm-source-header ((,class (:weight bold :box (:line-width 1 :color "#C7C7C7") :background "#DEDEDE" :foreground "black"))))
`(helm-swoop-target-line-block-face ((,class (:background "#CCCC00" :foreground "#222222"))))
+ `(helm-swoop-target-line-face ((,class (:background "#CCCCFF"))))
`(helm-swoop-target-word-face ((,class (:weight bold :foreground nil :background "#FDBD33"))))
`(helm-visible-mark ((,class ,marked-line)))
`(helm-w3m-bookmarks-face ((,class (:underline t :foreground "cyan1"))))
+ `(highlight-changes ((,class (:foreground nil)))) ;; blue "#2E08B5"
+ `(highlight-changes-delete ((,class (:strike-through nil :foreground nil)))) ;; red "#B5082E"
`(highlight-symbol-face ((,class (:background "#FFFFA0"))))
- `(hl-line ((,class ,highlight-line)))
- `(hl-tags-face ((,class (:background "#FEFCAE"))))
+ `(hl-line ((,class ,highlight-yellow))) ; Highlight current line.
+ `(hl-tags-face ((,class ,highlight-current-tag))) ; ~ Pair highlighting (matching tags).
`(holiday-face ((,class (:foreground "#777777" :background "#E4EBFE"))))
`(html-helper-bold-face ((,class (:weight bold :foreground "black"))))
`(html-helper-italic-face ((,class (:slant italic :foreground "black"))))
@@ -449,9 +613,11 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(ilog-echo-face ((,class (:height 2.0 :foreground "#006FE0"))))
`(ilog-load-face ((,class (:foreground "#BA36A5"))))
`(ilog-message-face ((,class (:foreground "#808080"))))
+ `(indent-guide-face ((,class (:foreground "#D3D3D3"))))
`(info-file ((,class (:family "Sans Serif" :height 1.8 :weight bold :box (:line-width 1 :color "#0000CC") :foreground "cornflower blue" :background "LightSteelBlue1"))))
`(info-header-node ((,class (:underline t :foreground "orange")))) ; nodes in header
`(info-header-xref ((,class (:underline t :foreground "dodger blue")))) ; cross references in header
+ `(info-index-match ((,class (:weight bold :foreground nil :background "#FDBD33")))) ; when using `i'
`(info-menu-header ((,class ,ol2))) ; menu titles (headers) -- major topics
`(info-menu-star ((,class (:foreground "black")))) ; every 3rd menu item
`(info-node ((,class (:underline t :foreground "blue")))) ; node names
@@ -460,16 +626,49 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(info-title-1 ((,class ,ol1)))
`(info-xref ((,class (:underline t :foreground "#006DAF")))) ; unvisited cross-references
`(info-xref-visited ((,class (:underline t :foreground "magenta4")))) ; previously visited cross-references
+ ;; js2-highlight-vars-face (~ auto-highlight-symbol)
+ `(js2-error ((,class (:box (:line-width 1 :color "#FF3737") :background "#FFC8C8")))) ; DONE.
+ `(js2-external-variable ((,class (:foreground "#FF0000" :background "#FFF8F8")))) ; DONE.
+ `(js2-function-param ((,class ,function-param)))
+ `(js2-instance-member ((,class (:foreground "DarkOrchid"))))
+ `(js2-jsdoc-html-tag-delimiter ((,class (:foreground "#D0372D"))))
+ `(js2-jsdoc-html-tag-name ((,class (:foreground "#D0372D"))))
+ `(js2-jsdoc-tag ((,class (:weight normal :foreground "#6434A3"))))
+ `(js2-jsdoc-type ((,class (:foreground "SteelBlue"))))
+ `(js2-jsdoc-value ((,class (:weight normal :foreground "#BA36A5")))) ; #800080
+ `(js2-magic-paren ((,class (:underline t))))
+ `(js2-private-function-call ((,class (:foreground "goldenrod"))))
+ `(js2-private-member ((,class (:foreground "PeachPuff3"))))
+ `(js2-warning ((,class (:underline "orange"))))
+
+ ;; Org non-standard faces.
+ `(leuven-org-deadline-overdue ((,class (:foreground "#F22659"))))
+ `(leuven-org-deadline-today ((,class (:weight bold :foreground "#4F4A3D" :background "#FFFFCC"))))
+ `(leuven-org-deadline-tomorrow ((,class (:foreground "#40A80B"))))
+ `(leuven-org-deadline-future ((,class (:foreground "#40A80B"))))
+ `(leuven-gnus-unseen ((,class (:weight bold :foreground "#FC7202"))))
+ `(leuven-gnus-date ((,class (:foreground "#FF80BF"))))
+ `(leuven-gnus-size ((,class (:foreground "#8FBF60"))))
+ `(leuven-todo-items-face ((,class (:weight bold :foreground "#FF3125" :background "#FFFF88"))))
+
`(light-symbol-face ((,class (:background "#FFFFA0"))))
- `(linum ((,class (:inherit (default shadow) :foreground "#9A9A9A" :background "#EDEDED"))))
+ `(linum ((,class (:foreground "#9A9A9A" :background "#EDEDED"))))
`(log-view-file ((,class (:foreground "#0000CC" :background "#EAF2F5"))))
+ `(log-view-message ((,class (:foreground "black" :background "#EDEA74"))))
+ `(lsp-ui-doc-background ((,class (:background "#F6FECD"))))
`(lui-button-face ((,class ,link)))
`(lui-highlight-face ((,class (:box '(:line-width 1 :color "#CC0000") :foreground "#CC0000" :background "#FFFF88")))) ; my nickname
`(lui-time-stamp-face ((,class (:foreground "purple"))))
+ `(magit-blame-header ((,class (:inherit magit-diff-file-header))))
+ `(magit-blame-heading ((,class (:overline "#A7A7A7" :foreground "red" :background "#E6E6E6"))))
+ `(magit-blame-hash ((,class (:overline "#A7A7A7" :foreground "red" :background "#E6E6E6"))))
+ `(magit-blame-name ((,class (:overline "#A7A7A7" :foreground "#036A07" :background "#E6E6E6"))))
+ `(magit-blame-date ((,class (:overline "#A7A7A7" :foreground "blue" :background "#E6E6E6"))))
+ `(magit-blame-summary ((,class (:overline "#A7A7A7" :weight bold :foreground "#707070" :background "#E6E6E6"))))
`(magit-branch ((,class ,vc-branch)))
`(magit-diff-add ((,class ,diff-added)))
`(magit-diff-del ((,class ,diff-removed)))
- `(magit-diff-file-header ((,class (:family "Sans Serif" :height 1.1 :weight bold :foreground "#4183C4"))))
+ `(magit-diff-file-header ((,class (:height 1.1 :weight bold :foreground "#4183C4"))))
`(magit-diff-hunk-header ((,class ,diff-hunk-header)))
`(magit-diff-none ((,class ,diff-none)))
`(magit-header ((,class (:foreground "white" :background "#FF4040"))))
@@ -477,48 +676,82 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(magit-item-mark ((,class ,marked-line)))
`(magit-log-head-label ((,class (:box (:line-width 1 :color "blue" :style nil)))))
`(magit-log-tag-label ((,class (:box (:line-width 1 :color "#00CC00" :style nil)))))
+ `(magit-section-highlight ((,class (:background "#F6FECD"))))
`(magit-section-title ((,class (:family "Sans Serif" :height 1.8 :weight bold :foreground "cornflower blue" :inherit nil))))
`(makefile-space-face ((,class (:background "hot pink"))))
`(makefile-targets ((,class (:weight bold :foreground "blue"))))
- `(match ((,class ,match)))
+ ;; `(markdown-blockquote-face ((,class ())))
+ `(markdown-bold-face ((,class (:inherit bold))))
+ ;; `(markdown-comment-face ((,class ())))
+ ;; `(markdown-footnote-face ((,class ())))
+ ;; `(markdown-header-delimiter-face ((,class ())))
+ ;; `(markdown-header-face ((,class ())))
+ `(markdown-header-face-1 ((,class ,ol1)))
+ `(markdown-header-face-2 ((,class ,ol2)))
+ `(markdown-header-face-3 ((,class ,ol3)))
+ `(markdown-header-face-4 ((,class ,ol4)))
+ `(markdown-header-face-5 ((,class ,ol5)))
+ `(markdown-header-face-6 ((,class ,ol6)))
+ ;; `(markdown-header-rule-face ((,class ())))
+ `(markdown-inline-code-face ((,class ,code-inline)))
+ `(markdown-italic-face ((,class (:inherit italic))))
+ `(markdown-language-keyword-face ((,class (:inherit org-block-begin-line))))
+ ;; `(markdown-line-break-face ((,class ())))
+ `(markdown-link-face ((,class ,link-no-underline)))
+ ;; `(markdown-link-title-face ((,class ())))
+ ;; `(markdown-list-face ((,class ())))
+ ;; `(markdown-math-face ((,class ())))
+ ;; `(markdown-metadata-key-face ((,class ())))
+ ;; `(markdown-metadata-value-face ((,class ())))
+ ;; `(markdown-missing-link-face ((,class ())))
+ `(markdown-pre-face ((,class (:inherit org-block-background))))
+ ;; `(markdown-reference-face ((,class ())))
+ ;; `(markdown-strike-through-face ((,class ())))
+ `(markdown-url-face ((,class ,link)))
+ `(match ((,class ,match))) ; Used for grep matches.
+ `(mc/cursor-bar-face ((,class (:height 1.0 :foreground "#1664C4" :background "#1664C4"))))
+ `(mc/cursor-face ((,class (:inverse-video t))))
+ `(mc/region-face ((,class (:inherit region))))
`(mm-uu-extract ((,class ,code-block)))
`(moccur-current-line-face ((,class (:foreground "black" :background "#FFFFCC"))))
`(moccur-face ((,class (:foreground "black" :background "#FFFF99"))))
- `(next-error ((,class ,volatile-highlight)))
+ `(next-error ((,class ,volatile-highlight-supersize)))
`(nobreak-space ((,class (:background "#CCE8F6"))))
- `(nxml-attribute-local-name-face ((,class (:foreground "magenta"))))
+ `(nxml-attribute-local-name-face ((,class ,xml-attribute)))
`(nxml-attribute-value-delimiter-face ((,class (:foreground "green4"))))
`(nxml-attribute-value-face ((,class (:foreground "green4"))))
`(nxml-comment-content-face ((,class (:slant italic :foreground "red"))))
`(nxml-comment-delimiter-face ((,class (:foreground "red"))))
- `(nxml-element-local-name ((,class (:box (:line-width 1 :color "#999999") :foreground "#000088" :background "#DEDEDE"))))
+ `(nxml-element-local-name ((,class ,xml-tag)))
`(nxml-element-local-name-face ((,class (:foreground "blue"))))
`(nxml-processing-instruction-target-face ((,class (:foreground "purple1"))))
`(nxml-tag-delimiter-face ((,class (:foreground "blue"))))
`(nxml-tag-slash-face ((,class (:foreground "blue"))))
`(org-agenda-block-count ((,class (:weight bold :foreground "#A5A5A5"))))
- `(org-agenda-calendar-event ((,class (:weight bold :foreground "#3774CC" :background "#A8C5EF"))))
- `(org-agenda-calendar-sexp ((,class (:foreground "#777777" :background "#E4EBFE"))))
+ `(org-agenda-calendar-event ((,class (:weight bold :foreground "#3774CC" :background "#E4EBFE"))))
+ `(org-agenda-calendar-sexp ((,class (:foreground "#327ACD" :background "#F3F7FC"))))
`(org-agenda-clocking ((,class (:foreground "black" :background "#EEC900"))))
`(org-agenda-column-dateline ((,class ,column)))
`(org-agenda-current-time ((,class (:underline t :foreground "#1662AF"))))
- `(org-agenda-date ((,class (:height 1.6 :weight bold :foreground "#1662AF"))))
- `(org-agenda-date-today ((,class (:height 1.6 :weight bold :foreground "#4F4A3D" :background "#FFFFCC"))))
- `(org-agenda-date-weekend ((,class (:height 1.6 :weight bold :foreground "#4E4E4E"))))
+ `(org-agenda-date ((,class (,@(leuven-scale-font leuven-scale-org-agenda-structure 1.6) :weight bold :foreground "#1662AF"))))
+ `(org-agenda-date-today ((,class (,@(leuven-scale-font leuven-scale-org-agenda-structure 1.6) :weight bold :foreground "#4F4A3D" :background "#FFFFCC"))))
+ `(org-agenda-date-weekend ((,class (,@(leuven-scale-font leuven-scale-org-agenda-structure 1.6) :weight bold :foreground "#4E4E4E"))))
`(org-agenda-diary ((,class (:weight bold :foreground "green4" :background "light blue"))))
`(org-agenda-dimmed-todo-face ((,class (:foreground "gold2"))))
`(org-agenda-done ((,class (:foreground "#555555"))))
`(org-agenda-filter-category ((,class (:weight bold :foreground "orange"))))
+ `(org-agenda-filter-effort ((,class (:weight bold :foreground "orange"))))
+ `(org-agenda-filter-regexp ((,class (:weight bold :foreground "orange"))))
`(org-agenda-filter-tags ((,class (:weight bold :foreground "orange"))))
`(org-agenda-restriction-lock ((,class (:background "#E77D63"))))
- `(org-agenda-structure ((,class (:height 1.6 :weight bold :foreground "#1F8DD6"))))
+ `(org-agenda-structure ((,class (,@(leuven-scale-font leuven-scale-org-agenda-structure 1.6) :weight bold :foreground "#1F8DD6"))))
`(org-archived ((,class (:foreground "gray70"))))
`(org-beamer-tag ((,class (:box (:line-width 1 :color "#FABC18") :foreground "#2C2C2C" :background "#FFF8D0"))))
`(org-block ((,class ,code-block)))
- `(org-block-background ((,class (:background "#FFFFE0"))))
+ `(org-block-background ((,class (:background "#FFFFE0")))) ;; :inherit fixed-pitch))))
`(org-block-begin-line ((,class (:underline "#A7A6AA" :foreground "#555555" :background "#E2E1D5"))))
`(org-block-end-line ((,class (:overline "#A7A6AA" :foreground "#555555" :background "#E2E1D5"))))
- `(org-checkbox ((,class (:weight bold :box (:line-width 1 :style pressed-button) :foreground "white" :background "#777777"))))
+ `(org-checkbox ((,class (:weight bold :box (:line-width 1 :style pressed-button) :foreground "#123555" :background "#A3A3A3"))))
`(org-clock-overlay ((,class (:foreground "white" :background "SkyBlue4"))))
`(org-code ((,class ,code-inline)))
`(org-column ((,class ,column)))
@@ -528,14 +761,14 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(org-dim ((,class (:foreground "#AAAAAA"))))
`(org-document-info ((,class (:foreground "#484848"))))
`(org-document-info-keyword ((,class (:foreground "#008ED1" :background "#EAEAFF"))))
- `(org-document-title ((,class (:family "Sans Serif" :height 1.8 :weight bold :foreground "black"))))
+ `(org-document-title ((,class (:height 1.8 :weight bold :foreground "black"))))
`(org-done ((,class (:weight bold :box (:line-width 1 :color "#BBBBBB") :foreground "#BBBBBB" :background "#F0F0F0"))))
- `(org-drawer ((,class (:foreground "light sky blue"))))
- `(org-ellipsis ((,class (:underline nil :box (:line-width 1 :color "#999999") :foreground "#999999" :background "#FFF8C0")))) ; #FFEE62
+ `(org-drawer ((,class (:weight bold :foreground "#00BB00" :background "#EAFFEA" :extend nil))))
+ `(org-ellipsis ((,class (:underline nil :foreground "#999999")))) ; #FFEE62
`(org-example ((,class (:foreground "blue" :background "#EAFFEA"))))
`(org-footnote ((,class (:underline t :foreground "#008ED1"))))
`(org-formula ((,class (:foreground "chocolate1"))))
- `(org-headline-done ((,class (:height 1.0 :weight normal :strike-through t :foreground "#ADADAD"))))
+ `(org-headline-done ((,class (:height 1.0 :weight normal :foreground "#ADADAD"))))
`(org-hide ((,class (:foreground "#E2E2E2"))))
`(org-inlinetask ((,class (:box (:line-width 1 :color "#EBEBEB") :foreground "#777777" :background "#FFFFD6"))))
`(org-latex-and-related ((,class (:foreground "#336699" :background "white"))))
@@ -549,25 +782,25 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(org-level-8 ((,class ,ol8)))
`(org-link ((,class ,link)))
`(org-list-dt ((,class (:weight bold :foreground "#335EA8"))))
- `(org-macro ((,class (:foreground "white" :background "#EDB802"))))
+ `(org-macro ((,class (:weight bold :foreground "#EDB802"))))
`(org-meta-line ((,class (:slant normal :foreground "#008ED1" :background "#EAEAFF"))))
- `(org-mode-line-clock ((,class ,clock-line)))
+ `(org-mode-line-clock ((,class (:box (:line-width 1 :color "#335EA8") :foreground "black" :background "#FFA335"))))
`(org-mode-line-clock-overrun ((,class (:weight bold :box (:line-width 1 :color "#335EA8") :foreground "white" :background "#FF4040"))))
`(org-number-of-items ((,class (:weight bold :foreground "white" :background "#79BA79"))))
`(org-property-value ((,class (:foreground "#00A000"))))
`(org-quote ((,class (:slant italic :foreground "dim gray" :background "#FFFFE0"))))
`(org-scheduled ((,class (:foreground "#333333"))))
- `(org-scheduled-previously ((,class (:foreground "#F22659"))))
+ `(org-scheduled-previously ((,class (:foreground "#1466C6"))))
`(org-scheduled-today ((,class (:weight bold :foreground "#4F4A3D" :background "#FFFFCC"))))
`(org-sexp-date ((,class (:foreground "#3774CC"))))
`(org-special-keyword ((,class (:weight bold :foreground "#00BB00" :background "#EAFFEA"))))
- `(org-table ((,class (:foreground "dark green" :background "#EAFFEA"))))
+ `(org-table ((,class (:foreground "dark green" :background "#EAFFEA")))) ;; :inherit fixed-pitch))))
`(org-tag ((,class (:weight normal :slant italic :foreground "#9A9FA4" :background "white"))))
- `(org-target ((,class ,link)))
+ `(org-target ((,class (:foreground "#FF6DAF"))))
`(org-time-grid ((,class (:foreground "#CFCFCF"))))
`(org-todo ((,class (:weight bold :box (:line-width 1 :color "#D8ABA7") :foreground "#D8ABA7" :background "#FFE6E4"))))
`(org-upcoming-deadline ((,class (:foreground "#FF5555"))))
- `(org-verbatim ((,class (:foreground "#0066CC"))))
+ `(org-verbatim ((,class (:foreground "#0066CC" :background "#F7FDFF"))))
`(org-verse ((,class (:slant italic :foreground "dim gray" :background "#EEEEEE"))))
`(org-warning ((,class (:weight bold :foreground "black" :background "#CCE7FF"))))
`(outline-1 ((,class ,ol1)))
@@ -578,17 +811,17 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(outline-6 ((,class ,ol6)))
`(outline-7 ((,class ,ol7)))
`(outline-8 ((,class ,ol8)))
- `(pabbrev-debug-display-label-face ((,class (:background "chartreuse"))))
+ `(pabbrev-debug-display-label-face ((,class (:foreground "white" :background "#A62154"))))
`(pabbrev-suggestions-face ((,class (:weight bold :foreground "white" :background "red"))))
`(pabbrev-suggestions-label-face ((,class (:weight bold :foreground "white" :background "purple"))))
`(paren-face-match ((,class ,paren-matched)))
`(paren-face-mismatch ((,class ,paren-unmatched)))
`(paren-face-no-match ((,class ,paren-unmatched)))
`(persp-selected-face ((,class (:weight bold :foreground "#EEF5FE"))))
- `(powerline-active1 ((,class (:background "grey22" :inherit mode-line))))
- `(powerline-active2 ((,class (:background "#4070B6" :inherit mode-line))))
- `(powerline-inactive1 ((,class (:background "#686868" :inherit mode-line-inactive))))
- `(powerline-inactive2 ((,class (:background "#A9A9A9" :inherit mode-line-inactive))))
+ `(powerline-active1 ((,class (:foreground "#85CEEB" :background "#383838" :inherit mode-line))))
+ `(powerline-active2 ((,class (:foreground "#85CEEB" :background "#4070B6" :inherit mode-line))))
+ `(powerline-inactive1 ((,class (:foreground "#F0F0EF" :background "#686868" :inherit mode-line-inactive))))
+ `(powerline-inactive2 ((,class (:foreground "#F0F0EF" :background "#A9A9A9" :inherit mode-line-inactive))))
`(rainbow-delimiters-depth-1-face ((,class (:foreground "#707183"))))
`(rainbow-delimiters-depth-2-face ((,class (:foreground "#7388D6"))))
`(rainbow-delimiters-depth-3-face ((,class (:foreground "#909183"))))
@@ -600,29 +833,33 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(rainbow-delimiters-depth-9-face ((,class (:foreground "#887070"))))
`(rainbow-delimiters-mismatched-face ((,class ,paren-unmatched)))
`(rainbow-delimiters-unmatched-face ((,class ,paren-unmatched)))
- `(realgud-overlay-arrow1 ((,class (:foreground "#005522"))))
- `(realgud-overlay-arrow2 ((,class (:foreground "#c18401"))))
- `(realgud-overlay-arrow3 ((,class (:foreground "#909183"))))
- `(realgud-bp-disabled-face ((,class (:foreground "#909183"))))
- `(realgud-bp-line-enabled-face ((,class (:underline "red"))))
- `(realgud-bp-line-disabled-face ((,class (:underline "#909183"))))
- `(realgud-file-name ((,class :foreground "#005522")))
- `(realgud-line-number ((,class :foreground "#A535AE")))
- `(realgud-backtrace-number ((,class :foreground "#A535AE" :weight bold)))
`(recover-this-file ((,class (:weight bold :background "#FF3F3F"))))
`(rng-error ((,class (:weight bold :foreground "red" :background "#FBE3E4"))))
`(sh-heredoc ((,class (:foreground "blue" :background "#EEF5FE"))))
`(sh-quoted-exec ((,class (:foreground "#FF1493"))))
- `(shadow ((,class ,shadow)))
+ `(shadow ((,class ,shadow))) ; Used for grep context lines.
`(shell-option-face ((,class (:foreground "forest green"))))
`(shell-output-2-face ((,class (:foreground "blue"))))
`(shell-output-3-face ((,class (:foreground "purple"))))
`(shell-output-face ((,class (:foreground "black"))))
;; `(shell-prompt-face ((,class (:weight bold :foreground "yellow"))))
+ `(shm-current-face ((,class (:background "#EEE8D5"))))
+ `(shm-quarantine-face ((,class (:background "lemonchiffon"))))
`(show-paren-match ((,class ,paren-matched)))
`(show-paren-mismatch ((,class ,paren-unmatched)))
`(sml-modeline-end-face ((,class (:background "#6BADF6")))) ; #335EA8
`(sml-modeline-vis-face ((,class (:background "#1979CA"))))
+ `(term ((,class (:foreground "#333333" :background "#FFFFFF"))))
+
+ ;; `(sp-pair-overlay-face ((,class ())))
+ ;; `(sp-show-pair-enclosing ((,class ())))
+ ;; `(sp-show-pair-match-face ((,class ()))) ; ~ Pair highlighting (matching tags).
+ ;; `(sp-show-pair-mismatch-face ((,class ())))
+ ;; `(sp-wrap-overlay-closing-pair ((,class ())))
+ ;; `(sp-wrap-overlay-face ((,class ())))
+ ;; `(sp-wrap-overlay-opening-pair ((,class ())))
+ ;; `(sp-wrap-tag-overlay-face ((,class ())))
+
`(speedbar-button-face ((,class (:foreground "green4"))))
`(speedbar-directory-face ((,class (:foreground "blue4"))))
`(speedbar-file-face ((,class (:foreground "cyan4"))))
@@ -640,7 +877,6 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(tex-verbatim ((,class (:foreground "blue"))))
`(tool-bar ((,class (:box (:line-width 1 :style released-button) :foreground "black" :background "gray75"))))
`(tooltip ((,class (:foreground "black" :background "light yellow"))))
- `(trailing-whitespace ((,class (:background "#F6EBFE"))))
`(traverse-match-face ((,class (:weight bold :foreground "blue violet"))))
`(vc-annotate-face-3F3FFF ((,class (:foreground "#3F3FFF" :background "black"))))
`(vc-annotate-face-3F6CFF ((,class (:foreground "#3F3FFF" :background "black"))))
@@ -655,11 +891,24 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(vc-annotate-face-83FF3F ((,class (:foreground "#B0FF3F" :background "black"))))
`(vc-annotate-face-B0FF3F ((,class (:foreground "#B0FF3F" :background "black"))))
`(vc-annotate-face-DDFF3F ((,class (:foreground "#FFF33F" :background "black"))))
+ `(vc-annotate-face-F6FFCC ((,class (:foreground "black" :background "#FFFFC0"))))
`(vc-annotate-face-FF3F3F ((,class (:foreground "#FF3F3F" :background "black"))))
`(vc-annotate-face-FF6C3F ((,class (:foreground "#FF3F3F" :background "black"))))
`(vc-annotate-face-FF993F ((,class (:foreground "#FF993F" :background "black"))))
`(vc-annotate-face-FFC63F ((,class (:foreground "#FF993F" :background "black"))))
`(vc-annotate-face-FFF33F ((,class (:foreground "#FFF33F" :background "black"))))
+
+ ;; ;; vc
+ ;; (vc-up-to-date-state ((,c :foreground ,(gc 'green-1))))
+ ;; (vc-edited-state ((,c :foreground ,(gc 'yellow+1))))
+ ;; (vc-missing-state ((,c :foreground ,(gc 'red))))
+ ;; (vc-conflict-state ((,c :foreground ,(gc 'red+2) :weight bold)))
+ ;; (vc-locked-state ((,c :foreground ,(gc 'cyan-1))))
+ ;; (vc-locally-added-state ((,c :foreground ,(gc 'blue))))
+ ;; (vc-needs-update-state ((,c :foreground ,(gc 'magenta))))
+ ;; (vc-removed-state ((,c :foreground ,(gc 'red-1))))
+
+ `(vhl/default-face ((,class ,volatile-highlight))) ; `volatile-highlights.el' (for undo, yank).
`(w3m-anchor ((,class ,link)))
`(w3m-arrived-anchor ((,class (:foreground "purple1"))))
`(w3m-bitmap-image-face ((,class (:foreground "gray4" :background "green"))))
@@ -676,38 +925,138 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(w3m-link-numbering ((,class (:foreground "#B4C7EB")))) ; mouseless browsing
`(w3m-strike-through-face ((,class (:strike-through t))))
`(w3m-underline-face ((,class (:underline t))))
- `(which-func ((,class (:weight bold :foreground "white"))))
+
+ ;; `(web-mode-block-attr-name-face ((,class ())))
+ ;; `(web-mode-block-attr-value-face ((,class ())))
+ ;; `(web-mode-block-comment-face ((,class ())))
+ ;; `(web-mode-block-control-face ((,class ())))
+ ;; `(web-mode-block-delimiter-face ((,class ())))
+ ;; `(web-mode-block-face ((,class ())))
+ ;; `(web-mode-block-string-face ((,class ())))
+ ;; `(web-mode-bold-face ((,class ())))
+ ;; `(web-mode-builtin-face ((,class ())))
+ ;; `(web-mode-comment-face ((,class ())))
+ ;; `(web-mode-comment-keyword-face ((,class ())))
+ ;; `(web-mode-constant-face ((,class ())))
+ ;; `(web-mode-css-at-rule-face ((,class ())))
+ ;; `(web-mode-css-color-face ((,class ())))
+ ;; `(web-mode-css-comment-face ((,class ())))
+ ;; `(web-mode-css-function-face ((,class ())))
+ ;; `(web-mode-css-priority-face ((,class ())))
+ ;; `(web-mode-css-property-name-face ((,class ())))
+ ;; `(web-mode-css-pseudo-class-face ((,class ())))
+ ;; `(web-mode-css-selector-face ((,class ())))
+ ;; `(web-mode-css-string-face ((,class ())))
+ ;; `(web-mode-css-variable-face ((,class ())))
+ ;; `(web-mode-current-column-highlight-face ((,class ())))
+ `(web-mode-current-element-highlight-face ((,class (:background "#99CCFF")))) ; #FFEE80
+ ;; `(web-mode-doctype-face ((,class ())))
+ ;; `(web-mode-error-face ((,class ())))
+ ;; `(web-mode-filter-face ((,class ())))
+ `(web-mode-folded-face ((,class (:box (:line-width 1 :color "#777777") :foreground "#9A9A6A" :background "#F3F349"))))
+ ;; `(web-mode-function-call-face ((,class ())))
+ ;; `(web-mode-function-name-face ((,class ())))
+ ;; `(web-mode-html-attr-custom-face ((,class ())))
+ ;; `(web-mode-html-attr-engine-face ((,class ())))
+ ;; `(web-mode-html-attr-equal-face ((,class ())))
+ `(web-mode-html-attr-name-face ((,class ,xml-attribute)))
+ ;; `(web-mode-html-attr-value-face ((,class ())))
+ ;; `(web-mode-html-entity-face ((,class ())))
+ `(web-mode-html-tag-bracket-face ((,class ,xml-tag)))
+ ;; `(web-mode-html-tag-custom-face ((,class ())))
+ `(web-mode-html-tag-face ((,class ,xml-tag)))
+ ;; `(web-mode-html-tag-namespaced-face ((,class ())))
+ ;; `(web-mode-inlay-face ((,class ())))
+ ;; `(web-mode-italic-face ((,class ())))
+ ;; `(web-mode-javascript-comment-face ((,class ())))
+ ;; `(web-mode-javascript-string-face ((,class ())))
+ ;; `(web-mode-json-comment-face ((,class ())))
+ ;; `(web-mode-json-context-face ((,class ())))
+ ;; `(web-mode-json-key-face ((,class ())))
+ ;; `(web-mode-json-string-face ((,class ())))
+ ;; `(web-mode-jsx-depth-1-face ((,class ())))
+ ;; `(web-mode-jsx-depth-2-face ((,class ())))
+ ;; `(web-mode-jsx-depth-3-face ((,class ())))
+ ;; `(web-mode-jsx-depth-4-face ((,class ())))
+ ;; `(web-mode-keyword-face ((,class ())))
+ ;; `(web-mode-param-name-face ((,class ())))
+ ;; `(web-mode-part-comment-face ((,class ())))
+ `(web-mode-part-face ((,class (:background "#FFFFE0"))))
+ ;; `(web-mode-part-string-face ((,class ())))
+ ;; `(web-mode-preprocessor-face ((,class ())))
+ `(web-mode-script-face ((,class (:background "#EFF0F1"))))
+ ;; `(web-mode-sql-keyword-face ((,class ())))
+ ;; `(web-mode-string-face ((,class ())))
+ ;; `(web-mode-style-face ((,class ())))
+ ;; `(web-mode-symbol-face ((,class ())))
+ ;; `(web-mode-type-face ((,class ())))
+ ;; `(web-mode-underline-face ((,class ())))
+ ;; `(web-mode-variable-name-face ((,class ())))
+ ;; `(web-mode-warning-face ((,class ())))
+ ;; `(web-mode-whitespace-face ((,class ())))
+
+ `(which-func ((,class (:weight bold :slant italic :foreground "white"))))
+ ;; `(which-key-command-description-face)
+ ;; `(which-key-group-description-face)
+ ;; `(which-key-highlighted-command-face)
+ ;; `(which-key-key-face)
+ `(which-key-local-map-description-face ((,class (:weight bold :background "#F3F7FC" :inherit which-key-command-description-face))))
+ ;; `(which-key-note-face)
+ ;; `(which-key-separator-face)
+ ;; `(which-key-special-key-face)
`(widget-button ((,class ,link)))
`(widget-button-pressed ((,class (:foreground "red"))))
`(widget-documentation ((,class (:foreground "green4"))))
`(widget-field ((,class (:background "gray85"))))
`(widget-inactive ((,class (:foreground "dim gray"))))
`(widget-single-line-field ((,class (:background "gray85"))))
- `(yas/field-debug-face ((,class (:background "ivory2"))))
- `(yas/field-highlight-face ((,class (:background "DarkSeaGreen1"))))
+ `(woman-bold ((,class (:weight bold :foreground "#F13D3D"))))
+ `(woman-italic ((,class (:weight bold :slant italic :foreground "#46BE1B"))))
+ `(woman-symbol ((,class (:weight bold :foreground "purple"))))
+ `(yas-field-debug-face ((,class (:foreground "white" :background "#A62154"))))
+ `(yas-field-highlight-face ((,class (:box (:line-width 1 :color "#838383") :foreground "black" :background "#D4DCD8"))))
+
+ ;; `(ztreep-arrow-face ((,class ())))
+ ;; `(ztreep-diff-header-face ((,class ())))
+ ;; `(ztreep-diff-header-small-face ((,class ())))
+ `(ztreep-diff-model-add-face ((,class (:weight bold :foreground "#008800"))))
+ `(ztreep-diff-model-diff-face ((,class (:weight bold :foreground "#0044DD"))))
+ `(ztreep-diff-model-ignored-face ((,class (:strike-through t :foreground "#9E9E9E"))))
+ `(ztreep-diff-model-normal-face ((,class (:foreground "#000000"))))
+ ;; `(ztreep-expand-sign-face ((,class ())))
+ ;; `(ztreep-header-face ((,class ())))
+ ;; `(ztreep-leaf-face ((,class ())))
+ ;; `(ztreep-node-face ((,class ())))
+
))
(custom-theme-set-variables 'leuven
- '(ansi-color-faces-vector
- [default default default italic underline success warning error])
- '(ansi-color-names-vector
- ["black" "red3" "ForestGreen" "yellow3" "blue" "magenta3" "DeepSkyBlue" "gray50"])
- ; colors used in Shell mode
+
+ ;; highlight-sexp-mode.
+ '(hl-sexp-background-color "#efebe9")
+
+ '(ansi-color-faces-vector
+ [default default default italic underline success warning error])
+
+ ;; Colors used in Shell mode.
+ '(ansi-color-names-vector
+ ["black" "red3" "ForestGreen" "yellow3" "blue" "magenta3" "DeepSkyBlue" "gray50"])
)
;;;###autoload
(when (and (boundp 'custom-theme-load-path)
load-file-name)
- ;; add theme folder to `custom-theme-load-path' when installing over MELPA
+ ;; Add theme folder to `custom-theme-load-path' when installing over MELPA.
(add-to-list 'custom-theme-load-path
(file-name-as-directory (file-name-directory load-file-name))))
(provide-theme 'leuven)
+;; This is for the sake of Emacs.
;; Local Variables:
+;; time-stamp-end: "$"
;; time-stamp-format: "%:y%02m%02d.%02H%02M"
;; time-stamp-start: "Version: "
-;; time-stamp-end: "$"
;; End:
;;; leuven-theme.el ends here
diff --git a/etc/themes/light-blue-theme.el b/etc/themes/light-blue-theme.el
index b769015f746..c6d3c92bce7 100644
--- a/etc/themes/light-blue-theme.el
+++ b/etc/themes/light-blue-theme.el
@@ -1,4 +1,4 @@
-;;; light-blue-theme.el --- Custom theme for faces
+;;; light-blue-theme.el --- Custom theme for faces -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el
index 045d4462843..ac395f993c9 100644
--- a/etc/themes/manoj-dark-theme.el
+++ b/etc/themes/manoj-dark-theme.el
@@ -1,22 +1,24 @@
-;;; manoj-dark.el --- A dark theme from Manoj
+;;; manoj-dark.el --- A dark theme from Manoj -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
;; Author: Manoj Srivastava <srivasta@ieee.org>
;; Keywords: lisp, faces
-;; 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:
@@ -88,7 +90,6 @@ jarring angry fruit salad look to reduce eye fatigue.")
'(font-lock-comment-face ((t (:italic t :slant oblique :foreground "chocolate1"))))
'(font-lock-comment-delimiter-face ((t (:foreground "Salmon"))))
'(font-lock-doc-face ((t (:italic t :slant oblique :foreground "LightCoral"))))
- '(font-lock-doc-string-face ((t (:foreground "Plum"))))
'(font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold))))
'(cperl-array-face ((t (:foreground "LawnGreen" :background "Black" :bold t))))
diff --git a/etc/themes/misterioso-theme.el b/etc/themes/misterioso-theme.el
index b51c9b8e58b..ff9af0c7440 100644
--- a/etc/themes/misterioso-theme.el
+++ b/etc/themes/misterioso-theme.el
@@ -1,4 +1,4 @@
-;;; misterioso-theme.el --- Custom face theme for Emacs
+;;; misterioso-theme.el --- Custom face theme for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el
new file mode 100644
index 00000000000..c1090eedefd
--- /dev/null
+++ b/etc/themes/modus-operandi-theme.el
@@ -0,0 +1,4266 @@
+;;; modus-operandi-theme.el --- Accessible light theme (WCAG AAA) -*- lexical-binding:t -*-
+
+;; Copyright (c) 2019-2020 Free Software Foundation, Inc.
+
+;; Author: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://gitlab.com/protesilaos/modus-themes
+;; Version: 0.12.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
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This theme is designed for colour-contrast accessibility.
+;;
+;; 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.
+;;
+;; The theme provides the following customisation options, all of which
+;; are disabled by default:
+;;
+;; modus-operandi-theme-slanted-constructs (boolean)
+;; modus-operandi-theme-bold-constructs (boolean)
+;; modus-operandi-theme-variable-pitch-headings (boolean)
+;; modus-operandi-theme-rainbow-headings (boolean)
+;; modus-operandi-theme-section-headings (boolean)
+;; 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-3d-modeline (boolean)
+;; modus-operandi-theme-subtle-diffs (boolean)
+;; modus-operandi-theme-faint-syntax (boolean)
+;; modus-operandi-theme-intense-hl-line (boolean)
+;; modus-operandi-theme-intense-paren-match (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
+;; 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
+;; csv-mode
+;; ctrlf
+;; custom (M-x customize)
+;; dap-mode
+;; dashboard (emacs-dashboard)
+;; deadgrep
+;; debbugs
+;; define-word
+;; deft
+;; dictionary
+;; diff-hl
+;; diff-mode
+;; dim-autoload
+;; 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-box
+;; elfeed
+;; elfeed-score
+;; emms
+;; enhanced-ruby-mode
+;; epa
+;; equake
+;; erc
+;; eros
+;; ert
+;; eshell
+;; eshell-fringe-status
+;; eshell-git-prompt
+;; eshell-prompt-extras (epe)
+;; evil (evil-mode)
+;; evil-goggles
+;; evil-visual-mark-mode
+;; eww
+;; eyebrowse
+;; fancy-dabbrev
+;; flycheck
+;; 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
+;; mu4e
+;; mu4e-conversation
+;; multiple-cursors
+;; neotree
+;; no-emoji
+;; notmuch
+;; num3-mode
+;; nxml-mode
+;; 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
+;; 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
+;; 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
+
+;;; 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-header nil nil) ; Name is tentative
+(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-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-rainbow-headings nil
+ "Use more saturated colours for headings."
+ :type 'boolean)
+
+(defcustom modus-operandi-theme-section-headings nil
+ "Use a background and an overline in headings."
+ :type 'boolean)
+
+(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)
+
+(define-obsolete-variable-alias '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)))
+
+(define-obsolete-variable-alias '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)
+
+(define-obsolete-variable-alias '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)))
+
+(defcustom modus-operandi-theme-3d-modeline nil
+ "Use a three-dimensional style for the active mode line."
+ :type 'boolean)
+
+(defcustom modus-operandi-theme-subtle-diffs nil
+ "Use fewer/dim backgrounds in `diff-mode', `ediff',`magit'."
+ :type 'boolean)
+
+(define-obsolete-variable-alias '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 `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)
+
+;;; 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-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-foreground (subtle rainbow)
+ "Apply foreground value to headings.
+SUBTLE is the default aesthetic. RAINBOW is the saturated one."
+ (if modus-operandi-theme-rainbow-headings
+ (list :foreground rainbow)
+ (list :foreground subtle)))
+
+(defun modus-operandi-theme-heading-block (bg fg)
+ "Conditionally extend heading styles.
+Apply BG to background and FG to overline."
+ (if modus-operandi-theme-section-headings
+ (append
+ (and (>= emacs-major-version 27) '(:extend t))
+ (list :background bg :overline fg))
+ (list :background nil :overline nil)))
+
+(defun modus-operandi-theme-org-todo-block (bgbox fgbox fg)
+ "Conditionally extend the styles of Org keywords.
+BGBOX applies to the background. FGBOX applies to the foreground
+and the border. FG is used when no block style is in effect."
+ (if modus-operandi-theme-section-headings
+ (list :background bgbox :foreground fgbox :box (list :color fgbox))
+ (list :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-modeline-box (col3d col &optional btn int)
+ "Control the box properties of the mode line.
+COL3D is the border that is intended for the three-dimensional
+modeline. COL applies to the two-dimensional modeline. Optional
+BTN provides the 3d button style. Optional INT defines a border
+width."
+ (let* ((style (if btn 'released-button nil))
+ (int (if int int 1)))
+ (if modus-operandi-theme-3d-modeline
+ (list :line-width int :color col3d :style style)
+ (list :line-width 1 :color col :style nil))))
+
+(defun modus-operandi-theme-modeline-props (bg3d fg3d &optional bg fg)
+ "Control the background and foreground of the mode line.
+BG is the modeline's background. FG is the modeline's
+foreground. BG3D and FG3D apply to the three-dimensional
+modeline style."
+ (if modus-operandi-theme-3d-modeline
+ (list :background bg3d :foreground fg3d)
+ (list :background bg :foreground fg)))
+
+(defun modus-operandi-theme-diffs (subtle-bg subtle-fg intense-bg intense-fg)
+ "Colour combinations for `modus-operandi-theme-subtle-diffs'.
+
+SUBTLE-BG should be similar or the same as the main background.
+SUBTLE-FG should be an appropriate accent value. INTENSE-BG
+should be one of the dedicated backgrounds for diffs. INTENSE-FG
+should be one of the dedicated foregrounds for diffs"
+ (if modus-operandi-theme-subtle-diffs
+ (list :background subtle-bg :foreground subtle-fg)
+ (list :background intense-bg :foreground intense-fg)))
+
+(defun modus-operandi-theme-standard-completions (mainfg subtlebg intensebg intensefg)
+ "Combinations for `modus-operandi-theme-completions'.
+These are intended for Icomplete, Ido, and related.
+
+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."
+ (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'.
+These are intended for Helm, Ivy, Selectrum, etc.
+
+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."
+ (pcase modus-operandi-theme-completions
+ ('opinionated (list :inherit (list altface bold)
+ :foreground (if altfg 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" . "#e0e0e0") ("fg-active" . "#191919")
+ ("bg-inactive" . "#efedef") ("fg-inactive" . "#424242")
+ ;; 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" . "#0030a6")
+ ("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" . "#223fbf")
+ ("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" . "#0000bb")
+ ("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" . "#930000") ("green-active" . "#005300")
+ ("yellow-active" . "#703700") ("blue-active" . "#0033c0")
+ ("magenta-active" . "#6320a0") ("cyan-active" . "#004882")
+ ;; styles that are meant exclusively for the fringes
+ ;;
+ ;; must have a minimum contrast ratio of 1.5:1 with `bg-inactive'
+ ;; and be combined with `fg-main' or `fg-dim'
+ ("red-fringe-bg" . "#ff9a9a") ("green-fringe-bg" . "#86cf86")
+ ("yellow-fringe-bg" . "#e0c050") ("blue-fringe-bg" . "#82afff")
+ ("magenta-fringe-bg" . "#f0a3ff") ("cyan-fringe-bg" . "#00d6e0")
+ ;; 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-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-paren-match" . "#e0af82")
+ ("bg-paren-match-intense" . "#70af9f")
+ ("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")
+
+ ("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-dim)))
+ `(modus-theme-fringe-green ((,class :background ,green-fringe-bg :foreground ,fg-dim)))
+ `(modus-theme-fringe-yellow ((,class :background ,yellow-fringe-bg :foreground ,fg-dim)))
+ `(modus-theme-fringe-blue ((,class :background ,blue-fringe-bg :foreground ,fg-dim)))
+ `(modus-theme-fringe-magenta ((,class :background ,magenta-fringe-bg :foreground ,fg-dim)))
+ `(modus-theme-fringe-cyan ((,class :background ,cyan-fringe-bg :foreground ,fg-dim)))
+;;;;; 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 :background ,bg-diff-added :foreground ,fg-diff-added)))
+ `(modus-theme-diff-changed ((,class :background ,bg-diff-changed :foreground ,fg-diff-changed)))
+ `(modus-theme-diff-removed ((,class :background ,bg-diff-removed :foreground ,fg-diff-removed)))
+ `(modus-theme-diff-refine-added ((,class :background ,bg-diff-refine-added :foreground ,fg-diff-refine-added)))
+ `(modus-theme-diff-refine-changed ((,class :background ,bg-diff-refine-changed :foreground ,fg-diff-refine-changed)))
+ `(modus-theme-diff-refine-removed ((,class :background ,bg-diff-refine-removed :foreground ,fg-diff-refine-removed)))
+ `(modus-theme-diff-focus-added ((,class :background ,bg-diff-focus-added :foreground ,fg-diff-focus-added)))
+ `(modus-theme-diff-focus-changed ((,class :background ,bg-diff-focus-changed :foreground ,fg-diff-focus-changed)))
+ `(modus-theme-diff-focus-removed ((,class :background ,bg-diff-focus-removed :foreground ,fg-diff-focus-removed)))
+ `(modus-theme-diff-heading ((,class :background ,bg-diff-heading :foreground ,fg-diff-heading)))
+;;;;; mark indicators
+ ;; colour combinations intended for Dired, Ibuffer, or equivalent
+ `(modus-theme-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)))
+;;;;; other custom faces
+ `(modus-theme-hl-line ((,class :background ,(if modus-operandi-theme-intense-hl-line
+ bg-active 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)))
+ `(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 :underline t)))
+ `(link ((,class :foreground ,blue-alt-other :underline t)))
+ `(link-visited ((,class :foreground ,magenta-alt-other :underline t)))
+ `(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 :foreground ,magenta-alt-other :underline t)))
+ `(apropos-keybinding ((,class :inherit bold :foreground ,cyan)))
+ `(apropos-misc-button ((,class :foreground ,cyan-alt-other :underline t)))
+ `(apropos-property ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta-alt)))
+ `(apropos-symbol ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,blue-nuanced :underline t)))
+ `(apropos-user-option-button ((,class :foreground ,green-alt-other :underline t)))
+ `(apropos-variable-button ((,class :foreground ,blue :underline t)))
+;;;;; 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)))
+;;;;; 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 :background ,bg-alt :foreground ,fg-alt)))
+ `(cfw:face-day-title ((,class :background ,bg-alt :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 :background ,bg-inactive :foreground ,fg-inactive)))
+ `(cfw:face-grid ((,class :foreground ,fg-inactive)))
+ `(cfw:face-header ((,class :inherit bold ::foreground ,fg-main)))
+ `(cfw:face-holiday ((,class :inherit bold :background ,bg-alt :foreground ,magenta)))
+ `(cfw:face-periods ((,class :foreground ,cyan-alt-other)))
+ `(cfw:face-saturday ((,class :inherit bold :background ,bg-alt :foreground ,magenta-alt)))
+ `(cfw:face-select ((,class :inherit modus-theme-intense-blue)))
+ `(cfw:face-sunday ((,class :inherit bold :background ,bg-alt :foreground ,magenta-alt-other)))
+ `(cfw:face-title ((,class :inherit ,modus-theme-variable-pitch
+ :foreground ,fg-special-warm
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4))))
+ `(cfw:face-today ((,class :inherit bold :foreground ,blue)))
+ `(cfw:face-today-title ((,class :inherit modus-theme-special-mild :box t)))
+ `(cfw:face-toolbar ((,class :background ,bg-active :foreground ,bg-active)))
+ `(cfw:face-toolbar-button-off ((,class :background ,bg-alt :foreground ,cyan)))
+ `(cfw:face-toolbar-button-on ((,class :inherit bold :background ,bg-main :foreground ,blue-intense)))
+;;;;; 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 :inherit bold :foreground ,green-alt-other)))
+ `(log-edit-summary ((,class :foreground ,magenta-alt-other)))
+ `(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 :foreground ,blue :underline t)))
+ `(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
+ cyan-alt-other cyan-nuanced-bg
+ yellow-refine-bg yellow-refine-fg))))
+ `(completions-first-difference ((,class :inherit bold
+ ,@(modus-operandi-theme-standard-completions
+ blue-alt-other blue-nuanced-bg
+ cyan-subtle-bg fg-dim))))
+;;;;; 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)))
+;;;;; 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 :foreground ,blue-alt-other :underline t)))
+ `(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 ,@(modus-operandi-theme-diffs
+ bg-main green
+ bg-diff-focus-added fg-diff-focus-added))))
+ `(diff-changed ((,class ,@(modus-operandi-theme-diffs
+ bg-main yellow
+ bg-diff-focus-changed fg-diff-focus-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 ,@(modus-operandi-theme-diffs
+ bg-alt blue-alt
+ bg-diff-heading fg-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 ,@(modus-operandi-theme-diffs
+ bg-diff-added fg-diff-added
+ bg-diff-refine-added fg-diff-refine-added))))
+ `(diff-refine-changed ((,class ,@(modus-operandi-theme-diffs
+ bg-diff-changed fg-diff-changed
+ bg-diff-refine-changed fg-diff-refine-changed))))
+ `(diff-refine-removed ((,class ,@(modus-operandi-theme-diffs
+ bg-diff-removed fg-diff-removed
+ bg-diff-refine-removed fg-diff-refine-removed))))
+ `(diff-removed ((,class ,@(modus-operandi-theme-diffs
+ bg-main red
+ bg-diff-focus-removed fg-diff-focus-removed))))
+;;;;; dim-autoload
+ `(dim-autoload-cookie-line ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
+;;;;; dired
+ `(dired-directory ((,class :foreground ,blue)))
+ `(dired-flagged ((,class :inherit modus-theme-mark-del)))
+ `(dired-header ((,class :inherit modus-theme-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 :foreground ,cyan-alt :underline t)))
+ `(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 ,green-alt-other)))
+ `(diredfl-compressed-file-suffix ((,class :foreground ,green-alt)))
+ `(diredfl-date-time ((,class :foreground ,fg-special-cold)))
+ `(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-header)))
+ `(diredfl-dir-name ((,class :inherit dired-directory)))
+ `(diredfl-dir-priv ((,class :foreground ,blue)))
+ `(diredfl-exec-priv ((,class :foreground ,red-alt-other)))
+ `(diredfl-executable-tag ((,class :foreground ,red-alt)))
+ `(diredfl-file-name ((,class :foreground ,fg-main)))
+ `(diredfl-file-suffix ((,class :foreground ,fg-special-warm)))
+ `(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-inactive)))
+ `(diredfl-link-priv ((,class :foreground ,blue-alt-other)))
+ `(diredfl-no-priv ((,class :foreground ,fg-inactive)))
+ `(diredfl-number ((,class :foreground ,cyan)))
+ `(diredfl-other-priv ((,class :foreground ,yellow)))
+ `(diredfl-rare-priv ((,class :foreground ,magenta-alt-other)))
+ `(diredfl-read-priv ((,class :foreground ,magenta)))
+ `(diredfl-symlink ((,class :foreground ,cyan-alt :underline t)))
+ `(diredfl-tagged-autofile-name ((,class :inherit modus-theme-refine-magenta)))
+ `(diredfl-write-priv ((,class :foreground ,cyan-alt-other)))
+;;;;; 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 :foreground ,blue :underline t)))
+ `(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 modus-theme-active-red)))
+ `(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
+ `(ediff-current-diff-A ((,class ,@(modus-operandi-theme-diffs
+ bg-alt red
+ bg-diff-removed fg-diff-removed))))
+ `(ediff-current-diff-Ancestor ((,class ,@(modus-operandi-theme-diffs
+ bg-alt fg-special-cold
+ bg-special-cold fg-special-cold))))
+ `(ediff-current-diff-B ((,class ,@(modus-operandi-theme-diffs
+ bg-alt green
+ bg-diff-added fg-diff-added))))
+ `(ediff-current-diff-C ((,class ,@(modus-operandi-theme-diffs
+ bg-alt yellow
+ bg-diff-changed fg-diff-changed))))
+ `(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-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 ,cyan)))
+ `(elfeed-search-feed-face ((,class :foreground ,blue)))
+ `(elfeed-search-filter-face ((,class :foreground ,magenta-active)))
+ `(elfeed-search-last-update-face ((,class :foreground ,green-active)))
+ `(elfeed-search-tag-face ((,class :foreground ,cyan-alt-other)))
+ `(elfeed-search-title-face ((,class :foreground ,fg-main)))
+ `(elfeed-search-unread-count-face ((,class :foreground ,blue-active)))
+ `(elfeed-search-unread-title-face ((,class :inherit bold)))
+;;;;; 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)))
+;;;;; 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 :foreground ,cyan :underline t)))
+ `(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)))
+;;;;; 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-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-other
+ '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-alt :slant ,modus-theme-slant)))
+ `(git-commit-keyword ((,class :foreground ,magenta)))
+ `(git-commit-known-pseudo-header ((,class :inherit bold :foreground ,fg-special-warm)))
+ `(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 :inherit bold :foreground ,fg-alt)))
+ `(git-commit-summary ((,class :foreground ,magenta-alt-other)))
+;;;;; 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-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-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 :foreground ,cyan :underline t)))
+ `(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 ,fg-special-calm)))
+ `(gnus-header-from ((,class :inherit bold :foreground ,cyan-alt :underline nil)))
+ `(gnus-header-name ((,class :foreground ,cyan-alt-other)))
+ `(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-special-cold :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-special-cold)))
+ `(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 helm-ff-dotted-directory :underline t)))
+ `(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 :foreground ,red :underline t)))
+ `(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 :foreground ,cyan :underline t)))
+ `(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 :foreground ,cyan-alt-other :underline t)))
+ `(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 (bold ,modus-theme-variable-pitch) :foreground ,fg-main
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4))))
+;;;;; 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 magenta-nuanced-bg
+ magenta-intense-bg 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 magenta-nuanced-bg
+ magenta-subtle-bg 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
+ magenta-intense red-nuanced-bg
+ magenta-intense-bg fg-main))))
+ `(ido-subdir ((,class :foreground ,blue-alt-other)))
+ `(ido-virtual ((,class :foreground ,yellow-alt-other)))
+;;;;; 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 :foreground ,fg-alt :underline t)))
+ `(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 :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 (bold ,modus-theme-variable-pitch) :foreground ,fg-main
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-2))))
+ `(info-menu-star ((,class :foreground ,fg-main)))
+ `(info-node ((,class :inherit bold)))
+ `(info-title-1 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-main
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4))))
+ `(info-title-2 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-warm
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-3))))
+ `(info-title-3 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-cold
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-2))))
+ `(info-title-4 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-mild
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-1))))
+;;;;; 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 :box ,(modus-operandi-theme-modeline-box blue-alt blue-active t -3)
+ ,@(modus-operandi-theme-modeline-props
+ blue-active bg-main
+ blue-active bg-active))))
+;;;;; line numbers (display-line-numbers-mode and global variant)
+ `(line-number ((,class :background ,bg-dim :foreground ,fg-alt)))
+ `(line-number-current-line ((,class :inherit bold :background ,bg-active :foreground ,fg-active)))
+;;;;; 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 :foreground ,blue-alt-other :underline t)))
+ `(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)))
+ `(magit-diff-added ((,class ,@(modus-operandi-theme-diffs
+ bg-main green
+ bg-diff-added fg-diff-added))))
+ `(magit-diff-added-highlight ((,class ,@(modus-operandi-theme-diffs
+ bg-dim green
+ bg-diff-focus-added fg-diff-focus-added))))
+ `(magit-diff-base ((,class ,@(modus-operandi-theme-diffs
+ bg-main yellow
+ bg-diff-changed fg-diff-changed))))
+ `(magit-diff-base-highlight ((,class ,@(modus-operandi-theme-diffs
+ bg-dim yellow
+ bg-diff-focus-changed fg-diff-focus-changed))))
+ `(magit-diff-context ((,class :foreground ,fg-unfocused)))
+ `(magit-diff-context-highlight ((,class ,@(modus-operandi-theme-diffs
+ bg-dim fg-dim
+ bg-inactive fg-inactive))))
+ `(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 :background ,bg-alt :foreground ,cyan)))
+ `(magit-diff-hunk-heading ((,class :inherit bold :background ,bg-active :foreground ,fg-inactive)))
+ `(magit-diff-hunk-heading-highlight ((,class :inherit (modus-theme-diff-heading bold))))
+ `(magit-diff-hunk-heading-selection ((,class :inherit modus-theme-intense-cyan)))
+ `(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-diffs
+ bg-main red
+ bg-diff-removed fg-diff-removed))))
+ `(magit-diff-removed-highlight ((,class ,@(modus-operandi-theme-diffs
+ bg-dim red
+ bg-diff-focus-removed fg-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-warm :slant ,modus-theme-slant)))
+ `(markdown-bold-face ((,class :inherit bold)))
+ `(markdown-code-face ((,class :inherit fixed-pitch)))
+ `(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 ((,class :inherit bold)))
+ `(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 fixed-pitch :foreground ,cyan)))
+ `(markdown-html-attr-value-face ((,class :inherit fixed-pitch :foreground ,blue)))
+ `(markdown-html-entity-face ((,class :inherit fixed-pitch :foreground ,cyan)))
+ `(markdown-html-tag-delimiter-face ((,class :inherit fixed-pitch :foreground ,fg-special-mild)))
+ `(markdown-html-tag-name-face ((,class :inherit fixed-pitch :foreground ,magenta-alt)))
+ `(markdown-inline-code-face ((,class :inherit fixed-pitch :foreground ,magenta)))
+ `(markdown-italic-face ((,class :foreground ,fg-special-cold :slant italic)))
+ `(markdown-language-info-face ((,class :inherit fixed-pitch :foreground ,fg-special-cold)))
+ `(markdown-language-keyword-face ((,class :inherit fixed-pitch :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))
+ :inherit fixed-pitch :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 :inherit fixed-pitch :foreground ,fg-special-cold)))
+ `(markdown-url-face ((,class :foreground ,blue)))
+;;;;; 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 :foreground ,fg-inactive :underline t)))
+ `(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 :foreground ,blue-alt)))
+ `(message-header-name ((,class :foreground ,green-alt-other)))
+ `(message-header-newsgroups ((,class :inherit bold :foreground ,blue)))
+ `(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 ,magenta-alt)))
+ `(message-header-xheader ((,class :foreground ,blue-alt-other)))
+ `(message-mml ((,class :foreground ,green-alt)))
+ `(message-separator ((,class :background ,bg-active :foreground ,fg-special-warm)))
+;;;;; 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 :box ,(modus-operandi-theme-modeline-box bg-active fg-alt t)
+ ,@(modus-operandi-theme-modeline-props
+ bg-active fg-dim
+ bg-active fg-active))))
+ `(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 :box ,(modus-operandi-theme-modeline-box bg-active bg-region)
+ ,@(modus-operandi-theme-modeline-props
+ bg-dim fg-inactive
+ bg-inactive fg-inactive))))
+;;;;; 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)))
+;;;;; 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 :background ,bg-active :foreground ,fg-special-warm)))
+ `(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 ,cyan-active)))
+ `(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))))
+;;;;; orderless
+ `(orderless-match-face-0 ((,class :inherit bold
+ ,@(modus-operandi-theme-standard-completions
+ blue-alt 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-alt-other green-nuanced-bg
+ green-refine-bg green-refine-fg))))
+ `(orderless-match-face-3 ((,class :inherit bold
+ ,@(modus-operandi-theme-standard-completions
+ yellow-alt-other 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)))
+ `(org-agenda-column-dateline ((,class :background ,bg-alt)))
+ `(org-agenda-current-time ((,class :inherit modus-theme-subtle-cyan)))
+ `(org-agenda-date ((,class :inherit ,modus-theme-variable-pitch :foreground ,cyan-alt-other
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4)
+ ,@(modus-operandi-theme-heading-block cyan-nuanced-bg cyan-nuanced))))
+ `(org-agenda-date-today ((,class :inherit (bold ,modus-theme-variable-pitch)
+ :background ,cyan-intense-bg :foreground ,fg-main
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4))))
+ `(org-agenda-date-weekend ((,class :inherit ,modus-theme-variable-pitch :foreground ,cyan
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4)
+ ,@(modus-operandi-theme-heading-block blue-nuanced-bg cyan-nuanced))))
+ `(org-agenda-diary ((,class :foreground ,fg-main)))
+ `(org-agenda-dimmed-todo-face ((,class :inherit modus-theme-subtle-neutral)))
+ `(org-agenda-done ((,class ,@(modus-operandi-theme-org-todo-block green-nuanced-bg green-nuanced green))))
+ `(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 :inherit ,modus-theme-variable-pitch
+ :foreground ,fg-special-mild
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-3))))
+ `(org-archived ((,class :background ,bg-alt :foreground ,fg-alt)))
+ `(org-block ((,class ,@(modus-operandi-theme-org-block bg-dim)
+ :inherit fixed-pitch :foreground ,fg-main)))
+ `(org-block-begin-line ((,class ,@(modus-operandi-theme-org-block-delim
+ bg-dim fg-special-cold
+ bg-alt fg-special-mild)
+ :inherit fixed-pitch)))
+ `(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 :foreground ,green
+ ,@(modus-operandi-theme-heading-block
+ green-nuanced-bg green-nuanced))))
+ `(org-checkbox-statistics-todo ((,class ,@(modus-operandi-theme-heading-foreground red-alt red)
+ ,@(modus-operandi-theme-heading-block
+ red-nuanced-bg red-nuanced))))
+ `(org-clock-overlay ((,class :inherit modus-theme-special-cold)))
+ `(org-code ((,class :inherit fixed-pitch :foreground ,magenta)))
+ `(org-column ((,class :background ,bg-alt)))
+ `(org-column-title ((,class :inherit bold :underline t :background ,bg-alt)))
+ `(org-date ((,class :inherit fixed-pitch :foreground ,cyan-alt-other :underline t)))
+ `(org-date-selected ((,class :inherit bold :foreground ,blue-alt :inverse-video t)))
+ `(org-default ((,class :background ,bg-main :foreground ,fg-main)))
+ `(org-document-info ((,class :foreground ,fg-special-cold)))
+ `(org-document-info-keyword ((,class :inherit fixed-pitch :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 ,@(modus-operandi-theme-org-todo-block green-nuanced-bg green-nuanced green))))
+ `(org-drawer ((,class :foreground ,cyan-alt)))
+ `(org-ellipsis ((,class :foreground nil))) ; inherits from the heading's colour
+ `(org-footnote ((,class :foreground ,blue-alt :underline t)))
+ `(org-formula ((,class :inherit fixed-pitch :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 :foreground ,green-nuanced
+ ,@(modus-operandi-theme-heading-block
+ green-nuanced-bg green-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 (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground fg-main magenta-alt-other)
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4)
+ ,@(modus-operandi-theme-heading-block magenta-nuanced-bg magenta-nuanced))))
+ `(org-level-2 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground fg-special-warm magenta-alt)
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-3)
+ ,@(modus-operandi-theme-heading-block red-nuanced-bg red-nuanced))))
+ `(org-level-3 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground fg-special-cold blue)
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-2)
+ ,@(modus-operandi-theme-heading-block blue-nuanced-bg blue-nuanced))))
+ `(org-level-4 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground fg-special-mild cyan)
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-1)
+ ,@(modus-operandi-theme-heading-block cyan-nuanced-bg cyan-nuanced))))
+ `(org-level-5 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground fg-special-calm green-alt-other)
+ ,@(modus-operandi-theme-heading-block green-nuanced-bg green-nuanced))))
+ `(org-level-6 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground yellow-nuanced yellow-alt-other)
+ ,@(modus-operandi-theme-heading-block yellow-nuanced-bg yellow-nuanced))))
+ `(org-level-7 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground red-nuanced red-alt)
+ ,@(modus-operandi-theme-heading-block red-nuanced-bg red-nuanced))))
+ `(org-level-8 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground fg-dim magenta)
+ ,@(modus-operandi-theme-heading-block bg-alt fg-alt))))
+ `(org-link ((,class :inherit link)))
+ `(org-list-dt ((,class :inherit bold)))
+ `(org-macro ((,class :inherit org-latex-and-related)))
+ `(org-meta-line ((,class :inherit fixed-pitch :background ,cyan-nuanced-bg :foreground ,cyan-nuanced)))
+ `(org-mode-line-clock ((,class :foreground ,fg-main)))
+ `(org-mode-line-clock-overrun ((,class :inherit modus-theme-active-red)))
+ `(org-priority ((,class ,@(modus-operandi-theme-org-todo-block magenta-nuanced-bg magenta-nuanced magenta)
+ ,@(modus-operandi-theme-heading-foreground magenta magenta-alt-other))))
+ `(org-quote ((,class ,@(if modus-operandi-theme-org-blocks
+ (append
+ (and (>= emacs-major-version 27) '(:extend t))
+ (list :background bg-dim))
+ (list :background nil))
+ :foreground ,fg-special-calm :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-org-todo-block cyan-nuanced-bg cyan-nuanced cyan-alt))))
+ `(org-table ((,class :inherit fixed-pitch :foreground ,fg-special-cold)))
+ `(org-tag ((,class ,@(modus-operandi-theme-bold-weight) :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 ,@(modus-operandi-theme-org-todo-block red-nuanced-bg red-nuanced red-alt)
+ ,@(modus-operandi-theme-heading-foreground red-alt red))))
+ `(org-upcoming-deadline ((,class :foreground ,red-alt-other)))
+ `(org-upcoming-distant-deadline ((,class :foreground ,red-nuanced)))
+ `(org-verbatim ((,class :inherit 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 :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 :foreground ,blue-alt-other :underline t)))
+ `(org-roam-backlink ((,class :foreground ,green-alt-other :underline t)))
+;;;;; 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 (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground fg-main magenta-alt-other)
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4)
+ ,@(modus-operandi-theme-heading-block magenta-nuanced-bg magenta-nuanced))))
+ `(outline-2 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground fg-special-warm magenta-alt)
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-3)
+ ,@(modus-operandi-theme-heading-block red-nuanced-bg red-nuanced))))
+ `(outline-3 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground fg-special-cold blue)
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-2)
+ ,@(modus-operandi-theme-heading-block blue-nuanced-bg blue-nuanced))))
+ `(outline-4 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground fg-special-mild cyan)
+ ,@(modus-operandi-theme-scale modus-operandi-theme-scale-1)
+ ,@(modus-operandi-theme-heading-block cyan-nuanced-bg cyan-nuanced))))
+ `(outline-5 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground fg-special-calm green-alt-other)
+ ,@(modus-operandi-theme-heading-block green-nuanced-bg green-nuanced))))
+ `(outline-6 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground yellow-nuanced yellow-alt-other)
+ ,@(modus-operandi-theme-heading-block yellow-nuanced-bg yellow-nuanced))))
+ `(outline-7 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground red-nuanced red-alt)
+ ,@(modus-operandi-theme-heading-block red-nuanced-bg red-nuanced))))
+ `(outline-8 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-operandi-theme-heading-foreground fg-dim magenta)
+ ,@(modus-operandi-theme-heading-block bg-alt fg-alt))))
+;;;;; outline-minor-faces
+ `(outline-minor-0 ((,class ,@(unless modus-operandi-theme-section-headings
+ (list :background cyan-nuanced-bg)))))
+;;;;; 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)))
+;;;;; 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 ,@(modus-operandi-theme-extra-completions
+ 'modus-theme-refine-magenta
+ 'modus-theme-intense-magenta
+ 'modus-theme-nuanced-magenta
+ magenta
+ 'bold))))
+ `(selectrum-primary-highlight ((,class ,@(modus-operandi-theme-extra-completions
+ 'modus-theme-refine-blue
+ 'modus-theme-intense-blue
+ 'modus-theme-nuanced-blue
+ blue
+ 'bold))))
+ `(selectrum-secondary-highlight ((,class ,@(modus-operandi-theme-extra-completions
+ 'modus-theme-refine-cyan
+ 'modus-theme-intense-cyan
+ 'modus-theme-nuanced-cyan
+ cyan
+ 'bold))))
+;;;;; 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 ,@(modus-operandi-theme-diffs
+ bg-main yellow
+ bg-diff-focus-changed fg-diff-focus-changed))))
+ `(smerge-lower ((,class ,@(modus-operandi-theme-diffs
+ bg-main green
+ bg-diff-focus-added fg-diff-focus-added))))
+ `(smerge-markers ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-2)))
+ `(smerge-refined-added ((,class ,@(modus-operandi-theme-diffs
+ bg-diff-added fg-diff-added
+ bg-diff-refine-added fg-diff-refine-added))))
+ `(smerge-refined-changed ((,class)))
+ `(smerge-refined-removed ((,class ,@(modus-operandi-theme-diffs
+ bg-diff-removed fg-diff-removed
+ bg-diff-refine-removed fg-diff-refine-removed))))
+ `(smerge-upper ((,class ,@(modus-operandi-theme-diffs
+ bg-main red
+ bg-diff-focus-removed fg-diff-focus-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 :foreground ,cyan-alt :underline t)))
+;;;;; 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)))
+;;;;; 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-conflict-state ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,red-active)))
+ `(vc-edited-state ((,class :foreground ,fg-special-warm)))
+ `(vc-locally-added-state ((,class :foreground ,cyan-active)))
+ `(vc-locked-state ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta-active)))
+ `(vc-missing-state ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,yellow-active)))
+ `(vc-needs-update-state ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,fg-special-mild)))
+ `(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 ,@(modus-operandi-theme-diffs
+ bg-main green
+ bg-diff-focus-added fg-diff-focus-added))))
+ `(vdiff-change-face ((,class ,@(modus-operandi-theme-diffs
+ bg-main yellow
+ bg-diff-focus-changed fg-diff-focus-changed))))
+ `(vdiff-closed-fold-face ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1)))
+ `(vdiff-refine-added ((,class ,@(modus-operandi-theme-diffs
+ bg-diff-added fg-diff-added
+ bg-diff-refine-added fg-diff-refine-added))))
+ `(vdiff-refine-changed ((,class ,@(modus-operandi-theme-diffs
+ bg-diff-changed fg-diff-changed
+ bg-diff-refine-changed fg-diff-refine-changed))))
+ `(vdiff-subtraction-face ((,class ,@(modus-operandi-theme-diffs
+ bg-main red
+ bg-diff-focus-removed fg-diff-focus-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 "black" :foreground "black")))
+ `(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 "white" :foreground "white")))
+ `(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+
+ ;; EXPERIMENTAL this form is subject to review
+ (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 (:background ,yellow-nuanced-bg :foreground ,yellow-nuanced))))
+ `(line-number-minor-tick ((,class (:background ,cyan-nuanced-bg :foreground ,cyan-nuanced))))
+;;;;; 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)))))
+;;; 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])
+;;;; 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-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))))))
+
+;;; library provides
+;;;###autoload
+(when load-file-name
+ (add-to-list 'custom-theme-load-path
+ (file-name-as-directory (file-name-directory load-file-name))))
+
+(provide-theme 'modus-operandi)
+
+(provide 'modus-operandi-theme)
+
+;;; modus-operandi-theme.el ends here
diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el
new file mode 100644
index 00000000000..fa1b6be8b8e
--- /dev/null
+++ b/etc/themes/modus-vivendi-theme.el
@@ -0,0 +1,4266 @@
+;;; modus-vivendi-theme.el --- Accessible dark theme (WCAG AAA) -*- lexical-binding:t -*-
+
+;; Copyright (c) 2019-2020 Free Software Foundation, Inc.
+
+;; Author: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://gitlab.com/protesilaos/modus-themes
+;; Version: 0.12.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
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This theme is designed for colour-contrast accessibility.
+;;
+;; 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.
+;;
+;; The theme provides the following customisation options, all of which
+;; are disabled by default:
+;;
+;; modus-vivendi-theme-slanted-constructs (boolean)
+;; modus-vivendi-theme-bold-constructs (boolean)
+;; modus-vivendi-theme-variable-pitch-headings (boolean)
+;; modus-vivendi-theme-rainbow-headings (boolean)
+;; modus-vivendi-theme-section-headings (boolean)
+;; 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-3d-modeline (boolean)
+;; modus-vivendi-theme-subtle-diffs (boolean)
+;; modus-vivendi-theme-faint-syntax (boolean)
+;; modus-vivendi-theme-intense-hl-line (boolean)
+;; modus-vivendi-theme-intense-paren-match (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
+;; 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
+;; csv-mode
+;; ctrlf
+;; custom (M-x customize)
+;; dap-mode
+;; dashboard (emacs-dashboard)
+;; deadgrep
+;; debbugs
+;; define-word
+;; deft
+;; dictionary
+;; diff-hl
+;; diff-mode
+;; dim-autoload
+;; 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-box
+;; elfeed
+;; elfeed-score
+;; emms
+;; enhanced-ruby-mode
+;; epa
+;; equake
+;; erc
+;; eros
+;; ert
+;; eshell
+;; eshell-fringe-status
+;; eshell-git-prompt
+;; eshell-prompt-extras (epe)
+;; evil (evil-mode)
+;; evil-goggles
+;; evil-visual-mark-mode
+;; eww
+;; eyebrowse
+;; fancy-dabbrev
+;; flycheck
+;; 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
+;; mu4e
+;; mu4e-conversation
+;; multiple-cursors
+;; neotree
+;; no-emoji
+;; notmuch
+;; num3-mode
+;; nxml-mode
+;; 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
+;; 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
+;; 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
+
+;;; 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-header nil nil) ; Name is tentative
+(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-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-rainbow-headings nil
+ "Use more saturated colours for headings."
+ :type 'boolean)
+
+(defcustom modus-vivendi-theme-section-headings nil
+ "Use a background and an overline in headings."
+ :type 'boolean)
+
+(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)
+
+(define-obsolete-variable-alias '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)))
+
+(define-obsolete-variable-alias '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)
+
+(define-obsolete-variable-alias '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)))
+
+(defcustom modus-vivendi-theme-3d-modeline nil
+ "Use a three-dimensional style for the active mode line."
+ :type 'boolean)
+
+(defcustom modus-vivendi-theme-subtle-diffs nil
+ "Use fewer/dim backgrounds in `diff-mode', `ediff',`magit'."
+ :type 'boolean)
+
+(define-obsolete-variable-alias '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 `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)
+
+;;; 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-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-foreground (subtle rainbow)
+ "Apply foreground value to headings.
+SUBTLE is the default aesthetic. RAINBOW is the saturated one."
+ (if modus-vivendi-theme-rainbow-headings
+ (list :foreground rainbow)
+ (list :foreground subtle)))
+
+(defun modus-vivendi-theme-heading-block (bg fg)
+ "Conditionally extend heading styles.
+Apply BG to background and FG to overline."
+ (if modus-vivendi-theme-section-headings
+ (append
+ (and (>= emacs-major-version 27) '(:extend t))
+ (list :background bg :overline fg))
+ (list :background nil :overline nil)))
+
+(defun modus-vivendi-theme-org-todo-block (bgbox fgbox fg)
+ "Conditionally extend the styles of Org keywords.
+BGBOX applies to the background. FGBOX applies to the foreground
+and the border. FG is used when no block style is in effect."
+ (if modus-vivendi-theme-section-headings
+ (list :background bgbox :foreground fgbox :box (list :color fgbox))
+ (list :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-modeline-box (col3d col &optional btn int)
+ "Control the box properties of the mode line.
+COL3D is the border that is intended for the three-dimensional
+modeline. COL applies to the two-dimensional modeline. Optional
+BTN provides the 3d button style. Optional INT defines a border
+width."
+ (let* ((style (if btn 'released-button nil))
+ (int (if int int 1)))
+ (if modus-vivendi-theme-3d-modeline
+ (list :line-width int :color col3d :style style)
+ (list :line-width 1 :color col :style nil))))
+
+(defun modus-vivendi-theme-modeline-props (bg3d fg3d &optional bg fg)
+ "Control the background and foreground of the mode line.
+BG is the modeline's background. FG is the modeline's
+foreground. BG3D and FG3D apply to the three-dimensional
+modeline style."
+ (if modus-vivendi-theme-3d-modeline
+ (list :background bg3d :foreground fg3d)
+ (list :background bg :foreground fg)))
+
+(defun modus-vivendi-theme-diffs (subtle-bg subtle-fg intense-bg intense-fg)
+ "Colour combinations for `modus-vivendi-theme-subtle-diffs'.
+
+SUBTLE-BG should be similar or the same as the main background.
+SUBTLE-FG should be an appropriate accent value. INTENSE-BG
+should be one of the dedicated backgrounds for diffs. INTENSE-FG
+should be one of the dedicated foregrounds for diffs"
+ (if modus-vivendi-theme-subtle-diffs
+ (list :background subtle-bg :foreground subtle-fg)
+ (list :background intense-bg :foreground intense-fg)))
+
+(defun modus-vivendi-theme-standard-completions (mainfg subtlebg intensebg intensefg)
+ "Combinations for `modus-vivendi-theme-completions'.
+These are intended for Icomplete, Ido, and related.
+
+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."
+ (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'.
+These are intended for Helm, Ivy, Selectrum, etc.
+
+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."
+ (pcase modus-vivendi-theme-completions
+ ('opinionated (list :inherit (list altface bold)
+ :foreground (if altfg 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" . "#2f2f2f") ("fg-active" . "#f5f5f5")
+ ("bg-inactive" . "#202020") ("fg-inactive" . "#bebebe")
+ ;; 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" . "#29aeff")
+ ("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" . "#72a4ff")
+ ("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" . "#00bdfa")
+ ("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" . "#ffa49e") ("green-active" . "#70e030")
+ ("yellow-active" . "#efdf00") ("blue-active" . "#00ccff")
+ ("magenta-active" . "#d0acff") ("cyan-active" . "#00ddc0")
+ ;; styles that are meant exclusively for the fringes
+ ;;
+ ;; must have a minimum contrast ratio of 1.5:1 with `bg-inactive'
+ ;; and be combined with `fg-main' or `fg-dim'
+ ("red-fringe-bg" . "#8f0040") ("green-fringe-bg" . "#006000")
+ ("yellow-fringe-bg" . "#6f4a00") ("blue-fringe-bg" . "#3a30ab")
+ ("magenta-fringe-bg" . "#692089") ("cyan-fringe-bg" . "#0068a0")
+ ;; 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-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-paren-match" . "#5f362f")
+ ("bg-paren-match-intense" . "#255650")
+ ("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")
+
+ ("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-dim)))
+ `(modus-theme-fringe-green ((,class :background ,green-fringe-bg :foreground ,fg-dim)))
+ `(modus-theme-fringe-yellow ((,class :background ,yellow-fringe-bg :foreground ,fg-dim)))
+ `(modus-theme-fringe-blue ((,class :background ,blue-fringe-bg :foreground ,fg-dim)))
+ `(modus-theme-fringe-magenta ((,class :background ,magenta-fringe-bg :foreground ,fg-dim)))
+ `(modus-theme-fringe-cyan ((,class :background ,cyan-fringe-bg :foreground ,fg-dim)))
+;;;;; 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 :background ,bg-diff-added :foreground ,fg-diff-added)))
+ `(modus-theme-diff-changed ((,class :background ,bg-diff-changed :foreground ,fg-diff-changed)))
+ `(modus-theme-diff-removed ((,class :background ,bg-diff-removed :foreground ,fg-diff-removed)))
+ `(modus-theme-diff-refine-added ((,class :background ,bg-diff-refine-added :foreground ,fg-diff-refine-added)))
+ `(modus-theme-diff-refine-changed ((,class :background ,bg-diff-refine-changed :foreground ,fg-diff-refine-changed)))
+ `(modus-theme-diff-refine-removed ((,class :background ,bg-diff-refine-removed :foreground ,fg-diff-refine-removed)))
+ `(modus-theme-diff-focus-added ((,class :background ,bg-diff-focus-added :foreground ,fg-diff-focus-added)))
+ `(modus-theme-diff-focus-changed ((,class :background ,bg-diff-focus-changed :foreground ,fg-diff-focus-changed)))
+ `(modus-theme-diff-focus-removed ((,class :background ,bg-diff-focus-removed :foreground ,fg-diff-focus-removed)))
+ `(modus-theme-diff-heading ((,class :background ,bg-diff-heading :foreground ,fg-diff-heading)))
+;;;;; mark indicators
+ ;; colour combinations intended for Dired, Ibuffer, or equivalent
+ `(modus-theme-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)))
+;;;;; other custom faces
+ `(modus-theme-hl-line ((,class :background ,(if modus-vivendi-theme-intense-hl-line
+ bg-active 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)))
+ `(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 :underline t)))
+ `(link ((,class :foreground ,blue-alt-other :underline t)))
+ `(link-visited ((,class :foreground ,magenta-alt-other :underline t)))
+ `(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 :foreground ,magenta-alt-other :underline t)))
+ `(apropos-keybinding ((,class :inherit bold :foreground ,cyan)))
+ `(apropos-misc-button ((,class :foreground ,cyan-alt-other :underline t)))
+ `(apropos-property ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta-alt)))
+ `(apropos-symbol ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,blue-nuanced :underline t)))
+ `(apropos-user-option-button ((,class :foreground ,green-alt-other :underline t)))
+ `(apropos-variable-button ((,class :foreground ,blue :underline t)))
+;;;;; 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)))
+;;;;; 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 :background ,bg-alt :foreground ,fg-alt)))
+ `(cfw:face-day-title ((,class :background ,bg-alt :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 :background ,bg-inactive :foreground ,fg-inactive)))
+ `(cfw:face-grid ((,class :foreground ,fg-inactive)))
+ `(cfw:face-header ((,class :inherit bold ::foreground ,fg-main)))
+ `(cfw:face-holiday ((,class :inherit bold :background ,bg-alt :foreground ,magenta)))
+ `(cfw:face-periods ((,class :foreground ,cyan-alt-other)))
+ `(cfw:face-saturday ((,class :inherit bold :background ,bg-alt :foreground ,magenta-alt)))
+ `(cfw:face-select ((,class :inherit modus-theme-intense-blue)))
+ `(cfw:face-sunday ((,class :inherit bold :background ,bg-alt :foreground ,magenta-alt-other)))
+ `(cfw:face-title ((,class :inherit ,modus-theme-variable-pitch
+ :foreground ,fg-special-warm
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4))))
+ `(cfw:face-today ((,class :inherit bold :foreground ,blue)))
+ `(cfw:face-today-title ((,class :inherit modus-theme-special-mild :box t)))
+ `(cfw:face-toolbar ((,class :background ,bg-active :foreground ,bg-active)))
+ `(cfw:face-toolbar-button-off ((,class :background ,bg-alt :foreground ,cyan)))
+ `(cfw:face-toolbar-button-on ((,class :inherit bold :background ,bg-main :foreground ,blue-intense)))
+;;;;; 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 :inherit bold :foreground ,green-alt-other)))
+ `(log-edit-summary ((,class :foreground ,magenta-alt-other)))
+ `(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 :foreground ,blue :underline t)))
+ `(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
+ cyan-alt-other cyan-nuanced-bg
+ yellow-refine-bg yellow-refine-fg))))
+ `(completions-first-difference ((,class :inherit bold
+ ,@(modus-vivendi-theme-standard-completions
+ blue-alt-other blue-nuanced-bg
+ cyan-subtle-bg fg-dim))))
+;;;;; 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)))
+;;;;; 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 :foreground ,blue-alt-other :underline t)))
+ `(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 ,@(modus-vivendi-theme-diffs
+ bg-main green
+ bg-diff-focus-added fg-diff-focus-added))))
+ `(diff-changed ((,class ,@(modus-vivendi-theme-diffs
+ bg-main yellow
+ bg-diff-focus-changed fg-diff-focus-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 ,@(modus-vivendi-theme-diffs
+ bg-alt blue-alt
+ bg-diff-heading fg-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 ,@(modus-vivendi-theme-diffs
+ bg-diff-added fg-diff-added
+ bg-diff-refine-added fg-diff-refine-added))))
+ `(diff-refine-changed ((,class ,@(modus-vivendi-theme-diffs
+ bg-diff-changed fg-diff-changed
+ bg-diff-refine-changed fg-diff-refine-changed))))
+ `(diff-refine-removed ((,class ,@(modus-vivendi-theme-diffs
+ bg-diff-removed fg-diff-removed
+ bg-diff-refine-removed fg-diff-refine-removed))))
+ `(diff-removed ((,class ,@(modus-vivendi-theme-diffs
+ bg-main red
+ bg-diff-focus-removed fg-diff-focus-removed))))
+;;;;; dim-autoload
+ `(dim-autoload-cookie-line ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
+;;;;; dired
+ `(dired-directory ((,class :foreground ,blue)))
+ `(dired-flagged ((,class :inherit modus-theme-mark-del)))
+ `(dired-header ((,class :inherit modus-theme-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 :foreground ,cyan-alt :underline t)))
+ `(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 ,green-alt-other)))
+ `(diredfl-compressed-file-suffix ((,class :foreground ,green-alt)))
+ `(diredfl-date-time ((,class :foreground ,fg-special-cold)))
+ `(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-header)))
+ `(diredfl-dir-name ((,class :inherit dired-directory)))
+ `(diredfl-dir-priv ((,class :foreground ,blue)))
+ `(diredfl-exec-priv ((,class :foreground ,red-alt-other)))
+ `(diredfl-executable-tag ((,class :foreground ,red-alt)))
+ `(diredfl-file-name ((,class :foreground ,fg-main)))
+ `(diredfl-file-suffix ((,class :foreground ,fg-special-warm)))
+ `(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-inactive)))
+ `(diredfl-link-priv ((,class :foreground ,blue-alt-other)))
+ `(diredfl-no-priv ((,class :foreground ,fg-inactive)))
+ `(diredfl-number ((,class :foreground ,cyan)))
+ `(diredfl-other-priv ((,class :foreground ,yellow)))
+ `(diredfl-rare-priv ((,class :foreground ,magenta-alt-other)))
+ `(diredfl-read-priv ((,class :foreground ,magenta)))
+ `(diredfl-symlink ((,class :foreground ,cyan-alt :underline t)))
+ `(diredfl-tagged-autofile-name ((,class :inherit modus-theme-refine-magenta)))
+ `(diredfl-write-priv ((,class :foreground ,cyan-alt-other)))
+;;;;; 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 :foreground ,blue :underline t)))
+ `(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 modus-theme-active-red)))
+ `(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
+ `(ediff-current-diff-A ((,class ,@(modus-vivendi-theme-diffs
+ bg-alt red
+ bg-diff-removed fg-diff-removed))))
+ `(ediff-current-diff-Ancestor ((,class ,@(modus-vivendi-theme-diffs
+ bg-alt fg-special-cold
+ bg-special-cold fg-special-cold))))
+ `(ediff-current-diff-B ((,class ,@(modus-vivendi-theme-diffs
+ bg-alt green
+ bg-diff-added fg-diff-added))))
+ `(ediff-current-diff-C ((,class ,@(modus-vivendi-theme-diffs
+ bg-alt yellow
+ bg-diff-changed fg-diff-changed))))
+ `(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-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 ,cyan)))
+ `(elfeed-search-feed-face ((,class :foreground ,blue)))
+ `(elfeed-search-filter-face ((,class :foreground ,magenta-active)))
+ `(elfeed-search-last-update-face ((,class :foreground ,green-active)))
+ `(elfeed-search-tag-face ((,class :foreground ,cyan-alt-other)))
+ `(elfeed-search-title-face ((,class :foreground ,fg-main)))
+ `(elfeed-search-unread-count-face ((,class :foreground ,blue-active)))
+ `(elfeed-search-unread-title-face ((,class :inherit bold)))
+;;;;; 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)))
+;;;;; 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 :foreground ,cyan :underline t)))
+ `(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)))
+;;;;; 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-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-other
+ '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-alt :slant ,modus-theme-slant)))
+ `(git-commit-keyword ((,class :foreground ,magenta)))
+ `(git-commit-known-pseudo-header ((,class :inherit bold :foreground ,fg-special-warm)))
+ `(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 :inherit bold :foreground ,fg-alt)))
+ `(git-commit-summary ((,class :foreground ,magenta-alt-other)))
+;;;;; 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 :foreground ,cyan :underline t)))
+ `(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 ,fg-special-calm)))
+ `(gnus-header-from ((,class :inherit bold :foreground ,cyan-alt :underline nil)))
+ `(gnus-header-name ((,class :foreground ,cyan-alt-other)))
+ `(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-special-cold :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-special-cold)))
+ `(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 helm-ff-dotted-directory :underline t)))
+ `(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 :foreground ,red :underline t)))
+ `(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 :foreground ,cyan :underline t)))
+ `(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 :foreground ,cyan-alt-other :underline t)))
+ `(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 (bold ,modus-theme-variable-pitch) :foreground ,fg-main
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4))))
+;;;;; 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 magenta-nuanced-bg
+ magenta-intense-bg 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 magenta-nuanced-bg
+ magenta-subtle-bg 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
+ magenta-intense red-nuanced-bg
+ magenta-intense-bg fg-main))))
+ `(ido-subdir ((,class :foreground ,blue-alt-other)))
+ `(ido-virtual ((,class :foreground ,yellow-alt-other)))
+;;;;; 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 :foreground ,fg-alt :underline t)))
+ `(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 :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 (bold ,modus-theme-variable-pitch) :foreground ,fg-main
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-2))))
+ `(info-menu-star ((,class :foreground ,fg-main)))
+ `(info-node ((,class :inherit bold)))
+ `(info-title-1 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-main
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4))))
+ `(info-title-2 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-warm
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-3))))
+ `(info-title-3 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-cold
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-2))))
+ `(info-title-4 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-mild
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-1))))
+;;;;; 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 :box ,(modus-vivendi-theme-modeline-box blue-alt blue-active t -3)
+ ,@(modus-vivendi-theme-modeline-props
+ blue-active bg-main
+ blue-active bg-active))))
+;;;;; line numbers (display-line-numbers-mode and global variant)
+ `(line-number ((,class :background ,bg-dim :foreground ,fg-alt)))
+ `(line-number-current-line ((,class :inherit bold :background ,bg-active :foreground ,fg-active)))
+;;;;; 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 :foreground ,blue-alt-other :underline t)))
+ `(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)))
+ `(magit-diff-added ((,class ,@(modus-vivendi-theme-diffs
+ bg-main green
+ bg-diff-added fg-diff-added))))
+ `(magit-diff-added-highlight ((,class ,@(modus-vivendi-theme-diffs
+ bg-dim green
+ bg-diff-focus-added fg-diff-focus-added))))
+ `(magit-diff-base ((,class ,@(modus-vivendi-theme-diffs
+ bg-main yellow
+ bg-diff-changed fg-diff-changed))))
+ `(magit-diff-base-highlight ((,class ,@(modus-vivendi-theme-diffs
+ bg-dim yellow
+ bg-diff-focus-changed fg-diff-focus-changed))))
+ `(magit-diff-context ((,class :foreground ,fg-unfocused)))
+ `(magit-diff-context-highlight ((,class ,@(modus-vivendi-theme-diffs
+ bg-dim fg-dim
+ bg-inactive fg-inactive))))
+ `(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 :background ,bg-alt :foreground ,cyan)))
+ `(magit-diff-hunk-heading ((,class :inherit bold :background ,bg-active :foreground ,fg-inactive)))
+ `(magit-diff-hunk-heading-highlight ((,class :inherit (modus-theme-diff-heading bold))))
+ `(magit-diff-hunk-heading-selection ((,class :inherit modus-theme-intense-cyan)))
+ `(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-diffs
+ bg-main red
+ bg-diff-removed fg-diff-removed))))
+ `(magit-diff-removed-highlight ((,class ,@(modus-vivendi-theme-diffs
+ bg-dim red
+ bg-diff-focus-removed fg-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-warm :slant ,modus-theme-slant)))
+ `(markdown-bold-face ((,class :inherit bold)))
+ `(markdown-code-face ((,class :inherit fixed-pitch)))
+ `(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 ((,class :inherit bold)))
+ `(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 fixed-pitch :foreground ,cyan)))
+ `(markdown-html-attr-value-face ((,class :inherit fixed-pitch :foreground ,blue)))
+ `(markdown-html-entity-face ((,class :inherit fixed-pitch :foreground ,cyan)))
+ `(markdown-html-tag-delimiter-face ((,class :inherit fixed-pitch :foreground ,fg-special-mild)))
+ `(markdown-html-tag-name-face ((,class :inherit fixed-pitch :foreground ,magenta-alt)))
+ `(markdown-inline-code-face ((,class :inherit fixed-pitch :foreground ,magenta)))
+ `(markdown-italic-face ((,class :foreground ,fg-special-cold :slant italic)))
+ `(markdown-language-info-face ((,class :inherit fixed-pitch :foreground ,fg-special-cold)))
+ `(markdown-language-keyword-face ((,class :inherit fixed-pitch :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))
+ :inherit fixed-pitch :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 :inherit fixed-pitch :foreground ,fg-special-cold)))
+ `(markdown-url-face ((,class :foreground ,blue)))
+;;;;; 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 :foreground ,fg-inactive :underline t)))
+ `(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 :foreground ,blue-alt)))
+ `(message-header-name ((,class :foreground ,green-alt-other)))
+ `(message-header-newsgroups ((,class :inherit bold :foreground ,blue)))
+ `(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 ,magenta-alt)))
+ `(message-header-xheader ((,class :foreground ,blue-alt-other)))
+ `(message-mml ((,class :foreground ,green-alt)))
+ `(message-separator ((,class :background ,bg-active :foreground ,fg-special-warm)))
+;;;;; 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 :box ,(modus-vivendi-theme-modeline-box bg-active fg-alt t)
+ ,@(modus-vivendi-theme-modeline-props
+ bg-active fg-dim
+ bg-active fg-active))))
+ `(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 :box ,(modus-vivendi-theme-modeline-box bg-active bg-region)
+ ,@(modus-vivendi-theme-modeline-props
+ bg-dim fg-inactive
+ bg-inactive fg-inactive))))
+;;;;; 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)))
+;;;;; 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 :background ,bg-active :foreground ,fg-special-warm)))
+ `(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 ,cyan-active)))
+ `(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))))
+;;;;; orderless
+ `(orderless-match-face-0 ((,class :inherit bold
+ ,@(modus-vivendi-theme-standard-completions
+ blue-alt 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-alt-other green-nuanced-bg
+ green-refine-bg green-refine-fg))))
+ `(orderless-match-face-3 ((,class :inherit bold
+ ,@(modus-vivendi-theme-standard-completions
+ yellow-alt-other 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)))
+ `(org-agenda-column-dateline ((,class :background ,bg-alt)))
+ `(org-agenda-current-time ((,class :inherit modus-theme-subtle-cyan)))
+ `(org-agenda-date ((,class :inherit ,modus-theme-variable-pitch :foreground ,cyan-alt-other
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4)
+ ,@(modus-vivendi-theme-heading-block cyan-nuanced-bg cyan-nuanced))))
+ `(org-agenda-date-today ((,class :inherit (bold ,modus-theme-variable-pitch)
+ :background ,cyan-intense-bg :foreground ,fg-main
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4))))
+ `(org-agenda-date-weekend ((,class :inherit ,modus-theme-variable-pitch :foreground ,cyan
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4)
+ ,@(modus-vivendi-theme-heading-block blue-nuanced-bg cyan-nuanced))))
+ `(org-agenda-diary ((,class :foreground ,fg-main)))
+ `(org-agenda-dimmed-todo-face ((,class :inherit modus-theme-subtle-neutral)))
+ `(org-agenda-done ((,class ,@(modus-vivendi-theme-org-todo-block green-nuanced-bg green-nuanced green))))
+ `(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 :inherit ,modus-theme-variable-pitch
+ :foreground ,fg-special-mild
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-3))))
+ `(org-archived ((,class :background ,bg-alt :foreground ,fg-alt)))
+ `(org-block ((,class ,@(modus-vivendi-theme-org-block bg-dim)
+ :inherit fixed-pitch :foreground ,fg-main)))
+ `(org-block-begin-line ((,class ,@(modus-vivendi-theme-org-block-delim
+ bg-dim fg-special-cold
+ bg-alt fg-special-mild)
+ :inherit fixed-pitch)))
+ `(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 :foreground ,green
+ ,@(modus-vivendi-theme-heading-block
+ green-nuanced-bg green-nuanced))))
+ `(org-checkbox-statistics-todo ((,class ,@(modus-vivendi-theme-heading-foreground red-alt red)
+ ,@(modus-vivendi-theme-heading-block
+ red-nuanced-bg red-nuanced))))
+ `(org-clock-overlay ((,class :inherit modus-theme-special-cold)))
+ `(org-code ((,class :inherit fixed-pitch :foreground ,magenta)))
+ `(org-column ((,class :background ,bg-alt)))
+ `(org-column-title ((,class :inherit bold :underline t :background ,bg-alt)))
+ `(org-date ((,class :inherit fixed-pitch :foreground ,cyan-alt-other :underline t)))
+ `(org-date-selected ((,class :inherit bold :foreground ,blue-alt :inverse-video t)))
+ `(org-default ((,class :background ,bg-main :foreground ,fg-main)))
+ `(org-document-info ((,class :foreground ,fg-special-cold)))
+ `(org-document-info-keyword ((,class :inherit fixed-pitch :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 ,@(modus-vivendi-theme-org-todo-block green-nuanced-bg green-nuanced green))))
+ `(org-drawer ((,class :foreground ,cyan-alt)))
+ `(org-ellipsis ((,class :foreground nil))) ; inherits from the heading's colour
+ `(org-footnote ((,class :foreground ,blue-alt :underline t)))
+ `(org-formula ((,class :inherit fixed-pitch :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 :foreground ,green-nuanced
+ ,@(modus-vivendi-theme-heading-block
+ green-nuanced-bg green-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 (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground fg-main magenta-alt-other)
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4)
+ ,@(modus-vivendi-theme-heading-block magenta-nuanced-bg magenta-nuanced))))
+ `(org-level-2 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground fg-special-warm magenta-alt)
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-3)
+ ,@(modus-vivendi-theme-heading-block red-nuanced-bg red-nuanced))))
+ `(org-level-3 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground fg-special-cold blue)
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-2)
+ ,@(modus-vivendi-theme-heading-block blue-nuanced-bg blue-nuanced))))
+ `(org-level-4 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground fg-special-mild cyan)
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-1)
+ ,@(modus-vivendi-theme-heading-block cyan-nuanced-bg cyan-nuanced))))
+ `(org-level-5 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground fg-special-calm green-alt-other)
+ ,@(modus-vivendi-theme-heading-block green-nuanced-bg green-nuanced))))
+ `(org-level-6 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground yellow-nuanced yellow-alt-other)
+ ,@(modus-vivendi-theme-heading-block yellow-nuanced-bg yellow-nuanced))))
+ `(org-level-7 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground red-nuanced red-alt)
+ ,@(modus-vivendi-theme-heading-block red-nuanced-bg red-nuanced))))
+ `(org-level-8 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground fg-dim magenta)
+ ,@(modus-vivendi-theme-heading-block bg-alt fg-alt))))
+ `(org-link ((,class :inherit link)))
+ `(org-list-dt ((,class :inherit bold)))
+ `(org-macro ((,class :inherit org-latex-and-related)))
+ `(org-meta-line ((,class :inherit fixed-pitch :background ,cyan-nuanced-bg :foreground ,cyan-nuanced)))
+ `(org-mode-line-clock ((,class :foreground ,fg-main)))
+ `(org-mode-line-clock-overrun ((,class :inherit modus-theme-active-red)))
+ `(org-priority ((,class ,@(modus-vivendi-theme-org-todo-block magenta-nuanced-bg magenta-nuanced magenta)
+ ,@(modus-vivendi-theme-heading-foreground magenta magenta-alt-other))))
+ `(org-quote ((,class ,@(if modus-vivendi-theme-org-blocks
+ (append
+ (and (>= emacs-major-version 27) '(:extend t))
+ (list :background bg-dim))
+ (list :background nil))
+ :foreground ,fg-special-calm :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-org-todo-block cyan-nuanced-bg cyan-nuanced cyan-alt))))
+ `(org-table ((,class :inherit fixed-pitch :foreground ,fg-special-cold)))
+ `(org-tag ((,class ,@(modus-vivendi-theme-bold-weight) :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 ,@(modus-vivendi-theme-org-todo-block red-nuanced-bg red-nuanced red-alt)
+ ,@(modus-vivendi-theme-heading-foreground red-alt red))))
+ `(org-upcoming-deadline ((,class :foreground ,red-alt-other)))
+ `(org-upcoming-distant-deadline ((,class :foreground ,red-nuanced)))
+ `(org-verbatim ((,class :inherit 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 :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 :foreground ,blue-alt-other :underline t)))
+ `(org-roam-backlink ((,class :foreground ,green-alt-other :underline t)))
+;;;;; 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 (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground fg-main magenta-alt-other)
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4)
+ ,@(modus-vivendi-theme-heading-block magenta-nuanced-bg magenta-nuanced))))
+ `(outline-2 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground fg-special-warm magenta-alt)
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-3)
+ ,@(modus-vivendi-theme-heading-block red-nuanced-bg red-nuanced))))
+ `(outline-3 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground fg-special-cold blue)
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-2)
+ ,@(modus-vivendi-theme-heading-block blue-nuanced-bg blue-nuanced))))
+ `(outline-4 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground fg-special-mild cyan)
+ ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-1)
+ ,@(modus-vivendi-theme-heading-block cyan-nuanced-bg cyan-nuanced))))
+ `(outline-5 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground fg-special-calm green-alt-other)
+ ,@(modus-vivendi-theme-heading-block green-nuanced-bg green-nuanced))))
+ `(outline-6 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground yellow-nuanced yellow-alt-other)
+ ,@(modus-vivendi-theme-heading-block yellow-nuanced-bg yellow-nuanced))))
+ `(outline-7 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground red-nuanced red-alt)
+ ,@(modus-vivendi-theme-heading-block red-nuanced-bg red-nuanced))))
+ `(outline-8 ((,class :inherit (bold ,modus-theme-variable-pitch)
+ ,@(modus-vivendi-theme-heading-foreground fg-dim magenta)
+ ,@(modus-vivendi-theme-heading-block bg-alt fg-alt))))
+;;;;; outline-minor-faces
+ `(outline-minor-0 ((,class ,@(unless modus-vivendi-theme-section-headings
+ (list :background cyan-nuanced-bg)))))
+;;;;; 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)))
+;;;;; 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 ,@(modus-vivendi-theme-extra-completions
+ 'modus-theme-refine-magenta
+ 'modus-theme-intense-magenta
+ 'modus-theme-nuanced-magenta
+ magenta
+ 'bold))))
+ `(selectrum-primary-highlight ((,class ,@(modus-vivendi-theme-extra-completions
+ 'modus-theme-refine-blue
+ 'modus-theme-intense-blue
+ 'modus-theme-nuanced-blue
+ blue
+ 'bold))))
+ `(selectrum-secondary-highlight ((,class ,@(modus-vivendi-theme-extra-completions
+ 'modus-theme-refine-cyan
+ 'modus-theme-intense-cyan
+ 'modus-theme-nuanced-cyan
+ cyan
+ 'bold))))
+;;;;; 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 ,@(modus-vivendi-theme-diffs
+ bg-main yellow
+ bg-diff-focus-changed fg-diff-focus-changed))))
+ `(smerge-lower ((,class ,@(modus-vivendi-theme-diffs
+ bg-main green
+ bg-diff-focus-added fg-diff-focus-added))))
+ `(smerge-markers ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-2)))
+ `(smerge-refined-added ((,class ,@(modus-vivendi-theme-diffs
+ bg-diff-added fg-diff-added
+ bg-diff-refine-added fg-diff-refine-added))))
+ `(smerge-refined-changed ((,class)))
+ `(smerge-refined-removed ((,class ,@(modus-vivendi-theme-diffs
+ bg-diff-removed fg-diff-removed
+ bg-diff-refine-removed fg-diff-refine-removed))))
+ `(smerge-upper ((,class ,@(modus-vivendi-theme-diffs
+ bg-main red
+ bg-diff-focus-removed fg-diff-focus-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 :foreground ,cyan-alt :underline t)))
+;;;;; 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)))
+;;;;; 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-conflict-state ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,red-active)))
+ `(vc-edited-state ((,class :foreground ,fg-special-warm)))
+ `(vc-locally-added-state ((,class :foreground ,cyan-active)))
+ `(vc-locked-state ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta-active)))
+ `(vc-missing-state ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,yellow-active)))
+ `(vc-needs-update-state ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,fg-special-mild)))
+ `(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 ,@(modus-vivendi-theme-diffs
+ bg-main green
+ bg-diff-focus-added fg-diff-focus-added))))
+ `(vdiff-change-face ((,class ,@(modus-vivendi-theme-diffs
+ bg-main yellow
+ bg-diff-focus-changed fg-diff-focus-changed))))
+ `(vdiff-closed-fold-face ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1)))
+ `(vdiff-refine-added ((,class ,@(modus-vivendi-theme-diffs
+ bg-diff-added fg-diff-added
+ bg-diff-refine-added fg-diff-refine-added))))
+ `(vdiff-refine-changed ((,class ,@(modus-vivendi-theme-diffs
+ bg-diff-changed fg-diff-changed
+ bg-diff-refine-changed fg-diff-refine-changed))))
+ `(vdiff-subtraction-face ((,class ,@(modus-vivendi-theme-diffs
+ bg-main red
+ bg-diff-focus-removed fg-diff-focus-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 "black" :foreground "black")))
+ `(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 "white" :foreground "white")))
+ `(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+
+ ;; EXPERIMENTAL this form is subject to review
+ (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 (:background ,yellow-nuanced-bg :foreground ,yellow-nuanced))))
+ `(line-number-minor-tick ((,class (:background ,cyan-nuanced-bg :foreground ,cyan-nuanced))))
+;;;;; 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)))))
+;;; 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])
+;;;; 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-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))))))
+
+;;; library provides
+;;;###autoload
+(when load-file-name
+ (add-to-list 'custom-theme-load-path
+ (file-name-as-directory (file-name-directory load-file-name))))
+
+(provide-theme 'modus-vivendi)
+
+(provide 'modus-vivendi-theme)
+
+;;; modus-vivendi-theme.el ends here
diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el
index 86cc2595ae9..cf1a98bfee2 100644
--- a/etc/themes/tango-dark-theme.el
+++ b/etc/themes/tango-dark-theme.el
@@ -1,4 +1,4 @@
-;;; tango-dark-theme.el --- Tango-based custom theme for faces
+;;; tango-dark-theme.el --- Tango-based custom theme for faces -*- lexical-binding:t -*-
;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el
index ab39bbc06fb..6166657c145 100644
--- a/etc/themes/tango-theme.el
+++ b/etc/themes/tango-theme.el
@@ -1,4 +1,4 @@
-;;; tango-theme.el --- Tango-based custom theme for faces
+;;; tango-theme.el --- Tango-based custom theme for faces -*- lexical-binding:t -*-
;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el
index 515a142d284..f3c9ced5b03 100644
--- a/etc/themes/tsdh-dark-theme.el
+++ b/etc/themes/tsdh-dark-theme.el
@@ -1,4 +1,4 @@
-;;; tsdh-dark-theme.el --- Tassilo's dark custom theme
+;;; tsdh-dark-theme.el --- Tassilo's dark custom theme -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el
index eaa65ffebd1..46443edfd49 100644
--- a/etc/themes/tsdh-light-theme.el
+++ b/etc/themes/tsdh-light-theme.el
@@ -1,4 +1,4 @@
-;;; tsdh-light-theme.el --- Tassilo's light custom theme
+;;; tsdh-light-theme.el --- Tassilo's light custom theme -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
diff --git a/etc/themes/wheatgrass-theme.el b/etc/themes/wheatgrass-theme.el
index c3edced3fa7..f1abdb38952 100644
--- a/etc/themes/wheatgrass-theme.el
+++ b/etc/themes/wheatgrass-theme.el
@@ -1,4 +1,4 @@
-;;; wheatgrass-theme.el --- custom theme for faces
+;;; wheatgrass-theme.el --- custom theme for faces -*- lexical-binding:t -*-
;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
diff --git a/etc/themes/whiteboard-theme.el b/etc/themes/whiteboard-theme.el
index 853479fa9c4..ee42e4f2155 100644
--- a/etc/themes/whiteboard-theme.el
+++ b/etc/themes/whiteboard-theme.el
@@ -1,4 +1,4 @@
-;;; whiteboard-theme.el --- Custom theme for faces
+;;; whiteboard-theme.el --- Custom theme for faces -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
@@ -48,7 +48,6 @@
`(font-lock-comment-face ((,class (:foreground "gray50"))))
`(font-lock-constant-face ((,class (:foreground "DarkOliveGreen4"))))
`(font-lock-doc-face ((,class (:foreground "peru"))))
- `(font-lock-doc-string-face ((,class (:foreground "peru"))))
`(font-lock-function-name-face ((,class (:foreground "goldenrod3"))))
`(font-lock-keyword-face ((,class (:foreground "DodgerBlue2"))))
`(font-lock-preprocessor-face ((,class (:foreground "gold3"))))
diff --git a/etc/themes/wombat-theme.el b/etc/themes/wombat-theme.el
index 122d3022221..4df5f5a3f1c 100644
--- a/etc/themes/wombat-theme.el
+++ b/etc/themes/wombat-theme.el
@@ -1,4 +1,4 @@
-;;; wombat-theme.el --- Custom face theme for Emacs
+;;; wombat-theme.el --- Custom face theme for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL
index eb3acde9c01..319ba52b670 100644
--- a/etc/tutorials/TUTORIAL
+++ b/etc/tutorials/TUTORIAL
@@ -473,6 +473,7 @@ to undo insertion of text.)
>> Kill this line with C-k, then type C-/ and it should reappear.
C-_ is an alternative undo command; it works exactly the same as C-/.
+On some text terminals, you can omit the shift key when you type C-_.
On some text terminals, typing C-/ actually sends C-_ to Emacs.
Alternatively, C-x u also works exactly like C-/, but is a little less
convenient to type.
@@ -612,11 +613,11 @@ but it also means that you need a convenient way to save the first
file's buffer. Having to switch back to that buffer, in order to save
it with C-x C-s, would be a nuisance. So we have
- C-x s Save some buffers
+ C-x s Save some buffers to their files
-C-x s asks you about each buffer which contains changes that you have
-not saved. It asks you, for each such buffer, whether to save the
-buffer.
+C-x s asks you about each file-visiting buffer which contains changes
+that you have not saved. It asks you, for each such buffer, whether
+to save the buffer to its file.
>> Insert a line of text, then type C-x s.
It should ask you whether to save the buffer named TUTORIAL.
@@ -660,8 +661,8 @@ as by a mail handling utility.
There are many C-x commands. Here is a list of the ones you have learned:
C-x C-f Find file
- C-x C-s Save file
- C-x s Save some buffers
+ C-x C-s Save buffer to file
+ C-x s Save some buffers to their files
C-x C-b List buffers
C-x b Switch buffer
C-x C-c Quit Emacs
@@ -1081,7 +1082,7 @@ corresponding command names (such as C-x C-f beside find-file).
You can learn more about Emacs by reading its manual, either as a
printed book, or inside Emacs (use the Help menu or type C-h r).
Two features that you may like especially are completion, which saves
-typing, and dired, which simplifies file handling.
+typing, and Dired, which simplifies file handling.
Completion is a way to avoid unnecessary typing. For instance, if you
want to switch to the *Messages* buffer, you can type C-x b *M<Tab>
diff --git a/etc/tutorials/TUTORIAL.he b/etc/tutorials/TUTORIAL.he
index a6e6f252699..907da242804 100644
--- a/etc/tutorials/TUTORIAL.he
+++ b/etc/tutorials/TUTORIAL.he
@@ -419,8 +419,9 @@ argument) משום מקישים אותו לפני הפקודה אליה הוא
>> גזרו שורה זו עם C-k, אחר־כך הקישו ‪C-/‬ והיא תופיע שוב.
‏C-_‎ הינה דרך חלופית להפעיל את פקודת הביטול. היא פועלת בדיוק כמו ‪C-/‬.
-במקלדות אחדות הקשה על ‪C-/‬ שולחת ל־Emacs את התו C-_‎. חלופה נוספת היא
-C-x u, אם־כי היא פחות נוחה להקשה מספר פעמים בזו אחר זו.
+במקלדות אחדות אפשר לא ללחוץ על shift כשמקישים ‏C-_‎.
+במקלדות אחדות הקשה על ‪C-/‬ שולחת ל־Emacs את התו C-_‎.
+חלופה נוספת היא C-x u, אם־כי היא פחות נוחה להקשה מספר פעמים בזו אחר זו.
ארגומנט נומרי ל־‪C-/‬ או ל־C-_‎ או ל־C-x u משמש כמספר החזרות על הפקודה.
diff --git a/leim/SKK-DIC/SKK-JISYO.L b/leim/SKK-DIC/SKK-JISYO.L
index 6b024e3dc4b..9098868caea 100644
--- a/leim/SKK-DIC/SKK-JISYO.L
+++ b/leim/SKK-DIC/SKK-JISYO.L
@@ -22978,6 +22978,7 @@ covering /С/
coverstory /Сȡ꡼/
coverup /Сå/
coverversion /СС/
+covid-19 /ʥ륹;Coronavirus disease 2019/
cow //
cowbell /٥/
cowboy /ܡ/
@@ -38107,6 +38108,9 @@ sardine /ǥ/
sari /꡼//
sarin //
sarod //å/
+sars /severe acute respiratory syndrome/žɵƵ۴ɸ/
+sars-cov /severe acute respiratory syndrome coronavirus/SARSʥ륹
+sars-cov-2 /severe acute respiratory syndrome coronavirus 2/2019ʥ륹
sartre /ȥ/
saruman /ޥ/
sasa //
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index 29b34d9363b..a2d27eab001 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -231,8 +231,6 @@ BASE_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) \
-I${srcdir} -I${srcdir}/../src -I${srcdir}/../lib
ALL_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${LDFLAGS} ${CPPFLAGS} ${CFLAGS}
-## Unused.
-LINK_CFLAGS = ${BASE_CFLAGS} ${LDFLAGS} ${CFLAGS}
CPP_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${CPPFLAGS} ${CFLAGS}
# Configuration files for .o files to depend on.
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 204064f1871..871fa7a8d3c 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -80,7 +80,7 @@ char *w32_getenv (const char *);
#include <sys/stat.h>
#include <unistd.h>
-#include <dosname.h>
+#include <filename.h>
#include <intprops.h>
#include <min-max.h>
#include <pathmax.h>
@@ -1504,11 +1504,17 @@ set_local_socket (char const *server_name)
"%s: (Be careful: XDG_RUNTIME_DIR is security-related.)\n"),
progname, sockdirname, progname);
}
- message (true,
- ("%s: can't find socket; have you started the server?\n"
- "%s: To start the server in Emacs,"
- " type \"M-x server-start\".\n"),
- progname, progname);
+
+ /* If there's an alternate editor and the user has requested
+ --quiet, don't output the warning. */
+ if (!quiet || !alternate_editor)
+ {
+ message (true,
+ ("%s: can't find socket; have you started the server?\n"
+ "%s: To start the server in Emacs,"
+ " type \"M-x server-start\".\n"),
+ progname, progname);
+ }
}
else
message (true, "%s: can't stat %s: %s\n",
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 8babe926db1..146cf612505 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -124,6 +124,7 @@ University of California, as described above. */
#include <binary-io.h>
#include <intprops.h>
#include <unlocked-io.h>
+#include <verify.h>
#include <c-ctype.h>
#include <c-strcase.h>
@@ -4199,9 +4200,9 @@ C_entries (int c_ext, FILE *inf)
break;
}
FALLTHROUGH;
- resetfvdef:
case '#': case '~': case '&': case '%': case '/':
case '|': case '^': case '!': case '.': case '?':
+ resetfvdef:
if (definedef != dnone)
break;
/* These surely cannot follow a function tag in C. */
@@ -7313,6 +7314,8 @@ static void *
xnmalloc (ptrdiff_t nitems, ptrdiff_t item_size)
{
ptrdiff_t nbytes;
+ assume (0 <= nitems);
+ assume (0 < item_size);
if (INT_MULTIPLY_WRAPV (nitems, item_size, &nbytes))
memory_full ();
return xmalloc (nbytes);
@@ -7322,6 +7325,8 @@ static void *
xnrealloc (void *pa, ptrdiff_t nitems, ptrdiff_t item_size)
{
ptrdiff_t nbytes;
+ assume (0 <= nitems);
+ assume (0 < item_size);
if (INT_MULTIPLY_WRAPV (nitems, item_size, &nbytes) || SIZE_MAX < nbytes)
memory_full ();
void *result = realloc (pa, nbytes);
diff --git a/lib/_Noreturn.h b/lib/_Noreturn.h
index 0d4b9c29e02..394ca3c2aa2 100644
--- a/lib/_Noreturn.h
+++ b/lib/_Noreturn.h
@@ -28,7 +28,10 @@
# define _Noreturn [[noreturn]]
# elif ((!defined __cplusplus || defined __clang__) \
&& (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
- || 4 < __GNUC__ + (7 <= __GNUC_MINOR__)))
+ || 4 < __GNUC__ + (7 <= __GNUC_MINOR__) \
+ || (defined __apple_build_version__ \
+ ? 6000000 <= __apple_build_version__ \
+ : 3 < __clang_major__ + (5 <= __clang_minor__))))
/* _Noreturn works as-is. */
# elif 2 < __GNUC__ + (8 <= __GNUC_MINOR__) || 0x5110 <= __SUNPRO_C
# define _Noreturn __attribute__ ((__noreturn__))
diff --git a/lib/alloca.in.h b/lib/alloca.in.h
index 228f9a0a29b..c71e9bfed9e 100644
--- a/lib/alloca.in.h
+++ b/lib/alloca.in.h
@@ -1,7 +1,7 @@
/* Memory allocation on the stack.
- Copyright (C) 1995, 1999, 2001-2004, 2006-2020 Free Software
- Foundation, Inc.
+ Copyright (C) 1995, 1999, 2001-2004, 2006-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
@@ -35,13 +35,16 @@
*/
#ifndef alloca
-# ifdef __GNUC__
- /* Some version of mingw have an <alloca.h> that causes trouble when
- included after 'alloca' gets defined as a macro. As a workaround, include
- this <alloca.h> first and define 'alloca' as a macro afterwards. */
-# if (defined _WIN32 && ! defined __CYGWIN__) && @HAVE_ALLOCA_H@
-# include_next <alloca.h>
-# endif
+ /* Some version of mingw have an <alloca.h> that causes trouble when
+ included after 'alloca' gets defined as a macro. As a workaround,
+ include this <alloca.h> first and define 'alloca' as a macro afterwards
+ if needed. */
+# if defined __GNUC__ && (defined _WIN32 && ! defined __CYGWIN__) && @HAVE_ALLOCA_H@
+# include_next <alloca.h>
+# endif
+#endif
+#ifndef alloca
+# if defined __GNUC__ || (__clang_major__ >= 4)
# define alloca __builtin_alloca
# elif defined _AIX
# define alloca __alloca
diff --git a/lib/arg-nonnull.h b/lib/arg-nonnull.h
index ac26ca8cfed..db9d9ae116a 100644
--- a/lib/arg-nonnull.h
+++ b/lib/arg-nonnull.h
@@ -18,7 +18,7 @@
that the values passed as arguments n, ..., m must be non-NULL pointers.
n = 1 stands for the first argument, n = 2 for the second argument etc. */
#ifndef _GL_ARG_NONNULL
-# if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || __GNUC__ > 3
+# if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || defined __clang__
# define _GL_ARG_NONNULL(params) __attribute__ ((__nonnull__ params))
# else
# define _GL_ARG_NONNULL(params)
diff --git a/lib/at-func.c b/lib/at-func.c
index 4a1c909d38e..90022e05787 100644
--- a/lib/at-func.c
+++ b/lib/at-func.c
@@ -16,7 +16,7 @@
/* written by Jim Meyering */
-#include "dosname.h" /* solely for definition of IS_ABSOLUTE_FILE_NAME */
+#include "filename.h" /* solely for definition of IS_ABSOLUTE_FILE_NAME */
#ifdef GNULIB_SUPPORT_ONLY_AT_FDCWD
# include <errno.h>
diff --git a/lib/attribute.h b/lib/attribute.h
new file mode 100644
index 00000000000..2836b99dad0
--- /dev/null
+++ b/lib/attribute.h
@@ -0,0 +1,215 @@
+/* ATTRIBUTE_* macros for using attributes in GCC and similar compilers
+
+ Copyright 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. */
+
+/* Provide public ATTRIBUTE_* names for the private _GL_ATTRIBUTE_*
+ macros used within Gnulib. */
+
+/* These attributes can be placed in two ways:
+ - At the start of a declaration (i.e. even before storage-class
+ specifiers!); then they apply to all entities that are declared
+ by the declaration.
+ - Immediately after the name of an entity being declared by the
+ declaration; then they apply to that entity only. */
+
+#ifndef _GL_ATTRIBUTE_H
+#define _GL_ATTRIBUTE_H
+
+
+/* This file defines two types of attributes:
+ * C2X standard attributes. These have macro names that do not begin with
+ 'ATTRIBUTE_'.
+ * Selected GCC attributes; see:
+ https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html
+ https://gcc.gnu.org/onlinedocs/gcc/Common-Variable-Attributes.html
+ https://gcc.gnu.org/onlinedocs/gcc/Common-Type-Attributes.html
+ These names begin with 'ATTRIBUTE_' to avoid name clashes. */
+
+
+/* =============== Attributes for specific kinds of functions =============== */
+
+/* Attributes for functions that should not be used. */
+
+/* Warn if the entity is used. */
+/* Applies to:
+ - function, variable,
+ - struct, union, struct/union member,
+ - enumeration, enumeration item,
+ - typedef,
+ in C++ also: namespace, class, template specialization. */
+#define DEPRECATED _GL_ATTRIBUTE_DEPRECATED
+
+/* If a function call is not optimized way, warn with MSG. */
+/* Applies to: functions. */
+#define ATTRIBUTE_WARNING(msg) _GL_ATTRIBUTE_WARNING (msg)
+
+/* If a function call is not optimized way, report an error with MSG. */
+/* Applies to: functions. */
+#define ATTRIBUTE_ERROR(msg) _GL_ATTRIBUTE_ERROR (msg)
+
+
+/* Attributes for memory-allocating functions. */
+
+/* The function returns a pointer to freshly allocated memory. */
+/* Applies to: functions. */
+#define ATTRIBUTE_MALLOC _GL_ATTRIBUTE_MALLOC
+
+/* ATTRIBUTE_ALLOC_SIZE ((N)) - The Nth argument of the function
+ is the size of the returned memory block.
+ ATTRIBUTE_ALLOC_SIZE ((M, N)) - Multiply the Mth and Nth arguments
+ to determine the size of the returned memory block. */
+/* Applies to: function, pointer to function, function types. */
+#define ATTRIBUTE_ALLOC_SIZE(args) _GL_ATTRIBUTE_ALLOC_SIZE (args)
+
+
+/* Attributes for variadic functions. */
+
+/* The variadic function expects a trailing NULL argument.
+ ATTRIBUTE_SENTINEL () - The last argument is NULL.
+ ATTRIBUTE_SENTINEL ((N)) - The (N+1)st argument from the end is NULL. */
+/* Applies to: functions. */
+#define ATTRIBUTE_SENTINEL(pos) _GL_ATTRIBUTE_SENTINEL (pos)
+
+
+/* ================== Attributes for compiler diagnostics ================== */
+
+/* Attributes that help the compiler diagnose programmer mistakes.
+ Some of them may also help for some compiler optimizations. */
+
+/* ATTRIBUTE_FORMAT ((ARCHETYPE, STRING-INDEX, FIRST-TO-CHECK)) -
+ The STRING-INDEXth function argument is a format string of style
+ ARCHETYPE, which is one of:
+ printf, gnu_printf
+ scanf, gnu_scanf,
+ strftime, gnu_strftime,
+ strfmon,
+ or the same thing prefixed and suffixed with '__'.
+ If FIRST-TO-CHECK is not 0, arguments starting at FIRST-TO_CHECK
+ are suitable for the format string. */
+/* Applies to: functions. */
+#define ATTRIBUTE_FORMAT(spec) _GL_ATTRIBUTE_FORMAT (spec)
+
+/* ATTRIBUTE_NONNULL ((N1, N2,...)) - Arguments N1, N2,... must not be NULL.
+ ATTRIBUTE_NONNULL () - All pointer arguments must not be null. */
+/* Applies to: functions. */
+#define ATTRIBUTE_NONNULL(args) _GL_ATTRIBUTE_NONNULL (args)
+
+/* The function's return value is a non-NULL pointer. */
+/* Applies to: functions. */
+#define ATTRIBUTE_RETURNS_NONNULL _GL_ATTRIBUTE_RETURNS_NONNULL
+
+/* Warn if the caller does not use the return value,
+ unless the caller uses something like ignore_value. */
+/* Applies to: function, enumeration, class. */
+#define NODISCARD _GL_ATTRIBUTE_NODISCARD
+
+
+/* Attributes that disable false alarms when the compiler diagnoses
+ programmer "mistakes". */
+
+/* Do not warn if the entity is not used. */
+/* Applies to:
+ - function, variable,
+ - struct, union, struct/union member,
+ - enumeration, enumeration item,
+ - typedef,
+ in C++ also: class. */
+#define MAYBE_UNUSED _GL_ATTRIBUTE_MAYBE_UNUSED
+
+/* The contents of a character array is not meant to be NUL-terminated. */
+/* Applies to: struct/union members and variables that are arrays of element
+ type '[[un]signed] char'. */
+#define ATTRIBUTE_NONSTRING _GL_ATTRIBUTE_NONSTRING
+
+/* Do not warn if control flow falls through to the immediately
+ following 'case' or 'default' label. */
+/* Applies to: Empty statement (;), inside a 'switch' statement. */
+#define FALLTHROUGH _GL_ATTRIBUTE_FALLTHROUGH
+
+
+/* ================== Attributes for debugging information ================== */
+
+/* Attributes regarding debugging information emitted by the compiler. */
+
+/* Omit the function from stack traces when debugging. */
+/* Applies to: function. */
+#define ATTRIBUTE_ARTIFICIAL _GL_ATTRIBUTE_ARTIFICIAL
+
+/* Make the entity visible to debuggers etc., even with '-fwhole-program'. */
+/* Applies to: functions, variables. */
+#define ATTRIBUTE_EXTERNALLY_VISIBLE _GL_ATTRIBUTE_EXTERNALLY_VISIBLE
+
+
+/* ========== Attributes that mainly direct compiler optimizations ========== */
+
+/* The function does not throw exceptions. */
+/* Applies to: functions. */
+#define ATTRIBUTE_NOTHROW _GL_ATTRIBUTE_NOTHROW
+
+/* Do not inline the function. */
+/* Applies to: functions. */
+#define ATTRIBUTE_NOINLINE _GL_ATTRIBUTE_NOINLINE
+
+/* Always inline the function, and report an error if the compiler
+ cannot inline. */
+/* Applies to: function. */
+#define ATTRIBUTE_ALWAYS_INLINE _GL_ATTRIBUTE_ALWAYS_INLINE
+
+/* The function does not affect observable state, and always returns a value.
+ Compilers can omit duplicate calls with the same arguments if
+ observable state is not changed between calls. (This attribute is
+ looser than ATTRIBUTE_CONST.) */
+/* Applies to: functions. */
+#define ATTRIBUTE_PURE _GL_ATTRIBUTE_PURE
+
+/* The function neither depends on nor affects observable state,
+ and always returns a value. Compilers can omit duplicate calls with
+ the same arguments. (This attribute is stricter than ATTRIBUTE_PURE.) */
+/* Applies to: functions. */
+#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST
+
+/* The function is rarely executed. */
+/* Applies to: functions. */
+#define ATTRIBUTE_COLD _GL_ATTRIBUTE_COLD
+
+/* If called from some other compilation unit, the function executes
+ code from that unit only by return or by exception handling,
+ letting the compiler optimize that unit more aggressively. */
+/* Applies to: functions. */
+#define ATTRIBUTE_LEAF _GL_ATTRIBUTE_LEAF
+
+/* For struct members: The member has the smallest possible alignment.
+ For struct, union, class: All members have the smallest possible alignment,
+ minimizing the memory required. */
+/* Applies to: struct members, struct, union,
+ in C++ also: class. */
+#define ATTRIBUTE_PACKED _GL_ATTRIBUTE_PACKED
+
+
+/* ================ Attributes that make invalid code valid ================ */
+
+/* Attributes that prevent fatal compiler optimizations for code that is not
+ fully ISO C compliant. */
+
+/* Pointers to the type may point to the same storage as pointers to
+ other types, thus disabling strict aliasing optimization. */
+/* Applies to: types. */
+#define ATTRIBUTE_MAY_ALIAS _GL_ATTRIBUTE_MAY_ALIAS
+
+
+#endif /* _GL_ATTRIBUTE_H */
diff --git a/lib/binary-io.h b/lib/binary-io.h
index 64223f16fc2..d17af7c3807 100644
--- a/lib/binary-io.h
+++ b/lib/binary-io.h
@@ -1,6 +1,5 @@
/* Binary mode I/O.
- Copyright (C) 2001, 2003, 2005, 2008-2020 Free Software Foundation,
- Inc.
+ Copyright (C) 2001, 2003, 2005, 2008-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
@@ -57,7 +56,7 @@ __gl_setmode (int fd _GL_UNUSED, int mode _GL_UNUSED)
/* Set FD's mode to MODE, which should be either O_TEXT or O_BINARY.
Return the old mode if successful, -1 (setting errno) on failure.
Ordinarily this function would be called 'setmode', since that is
- its name on MS-Windows, but it is called 'set_binary_mode' here
+ its old name on MS-Windows, but it is called 'set_binary_mode' here
to avoid colliding with a BSD function of another name. */
#if defined __DJGPP__ || defined __EMX__
diff --git a/lib/c++defs.h b/lib/c++defs.h
index 7a057633883..6a9bf295eb5 100644
--- a/lib/c++defs.h
+++ b/lib/c++defs.h
@@ -146,6 +146,16 @@
_GL_EXTERN_C int _gl_cxxalias_dummy
#endif
+/* _GL_CXXALIAS_MDA (func, rettype, parameters);
+ is to be used when func is a Microsoft deprecated alias, on native Windows.
+ It declares a C++ alias called GNULIB_NAMESPACE::func
+ that redirects to _func, if GNULIB_NAMESPACE is defined.
+ Example:
+ _GL_CXXALIAS_MDA (open, int, (const char *filename, int flags, ...));
+ */
+#define _GL_CXXALIAS_MDA(func,rettype,parameters) \
+ _GL_CXXALIAS_RPL_1 (func, _##func, rettype, parameters)
+
/* _GL_CXXALIAS_RPL_CAST_1 (func, rpl_func, rettype, parameters);
is like _GL_CXXALIAS_RPL_1 (func, rpl_func, rettype, parameters);
except that the C function rpl_func may have a slightly different
@@ -268,7 +278,7 @@
_GL_CXXALIASWARN_2 (func, namespace)
/* To work around GCC bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43881>,
we enable the warning only when not optimizing. */
-# if !__OPTIMIZE__
+# if !(defined __GNUC__ && !defined __clang__ && __OPTIMIZE__)
# define _GL_CXXALIASWARN_2(func,namespace) \
_GL_WARN_ON_USE (func, \
"The symbol ::" #func " refers to the system function. " \
@@ -296,14 +306,11 @@
_GL_CXXALIASWARN1_2 (func, rettype, parameters_and_attributes, namespace)
/* To work around GCC bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43881>,
we enable the warning only when not optimizing. */
-# if !__OPTIMIZE__
+# if !(defined __GNUC__ && !defined __clang__ && __OPTIMIZE__)
# define _GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \
- _GL_WARN_ON_USE_CXX (func, rettype, parameters_and_attributes, \
+ _GL_WARN_ON_USE_CXX (func, rettype, rettype, parameters_and_attributes, \
"The symbol ::" #func " refers to the system function. " \
"Use " #namespace "::" #func " instead.")
-# elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING
-# define _GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \
- extern __typeof__ (func) func
# else
# define _GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \
_GL_EXTERN_C int _gl_cxxalias_dummy
diff --git a/lib/c-ctype.h b/lib/c-ctype.h
index 42891bb1683..fbd11b34508 100644
--- a/lib/c-ctype.h
+++ b/lib/c-ctype.h
@@ -5,8 +5,7 @@
<ctype.h> functions' behaviour depends on the current locale set via
setlocale.
- Copyright (C) 2000-2003, 2006, 2008-2020 Free Software Foundation,
- Inc.
+ Copyright (C) 2000-2003, 2006, 2008-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
diff --git a/lib/c-strcasecmp.c b/lib/c-strcasecmp.c
index f660bba73b5..f1a4b98fa55 100644
--- a/lib/c-strcasecmp.c
+++ b/lib/c-strcasecmp.c
@@ -1,6 +1,5 @@
/* c-strcasecmp.c -- case insensitive string comparator in C locale
- Copyright (C) 1998-1999, 2005-2006, 2009-2020 Free Software
- Foundation, Inc.
+ Copyright (C) 1998-1999, 2005-2006, 2009-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
@@ -53,5 +52,5 @@ c_strcasecmp (const char *s1, const char *s2)
/* On machines where 'char' and 'int' are types of the same size, the
difference of two 'unsigned char' values - including the sign bit -
doesn't fit in an 'int'. */
- return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0);
+ return _GL_CMP (c1, c2);
}
diff --git a/lib/c-strncasecmp.c b/lib/c-strncasecmp.c
index 89df6915840..1d6e1411a67 100644
--- a/lib/c-strncasecmp.c
+++ b/lib/c-strncasecmp.c
@@ -1,6 +1,5 @@
/* c-strncasecmp.c -- case insensitive string comparator in C locale
- Copyright (C) 1998-1999, 2005-2006, 2009-2020 Free Software
- Foundation, Inc.
+ Copyright (C) 1998-1999, 2005-2006, 2009-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
@@ -53,5 +52,5 @@ c_strncasecmp (const char *s1, const char *s2, size_t n)
/* On machines where 'char' and 'int' are types of the same size, the
difference of two 'unsigned char' values - including the sign bit -
doesn't fit in an 'int'. */
- return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0);
+ return _GL_CMP (c1, c2);
}
diff --git a/lib/canonicalize-lgpl.c b/lib/canonicalize-lgpl.c
index 7d3c710f10f..0b89d2a1842 100644
--- a/lib/canonicalize-lgpl.c
+++ b/lib/canonicalize-lgpl.c
@@ -51,8 +51,10 @@
# define __realpath realpath
# include "pathmax.h"
# include "malloca.h"
-# include "dosname.h"
-# if HAVE_GETCWD
+# include "filename.h"
+# if defined _WIN32 && !defined __CYGWIN__
+# define __getcwd _getcwd
+# elif HAVE_GETCWD
# if IN_RELOCWRAPPER
/* When building the relocatable program wrapper, use the system's getcwd
function, not the gnulib override, otherwise we would get a link error.
diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c
index 197ce8de77f..e43aa42d5c4 100644
--- a/lib/careadlinkat.c
+++ b/lib/careadlinkat.c
@@ -1,7 +1,7 @@
/* Read symbolic links into a buffer without size limitation, relative to fd.
- Copyright (C) 2001, 2003-2004, 2007, 2009-2020 Free Software
- Foundation, Inc.
+ Copyright (C) 2001, 2003-2004, 2007, 2009-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
@@ -38,57 +38,47 @@
#include "allocator.h"
-/* Assuming the current directory is FD, get the symbolic link value
- of FILENAME as a null-terminated string and put it into a buffer.
- If FD is AT_FDCWD, FILENAME is interpreted relative to the current
- working directory, as in openat.
-
- If the link is small enough to fit into BUFFER put it there.
- BUFFER's size is BUFFER_SIZE, and BUFFER can be null
- if BUFFER_SIZE is zero.
-
- If the link is not small, put it into a dynamically allocated
- buffer managed by ALLOC. It is the caller's responsibility to free
- the returned value if it is nonnull and is not BUFFER. A null
- ALLOC stands for the standard allocator.
-
- The PREADLINKAT function specifies how to read links. It operates
- like POSIX readlinkat()
- <https://pubs.opengroup.org/onlinepubs/9699919799/functions/readlink.html>
- but can assume that its first argument is the same as FD.
-
- If successful, return the buffer address; otherwise return NULL and
- set errno. */
-
-char *
-careadlinkat (int fd, char const *filename,
+enum { STACK_BUF_SIZE = 1024 };
+
+/* Act like careadlinkat (see below), with an additional argument
+ STACK_BUF that can be used as temporary storage.
+
+ If GCC_LINT is defined, do not inline this function with GCC 10.1
+ and later, to avoid creating a pointer to the stack that GCC
+ -Wreturn-local-addr incorrectly complains about. See:
+ https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93644
+ Although the noinline attribute can hurt performance a bit, no better way
+ to pacify GCC is known; even an explicit #pragma does not pacify GCC.
+ When the GCC bug is fixed this workaround should be limited to the
+ broken GCC versions. */
+#if (defined GCC_LINT || defined lint) && _GL_GNUC_PREREQ (10, 1)
+__attribute__ ((__noinline__))
+#endif
+static char *
+readlink_stk (int fd, char const *filename,
char *buffer, size_t buffer_size,
struct allocator const *alloc,
- ssize_t (*preadlinkat) (int, char const *, char *, size_t))
+ ssize_t (*preadlinkat) (int, char const *, char *, size_t),
+ char stack_buf[STACK_BUF_SIZE])
{
char *buf;
size_t buf_size;
size_t buf_size_max =
SSIZE_MAX < SIZE_MAX ? (size_t) SSIZE_MAX + 1 : SIZE_MAX;
- char stack_buf[1024];
if (! alloc)
alloc = &stdlib_allocator;
- if (! buffer_size)
+ if (!buffer)
{
- /* Allocate the initial buffer on the stack. This way, in the
- common case of a symlink of small size, we get away with a
- single small malloc() instead of a big malloc() followed by a
- shrinking realloc(). */
buffer = stack_buf;
- buffer_size = sizeof stack_buf;
+ buffer_size = STACK_BUF_SIZE;
}
buf = buffer;
buf_size = buffer_size;
- do
+ while (buf)
{
/* Attempt to read the link into the current buffer. */
ssize_t link_length = preadlinkat (fd, filename, buf, buf_size);
@@ -117,19 +107,19 @@ careadlinkat (int fd, char const *filename,
if (buf == stack_buf)
{
- char *b = (char *) alloc->allocate (link_size);
+ char *b = alloc->allocate (link_size);
buf_size = link_size;
if (! b)
break;
- memcpy (b, buf, link_size);
- buf = b;
+ return memcpy (b, buf, link_size);
}
- else if (link_size < buf_size && buf != buffer && alloc->reallocate)
+
+ if (link_size < buf_size && buf != buffer && alloc->reallocate)
{
/* Shrink BUF before returning it. */
- char *b = (char *) alloc->reallocate (buf, link_size);
+ char *b = alloc->reallocate (buf, link_size);
if (b)
- buf = b;
+ return b;
}
return buf;
@@ -138,8 +128,8 @@ careadlinkat (int fd, char const *filename,
if (buf != buffer)
alloc->free (buf);
- if (buf_size <= buf_size_max / 2)
- buf_size *= 2;
+ if (buf_size < buf_size_max / 2)
+ buf_size = 2 * buf_size + 1;
else if (buf_size < buf_size_max)
buf_size = buf_size_max;
else if (buf_size_max < SIZE_MAX)
@@ -149,12 +139,52 @@ careadlinkat (int fd, char const *filename,
}
else
break;
- buf = (char *) alloc->allocate (buf_size);
+ buf = alloc->allocate (buf_size);
}
- while (buf);
if (alloc->die)
alloc->die (buf_size);
errno = ENOMEM;
return NULL;
}
+
+
+/* Assuming the current directory is FD, get the symbolic link value
+ of FILENAME as a null-terminated string and put it into a buffer.
+ If FD is AT_FDCWD, FILENAME is interpreted relative to the current
+ working directory, as in openat.
+
+ If the link is small enough to fit into BUFFER put it there.
+ BUFFER's size is BUFFER_SIZE, and BUFFER can be null
+ if BUFFER_SIZE is zero.
+
+ If the link is not small, put it into a dynamically allocated
+ buffer managed by ALLOC. It is the caller's responsibility to free
+ the returned value if it is nonnull and is not BUFFER. A null
+ ALLOC stands for the standard allocator.
+
+ The PREADLINKAT function specifies how to read links. It operates
+ like POSIX readlinkat()
+ <https://pubs.opengroup.org/onlinepubs/9699919799/functions/readlink.html>
+ but can assume that its first argument is the same as FD.
+
+ If successful, return the buffer address; otherwise return NULL and
+ set errno. */
+
+char *
+careadlinkat (int fd, char const *filename,
+ char *buffer, size_t buffer_size,
+ struct allocator const *alloc,
+ ssize_t (*preadlinkat) (int, char const *, char *, size_t))
+{
+ /* Allocate the initial buffer on the stack. This way, in the
+ common case of a symlink of small size, we get away with a
+ single small malloc instead of a big malloc followed by a
+ shrinking realloc.
+
+ If GCC -Wreturn-local-addr warns about this buffer, the warning
+ is bogus; see readlink_stk. */
+ char stack_buf[STACK_BUF_SIZE];
+ return readlink_stk (fd, filename, buffer, buffer_size, alloc,
+ preadlinkat, stack_buf);
+}
diff --git a/lib/careadlinkat.h b/lib/careadlinkat.h
index 584cfe9ad8e..a4a37b274d0 100644
--- a/lib/careadlinkat.h
+++ b/lib/careadlinkat.h
@@ -47,7 +47,7 @@ struct allocator;
set errno. */
char *careadlinkat (int fd, char const *filename,
- char *buffer, size_t buffer_size,
+ char *restrict buffer, size_t buffer_size,
struct allocator const *alloc,
ssize_t (*preadlinkat) (int, char const *,
char *, size_t));
diff --git a/lib/cdefs.h b/lib/cdefs.h
index d8e4a000333..ff7c628a264 100644
--- a/lib/cdefs.h
+++ b/lib/cdefs.h
@@ -34,7 +34,34 @@
#undef __P
#undef __PMT
-#ifdef __GNUC__
+/* Compilers that are not clang may object to
+ #if defined __clang__ && __has_attribute(...)
+ even though they do not need to evaluate the right-hand side of the &&. */
+#if defined __clang__ && defined __has_attribute
+# define __glibc_clang_has_attribute(name) __has_attribute (name)
+#else
+# define __glibc_clang_has_attribute(name) 0
+#endif
+
+/* Compilers that are not clang may object to
+ #if defined __clang__ && __has_builtin(...)
+ even though they do not need to evaluate the right-hand side of the &&. */
+#if defined __clang__ && defined __has_builtin
+# define __glibc_clang_has_builtin(name) __has_builtin (name)
+#else
+# define __glibc_clang_has_builtin(name) 0
+#endif
+
+/* Compilers that are not clang may object to
+ #if defined __clang__ && __has_extension(...)
+ even though they do not need to evaluate the right-hand side of the &&. */
+#if defined __clang__ && defined __has_extension
+# define __glibc_clang_has_extension(ext) __has_extension (ext)
+#else
+# define __glibc_clang_has_extension(ext) 0
+#endif
+
+#if defined __GNUC__ || defined __clang__
/* All functions, except those with callbacks or those that
synchronize memory, are leaf functions. */
@@ -51,13 +78,14 @@
gcc 2.8.x and egcs. For gcc 3.2 and up we even mark C functions
as non-throwing using a function attribute since programs can use
the -fexceptions options for C code as well. */
-# if !defined __cplusplus && __GNUC_PREREQ (3, 3)
+# if !defined __cplusplus \
+ && (__GNUC_PREREQ (3, 3) || __glibc_clang_has_attribute (__nothrow__))
# define __THROW __attribute__ ((__nothrow__ __LEAF))
# define __THROWNL __attribute__ ((__nothrow__))
# define __NTH(fct) __attribute__ ((__nothrow__ __LEAF)) fct
# define __NTHNL(fct) __attribute__ ((__nothrow__)) fct
# else
-# if defined __cplusplus && __GNUC_PREREQ (2,8)
+# if defined __cplusplus && (__GNUC_PREREQ (2,8) || __clang_major >= 4)
# define __THROW throw ()
# define __THROWNL throw ()
# define __NTH(fct) __LEAF_ATTR fct throw ()
@@ -70,7 +98,7 @@
# endif
# endif
-#else /* Not GCC. */
+#else /* Not GCC or clang. */
# if (defined __cplusplus \
|| (defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L))
@@ -83,16 +111,7 @@
# define __THROWNL
# define __NTH(fct) fct
-#endif /* GCC. */
-
-/* Compilers that are not clang may object to
- #if defined __clang__ && __has_extension(...)
- even though they do not need to evaluate the right-hand side of the &&. */
-#if defined __clang__ && defined __has_extension
-# define __glibc_clang_has_extension(ext) __has_extension (ext)
-#else
-# define __glibc_clang_has_extension(ext) 0
-#endif
+#endif /* GCC || clang. */
/* These two macros are not used in glibc anymore. They are kept here
only because some other projects expect the macros to be defined. */
@@ -129,6 +148,16 @@
# define __warnattr(msg) __attribute__((__warning__ (msg)))
# define __errordecl(name, msg) \
extern void name (void) __attribute__((__error__ (msg)))
+#elif __glibc_clang_has_attribute (__diagnose_if__) && 0
+/* These definitions are not enabled, because they produce bogus warnings
+ in the glibc Fortify functions. These functions are written in a style
+ that works with GCC. In order to work with clang, these functions would
+ need to be modified. */
+# define __warndecl(name, msg) \
+ extern void name (void) __attribute__((__diagnose_if__ (1, msg, "warning")))
+# define __warnattr(msg) __attribute__((__diagnose_if__ (1, msg, "warning")))
+# define __errordecl(name, msg) \
+ extern void name (void) __attribute__((__diagnose_if__ (1, msg, "error")))
#else
# define __warndecl(name, msg) extern void name (void)
# define __warnattr(msg)
@@ -142,8 +171,8 @@
#if defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L && !defined __HP_cc
# define __flexarr []
# define __glibc_c99_flexarr_available 1
-#elif __GNUC_PREREQ (2,97)
-/* GCC 2.97 supports C99 flexible array members as an extension,
+#elif __GNUC_PREREQ (2,97) || defined __clang__
+/* GCC 2.97 and clang support C99 flexible array members as an extension,
even when in C89 mode or compiling C++ (any version). */
# define __flexarr []
# define __glibc_c99_flexarr_available 1
@@ -169,7 +198,7 @@
Example:
int __REDIRECT(setpgrp, (__pid_t pid, __pid_t pgrp), setpgid); */
-#if defined __GNUC__ && __GNUC__ >= 2
+#if (defined __GNUC__ && __GNUC__ >= 2) || (__clang_major__ >= 4)
# define __REDIRECT(name, proto, alias) name proto __asm__ (__ASMNAME (#alias))
# ifdef __cplusplus
@@ -194,17 +223,17 @@
*/
#endif
-/* GCC has various useful declarations that can be made with the
- `__attribute__' syntax. All of the ways we use this do fine if
- they are omitted for compilers that don't understand it. */
-#if !defined __GNUC__ || __GNUC__ < 2
+/* GCC and clang have various useful declarations that can be made with
+ the '__attribute__' syntax. All of the ways we use this do fine if
+ they are omitted for compilers that don't understand it. */
+#if !(defined __GNUC__ || defined __clang__)
# define __attribute__(xyz) /* Ignore */
#endif
/* At some point during the gcc 2.96 development the `malloc' attribute
for functions was introduced. We don't want to use it unconditionally
(although this would be possible) since it generates warnings. */
-#if __GNUC_PREREQ (2,96)
+#if __GNUC_PREREQ (2,96) || __glibc_clang_has_attribute (__malloc__)
# define __attribute_malloc__ __attribute__ ((__malloc__))
#else
# define __attribute_malloc__ /* Ignore */
@@ -222,14 +251,14 @@
/* At some point during the gcc 2.96 development the `pure' attribute
for functions was introduced. We don't want to use it unconditionally
(although this would be possible) since it generates warnings. */
-#if __GNUC_PREREQ (2,96)
+#if __GNUC_PREREQ (2,96) || __glibc_clang_has_attribute (__pure__)
# define __attribute_pure__ __attribute__ ((__pure__))
#else
# define __attribute_pure__ /* Ignore */
#endif
/* This declaration tells the compiler that the value is constant. */
-#if __GNUC_PREREQ (2,5)
+#if __GNUC_PREREQ (2,5) || __glibc_clang_has_attribute (__const__)
# define __attribute_const__ __attribute__ ((__const__))
#else
# define __attribute_const__ /* Ignore */
@@ -238,7 +267,7 @@
/* At some point during the gcc 3.1 development the `used' attribute
for functions was introduced. We don't want to use it unconditionally
(although this would be possible) since it generates warnings. */
-#if __GNUC_PREREQ (3,1)
+#if __GNUC_PREREQ (3,1) || __glibc_clang_has_attribute (__used__)
# define __attribute_used__ __attribute__ ((__used__))
# define __attribute_noinline__ __attribute__ ((__noinline__))
#else
@@ -247,7 +276,7 @@
#endif
/* Since version 3.2, gcc allows marking deprecated functions. */
-#if __GNUC_PREREQ (3,2)
+#if __GNUC_PREREQ (3,2) || __glibc_clang_has_attribute (__deprecated__)
# define __attribute_deprecated__ __attribute__ ((__deprecated__))
#else
# define __attribute_deprecated__ /* Ignore */
@@ -270,7 +299,7 @@
If several `format_arg' attributes are given for the same function, in
gcc-3.0 and older, all but the last one are ignored. In newer gccs,
all designated arguments are considered. */
-#if __GNUC_PREREQ (2,8)
+#if __GNUC_PREREQ (2,8) || __glibc_clang_has_attribute (__format_arg__)
# define __attribute_format_arg__(x) __attribute__ ((__format_arg__ (x)))
#else
# define __attribute_format_arg__(x) /* Ignore */
@@ -280,7 +309,7 @@
attribute for functions was introduced. We don't want to use it
unconditionally (although this would be possible) since it
generates warnings. */
-#if __GNUC_PREREQ (2,97)
+#if __GNUC_PREREQ (2,97) || __glibc_clang_has_attribute (__format__)
# define __attribute_format_strfmon__(a,b) \
__attribute__ ((__format__ (__strfmon__, a, b)))
#else
@@ -291,7 +320,7 @@
must not be NULL. Do not define __nonnull if it is already defined,
for portability when this file is used in Gnulib. */
#ifndef __nonnull
-# if __GNUC_PREREQ (3,3)
+# if __GNUC_PREREQ (3,3) || __glibc_clang_has_attribute (__nonnull__)
# define __nonnull(params) __attribute__ ((__nonnull__ params))
# else
# define __nonnull(params)
@@ -300,7 +329,7 @@
/* If fortification mode, we warn about unused results of certain
function calls which can lead to problems. */
-#if __GNUC_PREREQ (3,4)
+#if __GNUC_PREREQ (3,4) || __glibc_clang_has_attribute (__warn_unused_result__)
# define __attribute_warn_unused_result__ \
__attribute__ ((__warn_unused_result__))
# if defined __USE_FORTIFY_LEVEL && __USE_FORTIFY_LEVEL > 0
@@ -314,7 +343,7 @@
#endif
/* Forces a function to be always inlined. */
-#if __GNUC_PREREQ (3,2)
+#if __GNUC_PREREQ (3,2) || __glibc_clang_has_attribute (__always_inline__)
/* The Linux kernel defines __always_inline in stddef.h (283d7573), and
it conflicts with this definition. Therefore undefine it first to
allow either header to be included first. */
@@ -327,7 +356,7 @@
/* Associate error messages with the source location of the call site rather
than with the source location inside the function. */
-#if __GNUC_PREREQ (4,3)
+#if __GNUC_PREREQ (4,3) || __glibc_clang_has_attribute (__artificial__)
# define __attribute_artificial__ __attribute__ ((__artificial__))
#else
# define __attribute_artificial__ /* Ignore */
@@ -370,12 +399,14 @@
run in pedantic mode if the uses are carefully marked using the
`__extension__' keyword. But this is not generally available before
version 2.8. */
-#if !__GNUC_PREREQ (2,8)
+#if !(__GNUC_PREREQ (2,8) || defined __clang__)
# define __extension__ /* Ignore */
#endif
-/* __restrict is known in EGCS 1.2 and above. */
-#if !__GNUC_PREREQ (2,92)
+/* __restrict is known in EGCS 1.2 and above, and in clang.
+ It works also in C++ mode (outside of arrays), but only when spelled
+ as '__restrict', not 'restrict'. */
+#if !(__GNUC_PREREQ (2,92) || __clang_major__ >= 3)
# if defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L
# define __restrict restrict
# else
@@ -385,8 +416,9 @@
/* ISO C99 also allows to declare arrays as non-overlapping. The syntax is
array_name[restrict]
- GCC 3.1 supports this. */
-#if __GNUC_PREREQ (3,1) && !defined __GNUG__
+ GCC 3.1 and clang support this.
+ This syntax is not usable in C++ mode. */
+#if (__GNUC_PREREQ (3,1) || __clang_major__ >= 3) && !defined __cplusplus
# define __restrict_arr __restrict
#else
# ifdef __GNUC__
@@ -401,7 +433,7 @@
# endif
#endif
-#if __GNUC__ >= 3
+#if (__GNUC__ >= 3) || __glibc_clang_has_builtin (__builtin_expect)
# define __glibc_unlikely(cond) __builtin_expect ((cond), 0)
# define __glibc_likely(cond) __builtin_expect ((cond), 1)
#else
@@ -417,7 +449,8 @@
#if (!defined _Noreturn \
&& (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) < 201112 \
- && !__GNUC_PREREQ (4,7))
+ && !(__GNUC_PREREQ (4,7) \
+ || (3 < __clang_major__ + (5 <= __clang_minor__))))
# if __GNUC_PREREQ (2,8)
# define _Noreturn __attribute__ ((__noreturn__))
# else
@@ -436,7 +469,8 @@
#if (!defined _Static_assert && !defined __cplusplus \
&& (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) < 201112 \
- && (!__GNUC_PREREQ (4, 6) || defined __STRICT_ANSI__))
+ && (!(__GNUC_PREREQ (4, 6) || __clang_major__ >= 4) \
+ || defined __STRICT_ANSI__))
# define _Static_assert(expr, diagnostic) \
extern int (*__Static_assert_function (void)) \
[!!sizeof (struct { int __error_if_negative: (expr) ? 2 : -1; })]
diff --git a/lib/cloexec.c b/lib/cloexec.c
index 269e6f25f3b..510be3d57ec 100644
--- a/lib/cloexec.c
+++ b/lib/cloexec.c
@@ -1,7 +1,6 @@
/* cloexec.c - set or clear the close-on-exec descriptor flag
- Copyright (C) 1991, 2004-2006, 2009-2020 Free Software Foundation,
- Inc.
+ Copyright (C) 1991, 2004-2006, 2009-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
diff --git a/lib/close-stream.c b/lib/close-stream.c
index b1d04a53059..04bc8009a57 100644
--- a/lib/close-stream.c
+++ b/lib/close-stream.c
@@ -1,7 +1,6 @@
/* Close a stream, with nicer error checking than fclose's.
- Copyright (C) 1998-2002, 2004, 2006-2020 Free Software Foundation,
- Inc.
+ Copyright (C) 1998-2002, 2004, 2006-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
diff --git a/lib/count-leading-zeros.h b/lib/count-leading-zeros.h
index 2b65cc9eda9..7cf605a5f64 100644
--- a/lib/count-leading-zeros.h
+++ b/lib/count-leading-zeros.h
@@ -30,11 +30,16 @@ _GL_INLINE_HEADER_BEGIN
# define COUNT_LEADING_ZEROS_INLINE _GL_INLINE
#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/* Assuming the GCC builtin is BUILTIN and the MSC builtin is MSC_BUILTIN,
expand to code that computes the number of leading zeros of the local
variable 'x' of type TYPE (an unsigned integer type) and return it
from the current function. */
-#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)
+#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) \
+ || (__clang_major__ >= 4)
# define COUNT_LEADING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \
return x ? BUILTIN (x) : CHAR_BIT * sizeof x;
#elif _MSC_VER
@@ -100,7 +105,6 @@ count_leading_zeros_l (unsigned long int x)
COUNT_LEADING_ZEROS (__builtin_clzl, _BitScanReverse, unsigned long int);
}
-#if HAVE_UNSIGNED_LONG_LONG_INT
/* Compute and return the number of leading zeros in X. */
COUNT_LEADING_ZEROS_INLINE int
count_leading_zeros_ll (unsigned long long int x)
@@ -108,6 +112,9 @@ count_leading_zeros_ll (unsigned long long int x)
COUNT_LEADING_ZEROS (__builtin_clzll, _BitScanReverse64,
unsigned long long int);
}
+
+#ifdef __cplusplus
+}
#endif
_GL_INLINE_HEADER_END
diff --git a/lib/count-one-bits.h b/lib/count-one-bits.h
index 040776f7466..a9e166aed8c 100644
--- a/lib/count-one-bits.h
+++ b/lib/count-one-bits.h
@@ -30,29 +30,18 @@ _GL_INLINE_HEADER_BEGIN
# define COUNT_ONE_BITS_INLINE _GL_INLINE
#endif
-/* Expand to code that computes the number of 1-bits of the local
- variable 'x' of type TYPE (an unsigned integer type) and return it
- from the current function. */
-#define COUNT_ONE_BITS_GENERIC(TYPE) \
- do \
- { \
- int count = 0; \
- int bits; \
- for (bits = 0; bits < sizeof (TYPE) * CHAR_BIT; bits += 32) \
- { \
- count += count_one_bits_32 (x); \
- x = x >> 31 >> 1; \
- } \
- return count; \
- } \
- while (0)
+#ifdef __cplusplus
+extern "C" {
+#endif
-/* Assuming the GCC builtin is BUILTIN and the MSC builtin is MSC_BUILTIN,
+/* Assuming the GCC builtin is GCC_BUILTIN and the MSC builtin is MSC_BUILTIN,
expand to code that computes the number of 1-bits of the local
variable 'x' of type TYPE (an unsigned integer type) and return it
from the current function. */
-#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)
-# define COUNT_ONE_BITS(BUILTIN, MSC_BUILTIN, TYPE) return BUILTIN (x)
+#if (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) \
+ || (__clang_major__ >= 4)
+# define COUNT_ONE_BITS(GCC_BUILTIN, MSC_BUILTIN, TYPE) \
+ return GCC_BUILTIN (x)
#else
/* Compute and return the number of 1-bits set in the least
@@ -67,14 +56,46 @@ count_one_bits_32 (unsigned int x)
return (x >> 8) + (x & 0x00ff);
}
+/* Expand to code that computes the number of 1-bits of the local
+ variable 'x' of type TYPE (an unsigned integer type) and return it
+ from the current function. */
+# define COUNT_ONE_BITS_GENERIC(TYPE) \
+ do \
+ { \
+ int count = 0; \
+ int bits; \
+ for (bits = 0; bits < sizeof (TYPE) * CHAR_BIT; bits += 32) \
+ { \
+ count += count_one_bits_32 (x); \
+ x = x >> 31 >> 1; \
+ } \
+ return count; \
+ } \
+ while (0)
+
# if 1500 <= _MSC_VER && (defined _M_IX86 || defined _M_X64)
/* While gcc falls back to its own generic code if the machine
on which it's running doesn't support popcount, with Microsoft's
compiler we need to detect and fallback ourselves. */
-# pragma intrinsic __cpuid
-# pragma intrinsic __popcnt
-# pragma intrinsic __popcnt64
+
+# if 0
+# include <intrin.h>
+# else
+ /* Don't pollute the namespace with too many MSVC intrinsics. */
+# pragma intrinsic (__cpuid)
+# pragma intrinsic (__popcnt)
+# if defined _M_X64
+# pragma intrinsic (__popcnt64)
+# endif
+# endif
+
+# if !defined _M_X64
+static inline __popcnt64 (unsigned long long x)
+{
+ return __popcnt ((unsigned int) (x >> 32)) + __popcnt ((unsigned int) x);
+}
+# endif
/* Return nonzero if popcount is supported. */
@@ -86,25 +107,30 @@ popcount_supported (void)
{
if (popcount_support < 0)
{
+ /* Do as described in
+ <https://docs.microsoft.com/en-us/cpp/intrinsics/popcnt16-popcnt-popcnt64> */
int cpu_info[4];
__cpuid (cpu_info, 1);
- popcount_support = (cpu_info[2] >> 23) & 1; /* See MSDN. */
+ popcount_support = (cpu_info[2] >> 23) & 1;
}
return popcount_support;
}
-# define COUNT_ONE_BITS(BUILTIN, MSC_BUILTIN, TYPE) \
- do \
- { \
- if (popcount_supported ()) \
- return MSC_BUILTIN (x); \
- else \
- COUNT_ONE_BITS_GENERIC (TYPE); \
- } \
+# define COUNT_ONE_BITS(GCC_BUILTIN, MSC_BUILTIN, TYPE) \
+ do \
+ { \
+ if (popcount_supported ()) \
+ return MSC_BUILTIN (x); \
+ else \
+ COUNT_ONE_BITS_GENERIC (TYPE); \
+ } \
while (0)
+
# else
-# define COUNT_ONE_BITS(BUILTIN, MSC_BUILTIN, TYPE) \
+
+# define COUNT_ONE_BITS(GCC_BUILTIN, MSC_BUILTIN, TYPE) \
COUNT_ONE_BITS_GENERIC (TYPE)
+
# endif
#endif
@@ -122,13 +148,15 @@ count_one_bits_l (unsigned long int x)
COUNT_ONE_BITS (__builtin_popcountl, __popcnt, unsigned long int);
}
-#if HAVE_UNSIGNED_LONG_LONG_INT
/* Compute and return the number of 1-bits set in X. */
COUNT_ONE_BITS_INLINE int
count_one_bits_ll (unsigned long long int x)
{
COUNT_ONE_BITS (__builtin_popcountll, __popcnt64, unsigned long long int);
}
+
+#ifdef __cplusplus
+}
#endif
_GL_INLINE_HEADER_END
diff --git a/lib/count-trailing-zeros.h b/lib/count-trailing-zeros.h
index 15e85708d18..727b21dcc56 100644
--- a/lib/count-trailing-zeros.h
+++ b/lib/count-trailing-zeros.h
@@ -30,11 +30,16 @@ _GL_INLINE_HEADER_BEGIN
# define COUNT_TRAILING_ZEROS_INLINE _GL_INLINE
#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/* Assuming the GCC builtin is BUILTIN and the MSC builtin is MSC_BUILTIN,
expand to code that computes the number of trailing zeros of the local
variable 'x' of type TYPE (an unsigned integer type) and return it
from the current function. */
-#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)
+#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) \
+ || (__clang_major__ >= 4)
# define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \
return x ? BUILTIN (x) : CHAR_BIT * sizeof x;
#elif _MSC_VER
@@ -92,7 +97,6 @@ count_trailing_zeros_l (unsigned long int x)
COUNT_TRAILING_ZEROS (__builtin_ctzl, _BitScanForward, unsigned long int);
}
-#if HAVE_UNSIGNED_LONG_LONG_INT
/* Compute and return the number of trailing zeros in X. */
COUNT_TRAILING_ZEROS_INLINE int
count_trailing_zeros_ll (unsigned long long int x)
@@ -100,6 +104,9 @@ count_trailing_zeros_ll (unsigned long long int x)
COUNT_TRAILING_ZEROS (__builtin_ctzll, _BitScanForward64,
unsigned long long int);
}
+
+#ifdef __cplusplus
+}
#endif
_GL_INLINE_HEADER_END
diff --git a/lib/diffseq.h b/lib/diffseq.h
index 16e06053b43..26e10bdd043 100644
--- a/lib/diffseq.h
+++ b/lib/diffseq.h
@@ -1,7 +1,7 @@
/* Analyze differences between two vectors.
- Copyright (C) 1988-1989, 1992-1995, 2001-2004, 2006-2020 Free
- Software Foundation, Inc.
+ Copyright (C) 1988-1989, 1992-1995, 2001-2004, 2006-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
@@ -51,10 +51,14 @@
EXTRA_CONTEXT_FIELDS Declarations of fields for 'struct context'.
NOTE_DELETE(ctxt, xoff) Record the removal of the object xvec[xoff].
NOTE_INSERT(ctxt, yoff) Record the insertion of the object yvec[yoff].
+ NOTE_ORDERED (Optional) A boolean expression saying that
+ NOTE_DELETE and NOTE_INSERT calls must be
+ issued in offset order.
EARLY_ABORT(ctxt) (Optional) A boolean expression that triggers an
early abort of the computation.
USE_HEURISTIC (Optional) Define if you want to support the
heuristic for large vectors.
+
It is also possible to use this file with abstract arrays. In this case,
xvec and yvec are not represented in memory. They only exist conceptually.
In this case, the list of defines above is amended as follows:
@@ -63,6 +67,7 @@
XVECREF_YVECREF_EQUAL(ctxt, xoff, yoff)
A three-argument macro: References xvec[xoff] and
yvec[yoff] and tests these elements for equality.
+
Before including this file, you also need to include:
#include <limits.h>
#include <stdbool.h>
@@ -78,6 +83,10 @@
# define EARLY_ABORT(ctxt) false
#endif
+#ifndef NOTE_ORDERED
+# define NOTE_ORDERED false
+#endif
+
/* Use this to suppress gcc's "...may be used before initialized" warnings.
Beware: The Code argument must not contain commas. */
#ifndef IF_LINT
@@ -88,15 +97,6 @@
# endif
#endif
-/* As above, but when Code must contain one comma. */
-#ifndef IF_LINT2
-# if defined GCC_LINT || defined lint
-# define IF_LINT2(Code1, Code2) Code1, Code2
-# else
-# define IF_LINT2(Code1, Code2) /* empty */
-# endif
-#endif
-
/*
* Context of comparison operation.
*/
@@ -468,49 +468,89 @@ compareseq (OFFSET xoff, OFFSET xlim, OFFSET yoff, OFFSET ylim,
#define XREF_YREF_EQUAL(x,y) XVECREF_YVECREF_EQUAL (ctxt, x, y)
#endif
- /* Slide down the bottom initial diagonal. */
- while (xoff < xlim && yoff < ylim && XREF_YREF_EQUAL (xoff, yoff))
+ while (true)
{
- xoff++;
- yoff++;
- }
+ /* Slide down the bottom initial diagonal. */
+ while (xoff < xlim && yoff < ylim && XREF_YREF_EQUAL (xoff, yoff))
+ {
+ xoff++;
+ yoff++;
+ }
- /* Slide up the top initial diagonal. */
- while (xoff < xlim && yoff < ylim && XREF_YREF_EQUAL (xlim - 1, ylim - 1))
- {
- xlim--;
- ylim--;
- }
+ /* Slide up the top initial diagonal. */
+ while (xoff < xlim && yoff < ylim && XREF_YREF_EQUAL (xlim - 1, ylim - 1))
+ {
+ xlim--;
+ ylim--;
+ }
- /* Handle simple cases. */
- if (xoff == xlim)
- while (yoff < ylim)
- {
- NOTE_INSERT (ctxt, yoff);
- if (EARLY_ABORT (ctxt))
- return true;
- yoff++;
- }
- else if (yoff == ylim)
- while (xoff < xlim)
- {
- NOTE_DELETE (ctxt, xoff);
- if (EARLY_ABORT (ctxt))
- return true;
- xoff++;
- }
- else
- {
- struct partition part IF_LINT2 (= { .xmid = 0, .ymid = 0 });
+ /* Handle simple cases. */
+ if (xoff == xlim)
+ {
+ while (yoff < ylim)
+ {
+ NOTE_INSERT (ctxt, yoff);
+ if (EARLY_ABORT (ctxt))
+ return true;
+ yoff++;
+ }
+ break;
+ }
+ if (yoff == ylim)
+ {
+ while (xoff < xlim)
+ {
+ NOTE_DELETE (ctxt, xoff);
+ if (EARLY_ABORT (ctxt))
+ return true;
+ xoff++;
+ }
+ break;
+ }
+
+ struct partition part;
/* Find a point of correspondence in the middle of the vectors. */
diag (xoff, xlim, yoff, ylim, find_minimal, &part, ctxt);
/* Use the partitions to split this problem into subproblems. */
- if (compareseq (xoff, part.xmid, yoff, part.ymid, part.lo_minimal, ctxt))
- return true;
- if (compareseq (part.xmid, xlim, part.ymid, ylim, part.hi_minimal, ctxt))
- return true;
+ OFFSET xoff1, xlim1, yoff1, ylim1, xoff2, xlim2, yoff2, ylim2;
+ bool find_minimal1, find_minimal2;
+ if (!NOTE_ORDERED
+ && ((xlim + ylim) - (part.xmid + part.ymid)
+ < (part.xmid + part.ymid) - (xoff + yoff)))
+ {
+ /* The second problem is smaller and the caller doesn't
+ care about order, so do the second problem first to
+ lessen recursion. */
+ xoff1 = part.xmid; xlim1 = xlim;
+ yoff1 = part.ymid; ylim1 = ylim;
+ find_minimal1 = part.hi_minimal;
+
+ xoff2 = xoff; xlim2 = part.xmid;
+ yoff2 = yoff; ylim2 = part.ymid;
+ find_minimal2 = part.lo_minimal;
+ }
+ else
+ {
+ xoff1 = xoff; xlim1 = part.xmid;
+ yoff1 = yoff; ylim1 = part.ymid;
+ find_minimal1 = part.lo_minimal;
+
+ xoff2 = part.xmid; xlim2 = xlim;
+ yoff2 = part.ymid; ylim2 = ylim;
+ find_minimal2 = part.hi_minimal;
+ }
+
+ /* Recurse to do one subproblem. */
+ bool early = compareseq (xoff1, xlim1, yoff1, ylim1, find_minimal1, ctxt);
+ if (early)
+ return early;
+
+ /* Iterate to do the other subproblem. */
+ xoff = xoff2; xlim = xlim2;
+ yoff = yoff2; ylim = ylim2;
+ find_minimal = find_minimal2;
}
return false;
diff --git a/lib/dirent.in.h b/lib/dirent.in.h
index f7c26810158..23c4e055774 100644
--- a/lib/dirent.in.h
+++ b/lib/dirent.in.h
@@ -57,10 +57,12 @@ typedef struct gl_directory DIR;
/* The __attribute__ feature is available in gcc versions 2.5 and later.
The attribute __pure__ was added in gcc 2.96. */
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
-# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
-#else
-# define _GL_ATTRIBUTE_PURE /* empty */
+#ifndef _GL_ATTRIBUTE_PURE
+# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96) || defined __clang__
+# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
+# else
+# define _GL_ATTRIBUTE_PURE /* empty */
+# endif
#endif
/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
diff --git a/lib/dosname.h b/lib/dosname.h
deleted file mode 100644
index 3bb08a5eeec..00000000000
--- a/lib/dosname.h
+++ /dev/null
@@ -1,53 +0,0 @@
-/* File names on MS-DOS/Windows systems.
-
- Copyright (C) 2000-2001, 2004-2006, 2009-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/>.
-
- From Paul Eggert and Jim Meyering. */
-
-#ifndef _DOSNAME_H
-#define _DOSNAME_H
-
-#if (defined _WIN32 || defined __CYGWIN__ \
- || defined __EMX__ || defined __MSDOS__ || defined __DJGPP__)
- /* This internal macro assumes ASCII, but all hosts that support drive
- letters use ASCII. */
-# define _IS_DRIVE_LETTER(C) (((unsigned int) (C) | ('a' - 'A')) - 'a' \
- <= 'z' - 'a')
-# define FILE_SYSTEM_PREFIX_LEN(Filename) \
- (_IS_DRIVE_LETTER ((Filename)[0]) && (Filename)[1] == ':' ? 2 : 0)
-# ifndef __CYGWIN__
-# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 1
-# endif
-# define ISSLASH(C) ((C) == '/' || (C) == '\\')
-#else
-# define FILE_SYSTEM_PREFIX_LEN(Filename) 0
-# define ISSLASH(C) ((C) == '/')
-#endif
-
-#ifndef FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE
-# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 0
-#endif
-
-#if FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE
-# define IS_ABSOLUTE_FILE_NAME(F) ISSLASH ((F)[FILE_SYSTEM_PREFIX_LEN (F)])
-# else
-# define IS_ABSOLUTE_FILE_NAME(F) \
- (ISSLASH ((F)[0]) || FILE_SYSTEM_PREFIX_LEN (F) != 0)
-#endif
-#define IS_RELATIVE_FILE_NAME(F) (! IS_ABSOLUTE_FILE_NAME (F))
-
-#endif /* DOSNAME_H_ */
diff --git a/lib/dup2.c b/lib/dup2.c
index b5c3a00c740..323e19b25ec 100644
--- a/lib/dup2.c
+++ b/lib/dup2.c
@@ -1,7 +1,6 @@
/* Duplicate an open file descriptor to a specified file descriptor.
- Copyright (C) 1999, 2004-2007, 2009-2020 Free Software Foundation,
- Inc.
+ Copyright (C) 1999, 2004-2007, 2009-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
@@ -26,28 +25,26 @@
#include <errno.h>
#include <fcntl.h>
-#if HAVE_DUP2
+#undef dup2
-# undef dup2
-
-# if defined _WIN32 && ! defined __CYGWIN__
+#if defined _WIN32 && ! defined __CYGWIN__
/* Get declarations of the native Windows API functions. */
-# define WIN32_LEAN_AND_MEAN
-# include <windows.h>
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
-# if HAVE_MSVC_INVALID_PARAMETER_HANDLER
-# include "msvc-inval.h"
-# endif
+# if HAVE_MSVC_INVALID_PARAMETER_HANDLER
+# include "msvc-inval.h"
+# endif
/* Get _get_osfhandle. */
-# if GNULIB_MSVC_NOTHROW
-# include "msvc-nothrow.h"
-# else
-# include <io.h>
-# endif
+# if GNULIB_MSVC_NOTHROW
+# include "msvc-nothrow.h"
+# else
+# include <io.h>
+# endif
-# if HAVE_MSVC_INVALID_PARAMETER_HANDLER
+# if HAVE_MSVC_INVALID_PARAMETER_HANDLER
static int
dup2_nothrow (int fd, int desired_fd)
{
@@ -55,7 +52,7 @@ dup2_nothrow (int fd, int desired_fd)
TRY_MSVC_INVAL
{
- result = dup2 (fd, desired_fd);
+ result = _dup2 (fd, desired_fd);
}
CATCH_MSVC_INVAL
{
@@ -66,9 +63,9 @@ dup2_nothrow (int fd, int desired_fd)
return result;
}
-# else
-# define dup2_nothrow dup2
-# endif
+# else
+# define dup2_nothrow _dup2
+# endif
static int
ms_windows_dup2 (int fd, int desired_fd)
@@ -104,11 +101,11 @@ ms_windows_dup2 (int fd, int desired_fd)
return result;
}
-# define dup2 ms_windows_dup2
+# define dup2 ms_windows_dup2
-# elif defined __KLIBC__
+#elif defined __KLIBC__
-# include <InnoTekLIBC/backend.h>
+# include <InnoTekLIBC/backend.h>
static int
klibc_dup2dirfd (int fd, int desired_fd)
@@ -156,81 +153,37 @@ klibc_dup2 (int fd, int desired_fd)
return dupfd;
}
-# define dup2 klibc_dup2
-# endif
+# define dup2 klibc_dup2
+#endif
int
rpl_dup2 (int fd, int desired_fd)
{
int result;
-# ifdef F_GETFL
+#ifdef F_GETFL
/* On Linux kernels 2.6.26-2.6.29, dup2 (fd, fd) returns -EBADF.
On Cygwin 1.5.x, dup2 (1, 1) returns 0.
On Cygwin 1.7.17, dup2 (1, -1) dumps core.
On Cygwin 1.7.25, dup2 (1, 256) can dump core.
On Haiku, dup2 (fd, fd) mistakenly clears FD_CLOEXEC. */
-# if HAVE_SETDTABLESIZE
+# if HAVE_SETDTABLESIZE
setdtablesize (desired_fd + 1);
-# endif
+# endif
if (desired_fd < 0)
fd = desired_fd;
if (fd == desired_fd)
return fcntl (fd, F_GETFL) == -1 ? -1 : fd;
-# endif
+#endif
result = dup2 (fd, desired_fd);
/* Correct an errno value on FreeBSD 6.1 and Cygwin 1.5.x. */
if (result == -1 && errno == EMFILE)
errno = EBADF;
-# if REPLACE_FCHDIR
+#if REPLACE_FCHDIR
if (fd != desired_fd && result != -1)
result = _gl_register_dup (fd, result);
-# endif
- return result;
-}
-
-#else /* !HAVE_DUP2 */
-
-/* On older platforms, dup2 did not exist. */
-
-# ifndef F_DUPFD
-static int
-dupfd (int fd, int desired_fd)
-{
- int duplicated_fd = dup (fd);
- if (duplicated_fd < 0 || duplicated_fd == desired_fd)
- return duplicated_fd;
- else
- {
- int r = dupfd (fd, desired_fd);
- int e = errno;
- close (duplicated_fd);
- errno = e;
- return r;
- }
-}
-# endif
-
-int
-dup2 (int fd, int desired_fd)
-{
- int result = fcntl (fd, F_GETFL) < 0 ? -1 : fd;
- if (result == -1 || fd == desired_fd)
- return result;
- close (desired_fd);
-# ifdef F_DUPFD
- result = fcntl (fd, F_DUPFD, desired_fd);
-# if REPLACE_FCHDIR
- if (0 <= result)
- result = _gl_register_dup (fd, result);
-# endif
-# else
- result = dupfd (fd, desired_fd);
-# endif
- if (result == -1 && (errno == EMFILE || errno == EINVAL))
- errno = EBADF;
+#endif
return result;
}
-#endif /* !HAVE_DUP2 */
diff --git a/lib/explicit_bzero.c b/lib/explicit_bzero.c
index c82771fb1e3..b1f5acb7771 100644
--- a/lib/explicit_bzero.c
+++ b/lib/explicit_bzero.c
@@ -25,8 +25,18 @@
# include <config.h>
#endif
+/* memset_s need this define */
+#if HAVE_MEMSET_S
+# define __STDC_WANT_LIB_EXT1__ 1
+#endif
+
#include <string.h>
+#if defined _WIN32 && !defined __CYGWIN__
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+#endif
+
#if _LIBC
/* glibc-internal users use __explicit_bzero_chk, and explicit_bzero
redirects to that. */
@@ -38,8 +48,12 @@
void
explicit_bzero (void *s, size_t len)
{
-#ifdef HAVE_EXPLICIT_MEMSET
- explicit_memset (s, 0, len);
+#if defined _WIN32 && !defined __CYGWIN__
+ (void) SecureZeroMemory (s, len);
+#elif HAVE_EXPLICIT_MEMSET
+ explicit_memset (s, '\0', len);
+#elif HAVE_MEMSET_S
+ (void) memset_s (s, len, '\0', len);
#else
memset (s, '\0', len);
# if defined __GNUC__ && !defined __clang__
diff --git a/lib/fchmodat.c b/lib/fchmodat.c
new file mode 100644
index 00000000000..eee0a1c56e4
--- /dev/null
+++ b/lib/fchmodat.c
@@ -0,0 +1,144 @@
+/* Change the protections of file relative to an open directory.
+ Copyright (C) 2006, 2009-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 Jim Meyering and Paul Eggert */
+
+/* If the user's config.h happens to include <sys/stat.h>, let it include only
+ the system's <sys/stat.h> here, so that orig_fchmodat doesn't recurse to
+ rpl_fchmodat. */
+#define __need_system_sys_stat_h
+#include <config.h>
+
+/* Specification. */
+#include <sys/stat.h>
+#undef __need_system_sys_stat_h
+
+#if HAVE_FCHMODAT
+static int
+orig_fchmodat (int dir, char const *file, mode_t mode, int flags)
+{
+ return fchmodat (dir, file, mode, flags);
+}
+#endif
+
+#include <errno.h>
+#include <fcntl.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+#ifdef __osf__
+/* Write "sys/stat.h" here, not <sys/stat.h>, otherwise OSF/1 5.1 DTK cc
+ eliminates this include because of the preliminary #include <sys/stat.h>
+ above. */
+# include "sys/stat.h"
+#else
+# include <sys/stat.h>
+#endif
+
+#include <intprops.h>
+
+/* Invoke chmod or lchmod on FILE, using mode MODE, in the directory
+ open on descriptor FD. If possible, do it without changing the
+ working directory. Otherwise, resort to using save_cwd/fchdir,
+ then (chmod|lchmod)/restore_cwd. If either the save_cwd or the
+ restore_cwd fails, then give a diagnostic and exit nonzero.
+ Note that an attempt to use a FLAG value of AT_SYMLINK_NOFOLLOW
+ on a system without lchmod support causes this function to fail. */
+
+#if HAVE_FCHMODAT
+int
+fchmodat (int dir, char const *file, mode_t mode, int flags)
+{
+# if NEED_FCHMODAT_NONSYMLINK_FIX
+ if (flags == AT_SYMLINK_NOFOLLOW)
+ {
+ struct stat st;
+
+# if defined O_PATH && defined AT_EMPTY_PATH
+ /* Open a file descriptor with O_NOFOLLOW, to make sure we don't
+ follow symbolic links, if /proc is mounted. O_PATH is used to
+ avoid a failure if the file is not readable.
+ Cf. <https://sourceware.org/bugzilla/show_bug.cgi?id=14578> */
+ int fd = openat (dir, file, O_PATH | O_NOFOLLOW | O_CLOEXEC);
+ if (fd < 0)
+ return fd;
+
+ /* Up to Linux 5.3 at least, when FILE refers to a symbolic link, the
+ chmod call below will change the permissions of the symbolic link
+ - which is undesired - and on many file systems (ext4, btrfs, jfs,
+ xfs, ..., but not reiserfs) fail with error EOPNOTSUPP - which is
+ misleading. Therefore test for a symbolic link explicitly.
+ Use fstatat because fstat does not work on O_PATH descriptors
+ before Linux 3.6. */
+ if (fstatat (fd, "", &st, AT_EMPTY_PATH) != 0)
+ {
+ int stat_errno = errno;
+ close (fd);
+ errno = stat_errno;
+ return -1;
+ }
+ if (S_ISLNK (st.st_mode))
+ {
+ close (fd);
+ errno = EOPNOTSUPP;
+ return -1;
+ }
+
+# if defined __linux__ || defined __ANDROID__ || defined __CYGWIN__
+ static char const fmt[] = "/proc/self/fd/%d";
+ char buf[sizeof fmt - sizeof "%d" + INT_BUFSIZE_BOUND (int)];
+ sprintf (buf, fmt, fd);
+ int chmod_result = chmod (buf, mode);
+ int chmod_errno = errno;
+ close (fd);
+ if (chmod_result == 0)
+ return chmod_result;
+ if (chmod_errno != ENOENT)
+ {
+ errno = chmod_errno;
+ return chmod_result;
+ }
+# endif
+ /* /proc is not mounted or would not work as in GNU/Linux. */
+
+# else
+ int fstatat_result = fstatat (dir, file, &st, AT_SYMLINK_NOFOLLOW);
+ if (fstatat_result != 0)
+ return fstatat_result;
+ if (S_ISLNK (st.st_mode))
+ {
+ errno = EOPNOTSUPP;
+ return -1;
+ }
+# endif
+
+ /* Fall back on orig_fchmodat with no flags, despite a possible race. */
+ flags = 0;
+ }
+# endif
+
+ return orig_fchmodat (dir, file, mode, flags);
+}
+#else
+# define AT_FUNC_NAME fchmodat
+# define AT_FUNC_F1 lchmod
+# define AT_FUNC_F2 chmod
+# define AT_FUNC_USE_F1_COND AT_SYMLINK_NOFOLLOW
+# define AT_FUNC_POST_FILE_PARAM_DECLS , mode_t mode, int flag
+# define AT_FUNC_POST_FILE_ARGS , mode
+# include "at-func.c"
+#endif
diff --git a/lib/fcntl.c b/lib/fcntl.c
index 6b9927ec4e5..8cd1531527d 100644
--- a/lib/fcntl.c
+++ b/lib/fcntl.c
@@ -70,14 +70,14 @@ dupfd (int oldfd, int newfd, int flags)
return -1;
}
if (old_handle == INVALID_HANDLE_VALUE
- || (mode = setmode (oldfd, O_BINARY)) == -1)
+ || (mode = _setmode (oldfd, O_BINARY)) == -1)
{
/* oldfd is not open, or is an unassigned standard file
descriptor. */
errno = EBADF;
return -1;
}
- setmode (oldfd, mode);
+ _setmode (oldfd, mode);
flags |= mode;
for (;;)
diff --git a/lib/fcntl.in.h b/lib/fcntl.in.h
index b2e1e5130d9..6f16bc66921 100644
--- a/lib/fcntl.in.h
+++ b/lib/fcntl.in.h
@@ -97,6 +97,12 @@
_GL_FUNCDECL_RPL (creat, int, (const char *filename, mode_t mode)
_GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_RPL (creat, int, (const char *filename, mode_t mode));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef creat
+# define creat _creat
+# endif
+_GL_CXXALIAS_MDA (creat, int, (const char *filename, mode_t mode));
# else
_GL_CXXALIAS_SYS (creat, int, (const char *filename, mode_t mode));
# endif
@@ -106,6 +112,9 @@ _GL_CXXALIASWARN (creat);
/* Assume creat is always declared. */
_GL_WARN_ON_USE (creat, "creat is not always POSIX compliant - "
"use gnulib module creat for portability");
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef creat
+# define creat _creat
#endif
#if @GNULIB_FCNTL@
@@ -116,9 +125,15 @@ _GL_WARN_ON_USE (creat, "creat is not always POSIX compliant - "
# endif
_GL_FUNCDECL_RPL (fcntl, int, (int fd, int action, ...));
_GL_CXXALIAS_RPL (fcntl, int, (int fd, int action, ...));
+# if !GNULIB_defined_rpl_fcntl
+# define GNULIB_defined_rpl_fcntl 1
+# endif
# else
# if !@HAVE_FCNTL@
_GL_FUNCDECL_SYS (fcntl, int, (int fd, int action, ...));
+# if !GNULIB_defined_fcntl
+# define GNULIB_defined_fcntl 1
+# endif
# endif
_GL_CXXALIAS_SYS (fcntl, int, (int fd, int action, ...));
# endif
@@ -140,6 +155,12 @@ _GL_WARN_ON_USE (fcntl, "fcntl is not always POSIX compliant - "
_GL_FUNCDECL_RPL (open, int, (const char *filename, int flags, ...)
_GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_RPL (open, int, (const char *filename, int flags, ...));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef open
+# define open _open
+# endif
+_GL_CXXALIAS_MDA (open, int, (const char *filename, int flags, ...));
# else
_GL_CXXALIAS_SYS (open, int, (const char *filename, int flags, ...));
# endif
@@ -153,6 +174,9 @@ _GL_CXXALIASWARN (open);
/* Assume open is always declared. */
_GL_WARN_ON_USE (open, "open is not always POSIX compliant - "
"use gnulib module open for portability");
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef open
+# define open _open
#endif
#if @GNULIB_OPENAT@
diff --git a/lib/filemode.h b/lib/filemode.h
index 8b8464f220a..f84a491625c 100644
--- a/lib/filemode.h
+++ b/lib/filemode.h
@@ -1,7 +1,7 @@
/* Make a string describing file modes.
- Copyright (C) 1998-1999, 2003, 2006, 2009-2020 Free Software
- Foundation, Inc.
+ Copyright (C) 1998-1999, 2003, 2006, 2009-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
diff --git a/lib/filename.h b/lib/filename.h
new file mode 100644
index 00000000000..4598fb1d638
--- /dev/null
+++ b/lib/filename.h
@@ -0,0 +1,110 @@
+/* Basic filename support macros.
+ Copyright (C) 2001-2004, 2007-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/>. */
+
+/* From Paul Eggert and Jim Meyering. */
+
+#ifndef _FILENAME_H
+#define _FILENAME_H
+
+#include <string.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* Filename support.
+ ISSLASH(C) tests whether C is a directory separator
+ character.
+ HAS_DEVICE(Filename) tests whether Filename contains a device
+ specification.
+ FILE_SYSTEM_PREFIX_LEN(Filename) length of the device specification
+ at the beginning of Filename,
+ index of the part consisting of
+ alternating components and slashes.
+ FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE
+ 1 when a non-empty device specification
+ can be followed by an empty or relative
+ part,
+ 0 when a non-empty device specification
+ must be followed by a slash,
+ 0 when device specification don't exist.
+ IS_ABSOLUTE_FILE_NAME(Filename)
+ tests whether Filename is independent of
+ any notion of "current directory".
+ IS_RELATIVE_FILE_NAME(Filename)
+ tests whether Filename may be concatenated
+ to a directory filename.
+ Note: On native Windows, OS/2, DOS, "c:" is neither an absolute nor a
+ relative file name!
+ IS_FILE_NAME_WITH_DIR(Filename) tests whether Filename contains a device
+ or directory specification.
+ */
+#if defined _WIN32 || defined __CYGWIN__ \
+ || defined __EMX__ || defined __MSDOS__ || defined __DJGPP__
+ /* Native Windows, Cygwin, OS/2, DOS */
+# define ISSLASH(C) ((C) == '/' || (C) == '\\')
+ /* Internal macro: Tests whether a character is a drive letter. */
+# define _IS_DRIVE_LETTER(C) \
+ (((C) >= 'A' && (C) <= 'Z') || ((C) >= 'a' && (C) <= 'z'))
+ /* Help the compiler optimizing it. This assumes ASCII. */
+# undef _IS_DRIVE_LETTER
+# define _IS_DRIVE_LETTER(C) \
+ (((unsigned int) (C) | ('a' - 'A')) - 'a' <= 'z' - 'a')
+# define HAS_DEVICE(Filename) \
+ (_IS_DRIVE_LETTER ((Filename)[0]) && (Filename)[1] == ':')
+# define FILE_SYSTEM_PREFIX_LEN(Filename) (HAS_DEVICE (Filename) ? 2 : 0)
+# ifdef __CYGWIN__
+# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 0
+# else
+ /* On native Windows, OS/2, DOS, the system has the notion of a
+ "current directory" on each drive. */
+# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 1
+# endif
+# if FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE
+# define IS_ABSOLUTE_FILE_NAME(Filename) \
+ ISSLASH ((Filename)[FILE_SYSTEM_PREFIX_LEN (Filename)])
+# else
+# define IS_ABSOLUTE_FILE_NAME(Filename) \
+ (ISSLASH ((Filename)[0]) || HAS_DEVICE (Filename))
+# endif
+# define IS_RELATIVE_FILE_NAME(Filename) \
+ (! (ISSLASH ((Filename)[0]) || HAS_DEVICE (Filename)))
+# define IS_FILE_NAME_WITH_DIR(Filename) \
+ (strchr ((Filename), '/') != NULL || strchr ((Filename), '\\') != NULL \
+ || HAS_DEVICE (Filename))
+#else
+ /* Unix */
+# define ISSLASH(C) ((C) == '/')
+# define HAS_DEVICE(Filename) ((void) (Filename), 0)
+# define FILE_SYSTEM_PREFIX_LEN(Filename) ((void) (Filename), 0)
+# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 0
+# define IS_ABSOLUTE_FILE_NAME(Filename) ISSLASH ((Filename)[0])
+# define IS_RELATIVE_FILE_NAME(Filename) (! ISSLASH ((Filename)[0]))
+# define IS_FILE_NAME_WITH_DIR(Filename) (strchr ((Filename), '/') != NULL)
+#endif
+
+/* Deprecated macros. For backward compatibility with old users of the
+ 'filename' module. */
+#define IS_ABSOLUTE_PATH IS_ABSOLUTE_FILE_NAME
+#define IS_PATH_WITH_DIR IS_FILE_NAME_WITH_DIR
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _FILENAME_H */
diff --git a/lib/fpending.c b/lib/fpending.c
index 4db32eafd6a..802ebcba654 100644
--- a/lib/fpending.c
+++ b/lib/fpending.c
@@ -1,6 +1,6 @@
/* fpending.c -- return the number of pending output bytes on a stream
- Copyright (C) 2000, 2004, 2006-2007, 2009-2020 Free Software
- Foundation, Inc.
+ Copyright (C) 2000, 2004, 2006-2007, 2009-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
diff --git a/lib/fpending.h b/lib/fpending.h
index 52639379975..a8b8859726d 100644
--- a/lib/fpending.h
+++ b/lib/fpending.h
@@ -1,7 +1,7 @@
/* Declare __fpending.
- Copyright (C) 2000, 2003, 2005-2006, 2009-2020 Free Software
- Foundation, Inc.
+ Copyright (C) 2000, 2003, 2005-2006, 2009-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
diff --git a/lib/fsusage.c b/lib/fsusage.c
index c0ee4533f9a..85bfe0e2837 100644
--- a/lib/fsusage.c
+++ b/lib/fsusage.c
@@ -1,7 +1,7 @@
/* fsusage.c -- return space usage of mounted file systems
- Copyright (C) 1991-1992, 1996, 1998-1999, 2002-2006, 2009-2020 Free
- Software Foundation, Inc.
+ Copyright (C) 1991-1992, 1996, 1998-1999, 2002-2006, 2009-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
@@ -211,11 +211,7 @@ get_fs_usage (char const *file, char const *disk, struct fs_usage *fsp)
/* Empirically, the block counts on most SVR3 and SVR3-derived
systems seem to always be in terms of 512-byte blocks,
no matter what value f_bsize has. */
-# if defined _CRAY
- fsp->fsu_blocksize = PROPAGATE_ALL_ONES (fsd.f_bsize);
-# else
fsp->fsu_blocksize = 512;
-# endif
#endif
diff --git a/lib/ftoastr.c b/lib/ftoastr.c
index 7a7d4113c22..47a83152e3f 100644
--- a/lib/ftoastr.c
+++ b/lib/ftoastr.c
@@ -33,20 +33,28 @@
#include <stdio.h>
#include <stdlib.h>
+#ifdef C_LOCALE
+# include "c-snprintf.h"
+# include "c-strtod.h"
+# define PREFIX(name) c_ ## name
+#else
+# define PREFIX(name) name
+#endif
+
#if LENGTH == 3
# define FLOAT long double
# define FLOAT_DIG LDBL_DIG
# define FLOAT_MIN LDBL_MIN
# define FLOAT_PREC_BOUND _GL_LDBL_PREC_BOUND
-# define FTOASTR ldtoastr
+# define FTOASTR PREFIX (ldtoastr)
# define PROMOTED_FLOAT long double
-# define STRTOF strtold
+# define STRTOF PREFIX (strtold)
#elif LENGTH == 2
# define FLOAT double
# define FLOAT_DIG DBL_DIG
# define FLOAT_MIN DBL_MIN
# define FLOAT_PREC_BOUND _GL_DBL_PREC_BOUND
-# define FTOASTR dtoastr
+# define FTOASTR PREFIX (dtoastr)
# define PROMOTED_FLOAT double
#else
# define LENGTH 1
@@ -54,7 +62,7 @@
# define FLOAT_DIG FLT_DIG
# define FLOAT_MIN FLT_MIN
# define FLOAT_PREC_BOUND _GL_FLT_PREC_BOUND
-# define FTOASTR ftoastr
+# define FTOASTR PREFIX (ftoastr)
# define PROMOTED_FLOAT double
# if HAVE_STRTOF
# define STRTOF strtof
@@ -65,13 +73,16 @@
may generate one or two extra digits, but that's better than not
working at all. */
#ifndef STRTOF
-# define STRTOF strtod
+# define STRTOF PREFIX (strtod)
#endif
/* On hosts where it's not known that snprintf works, use sprintf to
implement the subset needed here. Typically BUFSIZE is big enough
and there's little or no performance hit. */
-#if ! GNULIB_SNPRINTF
+#ifdef C_LOCALE
+# undef snprintf
+# define snprintf c_snprintf
+#elif ! GNULIB_SNPRINTF
# undef snprintf
# define snprintf ftoastr_snprintf
static int
diff --git a/lib/ftoastr.h b/lib/ftoastr.h
index d945cc064a7..78b569f3d97 100644
--- a/lib/ftoastr.h
+++ b/lib/ftoastr.h
@@ -18,6 +18,7 @@
/* Written by Paul Eggert. */
#ifndef _GL_FTOASTR_H
+#define _GL_FTOASTR_H
#include "intprops.h"
#include <float.h>
@@ -48,6 +49,12 @@ int ftoastr (char *buf, size_t bufsize, int flags, int width, float x);
int dtoastr (char *buf, size_t bufsize, int flags, int width, double x);
int ldtoastr (char *buf, size_t bufsize, int flags, int width, long double x);
+/* The last two functions except that the formatting takes place in
+ the C locale. */
+int c_dtoastr (char *buf, size_t bufsize, int flags, int width, double x);
+int c_ldtoastr (char *buf, size_t bufsize, int flags, int width, long double x);
+
+
/* Flag values for ftoastr etc. These can be ORed together. */
enum
{
diff --git a/lib/futimens.c b/lib/futimens.c
new file mode 100644
index 00000000000..83fb27cb6aa
--- /dev/null
+++ b/lib/futimens.c
@@ -0,0 +1,37 @@
+/* Set the access and modification time of an open fd.
+ Copyright (C) 2009-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 Eric Blake */
+
+#include <config.h>
+
+#include <sys/stat.h>
+
+#include "utimens.h"
+
+/* Set the access and modification timestamps of FD to be
+ TIMESPEC[0] and TIMESPEC[1], respectively.
+ Fail with ENOSYS on systems without futimes (or equivalent).
+ If TIMESPEC is null, set the timestamps to the current time.
+ Return 0 on success, -1 (setting errno) on failure. */
+int
+futimens (int fd, struct timespec const times[2])
+{
+ /* fdutimens also works around bugs in native futimens, when running
+ with glibc compiled against newer headers but on a Linux kernel
+ older than 2.6.32. */
+ return fdutimens (fd, NULL, times);
+}
diff --git a/lib/getgroups.c b/lib/getgroups.c
index b1ec68dadf9..4396b4d64b7 100644
--- a/lib/getgroups.c
+++ b/lib/getgroups.c
@@ -1,7 +1,6 @@
/* provide consistent interface to getgroups for systems that don't allow N==0
- Copyright (C) 1996, 1999, 2003, 2006-2020 Free Software Foundation,
- Inc.
+ Copyright (C) 1996, 1999, 2003, 2006-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
diff --git a/lib/getloadavg.c b/lib/getloadavg.c
index 507017339cc..468e2506709 100644
--- a/lib/getloadavg.c
+++ b/lib/getloadavg.c
@@ -1,7 +1,7 @@
/* Get the system load averages.
- Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2020 Free
- Software Foundation, Inc.
+ Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2020 Free Software
+ Foundation, Inc.
NOTE: The canonical source of this file is maintained with gnulib.
Bugs can be reported to bug-gnulib@gnu.org.
@@ -512,7 +512,7 @@ getloadavg (double loadavg[], int nelem)
char const *ptr = ldavgbuf;
int fd, count, saved_errno;
- fd = open (LINUX_LDAV_FILE, O_RDONLY);
+ fd = open (LINUX_LDAV_FILE, O_RDONLY | O_CLOEXEC);
if (fd == -1)
return -1;
count = read (fd, ldavgbuf, sizeof ldavgbuf - 1);
@@ -550,7 +550,7 @@ getloadavg (double loadavg[], int nelem)
for (ptr++; '0' <= *ptr && *ptr <= '9'; ptr++)
numerator = 10 * numerator + (*ptr - '0'), denominator *= 10;
- loadavg[elem++] = numerator / denominator;
+ loadavg[elem] = numerator / denominator;
}
return elem;
@@ -567,15 +567,22 @@ getloadavg (double loadavg[], int nelem)
unsigned long int load_ave[3], scale;
int count;
- FILE *fp;
-
- fp = fopen (NETBSD_LDAV_FILE, "r");
- if (fp == NULL)
- return -1;
- count = fscanf (fp, "%lu %lu %lu %lu\n",
+ char readbuf[4 * INT_BUFSIZE_BOUND (unsigned long int) + 1];
+ int fd = open (NETBSD_LDAV_FILE, O_RDONLY | O_CLOEXEC);
+ if (fd < 0)
+ return fd;
+ int nread = read (fd, readbuf, sizeof readbuf - 1);
+ int err = errno;
+ close (fd);
+ if (nread < 0)
+ {
+ errno = err;
+ return -1;
+ }
+ readbuf[nread] = '\0';
+ count = sscanf (readbuf, "%lu %lu %lu %lu\n",
&load_ave[0], &load_ave[1], &load_ave[2],
&scale);
- (void) fclose (fp);
if (count != 4)
{
errno = ENOTSUP;
@@ -869,27 +876,11 @@ getloadavg (double loadavg[], int nelem)
if (!getloadavg_initialized)
{
# ifndef SUNOS_5
- /* Set the channel to close on exec, so it does not
- litter any child's descriptor table. */
-# ifndef O_CLOEXEC
-# define O_CLOEXEC 0
-# endif
int fd = open ("/dev/kmem", O_RDONLY | O_CLOEXEC);
if (0 <= fd)
{
-# if F_DUPFD_CLOEXEC
- if (fd <= STDERR_FILENO)
- {
- int fd1 = fcntl (fd, F_DUPFD_CLOEXEC, STDERR_FILENO + 1);
- close (fd);
- fd = fd1;
- }
-# endif
- if (0 <= fd)
- {
- channel = fd;
- getloadavg_initialized = true;
- }
+ channel = fd;
+ getloadavg_initialized = true;
}
# else /* SUNOS_5 */
/* We pass 0 for the kernel, corefile, and swapfile names
diff --git a/lib/getopt-cdefs.in.h b/lib/getopt-cdefs.in.h
index c510ab163c3..674838c666a 100644
--- a/lib/getopt-cdefs.in.h
+++ b/lib/getopt-cdefs.in.h
@@ -57,7 +57,7 @@
#endif
#ifndef __THROW
-# if defined __cplusplus && __GNUC_PREREQ (2,8)
+# if defined __cplusplus && (__GNUC_PREREQ (2,8) || __clang_major__ >= 4)
# define __THROW throw ()
# else
# define __THROW
diff --git a/lib/getopt-pfx-core.h b/lib/getopt-pfx-core.h
index da0a6d0c3c4..ec545c1b51c 100644
--- a/lib/getopt-pfx-core.h
+++ b/lib/getopt-pfx-core.h
@@ -48,6 +48,14 @@
# define optind __GETOPT_ID (optind)
# define optopt __GETOPT_ID (optopt)
+/* Work around a a problem on macOS, which declares getopt with a
+ trailing __DARWIN_ALIAS(getopt) that would expand to something like
+ __asm("_" "rpl_getopt" "$UNIX2003") were it not for the following
+ hack to suppress the macOS declaration <https://bugs.gnu.org/40205>. */
+# ifdef __APPLE__
+# define _GETOPT
+# endif
+
/* The system's getopt.h may have already included getopt-core.h to
declare the unprefixed identifiers. Undef _GETOPT_CORE_H so that
getopt-core.h declares them with prefixes. */
diff --git a/lib/getrandom.c b/lib/getrandom.c
new file mode 100644
index 00000000000..f8695abf30a
--- /dev/null
+++ b/lib/getrandom.c
@@ -0,0 +1,187 @@
+/* Obtain a series of random bytes.
+
+ Copyright 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. */
+
+#include <config.h>
+
+#include <sys/random.h>
+
+#include <errno.h>
+#include <fcntl.h>
+#include <stdbool.h>
+#include <unistd.h>
+
+#if defined _WIN32 && ! defined __CYGWIN__
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+# if HAVE_BCRYPT_H
+# include <bcrypt.h>
+# else
+# define NTSTATUS LONG
+typedef void * BCRYPT_ALG_HANDLE;
+# define BCRYPT_USE_SYSTEM_PREFERRED_RNG 0x00000002
+# if HAVE_LIB_BCRYPT
+extern NTSTATUS WINAPI BCryptGenRandom (BCRYPT_ALG_HANDLE, UCHAR *, ULONG, ULONG);
+# endif
+# endif
+# if !HAVE_LIB_BCRYPT
+# include <wincrypt.h>
+# ifndef CRYPT_VERIFY_CONTEXT
+# define CRYPT_VERIFY_CONTEXT 0xF0000000
+# endif
+# endif
+#endif
+
+#include "minmax.h"
+
+#if defined _WIN32 && ! defined __CYGWIN__
+
+/* Don't assume that UNICODE is not defined. */
+# undef LoadLibrary
+# define LoadLibrary LoadLibraryA
+# undef CryptAcquireContext
+# define CryptAcquireContext CryptAcquireContextA
+
+# if !HAVE_LIB_BCRYPT
+
+/* Avoid warnings from gcc -Wcast-function-type. */
+# define GetProcAddress \
+ (void *) GetProcAddress
+
+/* BCryptGenRandom with the BCRYPT_USE_SYSTEM_PREFERRED_RNG flag works only
+ starting with Windows 7. */
+typedef NTSTATUS (WINAPI * BCryptGenRandomFuncType) (BCRYPT_ALG_HANDLE, UCHAR *, ULONG, ULONG);
+static BCryptGenRandomFuncType BCryptGenRandomFunc = NULL;
+static BOOL initialized = FALSE;
+
+static void
+initialize (void)
+{
+ HMODULE bcrypt = LoadLibrary ("bcrypt.dll");
+ if (bcrypt != NULL)
+ {
+ BCryptGenRandomFunc =
+ (BCryptGenRandomFuncType) GetProcAddress (bcrypt, "BCryptGenRandom");
+ }
+ initialized = TRUE;
+}
+
+# else
+
+# define BCryptGenRandomFunc BCryptGenRandom
+
+# endif
+
+#else
+/* These devices exist on all platforms except native Windows. */
+
+/* Name of a device through which the kernel returns high quality random
+ numbers, from an entropy pool. When the pool is empty, the call blocks
+ until entropy sources have added enough bits of entropy. */
+# ifndef NAME_OF_RANDOM_DEVICE
+# define NAME_OF_RANDOM_DEVICE "/dev/random"
+# endif
+
+/* Name of a device through which the kernel returns random or pseudo-random
+ numbers. It uses an entropy pool, but, in order to avoid blocking, adds
+ bits generated by a pseudo-random number generator, as needed. */
+# ifndef NAME_OF_NONCE_DEVICE
+# define NAME_OF_NONCE_DEVICE "/dev/urandom"
+# endif
+
+#endif
+
+/* Set BUFFER (of size LENGTH) to random bytes under the control of FLAGS.
+ Return the number of bytes written (> 0).
+ Upon error, return -1 and set errno. */
+ssize_t
+getrandom (void *buffer, size_t length, unsigned int flags)
+#undef getrandom
+{
+#if defined _WIN32 && ! defined __CYGWIN__
+ /* BCryptGenRandom, defined in <bcrypt.h>
+ <https://docs.microsoft.com/en-us/windows/win32/api/bcrypt/nf-bcrypt-bcryptgenrandom>
+ with the BCRYPT_USE_SYSTEM_PREFERRED_RNG flag
+ works in Windows 7 and newer. */
+ static int bcrypt_not_working /* = 0 */;
+ if (!bcrypt_not_working)
+ {
+# if !HAVE_LIB_BCRYPT
+ if (!initialized)
+ initialize ();
+# endif
+ if (BCryptGenRandomFunc != NULL
+ && BCryptGenRandomFunc (NULL, buffer, length,
+ BCRYPT_USE_SYSTEM_PREFERRED_RNG)
+ == 0 /*STATUS_SUCCESS*/)
+ return length;
+ bcrypt_not_working = 1;
+ }
+# if !HAVE_LIB_BCRYPT
+ /* CryptGenRandom, defined in <wincrypt.h>
+ <https://docs.microsoft.com/en-us/windows/win32/api/wincrypt/nf-wincrypt-cryptgenrandom>
+ works in older releases as well, but is now deprecated.
+ CryptAcquireContext, defined in <wincrypt.h>
+ <https://docs.microsoft.com/en-us/windows/win32/api/wincrypt/nf-wincrypt-cryptacquirecontexta> */
+ {
+ static int crypt_initialized /* = 0 */;
+ static HCRYPTPROV provider;
+ if (!crypt_initialized)
+ {
+ if (CryptAcquireContext (&provider, NULL, NULL, PROV_RSA_FULL,
+ CRYPT_VERIFY_CONTEXT))
+ crypt_initialized = 1;
+ else
+ crypt_initialized = -1;
+ }
+ if (crypt_initialized >= 0)
+ {
+ if (!CryptGenRandom (provider, length, buffer))
+ {
+ errno = EIO;
+ return -1;
+ }
+ return length;
+ }
+ }
+# endif
+ errno = ENOSYS;
+ return -1;
+#elif HAVE_GETRANDOM
+ return getrandom (buffer, length, flags);
+#else
+ static int randfd[2] = { -1, -1 };
+ bool devrandom = (flags & GRND_RANDOM) != 0;
+ int fd = randfd[devrandom];
+
+ if (fd < 0)
+ {
+ static char const randdevice[][MAX (sizeof NAME_OF_NONCE_DEVICE,
+ sizeof NAME_OF_RANDOM_DEVICE)]
+ = { NAME_OF_NONCE_DEVICE, NAME_OF_RANDOM_DEVICE };
+ int oflags = (O_RDONLY + O_CLOEXEC
+ + (flags & GRND_NONBLOCK ? O_NONBLOCK : 0));
+ fd = open (randdevice[devrandom], oflags);
+ if (fd < 0)
+ return fd;
+ randfd[devrandom] = fd;
+ }
+
+ return read (fd, buffer, length);
+#endif
+}
diff --git a/lib/gettext.h b/lib/gettext.h
index 4c6b5efcc3f..0bd1e13348a 100644
--- a/lib/gettext.h
+++ b/lib/gettext.h
@@ -1,6 +1,6 @@
/* Convenience header for conditional use of GNU <libintl.h>.
- Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2020 Free
- Software Foundation, Inc.
+ Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-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
diff --git a/lib/gettime.c b/lib/gettime.c
index f212a238a88..f5b8ca53b5f 100644
--- a/lib/gettime.c
+++ b/lib/gettime.c
@@ -1,7 +1,6 @@
/* gettime -- get the system clock
- Copyright (C) 2002, 2004-2007, 2009-2020 Free Software Foundation,
- Inc.
+ Copyright (C) 2002, 2004-2007, 2009-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
diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c
index b5e2c300305..5301e7c144a 100644
--- a/lib/gettimeofday.c
+++ b/lib/gettimeofday.c
@@ -1,7 +1,6 @@
/* Provide gettimeofday for systems that don't have it or for which it's broken.
- Copyright (C) 2001-2003, 2005-2007, 2009-2020 Free Software
- Foundation, Inc.
+ Copyright (C) 2001-2003, 2005-2007, 2009-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
@@ -30,13 +29,17 @@
# include <windows.h>
#endif
-#include "localtime-buffer.h"
-
#ifdef WINDOWS_NATIVE
+/* Don't assume that UNICODE is not defined. */
+# undef LoadLibrary
+# define LoadLibrary LoadLibraryA
+
+# if !(_WIN32_WINNT >= _WIN32_WINNT_WIN8)
+
/* Avoid warnings from gcc -Wcast-function-type. */
-# define GetProcAddress \
- (void *) GetProcAddress
+# define GetProcAddress \
+ (void *) GetProcAddress
/* GetSystemTimePreciseAsFileTime was introduced only in Windows 8. */
typedef void (WINAPI * GetSystemTimePreciseAsFileTimeFuncType) (FILETIME *lpTime);
@@ -55,6 +58,12 @@ initialize (void)
initialized = TRUE;
}
+# else
+
+# define GetSystemTimePreciseAsFileTimeFunc GetSystemTimePreciseAsFileTime
+
+# endif
+
#endif
/* This is a wrapper for gettimeofday. It is used only on systems
@@ -85,8 +94,10 @@ gettimeofday (struct timeval *restrict tv, void *restrict tz)
<http://www.windowstimestamp.com/description>. */
FILETIME current_time;
+# if !(_WIN32_WINNT >= _WIN32_WINNT_WIN8)
if (!initialized)
initialize ();
+# endif
if (GetSystemTimePreciseAsFileTimeFunc != NULL)
GetSystemTimePreciseAsFileTimeFunc (&current_time);
else
@@ -110,11 +121,6 @@ gettimeofday (struct timeval *restrict tv, void *restrict tz)
#else
# if HAVE_GETTIMEOFDAY
-# if GETTIMEOFDAY_CLOBBERS_LOCALTIME
- /* Save and restore the contents of the buffer used for localtime's
- result around the call to gettimeofday. */
- struct tm save = *localtime_buffer_addr;
-# endif
# if defined timeval /* 'struct timeval' overridden by gnulib? */
# undef timeval
@@ -129,10 +135,6 @@ gettimeofday (struct timeval *restrict tv, void *restrict tz)
int result = gettimeofday (tv, (struct timezone *) tz);
# endif
-# if GETTIMEOFDAY_CLOBBERS_LOCALTIME
- *localtime_buffer_addr = save;
-# endif
-
return result;
# else
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 5adea10c18e..9953198fb31 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -86,7 +86,6 @@
# crypto/sha512-buffer \
# d-type \
# diffseq \
-# dosname \
# double-slash-root \
# dtoastr \
# dtotimespec \
@@ -95,18 +94,22 @@
# execinfo \
# explicit_bzero \
# faccessat \
+# fchmodat \
# fcntl \
# fcntl-h \
# fdopendir \
# filemode \
+# filename \
# filevercmp \
# flexmember \
# fpieee \
# fstatat \
# fsusage \
# fsync \
+# futimens \
# getloadavg \
# getopt-gnu \
+# getrandom \
# gettime \
# gettimeofday \
# gitlog-to-changelog \
@@ -114,6 +117,7 @@
# ignore-value \
# intprops \
# largefile \
+# libgmp \
# lstat \
# manywarnings \
# memmem-simple \
@@ -127,12 +131,12 @@
# pipe2 \
# pselect \
# pthread_sigmask \
-# putenv \
# qcopy-acl \
# readlink \
# readlinkat \
# regex \
# sig2str \
+# sigdescr_np \
# socklen \
# stat-time \
# std-gnu11 \
@@ -155,7 +159,7 @@
# timespec-sub \
# unlocked-io \
# update-copyright \
-# utimens \
+# utimensat \
# vla \
# warnings
@@ -243,14 +247,15 @@ GL_GENERATE_ALLOCA_H = @GL_GENERATE_ALLOCA_H@
GL_GENERATE_BYTESWAP_H = @GL_GENERATE_BYTESWAP_H@
GL_GENERATE_ERRNO_H = @GL_GENERATE_ERRNO_H@
GL_GENERATE_EXECINFO_H = @GL_GENERATE_EXECINFO_H@
+GL_GENERATE_GMP_GMP_H = @GL_GENERATE_GMP_GMP_H@
GL_GENERATE_IEEE754_H = @GL_GENERATE_IEEE754_H@
GL_GENERATE_LIMITS_H = @GL_GENERATE_LIMITS_H@
+GL_GENERATE_MINI_GMP_H = @GL_GENERATE_MINI_GMP_H@
GL_GENERATE_STDALIGN_H = @GL_GENERATE_STDALIGN_H@
GL_GENERATE_STDDEF_H = @GL_GENERATE_STDDEF_H@
GL_GENERATE_STDINT_H = @GL_GENERATE_STDINT_H@
GMALLOC_OBJ = @GMALLOC_OBJ@
-GMP_LIB = @GMP_LIB@
-GMP_OBJ = @GMP_OBJ@
+GMP_H = @GMP_H@
GNULIB_ACCESS = @GNULIB_ACCESS@
GNULIB_ALPHASORT = @GNULIB_ALPHASORT@
GNULIB_ATOLL = @GNULIB_ATOLL@
@@ -310,16 +315,20 @@ GNULIB_GETCWD = @GNULIB_GETCWD@
GNULIB_GETDELIM = @GNULIB_GETDELIM@
GNULIB_GETDOMAINNAME = @GNULIB_GETDOMAINNAME@
GNULIB_GETDTABLESIZE = @GNULIB_GETDTABLESIZE@
+GNULIB_GETENTROPY = @GNULIB_GETENTROPY@
GNULIB_GETGROUPS = @GNULIB_GETGROUPS@
GNULIB_GETHOSTNAME = @GNULIB_GETHOSTNAME@
GNULIB_GETLINE = @GNULIB_GETLINE@
GNULIB_GETLOADAVG = @GNULIB_GETLOADAVG@
GNULIB_GETLOGIN = @GNULIB_GETLOGIN@
GNULIB_GETLOGIN_R = @GNULIB_GETLOGIN_R@
+GNULIB_GETOPT_POSIX = @GNULIB_GETOPT_POSIX@
GNULIB_GETPAGESIZE = @GNULIB_GETPAGESIZE@
GNULIB_GETPASS = @GNULIB_GETPASS@
+GNULIB_GETRANDOM = @GNULIB_GETRANDOM@
GNULIB_GETSUBOPT = @GNULIB_GETSUBOPT@
GNULIB_GETTIMEOFDAY = @GNULIB_GETTIMEOFDAY@
+GNULIB_GETUMASK = @GNULIB_GETUMASK@
GNULIB_GETUSERSHELL = @GNULIB_GETUSERSHELL@
GNULIB_GL_UNISTD_H_GETOPT = @GNULIB_GL_UNISTD_H_GETOPT@
GNULIB_GRANTPT = @GNULIB_GRANTPT@
@@ -416,7 +425,9 @@ GNULIB_SECURE_GETENV = @GNULIB_SECURE_GETENV@
GNULIB_SELECT = @GNULIB_SELECT@
GNULIB_SETENV = @GNULIB_SETENV@
GNULIB_SETHOSTNAME = @GNULIB_SETHOSTNAME@
+GNULIB_SIGABBREV_NP = @GNULIB_SIGABBREV_NP@
GNULIB_SIGACTION = @GNULIB_SIGACTION@
+GNULIB_SIGDESCR_NP = @GNULIB_SIGDESCR_NP@
GNULIB_SIGNAL_H_SIGPIPE = @GNULIB_SIGNAL_H_SIGPIPE@
GNULIB_SIGPROCMASK = @GNULIB_SIGPROCMASK@
GNULIB_SLEEP = @GNULIB_SLEEP@
@@ -431,6 +442,7 @@ GNULIB_STRCASESTR = @GNULIB_STRCASESTR@
GNULIB_STRCHRNUL = @GNULIB_STRCHRNUL@
GNULIB_STRDUP = @GNULIB_STRDUP@
GNULIB_STRERROR = @GNULIB_STRERROR@
+GNULIB_STRERRORNAME_NP = @GNULIB_STRERRORNAME_NP@
GNULIB_STRERROR_R = @GNULIB_STRERROR_R@
GNULIB_STRFTIME = @GNULIB_STRFTIME@
GNULIB_STRNCAT = @GNULIB_STRNCAT@
@@ -543,7 +555,6 @@ HAVE_DECL_UNSETENV = @HAVE_DECL_UNSETENV@
HAVE_DECL_VSNPRINTF = @HAVE_DECL_VSNPRINTF@
HAVE_DIRENT_H = @HAVE_DIRENT_H@
HAVE_DPRINTF = @HAVE_DPRINTF@
-HAVE_DUP2 = @HAVE_DUP2@
HAVE_DUP3 = @HAVE_DUP3@
HAVE_EUIDACCESS = @HAVE_EUIDACCESS@
HAVE_EXPLICIT_BZERO = @HAVE_EXPLICIT_BZERO@
@@ -563,14 +574,17 @@ HAVE_FTELLO = @HAVE_FTELLO@
HAVE_FTRUNCATE = @HAVE_FTRUNCATE@
HAVE_FUTIMENS = @HAVE_FUTIMENS@
HAVE_GETDTABLESIZE = @HAVE_GETDTABLESIZE@
+HAVE_GETENTROPY = @HAVE_GETENTROPY@
HAVE_GETGROUPS = @HAVE_GETGROUPS@
HAVE_GETHOSTNAME = @HAVE_GETHOSTNAME@
HAVE_GETLOGIN = @HAVE_GETLOGIN@
HAVE_GETOPT_H = @HAVE_GETOPT_H@
HAVE_GETPAGESIZE = @HAVE_GETPAGESIZE@
HAVE_GETPASS = @HAVE_GETPASS@
+HAVE_GETRANDOM = @HAVE_GETRANDOM@
HAVE_GETSUBOPT = @HAVE_GETSUBOPT@
HAVE_GETTIMEOFDAY = @HAVE_GETTIMEOFDAY@
+HAVE_GETUMASK = @HAVE_GETUMASK@
HAVE_GRANTPT = @HAVE_GRANTPT@
HAVE_GROUP_MEMBER = @HAVE_GROUP_MEMBER@
HAVE_IMAXDIV_T = @HAVE_IMAXDIV_T@
@@ -578,15 +592,14 @@ HAVE_INITSTATE = @HAVE_INITSTATE@
HAVE_INTTYPES_H = @HAVE_INTTYPES_H@
HAVE_LCHMOD = @HAVE_LCHMOD@
HAVE_LCHOWN = @HAVE_LCHOWN@
+HAVE_LIBGMP = @HAVE_LIBGMP@
HAVE_LINK = @HAVE_LINK@
HAVE_LINKAT = @HAVE_LINKAT@
-HAVE_LONG_LONG_INT = @HAVE_LONG_LONG_INT@
HAVE_LSTAT = @HAVE_LSTAT@
HAVE_MAKEINFO = @HAVE_MAKEINFO@
HAVE_MAX_ALIGN_T = @HAVE_MAX_ALIGN_T@
HAVE_MBSLEN = @HAVE_MBSLEN@
HAVE_MBTOWC = @HAVE_MBTOWC@
-HAVE_MEMCHR = @HAVE_MEMCHR@
HAVE_MEMPCPY = @HAVE_MEMPCPY@
HAVE_MKDIRAT = @HAVE_MKDIRAT@
HAVE_MKDTEMP = @HAVE_MKDTEMP@
@@ -635,7 +648,9 @@ HAVE_SECURE_GETENV = @HAVE_SECURE_GETENV@
HAVE_SETENV = @HAVE_SETENV@
HAVE_SETHOSTNAME = @HAVE_SETHOSTNAME@
HAVE_SETSTATE = @HAVE_SETSTATE@
+HAVE_SIGABBREV_NP = @HAVE_SIGABBREV_NP@
HAVE_SIGACTION = @HAVE_SIGACTION@
+HAVE_SIGDESCR_NP = @HAVE_SIGDESCR_NP@
HAVE_SIGHANDLER_T = @HAVE_SIGHANDLER_T@
HAVE_SIGINFO_T = @HAVE_SIGINFO_T@
HAVE_SIGNED_SIG_ATOMIC_T = @HAVE_SIGNED_SIG_ATOMIC_T@
@@ -648,6 +663,7 @@ HAVE_STPCPY = @HAVE_STPCPY@
HAVE_STPNCPY = @HAVE_STPNCPY@
HAVE_STRCASESTR = @HAVE_STRCASESTR@
HAVE_STRCHRNUL = @HAVE_STRCHRNUL@
+HAVE_STRERRORNAME_NP = @HAVE_STRERRORNAME_NP@
HAVE_STRPBRK = @HAVE_STRPBRK@
HAVE_STRPTIME = @HAVE_STRPTIME@
HAVE_STRSEP = @HAVE_STRSEP@
@@ -666,17 +682,16 @@ HAVE_SYS_CDEFS_H = @HAVE_SYS_CDEFS_H@
HAVE_SYS_INTTYPES_H = @HAVE_SYS_INTTYPES_H@
HAVE_SYS_LOADAVG_H = @HAVE_SYS_LOADAVG_H@
HAVE_SYS_PARAM_H = @HAVE_SYS_PARAM_H@
+HAVE_SYS_RANDOM_H = @HAVE_SYS_RANDOM_H@
HAVE_SYS_SELECT_H = @HAVE_SYS_SELECT_H@
HAVE_SYS_TIME_H = @HAVE_SYS_TIME_H@
HAVE_SYS_TYPES_H = @HAVE_SYS_TYPES_H@
HAVE_TIMEGM = @HAVE_TIMEGM@
HAVE_TIMEZONE_T = @HAVE_TIMEZONE_T@
HAVE_TYPE_VOLATILE_SIG_ATOMIC_T = @HAVE_TYPE_VOLATILE_SIG_ATOMIC_T@
-HAVE_TZSET = @HAVE_TZSET@
HAVE_UNISTD_H = @HAVE_UNISTD_H@
HAVE_UNLINKAT = @HAVE_UNLINKAT@
HAVE_UNLOCKPT = @HAVE_UNLOCKPT@
-HAVE_UNSIGNED_LONG_LONG_INT = @HAVE_UNSIGNED_LONG_LONG_INT@
HAVE_USLEEP = @HAVE_USLEEP@
HAVE_UTIMENSAT = @HAVE_UTIMENSAT@
HAVE_VASPRINTF = @HAVE_VASPRINTF@
@@ -714,6 +729,7 @@ LD_SWITCH_SYSTEM_TEMACS = @LD_SWITCH_SYSTEM_TEMACS@
LD_SWITCH_X_SITE = @LD_SWITCH_X_SITE@
LD_SWITCH_X_SITE_RPATH = @LD_SWITCH_X_SITE_RPATH@
LIBGIF = @LIBGIF@
+LIBGMP = @LIBGMP@
LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@
LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@
LIBGNU_LIBDEPS = @LIBGNU_LIBDEPS@
@@ -753,6 +769,7 @@ LIB_ACL = @LIB_ACL@
LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@
LIB_EACCESS = @LIB_EACCESS@
LIB_EXECINFO = @LIB_EXECINFO@
+LIB_GETRANDOM = @LIB_GETRANDOM@
LIB_MATH = @LIB_MATH@
LIB_PTHREAD = @LIB_PTHREAD@
LIB_PTHREAD_SIGMASK = @LIB_PTHREAD_SIGMASK@
@@ -760,6 +777,7 @@ LIB_TIMER_TIME = @LIB_TIMER_TIME@
LIB_WSOCK32 = @LIB_WSOCK32@
LIMITS_H = @LIMITS_H@
LN_S_FILEONLY = @LN_S_FILEONLY@
+LTLIBGMP = @LTLIBGMP@
LTLIBINTL = @LTLIBINTL@
LTLIBOBJS = @LTLIBOBJS@
M17N_FLT_CFLAGS = @M17N_FLT_CFLAGS@
@@ -768,6 +786,7 @@ MAKEINFO = @MAKEINFO@
MAKE_PROG = @MAKE_PROG@
MKDIR_P = @MKDIR_P@
MODULES_OBJ = @MODULES_OBJ@
+MODULES_SECONDARY_SUFFIX = @MODULES_SECONDARY_SUFFIX@
MODULES_SUFFIX = @MODULES_SUFFIX@
NEXT_AS_FIRST_DIRECTIVE_DIRENT_H = @NEXT_AS_FIRST_DIRECTIVE_DIRENT_H@
NEXT_AS_FIRST_DIRECTIVE_ERRNO_H = @NEXT_AS_FIRST_DIRECTIVE_ERRNO_H@
@@ -781,6 +800,7 @@ NEXT_AS_FIRST_DIRECTIVE_STDINT_H = @NEXT_AS_FIRST_DIRECTIVE_STDINT_H@
NEXT_AS_FIRST_DIRECTIVE_STDIO_H = @NEXT_AS_FIRST_DIRECTIVE_STDIO_H@
NEXT_AS_FIRST_DIRECTIVE_STDLIB_H = @NEXT_AS_FIRST_DIRECTIVE_STDLIB_H@
NEXT_AS_FIRST_DIRECTIVE_STRING_H = @NEXT_AS_FIRST_DIRECTIVE_STRING_H@
+NEXT_AS_FIRST_DIRECTIVE_SYS_RANDOM_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_RANDOM_H@
NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H@
NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H@
NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H@
@@ -799,6 +819,7 @@ NEXT_STDINT_H = @NEXT_STDINT_H@
NEXT_STDIO_H = @NEXT_STDIO_H@
NEXT_STDLIB_H = @NEXT_STDLIB_H@
NEXT_STRING_H = @NEXT_STRING_H@
+NEXT_SYS_RANDOM_H = @NEXT_SYS_RANDOM_H@
NEXT_SYS_SELECT_H = @NEXT_SYS_SELECT_H@
NEXT_SYS_STAT_H = @NEXT_SYS_STAT_H@
NEXT_SYS_TIME_H = @NEXT_SYS_TIME_H@
@@ -836,7 +857,6 @@ PRAGMA_COLUMNS = @PRAGMA_COLUMNS@
PRAGMA_SYSTEM_HEADER = @PRAGMA_SYSTEM_HEADER@
PRE_ALLOC_OBJ = @PRE_ALLOC_OBJ@
PRIPTR_PREFIX = @PRIPTR_PREFIX@
-PRI_MACROS_BROKEN = @PRI_MACROS_BROKEN@
PROFILING_CFLAGS = @PROFILING_CFLAGS@
PTHREAD_H_DEFINES_STRUCT_TIMESPEC = @PTHREAD_H_DEFINES_STRUCT_TIMESPEC@
PTRDIFF_T_SUFFIX = @PTRDIFF_T_SUFFIX@
@@ -855,6 +875,7 @@ REPLACE_DPRINTF = @REPLACE_DPRINTF@
REPLACE_DUP = @REPLACE_DUP@
REPLACE_DUP2 = @REPLACE_DUP2@
REPLACE_FACCESSAT = @REPLACE_FACCESSAT@
+REPLACE_FCHMODAT = @REPLACE_FCHMODAT@
REPLACE_FCHOWNAT = @REPLACE_FCHOWNAT@
REPLACE_FCLOSE = @REPLACE_FCLOSE@
REPLACE_FCNTL = @REPLACE_FCNTL@
@@ -882,6 +903,7 @@ REPLACE_GETLINE = @REPLACE_GETLINE@
REPLACE_GETLOGIN_R = @REPLACE_GETLOGIN_R@
REPLACE_GETPAGESIZE = @REPLACE_GETPAGESIZE@
REPLACE_GETPASS = @REPLACE_GETPASS@
+REPLACE_GETRANDOM = @REPLACE_GETRANDOM@
REPLACE_GETTIMEOFDAY = @REPLACE_GETTIMEOFDAY@
REPLACE_GMTIME = @REPLACE_GMTIME@
REPLACE_INITSTATE = @REPLACE_INITSTATE@
@@ -945,6 +967,7 @@ REPLACE_STRCASESTR = @REPLACE_STRCASESTR@
REPLACE_STRCHRNUL = @REPLACE_STRCHRNUL@
REPLACE_STRDUP = @REPLACE_STRDUP@
REPLACE_STRERROR = @REPLACE_STRERROR@
+REPLACE_STRERRORNAME_NP = @REPLACE_STRERRORNAME_NP@
REPLACE_STRERROR_R = @REPLACE_STRERROR_R@
REPLACE_STRFTIME = @REPLACE_STRFTIME@
REPLACE_STRNCAT = @REPLACE_STRNCAT@
@@ -1001,6 +1024,7 @@ UINT64_MAX_EQ_ULONG_MAX = @UINT64_MAX_EQ_ULONG_MAX@
UNDEFINE_STRTOK_R = @UNDEFINE_STRTOK_R@
UNEXEC_OBJ = @UNEXEC_OBJ@
UNISTD_H_DEFINES_STRUCT_TIMESPEC = @UNISTD_H_DEFINES_STRUCT_TIMESPEC@
+UNISTD_H_HAVE_SYS_RANDOM_H = @UNISTD_H_HAVE_SYS_RANDOM_H@
UNISTD_H_HAVE_WINSOCK2_H = @UNISTD_H_HAVE_WINSOCK2_H@
UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS = @UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS@
USE_ACL = @USE_ACL@
@@ -1069,8 +1093,6 @@ gamedir = @gamedir@
gamegroup = @gamegroup@
gameuser = @gameuser@
gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7 = @gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7@
-gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9 = @gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9@
-gl_GNULIB_ENABLED_21ee726a3540c09237a8e70c0baf7467 = @gl_GNULIB_ENABLED_21ee726a3540c09237a8e70c0baf7467@
gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b = @gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b@
gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31 = @gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31@
gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c = @gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c@
@@ -1082,9 +1104,11 @@ gl_GNULIB_ENABLED_dirfd = @gl_GNULIB_ENABLED_dirfd@
gl_GNULIB_ENABLED_euidaccess = @gl_GNULIB_ENABLED_euidaccess@
gl_GNULIB_ENABLED_getdtablesize = @gl_GNULIB_ENABLED_getdtablesize@
gl_GNULIB_ENABLED_getgroups = @gl_GNULIB_ENABLED_getgroups@
+gl_GNULIB_ENABLED_lchmod = @gl_GNULIB_ENABLED_lchmod@
gl_GNULIB_ENABLED_malloca = @gl_GNULIB_ENABLED_malloca@
gl_GNULIB_ENABLED_open = @gl_GNULIB_ENABLED_open@
gl_GNULIB_ENABLED_strtoll = @gl_GNULIB_ENABLED_strtoll@
+gl_GNULIB_ENABLED_utimens = @gl_GNULIB_ENABLED_utimens@
gl_LIBOBJS = @gl_LIBOBJS@
gl_LTLIBOBJS = @gl_LTLIBOBJS@
gltests_LIBOBJS = @gltests_LIBOBJS@
@@ -1142,7 +1166,7 @@ ifeq (,$(OMIT_GNULIB_MODULE_absolute-header))
# Use this preprocessor expression to decide whether #include_next works.
# Do not rely on a 'configure'-time test for this, since the expression
# might appear in an installed header, which is used by some other compiler.
-HAVE_INCLUDE_NEXT = (__GNUC__ || 60000000 <= __DECC_VER)
+HAVE_INCLUDE_NEXT = (__GNUC__ || __clang__ || 60000000 <= __DECC_VER)
endif
## end gnulib module absolute-header
@@ -1198,14 +1222,20 @@ endif
ifeq (,$(OMIT_GNULIB_MODULE_at-internal))
ifneq (,$(gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b))
+libgnu_a_SOURCES += openat-priv.h openat-proc.c
endif
-EXTRA_DIST += openat-priv.h openat-proc.c
+endif
+## end gnulib module at-internal
+
+## begin gnulib module attribute
+ifeq (,$(OMIT_GNULIB_MODULE_attribute))
+
-EXTRA_libgnu_a_SOURCES += openat-proc.c
+EXTRA_DIST += attribute.h
endif
-## end gnulib module at-internal
+## end gnulib module attribute
## begin gnulib module binary-io
ifeq (,$(OMIT_GNULIB_MODULE_binary-io))
@@ -1451,15 +1481,6 @@ EXTRA_libgnu_a_SOURCES += dirfd.c
endif
## end gnulib module dirfd
-## begin gnulib module dosname
-ifeq (,$(OMIT_GNULIB_MODULE_dosname))
-
-
-EXTRA_DIST += dosname.h
-
-endif
-## end gnulib module dosname
-
## begin gnulib module dtoastr
ifeq (,$(OMIT_GNULIB_MODULE_dtoastr))
@@ -1589,6 +1610,17 @@ EXTRA_libgnu_a_SOURCES += at-func.c faccessat.c
endif
## end gnulib module faccessat
+## begin gnulib module fchmodat
+ifeq (,$(OMIT_GNULIB_MODULE_fchmodat))
+
+
+EXTRA_DIST += at-func.c fchmodat.c
+
+EXTRA_libgnu_a_SOURCES += at-func.c fchmodat.c
+
+endif
+## end gnulib module fchmodat
+
## begin gnulib module fcntl
ifeq (,$(OMIT_GNULIB_MODULE_fcntl))
@@ -1660,6 +1692,15 @@ EXTRA_DIST += filemode.h
endif
## end gnulib module filemode
+## begin gnulib module filename
+ifeq (,$(OMIT_GNULIB_MODULE_filename))
+
+
+EXTRA_DIST += filename.h
+
+endif
+## end gnulib module filename
+
## begin gnulib module filevercmp
ifeq (,$(OMIT_GNULIB_MODULE_filevercmp))
@@ -1723,6 +1764,17 @@ EXTRA_libgnu_a_SOURCES += fsync.c
endif
## end gnulib module fsync
+## begin gnulib module futimens
+ifeq (,$(OMIT_GNULIB_MODULE_futimens))
+
+
+EXTRA_DIST += futimens.c
+
+EXTRA_libgnu_a_SOURCES += futimens.c
+
+endif
+## end gnulib module futimens
+
## begin gnulib module getdtablesize
ifeq (,$(OMIT_GNULIB_MODULE_getdtablesize))
@@ -1798,6 +1850,17 @@ EXTRA_libgnu_a_SOURCES += getopt.c getopt1.c
endif
## end gnulib module getopt-posix
+## begin gnulib module getrandom
+ifeq (,$(OMIT_GNULIB_MODULE_getrandom))
+
+
+EXTRA_DIST += getrandom.c
+
+EXTRA_libgnu_a_SOURCES += getrandom.c
+
+endif
+## end gnulib module getrandom
+
## begin gnulib module gettext-h
ifeq (,$(OMIT_GNULIB_MODULE_gettext-h))
@@ -1908,10 +1971,7 @@ inttypes.h: inttypes.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_U
-e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
-e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
-e 's|@''NEXT_INTTYPES_H''@|$(NEXT_INTTYPES_H)|g' \
- -e 's/@''PRI_MACROS_BROKEN''@/$(PRI_MACROS_BROKEN)/g' \
-e 's/@''APPLE_UNIVERSAL_BUILD''@/$(APPLE_UNIVERSAL_BUILD)/g' \
- -e 's/@''HAVE_LONG_LONG_INT''@/$(HAVE_LONG_LONG_INT)/g' \
- -e 's/@''HAVE_UNSIGNED_LONG_LONG_INT''@/$(HAVE_UNSIGNED_LONG_LONG_INT)/g' \
-e 's/@''PRIPTR_PREFIX''@/$(PRIPTR_PREFIX)/g' \
-e 's/@''GNULIB_IMAXABS''@/$(GNULIB_IMAXABS)/g' \
-e 's/@''GNULIB_IMAXDIV''@/$(GNULIB_IMAXDIV)/g' \
@@ -1941,17 +2001,58 @@ EXTRA_DIST += inttypes.in.h
endif
## end gnulib module inttypes-incomplete
+## begin gnulib module lchmod
+ifeq (,$(OMIT_GNULIB_MODULE_lchmod))
+
+ifneq (,$(gl_GNULIB_ENABLED_lchmod))
+
+endif
+EXTRA_DIST += lchmod.c
+
+EXTRA_libgnu_a_SOURCES += lchmod.c
+
+endif
+## end gnulib module lchmod
+
## begin gnulib module libc-config
ifeq (,$(OMIT_GNULIB_MODULE_libc-config))
-ifneq (,$(gl_GNULIB_ENABLED_21ee726a3540c09237a8e70c0baf7467))
-endif
EXTRA_DIST += cdefs.h libc-config.h
endif
## end gnulib module libc-config
+## begin gnulib module libgmp
+ifeq (,$(OMIT_GNULIB_MODULE_libgmp))
+
+BUILT_SOURCES += $(GMP_H)
+
+ifneq (,$(GL_GENERATE_MINI_GMP_H))
+# Build gmp.h as a wrapper for mini-gmp.h when using mini-gmp.
+gmp.h: $(top_builddir)/config.status
+ echo '#include "mini-gmp.h"' >$@-t
+ mv $@-t $@
+else
+ifneq (,$(GL_GENERATE_GMP_GMP_H))
+# Build gmp.h as a wrapper for gmp/gmp.h.
+gmp.h: $(top_builddir)/config.status
+ echo '#include <gmp/gmp.h>' >$@-t
+ mv $@-t $@
+else
+gmp.h: $(top_builddir)/config.status
+ rm -f $@
+endif
+endif
+MOSTLYCLEANFILES += gmp.h gmp.h-t
+
+EXTRA_DIST += mini-gmp-gnulib.c mini-gmp.c mini-gmp.h
+
+EXTRA_libgnu_a_SOURCES += mini-gmp-gnulib.c mini-gmp.c
+
+endif
+## end gnulib module libgmp
+
## begin gnulib module limits-h
ifeq (,$(OMIT_GNULIB_MODULE_limits-h))
@@ -1982,19 +2083,6 @@ EXTRA_DIST += limits.in.h
endif
## end gnulib module limits-h
-## begin gnulib module localtime-buffer
-ifeq (,$(OMIT_GNULIB_MODULE_localtime-buffer))
-
-ifneq (,$(gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9))
-
-endif
-EXTRA_DIST += localtime-buffer.c localtime-buffer.h
-
-EXTRA_libgnu_a_SOURCES += localtime-buffer.c
-
-endif
-## end gnulib module localtime-buffer
-
## begin gnulib module lstat
ifeq (,$(OMIT_GNULIB_MODULE_lstat))
@@ -2167,17 +2255,6 @@ EXTRA_libgnu_a_SOURCES += pthread_sigmask.c
endif
## end gnulib module pthread_sigmask
-## begin gnulib module putenv
-ifeq (,$(OMIT_GNULIB_MODULE_putenv))
-
-
-EXTRA_DIST += putenv.c
-
-EXTRA_libgnu_a_SOURCES += putenv.c
-
-endif
-## end gnulib module putenv
-
## begin gnulib module qcopy-acl
ifeq (,$(OMIT_GNULIB_MODULE_qcopy-acl))
@@ -2241,6 +2318,17 @@ EXTRA_libgnu_a_SOURCES += sig2str.c
endif
## end gnulib module sig2str
+## begin gnulib module sigdescr_np
+ifeq (,$(OMIT_GNULIB_MODULE_sigdescr_np))
+
+
+EXTRA_DIST += sigdescr_np.c
+
+EXTRA_libgnu_a_SOURCES += sigdescr_np.c
+
+endif
+## end gnulib module sigdescr_np
+
## begin gnulib module signal-h
ifeq (,$(OMIT_GNULIB_MODULE_signal-h))
@@ -2432,8 +2520,6 @@ stdint.h: stdint.in.h $(top_builddir)/config.status
-e 's/@''HAVE_SYS_INTTYPES_H''@/$(HAVE_SYS_INTTYPES_H)/g' \
-e 's/@''HAVE_SYS_BITYPES_H''@/$(HAVE_SYS_BITYPES_H)/g' \
-e 's/@''HAVE_WCHAR_H''@/$(HAVE_WCHAR_H)/g' \
- -e 's/@''HAVE_LONG_LONG_INT''@/$(HAVE_LONG_LONG_INT)/g' \
- -e 's/@''HAVE_UNSIGNED_LONG_LONG_INT''@/$(HAVE_UNSIGNED_LONG_LONG_INT)/g' \
-e 's/@''APPLE_UNIVERSAL_BUILD''@/$(APPLE_UNIVERSAL_BUILD)/g' \
-e 's/@''BITSIZEOF_PTRDIFF_T''@/$(BITSIZEOF_PTRDIFF_T)/g' \
-e 's/@''PTRDIFF_T_SUFFIX''@/$(PTRDIFF_T_SUFFIX)/g' \
@@ -2776,6 +2862,9 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's/@''GNULIB_STRTOK_R''@/$(GNULIB_STRTOK_R)/g' \
-e 's/@''GNULIB_STRERROR''@/$(GNULIB_STRERROR)/g' \
-e 's/@''GNULIB_STRERROR_R''@/$(GNULIB_STRERROR_R)/g' \
+ -e 's/@''GNULIB_STRERRORNAME_NP''@/$(GNULIB_STRERRORNAME_NP)/g' \
+ -e 's/@''GNULIB_SIGABBREV_NP''@/$(GNULIB_SIGABBREV_NP)/g' \
+ -e 's/@''GNULIB_SIGDESCR_NP''@/$(GNULIB_SIGDESCR_NP)/g' \
-e 's/@''GNULIB_STRSIGNAL''@/$(GNULIB_STRSIGNAL)/g' \
-e 's/@''GNULIB_STRVERSCMP''@/$(GNULIB_STRVERSCMP)/g' \
< $(srcdir)/string.in.h | \
@@ -2783,7 +2872,6 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''HAVE_FFSL''@|$(HAVE_FFSL)|g' \
-e 's|@''HAVE_FFSLL''@|$(HAVE_FFSLL)|g' \
-e 's|@''HAVE_MBSLEN''@|$(HAVE_MBSLEN)|g' \
- -e 's|@''HAVE_MEMCHR''@|$(HAVE_MEMCHR)|g' \
-e 's|@''HAVE_DECL_MEMMEM''@|$(HAVE_DECL_MEMMEM)|g' \
-e 's|@''HAVE_MEMPCPY''@|$(HAVE_MEMPCPY)|g' \
-e 's|@''HAVE_DECL_MEMRCHR''@|$(HAVE_DECL_MEMRCHR)|g' \
@@ -2799,6 +2887,9 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''HAVE_STRCASESTR''@|$(HAVE_STRCASESTR)|g' \
-e 's|@''HAVE_DECL_STRTOK_R''@|$(HAVE_DECL_STRTOK_R)|g' \
-e 's|@''HAVE_DECL_STRERROR_R''@|$(HAVE_DECL_STRERROR_R)|g' \
+ -e 's|@''HAVE_STRERRORNAME_NP''@|$(HAVE_STRERRORNAME_NP)|g' \
+ -e 's|@''HAVE_SIGABBREV_NP''@|$(HAVE_SIGABBREV_NP)|g' \
+ -e 's|@''HAVE_SIGDESCR_NP''@|$(HAVE_SIGDESCR_NP)|g' \
-e 's|@''HAVE_DECL_STRSIGNAL''@|$(HAVE_DECL_STRSIGNAL)|g' \
-e 's|@''HAVE_STRVERSCMP''@|$(HAVE_STRVERSCMP)|g' \
-e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \
@@ -2814,6 +2905,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''REPLACE_STRTOK_R''@|$(REPLACE_STRTOK_R)|g' \
-e 's|@''REPLACE_STRERROR''@|$(REPLACE_STRERROR)|g' \
-e 's|@''REPLACE_STRERROR_R''@|$(REPLACE_STRERROR_R)|g' \
+ -e 's|@''REPLACE_STRERRORNAME_NP''@|$(REPLACE_STRERRORNAME_NP)|g' \
-e 's|@''REPLACE_STRSIGNAL''@|$(REPLACE_STRSIGNAL)|g' \
-e 's|@''UNDEFINE_STRTOK_R''@|$(UNDEFINE_STRTOK_R)|g' \
-e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
@@ -2875,6 +2967,40 @@ EXTRA_libgnu_a_SOURCES += symlink.c
endif
## end gnulib module symlink
+## begin gnulib module sys_random
+ifeq (,$(OMIT_GNULIB_MODULE_sys_random))
+
+BUILT_SOURCES += sys/random.h
+
+# We need the following in order to create <sys/random.h> when the system
+# doesn't have one.
+sys/random.h: sys_random.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H)
+ $(AM_V_at)$(MKDIR_P) sys
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_SYS_RANDOM_H''@|$(NEXT_SYS_RANDOM_H)|g' \
+ -e 's|@''HAVE_SYS_RANDOM_H''@|$(HAVE_SYS_RANDOM_H)|g' \
+ -e 's/@''GNULIB_GETRANDOM''@/$(GNULIB_GETRANDOM)/g' \
+ -e 's/@''HAVE_GETRANDOM''@/$(HAVE_GETRANDOM)/g' \
+ -e 's/@''REPLACE_GETRANDOM''@/$(REPLACE_GETRANDOM)/g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
+ -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/sys_random.in.h; \
+ } > $@-t && \
+ mv -f $@-t $@
+MOSTLYCLEANFILES += sys/random.h sys/random.h-t
+MOSTLYCLEANDIRS += sys
+
+EXTRA_DIST += sys_random.in.h
+
+endif
+## end gnulib module sys_random
+
## begin gnulib module sys_select
ifeq (,$(OMIT_GNULIB_MODULE_sys_select))
@@ -2933,6 +3059,7 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU
-e 's/@''GNULIB_FSTAT''@/$(GNULIB_FSTAT)/g' \
-e 's/@''GNULIB_FSTATAT''@/$(GNULIB_FSTATAT)/g' \
-e 's/@''GNULIB_FUTIMENS''@/$(GNULIB_FUTIMENS)/g' \
+ -e 's/@''GNULIB_GETUMASK''@/$(GNULIB_GETUMASK)/g' \
-e 's/@''GNULIB_LCHMOD''@/$(GNULIB_LCHMOD)/g' \
-e 's/@''GNULIB_LSTAT''@/$(GNULIB_LSTAT)/g' \
-e 's/@''GNULIB_MKDIRAT''@/$(GNULIB_MKDIRAT)/g' \
@@ -2946,6 +3073,7 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU
-e 's|@''HAVE_FCHMODAT''@|$(HAVE_FCHMODAT)|g' \
-e 's|@''HAVE_FSTATAT''@|$(HAVE_FSTATAT)|g' \
-e 's|@''HAVE_FUTIMENS''@|$(HAVE_FUTIMENS)|g' \
+ -e 's|@''HAVE_GETUMASK''@|$(HAVE_GETUMASK)|g' \
-e 's|@''HAVE_LCHMOD''@|$(HAVE_LCHMOD)|g' \
-e 's|@''HAVE_LSTAT''@|$(HAVE_LSTAT)|g' \
-e 's|@''HAVE_MKDIRAT''@|$(HAVE_MKDIRAT)|g' \
@@ -2954,6 +3082,7 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU
-e 's|@''HAVE_MKNOD''@|$(HAVE_MKNOD)|g' \
-e 's|@''HAVE_MKNODAT''@|$(HAVE_MKNODAT)|g' \
-e 's|@''HAVE_UTIMENSAT''@|$(HAVE_UTIMENSAT)|g' \
+ -e 's|@''REPLACE_FCHMODAT''@|$(REPLACE_FCHMODAT)|g' \
-e 's|@''REPLACE_FSTAT''@|$(REPLACE_FSTAT)|g' \
-e 's|@''REPLACE_FSTATAT''@|$(REPLACE_FSTATAT)|g' \
-e 's|@''REPLACE_FUTIMENS''@|$(REPLACE_FUTIMENS)|g' \
@@ -3081,7 +3210,6 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(
-e 's|@''HAVE_STRPTIME''@|$(HAVE_STRPTIME)|g' \
-e 's|@''HAVE_TIMEGM''@|$(HAVE_TIMEGM)|g' \
-e 's|@''HAVE_TIMEZONE_T''@|$(HAVE_TIMEZONE_T)|g' \
- -e 's|@''HAVE_TZSET''@|$(HAVE_TZSET)|g' \
-e 's|@''REPLACE_CTIME''@|$(REPLACE_CTIME)|g' \
-e 's|@''REPLACE_GMTIME''@|$(REPLACE_GMTIME)|g' \
-e 's|@''REPLACE_LOCALTIME''@|$(REPLACE_LOCALTIME)|g' \
@@ -3214,10 +3342,12 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's/@''GNULIB_GETCWD''@/$(GNULIB_GETCWD)/g' \
-e 's/@''GNULIB_GETDOMAINNAME''@/$(GNULIB_GETDOMAINNAME)/g' \
-e 's/@''GNULIB_GETDTABLESIZE''@/$(GNULIB_GETDTABLESIZE)/g' \
+ -e 's/@''GNULIB_GETENTROPY''@/$(GNULIB_GETENTROPY)/g' \
-e 's/@''GNULIB_GETGROUPS''@/$(GNULIB_GETGROUPS)/g' \
-e 's/@''GNULIB_GETHOSTNAME''@/$(GNULIB_GETHOSTNAME)/g' \
-e 's/@''GNULIB_GETLOGIN''@/$(GNULIB_GETLOGIN)/g' \
-e 's/@''GNULIB_GETLOGIN_R''@/$(GNULIB_GETLOGIN_R)/g' \
+ -e 's/@''GNULIB_GETOPT_POSIX''@/$(GNULIB_GETOPT_POSIX)/g' \
-e 's/@''GNULIB_GETPAGESIZE''@/$(GNULIB_GETPAGESIZE)/g' \
-e 's/@''GNULIB_GETPASS''@/$(GNULIB_GETPASS)/g' \
-e 's/@''GNULIB_GETUSERSHELL''@/$(GNULIB_GETUSERSHELL)/g' \
@@ -3251,7 +3381,6 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
< $(srcdir)/unistd.in.h | \
sed -e 's|@''HAVE_CHOWN''@|$(HAVE_CHOWN)|g' \
-e 's|@''HAVE_COPY_FILE_RANGE''@|$(HAVE_COPY_FILE_RANGE)|g' \
- -e 's|@''HAVE_DUP2''@|$(HAVE_DUP2)|g' \
-e 's|@''HAVE_DUP3''@|$(HAVE_DUP3)|g' \
-e 's|@''HAVE_EUIDACCESS''@|$(HAVE_EUIDACCESS)|g' \
-e 's|@''HAVE_FACCESSAT''@|$(HAVE_FACCESSAT)|g' \
@@ -3261,6 +3390,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''HAVE_FSYNC''@|$(HAVE_FSYNC)|g' \
-e 's|@''HAVE_FTRUNCATE''@|$(HAVE_FTRUNCATE)|g' \
-e 's|@''HAVE_GETDTABLESIZE''@|$(HAVE_GETDTABLESIZE)|g' \
+ -e 's|@''HAVE_GETENTROPY''@|$(HAVE_GETENTROPY)|g' \
-e 's|@''HAVE_GETGROUPS''@|$(HAVE_GETGROUPS)|g' \
-e 's|@''HAVE_GETHOSTNAME''@|$(HAVE_GETHOSTNAME)|g' \
-e 's|@''HAVE_GETPAGESIZE''@|$(HAVE_GETPAGESIZE)|g' \
@@ -3330,6 +3460,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''REPLACE_UNLINKAT''@|$(REPLACE_UNLINKAT)|g' \
-e 's|@''REPLACE_USLEEP''@|$(REPLACE_USLEEP)|g' \
-e 's|@''REPLACE_WRITE''@|$(REPLACE_WRITE)|g' \
+ -e 's|@''UNISTD_H_HAVE_SYS_RANDOM_H''@|$(UNISTD_H_HAVE_SYS_RANDOM_H)|g' \
-e 's|@''UNISTD_H_HAVE_WINSOCK2_H''@|$(UNISTD_H_HAVE_WINSOCK2_H)|g' \
-e 's|@''UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS''@|$(UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS)|g' \
-e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
@@ -3365,13 +3496,26 @@ endif
## begin gnulib module utimens
ifeq (,$(OMIT_GNULIB_MODULE_utimens))
+ifneq (,$(gl_GNULIB_ENABLED_utimens))
libgnu_a_SOURCES += utimens.c
+endif
EXTRA_DIST += utimens.h
endif
## end gnulib module utimens
+## begin gnulib module utimensat
+ifeq (,$(OMIT_GNULIB_MODULE_utimensat))
+
+
+EXTRA_DIST += at-func.c utimensat.c
+
+EXTRA_libgnu_a_SOURCES += at-func.c utimensat.c
+
+endif
+## end gnulib module utimensat
+
## begin gnulib module verify
ifeq (,$(OMIT_GNULIB_MODULE_verify))
diff --git a/lib/group-member.c b/lib/group-member.c
index 7aa8a453615..6a6fc5605ef 100644
--- a/lib/group-member.c
+++ b/lib/group-member.c
@@ -1,7 +1,7 @@
/* group-member.c -- determine whether group id is in calling user's group list
- Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2020 Free
- Software Foundation, Inc.
+ Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-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
diff --git a/lib/ieee754.in.h b/lib/ieee754.in.h
index 01ca648905f..d64bb46e9de 100644
--- a/lib/ieee754.in.h
+++ b/lib/ieee754.in.h
@@ -67,7 +67,7 @@ union ieee754_float
#endif /* Little endian. */
} ieee;
- /* This format makes it easier to see if a NaN is a signaling NaN. */
+ /* This format makes it easier to see if a NaN is a signalling NaN. */
struct
{
#if __BYTE_ORDER == __BIG_ENDIAN
@@ -118,7 +118,7 @@ union ieee754_double
#endif /* Little endian. */
} ieee;
- /* This format makes it easier to see if a NaN is a signaling NaN. */
+ /* This format makes it easier to see if a NaN is a signalling NaN. */
struct
{
#if __BYTE_ORDER == __BIG_ENDIAN
diff --git a/lib/ignore-value.h b/lib/ignore-value.h
index 7a922268431..ec3288f0dfc 100644
--- a/lib/ignore-value.h
+++ b/lib/ignore-value.h
@@ -39,8 +39,9 @@
versions 3.4 and newer have __attribute__ ((__warn_unused_result__))
which may cause unwanted diagnostics in that case. Use __typeof__
and __extension__ to work around the problem, if the workaround is
- known to be needed. */
-#if 3 < __GNUC__ + (4 <= __GNUC_MINOR__)
+ known to be needed.
+ The workaround is not needed with clang. */
+#if (3 < __GNUC__ + (4 <= __GNUC_MINOR__)) && !defined __clang__
# define ignore_value(x) \
(__extension__ ({ __typeof__ (x) __x = (x); (void) __x; }))
#else
diff --git a/lib/intprops.h b/lib/intprops.h
index dfbcaae73e3..b27f2eea056 100644
--- a/lib/intprops.h
+++ b/lib/intprops.h
@@ -48,7 +48,7 @@
/* Minimum and maximum values for integer types and expressions. */
/* The width in bits of the integer type or expression T.
- Do not evaluate T.
+ Do not evaluate T. T must not be a bit-field expression.
Padding bits are not supported; this is checked at compile-time below. */
#define TYPE_WIDTH(t) (sizeof (t) * CHAR_BIT)
@@ -70,7 +70,7 @@
? _GL_SIGNED_INT_MAXIMUM (e) \
: _GL_INT_NEGATE_CONVERT (e, 1))
#define _GL_SIGNED_INT_MAXIMUM(e) \
- (((_GL_INT_CONVERT (e, 1) << (TYPE_WIDTH ((e) + 0) - 2)) - 1) * 2 + 1)
+ (((_GL_INT_CONVERT (e, 1) << (TYPE_WIDTH (+ (e)) - 2)) - 1) * 2 + 1)
/* Work around OpenVMS incompatibility with C99. */
#if !defined LLONG_MAX && defined __INT64_MAX
@@ -86,6 +86,7 @@
/* Does the __typeof__ keyword work? This could be done by
'configure', but for now it's easier to do it by hand. */
#if (2 <= __GNUC__ \
+ || (4 <= __clang_major__) \
|| (1210 <= __IBMC__ && defined __IBM__TYPEOF__) \
|| (0x5110 <= __SUNPRO_C && !__STDC__))
# define _GL_HAVE___TYPEOF__ 1
@@ -94,8 +95,9 @@
#endif
/* Return 1 if the integer type or expression T might be signed. Return 0
- if it is definitely unsigned. This macro does not evaluate its argument,
- and expands to an integer constant expression. */
+ if it is definitely unsigned. T must not be a bit-field expression.
+ This macro does not evaluate its argument, and expands to an
+ integer constant expression. */
#if _GL_HAVE___TYPEOF__
# define _GL_SIGNED_TYPE_OR_EXPR(t) TYPE_SIGNED (__typeof__ (t))
#else
@@ -108,6 +110,8 @@
#define INT_BITS_STRLEN_BOUND(b) (((b) * 146 + 484) / 485)
/* Bound on length of the string representing an integer type or expression T.
+ T must not be a bit-field expression.
+
Subtract 1 for the sign bit if T is signed, and then add 1 more for
a minus sign if needed.
@@ -119,7 +123,7 @@
+ _GL_SIGNED_TYPE_OR_EXPR (t))
/* Bound on buffer size needed to represent an integer type or expression T,
- including the terminating null. */
+ including the terminating null. T must not be a bit-field expression. */
#define INT_BUFSIZE_BOUND(t) (INT_STRLEN_BOUND (t) + 1)
@@ -239,7 +243,7 @@
#endif
/* True if __builtin_add_overflow_p (A, B, C) works, and similarly for
- __builtin_mul_overflow_p and __builtin_mul_overflow_p. */
+ __builtin_sub_overflow_p and __builtin_mul_overflow_p. */
#define _GL_HAS_BUILTIN_OVERFLOW_P (7 <= __GNUC__)
/* The _GL*_OVERFLOW macros have the same restrictions as the
@@ -395,7 +399,7 @@
For now, assume all versions of GCC-like compilers generate bogus
warnings for _Generic. This matters only for compilers that
lack relevant builtins. */
-#if __GNUC__
+#if __GNUC__ || defined __clang__
# define _GL__GENERIC_BOGUS 1
#else
# define _GL__GENERIC_BOGUS 0
@@ -565,7 +569,7 @@
? (EXPR_SIGNED (_GL_INT_CONVERT (tmax, b)) \
? (a) < (tmax) / (b) \
: ((INT_NEGATE_OVERFLOW (b) \
- ? _GL_INT_CONVERT (b, tmax) >> (TYPE_WIDTH (b) - 1) \
+ ? _GL_INT_CONVERT (b, tmax) >> (TYPE_WIDTH (+ (b)) - 1) \
: (tmax) / -(b)) \
<= -1 - (a))) \
: INT_NEGATE_OVERFLOW (_GL_INT_CONVERT (b, tmin)) && (b) == -1 \
diff --git a/lib/inttypes.in.h b/lib/inttypes.in.h
index da84aff0440..596a050458b 100644
--- a/lib/inttypes.in.h
+++ b/lib/inttypes.in.h
@@ -38,6 +38,8 @@
# endif
# @INCLUDE_NEXT@ @NEXT_INTTYPES_H@
+
+# define _GL_FINISHED_INCLUDING_SYSTEM_INTTYPES_H
# endif
#endif
@@ -76,110 +78,92 @@
# define _LONG_LONG_FORMAT_PREFIX "ll"
#endif
-#if !defined PRId8 || @PRI_MACROS_BROKEN@
-# undef PRId8
+#if !defined PRId8
# ifdef INT8_MAX
# define PRId8 "d"
# endif
#endif
-#if !defined PRIi8 || @PRI_MACROS_BROKEN@
-# undef PRIi8
+#if !defined PRIi8
# ifdef INT8_MAX
# define PRIi8 "i"
# endif
#endif
-#if !defined PRIo8 || @PRI_MACROS_BROKEN@
-# undef PRIo8
+#if !defined PRIo8
# ifdef UINT8_MAX
# define PRIo8 "o"
# endif
#endif
-#if !defined PRIu8 || @PRI_MACROS_BROKEN@
-# undef PRIu8
+#if !defined PRIu8
# ifdef UINT8_MAX
# define PRIu8 "u"
# endif
#endif
-#if !defined PRIx8 || @PRI_MACROS_BROKEN@
-# undef PRIx8
+#if !defined PRIx8
# ifdef UINT8_MAX
# define PRIx8 "x"
# endif
#endif
-#if !defined PRIX8 || @PRI_MACROS_BROKEN@
-# undef PRIX8
+#if !defined PRIX8
# ifdef UINT8_MAX
# define PRIX8 "X"
# endif
#endif
-#if !defined PRId16 || @PRI_MACROS_BROKEN@
-# undef PRId16
+#if !defined PRId16
# ifdef INT16_MAX
# define PRId16 "d"
# endif
#endif
-#if !defined PRIi16 || @PRI_MACROS_BROKEN@
-# undef PRIi16
+#if !defined PRIi16
# ifdef INT16_MAX
# define PRIi16 "i"
# endif
#endif
-#if !defined PRIo16 || @PRI_MACROS_BROKEN@
-# undef PRIo16
+#if !defined PRIo16
# ifdef UINT16_MAX
# define PRIo16 "o"
# endif
#endif
-#if !defined PRIu16 || @PRI_MACROS_BROKEN@
-# undef PRIu16
+#if !defined PRIu16
# ifdef UINT16_MAX
# define PRIu16 "u"
# endif
#endif
-#if !defined PRIx16 || @PRI_MACROS_BROKEN@
-# undef PRIx16
+#if !defined PRIx16
# ifdef UINT16_MAX
# define PRIx16 "x"
# endif
#endif
-#if !defined PRIX16 || @PRI_MACROS_BROKEN@
-# undef PRIX16
+#if !defined PRIX16
# ifdef UINT16_MAX
# define PRIX16 "X"
# endif
#endif
-#if !defined PRId32 || @PRI_MACROS_BROKEN@
-# undef PRId32
+#if !defined PRId32
# ifdef INT32_MAX
# define PRId32 "d"
# endif
#endif
-#if !defined PRIi32 || @PRI_MACROS_BROKEN@
-# undef PRIi32
+#if !defined PRIi32
# ifdef INT32_MAX
# define PRIi32 "i"
# endif
#endif
-#if !defined PRIo32 || @PRI_MACROS_BROKEN@
-# undef PRIo32
+#if !defined PRIo32
# ifdef UINT32_MAX
# define PRIo32 "o"
# endif
#endif
-#if !defined PRIu32 || @PRI_MACROS_BROKEN@
-# undef PRIu32
+#if !defined PRIu32
# ifdef UINT32_MAX
# define PRIu32 "u"
# endif
#endif
-#if !defined PRIx32 || @PRI_MACROS_BROKEN@
-# undef PRIx32
+#if !defined PRIx32
# ifdef UINT32_MAX
# define PRIx32 "x"
# endif
#endif
-#if !defined PRIX32 || @PRI_MACROS_BROKEN@
-# undef PRIX32
+#if !defined PRIX32
# ifdef UINT32_MAX
# define PRIX32 "X"
# endif
@@ -189,15 +173,13 @@
# define _PRI64_PREFIX "l"
# elif defined _MSC_VER || defined __MINGW32__
# define _PRI64_PREFIX "I64"
-# elif @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
+# elif LONG_MAX >> 30 == 1
# define _PRI64_PREFIX _LONG_LONG_FORMAT_PREFIX
# endif
-# if !defined PRId64 || @PRI_MACROS_BROKEN@
-# undef PRId64
+# if !defined PRId64
# define PRId64 _PRI64_PREFIX "d"
# endif
-# if !defined PRIi64 || @PRI_MACROS_BROKEN@
-# undef PRIi64
+# if !defined PRIi64
# define PRIi64 _PRI64_PREFIX "i"
# endif
#endif
@@ -206,266 +188,220 @@
# define _PRIu64_PREFIX "l"
# elif defined _MSC_VER || defined __MINGW32__
# define _PRIu64_PREFIX "I64"
-# elif @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
+# elif ULONG_MAX >> 31 == 1
# define _PRIu64_PREFIX _LONG_LONG_FORMAT_PREFIX
# endif
-# if !defined PRIo64 || @PRI_MACROS_BROKEN@
-# undef PRIo64
+# if !defined PRIo64
# define PRIo64 _PRIu64_PREFIX "o"
# endif
-# if !defined PRIu64 || @PRI_MACROS_BROKEN@
-# undef PRIu64
+# if !defined PRIu64
# define PRIu64 _PRIu64_PREFIX "u"
# endif
-# if !defined PRIx64 || @PRI_MACROS_BROKEN@
-# undef PRIx64
+# if !defined PRIx64
# define PRIx64 _PRIu64_PREFIX "x"
# endif
-# if !defined PRIX64 || @PRI_MACROS_BROKEN@
-# undef PRIX64
+# if !defined PRIX64
# define PRIX64 _PRIu64_PREFIX "X"
# endif
#endif
-#if !defined PRIdLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIdLEAST8
+#if !defined PRIdLEAST8
# define PRIdLEAST8 "d"
#endif
-#if !defined PRIiLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIiLEAST8
+#if !defined PRIiLEAST8
# define PRIiLEAST8 "i"
#endif
-#if !defined PRIoLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIoLEAST8
+#if !defined PRIoLEAST8
# define PRIoLEAST8 "o"
#endif
-#if !defined PRIuLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIuLEAST8
+#if !defined PRIuLEAST8
# define PRIuLEAST8 "u"
#endif
-#if !defined PRIxLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIxLEAST8
+#if !defined PRIxLEAST8
# define PRIxLEAST8 "x"
#endif
-#if !defined PRIXLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIXLEAST8
+#if !defined PRIXLEAST8
# define PRIXLEAST8 "X"
#endif
-#if !defined PRIdLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIdLEAST16
+#if !defined PRIdLEAST16
# define PRIdLEAST16 "d"
#endif
-#if !defined PRIiLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIiLEAST16
+#if !defined PRIiLEAST16
# define PRIiLEAST16 "i"
#endif
-#if !defined PRIoLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIoLEAST16
+#if !defined PRIoLEAST16
# define PRIoLEAST16 "o"
#endif
-#if !defined PRIuLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIuLEAST16
+#if !defined PRIuLEAST16
# define PRIuLEAST16 "u"
#endif
-#if !defined PRIxLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIxLEAST16
+#if !defined PRIxLEAST16
# define PRIxLEAST16 "x"
#endif
-#if !defined PRIXLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIXLEAST16
+#if !defined PRIXLEAST16
# define PRIXLEAST16 "X"
#endif
-#if !defined PRIdLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIdLEAST32
+#if !defined PRIdLEAST32
# define PRIdLEAST32 "d"
#endif
-#if !defined PRIiLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIiLEAST32
+#if !defined PRIiLEAST32
# define PRIiLEAST32 "i"
#endif
-#if !defined PRIoLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIoLEAST32
+#if !defined PRIoLEAST32
# define PRIoLEAST32 "o"
#endif
-#if !defined PRIuLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIuLEAST32
+#if !defined PRIuLEAST32
# define PRIuLEAST32 "u"
#endif
-#if !defined PRIxLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIxLEAST32
+#if !defined PRIxLEAST32
# define PRIxLEAST32 "x"
#endif
-#if !defined PRIXLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIXLEAST32
+#if !defined PRIXLEAST32
# define PRIXLEAST32 "X"
#endif
#ifdef INT64_MAX
-# if !defined PRIdLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIdLEAST64
+# if !defined PRIdLEAST64
# define PRIdLEAST64 PRId64
# endif
-# if !defined PRIiLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIiLEAST64
+# if !defined PRIiLEAST64
# define PRIiLEAST64 PRIi64
# endif
#endif
#ifdef UINT64_MAX
-# if !defined PRIoLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIoLEAST64
+# if !defined PRIoLEAST64
# define PRIoLEAST64 PRIo64
# endif
-# if !defined PRIuLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIuLEAST64
+# if !defined PRIuLEAST64
# define PRIuLEAST64 PRIu64
# endif
-# if !defined PRIxLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIxLEAST64
+# if !defined PRIxLEAST64
# define PRIxLEAST64 PRIx64
# endif
-# if !defined PRIXLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIXLEAST64
+# if !defined PRIXLEAST64
# define PRIXLEAST64 PRIX64
# endif
#endif
-#if !defined PRIdFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIdFAST8
+#if !defined PRIdFAST8
# if INT_FAST8_MAX > INT32_MAX
# define PRIdFAST8 PRId64
# else
# define PRIdFAST8 "d"
# endif
#endif
-#if !defined PRIiFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIiFAST8
+#if !defined PRIiFAST8
# if INT_FAST8_MAX > INT32_MAX
# define PRIiFAST8 PRIi64
# else
# define PRIiFAST8 "i"
# endif
#endif
-#if !defined PRIoFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIoFAST8
+#if !defined PRIoFAST8
# if UINT_FAST8_MAX > UINT32_MAX
# define PRIoFAST8 PRIo64
# else
# define PRIoFAST8 "o"
# endif
#endif
-#if !defined PRIuFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIuFAST8
+#if !defined PRIuFAST8
# if UINT_FAST8_MAX > UINT32_MAX
# define PRIuFAST8 PRIu64
# else
# define PRIuFAST8 "u"
# endif
#endif
-#if !defined PRIxFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIxFAST8
+#if !defined PRIxFAST8
# if UINT_FAST8_MAX > UINT32_MAX
# define PRIxFAST8 PRIx64
# else
# define PRIxFAST8 "x"
# endif
#endif
-#if !defined PRIXFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIXFAST8
+#if !defined PRIXFAST8
# if UINT_FAST8_MAX > UINT32_MAX
# define PRIXFAST8 PRIX64
# else
# define PRIXFAST8 "X"
# endif
#endif
-#if !defined PRIdFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIdFAST16
+#if !defined PRIdFAST16
# if INT_FAST16_MAX > INT32_MAX
# define PRIdFAST16 PRId64
# else
# define PRIdFAST16 "d"
# endif
#endif
-#if !defined PRIiFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIiFAST16
+#if !defined PRIiFAST16
# if INT_FAST16_MAX > INT32_MAX
# define PRIiFAST16 PRIi64
# else
# define PRIiFAST16 "i"
# endif
#endif
-#if !defined PRIoFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIoFAST16
+#if !defined PRIoFAST16
# if UINT_FAST16_MAX > UINT32_MAX
# define PRIoFAST16 PRIo64
# else
# define PRIoFAST16 "o"
# endif
#endif
-#if !defined PRIuFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIuFAST16
+#if !defined PRIuFAST16
# if UINT_FAST16_MAX > UINT32_MAX
# define PRIuFAST16 PRIu64
# else
# define PRIuFAST16 "u"
# endif
#endif
-#if !defined PRIxFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIxFAST16
+#if !defined PRIxFAST16
# if UINT_FAST16_MAX > UINT32_MAX
# define PRIxFAST16 PRIx64
# else
# define PRIxFAST16 "x"
# endif
#endif
-#if !defined PRIXFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIXFAST16
+#if !defined PRIXFAST16
# if UINT_FAST16_MAX > UINT32_MAX
# define PRIXFAST16 PRIX64
# else
# define PRIXFAST16 "X"
# endif
#endif
-#if !defined PRIdFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIdFAST32
+#if !defined PRIdFAST32
# if INT_FAST32_MAX > INT32_MAX
# define PRIdFAST32 PRId64
# else
# define PRIdFAST32 "d"
# endif
#endif
-#if !defined PRIiFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIiFAST32
+#if !defined PRIiFAST32
# if INT_FAST32_MAX > INT32_MAX
# define PRIiFAST32 PRIi64
# else
# define PRIiFAST32 "i"
# endif
#endif
-#if !defined PRIoFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIoFAST32
+#if !defined PRIoFAST32
# if UINT_FAST32_MAX > UINT32_MAX
# define PRIoFAST32 PRIo64
# else
# define PRIoFAST32 "o"
# endif
#endif
-#if !defined PRIuFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIuFAST32
+#if !defined PRIuFAST32
# if UINT_FAST32_MAX > UINT32_MAX
# define PRIuFAST32 PRIu64
# else
# define PRIuFAST32 "u"
# endif
#endif
-#if !defined PRIxFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIxFAST32
+#if !defined PRIxFAST32
# if UINT_FAST32_MAX > UINT32_MAX
# define PRIxFAST32 PRIx64
# else
# define PRIxFAST32 "x"
# endif
#endif
-#if !defined PRIXFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIXFAST32
+#if !defined PRIXFAST32
# if UINT_FAST32_MAX > UINT32_MAX
# define PRIXFAST32 PRIX64
# else
@@ -473,76 +409,64 @@
# endif
#endif
#ifdef INT64_MAX
-# if !defined PRIdFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIdFAST64
+# if !defined PRIdFAST64
# define PRIdFAST64 PRId64
# endif
-# if !defined PRIiFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIiFAST64
+# if !defined PRIiFAST64
# define PRIiFAST64 PRIi64
# endif
#endif
#ifdef UINT64_MAX
-# if !defined PRIoFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIoFAST64
+# if !defined PRIoFAST64
# define PRIoFAST64 PRIo64
# endif
-# if !defined PRIuFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIuFAST64
+# if !defined PRIuFAST64
# define PRIuFAST64 PRIu64
# endif
-# if !defined PRIxFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIxFAST64
+# if !defined PRIxFAST64
# define PRIxFAST64 PRIx64
# endif
-# if !defined PRIXFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIXFAST64
+# if !defined PRIXFAST64
# define PRIXFAST64 PRIX64
# endif
#endif
-#if !defined PRIdMAX || @PRI_MACROS_BROKEN@
-# undef PRIdMAX
+#if !defined PRIdMAX
# if @INT32_MAX_LT_INTMAX_MAX@
# define PRIdMAX PRId64
# else
# define PRIdMAX "ld"
# endif
#endif
-#if !defined PRIiMAX || @PRI_MACROS_BROKEN@
-# undef PRIiMAX
+#if !defined PRIiMAX
# if @INT32_MAX_LT_INTMAX_MAX@
# define PRIiMAX PRIi64
# else
# define PRIiMAX "li"
# endif
#endif
-#if !defined PRIoMAX || @PRI_MACROS_BROKEN@
-# undef PRIoMAX
+#if !defined PRIoMAX
# if @UINT32_MAX_LT_UINTMAX_MAX@
# define PRIoMAX PRIo64
# else
# define PRIoMAX "lo"
# endif
#endif
-#if !defined PRIuMAX || @PRI_MACROS_BROKEN@
-# undef PRIuMAX
+#if !defined PRIuMAX
# if @UINT32_MAX_LT_UINTMAX_MAX@
# define PRIuMAX PRIu64
# else
# define PRIuMAX "lu"
# endif
#endif
-#if !defined PRIxMAX || @PRI_MACROS_BROKEN@
-# undef PRIxMAX
+#if !defined PRIxMAX
# if @UINT32_MAX_LT_UINTMAX_MAX@
# define PRIxMAX PRIx64
# else
# define PRIxMAX "lx"
# endif
#endif
-#if !defined PRIXMAX || @PRI_MACROS_BROKEN@
-# undef PRIXMAX
+#if !defined PRIXMAX
# if @UINT32_MAX_LT_UINTMAX_MAX@
# define PRIXMAX PRIX64
# else
@@ -550,129 +474,108 @@
# endif
#endif
-#if !defined PRIdPTR || @PRI_MACROS_BROKEN@
-# undef PRIdPTR
+#if !defined PRIdPTR
# ifdef INTPTR_MAX
# define PRIdPTR @PRIPTR_PREFIX@ "d"
# endif
#endif
-#if !defined PRIiPTR || @PRI_MACROS_BROKEN@
-# undef PRIiPTR
+#if !defined PRIiPTR
# ifdef INTPTR_MAX
# define PRIiPTR @PRIPTR_PREFIX@ "i"
# endif
#endif
-#if !defined PRIoPTR || @PRI_MACROS_BROKEN@
-# undef PRIoPTR
+#if !defined PRIoPTR
# ifdef UINTPTR_MAX
# define PRIoPTR @PRIPTR_PREFIX@ "o"
# endif
#endif
-#if !defined PRIuPTR || @PRI_MACROS_BROKEN@
-# undef PRIuPTR
+#if !defined PRIuPTR
# ifdef UINTPTR_MAX
# define PRIuPTR @PRIPTR_PREFIX@ "u"
# endif
#endif
-#if !defined PRIxPTR || @PRI_MACROS_BROKEN@
-# undef PRIxPTR
+#if !defined PRIxPTR
# ifdef UINTPTR_MAX
# define PRIxPTR @PRIPTR_PREFIX@ "x"
# endif
#endif
-#if !defined PRIXPTR || @PRI_MACROS_BROKEN@
-# undef PRIXPTR
+#if !defined PRIXPTR
# ifdef UINTPTR_MAX
# define PRIXPTR @PRIPTR_PREFIX@ "X"
# endif
#endif
-#if !defined SCNd8 || @PRI_MACROS_BROKEN@
-# undef SCNd8
+#if !defined SCNd8
# ifdef INT8_MAX
# define SCNd8 "hhd"
# endif
#endif
-#if !defined SCNi8 || @PRI_MACROS_BROKEN@
-# undef SCNi8
+#if !defined SCNi8
# ifdef INT8_MAX
# define SCNi8 "hhi"
# endif
#endif
-#if !defined SCNo8 || @PRI_MACROS_BROKEN@
-# undef SCNo8
+#if !defined SCNo8
# ifdef UINT8_MAX
# define SCNo8 "hho"
# endif
#endif
-#if !defined SCNu8 || @PRI_MACROS_BROKEN@
-# undef SCNu8
+#if !defined SCNu8
# ifdef UINT8_MAX
# define SCNu8 "hhu"
# endif
#endif
-#if !defined SCNx8 || @PRI_MACROS_BROKEN@
-# undef SCNx8
+#if !defined SCNx8
# ifdef UINT8_MAX
# define SCNx8 "hhx"
# endif
#endif
-#if !defined SCNd16 || @PRI_MACROS_BROKEN@
-# undef SCNd16
+#if !defined SCNd16
# ifdef INT16_MAX
# define SCNd16 "hd"
# endif
#endif
-#if !defined SCNi16 || @PRI_MACROS_BROKEN@
-# undef SCNi16
+#if !defined SCNi16
# ifdef INT16_MAX
# define SCNi16 "hi"
# endif
#endif
-#if !defined SCNo16 || @PRI_MACROS_BROKEN@
-# undef SCNo16
+#if !defined SCNo16
# ifdef UINT16_MAX
# define SCNo16 "ho"
# endif
#endif
-#if !defined SCNu16 || @PRI_MACROS_BROKEN@
-# undef SCNu16
+#if !defined SCNu16
# ifdef UINT16_MAX
# define SCNu16 "hu"
# endif
#endif
-#if !defined SCNx16 || @PRI_MACROS_BROKEN@
-# undef SCNx16
+#if !defined SCNx16
# ifdef UINT16_MAX
# define SCNx16 "hx"
# endif
#endif
-#if !defined SCNd32 || @PRI_MACROS_BROKEN@
-# undef SCNd32
+#if !defined SCNd32
# ifdef INT32_MAX
# define SCNd32 "d"
# endif
#endif
-#if !defined SCNi32 || @PRI_MACROS_BROKEN@
-# undef SCNi32
+#if !defined SCNi32
# ifdef INT32_MAX
# define SCNi32 "i"
# endif
#endif
-#if !defined SCNo32 || @PRI_MACROS_BROKEN@
-# undef SCNo32
+#if !defined SCNo32
# ifdef UINT32_MAX
# define SCNo32 "o"
# endif
#endif
-#if !defined SCNu32 || @PRI_MACROS_BROKEN@
-# undef SCNu32
+#if !defined SCNu32
# ifdef UINT32_MAX
# define SCNu32 "u"
# endif
#endif
-#if !defined SCNx32 || @PRI_MACROS_BROKEN@
-# undef SCNx32
+#if !defined SCNx32
# ifdef UINT32_MAX
# define SCNx32 "x"
# endif
@@ -682,15 +585,13 @@
# define _SCN64_PREFIX "l"
# elif defined _MSC_VER || defined __MINGW32__
# define _SCN64_PREFIX "I64"
-# elif @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
+# elif LONG_MAX >> 30 == 1
# define _SCN64_PREFIX _LONG_LONG_FORMAT_PREFIX
# endif
-# if !defined SCNd64 || @PRI_MACROS_BROKEN@
-# undef SCNd64
+# if !defined SCNd64
# define SCNd64 _SCN64_PREFIX "d"
# endif
-# if !defined SCNi64 || @PRI_MACROS_BROKEN@
-# undef SCNi64
+# if !defined SCNi64
# define SCNi64 _SCN64_PREFIX "i"
# endif
#endif
@@ -699,110 +600,86 @@
# define _SCNu64_PREFIX "l"
# elif defined _MSC_VER || defined __MINGW32__
# define _SCNu64_PREFIX "I64"
-# elif @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
+# elif ULONG_MAX >> 31 == 1
# define _SCNu64_PREFIX _LONG_LONG_FORMAT_PREFIX
# endif
-# if !defined SCNo64 || @PRI_MACROS_BROKEN@
-# undef SCNo64
+# if !defined SCNo64
# define SCNo64 _SCNu64_PREFIX "o"
# endif
-# if !defined SCNu64 || @PRI_MACROS_BROKEN@
-# undef SCNu64
+# if !defined SCNu64
# define SCNu64 _SCNu64_PREFIX "u"
# endif
-# if !defined SCNx64 || @PRI_MACROS_BROKEN@
-# undef SCNx64
+# if !defined SCNx64
# define SCNx64 _SCNu64_PREFIX "x"
# endif
#endif
-#if !defined SCNdLEAST8 || @PRI_MACROS_BROKEN@
-# undef SCNdLEAST8
+#if !defined SCNdLEAST8
# define SCNdLEAST8 "hhd"
#endif
-#if !defined SCNiLEAST8 || @PRI_MACROS_BROKEN@
-# undef SCNiLEAST8
+#if !defined SCNiLEAST8
# define SCNiLEAST8 "hhi"
#endif
-#if !defined SCNoLEAST8 || @PRI_MACROS_BROKEN@
-# undef SCNoLEAST8
+#if !defined SCNoLEAST8
# define SCNoLEAST8 "hho"
#endif
-#if !defined SCNuLEAST8 || @PRI_MACROS_BROKEN@
-# undef SCNuLEAST8
+#if !defined SCNuLEAST8
# define SCNuLEAST8 "hhu"
#endif
-#if !defined SCNxLEAST8 || @PRI_MACROS_BROKEN@
-# undef SCNxLEAST8
+#if !defined SCNxLEAST8
# define SCNxLEAST8 "hhx"
#endif
-#if !defined SCNdLEAST16 || @PRI_MACROS_BROKEN@
-# undef SCNdLEAST16
+#if !defined SCNdLEAST16
# define SCNdLEAST16 "hd"
#endif
-#if !defined SCNiLEAST16 || @PRI_MACROS_BROKEN@
-# undef SCNiLEAST16
+#if !defined SCNiLEAST16
# define SCNiLEAST16 "hi"
#endif
-#if !defined SCNoLEAST16 || @PRI_MACROS_BROKEN@
-# undef SCNoLEAST16
+#if !defined SCNoLEAST16
# define SCNoLEAST16 "ho"
#endif
-#if !defined SCNuLEAST16 || @PRI_MACROS_BROKEN@
-# undef SCNuLEAST16
+#if !defined SCNuLEAST16
# define SCNuLEAST16 "hu"
#endif
-#if !defined SCNxLEAST16 || @PRI_MACROS_BROKEN@
-# undef SCNxLEAST16
+#if !defined SCNxLEAST16
# define SCNxLEAST16 "hx"
#endif
-#if !defined SCNdLEAST32 || @PRI_MACROS_BROKEN@
-# undef SCNdLEAST32
+#if !defined SCNdLEAST32
# define SCNdLEAST32 "d"
#endif
-#if !defined SCNiLEAST32 || @PRI_MACROS_BROKEN@
-# undef SCNiLEAST32
+#if !defined SCNiLEAST32
# define SCNiLEAST32 "i"
#endif
-#if !defined SCNoLEAST32 || @PRI_MACROS_BROKEN@
-# undef SCNoLEAST32
+#if !defined SCNoLEAST32
# define SCNoLEAST32 "o"
#endif
-#if !defined SCNuLEAST32 || @PRI_MACROS_BROKEN@
-# undef SCNuLEAST32
+#if !defined SCNuLEAST32
# define SCNuLEAST32 "u"
#endif
-#if !defined SCNxLEAST32 || @PRI_MACROS_BROKEN@
-# undef SCNxLEAST32
+#if !defined SCNxLEAST32
# define SCNxLEAST32 "x"
#endif
#ifdef INT64_MAX
-# if !defined SCNdLEAST64 || @PRI_MACROS_BROKEN@
-# undef SCNdLEAST64
+# if !defined SCNdLEAST64
# define SCNdLEAST64 SCNd64
# endif
-# if !defined SCNiLEAST64 || @PRI_MACROS_BROKEN@
-# undef SCNiLEAST64
+# if !defined SCNiLEAST64
# define SCNiLEAST64 SCNi64
# endif
#endif
#ifdef UINT64_MAX
-# if !defined SCNoLEAST64 || @PRI_MACROS_BROKEN@
-# undef SCNoLEAST64
+# if !defined SCNoLEAST64
# define SCNoLEAST64 SCNo64
# endif
-# if !defined SCNuLEAST64 || @PRI_MACROS_BROKEN@
-# undef SCNuLEAST64
+# if !defined SCNuLEAST64
# define SCNuLEAST64 SCNu64
# endif
-# if !defined SCNxLEAST64 || @PRI_MACROS_BROKEN@
-# undef SCNxLEAST64
+# if !defined SCNxLEAST64
# define SCNxLEAST64 SCNx64
# endif
#endif
-#if !defined SCNdFAST8 || @PRI_MACROS_BROKEN@
-# undef SCNdFAST8
+#if !defined SCNdFAST8
# if INT_FAST8_MAX > INT32_MAX
# define SCNdFAST8 SCNd64
# elif INT_FAST8_MAX == 0x7fff
@@ -813,8 +690,7 @@
# define SCNdFAST8 "d"
# endif
#endif
-#if !defined SCNiFAST8 || @PRI_MACROS_BROKEN@
-# undef SCNiFAST8
+#if !defined SCNiFAST8
# if INT_FAST8_MAX > INT32_MAX
# define SCNiFAST8 SCNi64
# elif INT_FAST8_MAX == 0x7fff
@@ -825,8 +701,7 @@
# define SCNiFAST8 "i"
# endif
#endif
-#if !defined SCNoFAST8 || @PRI_MACROS_BROKEN@
-# undef SCNoFAST8
+#if !defined SCNoFAST8
# if UINT_FAST8_MAX > UINT32_MAX
# define SCNoFAST8 SCNo64
# elif UINT_FAST8_MAX == 0xffff
@@ -837,8 +712,7 @@
# define SCNoFAST8 "o"
# endif
#endif
-#if !defined SCNuFAST8 || @PRI_MACROS_BROKEN@
-# undef SCNuFAST8
+#if !defined SCNuFAST8
# if UINT_FAST8_MAX > UINT32_MAX
# define SCNuFAST8 SCNu64
# elif UINT_FAST8_MAX == 0xffff
@@ -849,8 +723,7 @@
# define SCNuFAST8 "u"
# endif
#endif
-#if !defined SCNxFAST8 || @PRI_MACROS_BROKEN@
-# undef SCNxFAST8
+#if !defined SCNxFAST8
# if UINT_FAST8_MAX > UINT32_MAX
# define SCNxFAST8 SCNx64
# elif UINT_FAST8_MAX == 0xffff
@@ -861,8 +734,7 @@
# define SCNxFAST8 "x"
# endif
#endif
-#if !defined SCNdFAST16 || @PRI_MACROS_BROKEN@
-# undef SCNdFAST16
+#if !defined SCNdFAST16
# if INT_FAST16_MAX > INT32_MAX
# define SCNdFAST16 SCNd64
# elif INT_FAST16_MAX == 0x7fff
@@ -871,8 +743,7 @@
# define SCNdFAST16 "d"
# endif
#endif
-#if !defined SCNiFAST16 || @PRI_MACROS_BROKEN@
-# undef SCNiFAST16
+#if !defined SCNiFAST16
# if INT_FAST16_MAX > INT32_MAX
# define SCNiFAST16 SCNi64
# elif INT_FAST16_MAX == 0x7fff
@@ -881,8 +752,7 @@
# define SCNiFAST16 "i"
# endif
#endif
-#if !defined SCNoFAST16 || @PRI_MACROS_BROKEN@
-# undef SCNoFAST16
+#if !defined SCNoFAST16
# if UINT_FAST16_MAX > UINT32_MAX
# define SCNoFAST16 SCNo64
# elif UINT_FAST16_MAX == 0xffff
@@ -891,8 +761,7 @@
# define SCNoFAST16 "o"
# endif
#endif
-#if !defined SCNuFAST16 || @PRI_MACROS_BROKEN@
-# undef SCNuFAST16
+#if !defined SCNuFAST16
# if UINT_FAST16_MAX > UINT32_MAX
# define SCNuFAST16 SCNu64
# elif UINT_FAST16_MAX == 0xffff
@@ -901,8 +770,7 @@
# define SCNuFAST16 "u"
# endif
#endif
-#if !defined SCNxFAST16 || @PRI_MACROS_BROKEN@
-# undef SCNxFAST16
+#if !defined SCNxFAST16
# if UINT_FAST16_MAX > UINT32_MAX
# define SCNxFAST16 SCNx64
# elif UINT_FAST16_MAX == 0xffff
@@ -911,40 +779,35 @@
# define SCNxFAST16 "x"
# endif
#endif
-#if !defined SCNdFAST32 || @PRI_MACROS_BROKEN@
-# undef SCNdFAST32
+#if !defined SCNdFAST32
# if INT_FAST32_MAX > INT32_MAX
# define SCNdFAST32 SCNd64
# else
# define SCNdFAST32 "d"
# endif
#endif
-#if !defined SCNiFAST32 || @PRI_MACROS_BROKEN@
-# undef SCNiFAST32
+#if !defined SCNiFAST32
# if INT_FAST32_MAX > INT32_MAX
# define SCNiFAST32 SCNi64
# else
# define SCNiFAST32 "i"
# endif
#endif
-#if !defined SCNoFAST32 || @PRI_MACROS_BROKEN@
-# undef SCNoFAST32
+#if !defined SCNoFAST32
# if UINT_FAST32_MAX > UINT32_MAX
# define SCNoFAST32 SCNo64
# else
# define SCNoFAST32 "o"
# endif
#endif
-#if !defined SCNuFAST32 || @PRI_MACROS_BROKEN@
-# undef SCNuFAST32
+#if !defined SCNuFAST32
# if UINT_FAST32_MAX > UINT32_MAX
# define SCNuFAST32 SCNu64
# else
# define SCNuFAST32 "u"
# endif
#endif
-#if !defined SCNxFAST32 || @PRI_MACROS_BROKEN@
-# undef SCNxFAST32
+#if !defined SCNxFAST32
# if UINT_FAST32_MAX > UINT32_MAX
# define SCNxFAST32 SCNx64
# else
@@ -952,64 +815,54 @@
# endif
#endif
#ifdef INT64_MAX
-# if !defined SCNdFAST64 || @PRI_MACROS_BROKEN@
-# undef SCNdFAST64
+# if !defined SCNdFAST64
# define SCNdFAST64 SCNd64
# endif
-# if !defined SCNiFAST64 || @PRI_MACROS_BROKEN@
-# undef SCNiFAST64
+# if !defined SCNiFAST64
# define SCNiFAST64 SCNi64
# endif
#endif
#ifdef UINT64_MAX
-# if !defined SCNoFAST64 || @PRI_MACROS_BROKEN@
-# undef SCNoFAST64
+# if !defined SCNoFAST64
# define SCNoFAST64 SCNo64
# endif
-# if !defined SCNuFAST64 || @PRI_MACROS_BROKEN@
-# undef SCNuFAST64
+# if !defined SCNuFAST64
# define SCNuFAST64 SCNu64
# endif
-# if !defined SCNxFAST64 || @PRI_MACROS_BROKEN@
-# undef SCNxFAST64
+# if !defined SCNxFAST64
# define SCNxFAST64 SCNx64
# endif
#endif
-#if !defined SCNdMAX || @PRI_MACROS_BROKEN@
-# undef SCNdMAX
+#if !defined SCNdMAX
# if @INT32_MAX_LT_INTMAX_MAX@
# define SCNdMAX SCNd64
# else
# define SCNdMAX "ld"
# endif
#endif
-#if !defined SCNiMAX || @PRI_MACROS_BROKEN@
-# undef SCNiMAX
+#if !defined SCNiMAX
# if @INT32_MAX_LT_INTMAX_MAX@
# define SCNiMAX SCNi64
# else
# define SCNiMAX "li"
# endif
#endif
-#if !defined SCNoMAX || @PRI_MACROS_BROKEN@
-# undef SCNoMAX
+#if !defined SCNoMAX
# if @UINT32_MAX_LT_UINTMAX_MAX@
# define SCNoMAX SCNo64
# else
# define SCNoMAX "lo"
# endif
#endif
-#if !defined SCNuMAX || @PRI_MACROS_BROKEN@
-# undef SCNuMAX
+#if !defined SCNuMAX
# if @UINT32_MAX_LT_UINTMAX_MAX@
# define SCNuMAX SCNu64
# else
# define SCNuMAX "lu"
# endif
#endif
-#if !defined SCNxMAX || @PRI_MACROS_BROKEN@
-# undef SCNxMAX
+#if !defined SCNxMAX
# if @UINT32_MAX_LT_UINTMAX_MAX@
# define SCNxMAX SCNx64
# else
@@ -1017,32 +870,27 @@
# endif
#endif
-#if !defined SCNdPTR || @PRI_MACROS_BROKEN@
-# undef SCNdPTR
+#if !defined SCNdPTR
# ifdef INTPTR_MAX
# define SCNdPTR @PRIPTR_PREFIX@ "d"
# endif
#endif
-#if !defined SCNiPTR || @PRI_MACROS_BROKEN@
-# undef SCNiPTR
+#if !defined SCNiPTR
# ifdef INTPTR_MAX
# define SCNiPTR @PRIPTR_PREFIX@ "i"
# endif
#endif
-#if !defined SCNoPTR || @PRI_MACROS_BROKEN@
-# undef SCNoPTR
+#if !defined SCNoPTR
# ifdef UINTPTR_MAX
# define SCNoPTR @PRIPTR_PREFIX@ "o"
# endif
#endif
-#if !defined SCNuPTR || @PRI_MACROS_BROKEN@
-# undef SCNuPTR
+#if !defined SCNuPTR
# ifdef UINTPTR_MAX
# define SCNuPTR @PRIPTR_PREFIX@ "u"
# endif
#endif
-#if !defined SCNxPTR || @PRI_MACROS_BROKEN@
-# undef SCNxPTR
+#if !defined SCNxPTR
# ifdef UINTPTR_MAX
# define SCNxPTR @PRIPTR_PREFIX@ "x"
# endif
@@ -1091,15 +939,19 @@ _GL_WARN_ON_USE (imaxdiv, "imaxdiv is unportable - "
# define strtoimax rpl_strtoimax
# endif
_GL_FUNCDECL_RPL (strtoimax, intmax_t,
- (const char *, char **, int) _GL_ARG_NONNULL ((1)));
-_GL_CXXALIAS_RPL (strtoimax, intmax_t, (const char *, char **, int));
+ (const char *restrict, char **restrict, int)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (strtoimax, intmax_t,
+ (const char *restrict, char **restrict, int));
# else
# if !@HAVE_DECL_STRTOIMAX@
# undef strtoimax
_GL_FUNCDECL_SYS (strtoimax, intmax_t,
- (const char *, char **, int) _GL_ARG_NONNULL ((1)));
+ (const char *restrict, char **restrict, int)
+ _GL_ARG_NONNULL ((1)));
# endif
-_GL_CXXALIAS_SYS (strtoimax, intmax_t, (const char *, char **, int));
+_GL_CXXALIAS_SYS (strtoimax, intmax_t,
+ (const char *restrict, char **restrict, int));
# endif
_GL_CXXALIASWARN (strtoimax);
#elif defined GNULIB_POSIXCHECK
@@ -1117,15 +969,19 @@ _GL_WARN_ON_USE (strtoimax, "strtoimax is unportable - "
# define strtoumax rpl_strtoumax
# endif
_GL_FUNCDECL_RPL (strtoumax, uintmax_t,
- (const char *, char **, int) _GL_ARG_NONNULL ((1)));
-_GL_CXXALIAS_RPL (strtoumax, uintmax_t, (const char *, char **, int));
+ (const char *restrict, char **restrict, int)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (strtoumax, uintmax_t,
+ (const char *restrict, char **restrict, int));
# else
# if !@HAVE_DECL_STRTOUMAX@
# undef strtoumax
_GL_FUNCDECL_SYS (strtoumax, uintmax_t,
- (const char *, char **, int) _GL_ARG_NONNULL ((1)));
+ (const char *restrict, char **restrict, int)
+ _GL_ARG_NONNULL ((1)));
# endif
-_GL_CXXALIAS_SYS (strtoumax, uintmax_t, (const char *, char **, int));
+_GL_CXXALIAS_SYS (strtoumax, uintmax_t,
+ (const char *restrict, char **restrict, int));
# endif
_GL_CXXALIASWARN (strtoumax);
#elif defined GNULIB_POSIXCHECK
diff --git a/lib/lchmod.c b/lib/lchmod.c
new file mode 100644
index 00000000000..77a00609552
--- /dev/null
+++ b/lib/lchmod.c
@@ -0,0 +1,110 @@
+/* Implement lchmod on platforms where it does not work correctly.
+
+ Copyright 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 */
+
+#include <config.h>
+
+/* Specification. */
+#include <sys/stat.h>
+
+#include <errno.h>
+#include <fcntl.h>
+#include <stdio.h>
+#include <unistd.h>
+
+#ifdef __osf__
+/* Write "sys/stat.h" here, not <sys/stat.h>, otherwise OSF/1 5.1 DTK cc
+ eliminates this include because of the preliminary #include <sys/stat.h>
+ above. */
+# include "sys/stat.h"
+#else
+# include <sys/stat.h>
+#endif
+
+#include <intprops.h>
+
+/* Work like chmod, except when FILE is a symbolic link.
+ In that case, on systems where permissions on symbolic links are unsupported
+ (such as Linux), set errno to EOPNOTSUPP and return -1. */
+
+int
+lchmod (char const *file, mode_t mode)
+{
+#if defined O_PATH && defined AT_EMPTY_PATH
+ /* Open a file descriptor with O_NOFOLLOW, to make sure we don't
+ follow symbolic links, if /proc is mounted. O_PATH is used to
+ avoid a failure if the file is not readable.
+ Cf. <https://sourceware.org/bugzilla/show_bug.cgi?id=14578> */
+ int fd = open (file, O_PATH | O_NOFOLLOW | O_CLOEXEC);
+ if (fd < 0)
+ return fd;
+
+ /* Up to Linux 5.3 at least, when FILE refers to a symbolic link, the
+ chmod call below will change the permissions of the symbolic link
+ - which is undesired - and on many file systems (ext4, btrfs, jfs,
+ xfs, ..., but not reiserfs) fail with error EOPNOTSUPP - which is
+ misleading. Therefore test for a symbolic link explicitly.
+ Use fstatat because fstat does not work on O_PATH descriptors
+ before Linux 3.6. */
+ struct stat st;
+ if (fstatat (fd, "", &st, AT_EMPTY_PATH) != 0)
+ {
+ int stat_errno = errno;
+ close (fd);
+ errno = stat_errno;
+ return -1;
+ }
+ if (S_ISLNK (st.st_mode))
+ {
+ close (fd);
+ errno = EOPNOTSUPP;
+ return -1;
+ }
+
+# if defined __linux__ || defined __ANDROID__ || defined __CYGWIN__
+ static char const fmt[] = "/proc/self/fd/%d";
+ char buf[sizeof fmt - sizeof "%d" + INT_BUFSIZE_BOUND (int)];
+ sprintf (buf, fmt, fd);
+ int chmod_result = chmod (buf, mode);
+ int chmod_errno = errno;
+ close (fd);
+ if (chmod_result == 0)
+ return chmod_result;
+ if (chmod_errno != ENOENT)
+ {
+ errno = chmod_errno;
+ return chmod_result;
+ }
+# endif
+ /* /proc is not mounted or would not work as in GNU/Linux. */
+
+#elif HAVE_LSTAT
+ struct stat st;
+ int lstat_result = lstat (file, &st);
+ if (lstat_result != 0)
+ return lstat_result;
+ if (S_ISLNK (st.st_mode))
+ {
+ errno = EOPNOTSUPP;
+ return -1;
+ }
+#endif
+
+ /* Fall back on chmod, despite a possible race. */
+ return chmod (file, mode);
+}
diff --git a/lib/libc-config.h b/lib/libc-config.h
index aef1f793242..1300c3a2ac8 100644
--- a/lib/libc-config.h
+++ b/lib/libc-config.h
@@ -55,8 +55,17 @@
#ifndef __glibc_clang_prereq
# if defined __clang_major__ && defined __clang_minor__
-# define __glibc_clang_prereq(maj, min) \
- ((maj) < __clang_major__ + ((min) <= __clang_minor__))
+# ifdef __apple_build_version__
+/* Apple for some reason renumbers __clang_major__ and __clang_minor__.
+ Gnulib code uses only __glibc_clang_prereq (3, 5); map it to
+ 6000000 <= __apple_build_version__. Support for other calls to
+ __glibc_clang_prereq can be added here as needed. */
+# define __glibc_clang_prereq(maj, min) \
+ ((maj) == 3 && (min) == 5 ? 6000000 <= __apple_build_version__ : 0)
+# else
+# define __glibc_clang_prereq(maj, min) \
+ ((maj) < __clang_major__ + ((min) <= __clang_minor__))
+# endif
# else
# define __glibc_clang_prereq(maj, min) 0
# endif
@@ -171,4 +180,5 @@
/* A substitute for glibc <shlib-compat.h>, good enough for Gnulib. */
#define SHLIB_COMPAT(lib, introduced, obsoleted) 0
-#define versioned_symbol(lib, local, symbol, version)
+#define compat_symbol(lib, local, symbol, version) extern int dummy
+#define versioned_symbol(lib, local, symbol, version) extern int dummy
diff --git a/lib/limits.in.h b/lib/limits.in.h
index 90c273fa178..d25c5237060 100644
--- a/lib/limits.in.h
+++ b/lib/limits.in.h
@@ -15,16 +15,32 @@
You should have received a copy of the GNU General Public License
along with this program; if not, see <https://www.gnu.org/licenses/>. */
-#ifndef _@GUARD_PREFIX@_LIMITS_H
-
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
#endif
@PRAGMA_COLUMNS@
-/* The include_next requires a split double-inclusion guard. */
+#if defined _GL_ALREADY_INCLUDING_LIMITS_H
+/* Special invocation convention:
+ On Haiku/x86_64, we have a sequence of nested includes
+ <limits.h> -> <syslimits.h> -> <limits.h>.
+ In this situation, LONG_MAX and INT_MAX are not yet defined,
+ therefore we should not attempt to define LONG_BIT. */
+
#@INCLUDE_NEXT@ @NEXT_LIMITS_H@
+#else
+/* Normal invocation convention. */
+
+#ifndef _@GUARD_PREFIX@_LIMITS_H
+
+# define _GL_ALREADY_INCLUDING_LIMITS_H
+
+/* The include_next requires a split double-inclusion guard. */
+# @INCLUDE_NEXT@ @NEXT_LIMITS_H@
+
+# undef _GL_ALREADY_INCLUDING_LIMITS_H
+
#ifndef _@GUARD_PREFIX@_LIMITS_H
#define _@GUARD_PREFIX@_LIMITS_H
@@ -102,3 +118,4 @@
#endif /* _@GUARD_PREFIX@_LIMITS_H */
#endif /* _@GUARD_PREFIX@_LIMITS_H */
+#endif
diff --git a/lib/localtime-buffer.c b/lib/localtime-buffer.c
deleted file mode 100644
index eb099ff8d84..00000000000
--- a/lib/localtime-buffer.c
+++ /dev/null
@@ -1,61 +0,0 @@
-/* Provide access to the last buffer returned by localtime() or gmtime().
-
- Copyright (C) 2001-2003, 2005-2007, 2009-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, or (at your option)
- any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, see <https://www.gnu.org/licenses/>. */
-
-/* written by Jim Meyering */
-
-#include <config.h>
-
-/* Specification. */
-#include "localtime-buffer.h"
-
-#if GETTIMEOFDAY_CLOBBERS_LOCALTIME || TZSET_CLOBBERS_LOCALTIME
-
-static struct tm tm_zero_buffer;
-struct tm *localtime_buffer_addr = &tm_zero_buffer;
-
-/* This is a wrapper for localtime.
-
- On the first call, record the address of the static buffer that
- localtime uses for its result. */
-
-struct tm *
-rpl_localtime (time_t const *timep)
-#undef localtime
-{
- struct tm *tm = localtime (timep);
-
- if (localtime_buffer_addr == &tm_zero_buffer)
- localtime_buffer_addr = tm;
-
- return tm;
-}
-
-/* Same as above, since gmtime and localtime use the same buffer. */
-struct tm *
-rpl_gmtime (time_t const *timep)
-#undef gmtime
-{
- struct tm *tm = gmtime (timep);
-
- if (localtime_buffer_addr == &tm_zero_buffer)
- localtime_buffer_addr = tm;
-
- return tm;
-}
-
-#endif
diff --git a/lib/localtime-buffer.h b/lib/localtime-buffer.h
deleted file mode 100644
index 2552cfcffba..00000000000
--- a/lib/localtime-buffer.h
+++ /dev/null
@@ -1,28 +0,0 @@
-/* Provide access to the last buffer returned by localtime() or gmtime().
-
- Copyright (C) 2001-2003, 2005-2007, 2009-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, or (at your option)
- any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, see <https://www.gnu.org/licenses/>. */
-
-/* written by Jim Meyering */
-
-#include <time.h>
-
-#if GETTIMEOFDAY_CLOBBERS_LOCALTIME || TZSET_CLOBBERS_LOCALTIME
-
-/* The address of the last buffer returned by localtime() or gmtime(). */
-extern struct tm *localtime_buffer_addr;
-
-#endif
diff --git a/lib/malloca.c b/lib/malloca.c
index 59bd74d598b..975b166daed 100644
--- a/lib/malloca.c
+++ b/lib/malloca.c
@@ -1,6 +1,5 @@
/* Safe automatic memory allocation.
- Copyright (C) 2003, 2006-2007, 2009-2020 Free Software Foundation,
- Inc.
+ Copyright (C) 2003, 2006-2007, 2009-2020 Free Software Foundation, Inc.
Written by Bruno Haible <bruno@clisp.org>, 2003, 2018.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/malloca.h b/lib/malloca.h
index 0d0b713c7bd..ccc485a6a4d 100644
--- a/lib/malloca.h
+++ b/lib/malloca.h
@@ -89,7 +89,7 @@ extern void freea (void *p);
/* ------------------- Auxiliary, non-public definitions ------------------- */
/* Determine the alignment of a type at compile time. */
-#if defined __GNUC__ || defined __IBM__ALIGNOF__
+#if defined __GNUC__ || defined __clang__ || defined __IBM__ALIGNOF__
# define sa_alignof __alignof__
#elif defined __cplusplus
template <class type> struct sa_alignof_helper { char __slot1; type __slot2; };
@@ -112,14 +112,10 @@ enum
among all elementary types. */
sa_alignment_long = sa_alignof (long),
sa_alignment_double = sa_alignof (double),
-#if HAVE_LONG_LONG_INT
sa_alignment_longlong = sa_alignof (long long),
-#endif
sa_alignment_longdouble = sa_alignof (long double),
sa_alignment_max = ((sa_alignment_long - 1) | (sa_alignment_double - 1)
-#if HAVE_LONG_LONG_INT
| (sa_alignment_longlong - 1)
-#endif
| (sa_alignment_longdouble - 1)
) + 1
};
diff --git a/lib/md5.c b/lib/md5.c
index e0f3032aec0..74cf2c3a0f7 100644
--- a/lib/md5.c
+++ b/lib/md5.c
@@ -1,7 +1,7 @@
/* Functions to compute MD5 message digest of files or memory blocks.
according to the definition of MD5 in RFC 1321 from April 1992.
- Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2020 Free
- Software Foundation, Inc.
+ Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2020 Free Software
+ Foundation, Inc.
This file is part of the GNU C Library.
This program is free software; you can redistribute it and/or modify it
diff --git a/lib/md5.h b/lib/md5.h
index 7c827b0586a..c728ba1b6f2 100644
--- a/lib/md5.h
+++ b/lib/md5.h
@@ -1,7 +1,7 @@
/* Declaration of functions and data types used for MD5 sum computing
library functions.
- Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2020 Free
- Software Foundation, Inc.
+ Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2020 Free Software
+ Foundation, Inc.
This file is part of the GNU C Library.
This program is free software; you can redistribute it and/or modify it
@@ -40,7 +40,7 @@
#endif
#ifndef __THROW
-# if defined __cplusplus && __GNUC_PREREQ (2,8)
+# if defined __cplusplus && (__GNUC_PREREQ (2,8) || __clang_major__ >= 4)
# define __THROW throw ()
# else
# define __THROW
@@ -105,13 +105,15 @@ extern void __md5_process_bytes (const void *buffer, size_t len,
in first 16 bytes following RESBUF. The result is always in little
endian byte order, so that a byte-wise output yields to the wanted
ASCII representation of the message digest. */
-extern void *__md5_finish_ctx (struct md5_ctx *ctx, void *resbuf) __THROW;
+extern void *__md5_finish_ctx (struct md5_ctx *ctx, void *restrict resbuf)
+ __THROW;
/* Put result from CTX in first 16 bytes following RESBUF. The result is
always in little endian byte order, so that a byte-wise output yields
to the wanted ASCII representation of the message digest. */
-extern void *__md5_read_ctx (const struct md5_ctx *ctx, void *resbuf) __THROW;
+extern void *__md5_read_ctx (const struct md5_ctx *ctx, void *restrict resbuf)
+ __THROW;
/* Compute MD5 message digest for LEN bytes beginning at BUFFER. The
@@ -119,7 +121,7 @@ extern void *__md5_read_ctx (const struct md5_ctx *ctx, void *resbuf) __THROW;
output yields to the wanted ASCII representation of the message
digest. */
extern void *__md5_buffer (const char *buffer, size_t len,
- void *resblock) __THROW;
+ void *restrict resblock) __THROW;
# endif
/* Compute MD5 message digest for bytes read from STREAM.
diff --git a/lib/memmem.c b/lib/memmem.c
index 9108f6f697c..6f6574211f8 100644
--- a/lib/memmem.c
+++ b/lib/memmem.c
@@ -1,5 +1,5 @@
-/* Copyright (C) 1991-1994, 1996-1998, 2000, 2004, 2007-2020 Free
- Software Foundation, Inc.
+/* Copyright (C) 1991-1994, 1996-1998, 2000, 2004, 2007-2020 Free Software
+ Foundation, Inc.
This file is part of the GNU C Library.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/memrchr.c b/lib/memrchr.c
index b4256edcbb9..7ff32e11338 100644
--- a/lib/memrchr.c
+++ b/lib/memrchr.c
@@ -1,7 +1,7 @@
/* memrchr -- find the last occurrence of a byte in a memory block
- Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2020 Free
- Software Foundation, Inc.
+ Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2020 Free Software
+ Foundation, Inc.
Based on strlen implementation by Torbjorn Granlund (tege@sics.se),
with help from Dan Sahlin (dan@sics.se) and
diff --git a/lib/mini-gmp-gnulib.c b/lib/mini-gmp-gnulib.c
new file mode 100644
index 00000000000..e9e8a174c03
--- /dev/null
+++ b/lib/mini-gmp-gnulib.c
@@ -0,0 +1,39 @@
+/* Tailor mini-gmp.c for Gnulib-using applications.
+
+ Copyright 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 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#include <stddef.h>
+#include <stdio.h>
+
+#include "mini-gmp.h"
+
+/* Pacify GCC -Wsuggest-attribute=const, pure, malloc. */
+#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
+# pragma GCC diagnostic ignored "-Wsuggest-attribute=const"
+# pragma GCC diagnostic ignored "-Wsuggest-attribute=pure"
+#endif
+#if 8 <= __GNUC__
+# pragma GCC diagnostic ignored "-Wsuggest-attribute=malloc"
+#endif
+
+/* Pacify GCC -Wunused-variable for variables used only in 'assert' calls. */
+#if defined NDEBUG && 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
+# pragma GCC diagnostic ignored "-Wunused-variable"
+#endif
+
+#include "mini-gmp.c"
diff --git a/src/mini-gmp.c b/lib/mini-gmp.c
index bf8a6164981..2e0301b0081 100644
--- a/src/mini-gmp.c
+++ b/lib/mini-gmp.c
@@ -2,21 +2,21 @@
Contributed to the GNU project by Niels Möller
-Copyright 1991-1997, 1999-2019 Free Software Foundation, Inc.
+Copyright 1991-1997, 1999-2020 Free Software Foundation, Inc.
This file is part of the GNU MP Library.
The GNU MP Library is free software; you can redistribute it and/or modify
it under the terms of either:
- * the GNU Lesser General Public License as published by the Free
+ * 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.
or
* the GNU General Public License as published by the Free Software
- Foundation; either version 2 of the License, or (at your option) any
+ Foundation; either version 3 of the License, or (at your option) any
later version.
or both in parallel, as here.
@@ -27,7 +27,7 @@ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
for more details.
You should have received copies of the GNU General Public License and the
-GNU Lesser General Public License along with the GNU MP Library. If not,
+GNU General Public License along with the GNU MP Library. If not,
see https://www.gnu.org/licenses/. */
/* NOTE: All functions in this file which are not declared in
@@ -94,11 +94,13 @@ see https://www.gnu.org/licenses/. */
#define gmp_clz(count, x) do { \
mp_limb_t __clz_x = (x); \
- unsigned __clz_c; \
- for (__clz_c = 0; \
- (__clz_x & ((mp_limb_t) 0xff << (GMP_LIMB_BITS - 8))) == 0; \
- __clz_c += 8) \
- __clz_x <<= 8; \
+ unsigned __clz_c = 0; \
+ int LOCAL_SHIFT_BITS = 8; \
+ if (GMP_LIMB_BITS > LOCAL_SHIFT_BITS) \
+ for (; \
+ (__clz_x & ((mp_limb_t) 0xff << (GMP_LIMB_BITS - 8))) == 0; \
+ __clz_c += 8) \
+ { __clz_x <<= LOCAL_SHIFT_BITS; } \
for (; (__clz_x & GMP_LIMB_HIGHBIT) == 0; __clz_c++) \
__clz_x <<= 1; \
(count) = __clz_c; \
@@ -143,27 +145,27 @@ see https://www.gnu.org/licenses/. */
w1 = (mp_limb_t) (__ww >> LOCAL_GMP_LIMB_BITS); \
} \
else { \
- mp_limb_t __x0, __x1, __x2, __x3; \
- unsigned __ul, __vl, __uh, __vh; \
- mp_limb_t __u = (u), __v = (v); \
+ mp_limb_t __x0, __x1, __x2, __x3; \
+ unsigned __ul, __vl, __uh, __vh; \
+ mp_limb_t __u = (u), __v = (v); \
\
- __ul = __u & GMP_LLIMB_MASK; \
- __uh = __u >> (GMP_LIMB_BITS / 2); \
- __vl = __v & GMP_LLIMB_MASK; \
- __vh = __v >> (GMP_LIMB_BITS / 2); \
+ __ul = __u & GMP_LLIMB_MASK; \
+ __uh = __u >> (GMP_LIMB_BITS / 2); \
+ __vl = __v & GMP_LLIMB_MASK; \
+ __vh = __v >> (GMP_LIMB_BITS / 2); \
\
- __x0 = (mp_limb_t) __ul * __vl; \
- __x1 = (mp_limb_t) __ul * __vh; \
- __x2 = (mp_limb_t) __uh * __vl; \
- __x3 = (mp_limb_t) __uh * __vh; \
+ __x0 = (mp_limb_t) __ul * __vl; \
+ __x1 = (mp_limb_t) __ul * __vh; \
+ __x2 = (mp_limb_t) __uh * __vl; \
+ __x3 = (mp_limb_t) __uh * __vh; \
\
- __x1 += __x0 >> (GMP_LIMB_BITS / 2);/* this can't give carry */ \
- __x1 += __x2; /* but this indeed can */ \
- if (__x1 < __x2) /* did we get it? */ \
- __x3 += GMP_HLIMB_BIT; /* yes, add it in the proper pos. */ \
+ __x1 += __x0 >> (GMP_LIMB_BITS / 2);/* this can't give carry */ \
+ __x1 += __x2; /* but this indeed can */ \
+ if (__x1 < __x2) /* did we get it? */ \
+ __x3 += GMP_HLIMB_BIT; /* yes, add it in the proper pos. */ \
\
- (w1) = __x3 + (__x1 >> (GMP_LIMB_BITS / 2)); \
- (w0) = (__x1 << (GMP_LIMB_BITS / 2)) + (__x0 & GMP_LLIMB_MASK); \
+ (w1) = __x3 + (__x1 >> (GMP_LIMB_BITS / 2)); \
+ (w0) = (__x1 << (GMP_LIMB_BITS / 2)) + (__x0 & GMP_LLIMB_MASK); \
} \
} while (0)
@@ -349,20 +351,27 @@ mp_set_memory_functions (void *(*alloc_func) (size_t),
gmp_free_func = free_func;
}
-#define gmp_xalloc(size) ((*gmp_allocate_func)((size)))
-#define gmp_free(p) ((*gmp_free_func) ((p), 0))
+#define gmp_alloc(size) ((*gmp_allocate_func)((size)))
+#define gmp_free(p, size) ((*gmp_free_func) ((p), (size)))
+#define gmp_realloc(ptr, old_size, size) ((*gmp_reallocate_func)(ptr, old_size, size))
static mp_ptr
-gmp_xalloc_limbs (mp_size_t size)
+gmp_alloc_limbs (mp_size_t size)
{
- return (mp_ptr) gmp_xalloc (size * sizeof (mp_limb_t));
+ return (mp_ptr) gmp_alloc (size * sizeof (mp_limb_t));
}
static mp_ptr
-gmp_xrealloc_limbs (mp_ptr old, mp_size_t size)
+gmp_realloc_limbs (mp_ptr old, mp_size_t old_size, mp_size_t size)
{
assert (size > 0);
- return (mp_ptr) (*gmp_reallocate_func) (old, 0, size * sizeof (mp_limb_t));
+ return (mp_ptr) gmp_realloc (old, old_size * sizeof (mp_limb_t), size * sizeof (mp_limb_t));
+}
+
+static void
+gmp_free_limbs (mp_ptr old, mp_size_t size)
+{
+ gmp_free (old, size * sizeof (mp_limb_t));
}
@@ -768,91 +777,81 @@ mpn_neg (mp_ptr rp, mp_srcptr up, mp_size_t n)
mp_limb_t
mpn_invert_3by2 (mp_limb_t u1, mp_limb_t u0)
{
- int GMP_LIMB_BITS_MUL_3 = GMP_LIMB_BITS * 3;
- if (sizeof (unsigned) * CHAR_BIT > GMP_LIMB_BITS * 3)
- {
- return (((unsigned) 1 << GMP_LIMB_BITS_MUL_3) - 1) /
- (((unsigned) u1 << GMP_LIMB_BITS_MUL_3 / 3) + u0);
- }
- else if (GMP_ULONG_BITS > GMP_LIMB_BITS * 3)
- {
- return (((unsigned long) 1 << GMP_LIMB_BITS_MUL_3) - 1) /
- (((unsigned long) u1 << GMP_LIMB_BITS_MUL_3 / 3) + u0);
- }
- else {
- mp_limb_t r, p, m, ql;
- unsigned ul, uh, qh;
+ mp_limb_t r, m;
- assert (u1 >= GMP_LIMB_HIGHBIT);
+ {
+ mp_limb_t p, ql;
+ unsigned ul, uh, qh;
- /* For notation, let b denote the half-limb base, so that B = b^2.
- Split u1 = b uh + ul. */
- ul = u1 & GMP_LLIMB_MASK;
- uh = u1 >> (GMP_LIMB_BITS / 2);
+ /* For notation, let b denote the half-limb base, so that B = b^2.
+ Split u1 = b uh + ul. */
+ ul = u1 & GMP_LLIMB_MASK;
+ uh = u1 >> (GMP_LIMB_BITS / 2);
- /* Approximation of the high half of quotient. Differs from the 2/1
- inverse of the half limb uh, since we have already subtracted
- u0. */
- qh = ~u1 / uh;
+ /* Approximation of the high half of quotient. Differs from the 2/1
+ inverse of the half limb uh, since we have already subtracted
+ u0. */
+ qh = (u1 ^ GMP_LIMB_MAX) / uh;
- /* Adjust to get a half-limb 3/2 inverse, i.e., we want
+ /* Adjust to get a half-limb 3/2 inverse, i.e., we want
- qh' = floor( (b^3 - 1) / u) - b = floor ((b^3 - b u - 1) / u
- = floor( (b (~u) + b-1) / u),
+ qh' = floor( (b^3 - 1) / u) - b = floor ((b^3 - b u - 1) / u
+ = floor( (b (~u) + b-1) / u),
- and the remainder
+ and the remainder
- r = b (~u) + b-1 - qh (b uh + ul)
+ r = b (~u) + b-1 - qh (b uh + ul)
= b (~u - qh uh) + b-1 - qh ul
- Subtraction of qh ul may underflow, which implies adjustments.
- But by normalization, 2 u >= B > qh ul, so we need to adjust by
- at most 2.
- */
+ Subtraction of qh ul may underflow, which implies adjustments.
+ But by normalization, 2 u >= B > qh ul, so we need to adjust by
+ at most 2.
+ */
- r = ((~u1 - (mp_limb_t) qh * uh) << (GMP_LIMB_BITS / 2)) | GMP_LLIMB_MASK;
+ r = ((~u1 - (mp_limb_t) qh * uh) << (GMP_LIMB_BITS / 2)) | GMP_LLIMB_MASK;
- p = (mp_limb_t) qh * ul;
- /* Adjustment steps taken from udiv_qrnnd_c */
- if (r < p)
- {
- qh--;
- r += u1;
- if (r >= u1) /* i.e. we didn't get carry when adding to r */
- if (r < p)
- {
- qh--;
- r += u1;
- }
- }
- r -= p;
+ p = (mp_limb_t) qh * ul;
+ /* Adjustment steps taken from udiv_qrnnd_c */
+ if (r < p)
+ {
+ qh--;
+ r += u1;
+ if (r >= u1) /* i.e. we didn't get carry when adding to r */
+ if (r < p)
+ {
+ qh--;
+ r += u1;
+ }
+ }
+ r -= p;
- /* Low half of the quotient is
+ /* Low half of the quotient is
ql = floor ( (b r + b-1) / u1).
- This is a 3/2 division (on half-limbs), for which qh is a
- suitable inverse. */
+ This is a 3/2 division (on half-limbs), for which qh is a
+ suitable inverse. */
- p = (r >> (GMP_LIMB_BITS / 2)) * qh + r;
- /* Unlike full-limb 3/2, we can add 1 without overflow. For this to
- work, it is essential that ql is a full mp_limb_t. */
- ql = (p >> (GMP_LIMB_BITS / 2)) + 1;
+ p = (r >> (GMP_LIMB_BITS / 2)) * qh + r;
+ /* Unlike full-limb 3/2, we can add 1 without overflow. For this to
+ work, it is essential that ql is a full mp_limb_t. */
+ ql = (p >> (GMP_LIMB_BITS / 2)) + 1;
- /* By the 3/2 trick, we don't need the high half limb. */
- r = (r << (GMP_LIMB_BITS / 2)) + GMP_LLIMB_MASK - ql * u1;
+ /* By the 3/2 trick, we don't need the high half limb. */
+ r = (r << (GMP_LIMB_BITS / 2)) + GMP_LLIMB_MASK - ql * u1;
- if (r >= (p << (GMP_LIMB_BITS / 2)))
- {
- ql--;
- r += u1;
- }
- m = ((mp_limb_t) qh << (GMP_LIMB_BITS / 2)) + ql;
- if (r >= u1)
- {
- m++;
- r -= u1;
- }
+ if (r >= (GMP_LIMB_MAX & (p << (GMP_LIMB_BITS / 2))))
+ {
+ ql--;
+ r += u1;
+ }
+ m = ((mp_limb_t) qh << (GMP_LIMB_BITS / 2)) + ql;
+ if (r >= u1)
+ {
+ m++;
+ r -= u1;
+ }
+ }
/* Now m is the 2/1 inverse of u1. If u0 > 0, adjust it to become a
3/2 inverse. */
@@ -881,7 +880,6 @@ mpn_invert_3by2 (mp_limb_t u1, mp_limb_t u0)
}
return m;
- }
}
struct gmp_div_inverse
@@ -965,11 +963,17 @@ mpn_div_qr_1_preinv (mp_ptr qp, mp_srcptr np, mp_size_t nn,
mp_limb_t d, di;
mp_limb_t r;
mp_ptr tp = NULL;
+ mp_size_t tn = 0;
if (inv->shift > 0)
{
/* Shift, reusing qp area if possible. In-place shift if qp == np. */
- tp = qp ? qp : gmp_xalloc_limbs (nn);
+ tp = qp;
+ if (!tp)
+ {
+ tn = nn;
+ tp = gmp_alloc_limbs (tn);
+ }
r = mpn_lshift (tp, np, nn, inv->shift);
np = tp;
}
@@ -986,8 +990,8 @@ mpn_div_qr_1_preinv (mp_ptr qp, mp_srcptr np, mp_size_t nn,
if (qp)
qp[nn] = q;
}
- if ((inv->shift > 0) && (tp != qp))
- gmp_free (tp);
+ if (tn)
+ gmp_free_limbs (tp, tn);
return r >> inv->shift;
}
@@ -1145,13 +1149,13 @@ mpn_div_qr (mp_ptr qp, mp_ptr np, mp_size_t nn, mp_srcptr dp, mp_size_t dn)
mpn_div_qr_invert (&inv, dp, dn);
if (dn > 2 && inv.shift > 0)
{
- tp = gmp_xalloc_limbs (dn);
+ tp = gmp_alloc_limbs (dn);
gmp_assert_nocarry (mpn_lshift (tp, dp, dn, inv.shift));
dp = tp;
}
mpn_div_qr_preinv (qp, np, nn, dp, dn, &inv);
if (tp)
- gmp_free (tp);
+ gmp_free_limbs (tp, dn);
}
@@ -1437,14 +1441,14 @@ mpz_init2 (mpz_t r, mp_bitcnt_t bits)
r->_mp_alloc = rn;
r->_mp_size = 0;
- r->_mp_d = gmp_xalloc_limbs (rn);
+ r->_mp_d = gmp_alloc_limbs (rn);
}
void
mpz_clear (mpz_t r)
{
if (r->_mp_alloc)
- gmp_free (r->_mp_d);
+ gmp_free_limbs (r->_mp_d, r->_mp_alloc);
}
static mp_ptr
@@ -1453,9 +1457,9 @@ mpz_realloc (mpz_t r, mp_size_t size)
size = GMP_MAX (size, 1);
if (r->_mp_alloc)
- r->_mp_d = gmp_xrealloc_limbs (r->_mp_d, size);
+ r->_mp_d = gmp_realloc_limbs (r->_mp_d, r->_mp_alloc, size);
else
- r->_mp_d = gmp_xalloc_limbs (size);
+ r->_mp_d = gmp_alloc_limbs (size);
r->_mp_alloc = size;
if (GMP_ABS (r->_mp_size) > size)
@@ -1550,8 +1554,7 @@ mpz_init_set (mpz_t r, const mpz_t x)
int
mpz_fits_slong_p (const mpz_t u)
{
- return (LONG_MAX + LONG_MIN == 0 || mpz_cmp_ui (u, LONG_MAX) <= 0) &&
- mpz_cmpabs_ui (u, GMP_NEG_CAST (unsigned long int, LONG_MIN)) <= 0;
+ return mpz_cmp_si (u, LONG_MAX) <= 0 && mpz_cmp_si (u, LONG_MIN) >= 0;
}
static int
@@ -1574,6 +1577,30 @@ mpz_fits_ulong_p (const mpz_t u)
return us >= 0 && mpn_absfits_ulong_p (u->_mp_d, us);
}
+int
+mpz_fits_sint_p (const mpz_t u)
+{
+ return mpz_cmp_si (u, INT_MAX) <= 0 && mpz_cmp_si (u, INT_MIN) >= 0;
+}
+
+int
+mpz_fits_uint_p (const mpz_t u)
+{
+ return u->_mp_size >= 0 && mpz_cmpabs_ui (u, UINT_MAX) <= 0;
+}
+
+int
+mpz_fits_sshort_p (const mpz_t u)
+{
+ return mpz_cmp_si (u, SHRT_MAX) <= 0 && mpz_cmp_si (u, SHRT_MIN) >= 0;
+}
+
+int
+mpz_fits_ushort_p (const mpz_t u)
+{
+ return u->_mp_size >= 0 && mpz_cmpabs_ui (u, USHRT_MAX) <= 0;
+}
+
long int
mpz_get_si (const mpz_t u)
{
@@ -3082,7 +3109,7 @@ mpz_powm (mpz_t r, const mpz_t b, const mpz_t e, const mpz_t m)
one, using a *normalized* m. */
minv.shift = 0;
- tp = gmp_xalloc_limbs (mn);
+ tp = gmp_alloc_limbs (mn);
gmp_assert_nocarry (mpn_lshift (tp, mp, mn, shift));
mp = tp;
}
@@ -3148,7 +3175,7 @@ mpz_powm (mpz_t r, const mpz_t b, const mpz_t e, const mpz_t m)
tr->_mp_size = mpn_normalized_size (tr->_mp_d, mn);
}
if (tp)
- gmp_free (tp);
+ gmp_free_limbs (tp, mn);
mpz_swap (r, tr);
mpz_clear (tr);
@@ -3332,7 +3359,7 @@ mpz_bin_uiui (mpz_t r, unsigned long n, unsigned long k)
mpz_fac_ui (t, k);
for (; k > 0; --k)
- mpz_mul_ui (r, r, n--);
+ mpz_mul_ui (r, r, n--);
mpz_divexact (r, r, t);
mpz_clear (t);
@@ -3359,13 +3386,15 @@ gmp_jacobi_coprime (mp_limb_t a, mp_limb_t b)
gmp_ctz(c, a);
a >>= 1;
- do
+ for (;;)
{
a >>= c;
/* (2/b) = -1 if b = 3 or 5 mod 8 */
bit ^= c & (b ^ (b >> 1));
if (a < b)
{
+ if (a == 0)
+ return bit & 1 ? -1 : 1;
bit ^= a & b;
a = b - a;
b -= a;
@@ -3379,9 +3408,6 @@ gmp_jacobi_coprime (mp_limb_t a, mp_limb_t b)
gmp_ctz(c, a);
++c;
}
- while (b > 0);
-
- return bit & 1 ? -1 : 1;
}
static void
@@ -3990,13 +4016,18 @@ gmp_popcount_limb (mp_limb_t x)
unsigned c;
/* Do 16 bits at a time, to avoid limb-sized constants. */
- for (c = 0; x > 0; x >>= 16)
+ int LOCAL_SHIFT_BITS = 16;
+ for (c = 0; x > 0;)
{
unsigned w = x - ((x >> 1) & 0x5555);
w = ((w >> 2) & 0x3333) + (w & 0x3333);
w = (w >> 4) + w;
w = ((w >> 8) & 0x000f) + (w & 0x000f);
c += w;
+ if (GMP_LIMB_BITS > LOCAL_SHIFT_BITS)
+ x >>= LOCAL_SHIFT_BITS;
+ else
+ x = 0;
}
return c;
}
@@ -4148,7 +4179,7 @@ mpz_scan0 (const mpz_t u, mp_bitcnt_t starting_bit)
size_t
mpz_sizeinbase (const mpz_t u, int base)
{
- mp_size_t un;
+ mp_size_t un, tn;
mp_srcptr up;
mp_ptr tp;
mp_bitcnt_t bits;
@@ -4181,20 +4212,21 @@ mpz_sizeinbase (const mpz_t u, int base)
10. */
}
- tp = gmp_xalloc_limbs (un);
+ tp = gmp_alloc_limbs (un);
mpn_copyi (tp, up, un);
mpn_div_qr_1_invert (&bi, base);
+ tn = un;
ndigits = 0;
do
{
ndigits++;
- mpn_div_qr_1_preinv (tp, tp, un, &bi);
- un -= (tp[un-1] == 0);
+ mpn_div_qr_1_preinv (tp, tp, tn, &bi);
+ tn -= (tp[tn-1] == 0);
}
- while (un > 0);
+ while (tn > 0);
- gmp_free (tp);
+ gmp_free_limbs (tp, un);
return ndigits;
}
@@ -4204,7 +4236,7 @@ mpz_get_str (char *sp, int base, const mpz_t u)
unsigned bits;
const char *digits;
mp_size_t un;
- size_t i, sn;
+ size_t i, sn, osn;
digits = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
if (base > 1)
@@ -4225,15 +4257,19 @@ mpz_get_str (char *sp, int base, const mpz_t u)
sn = 1 + mpz_sizeinbase (u, base);
if (!sp)
- sp = (char *) gmp_xalloc (1 + sn);
-
+ {
+ osn = 1 + sn;
+ sp = (char *) gmp_alloc (osn);
+ }
+ else
+ osn = 0;
un = GMP_ABS (u->_mp_size);
if (un == 0)
{
sp[0] = '0';
- sp[1] = '\0';
- return sp;
+ sn = 1;
+ goto ret;
}
i = 0;
@@ -4252,17 +4288,20 @@ mpz_get_str (char *sp, int base, const mpz_t u)
mp_ptr tp;
mpn_get_base_info (&info, base);
- tp = gmp_xalloc_limbs (un);
+ tp = gmp_alloc_limbs (un);
mpn_copyi (tp, u->_mp_d, un);
sn = i + mpn_get_str_other ((unsigned char *) sp + i, base, &info, tp, un);
- gmp_free (tp);
+ gmp_free_limbs (tp, un);
}
for (; i < sn; i++)
sp[i] = digits[(unsigned char) sp[i]];
+ret:
sp[sn] = '\0';
+ if (osn && osn != sn + 1)
+ sp = gmp_realloc(sp, osn, sn + 1);
return sp;
}
@@ -4272,7 +4311,7 @@ mpz_set_str (mpz_t r, const char *sp, int base)
unsigned bits, value_of_a;
mp_size_t rn, alloc;
mp_ptr rp;
- size_t dn;
+ size_t dn, sn;
int sign;
unsigned char *dp;
@@ -4310,7 +4349,8 @@ mpz_set_str (mpz_t r, const char *sp, int base)
r->_mp_size = 0;
return -1;
}
- dp = (unsigned char *) gmp_xalloc (strlen (sp));
+ sn = strlen(sp);
+ dp = (unsigned char *) gmp_alloc (sn);
value_of_a = (base > 36) ? 36 : 10;
for (dn = 0; *sp; sp++)
@@ -4330,7 +4370,7 @@ mpz_set_str (mpz_t r, const char *sp, int base)
if (digit >= (unsigned) base)
{
- gmp_free (dp);
+ gmp_free (dp, sn);
r->_mp_size = 0;
return -1;
}
@@ -4340,7 +4380,7 @@ mpz_set_str (mpz_t r, const char *sp, int base)
if (!dn)
{
- gmp_free (dp);
+ gmp_free (dp, sn);
r->_mp_size = 0;
return -1;
}
@@ -4364,7 +4404,7 @@ mpz_set_str (mpz_t r, const char *sp, int base)
rn -= rp[rn-1] == 0;
}
assert (rn <= alloc);
- gmp_free (dp);
+ gmp_free (dp, sn);
r->_mp_size = sign ? - rn : rn;
@@ -4382,13 +4422,13 @@ size_t
mpz_out_str (FILE *stream, int base, const mpz_t x)
{
char *str;
- size_t len;
+ size_t len, n;
str = mpz_get_str (NULL, base, x);
len = strlen (str);
- len = fwrite (str, 1, len, stream);
- gmp_free (str);
- return len;
+ n = fwrite (str, 1, len, stream);
+ gmp_free (str, len + 1);
+ return n;
}
@@ -4503,15 +4543,20 @@ mpz_export (void *r, size_t *countp, int order, size_t size, int endian,
limb = u->_mp_d[un-1];
assert (limb != 0);
- k = 0;
- do {
- k++; limb >>= CHAR_BIT;
- } while (limb != 0);
+ k = (GMP_LIMB_BITS <= CHAR_BIT);
+ if (!k)
+ {
+ do {
+ int LOCAL_CHAR_BIT = CHAR_BIT;
+ k++; limb >>= LOCAL_CHAR_BIT;
+ } while (limb != 0);
+ }
+ /* else limb = 0; */
count = (k + (un-1) * sizeof (mp_limb_t) + size - 1) / size;
if (!r)
- r = gmp_xalloc (count * size);
+ r = gmp_alloc (count * size);
if (endian == 0)
endian = gmp_detect_endian ();
@@ -4535,17 +4580,28 @@ mpz_export (void *r, size_t *countp, int order, size_t size, int endian,
for (bytes = 0, i = 0, k = 0; k < count; k++, p += word_step)
{
size_t j;
- for (j = 0; j < size; j++, p -= (ptrdiff_t) endian)
+ for (j = 0; j < size; ++j, p -= (ptrdiff_t) endian)
{
- if (bytes == 0)
+ if (sizeof (mp_limb_t) == 1)
{
if (i < un)
- limb = u->_mp_d[i++];
- bytes = sizeof (mp_limb_t);
+ *p = u->_mp_d[i++];
+ else
+ *p = 0;
+ }
+ else
+ {
+ int LOCAL_CHAR_BIT = CHAR_BIT;
+ if (bytes == 0)
+ {
+ if (i < un)
+ limb = u->_mp_d[i++];
+ bytes = sizeof (mp_limb_t);
+ }
+ *p = limb;
+ limb >>= LOCAL_CHAR_BIT;
+ bytes--;
}
- *p = limb;
- limb >>= CHAR_BIT;
- bytes--;
}
}
assert (i == un);
diff --git a/src/mini-gmp.h b/lib/mini-gmp.h
index 27e0c0671a2..c00568c2568 100644
--- a/src/mini-gmp.h
+++ b/lib/mini-gmp.h
@@ -1,20 +1,20 @@
/* mini-gmp, a minimalistic implementation of a GNU GMP subset.
-Copyright 2011-2015, 2017 Free Software Foundation, Inc.
+Copyright 2011-2015, 2017, 2019 Free Software Foundation, Inc.
This file is part of the GNU MP Library.
The GNU MP Library is free software; you can redistribute it and/or modify
it under the terms of either:
- * the GNU Lesser General Public License as published by the Free
+ * 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.
or
* the GNU General Public License as published by the Free Software
- Foundation; either version 2 of the License, or (at your option) any
+ Foundation; either version 3 of the License, or (at your option) any
later version.
or both in parallel, as here.
@@ -25,7 +25,7 @@ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
for more details.
You should have received copies of the GNU General Public License and the
-GNU Lesser General Public License along with the GNU MP Library. If not,
+GNU General Public License along with the GNU MP Library. If not,
see https://www.gnu.org/licenses/. */
/* About mini-gmp: This is a minimal implementation of a subset of the
@@ -53,7 +53,11 @@ void mp_get_memory_functions (void *(**) (size_t),
void *(**) (void *, size_t, size_t),
void (**) (void *, size_t));
-typedef unsigned long mp_limb_t;
+#ifndef MINI_GMP_LIMB_TYPE
+#define MINI_GMP_LIMB_TYPE long
+#endif
+
+typedef unsigned MINI_GMP_LIMB_TYPE mp_limb_t;
typedef long mp_size_t;
typedef unsigned long mp_bitcnt_t;
@@ -240,6 +244,10 @@ mp_bitcnt_t mpz_scan1 (const mpz_t, mp_bitcnt_t);
int mpz_fits_slong_p (const mpz_t);
int mpz_fits_ulong_p (const mpz_t);
+int mpz_fits_sint_p (const mpz_t);
+int mpz_fits_uint_p (const mpz_t);
+int mpz_fits_sshort_p (const mpz_t);
+int mpz_fits_ushort_p (const mpz_t);
long int mpz_get_si (const mpz_t);
unsigned long int mpz_get_ui (const mpz_t);
double mpz_get_d (const mpz_t);
diff --git a/lib/mktime.c b/lib/mktime.c
index a13fa27e2bc..5b4c144ecad 100644
--- a/lib/mktime.c
+++ b/lib/mktime.c
@@ -94,7 +94,7 @@ my_tzset (void)
const char *tz = getenv ("TZ");
if (tz != NULL && strchr (tz, '/') != NULL)
_putenv ("TZ=");
-# elif HAVE_TZSET
+# else
tzset ();
# endif
}
@@ -141,7 +141,7 @@ shr (long_int a, int b)
long_int one = 1;
return (-one >> 1 == -1
? a >> b
- : a / (one << b) - (a % (one << b) < 0));
+ : (a + (a < 0)) / (one << b) - (a < 0));
}
/* Bounds for the intersection of __time64_t and long_int. */
@@ -211,8 +211,8 @@ ydhms_diff (long_int year1, long_int yday1, int hour1, int min1, int sec1,
Take care to avoid integer overflow here. */
int a4 = shr (year1, 2) + shr (TM_YEAR_BASE, 2) - ! (year1 & 3);
int b4 = shr (year0, 2) + shr (TM_YEAR_BASE, 2) - ! (year0 & 3);
- int a100 = a4 / 25 - (a4 % 25 < 0);
- int b100 = b4 / 25 - (b4 % 25 < 0);
+ int a100 = (a4 + (a4 < 0)) / 25 - (a4 < 0);
+ int b100 = (b4 + (b4 < 0)) / 25 - (b4 < 0);
int a400 = shr (a100, 2);
int b400 = shr (b100, 2);
int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400);
diff --git a/lib/nstrftime.c b/lib/nstrftime.c
index 667c7ddc56e..7d5a97f7635 100644
--- a/lib/nstrftime.c
+++ b/lib/nstrftime.c
@@ -21,7 +21,6 @@
# define HAVE_TM_GMTOFF 1
# define HAVE_TM_ZONE 1
# define HAVE_TZNAME 1
-# define HAVE_TZSET 1
# include "../locale/localeinfo.h"
#else
# include <config.h>
@@ -34,6 +33,7 @@
#endif
#include <ctype.h>
+#include <errno.h>
#include <time.h>
#if HAVE_TZNAME && !HAVE_DECL_TZNAME
@@ -68,16 +68,9 @@ extern char *tzname[];
#include <string.h>
#include <stdbool.h>
+#include "attribute.h"
#include <intprops.h>
-#ifndef FALLTHROUGH
-# if __GNUC__ < 7
-# define FALLTHROUGH ((void) 0)
-# else
-# define FALLTHROUGH __attribute__ ((__fallthrough__))
-# endif
-#endif
-
#ifdef COMPILE_WIDE
# include <endian.h>
# define CHAR_T wchar_t
@@ -113,7 +106,7 @@ extern char *tzname[];
#define SHR(a, b) \
(-1 >> 1 == -1 \
? (a) >> (b) \
- : (a) / (1 << (b)) - ((a) % (1 << (b)) < 0))
+ : ((a) + ((a) < 0)) / (1 << (b)) - ((a) < 0))
#define TM_YEAR_BASE 1900
@@ -170,7 +163,10 @@ extern char *tzname[];
size_t _w = pad == L_('-') || width < 0 ? 0 : width; \
size_t _incr = _n < _w ? _w : _n; \
if (_incr >= maxsize - i) \
- return 0; \
+ { \
+ errno = ERANGE; \
+ return 0; \
+ } \
if (p) \
{ \
if (_n < _w) \
@@ -348,8 +344,8 @@ tm_diff (const struct tm *a, const struct tm *b)
but it's OK to assume that A and B are close to each other. */
int a4 = SHR (a->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (a->tm_year & 3);
int b4 = SHR (b->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (b->tm_year & 3);
- int a100 = a4 / 25 - (a4 % 25 < 0);
- int b100 = b4 / 25 - (b4 % 25 < 0);
+ int a100 = (a4 + (a4 < 0)) / 25 - (a4 < 0);
+ int b100 = (b4 + (b4 < 0)) / 25 - (b4 < 0);
int a400 = SHR (a100, 2);
int b400 = SHR (b100, 2);
int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400);
@@ -372,7 +368,7 @@ tm_diff (const struct tm *a, const struct tm *b)
#define ISO_WEEK1_WDAY 4 /* Thursday */
#define YDAY_MINIMUM (-366)
static int iso_week_days (int, int);
-#ifdef __GNUC__
+#if defined __GNUC__ || defined __clang__
__inline__
#endif
static int
@@ -396,7 +392,6 @@ iso_week_days (int yday, int wday)
#endif
#ifdef my_strftime
-# undef HAVE_TZSET
# define extra_args , tz, ns
# define extra_args_spec , timezone_t tz, int ns
#else
@@ -456,6 +451,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
size_t maxsize = (size_t) -1;
#endif
+ int saved_errno = errno;
int hour12 = tp->tm_hour;
#ifdef _NL_CURRENT
/* We cannot make the following values variables since we must delay
@@ -502,15 +498,6 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
const char *format_end = NULL;
#endif
-#if ! defined _LIBC && ! HAVE_RUN_TZSET_TEST
- /* Solaris 2.5.x and 2.6 tzset sometimes modify the storage returned
- by localtime. On such systems, we must either use the tzset and
- localtime wrappers to work around the bug (which sets
- HAVE_RUN_TZSET_TEST) or make a copy of the structure. */
- struct tm copy = *tp;
- tp = &copy;
-#endif
-
zone = NULL;
#if HAVE_TM_ZONE
/* The POSIX test suite assumes that setting
@@ -539,7 +526,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
{
/* POSIX.1 requires that local time zone information be used as
though strftime called tzset. */
-# if HAVE_TZSET
+# ifndef my_strftime
if (!*tzset_called)
{
tzset ();
@@ -927,9 +914,11 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
}
{
- int century = tp->tm_year / 100 + TM_YEAR_BASE / 100;
- century -= tp->tm_year % 100 < 0 && 0 < century;
- DO_YEARISH (2, tp->tm_year < - TM_YEAR_BASE, century);
+ bool negative_year = tp->tm_year < - TM_YEAR_BASE;
+ bool zero_thru_1899 = !negative_year & (tp->tm_year < 0);
+ int century = ((tp->tm_year - 99 * zero_thru_1899) / 100
+ + TM_YEAR_BASE / 100);
+ DO_YEARISH (2, negative_year, century);
}
case L_('x'):
@@ -1138,8 +1127,8 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
int ndigs = ns_digits;
while (width < ndigs || (1 < ndigs && n % 10 == 0))
ndigs--, n /= 10;
- for (int i = ndigs; 0 < i; i--)
- buf[i - 1] = n % 10 + L_('0'), n /= 10;
+ for (int j = ndigs; 0 < j; j--)
+ buf[j - 1] = n % 10 + L_('0'), n /= 10;
if (!pad)
pad = L_('0');
width_cpy (0, ndigs, buf);
@@ -1202,7 +1191,13 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
time_t t;
ltm = *tp;
+ ltm.tm_yday = -1;
t = mktime_z (tz, &ltm);
+ if (ltm.tm_yday < 0)
+ {
+ errno = EOVERFLOW;
+ return 0;
+ }
/* Generate string value for T using time_t arithmetic;
this works even if sizeof (long) < sizeof (time_t). */
@@ -1431,7 +1426,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
/* POSIX.1 requires that local time zone information be used as
though strftime called tzset. */
-# if HAVE_TZSET
+# ifndef my_strftime
if (!*tzset_called)
{
tzset ();
@@ -1500,5 +1495,6 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
*p = L_('\0');
#endif
+ errno = saved_errno;
return i;
}
diff --git a/lib/open.c b/lib/open.c
index 487194f6652..0f7c6e9b9d3 100644
--- a/lib/open.c
+++ b/lib/open.c
@@ -30,7 +30,11 @@
static int
orig_open (const char *filename, int flags, mode_t mode)
{
+#if defined _WIN32 && !defined __CYGWIN__
+ return _open (filename, flags, mode);
+#else
return open (filename, flags, mode);
+#endif
}
/* Specification. */
@@ -110,7 +114,9 @@ open (const char *filename, int flags, ...)
directories,
- if O_WRONLY or O_RDWR is specified, open() must fail because the
file does not contain a '.' directory. */
- if (flags & (O_CREAT | O_WRONLY | O_RDWR))
+ if ((flags & O_CREAT)
+ || (flags & O_ACCMODE) == O_RDWR
+ || (flags & O_ACCMODE) == O_WRONLY)
{
size_t len = strlen (filename);
if (len > 0 && filename[len - 1] == '/')
@@ -122,7 +128,7 @@ open (const char *filename, int flags, ...)
#endif
fd = orig_open (filename,
- flags & ~(have_cloexec <= 0 ? O_CLOEXEC : 0), mode);
+ flags & ~(have_cloexec < 0 ? O_CLOEXEC : 0), mode);
if (flags & O_CLOEXEC)
{
diff --git a/lib/openat-proc.c b/lib/openat-proc.c
index 9111cd3d7ee..b5aaee8b1d3 100644
--- a/lib/openat-proc.c
+++ b/lib/openat-proc.c
@@ -73,8 +73,9 @@ openat_proc_name (char buf[OPENAT_BUFFER_SIZE], int fd, char const *file)
problem is exhibited on code that built on Solaris 8 and
running on Solaris 10. */
- int proc_self_fd = open ("/proc/self/fd",
- O_SEARCH | O_DIRECTORY | O_NOCTTY | O_NONBLOCK);
+ int proc_self_fd =
+ open ("/proc/self/fd",
+ O_SEARCH | O_DIRECTORY | O_NOCTTY | O_NONBLOCK | O_CLOEXEC);
if (proc_self_fd < 0)
proc_status = -1;
else
diff --git a/lib/openat.h b/lib/openat.h
index 7589150f34f..824ce560e34 100644
--- a/lib/openat.h
+++ b/lib/openat.h
@@ -52,19 +52,19 @@ _Noreturn void openat_save_fail (int);
slightly more readable than it would be with
fchownat (..., 0) or fchownat (..., AT_SYMLINK_NOFOLLOW). */
-#if GNULIB_FCHOWNAT
+#if GNULIB_CHOWNAT
-# ifndef FCHOWNAT_INLINE
-# define FCHOWNAT_INLINE _GL_INLINE
+# ifndef CHOWNAT_INLINE
+# define CHOWNAT_INLINE _GL_INLINE
# endif
-FCHOWNAT_INLINE int
+CHOWNAT_INLINE int
chownat (int fd, char const *file, uid_t owner, gid_t group)
{
return fchownat (fd, file, owner, group, 0);
}
-FCHOWNAT_INLINE int
+CHOWNAT_INLINE int
lchownat (int fd, char const *file, uid_t owner, gid_t group)
{
return fchownat (fd, file, owner, group, AT_SYMLINK_NOFOLLOW);
@@ -72,19 +72,19 @@ lchownat (int fd, char const *file, uid_t owner, gid_t group)
#endif
-#if GNULIB_FCHMODAT
+#if GNULIB_CHMODAT
-# ifndef FCHMODAT_INLINE
-# define FCHMODAT_INLINE _GL_INLINE
+# ifndef CHMODAT_INLINE
+# define CHMODAT_INLINE _GL_INLINE
# endif
-FCHMODAT_INLINE int
+CHMODAT_INLINE int
chmodat (int fd, char const *file, mode_t mode)
{
return fchmodat (fd, file, mode, 0);
}
-FCHMODAT_INLINE int
+CHMODAT_INLINE int
lchmodat (int fd, char const *file, mode_t mode)
{
return fchmodat (fd, file, mode, AT_SYMLINK_NOFOLLOW);
diff --git a/lib/putenv.c b/lib/putenv.c
deleted file mode 100644
index 9e862e63d3d..00000000000
--- a/lib/putenv.c
+++ /dev/null
@@ -1,194 +0,0 @@
-/* Copyright (C) 1991, 1994, 1997-1998, 2000, 2003-2020 Free Software
- Foundation, Inc.
-
- NOTE: The canonical source of this file is maintained with the GNU C
- Library. Bugs can be reported to bug-glibc@prep.ai.mit.edu.
-
- 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 any
- later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <https://www.gnu.org/licenses/>. */
-
-#include <config.h>
-
-/* Specification. */
-#include <stdlib.h>
-
-#include <stddef.h>
-
-/* Include errno.h *after* sys/types.h to work around header problems
- on AIX 3.2.5. */
-#include <errno.h>
-#ifndef __set_errno
-# define __set_errno(ev) ((errno) = (ev))
-#endif
-
-#include <string.h>
-#include <unistd.h>
-
-#if defined _WIN32 && ! defined __CYGWIN__
-# define WIN32_LEAN_AND_MEAN
-# include <windows.h>
-#endif
-
-#if _LIBC
-# if HAVE_GNU_LD
-# define environ __environ
-# else
-extern char **environ;
-# endif
-#endif
-
-#if _LIBC
-/* This lock protects against simultaneous modifications of 'environ'. */
-# include <bits/libc-lock.h>
-__libc_lock_define_initialized (static, envlock)
-# define LOCK __libc_lock_lock (envlock)
-# define UNLOCK __libc_lock_unlock (envlock)
-#else
-# define LOCK
-# define UNLOCK
-#endif
-
-static int
-_unsetenv (const char *name)
-{
- size_t len;
-#if !HAVE_DECL__PUTENV
- char **ep;
-#endif
-
- if (name == NULL || *name == '\0' || strchr (name, '=') != NULL)
- {
- __set_errno (EINVAL);
- return -1;
- }
-
- len = strlen (name);
-
-#if HAVE_DECL__PUTENV
- {
- int putenv_result, putenv_errno;
- char *name_ = malloc (len + 2);
- memcpy (name_, name, len);
- name_[len] = '=';
- name_[len + 1] = 0;
- putenv_result = _putenv (name_);
- putenv_errno = errno;
- free (name_);
- __set_errno (putenv_errno);
- return putenv_result;
- }
-#else
-
- LOCK;
-
- ep = environ;
- while (*ep != NULL)
- if (!strncmp (*ep, name, len) && (*ep)[len] == '=')
- {
- /* Found it. Remove this pointer by moving later ones back. */
- char **dp = ep;
-
- do
- dp[0] = dp[1];
- while (*dp++);
- /* Continue the loop in case NAME appears again. */
- }
- else
- ++ep;
-
- UNLOCK;
-
- return 0;
-#endif
-}
-
-
-/* Put STRING, which is of the form "NAME=VALUE", in the environment.
- If STRING contains no '=', then remove STRING from the environment. */
-int
-putenv (char *string)
-{
- const char *name_end = strchr (string, '=');
- char **ep;
-
- if (name_end == NULL)
- {
- /* Remove the variable from the environment. */
- return _unsetenv (string);
- }
-
-#if HAVE_DECL__PUTENV
- /* Rely on _putenv to allocate the new environment. If other
- parts of the application use _putenv, the !HAVE_DECL__PUTENV code
- would fight over who owns the environ vector, causing a crash. */
- if (name_end[1])
- return _putenv (string);
- else
- {
- /* _putenv ("NAME=") unsets NAME, so invoke _putenv ("NAME= ")
- to allocate the environ vector and then replace the new
- entry with "NAME=". */
- int putenv_result, putenv_errno;
- char *name_x = malloc (name_end - string + sizeof "= ");
- if (!name_x)
- return -1;
- memcpy (name_x, string, name_end - string + 1);
- name_x[name_end - string + 1] = ' ';
- name_x[name_end - string + 2] = 0;
- putenv_result = _putenv (name_x);
- putenv_errno = errno;
- for (ep = environ; *ep; ep++)
- if (strcmp (*ep, name_x) == 0)
- {
- *ep = string;
- break;
- }
-# if defined _WIN32 && ! defined __CYGWIN__
- if (putenv_result == 0)
- {
- /* _putenv propagated "NAME= " into the subprocess environment;
- fix that by calling SetEnvironmentVariable directly. */
- name_x[name_end - string] = 0;
- putenv_result = SetEnvironmentVariable (name_x, "") ? 0 : -1;
- putenv_errno = ENOMEM; /* ENOMEM is the only way to fail. */
- }
-# endif
- free (name_x);
- __set_errno (putenv_errno);
- return putenv_result;
- }
-#else
- for (ep = environ; *ep; ep++)
- if (strncmp (*ep, string, name_end - string) == 0
- && (*ep)[name_end - string] == '=')
- break;
-
- if (*ep)
- *ep = string;
- else
- {
- static char **last_environ = NULL;
- size_t size = ep - environ;
- char **new_environ = malloc ((size + 2) * sizeof *new_environ);
- if (! new_environ)
- return -1;
- new_environ[0] = string;
- memcpy (new_environ + 1, environ, (size + 1) * sizeof *new_environ);
- free (last_environ);
- last_environ = new_environ;
- environ = new_environ;
- }
-
- return 0;
-#endif
-}
diff --git a/lib/regcomp.c b/lib/regcomp.c
index 84044be5e09..a4b95b0b2ff 100644
--- a/lib/regcomp.c
+++ b/lib/regcomp.c
@@ -558,7 +558,7 @@ weak_alias (__regerror, regerror)
static const bitset_t utf8_sb_map =
{
/* Set the first 128 bits. */
-# if defined __GNUC__ && !defined __STRICT_ANSI__
+# if (defined __GNUC__ || __clang_major__ >= 4) && !defined __STRICT_ANSI__
[0 ... 0x80 / BITSET_WORD_BITS - 1] = BITSET_WORD_MAX
# else
# if 4 * BITSET_WORD_BITS < ASCII_CHARS
diff --git a/lib/regex.c b/lib/regex.c
index 6bdd77f50b2..88173bb1052 100644
--- a/lib/regex.c
+++ b/lib/regex.c
@@ -17,6 +17,8 @@
License along with the GNU C Library; if not, see
<https://www.gnu.org/licenses/>. */
+#define __STDC_WANT_IEC_60559_BFP_EXT__
+
#ifndef _LIBC
# include <libc-config.h>
diff --git a/lib/regex.h b/lib/regex.h
index 76ff4e342fe..306521a3e8a 100644
--- a/lib/regex.h
+++ b/lib/regex.h
@@ -600,11 +600,9 @@ extern void re_set_registers (struct re_pattern_buffer *__buffer,
#endif /* Use GNU */
#if defined _REGEX_RE_COMP || (defined _LIBC && defined __USE_MISC)
-# ifndef _CRAY
/* 4.2 bsd compatibility. */
extern char *re_comp (const char *);
extern int re_exec (const char *);
-# endif
#endif
/* For plain 'restrict', use glibc's __restrict if defined.
@@ -614,7 +612,9 @@ extern int re_exec (const char *);
'configure' might #define 'restrict' to those words, so pick a
different name. */
#ifndef _Restrict_
-# if defined __restrict || 2 < __GNUC__ + (95 <= __GNUC_MINOR__)
+# if defined __restrict \
+ || 2 < __GNUC__ + (95 <= __GNUC_MINOR__) \
+ || __clang_major__ >= 3
# define _Restrict_ __restrict
# elif 199901L <= __STDC_VERSION__ || defined restrict
# define _Restrict_ restrict
@@ -622,13 +622,18 @@ extern int re_exec (const char *);
# define _Restrict_
# endif
#endif
-/* For [restrict], use glibc's __restrict_arr if available.
- Otherwise, GCC 3.1 (not in C++ mode) and C99 support [restrict]. */
+/* For the ISO C99 syntax
+ array_name[restrict]
+ use glibc's __restrict_arr if available.
+ Otherwise, GCC 3.1 and clang support this syntax (but not in C++ mode).
+ Other ISO C99 compilers support it as well. */
#ifndef _Restrict_arr_
# ifdef __restrict_arr
# define _Restrict_arr_ __restrict_arr
-# elif ((199901L <= __STDC_VERSION__ || 3 < __GNUC__ + (1 <= __GNUC_MINOR__)) \
- && !defined __GNUG__)
+# elif ((199901L <= __STDC_VERSION__ \
+ || 3 < __GNUC__ + (1 <= __GNUC_MINOR__) \
+ || __clang_major__ >= 3) \
+ && !defined __cplusplus)
# define _Restrict_arr_ _Restrict_
# else
# define _Restrict_arr_
diff --git a/lib/regex_internal.h b/lib/regex_internal.h
index 5c9cbf3b4fe..0c72e3f7b01 100644
--- a/lib/regex_internal.h
+++ b/lib/regex_internal.h
@@ -141,6 +141,24 @@
#ifndef SSIZE_MAX
# define SSIZE_MAX ((ssize_t) (SIZE_MAX / 2))
#endif
+#ifndef ULONG_WIDTH
+# define ULONG_WIDTH REGEX_UINTEGER_WIDTH (ULONG_MAX)
+/* The number of usable bits in an unsigned integer type with maximum
+ value MAX, as an int expression suitable in #if. Cover all known
+ practical hosts. This implementation exploits the fact that MAX is
+ 1 less than a power of 2, and merely counts the number of 1 bits in
+ MAX; "COBn" means "count the number of 1 bits in the low-order n bits". */
+# define REGEX_UINTEGER_WIDTH(max) REGEX_COB128 (max)
+# define REGEX_COB128(n) (REGEX_COB64 ((n) >> 31 >> 31 >> 2) + REGEX_COB64 (n))
+# define REGEX_COB64(n) (REGEX_COB32 ((n) >> 31 >> 1) + REGEX_COB32 (n))
+# define REGEX_COB32(n) (REGEX_COB16 ((n) >> 16) + REGEX_COB16 (n))
+# define REGEX_COB16(n) (REGEX_COB8 ((n) >> 8) + REGEX_COB8 (n))
+# define REGEX_COB8(n) (REGEX_COB4 ((n) >> 4) + REGEX_COB4 (n))
+# define REGEX_COB4(n) (!!((n) & 8) + !!((n) & 4) + !!((n) & 2) + ((n) & 1))
+# if ULONG_MAX / 2 + 1 != 1ul << (ULONG_WIDTH - 1)
+# error "ULONG_MAX out of range"
+# endif
+#endif
/* The type of indexes into strings. This is signed, not size_t,
since the API requires indexes to fit in regoff_t anyway, and using
@@ -164,36 +182,8 @@ typedef __re_size_t re_hashval_t;
typedef unsigned long int bitset_word_t;
/* All bits set in a bitset_word_t. */
#define BITSET_WORD_MAX ULONG_MAX
-
-/* Number of bits in a bitset_word_t. For portability to hosts with
- padding bits, do not use '(sizeof (bitset_word_t) * CHAR_BIT)';
- instead, deduce it directly from BITSET_WORD_MAX. Avoid
- greater-than-32-bit integers and unconditional shifts by more than
- 31 bits, as they're not portable. */
-#if BITSET_WORD_MAX == 0xffffffffUL
-# define BITSET_WORD_BITS 32
-#elif BITSET_WORD_MAX >> 31 >> 4 == 1
-# define BITSET_WORD_BITS 36
-#elif BITSET_WORD_MAX >> 31 >> 16 == 1
-# define BITSET_WORD_BITS 48
-#elif BITSET_WORD_MAX >> 31 >> 28 == 1
-# define BITSET_WORD_BITS 60
-#elif BITSET_WORD_MAX >> 31 >> 31 >> 1 == 1
-# define BITSET_WORD_BITS 64
-#elif BITSET_WORD_MAX >> 31 >> 31 >> 9 == 1
-# define BITSET_WORD_BITS 72
-#elif BITSET_WORD_MAX >> 31 >> 31 >> 31 >> 31 >> 3 == 1
-# define BITSET_WORD_BITS 128
-#elif BITSET_WORD_MAX >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 7 == 1
-# define BITSET_WORD_BITS 256
-#elif BITSET_WORD_MAX >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 7 > 1
-# define BITSET_WORD_BITS 257 /* any value > SBC_MAX will do here */
-# if BITSET_WORD_BITS <= SBC_MAX
-# error "Invalid SBC_MAX"
-# endif
-#else
-# error "Add case for new bitset_word_t size"
-#endif
+/* Number of bits in a bitset_word_t. */
+#define BITSET_WORD_BITS ULONG_WIDTH
/* Number of bitset_word_t values in a bitset_t. */
#define BITSET_WORDS ((SBC_MAX + BITSET_WORD_BITS - 1) / BITSET_WORD_BITS)
@@ -345,7 +335,7 @@ typedef struct
Idx idx; /* for BACK_REF */
re_context_type ctx_type; /* for ANCHOR */
} opr;
-#if __GNUC__ >= 2 && !defined __STRICT_ANSI__
+#if (__GNUC__ >= 2 || defined __clang__) && !defined __STRICT_ANSI__
re_token_type_t type : 8;
#else
re_token_type_t type;
@@ -601,9 +591,8 @@ struct re_backref_cache_entry
Idx str_idx;
Idx subexp_from;
Idx subexp_to;
+ bitset_word_t eps_reachable_subexps_map;
char more;
- char unused;
- unsigned short int eps_reachable_subexps_map;
};
typedef struct
@@ -852,10 +841,10 @@ re_string_elem_size_at (const re_string_t *pstr, Idx idx)
#endif /* RE_ENABLE_I18N */
#ifndef FALLTHROUGH
-# if __GNUC__ < 7
-# define FALLTHROUGH ((void) 0)
-# else
+# if (__GNUC__ >= 7) || (__clang_major__ >= 10)
# define FALLTHROUGH __attribute__ ((__fallthrough__))
+# else
+# define FALLTHROUGH ((void) 0)
# endif
#endif
diff --git a/lib/sha1.c b/lib/sha1.c
index 68e74ff3f98..bacf29c4051 100644
--- a/lib/sha1.c
+++ b/lib/sha1.c
@@ -1,8 +1,7 @@
/* sha1.c - Functions to compute SHA1 message digest of files or
memory blocks according to the NIST specification FIPS-180-1.
- Copyright (C) 2000-2001, 2003-2006, 2008-2020 Free Software
- Foundation, Inc.
+ Copyright (C) 2000-2001, 2003-2006, 2008-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
diff --git a/lib/sha1.h b/lib/sha1.h
index 2c9c2d4a5e2..b76788487c3 100644
--- a/lib/sha1.h
+++ b/lib/sha1.h
@@ -71,20 +71,21 @@ extern void sha1_process_bytes (const void *buffer, size_t len,
in first 20 bytes following RESBUF. The result is always in little
endian byte order, so that a byte-wise output yields to the wanted
ASCII representation of the message digest. */
-extern void *sha1_finish_ctx (struct sha1_ctx *ctx, void *resbuf);
+extern void *sha1_finish_ctx (struct sha1_ctx *ctx, void *restrict resbuf);
/* Put result from CTX in first 20 bytes following RESBUF. The result is
always in little endian byte order, so that a byte-wise output yields
to the wanted ASCII representation of the message digest. */
-extern void *sha1_read_ctx (const struct sha1_ctx *ctx, void *resbuf);
+extern void *sha1_read_ctx (const struct sha1_ctx *ctx, void *restrict resbuf);
/* Compute SHA1 message digest for LEN bytes beginning at BUFFER. The
result is always in little endian byte order, so that a byte-wise
output yields to the wanted ASCII representation of the message
digest. */
-extern void *sha1_buffer (const char *buffer, size_t len, void *resblock);
+extern void *sha1_buffer (const char *buffer, size_t len,
+ void *restrict resblock);
# endif
/* Compute SHA1 message digest for bytes read from STREAM.
diff --git a/lib/sha256.h b/lib/sha256.h
index 1bc61d437c9..750d78a2696 100644
--- a/lib/sha256.h
+++ b/lib/sha256.h
@@ -70,23 +70,27 @@ extern void sha256_process_bytes (const void *buffer, size_t len,
in first 32 (28) bytes following RESBUF. The result is always in little
endian byte order, so that a byte-wise output yields to the wanted
ASCII representation of the message digest. */
-extern void *sha256_finish_ctx (struct sha256_ctx *ctx, void *resbuf);
-extern void *sha224_finish_ctx (struct sha256_ctx *ctx, void *resbuf);
+extern void *sha256_finish_ctx (struct sha256_ctx *ctx, void *restrict resbuf);
+extern void *sha224_finish_ctx (struct sha256_ctx *ctx, void *restrict resbuf);
/* Put result from CTX in first 32 (28) bytes following RESBUF. The result is
always in little endian byte order, so that a byte-wise output yields
to the wanted ASCII representation of the message digest. */
-extern void *sha256_read_ctx (const struct sha256_ctx *ctx, void *resbuf);
-extern void *sha224_read_ctx (const struct sha256_ctx *ctx, void *resbuf);
+extern void *sha256_read_ctx (const struct sha256_ctx *ctx,
+ void *restrict resbuf);
+extern void *sha224_read_ctx (const struct sha256_ctx *ctx,
+ void *restrict resbuf);
-/* Compute SHA256 (SHA224) message digest for LEN bytes beginning at BUFFER. The
- result is always in little endian byte order, so that a byte-wise
+/* Compute SHA256 (SHA224) message digest for LEN bytes beginning at BUFFER.
+ The result is always in little endian byte order, so that a byte-wise
output yields to the wanted ASCII representation of the message
digest. */
-extern void *sha256_buffer (const char *buffer, size_t len, void *resblock);
-extern void *sha224_buffer (const char *buffer, size_t len, void *resblock);
+extern void *sha256_buffer (const char *buffer, size_t len,
+ void *restrict resblock);
+extern void *sha224_buffer (const char *buffer, size_t len,
+ void *restrict resblock);
# endif
/* Compute SHA256 (SHA224) message digest for bytes read from STREAM.
diff --git a/lib/sha512.h b/lib/sha512.h
index aaf35a5f7d8..21c2f580147 100644
--- a/lib/sha512.h
+++ b/lib/sha512.h
@@ -70,8 +70,8 @@ extern void sha512_process_bytes (const void *buffer, size_t len,
in first 64 (48) bytes following RESBUF. The result is always in little
endian byte order, so that a byte-wise output yields to the wanted
ASCII representation of the message digest. */
-extern void *sha512_finish_ctx (struct sha512_ctx *ctx, void *resbuf);
-extern void *sha384_finish_ctx (struct sha512_ctx *ctx, void *resbuf);
+extern void *sha512_finish_ctx (struct sha512_ctx *ctx, void *restrict resbuf);
+extern void *sha384_finish_ctx (struct sha512_ctx *ctx, void *restrict resbuf);
/* Put result from CTX in first 64 (48) bytes following RESBUF. The result is
@@ -80,16 +80,20 @@ extern void *sha384_finish_ctx (struct sha512_ctx *ctx, void *resbuf);
IMPORTANT: On some systems it is required that RESBUF is correctly
aligned for a 32 bits value. */
-extern void *sha512_read_ctx (const struct sha512_ctx *ctx, void *resbuf);
-extern void *sha384_read_ctx (const struct sha512_ctx *ctx, void *resbuf);
+extern void *sha512_read_ctx (const struct sha512_ctx *ctx,
+ void *restrict resbuf);
+extern void *sha384_read_ctx (const struct sha512_ctx *ctx,
+ void *restrict resbuf);
-/* Compute SHA512 (SHA384) message digest for LEN bytes beginning at BUFFER. The
- result is always in little endian byte order, so that a byte-wise
+/* Compute SHA512 (SHA384) message digest for LEN bytes beginning at BUFFER.
+ The result is always in little endian byte order, so that a byte-wise
output yields to the wanted ASCII representation of the message
digest. */
-extern void *sha512_buffer (const char *buffer, size_t len, void *resblock);
-extern void *sha384_buffer (const char *buffer, size_t len, void *resblock);
+extern void *sha512_buffer (const char *buffer, size_t len,
+ void *restrict resblock);
+extern void *sha384_buffer (const char *buffer, size_t len,
+ void *restrict resblock);
# endif
/* Compute SHA512 (SHA384) message digest for bytes read from STREAM.
diff --git a/lib/sig2str.c b/lib/sig2str.c
index 47c6cfcf95e..cf7c3bb5c38 100644
--- a/lib/sig2str.c
+++ b/lib/sig2str.c
@@ -1,7 +1,6 @@
/* sig2str.c -- convert between signal names and numbers
- Copyright (C) 2002, 2004, 2006, 2009-2020 Free Software Foundation,
- Inc.
+ Copyright (C) 2002, 2004, 2006, 2009-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
@@ -190,6 +189,11 @@ static struct numname { int num; char const name[8]; } numname_table[] =
NUMNAME (STKFLT),
#endif
+ /* AIX 7. */
+#ifdef SIGCPUFAIL
+ NUMNAME (CPUFAIL),
+#endif
+
/* AIX 5L. */
#ifdef SIGDANGER
NUMNAME (DANGER),
@@ -230,7 +234,12 @@ static struct numname { int num; char const name[8]; } numname_table[] =
NUMNAME (WINDOW), /* Older name for SIGWINCH. */
#endif
- /* BeOS */
+ /* OpenBSD. */
+#ifdef SIGTHR
+ NUMNAME (THR),
+#endif
+
+ /* BeOS, Haiku */
#ifdef SIGKILLTHR
NUMNAME (KILLTHR),
#endif
@@ -240,6 +249,11 @@ static struct numname { int num; char const name[8]; } numname_table[] =
NUMNAME (DIL),
#endif
+ /* native Windows */
+#ifdef SIGBREAK
+ NUMNAME (BREAK),
+#endif
+
/* Korn shell and Bash, of uncertain vintage. */
{ 0, "EXIT" }
};
diff --git a/lib/sigdescr_np.c b/lib/sigdescr_np.c
new file mode 100644
index 00000000000..fc9cd3c2369
--- /dev/null
+++ b/lib/sigdescr_np.c
@@ -0,0 +1,376 @@
+/* English descriptions of signals.
+ Copyright (C) 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 Bruno Haible <bruno@clisp.org>, 2020. */
+
+#include <config.h>
+
+/* Specification. */
+#include <string.h>
+
+#include <signal.h>
+
+const char *
+sigdescr_np (int sig)
+{
+ /* Note: Some platforms (glibc, FreeBSD, NetBSD, OpenBSD, AIX, IRIX, Haiku,
+ Android) have an array 'sys_siglist'. (On AIX, you need to declare it
+ yourself, and it has fewer than NSIG elements.) Its contents varies
+ depending on the OS.
+ On other OSes, you can invoke strsignal (sig) in the C locale.
+ In the code below, we show the differences.
+ You can see how cryptic some of these strings are. We try to pick more
+ understandable wordings. */
+
+ switch (sig)
+ {
+ /* Signals specified by ISO C. */
+ case SIGABRT:
+ /* glibc: "Aborted". *BSD: "Abort trap". Solaris: "Abort". */
+ return "Aborted";
+ case SIGFPE:
+ /* glibc, *BSD: "Floating point exception". Solaris: "Arithmetic exception".
+ The latter is more correct, because of integer division by 0 or -1. */
+ return "Arithmetic exception";
+ case SIGILL:
+ return "Illegal instruction";
+ case SIGINT:
+ return "Interrupt";
+ case SIGSEGV:
+ return "Segmentation fault";
+ case SIGTERM:
+ return "Terminated";
+
+ /* Signals specified by POSIX.
+ <https://pubs.opengroup.org/onlinepubs/9699919799/basedefs/signal.h.html> */
+ #if defined SIGALRM
+ case SIGALRM:
+ return "Alarm clock";
+ #endif
+ #if defined SIGBUS
+ case SIGBUS:
+ return "Bus error";
+ #endif
+ #if defined SIGCHLD
+ case SIGCHLD:
+ /* glibc, *BSD: "Child exited". Solaris: "Child status changed". */
+ return "Child stopped or exited";
+ #endif
+ #if defined SIGCONT
+ case SIGCONT:
+ return "Continued";
+ #endif
+ #if defined SIGHUP
+ case SIGHUP:
+ return "Hangup";
+ #endif
+ #if defined SIGKILL
+ case SIGKILL:
+ return "Killed";
+ #endif
+ #if defined SIGPIPE
+ case SIGPIPE:
+ return "Broken pipe";
+ #endif
+ #if defined SIGQUIT
+ case SIGQUIT:
+ return "Quit";
+ #endif
+ #if defined SIGSTOP
+ case SIGSTOP:
+ /* glibc, Solaris: "Stopped (signal)". *BSD: "Suspended (signal)". */
+ return "Stopped (signal)";
+ #endif
+ #if defined SIGTSTP
+ case SIGTSTP:
+ /* glibc: "Stopped". *BSD: "Suspended". Solaris: "Stopped (user)". */
+ return "Stopped";
+ #endif
+ #if defined SIGTTIN
+ case SIGTTIN:
+ return "Stopped (tty input)";
+ #endif
+ #if defined SIGTTOU
+ case SIGTTOU:
+ return "Stopped (tty output)";
+ #endif
+ #if defined SIGUSR1
+ case SIGUSR1:
+ /* glibc, *BSD: "User defined signal 1". Solaris: "User signal 1". */
+ return "User defined signal 1";
+ #endif
+ #if defined SIGUSR2
+ case SIGUSR2:
+ /* glibc, *BSD: "User defined signal 2". Solaris: "User signal 2". */
+ return "User defined signal 2";
+ #endif
+ #if defined SIGPOLL
+ case SIGPOLL:
+ /* glibc: "I/O possible". Solaris: "Pollable event". */
+ return "I/O possible";
+ #endif
+ #if defined SIGPROF
+ case SIGPROF:
+ return "Profiling timer expired";
+ #endif
+ #if defined SIGSYS
+ case SIGSYS:
+ return "Bad system call";
+ #endif
+ #if defined SIGTRAP
+ case SIGTRAP:
+ /* glibc, Solaris: "Trace/breakpoint trap". *BSD: "Trace/BPT trap". */
+ return "Trace/breakpoint trap";
+ #endif
+ #if defined SIGURG
+ case SIGURG:
+ /* glibc, *BSD: "Urgent I/O condition". Solaris: "Urgent socket condition". */
+ return "Urgent I/O condition";
+ #endif
+ #if defined SIGVTALRM
+ case SIGVTALRM:
+ return "Virtual timer expired";
+ #endif
+ #if defined SIGXCPU
+ case SIGXCPU:
+ /* glibc, *BSD: "CPU time limit exceeded". Solaris: "Cpu limit exceeded". */
+ return "CPU time limit exceeded";
+ #endif
+ #if defined SIGXFSZ
+ case SIGXFSZ:
+ return "File size limit exceeded";
+ #endif
+
+ /* Other signals on other systems. */
+ /* native Windows */
+ #if defined SIGBREAK
+ case SIGBREAK:
+ return "Ctrl-Break";
+ #endif
+ /* IRIX */
+ #if defined SIGCKPT
+ case SIGCKPT:
+ return "Checkpoint"; /* See man 1 cpr, man 3C atcheckpoint */
+ #endif
+ /* Linux, IRIX, Cygwin */
+ #if defined SIGCLD && SIGCLD != SIGCHLD
+ case SIGCLD:
+ return "Child stopped or exited";
+ #endif
+ /* AIX */
+ #if defined SIGCPUFAIL
+ case SIGCPUFAIL:
+ /* AIX: "CPU failure predicted". */
+ return "CPU going down"; /* See man bindprocessor */
+ #endif
+ /* AIX */
+ #if defined SIGDANGER
+ case SIGDANGER:
+ /* AIX: "Paging space low". */
+ return "Swap space nearly exhausted";
+ #endif
+ /* Mac OS X, FreeBSD, NetBSD, OpenBSD, Minix, AIX, IRIX, Cygwin, mingw */
+ #if defined SIGEMT
+ case SIGEMT:
+ /* glibc/Hurd, *BSD: "EMT trap". Solaris: "Emulation trap". */
+ return "Instruction emulation needed";
+ #endif
+ /* Mac OS X, FreeBSD, NetBSD, OpenBSD, Minix */
+ #if defined SIGINFO
+ case SIGINFO:
+ return "Information request";
+ #endif
+ /* Linux, Mac OS X, FreeBSD, NetBSD, OpenBSD, Minix, AIX, IRIX, Cygwin */
+ #if defined SIGIO && SIGIO != SIGPOLL
+ case SIGIO:
+ return "I/O possible";
+ #endif
+ /* Linux, IRIX, Cygwin, mingw */
+ #if defined SIGIOT && SIGIOT != SIGABRT
+ case SIGIOT:
+ return "IOT instruction"; /* a PDP-11 instruction */
+ #endif
+ /* AIX */
+ #if defined SIGKAP
+ case SIGKAP:
+ /* Process must issue a KSKAPACK ioctl, or will be killed in 30 seconds. */
+ /* AIX: "Monitor mode granted". */
+ return "Keep Alive Poll";
+ #endif
+ /* Haiku */
+ #if defined SIGKILLTHR
+ case SIGKILLTHR:
+ return "Kill thread";
+ #endif
+ /* Minix */
+ #if defined SIGKMEM
+ case SIGKMEM:
+ return "Kernel memory request";
+ #endif
+ /* Minix */
+ #if defined SIGKMESS
+ case SIGKMESS:
+ return "Kernel message";
+ #endif
+ /* Minix */
+ #if defined SIGKSIG
+ case SIGKSIG:
+ return "Kernel signal";
+ #endif
+ /* Minix */
+ #if defined SIGKSIGSM
+ case SIGKSIGSM:
+ return "Kernel signal for signal manager";
+ #endif
+ /* FreeBSD */
+ #if defined SIGLIBRT
+ case SIGLIBRT:
+ return "Real-time library interrupt";
+ #endif
+ /* Cygwin */
+ #if defined SIGLOST && SIGLOST != SIGABRT && SIGLOST != SIGPWR
+ case SIGLOST:
+ /* Solaris: "Resource lost". */
+ return "File lock lost";
+ #endif
+ /* AIX */
+ #if defined SIGMIGRATE
+ case SIGMIGRATE:
+ return "Process migration";
+ #endif
+ /* AIX */
+ #if defined SIGMSG
+ case SIGMSG:
+ /* AIX: "Input device data". */
+ return "Message in the ring";
+ #endif
+ /* ACM */
+ #if defined SIGPLAN
+ case SIGPLAN:
+ return "Programming language anomaly";
+ #endif
+ /* AIX */
+ #if defined SIGPRE
+ case SIGPRE:
+ return "Programmed exception";
+ #endif
+ /* IRIX */
+ #if defined SIGPTINTR
+ case SIGPTINTR:
+ return "Pthread interrupt";
+ #endif
+ /* IRIX */
+ #if defined SIGPTRESCHED
+ case SIGPTRESCHED:
+ return "Pthread rescheduling";
+ #endif
+ /* Linux, NetBSD, Minix, AIX, IRIX, Cygwin */
+ #if defined SIGPWR
+ case SIGPWR:
+ /* glibc: "Power failure". NetBSD: "Power fail/restart". */
+ return "Power failure";
+ #endif
+ /* AIX */
+ #if defined SIGRECONFIG
+ case SIGRECONFIG:
+ return "Dynamic logical partitioning changed";
+ #endif
+ /* AIX */
+ #if defined SIGRECOVERY
+ case SIGRECOVERY:
+ return "Kernel recovery";
+ #endif
+ /* IRIX */
+ #if defined SIGRESTART
+ case SIGRESTART:
+ return "Checkpoint restart"; /* See man 1 cpr, man 3C atrestart */
+ #endif
+ /* AIX */
+ #if defined SIGRETRACT
+ case SIGRETRACT:
+ /* AIX: "Monitor mode retracted". */
+ return "Retracting Keep Alive Poll";
+ #endif
+ /* AIX */
+ #if defined SIGSAK
+ case SIGSAK:
+ /* AIX: "Secure attention". */
+ return "Secure Attention Key";
+ #endif
+ /* ACM */
+ #if defined SIGSAM
+ case SIGSAM:
+ return "Symbolic computation failed";
+ #endif
+ /* Minix */
+ #if defined SIGSNDELAY
+ case SIGSNDELAY:
+ return "Done sending message";
+ #endif
+ /* AIX */
+ #if defined SIGSOUND
+ case SIGSOUND:
+ /* AIX: "Sound completed". */
+ return "Sound configuration changed";
+ #endif
+ /* Linux */
+ #if defined SIGSTKFLT
+ case SIGSTKFLT:
+ return "Stack fault";
+ #endif
+ /* AIX */
+ #if defined SIGSYSERROR
+ case SIGSYSERROR:
+ return "Kernel error";
+ #endif
+ /* AIX */
+ #if defined SIGTALRM
+ case SIGTALRM:
+ return "Thread alarm clock";
+ #endif
+ /* FreeBSD, OpenBSD */
+ #if defined SIGTHR
+ case SIGTHR:
+ /* OpenBSD: "Thread AST". */
+ return "Thread library interrupt";
+ #endif
+ /* IRIX */
+ #if defined SIGUME
+ case SIGUME:
+ return "Uncorrectable memory error";
+ #endif
+ /* AIX */
+ #if defined SIGVIRT
+ case SIGVIRT:
+ return "Virtual time alarm clock";
+ #endif
+ /* AIX */
+ #if defined SIGWAITING
+ case SIGWAITING:
+ /* AIX: "No runnable lwp". */
+ return "Thread waiting";
+ #endif
+ /* Linux, Mac OS X, FreeBSD, NetBSD, OpenBSD, Minix, AIX, IRIX, Cygwin, Haiku */
+ #if defined SIGWINCH
+ case SIGWINCH:
+ /* glibc: "Window changed". *BSD: "Window size changed" or "Window size changes". */
+ return "Window size changed";
+ #endif
+
+ default:
+ return NULL;
+ }
+}
diff --git a/lib/signal.in.h b/lib/signal.in.h
index 42e1897f1ea..c94b053d6af 100644
--- a/lib/signal.in.h
+++ b/lib/signal.in.h
@@ -133,16 +133,24 @@ typedef void (*sighandler_t) (int);
# define pthread_sigmask rpl_pthread_sigmask
# endif
_GL_FUNCDECL_RPL (pthread_sigmask, int,
- (int how, const sigset_t *new_mask, sigset_t *old_mask));
+ (int how,
+ const sigset_t *restrict new_mask,
+ sigset_t *restrict old_mask));
_GL_CXXALIAS_RPL (pthread_sigmask, int,
- (int how, const sigset_t *new_mask, sigset_t *old_mask));
+ (int how,
+ const sigset_t *restrict new_mask,
+ sigset_t *restrict old_mask));
# else
# if !(@HAVE_PTHREAD_SIGMASK@ || defined pthread_sigmask)
_GL_FUNCDECL_SYS (pthread_sigmask, int,
- (int how, const sigset_t *new_mask, sigset_t *old_mask));
+ (int how,
+ const sigset_t *restrict new_mask,
+ sigset_t *restrict old_mask));
# endif
_GL_CXXALIAS_SYS (pthread_sigmask, int,
- (int how, const sigset_t *new_mask, sigset_t *old_mask));
+ (int how,
+ const sigset_t *restrict new_mask,
+ sigset_t *restrict old_mask));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (pthread_sigmask);
@@ -295,10 +303,14 @@ _GL_CXXALIASWARN (sigpending);
# define SIG_SETMASK 1 /* blocked_set = *set; */
# define SIG_UNBLOCK 2 /* blocked_set = blocked_set & ~*set; */
_GL_FUNCDECL_SYS (sigprocmask, int,
- (int operation, const sigset_t *set, sigset_t *old_set));
+ (int operation,
+ const sigset_t *restrict set,
+ sigset_t *restrict old_set));
# endif
_GL_CXXALIAS_SYS (sigprocmask, int,
- (int operation, const sigset_t *set, sigset_t *old_set));
+ (int operation,
+ const sigset_t *restrict set,
+ sigset_t *restrict old_set));
_GL_CXXALIASWARN (sigprocmask);
/* Install the handler FUNC for signal SIG, and return the previous
@@ -322,6 +334,12 @@ _GL_FUNCDECL_RPL (signal, _gl_function_taking_int_returning_void_t,
_GL_CXXALIAS_RPL (signal, _gl_function_taking_int_returning_void_t,
(int sig, _gl_function_taking_int_returning_void_t func));
# else
+/* On OpenBSD, the declaration of 'signal' may not be present at this point,
+ because it occurs in <sys/signal.h>, not <signal.h> directly. */
+# if defined __OpenBSD__
+_GL_FUNCDECL_SYS (signal, _gl_function_taking_int_returning_void_t,
+ (int sig, _gl_function_taking_int_returning_void_t func));
+# endif
_GL_CXXALIAS_SYS (signal, _gl_function_taking_int_returning_void_t,
(int sig, _gl_function_taking_int_returning_void_t func));
# endif
diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h
index 2f53411e16c..b5b63e53f12 100644
--- a/lib/stdalign.in.h
+++ b/lib/stdalign.in.h
@@ -34,11 +34,12 @@
requirement of a structure member (i.e., slot or field) that is of
type TYPE, as an integer constant expression.
- This differs from GCC's __alignof__ operator, which can yield a
- better-performing alignment for an object of that type. For
- example, on x86 with GCC, __alignof__ (double) and __alignof__
- (long long) are 8, whereas alignof (double) and alignof (long long)
- are 4 unless the option '-malign-double' is used.
+ This differs from GCC's and clang's __alignof__ operator, which can
+ yield a better-performing alignment for an object of that type. For
+ example, on x86 with GCC and on Linux/x86 with clang,
+ __alignof__ (double) and __alignof__ (long long) are 8, whereas
+ alignof (double) and alignof (long long) are 4 unless the option
+ '-malign-double' is used.
The result cannot be used as a value for an 'enum' constant, if you
want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc.
@@ -53,9 +54,12 @@
#undef _Alignof
/* GCC releases before GCC 4.9 had a bug in _Alignof. See GCC bug 52023
- <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52023>. */
+ <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52023>.
+ clang versions < 8.0.0 have the same bug. */
#if (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 \
- || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9)))
+ || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9) \
+ && !defined __clang__) \
+ || (defined __clang__ && __clang_major__ < 8))
# ifdef __cplusplus
# if 201103 <= __cplusplus
# define _Alignof(type) alignof (type)
@@ -102,8 +106,9 @@
# define _Alignas(a) alignas (a)
# elif ((defined __APPLE__ && defined __MACH__ \
? 4 < __GNUC__ + (1 <= __GNUC_MINOR__) \
- : __GNUC__) \
- || (__ia64 && (61200 <= __HP_cc || 61200 <= __HP_aCC)) \
+ : __GNUC__ && !defined __ibmxl__) \
+ || (4 <= __clang_major__) \
+ || (__ia64 && (61200 <= __HP_cc || 61200 <= __HP_aCC)) \
|| __ICC || 0x590 <= __SUNPRO_C || 0x0600 <= __xlC__)
# define _Alignas(a) __attribute__ ((__aligned__ (a)))
# elif 1300 <= _MSC_VER
diff --git a/lib/stddef.in.h b/lib/stddef.in.h
index e146063c026..87b46d53204 100644
--- a/lib/stddef.in.h
+++ b/lib/stddef.in.h
@@ -83,20 +83,26 @@
/* Some platforms lack max_align_t. The check for _GCC_MAX_ALIGN_T is
a hack in case the configure-time test was done with g++ even though
- we are currently compiling with gcc. */
-#if ! (@HAVE_MAX_ALIGN_T@ || defined _GCC_MAX_ALIGN_T)
-# if !GNULIB_defined_max_align_t
+ we are currently compiling with gcc.
+ On MSVC, max_align_t is defined only in C++ mode, after <cstddef> was
+ included. Its definition is good since it has an alignment of 8 (on x86
+ and x86_64). */
+#if defined _MSC_VER && defined __cplusplus
+# include <cstddef>
+#else
+# if ! (@HAVE_MAX_ALIGN_T@ || defined _GCC_MAX_ALIGN_T)
+# if !GNULIB_defined_max_align_t
/* On the x86, the maximum storage alignment of double, long, etc. is 4,
but GCC's C11 ABI for x86 says that max_align_t has an alignment of 8,
and the C11 standard allows this. Work around this problem by
using __alignof__ (which returns 8 for double) rather than _Alignof
(which returns 4), and align each union member accordingly. */
-# ifdef __GNUC__
-# define _GL_STDDEF_ALIGNAS(type) \
- __attribute__ ((__aligned__ (__alignof__ (type))))
-# else
-# define _GL_STDDEF_ALIGNAS(type) /* */
-# endif
+# if defined __GNUC__ || (__clang_major__ >= 4)
+# define _GL_STDDEF_ALIGNAS(type) \
+ __attribute__ ((__aligned__ (__alignof__ (type))))
+# else
+# define _GL_STDDEF_ALIGNAS(type) /* */
+# endif
typedef union
{
char *__p _GL_STDDEF_ALIGNAS (char *);
@@ -104,8 +110,9 @@ typedef union
long double __ld _GL_STDDEF_ALIGNAS (long double);
long int __i _GL_STDDEF_ALIGNAS (long int);
} rpl_max_align_t;
-# define max_align_t rpl_max_align_t
-# define GNULIB_defined_max_align_t 1
+# define max_align_t rpl_max_align_t
+# define GNULIB_defined_max_align_t 1
+# endif
# endif
#endif
diff --git a/lib/stdint.in.h b/lib/stdint.in.h
index a83bc45c79c..63fa1aa628f 100644
--- a/lib/stdint.in.h
+++ b/lib/stdint.in.h
@@ -188,7 +188,7 @@ typedef long int gl_int64_t;
typedef __int64 gl_int64_t;
# define int64_t gl_int64_t
# define GL_INT64_T
-# elif @HAVE_LONG_LONG_INT@
+# else
# undef int64_t
typedef long long int gl_int64_t;
# define int64_t gl_int64_t
@@ -209,7 +209,7 @@ typedef unsigned long int gl_uint64_t;
typedef unsigned __int64 gl_uint64_t;
# define uint64_t gl_uint64_t
# define GL_UINT64_T
-# elif @HAVE_UNSIGNED_LONG_LONG_INT@
+# else
# undef uint64_t
typedef unsigned long long int gl_uint64_t;
# define uint64_t gl_uint64_t
@@ -302,12 +302,11 @@ typedef gl_uint_fast32_t gl_uint_fast16_t;
/* kLIBC's <stdint.h> defines _INTPTR_T_DECLARED and needs its own
definitions of intptr_t and uintptr_t (which use int and unsigned)
to avoid clashes with declarations of system functions like sbrk.
- Similarly, mingw 5.22 <crtdefs.h> defines _INTPTR_T_DEFINED and
- _UINTPTR_T_DEFINED and needs its own definitions of intptr_t and
+ Similarly, MinGW WSL-5.4.1 <stdint.h> needs its own intptr_t and
uintptr_t to avoid conflicting declarations of system functions like
_findclose in <io.h>. */
# if !((defined __KLIBC__ && defined _INTPTR_T_DECLARED) \
- || (defined __MINGW32__ && defined _INTPTR_T_DEFINED && defined _UINTPTR_T_DEFINED))
+ || defined __MINGW32__)
# undef intptr_t
# undef uintptr_t
# ifdef _WIN64
@@ -333,7 +332,7 @@ typedef unsigned long int gl_uintptr_t;
# ifndef INTMAX_MAX
# undef INTMAX_C
# undef intmax_t
-# if @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
+# if LONG_MAX >> 30 == 1
typedef long long int gl_intmax_t;
# define intmax_t gl_intmax_t
# elif defined GL_INT64_T
@@ -347,7 +346,7 @@ typedef long int gl_intmax_t;
# ifndef UINTMAX_MAX
# undef UINTMAX_C
# undef uintmax_t
-# if @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
+# if ULONG_MAX >> 31 == 1
typedef unsigned long long int gl_uintmax_t;
# define uintmax_t gl_uintmax_t
# elif defined GL_UINT64_T
@@ -647,21 +646,21 @@ typedef int _verify_intmax_size[sizeof (intmax_t) == sizeof (uintmax_t)
# define INT64_C(x) x##L
# elif defined _MSC_VER
# define INT64_C(x) x##i64
-# elif @HAVE_LONG_LONG_INT@
+# else
# define INT64_C(x) x##LL
# endif
# if ULONG_MAX >> 31 >> 31 >> 1 == 1
# define UINT64_C(x) x##UL
# elif defined _MSC_VER
# define UINT64_C(x) x##ui64
-# elif @HAVE_UNSIGNED_LONG_LONG_INT@
+# else
# define UINT64_C(x) x##ULL
# endif
/* 7.18.4.2. Macros for greatest-width integer constants */
# ifndef INTMAX_C
-# if @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
+# if LONG_MAX >> 30 == 1
# define INTMAX_C(x) x##LL
# elif defined GL_INT64_T
# define INTMAX_C(x) INT64_C(x)
@@ -671,7 +670,7 @@ typedef int _verify_intmax_size[sizeof (intmax_t) == sizeof (uintmax_t)
# endif
# ifndef UINTMAX_C
-# if @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
+# if ULONG_MAX >> 31 == 1
# define UINTMAX_C(x) x##ULL
# elif defined GL_UINT64_T
# define UINTMAX_C(x) UINT64_C(x)
diff --git a/lib/stdio.in.h b/lib/stdio.in.h
index 6dc526eaab0..6d12cd826de 100644
--- a/lib/stdio.in.h
+++ b/lib/stdio.in.h
@@ -62,10 +62,12 @@
We enable _GL_ATTRIBUTE_FORMAT only if these are supported too, because
gnulib and libintl do '#define printf __printf__' when they override
the 'printf' function. */
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
-# define _GL_ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
-#else
-# define _GL_ATTRIBUTE_FORMAT(spec) /* empty */
+#ifndef _GL_ATTRIBUTE_FORMAT
+# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7) || defined __clang__
+# define _GL_ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
+# else
+# define _GL_ATTRIBUTE_FORMAT(spec) /* empty */
+# endif
#endif
/* _GL_ATTRIBUTE_FORMAT_PRINTF
@@ -171,17 +173,17 @@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# define dprintf rpl_dprintf
# endif
-_GL_FUNCDECL_RPL (dprintf, int, (int fd, const char *format, ...)
+_GL_FUNCDECL_RPL (dprintf, int, (int fd, const char *restrict format, ...)
_GL_ATTRIBUTE_FORMAT_PRINTF (2, 3)
_GL_ARG_NONNULL ((2)));
-_GL_CXXALIAS_RPL (dprintf, int, (int fd, const char *format, ...));
+_GL_CXXALIAS_RPL (dprintf, int, (int fd, const char *restrict format, ...));
# else
# if !@HAVE_DPRINTF@
-_GL_FUNCDECL_SYS (dprintf, int, (int fd, const char *format, ...)
+_GL_FUNCDECL_SYS (dprintf, int, (int fd, const char *restrict format, ...)
_GL_ATTRIBUTE_FORMAT_PRINTF (2, 3)
_GL_ARG_NONNULL ((2)));
# endif
-_GL_CXXALIAS_SYS (dprintf, int, (int fd, const char *format, ...));
+_GL_CXXALIAS_SYS (dprintf, int, (int fd, const char *restrict format, ...));
# endif
_GL_CXXALIASWARN (dprintf);
#elif defined GNULIB_POSIXCHECK
@@ -213,6 +215,11 @@ _GL_WARN_ON_USE (fclose, "fclose is not always POSIX compliant - "
"use gnulib module fclose for portable POSIX compliance");
#endif
+#if defined _WIN32 && !defined __CYGWIN__
+# undef fcloseall
+# define fcloseall _fcloseall
+#endif
+
#if @GNULIB_FDOPEN@
# if @REPLACE_FDOPEN@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
@@ -222,6 +229,12 @@ _GL_WARN_ON_USE (fclose, "fclose is not always POSIX compliant - "
_GL_FUNCDECL_RPL (fdopen, FILE *, (int fd, const char *mode)
_GL_ARG_NONNULL ((2)));
_GL_CXXALIAS_RPL (fdopen, FILE *, (int fd, const char *mode));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef fdopen
+# define fdopen _fdopen
+# endif
+_GL_CXXALIAS_MDA (fdopen, FILE *, (int fd, const char *mode));
# else
_GL_CXXALIAS_SYS (fdopen, FILE *, (int fd, const char *mode));
# endif
@@ -231,6 +244,9 @@ _GL_CXXALIASWARN (fdopen);
/* Assume fdopen is always declared. */
_GL_WARN_ON_USE (fdopen, "fdopen on native Windows platforms is not POSIX compliant - "
"use gnulib module fdopen for portability");
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef fdopen
+# define fdopen _fdopen
#endif
#if @GNULIB_FFLUSH@
@@ -281,28 +297,39 @@ _GL_CXXALIASWARN (fgetc);
# undef fgets
# define fgets rpl_fgets
# endif
-_GL_FUNCDECL_RPL (fgets, char *, (char *s, int n, FILE *stream)
- _GL_ARG_NONNULL ((1, 3)));
-_GL_CXXALIAS_RPL (fgets, char *, (char *s, int n, FILE *stream));
+_GL_FUNCDECL_RPL (fgets, char *,
+ (char *restrict s, int n, FILE *restrict stream)
+ _GL_ARG_NONNULL ((1, 3)));
+_GL_CXXALIAS_RPL (fgets, char *,
+ (char *restrict s, int n, FILE *restrict stream));
# else
-_GL_CXXALIAS_SYS (fgets, char *, (char *s, int n, FILE *stream));
+_GL_CXXALIAS_SYS (fgets, char *,
+ (char *restrict s, int n, FILE *restrict stream));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (fgets);
# endif
#endif
+#if defined _WIN32 && !defined __CYGWIN__
+# undef fileno
+# define fileno _fileno
+#endif
+
#if @GNULIB_FOPEN@
# if @REPLACE_FOPEN@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# undef fopen
# define fopen rpl_fopen
# endif
-_GL_FUNCDECL_RPL (fopen, FILE *, (const char *filename, const char *mode)
- _GL_ARG_NONNULL ((1, 2)));
-_GL_CXXALIAS_RPL (fopen, FILE *, (const char *filename, const char *mode));
+_GL_FUNCDECL_RPL (fopen, FILE *,
+ (const char *restrict filename, const char *restrict mode)
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (fopen, FILE *,
+ (const char *restrict filename, const char *restrict mode));
# else
-_GL_CXXALIAS_SYS (fopen, FILE *, (const char *filename, const char *mode));
+_GL_CXXALIAS_SYS (fopen, FILE *,
+ (const char *restrict filename, const char *restrict mode));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (fopen);
@@ -322,17 +349,21 @@ _GL_WARN_ON_USE (fopen, "fopen on native Windows platforms is not POSIX complian
# endif
# define GNULIB_overrides_fprintf 1
# if @GNULIB_FPRINTF_POSIX@ || @GNULIB_VFPRINTF_POSIX@
-_GL_FUNCDECL_RPL (fprintf, int, (FILE *fp, const char *format, ...)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 3)
- _GL_ARG_NONNULL ((1, 2)));
+_GL_FUNCDECL_RPL (fprintf, int,
+ (FILE *restrict fp, const char *restrict format, ...)
+ _GL_ATTRIBUTE_FORMAT_PRINTF (2, 3)
+ _GL_ARG_NONNULL ((1, 2)));
# else
-_GL_FUNCDECL_RPL (fprintf, int, (FILE *fp, const char *format, ...)
- _GL_ATTRIBUTE_FORMAT_PRINTF_SYSTEM (2, 3)
- _GL_ARG_NONNULL ((1, 2)));
+_GL_FUNCDECL_RPL (fprintf, int,
+ (FILE *restrict fp, const char *restrict format, ...)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_SYSTEM (2, 3)
+ _GL_ARG_NONNULL ((1, 2)));
# endif
-_GL_CXXALIAS_RPL (fprintf, int, (FILE *fp, const char *format, ...));
+_GL_CXXALIAS_RPL (fprintf, int,
+ (FILE *restrict fp, const char *restrict format, ...));
# else
-_GL_CXXALIAS_SYS (fprintf, int, (FILE *fp, const char *format, ...));
+_GL_CXXALIAS_SYS (fprintf, int,
+ (FILE *restrict fp, const char *restrict format, ...));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (fprintf);
@@ -398,11 +429,14 @@ _GL_CXXALIASWARN (fputc);
# undef fputs
# define fputs rpl_fputs
# endif
-_GL_FUNCDECL_RPL (fputs, int, (const char *string, FILE *stream)
- _GL_ARG_NONNULL ((1, 2)));
-_GL_CXXALIAS_RPL (fputs, int, (const char *string, FILE *stream));
+_GL_FUNCDECL_RPL (fputs, int,
+ (const char *restrict string, FILE *restrict stream)
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (fputs, int,
+ (const char *restrict string, FILE *restrict stream));
# else
-_GL_CXXALIAS_SYS (fputs, int, (const char *string, FILE *stream));
+_GL_CXXALIAS_SYS (fputs, int,
+ (const char *restrict string, FILE *restrict stream));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (fputs);
@@ -415,11 +449,17 @@ _GL_CXXALIASWARN (fputs);
# undef fread
# define fread rpl_fread
# endif
-_GL_FUNCDECL_RPL (fread, size_t, (void *ptr, size_t s, size_t n, FILE *stream)
- _GL_ARG_NONNULL ((4)));
-_GL_CXXALIAS_RPL (fread, size_t, (void *ptr, size_t s, size_t n, FILE *stream));
+_GL_FUNCDECL_RPL (fread, size_t,
+ (void *restrict ptr, size_t s, size_t n,
+ FILE *restrict stream)
+ _GL_ARG_NONNULL ((4)));
+_GL_CXXALIAS_RPL (fread, size_t,
+ (void *restrict ptr, size_t s, size_t n,
+ FILE *restrict stream));
# else
-_GL_CXXALIAS_SYS (fread, size_t, (void *ptr, size_t s, size_t n, FILE *stream));
+_GL_CXXALIAS_SYS (fread, size_t,
+ (void *restrict ptr, size_t s, size_t n,
+ FILE *restrict stream));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (fread);
@@ -433,13 +473,16 @@ _GL_CXXALIASWARN (fread);
# define freopen rpl_freopen
# endif
_GL_FUNCDECL_RPL (freopen, FILE *,
- (const char *filename, const char *mode, FILE *stream)
+ (const char *restrict filename, const char *restrict mode,
+ FILE *restrict stream)
_GL_ARG_NONNULL ((2, 3)));
_GL_CXXALIAS_RPL (freopen, FILE *,
- (const char *filename, const char *mode, FILE *stream));
+ (const char *restrict filename, const char *restrict mode,
+ FILE *restrict stream));
# else
_GL_CXXALIAS_SYS (freopen, FILE *,
- (const char *filename, const char *mode, FILE *stream));
+ (const char *restrict filename, const char *restrict mode,
+ FILE *restrict stream));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (freopen);
@@ -458,12 +501,15 @@ _GL_WARN_ON_USE (freopen,
# undef fscanf
# define fscanf rpl_fscanf
# endif
-_GL_FUNCDECL_RPL (fscanf, int, (FILE *stream, const char *format, ...)
- _GL_ATTRIBUTE_FORMAT_SCANF_SYSTEM (2, 3)
- _GL_ARG_NONNULL ((1, 2)));
-_GL_CXXALIAS_RPL (fscanf, int, (FILE *stream, const char *format, ...));
+_GL_FUNCDECL_RPL (fscanf, int,
+ (FILE *restrict stream, const char *restrict format, ...)
+ _GL_ATTRIBUTE_FORMAT_SCANF_SYSTEM (2, 3)
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (fscanf, int,
+ (FILE *restrict stream, const char *restrict format, ...));
# else
-_GL_CXXALIAS_SYS (fscanf, int, (FILE *stream, const char *format, ...));
+_GL_CXXALIAS_SYS (fscanf, int,
+ (FILE *restrict stream, const char *restrict format, ...));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (fscanf);
@@ -634,13 +680,16 @@ _GL_WARN_ON_USE (ftell, "ftell cannot handle files larger than 4 GB "
# define fwrite rpl_fwrite
# endif
_GL_FUNCDECL_RPL (fwrite, size_t,
- (const void *ptr, size_t s, size_t n, FILE *stream)
+ (const void *restrict ptr, size_t s, size_t n,
+ FILE *restrict stream)
_GL_ARG_NONNULL ((1, 4)));
_GL_CXXALIAS_RPL (fwrite, size_t,
- (const void *ptr, size_t s, size_t n, FILE *stream));
+ (const void *restrict ptr, size_t s, size_t n,
+ FILE *restrict stream));
# else
_GL_CXXALIAS_SYS (fwrite, size_t,
- (const void *ptr, size_t s, size_t n, FILE *stream));
+ (const void *restrict ptr, size_t s, size_t n,
+ FILE *restrict stream));
/* Work around bug 11959 when fortifying glibc 2.4 through 2.15
<https://sourceware.org/bugzilla/show_bug.cgi?id=11959>,
@@ -715,22 +764,26 @@ _GL_CXXALIASWARN (getchar);
# define getdelim rpl_getdelim
# endif
_GL_FUNCDECL_RPL (getdelim, ssize_t,
- (char **lineptr, size_t *linesize, int delimiter,
- FILE *stream)
+ (char **restrict lineptr, size_t *restrict linesize,
+ int delimiter,
+ FILE *restrict stream)
_GL_ARG_NONNULL ((1, 2, 4)));
_GL_CXXALIAS_RPL (getdelim, ssize_t,
- (char **lineptr, size_t *linesize, int delimiter,
- FILE *stream));
+ (char **restrict lineptr, size_t *restrict linesize,
+ int delimiter,
+ FILE *restrict stream));
# else
# if !@HAVE_DECL_GETDELIM@
_GL_FUNCDECL_SYS (getdelim, ssize_t,
- (char **lineptr, size_t *linesize, int delimiter,
- FILE *stream)
+ (char **restrict lineptr, size_t *restrict linesize,
+ int delimiter,
+ FILE *restrict stream)
_GL_ARG_NONNULL ((1, 2, 4)));
# endif
_GL_CXXALIAS_SYS (getdelim, ssize_t,
- (char **lineptr, size_t *linesize, int delimiter,
- FILE *stream));
+ (char **restrict lineptr, size_t *restrict linesize,
+ int delimiter,
+ FILE *restrict stream));
# endif
_GL_CXXALIASWARN (getdelim);
#elif defined GNULIB_POSIXCHECK
@@ -754,18 +807,22 @@ _GL_WARN_ON_USE (getdelim, "getdelim is unportable - "
# define getline rpl_getline
# endif
_GL_FUNCDECL_RPL (getline, ssize_t,
- (char **lineptr, size_t *linesize, FILE *stream)
+ (char **restrict lineptr, size_t *restrict linesize,
+ FILE *restrict stream)
_GL_ARG_NONNULL ((1, 2, 3)));
_GL_CXXALIAS_RPL (getline, ssize_t,
- (char **lineptr, size_t *linesize, FILE *stream));
+ (char **restrict lineptr, size_t *restrict linesize,
+ FILE *restrict stream));
# else
# if !@HAVE_DECL_GETLINE@
_GL_FUNCDECL_SYS (getline, ssize_t,
- (char **lineptr, size_t *linesize, FILE *stream)
+ (char **restrict lineptr, size_t *restrict linesize,
+ FILE *restrict stream)
_GL_ARG_NONNULL ((1, 2, 3)));
# endif
_GL_CXXALIAS_SYS (getline, ssize_t,
- (char **lineptr, size_t *linesize, FILE *stream));
+ (char **restrict lineptr, size_t *restrict linesize,
+ FILE *restrict stream));
# endif
# if @HAVE_DECL_GETLINE@
_GL_CXXALIASWARN (getline);
@@ -786,6 +843,11 @@ _GL_WARN_ON_USE (getline, "getline is unportable - "
_GL_WARN_ON_USE (gets, "gets is a security hole - use fgets instead");
#endif
+#if defined _WIN32 && !defined __CYGWIN__
+# undef getw
+# define getw _getw
+#endif
+
#if @GNULIB_OBSTACK_PRINTF@ || @GNULIB_OBSTACK_PRINTF_POSIX@
struct obstack;
/* Grow an obstack with formatted output. Return the number of
@@ -902,21 +964,21 @@ _GL_WARN_ON_USE (popen, "popen is buggy on some platforms - "
#if @GNULIB_PRINTF_POSIX@ || @GNULIB_PRINTF@
# if (@GNULIB_PRINTF_POSIX@ && @REPLACE_PRINTF@) \
|| (@GNULIB_PRINTF@ && @REPLACE_STDIO_WRITE_FUNCS@ && (@GNULIB_STDIO_H_NONBLOCKING@ || @GNULIB_STDIO_H_SIGPIPE@))
-# if defined __GNUC__
+# if defined __GNUC__ || defined __clang__
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
/* Don't break __attribute__((format(printf,M,N))). */
# define printf __printf__
# endif
# if @GNULIB_PRINTF_POSIX@ || @GNULIB_VFPRINTF_POSIX@
_GL_FUNCDECL_RPL_1 (__printf__, int,
- (const char *format, ...)
+ (const char *restrict format, ...)
__asm__ (@ASM_SYMBOL_PREFIX@
_GL_STDIO_MACROEXPAND_AND_STRINGIZE(rpl_printf))
_GL_ATTRIBUTE_FORMAT_PRINTF (1, 2)
_GL_ARG_NONNULL ((1)));
# else
_GL_FUNCDECL_RPL_1 (__printf__, int,
- (const char *format, ...)
+ (const char *restrict format, ...)
__asm__ (@ASM_SYMBOL_PREFIX@
_GL_STDIO_MACROEXPAND_AND_STRINGIZE(rpl_printf))
_GL_ATTRIBUTE_FORMAT_PRINTF_SYSTEM (1, 2)
@@ -928,14 +990,14 @@ _GL_CXXALIAS_RPL_1 (printf, __printf__, int, (const char *format, ...));
# define printf rpl_printf
# endif
_GL_FUNCDECL_RPL (printf, int,
- (const char *format, ...)
+ (const char *restrict format, ...)
_GL_ATTRIBUTE_FORMAT_PRINTF (1, 2)
_GL_ARG_NONNULL ((1)));
-_GL_CXXALIAS_RPL (printf, int, (const char *format, ...));
+_GL_CXXALIAS_RPL (printf, int, (const char *restrict format, ...));
# endif
# define GNULIB_overrides_printf 1
# else
-_GL_CXXALIAS_SYS (printf, int, (const char *format, ...));
+_GL_CXXALIAS_SYS (printf, int, (const char *restrict format, ...));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (printf);
@@ -999,6 +1061,11 @@ _GL_CXXALIASWARN (puts);
# endif
#endif
+#if defined _WIN32 && !defined __CYGWIN__
+# undef putw
+# define putw _putw
+#endif
+
#if @GNULIB_REMOVE@
# if @REPLACE_REMOVE@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
@@ -1076,31 +1143,31 @@ _GL_WARN_ON_USE (renameat, "renameat is not portable - "
#if @GNULIB_SCANF@
# if @REPLACE_STDIO_READ_FUNCS@ && @GNULIB_STDIO_H_NONBLOCKING@
-# if defined __GNUC__
+# if defined __GNUC__ || defined __clang__
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# undef scanf
/* Don't break __attribute__((format(scanf,M,N))). */
# define scanf __scanf__
# endif
_GL_FUNCDECL_RPL_1 (__scanf__, int,
- (const char *format, ...)
+ (const char *restrict format, ...)
__asm__ (@ASM_SYMBOL_PREFIX@
_GL_STDIO_MACROEXPAND_AND_STRINGIZE(rpl_scanf))
_GL_ATTRIBUTE_FORMAT_SCANF_SYSTEM (1, 2)
_GL_ARG_NONNULL ((1)));
-_GL_CXXALIAS_RPL_1 (scanf, __scanf__, int, (const char *format, ...));
+_GL_CXXALIAS_RPL_1 (scanf, __scanf__, int, (const char *restrict format, ...));
# else
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# undef scanf
# define scanf rpl_scanf
# endif
-_GL_FUNCDECL_RPL (scanf, int, (const char *format, ...)
+_GL_FUNCDECL_RPL (scanf, int, (const char *restrict format, ...)
_GL_ATTRIBUTE_FORMAT_SCANF_SYSTEM (1, 2)
_GL_ARG_NONNULL ((1)));
-_GL_CXXALIAS_RPL (scanf, int, (const char *format, ...));
+_GL_CXXALIAS_RPL (scanf, int, (const char *restrict format, ...));
# endif
# else
-_GL_CXXALIAS_SYS (scanf, int, (const char *format, ...));
+_GL_CXXALIAS_SYS (scanf, int, (const char *restrict format, ...));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (scanf);
@@ -1113,22 +1180,28 @@ _GL_CXXALIASWARN (scanf);
# define snprintf rpl_snprintf
# endif
_GL_FUNCDECL_RPL (snprintf, int,
- (char *str, size_t size, const char *format, ...)
+ (char *restrict str, size_t size,
+ const char *restrict format, ...)
_GL_ATTRIBUTE_FORMAT_PRINTF (3, 4)
_GL_ARG_NONNULL ((3)));
_GL_CXXALIAS_RPL (snprintf, int,
- (char *str, size_t size, const char *format, ...));
+ (char *restrict str, size_t size,
+ const char *restrict format, ...));
# else
# if !@HAVE_DECL_SNPRINTF@
_GL_FUNCDECL_SYS (snprintf, int,
- (char *str, size_t size, const char *format, ...)
+ (char *restrict str, size_t size,
+ const char *restrict format, ...)
_GL_ATTRIBUTE_FORMAT_PRINTF (3, 4)
_GL_ARG_NONNULL ((3)));
# endif
_GL_CXXALIAS_SYS (snprintf, int,
- (char *str, size_t size, const char *format, ...));
+ (char *restrict str, size_t size,
+ const char *restrict format, ...));
# endif
+# if __GLIBC__ >= 2
_GL_CXXALIASWARN (snprintf);
+# endif
#elif defined GNULIB_POSIXCHECK
# undef snprintf
# if HAVE_RAW_DECL_SNPRINTF
@@ -1151,12 +1224,15 @@ _GL_WARN_ON_USE (snprintf, "snprintf is unportable - "
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# define sprintf rpl_sprintf
# endif
-_GL_FUNCDECL_RPL (sprintf, int, (char *str, const char *format, ...)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 3)
- _GL_ARG_NONNULL ((1, 2)));
-_GL_CXXALIAS_RPL (sprintf, int, (char *str, const char *format, ...));
+_GL_FUNCDECL_RPL (sprintf, int,
+ (char *restrict str, const char *restrict format, ...)
+ _GL_ATTRIBUTE_FORMAT_PRINTF (2, 3)
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (sprintf, int,
+ (char *restrict str, const char *restrict format, ...));
# else
-_GL_CXXALIAS_SYS (sprintf, int, (char *str, const char *format, ...));
+_GL_CXXALIAS_SYS (sprintf, int,
+ (char *restrict str, const char *restrict format, ...));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (sprintf);
@@ -1169,6 +1245,11 @@ _GL_WARN_ON_USE (sprintf, "sprintf is not always POSIX compliant - "
"POSIX compliance");
#endif
+#if defined _WIN32 && !defined __CYGWIN__
+# undef tempnam
+# define tempnam _tempnam
+#endif
+
#if @GNULIB_TMPFILE@
# if @REPLACE_TMPFILE@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
@@ -1244,22 +1325,27 @@ _GL_CXXALIASWARN (vasprintf);
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# define vdprintf rpl_vdprintf
# endif
-_GL_FUNCDECL_RPL (vdprintf, int, (int fd, const char *format, va_list args)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 0)
- _GL_ARG_NONNULL ((2)));
-_GL_CXXALIAS_RPL (vdprintf, int, (int fd, const char *format, va_list args));
+_GL_FUNCDECL_RPL (vdprintf, int,
+ (int fd, const char *restrict format, va_list args)
+ _GL_ATTRIBUTE_FORMAT_PRINTF (2, 0)
+ _GL_ARG_NONNULL ((2)));
+_GL_CXXALIAS_RPL (vdprintf, int,
+ (int fd, const char *restrict format, va_list args));
# else
# if !@HAVE_VDPRINTF@
-_GL_FUNCDECL_SYS (vdprintf, int, (int fd, const char *format, va_list args)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 0)
- _GL_ARG_NONNULL ((2)));
+_GL_FUNCDECL_SYS (vdprintf, int,
+ (int fd, const char *restrict format, va_list args)
+ _GL_ATTRIBUTE_FORMAT_PRINTF (2, 0)
+ _GL_ARG_NONNULL ((2)));
# endif
/* Need to cast, because on Solaris, the third parameter will likely be
__va_list args. */
_GL_CXXALIAS_SYS_CAST (vdprintf, int,
- (int fd, const char *format, va_list args));
+ (int fd, const char *restrict format, va_list args));
# endif
+# if __GLIBC__ >= 2
_GL_CXXALIASWARN (vdprintf);
+# endif
#elif defined GNULIB_POSIXCHECK
# undef vdprintf
# if HAVE_RAW_DECL_VDPRINTF
@@ -1276,21 +1362,28 @@ _GL_WARN_ON_USE (vdprintf, "vdprintf is unportable - "
# endif
# define GNULIB_overrides_vfprintf 1
# if @GNULIB_VFPRINTF_POSIX@
-_GL_FUNCDECL_RPL (vfprintf, int, (FILE *fp, const char *format, va_list args)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 0)
- _GL_ARG_NONNULL ((1, 2)));
+_GL_FUNCDECL_RPL (vfprintf, int,
+ (FILE *restrict fp,
+ const char *restrict format, va_list args)
+ _GL_ATTRIBUTE_FORMAT_PRINTF (2, 0)
+ _GL_ARG_NONNULL ((1, 2)));
# else
-_GL_FUNCDECL_RPL (vfprintf, int, (FILE *fp, const char *format, va_list args)
- _GL_ATTRIBUTE_FORMAT_PRINTF_SYSTEM (2, 0)
- _GL_ARG_NONNULL ((1, 2)));
+_GL_FUNCDECL_RPL (vfprintf, int,
+ (FILE *restrict fp,
+ const char *restrict format, va_list args)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_SYSTEM (2, 0)
+ _GL_ARG_NONNULL ((1, 2)));
# endif
-_GL_CXXALIAS_RPL (vfprintf, int, (FILE *fp, const char *format, va_list args));
+_GL_CXXALIAS_RPL (vfprintf, int,
+ (FILE *restrict fp,
+ const char *restrict format, va_list args));
# else
/* Need to cast, because on Solaris, the third parameter is
__va_list args
and GCC's fixincludes did not change this to __gnuc_va_list. */
_GL_CXXALIAS_SYS_CAST (vfprintf, int,
- (FILE *fp, const char *format, va_list args));
+ (FILE *restrict fp,
+ const char *restrict format, va_list args));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (vfprintf);
@@ -1313,16 +1406,21 @@ _GL_WARN_ON_USE (vfprintf, "vfprintf is not always POSIX compliant - "
# define vfscanf rpl_vfscanf
# endif
_GL_FUNCDECL_RPL (vfscanf, int,
- (FILE *stream, const char *format, va_list args)
+ (FILE *restrict stream,
+ const char *restrict format, va_list args)
_GL_ATTRIBUTE_FORMAT_SCANF_SYSTEM (2, 0)
_GL_ARG_NONNULL ((1, 2)));
_GL_CXXALIAS_RPL (vfscanf, int,
- (FILE *stream, const char *format, va_list args));
+ (FILE *restrict stream,
+ const char *restrict format, va_list args));
# else
_GL_CXXALIAS_SYS (vfscanf, int,
- (FILE *stream, const char *format, va_list args));
+ (FILE *restrict stream,
+ const char *restrict format, va_list args));
# endif
+# if __GLIBC__ >= 2
_GL_CXXALIASWARN (vfscanf);
+# endif
#endif
#if @GNULIB_VPRINTF_POSIX@ || @GNULIB_VPRINTF@
@@ -1333,20 +1431,21 @@ _GL_CXXALIASWARN (vfscanf);
# endif
# define GNULIB_overrides_vprintf 1
# if @GNULIB_VPRINTF_POSIX@ || @GNULIB_VFPRINTF_POSIX@
-_GL_FUNCDECL_RPL (vprintf, int, (const char *format, va_list args)
+_GL_FUNCDECL_RPL (vprintf, int, (const char *restrict format, va_list args)
_GL_ATTRIBUTE_FORMAT_PRINTF (1, 0)
_GL_ARG_NONNULL ((1)));
# else
-_GL_FUNCDECL_RPL (vprintf, int, (const char *format, va_list args)
+_GL_FUNCDECL_RPL (vprintf, int, (const char *restrict format, va_list args)
_GL_ATTRIBUTE_FORMAT_PRINTF_SYSTEM (1, 0)
_GL_ARG_NONNULL ((1)));
# endif
-_GL_CXXALIAS_RPL (vprintf, int, (const char *format, va_list args));
+_GL_CXXALIAS_RPL (vprintf, int, (const char *restrict format, va_list args));
# else
/* Need to cast, because on Solaris, the second parameter is
__va_list args
and GCC's fixincludes did not change this to __gnuc_va_list. */
-_GL_CXXALIAS_SYS_CAST (vprintf, int, (const char *format, va_list args));
+_GL_CXXALIAS_SYS_CAST (vprintf, int,
+ (const char *restrict format, va_list args));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (vprintf);
@@ -1368,14 +1467,16 @@ _GL_WARN_ON_USE (vprintf, "vprintf is not always POSIX compliant - "
# undef vscanf
# define vscanf rpl_vscanf
# endif
-_GL_FUNCDECL_RPL (vscanf, int, (const char *format, va_list args)
+_GL_FUNCDECL_RPL (vscanf, int, (const char *restrict format, va_list args)
_GL_ATTRIBUTE_FORMAT_SCANF_SYSTEM (1, 0)
_GL_ARG_NONNULL ((1)));
-_GL_CXXALIAS_RPL (vscanf, int, (const char *format, va_list args));
+_GL_CXXALIAS_RPL (vscanf, int, (const char *restrict format, va_list args));
# else
-_GL_CXXALIAS_SYS (vscanf, int, (const char *format, va_list args));
+_GL_CXXALIAS_SYS (vscanf, int, (const char *restrict format, va_list args));
# endif
+# if __GLIBC__ >= 2
_GL_CXXALIASWARN (vscanf);
+# endif
#endif
#if @GNULIB_VSNPRINTF@
@@ -1384,22 +1485,28 @@ _GL_CXXALIASWARN (vscanf);
# define vsnprintf rpl_vsnprintf
# endif
_GL_FUNCDECL_RPL (vsnprintf, int,
- (char *str, size_t size, const char *format, va_list args)
+ (char *restrict str, size_t size,
+ const char *restrict format, va_list args)
_GL_ATTRIBUTE_FORMAT_PRINTF (3, 0)
_GL_ARG_NONNULL ((3)));
_GL_CXXALIAS_RPL (vsnprintf, int,
- (char *str, size_t size, const char *format, va_list args));
+ (char *restrict str, size_t size,
+ const char *restrict format, va_list args));
# else
# if !@HAVE_DECL_VSNPRINTF@
_GL_FUNCDECL_SYS (vsnprintf, int,
- (char *str, size_t size, const char *format, va_list args)
+ (char *restrict str, size_t size,
+ const char *restrict format, va_list args)
_GL_ATTRIBUTE_FORMAT_PRINTF (3, 0)
_GL_ARG_NONNULL ((3)));
# endif
_GL_CXXALIAS_SYS (vsnprintf, int,
- (char *str, size_t size, const char *format, va_list args));
+ (char *restrict str, size_t size,
+ const char *restrict format, va_list args));
# endif
+# if __GLIBC__ >= 2
_GL_CXXALIASWARN (vsnprintf);
+# endif
#elif defined GNULIB_POSIXCHECK
# undef vsnprintf
# if HAVE_RAW_DECL_VSNPRINTF
@@ -1414,17 +1521,20 @@ _GL_WARN_ON_USE (vsnprintf, "vsnprintf is unportable - "
# define vsprintf rpl_vsprintf
# endif
_GL_FUNCDECL_RPL (vsprintf, int,
- (char *str, const char *format, va_list args)
+ (char *restrict str,
+ const char *restrict format, va_list args)
_GL_ATTRIBUTE_FORMAT_PRINTF (2, 0)
_GL_ARG_NONNULL ((1, 2)));
_GL_CXXALIAS_RPL (vsprintf, int,
- (char *str, const char *format, va_list args));
+ (char *restrict str,
+ const char *restrict format, va_list args));
# else
/* Need to cast, because on Solaris, the third parameter is
__va_list args
and GCC's fixincludes did not change this to __gnuc_va_list. */
_GL_CXXALIAS_SYS_CAST (vsprintf, int,
- (char *str, const char *format, va_list args));
+ (char *restrict str,
+ const char *restrict format, va_list args));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (vsprintf);
diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h
index 1524277d799..47a1309e633 100644
--- a/lib/stdlib.in.h
+++ b/lib/stdlib.in.h
@@ -1,7 +1,6 @@
/* A GNU-like <stdlib.h>.
- Copyright (C) 1995, 2001-2004, 2006-2020 Free Software Foundation,
- Inc.
+ Copyright (C) 1995, 2001-2004, 2006-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
@@ -102,10 +101,12 @@ struct random_data
/* The __attribute__ feature is available in gcc versions 2.5 and later.
The attribute __pure__ was added in gcc 2.96. */
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
-# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
-#else
-# define _GL_ATTRIBUTE_PURE /* empty */
+#ifndef _GL_ATTRIBUTE_PURE
+# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96) || defined __clang__
+# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
+# else
+# define _GL_ATTRIBUTE_PURE /* empty */
+# endif
#endif
/* The definition of _Noreturn is copied here. */
@@ -202,6 +203,10 @@ _GL_FUNCDECL_SYS (canonicalize_file_name, char *, (const char *name)
# endif
_GL_CXXALIAS_SYS (canonicalize_file_name, char *, (const char *name));
# endif
+# ifndef GNULIB_defined_canonicalize_file_name
+# define GNULIB_defined_canonicalize_file_name \
+ (!@HAVE_CANONICALIZE_FILE_NAME@ || @REPLACE_CANONICALIZE_FILE_NAME@)
+# endif
_GL_CXXALIASWARN (canonicalize_file_name);
#elif defined GNULIB_POSIXCHECK
# undef canonicalize_file_name
@@ -212,6 +217,21 @@ _GL_WARN_ON_USE (canonicalize_file_name,
# endif
#endif
+#if defined _WIN32 && !defined __CYGWIN__
+# undef ecvt
+# define ecvt _ecvt
+#endif
+
+#if defined _WIN32 && !defined __CYGWIN__
+# undef fcvt
+# define fcvt _fcvt
+#endif
+
+#if defined _WIN32 && !defined __CYGWIN__
+# undef gcvt
+# define gcvt _gcvt
+#endif
+
#if @GNULIB_GETLOADAVG@
/* Store max(NELEM,3) load average numbers in LOADAVG[].
The three numbers are the load average of the last 1 minute, the last 5
@@ -308,13 +328,17 @@ _GL_WARN_ON_USE (malloc, "malloc is not POSIX compliant everywhere - "
# undef mbtowc
# define mbtowc rpl_mbtowc
# endif
-_GL_FUNCDECL_RPL (mbtowc, int, (wchar_t *pwc, const char *s, size_t n));
-_GL_CXXALIAS_RPL (mbtowc, int, (wchar_t *pwc, const char *s, size_t n));
+_GL_FUNCDECL_RPL (mbtowc, int,
+ (wchar_t *restrict pwc, const char *restrict s, size_t n));
+_GL_CXXALIAS_RPL (mbtowc, int,
+ (wchar_t *restrict pwc, const char *restrict s, size_t n));
# else
# if !@HAVE_MBTOWC@
-_GL_FUNCDECL_SYS (mbtowc, int, (wchar_t *pwc, const char *s, size_t n));
+_GL_FUNCDECL_SYS (mbtowc, int,
+ (wchar_t *restrict pwc, const char *restrict s, size_t n));
# endif
-_GL_CXXALIAS_SYS (mbtowc, int, (wchar_t *pwc, const char *s, size_t n));
+_GL_CXXALIAS_SYS (mbtowc, int,
+ (wchar_t *restrict pwc, const char *restrict s, size_t n));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (mbtowc);
@@ -459,6 +483,11 @@ _GL_WARN_ON_USE (mkstemps, "mkstemps is unportable - "
# endif
#endif
+#if defined _WIN32 && !defined __CYGWIN__
+# undef mktemp
+# define mktemp _mktemp
+#endif
+
#if @GNULIB_POSIX_OPENPT@
/* Return an FD open to the master side of a pseudo-terminal. Flags should
include O_RDWR, and may also include O_NOCTTY. */
@@ -517,6 +546,9 @@ _GL_FUNCDECL_SYS (ptsname_r, int, (int fd, char *buf, size_t len));
# endif
_GL_CXXALIAS_SYS (ptsname_r, int, (int fd, char *buf, size_t len));
# endif
+# ifndef GNULIB_defined_ptsname_r
+# define GNULIB_defined_ptsname_r (!@HAVE_PTSNAME_R@ || @REPLACE_PTSNAME_R@)
+# endif
_GL_CXXALIASWARN (ptsname_r);
#elif defined GNULIB_POSIXCHECK
# undef ptsname_r
@@ -534,10 +566,19 @@ _GL_WARN_ON_USE (ptsname_r, "ptsname_r is not portable - "
# endif
_GL_FUNCDECL_RPL (putenv, int, (char *string) _GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_RPL (putenv, int, (char *string));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef putenv
+# define putenv _putenv
+# endif
+_GL_CXXALIAS_MDA (putenv, int, (char *string));
# else
_GL_CXXALIAS_SYS (putenv, int, (char *string));
# endif
_GL_CXXALIASWARN (putenv);
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef putenv
+# define putenv _putenv
#endif
#if @GNULIB_QSORT_R@
@@ -600,7 +641,9 @@ _GL_CXXALIAS_RPL (random, long, (void));
# if !@HAVE_RANDOM@
_GL_FUNCDECL_SYS (random, long, (void));
# endif
-_GL_CXXALIAS_SYS (random, long, (void));
+/* Need to cast, because on Haiku, the return type is
+ int. */
+_GL_CXXALIAS_SYS_CAST (random, long, (void));
# endif
_GL_CXXALIASWARN (random);
#elif defined GNULIB_POSIXCHECK
@@ -767,9 +810,11 @@ _GL_FUNCDECL_SYS (initstate_r, int,
struct random_data *rand_state)
_GL_ARG_NONNULL ((2, 4)));
# endif
-_GL_CXXALIAS_SYS (initstate_r, int,
- (unsigned int seed, char *buf, size_t buf_size,
- struct random_data *rand_state));
+/* Need to cast, because on Haiku, the third parameter is
+ unsigned long buf_size. */
+_GL_CXXALIAS_SYS_CAST (initstate_r, int,
+ (unsigned int seed, char *buf, size_t buf_size,
+ struct random_data *rand_state));
# endif
_GL_CXXALIASWARN (initstate_r);
#elif defined GNULIB_POSIXCHECK
@@ -797,8 +842,10 @@ _GL_FUNCDECL_SYS (setstate_r, int,
(char *arg_state, struct random_data *rand_state)
_GL_ARG_NONNULL ((1, 2)));
# endif
-_GL_CXXALIAS_SYS (setstate_r, int,
- (char *arg_state, struct random_data *rand_state));
+/* Need to cast, because on Haiku, the first parameter is
+ void *arg_state. */
+_GL_CXXALIAS_SYS_CAST (setstate_r, int,
+ (char *arg_state, struct random_data *rand_state));
# endif
_GL_CXXALIASWARN (setstate_r);
#elif defined GNULIB_POSIXCHECK
@@ -854,15 +901,19 @@ _GL_WARN_ON_USE (reallocarray, "reallocarray is not portable - "
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# define realpath rpl_realpath
# endif
-_GL_FUNCDECL_RPL (realpath, char *, (const char *name, char *resolved)
- _GL_ARG_NONNULL ((1)));
-_GL_CXXALIAS_RPL (realpath, char *, (const char *name, char *resolved));
+_GL_FUNCDECL_RPL (realpath, char *,
+ (const char *restrict name, char *restrict resolved)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (realpath, char *,
+ (const char *restrict name, char *restrict resolved));
# else
# if !@HAVE_REALPATH@
-_GL_FUNCDECL_SYS (realpath, char *, (const char *name, char *resolved)
- _GL_ARG_NONNULL ((1)));
+_GL_FUNCDECL_SYS (realpath, char *,
+ (const char *restrict name, char *restrict resolved)
+ _GL_ARG_NONNULL ((1)));
# endif
-_GL_CXXALIAS_SYS (realpath, char *, (const char *name, char *resolved));
+_GL_CXXALIAS_SYS (realpath, char *,
+ (const char *restrict name, char *restrict resolved));
# endif
_GL_CXXALIASWARN (realpath);
#elif defined GNULIB_POSIXCHECK
@@ -945,15 +996,19 @@ _GL_WARN_ON_USE (setenv, "setenv is unportable - "
# define strtod rpl_strtod
# endif
# define GNULIB_defined_strtod_function 1
-_GL_FUNCDECL_RPL (strtod, double, (const char *str, char **endp)
- _GL_ARG_NONNULL ((1)));
-_GL_CXXALIAS_RPL (strtod, double, (const char *str, char **endp));
+_GL_FUNCDECL_RPL (strtod, double,
+ (const char *restrict str, char **restrict endp)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (strtod, double,
+ (const char *restrict str, char **restrict endp));
# else
# if !@HAVE_STRTOD@
-_GL_FUNCDECL_SYS (strtod, double, (const char *str, char **endp)
- _GL_ARG_NONNULL ((1)));
+_GL_FUNCDECL_SYS (strtod, double,
+ (const char *restrict str, char **restrict endp)
+ _GL_ARG_NONNULL ((1)));
# endif
-_GL_CXXALIAS_SYS (strtod, double, (const char *str, char **endp));
+_GL_CXXALIAS_SYS (strtod, double,
+ (const char *restrict str, char **restrict endp));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (strtod);
@@ -973,15 +1028,19 @@ _GL_WARN_ON_USE (strtod, "strtod is unportable - "
# define strtold rpl_strtold
# endif
# define GNULIB_defined_strtold_function 1
-_GL_FUNCDECL_RPL (strtold, long double, (const char *str, char **endp)
- _GL_ARG_NONNULL ((1)));
-_GL_CXXALIAS_RPL (strtold, long double, (const char *str, char **endp));
+_GL_FUNCDECL_RPL (strtold, long double,
+ (const char *restrict str, char **restrict endp)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (strtold, long double,
+ (const char *restrict str, char **restrict endp));
# else
# if !@HAVE_STRTOLD@
-_GL_FUNCDECL_SYS (strtold, long double, (const char *str, char **endp)
- _GL_ARG_NONNULL ((1)));
+_GL_FUNCDECL_SYS (strtold, long double,
+ (const char *restrict str, char **restrict endp)
+ _GL_ARG_NONNULL ((1)));
# endif
-_GL_CXXALIAS_SYS (strtold, long double, (const char *str, char **endp));
+_GL_CXXALIAS_SYS (strtold, long double,
+ (const char *restrict str, char **restrict endp));
# endif
_GL_CXXALIASWARN (strtold);
#elif defined GNULIB_POSIXCHECK
@@ -1003,11 +1062,13 @@ _GL_WARN_ON_USE (strtold, "strtold is unportable - "
to ERANGE. */
# if !@HAVE_STRTOLL@
_GL_FUNCDECL_SYS (strtoll, long long,
- (const char *string, char **endptr, int base)
+ (const char *restrict string, char **restrict endptr,
+ int base)
_GL_ARG_NONNULL ((1)));
# endif
_GL_CXXALIAS_SYS (strtoll, long long,
- (const char *string, char **endptr, int base));
+ (const char *restrict string, char **restrict endptr,
+ int base));
_GL_CXXALIASWARN (strtoll);
#elif defined GNULIB_POSIXCHECK
# undef strtoll
@@ -1028,11 +1089,13 @@ _GL_WARN_ON_USE (strtoll, "strtoll is unportable - "
ERANGE. */
# if !@HAVE_STRTOULL@
_GL_FUNCDECL_SYS (strtoull, unsigned long long,
- (const char *string, char **endptr, int base)
+ (const char *restrict string, char **restrict endptr,
+ int base)
_GL_ARG_NONNULL ((1)));
# endif
_GL_CXXALIAS_SYS (strtoull, unsigned long long,
- (const char *string, char **endptr, int base));
+ (const char *restrict string, char **restrict endptr,
+ int base));
_GL_CXXALIASWARN (strtoull);
#elif defined GNULIB_POSIXCHECK
# undef strtoull
diff --git a/lib/strftime.h b/lib/strftime.h
index 97a062c631d..fe0c4195a59 100644
--- a/lib/strftime.h
+++ b/lib/strftime.h
@@ -24,8 +24,13 @@ extern "C" {
/* Just like strftime, but with two more arguments:
POSIX requires that strftime use the local timezone information.
Use the timezone __TZ instead. Use __NS as the number of
- nanoseconds in the %N directive. */
-size_t nstrftime (char *, size_t, char const *, struct tm const *,
+ nanoseconds in the %N directive.
+
+ On error, set errno and return 0. Otherwise, return the number of
+ bytes generated (not counting the trailing NUL), preserving errno
+ if the number is 0. This errno behavior is in draft POSIX 202x
+ plus some requested changes to POSIX. */
+size_t nstrftime (char *restrict, size_t, char const *, struct tm const *,
timezone_t __tz, int __ns);
#ifdef __cplusplus
diff --git a/lib/string.in.h b/lib/string.in.h
index 2c04e5f4f71..9724addef43 100644
--- a/lib/string.in.h
+++ b/lib/string.in.h
@@ -54,10 +54,12 @@
/* The __attribute__ feature is available in gcc versions 2.5 and later.
The attribute __pure__ was added in gcc 2.96. */
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
-# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
-#else
-# define _GL_ATTRIBUTE_PURE /* empty */
+#ifndef _GL_ATTRIBUTE_PURE
+# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96) || defined __clang__
+# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
+# else
+# define _GL_ATTRIBUTE_PURE /* empty */
+# endif
#endif
/* NetBSD 5.0 declares strsignal in <unistd.h>, not in <string.h>. */
@@ -121,6 +123,12 @@ _GL_WARN_ON_USE (ffsll, "ffsll is not portable - use the ffsll module");
#endif
+#if defined _WIN32 && !defined __CYGWIN__
+# undef memccpy
+# define memccpy _memccpy
+#endif
+
+
/* Return the first instance of C within N bytes of S, or NULL. */
#if @GNULIB_MEMCHR@
# if @REPLACE_MEMCHR@
@@ -132,11 +140,6 @@ _GL_FUNCDECL_RPL (memchr, void *, (void const *__s, int __c, size_t __n)
_GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_RPL (memchr, void *, (void const *__s, int __c, size_t __n));
# else
-# if ! @HAVE_MEMCHR@
-_GL_FUNCDECL_SYS (memchr, void *, (void const *__s, int __c, size_t __n)
- _GL_ATTRIBUTE_PURE
- _GL_ARG_NONNULL ((1)));
-# endif
/* On some systems, this function is defined as an overloaded function:
extern "C" { const void * std::memchr (const void *, int, size_t); }
extern "C++" { void * std::memchr (void *, int, size_t); } */
@@ -332,9 +335,11 @@ _GL_WARN_ON_USE (stpncpy, "stpncpy is unportable - "
GB18030 and the character to be searched is a digit. */
# undef strchr
/* Assume strchr is always declared. */
-_GL_WARN_ON_USE (strchr, "strchr cannot work correctly on character strings "
- "in some multibyte locales - "
- "use mbschr if you care about internationalization");
+_GL_WARN_ON_USE_CXX (strchr,
+ const char *, char *, (const char *, int),
+ "strchr cannot work correctly on character strings "
+ "in some multibyte locales - "
+ "use mbschr if you care about internationalization");
#endif
/* Find the first occurrence of C in S or the final NUL byte. */
@@ -385,6 +390,12 @@ _GL_WARN_ON_USE (strchrnul, "strchrnul is unportable - "
# endif
_GL_FUNCDECL_RPL (strdup, char *, (char const *__s) _GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_RPL (strdup, char *, (char const *__s));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef strdup
+# define strdup _strdup
+# endif
+_GL_CXXALIAS_MDA (strdup, char *, (char const *__s));
# else
# if defined __cplusplus && defined GNULIB_NAMESPACE && defined strdup
/* strdup exists as a function and as a macro. Get rid of the macro. */
@@ -402,6 +413,9 @@ _GL_CXXALIASWARN (strdup);
_GL_WARN_ON_USE (strdup, "strdup is unportable - "
"use gnulib module strdup for portability");
# endif
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef strdup
+# define strdup _strdup
#endif
/* Append no more than N characters from SRC onto DEST. */
@@ -411,11 +425,14 @@ _GL_WARN_ON_USE (strdup, "strdup is unportable - "
# undef strncat
# define strncat rpl_strncat
# endif
-_GL_FUNCDECL_RPL (strncat, char *, (char *dest, const char *src, size_t n)
- _GL_ARG_NONNULL ((1, 2)));
-_GL_CXXALIAS_RPL (strncat, char *, (char *dest, const char *src, size_t n));
+_GL_FUNCDECL_RPL (strncat, char *,
+ (char *restrict dest, const char *restrict src, size_t n)
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (strncat, char *,
+ (char *restrict dest, const char *restrict src, size_t n));
# else
-_GL_CXXALIAS_SYS (strncat, char *, (char *dest, const char *src, size_t n));
+_GL_CXXALIAS_SYS (strncat, char *,
+ (char *restrict dest, const char *restrict src, size_t n));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (strncat);
@@ -523,15 +540,19 @@ _GL_CXXALIASWARN (strpbrk);
locale encoding is GB18030 and one of the characters to be searched is a
digit. */
# undef strpbrk
-_GL_WARN_ON_USE (strpbrk, "strpbrk cannot work correctly on character strings "
- "in multibyte locales - "
- "use mbspbrk if you care about internationalization");
+_GL_WARN_ON_USE_CXX (strpbrk,
+ const char *, char *, (const char *, const char *),
+ "strpbrk cannot work correctly on character strings "
+ "in multibyte locales - "
+ "use mbspbrk if you care about internationalization");
# endif
#elif defined GNULIB_POSIXCHECK
# undef strpbrk
# if HAVE_RAW_DECL_STRPBRK
-_GL_WARN_ON_USE (strpbrk, "strpbrk is unportable - "
- "use gnulib module strpbrk for portability");
+_GL_WARN_ON_USE_CXX (strpbrk,
+ const char *, char *, (const char *, const char *),
+ "strpbrk is unportable - "
+ "use gnulib module strpbrk for portability");
# endif
#endif
@@ -550,9 +571,11 @@ _GL_WARN_ON_USE (strspn, "strspn cannot work correctly on character strings "
GB18030 and the character to be searched is a digit. */
# undef strrchr
/* Assume strrchr is always declared. */
-_GL_WARN_ON_USE (strrchr, "strrchr cannot work correctly on character strings "
- "in some multibyte locales - "
- "use mbsrchr if you care about internationalization");
+_GL_WARN_ON_USE_CXX (strrchr,
+ const char *, char *, (const char *, int),
+ "strrchr cannot work correctly on character strings "
+ "in some multibyte locales - "
+ "use mbsrchr if you care about internationalization");
#endif
/* Search the next delimiter (char listed in DELIM) starting at *STRINGP.
@@ -966,7 +989,8 @@ _GL_EXTERN_C char * mbssep (char **stringp, const char *delim)
Caveat: The identity of the delimiting character is lost.
See also mbssep(). */
-_GL_EXTERN_C char * mbstok_r (char *string, const char *delim, char **save_ptr)
+_GL_EXTERN_C char * mbstok_r (char *restrict string, const char *delim,
+ char **save_ptr)
_GL_ARG_NONNULL ((2, 3));
#endif
@@ -1021,6 +1045,60 @@ _GL_WARN_ON_USE (strerror_r, "strerror_r is unportable - "
# endif
#endif
+/* Return the name of the system error code ERRNUM. */
+#if @GNULIB_STRERRORNAME_NP@
+# if @REPLACE_STRERRORNAME_NP@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef strerrorname_np
+# define strerrorname_np rpl_strerrorname_np
+# endif
+_GL_FUNCDECL_RPL (strerrorname_np, const char *, (int errnum));
+_GL_CXXALIAS_RPL (strerrorname_np, const char *, (int errnum));
+# else
+# if !@HAVE_STRERRORNAME_NP@
+_GL_FUNCDECL_SYS (strerrorname_np, const char *, (int errnum));
+# endif
+_GL_CXXALIAS_SYS (strerrorname_np, const char *, (int errnum));
+# endif
+_GL_CXXALIASWARN (strerrorname_np);
+#elif defined GNULIB_POSIXCHECK
+# undef strerrorname_np
+# if HAVE_RAW_DECL_STRERRORNAME_NP
+_GL_WARN_ON_USE (strerrorname_np, "strerrorname_np is unportable - "
+ "use gnulib module strerrorname_np for portability");
+# endif
+#endif
+
+/* Return an abbreviation string for the signal number SIG. */
+#if @GNULIB_SIGABBREV_NP@
+# if ! @HAVE_SIGABBREV_NP@
+_GL_FUNCDECL_SYS (sigabbrev_np, const char *, (int sig));
+# endif
+_GL_CXXALIAS_SYS (sigabbrev_np, const char *, (int sig));
+_GL_CXXALIASWARN (sigabbrev_np);
+#elif defined GNULIB_POSIXCHECK
+# undef sigabbrev_np
+# if HAVE_RAW_DECL_SIGABBREV_NP
+_GL_WARN_ON_USE (sigabbrev_np, "sigabbrev_np is unportable - "
+ "use gnulib module sigabbrev_np for portability");
+# endif
+#endif
+
+/* Return an English description string for the signal number SIG. */
+#if @GNULIB_SIGDESCR_NP@
+# if ! @HAVE_SIGDESCR_NP@
+_GL_FUNCDECL_SYS (sigdescr_np, const char *, (int sig));
+# endif
+_GL_CXXALIAS_SYS (sigdescr_np, const char *, (int sig));
+_GL_CXXALIASWARN (sigdescr_np);
+#elif defined GNULIB_POSIXCHECK
+# undef sigdescr_np
+# if HAVE_RAW_DECL_SIGDESCR_NP
+_GL_WARN_ON_USE (sigdescr_np, "sigdescr_np is unportable - "
+ "use gnulib module sigdescr_np for portability");
+# endif
+#endif
+
#if @GNULIB_STRSIGNAL@
# if @REPLACE_STRSIGNAL@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
diff --git a/lib/strtoimax.c b/lib/strtoimax.c
index 95f6f3ff11f..a17b2f0a9d7 100644
--- a/lib/strtoimax.c
+++ b/lib/strtoimax.c
@@ -1,7 +1,7 @@
/* Convert string representation of a number into an intmax_t value.
- Copyright (C) 1999, 2001-2004, 2006, 2009-2020 Free Software
- Foundation, Inc.
+ Copyright (C) 1999, 2001-2004, 2006, 2009-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
@@ -28,36 +28,30 @@
#include "verify.h"
#ifdef UNSIGNED
-# if HAVE_UNSIGNED_LONG_LONG_INT
-# ifndef HAVE_DECL_STRTOULL
+# ifndef HAVE_DECL_STRTOULL
"this configure-time declaration test was not run"
-# endif
-# if !HAVE_DECL_STRTOULL
+# endif
+# if !HAVE_DECL_STRTOULL
unsigned long long int strtoull (char const *, char **, int);
-# endif
# endif
#else
-# if HAVE_LONG_LONG_INT
-# ifndef HAVE_DECL_STRTOLL
+# ifndef HAVE_DECL_STRTOLL
"this configure-time declaration test was not run"
-# endif
-# if !HAVE_DECL_STRTOLL
+# endif
+# if !HAVE_DECL_STRTOLL
long long int strtoll (char const *, char **, int);
-# endif
# endif
#endif
#ifdef UNSIGNED
-# define Have_long_long HAVE_UNSIGNED_LONG_LONG_INT
# define Int uintmax_t
# define Strtoimax strtoumax
# define Strtol strtoul
# define Strtoll strtoull
# define Unsigned unsigned
#else
-# define Have_long_long HAVE_LONG_LONG_INT
# define Int intmax_t
# define Strtoimax strtoimax
# define Strtol strtol
@@ -68,15 +62,11 @@ long long int strtoll (char const *, char **, int);
Int
Strtoimax (char const *ptr, char **endptr, int base)
{
-#if Have_long_long
verify (sizeof (Int) == sizeof (Unsigned long int)
|| sizeof (Int) == sizeof (Unsigned long long int));
if (sizeof (Int) != sizeof (Unsigned long int))
return Strtoll (ptr, endptr, base);
-#else
- verify (sizeof (Int) == sizeof (Unsigned long int));
-#endif
return Strtol (ptr, endptr, base);
}
diff --git a/lib/strtol.c b/lib/strtol.c
index a2e1dee99ee..02aafca44ea 100644
--- a/lib/strtol.c
+++ b/lib/strtol.c
@@ -1,7 +1,7 @@
/* Convert string representation of a number into an integer value.
- Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2020 Free
- Software Foundation, Inc.
+ Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2020 Free Software
+ Foundation, Inc.
NOTE: The canonical source of this file is maintained with the GNU C
Library. Bugs can be reported to bug-glibc@gnu.org.
diff --git a/lib/strtoll.c b/lib/strtoll.c
index 0b8e03c025c..3c7e8c002f0 100644
--- a/lib/strtoll.c
+++ b/lib/strtoll.c
@@ -1,6 +1,6 @@
/* Function to parse a 'long long int' from text.
- Copyright (C) 1995-1997, 1999, 2001, 2009-2020 Free Software
- Foundation, Inc.
+ Copyright (C) 1995-1997, 1999, 2001, 2009-2020 Free Software Foundation,
+ Inc.
This file is part of the GNU C Library.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/sys_random.in.h b/lib/sys_random.in.h
new file mode 100644
index 00000000000..a82d716de2e
--- /dev/null
+++ b/lib/sys_random.in.h
@@ -0,0 +1,96 @@
+/* Substitute for <sys/random.h>.
+ Copyright (C) 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, 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/>. */
+
+# if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+# endif
+@PRAGMA_COLUMNS@
+
+#ifndef _@GUARD_PREFIX@_SYS_RANDOM_H
+
+#if @HAVE_SYS_RANDOM_H@
+
+/* On uClibc, <sys/random.h> assumes prior inclusion of <stddef.h>. */
+# if defined __UCLIBC__
+# include <stddef.h>
+# endif
+/* On Mac OS X 10.5, <sys/random.h> assumes prior inclusion of <sys/types.h>.
+ On Max OS X 10.13, <sys/random.h> assumes prior inclusion of a file that
+ includes <Availability.h>, such as <stdlib.h> or <unistd.h>. */
+# if defined __APPLE__ && defined __MACH__ /* Mac OS X */
+# include <sys/types.h>
+# include <stdlib.h>
+# endif
+
+/* The include_next requires a split double-inclusion guard. */
+# @INCLUDE_NEXT@ @NEXT_SYS_RANDOM_H@
+
+#endif
+
+#ifndef _@GUARD_PREFIX@_SYS_RANDOM_H
+#define _@GUARD_PREFIX@_SYS_RANDOM_H
+
+#include <sys/types.h>
+
+/* Define the GRND_* constants. */
+#ifndef GRND_NONBLOCK
+# define GRND_NONBLOCK 1
+# define GRND_RANDOM 2
+#endif
+
+/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
+
+/* The definition of _GL_ARG_NONNULL is copied here. */
+
+/* The definition of _GL_WARN_ON_USE is copied here. */
+
+
+/* Declare overridden functions. */
+
+
+#if @GNULIB_GETRANDOM@
+/* Fill a buffer with random bytes. */
+# if @REPLACE_GETRANDOM@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef getrandom
+# define getrandom rpl_getrandom
+# endif
+_GL_FUNCDECL_RPL (getrandom, ssize_t,
+ (void *buffer, size_t length, unsigned int flags)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (getrandom, ssize_t,
+ (void *buffer, size_t length, unsigned int flags));
+# else
+# if !@HAVE_GETRANDOM@
+_GL_FUNCDECL_SYS (getrandom, ssize_t,
+ (void *buffer, size_t length, unsigned int flags)
+ _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (getrandom, ssize_t,
+ (void *buffer, size_t length, unsigned int flags));
+# endif
+_GL_CXXALIASWARN (getrandom);
+#elif defined GNULIB_POSIXCHECK
+# undef getrandom
+# if HAVE_RAW_DECL_GETRANDOM
+_GL_WARN_ON_USE (getrandom, "getrandom is unportable - "
+ "use gnulib module getrandom for portability");
+# endif
+#endif
+
+
+#endif /* _@GUARD_PREFIX@_SYS_RANDOM_H */
+#endif /* _@GUARD_PREFIX@_SYS_RANDOM_H */
diff --git a/lib/sys_select.in.h b/lib/sys_select.in.h
index 7a7b157d545..72cb9ba7b0f 100644
--- a/lib/sys_select.in.h
+++ b/lib/sys_select.in.h
@@ -177,14 +177,14 @@ rpl_fd_isset (SOCKET fd, fd_set * set)
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# undef close
# define close close_used_without_including_unistd_h
-# else
+# elif !defined __clang__
_GL_WARN_ON_USE (close,
"close() used without including <unistd.h>");
# endif
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# undef gethostname
# define gethostname gethostname_used_without_including_unistd_h
-# else
+# elif !defined __clang__
_GL_WARN_ON_USE (gethostname,
"gethostname() used without including <unistd.h>");
# endif
@@ -219,7 +219,7 @@ rpl_fd_isset (SOCKET fd, fd_set * set)
# define setsockopt setsockopt_used_without_including_sys_socket_h
# undef shutdown
# define shutdown shutdown_used_without_including_sys_socket_h
-# else
+# elif !defined __clang__
_GL_WARN_ON_USE (socket,
"socket() used without including <sys/socket.h>");
_GL_WARN_ON_USE (connect,
diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h
index c1e3243c1fe..3e0e4b27b7e 100644
--- a/lib/sys_stat.in.h
+++ b/lib/sys_stat.in.h
@@ -391,14 +391,32 @@ struct stat
#endif
+#if defined _WIN32 && !defined __CYGWIN__
+# undef chmod
+# define chmod _chmod
+#endif
+
+
#if @GNULIB_FCHMODAT@
-# if !@HAVE_FCHMODAT@
+# if @REPLACE_FCHMODAT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef fchmodat
+# define fchmodat rpl_fchmodat
+# endif
+_GL_FUNCDECL_RPL (fchmodat, int,
+ (int fd, char const *file, mode_t mode, int flag)
+ _GL_ARG_NONNULL ((2)));
+_GL_CXXALIAS_RPL (fchmodat, int,
+ (int fd, char const *file, mode_t mode, int flag));
+# else
+# if !@HAVE_FCHMODAT@
_GL_FUNCDECL_SYS (fchmodat, int,
(int fd, char const *file, mode_t mode, int flag)
_GL_ARG_NONNULL ((2)));
-# endif
+# endif
_GL_CXXALIAS_SYS (fchmodat, int,
(int fd, char const *file, mode_t mode, int flag));
+# endif
_GL_CXXALIASWARN (fchmodat);
#elif defined GNULIB_POSIXCHECK
# undef fchmodat
@@ -420,7 +438,9 @@ _GL_CXXALIAS_RPL (fstat, int, (int fd, struct stat *buf));
# else
_GL_CXXALIAS_SYS (fstat, int, (int fd, struct stat *buf));
# endif
+# if __GLIBC__ >= 2
_GL_CXXALIASWARN (fstat);
+# endif
#elif @GNULIB_OVERRIDES_STRUCT_STAT@
# undef fstat
# define fstat fstat_used_without_requesting_gnulib_module_fstat
@@ -443,18 +463,22 @@ _GL_WARN_ON_USE (fstat, "fstat has portability problems - "
# define fstatat rpl_fstatat
# endif
_GL_FUNCDECL_RPL (fstatat, int,
- (int fd, char const *name, struct stat *st, int flags)
+ (int fd, char const *restrict name, struct stat *restrict st,
+ int flags)
_GL_ARG_NONNULL ((2, 3)));
_GL_CXXALIAS_RPL (fstatat, int,
- (int fd, char const *name, struct stat *st, int flags));
+ (int fd, char const *restrict name, struct stat *restrict st,
+ int flags));
# else
# if !@HAVE_FSTATAT@
_GL_FUNCDECL_SYS (fstatat, int,
- (int fd, char const *name, struct stat *st, int flags)
+ (int fd, char const *restrict name, struct stat *restrict st,
+ int flags)
_GL_ARG_NONNULL ((2, 3)));
# endif
_GL_CXXALIAS_SYS (fstatat, int,
- (int fd, char const *name, struct stat *st, int flags));
+ (int fd, char const *restrict name, struct stat *restrict st,
+ int flags));
# endif
_GL_CXXALIASWARN (fstatat);
#elif @GNULIB_OVERRIDES_STRUCT_STAT@
@@ -499,34 +523,32 @@ _GL_WARN_ON_USE (futimens, "futimens is not portable - "
#endif
+#if @GNULIB_GETUMASK@
+# if !@HAVE_GETUMASK@
+_GL_FUNCDECL_SYS (getumask, mode_t, (void));
+# endif
+_GL_CXXALIAS_SYS (getumask, mode_t, (void));
+# if @HAVE_GETUMASK@
+_GL_CXXALIASWARN (getumask);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef getumask
+# if HAVE_RAW_DECL_GETUMASK
+_GL_WARN_ON_USE (getumask, "getumask is not portable - "
+ "use gnulib module getumask for portability");
+# endif
+#endif
+
+
#if @GNULIB_LCHMOD@
/* Change the mode of FILENAME to MODE, without dereferencing it if FILENAME
denotes a symbolic link. */
-# if !@HAVE_LCHMOD@
-/* The lchmod replacement follows symbolic links. Callers should take
- this into account; lchmod should be applied only to arguments that
- are known to not be symbolic links. On hosts that lack lchmod,
- this can lead to race conditions between the check and the
- invocation of lchmod, but we know of no workarounds that are
- reliable in general. You might try requesting support for lchmod
- from your operating system supplier. */
-# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
-# define lchmod chmod
-# endif
-/* Need to cast, because on mingw, the second parameter of chmod is
- int mode. */
-_GL_CXXALIAS_RPL_CAST_1 (lchmod, chmod, int,
- (const char *filename, mode_t mode));
-# else
-# if 0 /* assume already declared */
+# if !@HAVE_LCHMOD@ || defined __hpux
_GL_FUNCDECL_SYS (lchmod, int, (const char *filename, mode_t mode)
_GL_ARG_NONNULL ((1)));
-# endif
-_GL_CXXALIAS_SYS (lchmod, int, (const char *filename, mode_t mode));
# endif
-# if @HAVE_LCHMOD@
+_GL_CXXALIAS_SYS (lchmod, int, (const char *filename, mode_t mode));
_GL_CXXALIASWARN (lchmod);
-# endif
#elif defined GNULIB_POSIXCHECK
# undef lchmod
# if HAVE_RAW_DECL_LCHMOD
@@ -543,17 +565,21 @@ _GL_WARN_ON_USE (lchmod, "lchmod is unportable - "
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# define lstat stat
# endif
-_GL_CXXALIAS_RPL_1 (lstat, stat, int, (const char *name, struct stat *buf));
+_GL_CXXALIAS_RPL_1 (lstat, stat, int,
+ (const char *restrict name, struct stat *restrict buf));
# elif @REPLACE_LSTAT@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# undef lstat
# define lstat rpl_lstat
# endif
-_GL_FUNCDECL_RPL (lstat, int, (const char *name, struct stat *buf)
- _GL_ARG_NONNULL ((1, 2)));
-_GL_CXXALIAS_RPL (lstat, int, (const char *name, struct stat *buf));
+_GL_FUNCDECL_RPL (lstat, int,
+ (const char *restrict name, struct stat *restrict buf)
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (lstat, int,
+ (const char *restrict name, struct stat *restrict buf));
# else
-_GL_CXXALIAS_SYS (lstat, int, (const char *name, struct stat *buf));
+_GL_CXXALIAS_SYS (lstat, int,
+ (const char *restrict name, struct stat *restrict buf));
# endif
# if @HAVE_LSTAT@
_GL_CXXALIASWARN (lstat);
@@ -766,7 +792,7 @@ _GL_WARN_ON_USE (mknodat, "mknodat is not portable - "
# define stat(name, st) rpl_stat (name, st)
# endif /* !_LARGE_FILES */
# endif /* !@GNULIB_OVERRIDES_STRUCT_STAT@ */
-_GL_EXTERN_C int stat (const char *name, struct stat *buf)
+_GL_EXTERN_C int stat (const char *restrict name, struct stat *restrict buf)
_GL_ARG_NONNULL ((1, 2));
# endif
#elif @GNULIB_OVERRIDES_STRUCT_STAT@
@@ -782,6 +808,12 @@ _GL_WARN_ON_USE (stat, "stat is unportable - "
#endif
+#if defined _WIN32 && !defined __CYGWIN__
+# undef umask
+# define umask _umask
+#endif
+
+
#if @GNULIB_UTIMENSAT@
/* Use the rpl_ prefix also on Solaris <= 9, because on Solaris 9 our utimensat
implementation relies on futimesat, which on Solaris 10 makes an invocation
diff --git a/lib/sys_time.in.h b/lib/sys_time.in.h
index d30b26719b2..1c12d5f13d7 100644
--- a/lib/sys_time.in.h
+++ b/lib/sys_time.in.h
@@ -135,7 +135,7 @@ _GL_WARN_ON_USE (gettimeofday, "gettimeofday is unportable - "
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# undef close
# define close close_used_without_including_unistd_h
-# else
+# elif !defined __clang__
_GL_WARN_ON_USE (close,
"close() used without including <unistd.h>");
# endif
diff --git a/lib/tempname.c b/lib/tempname.c
index 7c46ad14078..cfb0fc42eca 100644
--- a/lib/tempname.c
+++ b/lib/tempname.c
@@ -1,25 +1,22 @@
-/* tempname.c - generate the name of a temporary file.
+/* Copyright (C) 1991-2020 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
- Copyright (C) 1991-2003, 2005-2007, 2009-2020 Free Software
- Foundation, Inc.
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public
+ License as published by the Free Software Foundation; either
+ version 3 of the License, or (at your option) any later version.
- This program is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 3 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
+ The GNU C Library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <https://www.gnu.org/licenses/>. */
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
-/* Extracted from glibc sysdeps/posix/tempname.c. See also tmpdir.c. */
+ You should have received a copy of the GNU General Public
+ License along with the GNU C Library; if not, see
+ <https://www.gnu.org/licenses/>. */
#if !_LIBC
-# include <config.h>
+# include <libc-config.h>
# include "tempname.h"
#endif
@@ -27,9 +24,6 @@
#include <assert.h>
#include <errno.h>
-#ifndef __set_errno
-# define __set_errno(Val) errno = (Val)
-#endif
#include <stdio.h>
#ifndef P_tmpdir
@@ -53,51 +47,39 @@
#include <string.h>
#include <fcntl.h>
-#include <sys/time.h>
#include <stdint.h>
-#include <unistd.h>
-
+#include <sys/random.h>
#include <sys/stat.h>
#if _LIBC
# define struct_stat64 struct stat64
+# define __secure_getenv __libc_secure_getenv
#else
# define struct_stat64 struct stat
-# define __try_tempname try_tempname
# define __gen_tempname gen_tempname
-# define __getpid getpid
-# define __gettimeofday gettimeofday
# define __mkdir mkdir
# define __open open
# define __lxstat64(version, file, buf) lstat (file, buf)
#endif
#ifdef _LIBC
-# include <hp-timing.h>
-# if HP_TIMING_AVAIL
-# define RANDOM_BITS(Var) \
- if (__builtin_expect (value == UINT64_C (0), 0)) \
- { \
- /* If this is the first time this function is used initialize \
- the variable we accumulate the value in to some somewhat \
- random value. If we'd not do this programs at startup time \
- might have a reduced set of possible names, at least on slow \
- machines. */ \
- struct timeval tv; \
- __gettimeofday (&tv, NULL); \
- value = ((uint64_t) tv.tv_usec << 16) ^ tv.tv_sec; \
- } \
- HP_TIMING_NOW (Var)
-# endif
-#endif
-
-/* Use the widest available unsigned type if uint64_t is not
- available. The algorithm below extracts a number less than 62**6
- (approximately 2**35.725) from uint64_t, so ancient hosts where
- uintmax_t is only 32 bits lose about 3.725 bits of randomness,
- which is better than not having mkstemp at all. */
-#if !defined UINT64_MAX && !defined uint64_t
-# define uint64_t uintmax_t
+# include <random-bits.h>
+# define RANDOM_BITS(Var) ((Var) = random_bits ())
+typedef uint32_t random_value;
+# define RANDOM_VALUE_MAX UINT32_MAX
+# define BASE_62_DIGITS 5 /* 62**5 < UINT32_MAX */
+# define BASE_62_POWER (62 * 62 * 62 * 62 * 62) /* 2**BASE_62_DIGITS */
+#else
+/* Use getrandom if it works, falling back on a 64-bit linear
+ congruential generator that starts with whatever Var's value
+ happens to be. */
+# define RANDOM_BITS(Var) \
+ ((void) (getrandom (&(Var), sizeof (Var), 0) == sizeof (Var) \
+ || ((Var) = 2862933555777941757 * (Var) + 3037000493)))
+typedef uint_fast64_t random_value;
+# define RANDOM_VALUE_MAX UINT_FAST64_MAX
+# define BASE_62_DIGITS 10 /* 62**10 < UINT_FAST64_MAX */
+# define BASE_62_POWER (62LL * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62)
#endif
#if _LIBC
@@ -173,18 +155,80 @@ __path_search (char *tmpl, size_t tmpl_len, const char *dir, const char *pfx,
}
#endif /* _LIBC */
+#if _LIBC
+static int try_tempname_len (char *, int, void *, int (*) (char *, void *),
+ size_t);
+#endif
+
+static int
+try_file (char *tmpl, void *flags)
+{
+ int *openflags = flags;
+ return __open (tmpl,
+ (*openflags & ~O_ACCMODE)
+ | O_RDWR | O_CREAT | O_EXCL, S_IRUSR | S_IWUSR);
+}
+
+static int
+try_dir (char *tmpl, void *flags _GL_UNUSED)
+{
+ return __mkdir (tmpl, S_IRUSR | S_IWUSR | S_IXUSR);
+}
+
+static int
+try_nocreate (char *tmpl, void *flags _GL_UNUSED)
+{
+ struct_stat64 st;
+
+ if (__lxstat64 (_STAT_VER, tmpl, &st) == 0 || errno == EOVERFLOW)
+ __set_errno (EEXIST);
+ return errno == ENOENT ? 0 : -1;
+}
+
/* These are the characters used in temporary file names. */
static const char letters[] =
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
+/* Generate a temporary file name based on TMPL. TMPL must match the
+ rules for mk[s]temp (i.e., end in at least X_SUFFIX_LEN "X"s,
+ possibly with a suffix).
+ The name constructed does not exist at the time of the call to
+ this function. TMPL is overwritten with the result.
+
+ KIND may be one of:
+ __GT_NOCREATE: simply verify that the name does not exist
+ at the time of the call.
+ __GT_FILE: create the file using open(O_CREAT|O_EXCL)
+ and return a read-write fd. The file is mode 0600.
+ __GT_DIR: create a directory, which will be mode 0700.
+
+ We use a clever algorithm to get hard-to-predict names. */
+#ifdef _LIBC
+static
+#endif
int
-__try_tempname (char *tmpl, int suffixlen, void *args,
- int (*tryfunc) (char *, void *))
+gen_tempname_len (char *tmpl, int suffixlen, int flags, int kind,
+ size_t x_suffix_len)
{
- int len;
+ static int (*const tryfunc[]) (char *, void *) =
+ {
+ [__GT_FILE] = try_file,
+ [__GT_DIR] = try_dir,
+ [__GT_NOCREATE] = try_nocreate
+ };
+ return try_tempname_len (tmpl, suffixlen, &flags, tryfunc[kind],
+ x_suffix_len);
+}
+
+#ifdef _LIBC
+static
+#endif
+int
+try_tempname_len (char *tmpl, int suffixlen, void *args,
+ int (*tryfunc) (char *, void *), size_t x_suffix_len)
+{
+ size_t len;
char *XXXXXX;
- static uint64_t value;
- uint64_t random_time_bits;
unsigned int count;
int fd = -1;
int save_errno = errno;
@@ -194,7 +238,8 @@ __try_tempname (char *tmpl, int suffixlen, void *args,
can exist for a given template is 62**6. It should never be
necessary to try all of these combinations. Instead if a reasonable
number of names is tried (we define reasonable as 62**3) fail to
- give the system administrator the chance to remove the problems. */
+ give the system administrator the chance to remove the problems.
+ This value requires that X_SUFFIX_LEN be at least 3. */
#define ATTEMPTS_MIN (62 * 62 * 62)
/* The number of times to attempt to generate a temporary file. To
@@ -205,44 +250,45 @@ __try_tempname (char *tmpl, int suffixlen, void *args,
unsigned int attempts = ATTEMPTS_MIN;
#endif
+ /* A random variable. */
+ random_value v;
+
+ /* How many random base-62 digits can currently be extracted from V. */
+ int vdigits = 0;
+
+ /* Least unfair value for V. If V is less than this, V can generate
+ BASE_62_DIGITS digits fairly. Otherwise it might be biased. */
+ random_value const unfair_min
+ = RANDOM_VALUE_MAX - RANDOM_VALUE_MAX % BASE_62_POWER;
+
len = strlen (tmpl);
- if (len < 6 + suffixlen || memcmp (&tmpl[len - 6 - suffixlen], "XXXXXX", 6))
+ if (len < x_suffix_len + suffixlen
+ || strspn (&tmpl[len - x_suffix_len - suffixlen], "X") < x_suffix_len)
{
__set_errno (EINVAL);
return -1;
}
/* This is where the Xs start. */
- XXXXXX = &tmpl[len - 6 - suffixlen];
-
- /* Get some more or less random data. */
-#ifdef RANDOM_BITS
- RANDOM_BITS (random_time_bits);
-#else
- {
- struct timeval tv;
- __gettimeofday (&tv, NULL);
- random_time_bits = ((uint64_t) tv.tv_usec << 16) ^ tv.tv_sec;
- }
-#endif
- value += random_time_bits ^ __getpid ();
+ XXXXXX = &tmpl[len - x_suffix_len - suffixlen];
- for (count = 0; count < attempts; value += 7777, ++count)
+ for (count = 0; count < attempts; ++count)
{
- uint64_t v = value;
-
- /* Fill in the random bits. */
- XXXXXX[0] = letters[v % 62];
- v /= 62;
- XXXXXX[1] = letters[v % 62];
- v /= 62;
- XXXXXX[2] = letters[v % 62];
- v /= 62;
- XXXXXX[3] = letters[v % 62];
- v /= 62;
- XXXXXX[4] = letters[v % 62];
- v /= 62;
- XXXXXX[5] = letters[v % 62];
+ for (size_t i = 0; i < x_suffix_len; i++)
+ {
+ if (vdigits == 0)
+ {
+ do
+ RANDOM_BITS (v);
+ while (unfair_min <= v);
+
+ vdigits = BASE_62_DIGITS;
+ }
+
+ XXXXXX[i] = letters[v % 62];
+ v /= 62;
+ vdigits--;
+ }
fd = tryfunc (tmpl, args);
if (fd >= 0)
@@ -259,66 +305,17 @@ __try_tempname (char *tmpl, int suffixlen, void *args,
return -1;
}
-static int
-try_file (char *tmpl, void *flags)
-{
- int *openflags = flags;
- return __open (tmpl,
- (*openflags & ~O_ACCMODE)
- | O_RDWR | O_CREAT | O_EXCL, S_IRUSR | S_IWUSR);
-}
-
-static int
-try_dir (char *tmpl, void *flags _GL_UNUSED)
-{
- return __mkdir (tmpl, S_IRUSR | S_IWUSR | S_IXUSR);
-}
-
-static int
-try_nocreate (char *tmpl, void *flags _GL_UNUSED)
+int
+__gen_tempname (char *tmpl, int suffixlen, int flags, int kind)
{
- struct_stat64 st;
-
- if (__lxstat64 (_STAT_VER, tmpl, &st) == 0 || errno == EOVERFLOW)
- __set_errno (EEXIST);
- return errno == ENOENT ? 0 : -1;
+ return gen_tempname_len (tmpl, suffixlen, flags, kind, 6);
}
-/* Generate a temporary file name based on TMPL. TMPL must match the
- rules for mk[s]temp (i.e. end in "XXXXXX", possibly with a suffix).
- The name constructed does not exist at the time of the call to
- __gen_tempname. TMPL is overwritten with the result.
-
- KIND may be one of:
- __GT_NOCREATE: simply verify that the name does not exist
- at the time of the call.
- __GT_FILE: create the file using open(O_CREAT|O_EXCL)
- and return a read-write fd. The file is mode 0600.
- __GT_DIR: create a directory, which will be mode 0700.
-
- We use a clever algorithm to get hard-to-predict names. */
+#if !_LIBC
int
-__gen_tempname (char *tmpl, int suffixlen, int flags, int kind)
+try_tempname (char *tmpl, int suffixlen, void *args,
+ int (*tryfunc) (char *, void *))
{
- int (*tryfunc) (char *, void *);
-
- switch (kind)
- {
- case __GT_FILE:
- tryfunc = try_file;
- break;
-
- case __GT_DIR:
- tryfunc = try_dir;
- break;
-
- case __GT_NOCREATE:
- tryfunc = try_nocreate;
- break;
-
- default:
- assert (! "invalid KIND in __gen_tempname");
- abort ();
- }
- return __try_tempname (tmpl, suffixlen, &flags, tryfunc);
+ return try_tempname_len (tmpl, suffixlen, args, tryfunc, 6);
}
+#endif
diff --git a/lib/tempname.h b/lib/tempname.h
index abb92650827..00dcbe4c93b 100644
--- a/lib/tempname.h
+++ b/lib/tempname.h
@@ -50,6 +50,9 @@ extern "C" {
We use a clever algorithm to get hard-to-predict names. */
extern int gen_tempname (char *tmpl, int suffixlen, int flags, int kind);
+/* Similar, except X_SUFFIX_LEN gives the number of Xs. */
+extern int gen_tempname_len (char *tmpl, int suffixlen, int flags, int kind,
+ size_t x_suffix_len);
/* Similar to gen_tempname, but TRYFUNC is called for each temporary
name to try. If TRYFUNC returns a non-negative number, TRY_GEN_TEMPNAME
@@ -57,6 +60,10 @@ extern int gen_tempname (char *tmpl, int suffixlen, int flags, int kind);
name is tried, or else TRY_GEN_TEMPNAME returns -1. */
extern int try_tempname (char *tmpl, int suffixlen, void *args,
int (*tryfunc) (char *, void *));
+/* Similar, except X_SUFFIX_LEN gives the number of Xs. */
+extern int try_tempname_len (char *tmpl, int suffixlen, void *args,
+ int (*tryfunc) (char *, void *),
+ size_t x_suffix_len);
#ifdef __cplusplus
}
diff --git a/lib/time.in.h b/lib/time.in.h
index 3f942b704dc..32e6ec03ef4 100644
--- a/lib/time.in.h
+++ b/lib/time.in.h
@@ -135,13 +135,19 @@ _GL_CXXALIASWARN (nanosleep);
# endif
_GL_FUNCDECL_RPL (tzset, void, (void));
_GL_CXXALIAS_RPL (tzset, void, (void));
-# else
-# if ! @HAVE_TZSET@
-_GL_FUNCDECL_SYS (tzset, void, (void));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef tzset
+# define tzset _tzset
# endif
+_GL_CXXALIAS_MDA (tzset, void, (void));
+# else
_GL_CXXALIAS_SYS (tzset, void, (void));
# endif
_GL_CXXALIASWARN (tzset);
+# elif defined _WIN32 && !defined __CYGWIN__
+# undef tzset
+# define tzset _tzset
# endif
/* Return the 'time_t' representation of TP and normalize TP. */
@@ -286,14 +292,17 @@ _GL_CXXALIASWARN (ctime);
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# define strftime rpl_strftime
# endif
-_GL_FUNCDECL_RPL (strftime, size_t, (char *__buf, size_t __bufsize,
- const char *__fmt, const struct tm *__tp)
- _GL_ARG_NONNULL ((1, 3, 4)));
-_GL_CXXALIAS_RPL (strftime, size_t, (char *__buf, size_t __bufsize,
- const char *__fmt, const struct tm *__tp));
+_GL_FUNCDECL_RPL (strftime, size_t,
+ (char *restrict __buf, size_t __bufsize,
+ const char *restrict __fmt, const struct tm *restrict __tp)
+ _GL_ARG_NONNULL ((1, 3, 4)));
+_GL_CXXALIAS_RPL (strftime, size_t,
+ (char *restrict __buf, size_t __bufsize,
+ const char *restrict __fmt, const struct tm *restrict __tp));
# else
-_GL_CXXALIAS_SYS (strftime, size_t, (char *__buf, size_t __bufsize,
- const char *__fmt, const struct tm *__tp));
+_GL_CXXALIAS_SYS (strftime, size_t,
+ (char *restrict __buf, size_t __bufsize,
+ const char *restrict __fmt, const struct tm *restrict __tp));
# endif
# if __GLIBC__ >= 2
_GL_CXXALIASWARN (strftime);
diff --git a/lib/time_r.c b/lib/time_r.c
index 25068ad7276..e8fca2d5c44 100644
--- a/lib/time_r.c
+++ b/lib/time_r.c
@@ -1,7 +1,6 @@
/* Reentrant time functions like localtime_r.
- Copyright (C) 2003, 2006-2007, 2010-2020 Free Software Foundation,
- Inc.
+ Copyright (C) 2003, 2006-2007, 2010-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
diff --git a/lib/time_rz.c b/lib/time_rz.c
index 5d85963c9ed..95438cf876e 100644
--- a/lib/time_rz.c
+++ b/lib/time_rz.c
@@ -54,31 +54,6 @@ enum { ABBR_SIZE_MIN = DEFAULT_MXFAST - offsetof (struct tm_zone, abbrs) };
matters; the pointer is never dereferenced. */
static timezone_t const local_tz = (timezone_t) 1;
-#if HAVE_TM_ZONE || HAVE_TZNAME
-
-/* Return true if the values A and B differ according to the rules for
- tm_isdst: A and B differ if one is zero and the other positive. */
-static bool
-isdst_differ (int a, int b)
-{
- return !a != !b && 0 <= a && 0 <= b;
-}
-
-/* Return true if A and B are equal. */
-static int
-equal_tm (const struct tm *a, const struct tm *b)
-{
- return ! ((a->tm_sec ^ b->tm_sec)
- | (a->tm_min ^ b->tm_min)
- | (a->tm_hour ^ b->tm_hour)
- | (a->tm_mday ^ b->tm_mday)
- | (a->tm_mon ^ b->tm_mon)
- | (a->tm_year ^ b->tm_year)
- | isdst_differ (a->tm_isdst, b->tm_isdst));
-}
-
-#endif
-
/* Copy to ABBRS the abbreviation at ABBR with size ABBR_SIZE (this
includes its trailing null byte). Append an extra null byte to
mark the end of ABBRS. */
@@ -327,17 +302,25 @@ mktime_z (timezone_t tz, struct tm *tm)
timezone_t old_tz = set_tz (tz);
if (old_tz)
{
- time_t t = mktime (tm);
-#if HAVE_TM_ZONE || HAVE_TZNAME
- time_t badtime = -1;
struct tm tm_1;
- if ((t != badtime
- || (localtime_r (&t, &tm_1) && equal_tm (tm, &tm_1)))
- && !save_abbr (tz, tm))
- t = badtime;
+ tm_1.tm_sec = tm->tm_sec;
+ tm_1.tm_min = tm->tm_min;
+ tm_1.tm_hour = tm->tm_hour;
+ tm_1.tm_mday = tm->tm_mday;
+ tm_1.tm_mon = tm->tm_mon;
+ tm_1.tm_year = tm->tm_year;
+ tm_1.tm_yday = -1;
+ tm_1.tm_isdst = tm->tm_isdst;
+ time_t t = mktime (&tm_1);
+ bool ok = 0 <= tm_1.tm_yday;
+#if HAVE_TM_ZONE || HAVE_TZNAME
+ ok = ok && save_abbr (tz, &tm_1);
#endif
- if (revert_tz (old_tz))
- return t;
+ if (revert_tz (old_tz) && ok)
+ {
+ *tm = tm_1;
+ return t;
+ }
}
return -1;
}
diff --git a/lib/timespec.h b/lib/timespec.h
index 02684ce6eac..dc999f944b2 100644
--- a/lib/timespec.h
+++ b/lib/timespec.h
@@ -34,7 +34,6 @@ extern "C" {
#endif
#include "arg-nonnull.h"
-#include "verify.h"
/* Inverse resolution of timespec timestamps (in units per second),
and log base 10 of the inverse resolution. */
@@ -59,46 +58,12 @@ make_timespec (time_t s, long int ns)
return r;
}
-/* Return negative, zero, positive if A < B, A == B, A > B, respectively.
-
- For each timestamp T, this code assumes that either:
-
- * T.tv_nsec is in the range 0..999999999; or
- * T.tv_sec corresponds to a valid leap second on a host that supports
- leap seconds, and T.tv_nsec is in the range 1000000000..1999999999; or
- * T.tv_sec is the minimum time_t value and T.tv_nsec is -1; or
- T.tv_sec is the maximum time_t value and T.tv_nsec is 2000000000.
- This allows for special struct timespec values that are less or
- greater than all possible valid timestamps.
-
- In all these cases, it is safe to subtract two tv_nsec values and
- convert the result to integer without worrying about overflow on
- any platform of interest to the GNU project, since all such
- platforms have 32-bit int or wider.
-
- Replacing "a.tv_nsec - b.tv_nsec" with something like
- "a.tv_nsec < b.tv_nsec ? -1 : a.tv_nsec > b.tv_nsec" would cause
- this function to work in some cases where the above assumption is
- violated, but not in all cases (e.g., a.tv_sec==1, a.tv_nsec==-2,
- b.tv_sec==0, b.tv_nsec==999999999) and is arguably not worth the
- extra instructions. Using a subtraction has the advantage of
- detecting some invalid cases on platforms that detect integer
- overflow. */
+/* Return negative, zero, positive if A < B, A == B, A > B, respectively. */
_GL_TIMESPEC_INLINE int _GL_ATTRIBUTE_PURE
timespec_cmp (struct timespec a, struct timespec b)
{
- if (a.tv_sec < b.tv_sec)
- return -1;
- if (a.tv_sec > b.tv_sec)
- return 1;
-
- /* Pacify gcc -Wstrict-overflow (bleeding-edge circa 2017-10-02). See:
- https://lists.gnu.org/r/bug-gnulib/2017-10/msg00006.html */
- assume (-1 <= a.tv_nsec && a.tv_nsec <= 2 * TIMESPEC_HZ);
- assume (-1 <= b.tv_nsec && b.tv_nsec <= 2 * TIMESPEC_HZ);
-
- return a.tv_nsec - b.tv_nsec;
+ return 2 * _GL_CMP (a.tv_sec, b.tv_sec) + _GL_CMP (a.tv_nsec, b.tv_nsec);
}
/* Return -1, 0, 1, depending on the sign of A. A.tv_nsec must be
@@ -106,7 +71,7 @@ timespec_cmp (struct timespec a, struct timespec b)
_GL_TIMESPEC_INLINE int _GL_ATTRIBUTE_PURE
timespec_sign (struct timespec a)
{
- return a.tv_sec < 0 ? -1 : a.tv_sec || a.tv_nsec;
+ return _GL_CMP (a.tv_sec, 0) + (!a.tv_sec & !!a.tv_nsec);
}
struct timespec timespec_add (struct timespec, struct timespec)
diff --git a/lib/unistd.in.h b/lib/unistd.in.h
index ddb7c5771ba..357a35e3881 100644
--- a/lib/unistd.in.h
+++ b/lib/unistd.in.h
@@ -21,7 +21,7 @@
#endif
@PRAGMA_COLUMNS@
-#ifdef _GL_INCLUDING_UNISTD_H
+#if @HAVE_UNISTD_H@ && defined _GL_INCLUDING_UNISTD_H
/* Special invocation convention:
- On Mac OS X 10.3.9 we have a sequence of nested includes
<unistd.h> -> <signal.h> -> <pthread.h> -> <unistd.h>
@@ -118,6 +118,17 @@
# include <netdb.h>
#endif
+/* Mac OS X 10.13, Solaris 11.4, and Android 9.0 declare getentropy in
+ <sys/random.h>, not in <unistd.h>. */
+/* But avoid namespace pollution on glibc systems. */
+#if (@GNULIB_GETENTROPY@ || defined GNULIB_POSIXCHECK) \
+ && ((defined __APPLE__ && defined __MACH__) || defined __sun \
+ || defined __ANDROID__) \
+ && @UNISTD_H_HAVE_SYS_RANDOM_H@ \
+ && !defined __GLIBC__
+# include <sys/random.h>
+#endif
+
/* Android 4.3 declares fchownat in <sys/stat.h>, not in <unistd.h>. */
/* But avoid namespace pollution on glibc systems. */
#if (@GNULIB_FCHOWNAT@ || defined GNULIB_POSIXCHECK) && defined __ANDROID__ \
@@ -141,7 +152,7 @@
/* Get getopt(), optarg, optind, opterr, optopt. */
-#if @GNULIB_UNISTD_H_GETOPT@ && !defined _GL_SYSTEM_GETOPT
+#if @GNULIB_GETOPT_POSIX@ && @GNULIB_UNISTD_H_GETOPT@ && !defined _GL_SYSTEM_GETOPT
# include <getopt-cdefs.h>
# include <getopt-pfx-core.h>
#endif
@@ -262,6 +273,12 @@ _GL_INLINE_HEADER_BEGIN
_GL_FUNCDECL_RPL (access, int, (const char *file, int mode)
_GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_RPL (access, int, (const char *file, int mode));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef access
+# define access _access
+# endif
+_GL_CXXALIAS_MDA (access, int, (const char *file, int mode));
# else
_GL_CXXALIAS_SYS (access, int, (const char *file, int mode));
# endif
@@ -275,11 +292,22 @@ _GL_WARN_ON_USE (access, "access does not always support X_OK - "
"also, this function is a security risk - "
"use the gnulib module faccessat instead");
# endif
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef access
+# define access _access
#endif
#if @GNULIB_CHDIR@
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef chdir
+# define chdir _chdir
+# endif
+_GL_CXXALIAS_MDA (chdir, int, (const char *file));
+# else
_GL_CXXALIAS_SYS (chdir, int, (const char *file) _GL_ARG_NONNULL ((1)));
+# endif
_GL_CXXALIASWARN (chdir);
#elif defined GNULIB_POSIXCHECK
# undef chdir
@@ -287,6 +315,9 @@ _GL_CXXALIASWARN (chdir);
_GL_WARN_ON_USE (chown, "chdir is not always in <unistd.h> - "
"use gnulib module chdir for portability");
# endif
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef chdir
+# define chdir _chdir
#endif
@@ -331,6 +362,12 @@ _GL_WARN_ON_USE (chown, "chown fails to follow symlinks on some systems and "
# endif
_GL_FUNCDECL_RPL (close, int, (int fd));
_GL_CXXALIAS_RPL (close, int, (int fd));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef close
+# define close _close
+# endif
+_GL_CXXALIAS_MDA (close, int, (int fd));
# else
_GL_CXXALIAS_SYS (close, int, (int fd));
# endif
@@ -343,6 +380,9 @@ _GL_CXXALIASWARN (close);
/* Assume close is always declared. */
_GL_WARN_ON_USE (close, "close does not portably work on sockets - "
"use gnulib module close for portability");
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef close
+# define close _close
#endif
@@ -371,6 +411,12 @@ _GL_WARN_ON_USE (copy_file_range,
# endif
_GL_FUNCDECL_RPL (dup, int, (int oldfd));
_GL_CXXALIAS_RPL (dup, int, (int oldfd));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef dup
+# define dup _dup
+# endif
+_GL_CXXALIAS_MDA (dup, int, (int oldfd));
# else
_GL_CXXALIAS_SYS (dup, int, (int oldfd));
# endif
@@ -381,6 +427,9 @@ _GL_CXXALIASWARN (dup);
_GL_WARN_ON_USE (dup, "dup is unportable - "
"use gnulib module dup for portability");
# endif
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef dup
+# define dup _dup
#endif
@@ -396,10 +445,13 @@ _GL_WARN_ON_USE (dup, "dup is unportable - "
# endif
_GL_FUNCDECL_RPL (dup2, int, (int oldfd, int newfd));
_GL_CXXALIAS_RPL (dup2, int, (int oldfd, int newfd));
-# else
-# if !@HAVE_DUP2@
-_GL_FUNCDECL_SYS (dup2, int, (int oldfd, int newfd));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef dup2
+# define dup2 _dup2
# endif
+_GL_CXXALIAS_MDA (dup2, int, (int oldfd, int newfd));
+# else
_GL_CXXALIAS_SYS (dup2, int, (int oldfd, int newfd));
# endif
_GL_CXXALIASWARN (dup2);
@@ -409,6 +461,9 @@ _GL_CXXALIASWARN (dup2);
_GL_WARN_ON_USE (dup2, "dup2 is unportable - "
"use gnulib module dup2 for portability");
# endif
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef dup2
+# define dup2 _dup2
#endif
@@ -509,6 +564,43 @@ _GL_WARN_ON_USE (euidaccess, "euidaccess is unportable - "
#endif
+#if defined _WIN32 && !defined __CYGWIN__
+# undef execl
+# define execl _execl
+#endif
+
+#if defined _WIN32 && !defined __CYGWIN__
+# undef execle
+# define execle _execle
+#endif
+
+#if defined _WIN32 && !defined __CYGWIN__
+# undef execlp
+# define execlp _execlp
+#endif
+
+
+#if defined _WIN32 && !defined __CYGWIN__
+# undef execv
+# define execv _execv
+#endif
+
+#if defined _WIN32 && !defined __CYGWIN__
+# undef execve
+# define execve _execve
+#endif
+
+#if defined _WIN32 && !defined __CYGWIN__
+# undef execvp
+# define execvp _execvp
+#endif
+
+#if defined _WIN32 && !defined __CYGWIN__
+# undef execvpe
+# define execvpe _execvpe
+#endif
+
+
#if @GNULIB_FACCESSAT@
# if @REPLACE_FACCESSAT@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
@@ -684,6 +776,12 @@ _GL_WARN_ON_USE (ftruncate, "ftruncate is unportable - "
# endif
_GL_FUNCDECL_RPL (getcwd, char *, (char *buf, size_t size));
_GL_CXXALIAS_RPL (getcwd, char *, (char *buf, size_t size));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef getcwd
+# define getcwd _getcwd
+# endif
+_GL_CXXALIAS_MDA (getcwd, char *, (char *buf, size_t size));
# else
/* Need to cast, because on mingw, the second parameter is
int size. */
@@ -696,6 +794,9 @@ _GL_CXXALIASWARN (getcwd);
_GL_WARN_ON_USE (getcwd, "getcwd is unportable - "
"use gnulib module getcwd for portability");
# endif
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef getcwd
+# define getcwd _getcwd
#endif
@@ -763,6 +864,22 @@ _GL_WARN_ON_USE (getdtablesize, "getdtablesize is unportable - "
#endif
+#if @GNULIB_GETENTROPY@
+/* Fill a buffer with random bytes. */
+# if !@HAVE_GETENTROPY@
+_GL_FUNCDECL_SYS (getentropy, int, (void *buffer, size_t length));
+# endif
+_GL_CXXALIAS_SYS (getentropy, int, (void *buffer, size_t length));
+_GL_CXXALIASWARN (getentropy);
+#elif defined GNULIB_POSIXCHECK
+# undef getentropy
+# if HAVE_RAW_DECL_GETENTROPY
+_GL_WARN_ON_USE (getentropy, "getentropy is unportable - "
+ "use gnulib module getentropy for portability");
+# endif
+#endif
+
+
#if @GNULIB_GETGROUPS@
/* Return the supplemental groups that the current process belongs to.
It is unspecified whether the effective group id is in the list.
@@ -905,6 +1022,11 @@ _GL_WARN_ON_USE (getlogin_r, "getlogin_r is unportable - "
_GL_FUNCDECL_RPL (getpagesize, int, (void));
_GL_CXXALIAS_RPL (getpagesize, int, (void));
# else
+/* On HP-UX, getpagesize exists, but it is not declared in <unistd.h> even if
+ the compiler options -D_HPUX_SOURCE -D_XOPEN_SOURCE=600 are used. */
+# if defined __hpux
+_GL_FUNCDECL_SYS (getpagesize, int, (void));
+# endif
# if !@HAVE_GETPAGESIZE@
# if !defined getpagesize
/* This is for POSIX systems. */
@@ -1009,6 +1131,12 @@ _GL_WARN_ON_USE (getpass, "getpass is unportable - "
#endif
+#if defined _WIN32 && !defined __CYGWIN__
+# undef getpid
+# define getpid _getpid
+#endif
+
+
#if @GNULIB_GETUSERSHELL@
/* Return the next valid login shell on the system, or NULL when the end of
the list has been reached. */
@@ -1081,6 +1209,12 @@ _GL_WARN_ON_USE (group_member, "group_member is unportable - "
# endif
_GL_FUNCDECL_RPL (isatty, int, (int fd));
_GL_CXXALIAS_RPL (isatty, int, (int fd));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef isatty
+# define isatty _isatty
+# endif
+_GL_CXXALIAS_MDA (isatty, int, (int fd));
# else
_GL_CXXALIAS_SYS (isatty, int, (int fd));
# endif
@@ -1091,6 +1225,9 @@ _GL_CXXALIASWARN (isatty);
_GL_WARN_ON_USE (isatty, "isatty has portability problems on native Windows - "
"use gnulib module isatty for portability");
# endif
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef isatty
+# define isatty _isatty
#endif
@@ -1202,6 +1339,12 @@ _GL_WARN_ON_USE (linkat, "linkat is unportable - "
# endif
_GL_FUNCDECL_RPL (lseek, off_t, (int fd, off_t offset, int whence));
_GL_CXXALIAS_RPL (lseek, off_t, (int fd, off_t offset, int whence));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef lseek
+# define lseek _lseek
+# endif
+_GL_CXXALIAS_MDA (lseek, off_t, (int fd, off_t offset, int whence));
# else
_GL_CXXALIAS_SYS (lseek, off_t, (int fd, off_t offset, int whence));
# endif
@@ -1212,6 +1355,9 @@ _GL_CXXALIASWARN (lseek);
_GL_WARN_ON_USE (lseek, "lseek does not fail with ESPIPE on pipes on some "
"systems - use gnulib module lseek for portability");
# endif
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef lseek
+# define lseek _lseek
#endif
@@ -1344,6 +1490,12 @@ _GL_WARN_ON_USE (pwrite, "pwrite is unportable - "
_GL_FUNCDECL_RPL (read, ssize_t, (int fd, void *buf, size_t count)
_GL_ARG_NONNULL ((2)));
_GL_CXXALIAS_RPL (read, ssize_t, (int fd, void *buf, size_t count));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef read
+# define read _read
+# endif
+_GL_CXXALIAS_MDA (read, ssize_t, (int fd, void *buf, size_t count));
# else
/* Need to cast, because on mingw, the third parameter is
unsigned int count
@@ -1351,6 +1503,9 @@ _GL_CXXALIAS_RPL (read, ssize_t, (int fd, void *buf, size_t count));
_GL_CXXALIAS_SYS_CAST (read, ssize_t, (int fd, void *buf, size_t count));
# endif
_GL_CXXALIASWARN (read);
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef read
+# define read _read
#endif
@@ -1365,18 +1520,22 @@ _GL_CXXALIASWARN (read);
# define readlink rpl_readlink
# endif
_GL_FUNCDECL_RPL (readlink, ssize_t,
- (const char *file, char *buf, size_t bufsize)
+ (const char *restrict file,
+ char *restrict buf, size_t bufsize)
_GL_ARG_NONNULL ((1, 2)));
_GL_CXXALIAS_RPL (readlink, ssize_t,
- (const char *file, char *buf, size_t bufsize));
+ (const char *restrict file,
+ char *restrict buf, size_t bufsize));
# else
# if !@HAVE_READLINK@
_GL_FUNCDECL_SYS (readlink, ssize_t,
- (const char *file, char *buf, size_t bufsize)
+ (const char *restrict file,
+ char *restrict buf, size_t bufsize)
_GL_ARG_NONNULL ((1, 2)));
# endif
_GL_CXXALIAS_SYS (readlink, ssize_t,
- (const char *file, char *buf, size_t bufsize));
+ (const char *restrict file,
+ char *restrict buf, size_t bufsize));
# endif
_GL_CXXALIASWARN (readlink);
#elif defined GNULIB_POSIXCHECK
@@ -1394,18 +1553,22 @@ _GL_WARN_ON_USE (readlink, "readlink is unportable - "
# define readlinkat rpl_readlinkat
# endif
_GL_FUNCDECL_RPL (readlinkat, ssize_t,
- (int fd, char const *file, char *buf, size_t len)
+ (int fd, char const *restrict file,
+ char *restrict buf, size_t len)
_GL_ARG_NONNULL ((2, 3)));
_GL_CXXALIAS_RPL (readlinkat, ssize_t,
- (int fd, char const *file, char *buf, size_t len));
+ (int fd, char const *restrict file,
+ char *restrict buf, size_t len));
# else
# if !@HAVE_READLINKAT@
_GL_FUNCDECL_SYS (readlinkat, ssize_t,
- (int fd, char const *file, char *buf, size_t len)
+ (int fd, char const *restrict file,
+ char *restrict buf, size_t len)
_GL_ARG_NONNULL ((2, 3)));
# endif
_GL_CXXALIAS_SYS (readlinkat, ssize_t,
- (int fd, char const *file, char *buf, size_t len));
+ (int fd, char const *restrict file,
+ char *restrict buf, size_t len));
# endif
_GL_CXXALIASWARN (readlinkat);
#elif defined GNULIB_POSIXCHECK
@@ -1425,6 +1588,12 @@ _GL_WARN_ON_USE (readlinkat, "readlinkat is not portable - "
# endif
_GL_FUNCDECL_RPL (rmdir, int, (char const *name) _GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_RPL (rmdir, int, (char const *name));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef rmdir
+# define rmdir _rmdir
+# endif
+_GL_CXXALIAS_MDA (rmdir, int, (char const *name));
# else
_GL_CXXALIAS_SYS (rmdir, int, (char const *name));
# endif
@@ -1435,6 +1604,9 @@ _GL_CXXALIASWARN (rmdir);
_GL_WARN_ON_USE (rmdir, "rmdir is unportable - "
"use gnulib module rmdir for portability");
# endif
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef rmdir
+# define rmdir _rmdir
#endif
@@ -1493,6 +1665,12 @@ _GL_WARN_ON_USE (sleep, "sleep is unportable - "
#endif
+#if defined _WIN32 && !defined __CYGWIN__
+# undef swab
+# define swab _swab
+#endif
+
+
#if @GNULIB_SYMLINK@
# if @REPLACE_SYMLINK@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
@@ -1617,6 +1795,12 @@ _GL_WARN_ON_USE (ttyname_r, "ttyname_r is not portable - "
# endif
_GL_FUNCDECL_RPL (unlink, int, (char const *file) _GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_RPL (unlink, int, (char const *file));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef unlink
+# define unlink _unlink
+# endif
+_GL_CXXALIAS_MDA (unlink, int, (char const *file));
# else
_GL_CXXALIAS_SYS (unlink, int, (char const *file));
# endif
@@ -1627,6 +1811,9 @@ _GL_CXXALIASWARN (unlink);
_GL_WARN_ON_USE (unlink, "unlink is not portable - "
"use gnulib module unlink for portability");
# endif
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef unlink
+# define unlink _unlink
#endif
@@ -1672,7 +1859,9 @@ _GL_CXXALIAS_RPL (usleep, int, (useconds_t n));
# if !@HAVE_USLEEP@
_GL_FUNCDECL_SYS (usleep, int, (useconds_t n));
# endif
-_GL_CXXALIAS_SYS (usleep, int, (useconds_t n));
+/* Need to cast, because on Haiku, the first parameter is
+ unsigned int n. */
+_GL_CXXALIAS_SYS_CAST (usleep, int, (useconds_t n));
# endif
_GL_CXXALIASWARN (usleep);
#elif defined GNULIB_POSIXCHECK
@@ -1696,6 +1885,12 @@ _GL_WARN_ON_USE (usleep, "usleep is unportable - "
_GL_FUNCDECL_RPL (write, ssize_t, (int fd, const void *buf, size_t count)
_GL_ARG_NONNULL ((2)));
_GL_CXXALIAS_RPL (write, ssize_t, (int fd, const void *buf, size_t count));
+# elif defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef write
+# define write _write
+# endif
+_GL_CXXALIAS_MDA (write, ssize_t, (int fd, const void *buf, size_t count));
# else
/* Need to cast, because on mingw, the third parameter is
unsigned int count
@@ -1703,6 +1898,9 @@ _GL_CXXALIAS_RPL (write, ssize_t, (int fd, const void *buf, size_t count));
_GL_CXXALIAS_SYS_CAST (write, ssize_t, (int fd, const void *buf, size_t count));
# endif
_GL_CXXALIASWARN (write);
+#elif defined _WIN32 && !defined __CYGWIN__
+# undef write
+# define write _write
#endif
_GL_INLINE_HEADER_END
diff --git a/lib/utimensat.c b/lib/utimensat.c
new file mode 100644
index 00000000000..63788d56480
--- /dev/null
+++ b/lib/utimensat.c
@@ -0,0 +1,160 @@
+/* Set the access and modification time of a file relative to directory fd.
+ Copyright (C) 2009-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 Eric Blake */
+
+#include <config.h>
+
+/* Specification. */
+#include <sys/stat.h>
+
+#include <errno.h>
+#include <fcntl.h>
+#include <stdlib.h>
+
+#include "stat-time.h"
+#include "timespec.h"
+#include "utimens.h"
+
+#if HAVE_UTIMENSAT
+
+# undef utimensat
+
+/* If we have a native utimensat, but are compiling this file, then
+ utimensat was defined to rpl_utimensat by our replacement
+ sys/stat.h. We assume the native version might fail with ENOSYS,
+ or succeed without properly affecting ctime (as is the case when
+ using newer glibc but older Linux kernel). In this scenario,
+ rpl_utimensat checks whether the native version is usable, and
+ local_utimensat provides the fallback manipulation. */
+
+static int local_utimensat (int, char const *, struct timespec const[2], int);
+# define AT_FUNC_NAME local_utimensat
+
+/* Like utimensat, but work around native bugs. */
+
+int
+rpl_utimensat (int fd, char const *file, struct timespec const times[2],
+ int flag)
+{
+# if defined __linux__ || defined __sun
+ struct timespec ts[2];
+# endif
+
+ /* See comments in utimens.c for details. */
+ static int utimensat_works_really; /* 0 = unknown, 1 = yes, -1 = no. */
+ if (0 <= utimensat_works_really)
+ {
+ int result;
+# if defined __linux__ || defined __sun
+ struct stat st;
+ /* As recently as Linux kernel 2.6.32 (Dec 2009), several file
+ systems (xfs, ntfs-3g) have bugs with a single UTIME_OMIT,
+ but work if both times are either explicitly specified or
+ UTIME_NOW. Work around it with a preparatory [l]stat prior
+ to calling utimensat; fortunately, there is not much timing
+ impact due to the extra syscall even on file systems where
+ UTIME_OMIT would have worked.
+
+ The same bug occurs in Solaris 11.1 (Apr 2013).
+
+ FIXME: Simplify this in 2024, when these file system bugs are
+ no longer common on Gnulib target platforms. */
+ if (times && (times[0].tv_nsec == UTIME_OMIT
+ || times[1].tv_nsec == UTIME_OMIT))
+ {
+ if (fstatat (fd, file, &st, flag))
+ return -1;
+ if (times[0].tv_nsec == UTIME_OMIT && times[1].tv_nsec == UTIME_OMIT)
+ return 0;
+ if (times[0].tv_nsec == UTIME_OMIT)
+ ts[0] = get_stat_atime (&st);
+ else
+ ts[0] = times[0];
+ if (times[1].tv_nsec == UTIME_OMIT)
+ ts[1] = get_stat_mtime (&st);
+ else
+ ts[1] = times[1];
+ times = ts;
+ }
+# ifdef __hppa__
+ /* Linux kernel 2.6.22.19 on hppa does not reject invalid tv_nsec
+ values. */
+ else if (times
+ && ((times[0].tv_nsec != UTIME_NOW
+ && ! (0 <= times[0].tv_nsec
+ && times[0].tv_nsec < TIMESPEC_HZ))
+ || (times[1].tv_nsec != UTIME_NOW
+ && ! (0 <= times[1].tv_nsec
+ && times[1].tv_nsec < TIMESPEC_HZ))))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+# endif
+# endif
+ result = utimensat (fd, file, times, flag);
+ /* Linux kernel 2.6.25 has a bug where it returns EINVAL for
+ UTIME_NOW or UTIME_OMIT with non-zero tv_sec, which
+ local_utimensat works around. Meanwhile, EINVAL for a bad
+ flag is indeterminate whether the native utimensat works, but
+ local_utimensat will also reject it. */
+ if (result == -1 && errno == EINVAL && (flag & ~AT_SYMLINK_NOFOLLOW))
+ return result;
+ if (result == 0 || (errno != ENOSYS && errno != EINVAL))
+ {
+ utimensat_works_really = 1;
+ return result;
+ }
+ }
+ /* No point in trying openat/futimens, since on Linux, futimens is
+ implemented with the same syscall as utimensat. Only avoid the
+ native utimensat due to an ENOSYS failure; an EINVAL error was
+ data-dependent, and the next caller may pass valid data. */
+ if (0 <= utimensat_works_really && errno == ENOSYS)
+ utimensat_works_really = -1;
+ return local_utimensat (fd, file, times, flag);
+}
+
+#else /* !HAVE_UTIMENSAT */
+
+# define AT_FUNC_NAME utimensat
+
+#endif /* !HAVE_UTIMENSAT */
+
+/* Set the access and modification timestamps of FILE to be
+ TIMESPEC[0] and TIMESPEC[1], respectively; relative to directory
+ FD. If flag is AT_SYMLINK_NOFOLLOW, change the times of a symlink,
+ or fail with ENOSYS if not possible. If TIMESPEC is null, set the
+ timestamps to the current time. If possible, do it without
+ changing the working directory. Otherwise, resort to using
+ save_cwd/fchdir, then utimens/restore_cwd. If either the save_cwd
+ or the restore_cwd fails, then give a diagnostic and exit nonzero.
+ Return 0 on success, -1 (setting errno) on failure. */
+
+/* AT_FUNC_NAME is now utimensat or local_utimensat. */
+#define AT_FUNC_F1 lutimens
+#define AT_FUNC_F2 utimens
+#define AT_FUNC_USE_F1_COND AT_SYMLINK_NOFOLLOW
+#define AT_FUNC_POST_FILE_PARAM_DECLS , struct timespec const ts[2], int flag
+#define AT_FUNC_POST_FILE_ARGS , ts
+#include "at-func.c"
+#undef AT_FUNC_NAME
+#undef AT_FUNC_F1
+#undef AT_FUNC_F2
+#undef AT_FUNC_USE_F1_COND
+#undef AT_FUNC_POST_FILE_PARAM_DECLS
+#undef AT_FUNC_POST_FILE_ARGS
diff --git a/lib/verify.h b/lib/verify.h
index d9ab89a570c..fa1ed717d0e 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -23,11 +23,15 @@
/* Define _GL_HAVE__STATIC_ASSERT to 1 if _Static_assert (R, DIAGNOSTIC)
works as per C11. This is supported by GCC 4.6.0 and later, in C
- mode.
+ mode, and by clang (also in C++ mode).
Define _GL_HAVE__STATIC_ASSERT1 to 1 if _Static_assert (R) works as
- per C2X, and define _GL_HAVE_STATIC_ASSERT1 if static_assert (R)
- works as per C++17. This is supported by GCC 9.1 and later.
+ per C2X. This is supported by GCC 9.1 and later, and by clang in
+ C++1z mode.
+
+ Define _GL_HAVE_STATIC_ASSERT1 if static_assert (R) works as per
+ C++17. This is supported by GCC 9.1 and later, and by clang in
+ C++1z mode.
Support compilers claiming conformance to the relevant standard,
and also support GCC when not pedantic. If we were willing to slow
@@ -35,7 +39,8 @@
since this affects only the quality of diagnostics, why bother? */
#ifndef __cplusplus
# if (201112L <= __STDC_VERSION__ \
- || (!defined __STRICT_ANSI__ && 4 < __GNUC__ + (6 <= __GNUC_MINOR__)))
+ || (!defined __STRICT_ANSI__ \
+ && (4 < __GNUC__ + (6 <= __GNUC_MINOR__) || 4 <= __clang_major__)))
# define _GL_HAVE__STATIC_ASSERT 1
# endif
# if (202000L <= __STDC_VERSION__ \
@@ -43,7 +48,15 @@
# define _GL_HAVE__STATIC_ASSERT1 1
# endif
#else
-# if 201703L <= __cplusplus || 9 <= __GNUC__
+# if 4 <= __clang_major__
+# define _GL_HAVE__STATIC_ASSERT 1
+# endif
+# if 4 <= __clang_major__ && 201411 <= __cpp_static_assert
+# define _GL_HAVE__STATIC_ASSERT1 1
+# endif
+# if 201703L <= __cplusplus \
+ || 9 <= __GNUC__ \
+ || (4 <= __clang_major__ && 201411 <= __cpp_static_assert)
# define _GL_HAVE_STATIC_ASSERT1 1
# endif
#endif
@@ -277,10 +290,27 @@ template <int w>
#endif
/* Assume that R always holds. Behavior is undefined if R is false,
- fails to evaluate, or has side effects. Although assuming R can
- help a compiler generate better code or diagnostics, performance
- can suffer if R uses hard-to-optimize features such as function
- calls not inlined by the compiler. */
+ fails to evaluate, or has side effects.
+
+ 'assume (R)' is a directive from the programmer telling the
+ compiler that R is true so the compiler needn't generate code to
+ test R. This is why 'assume' is in verify.h: it's related to
+ static checking (in this case, static checking done by the
+ programmer), not dynamic checking.
+
+ 'assume (R)' can affect compilation of all the code, not just code
+ that happens to be executed after the assume (R) is "executed".
+ For example, if the code mistakenly does 'assert (R); assume (R);'
+ the compiler is entitled to optimize away the 'assert (R)'.
+
+ Although assuming R can help a compiler generate better code or
+ diagnostics, performance can suffer if R uses hard-to-optimize
+ features such as function calls not inlined by the compiler.
+
+ Avoid Clang's __builtin_assume, as it breaks GNU Emacs master
+ as of 2020-08-23T21:09:49Z!eggert@cs.ucla.edu; see
+ <https://bugs.gnu.org/43152#71>. It's not known whether this breakage
+ is a Clang bug or an Emacs bug; play it safe for now. */
#if _GL_HAS_BUILTIN_UNREACHABLE
# define assume(R) ((R) ? (void) 0 : __builtin_unreachable ())
diff --git a/lib/warn-on-use.h b/lib/warn-on-use.h
index 1be2cbb9570..3f728d1a9dc 100644
--- a/lib/warn-on-use.h
+++ b/lib/warn-on-use.h
@@ -87,6 +87,13 @@
extern __typeof__ (function) function __attribute__ ((__warning__ (message)))
# define _GL_WARN_ON_USE_ATTRIBUTE(message) \
__attribute__ ((__warning__ (message)))
+# elif __clang_major__ >= 4
+/* Another compiler attribute is available in clang. */
+# define _GL_WARN_ON_USE(function, message) \
+extern __typeof__ (function) function \
+ __attribute__ ((__diagnose_if__ (1, message, "warning")))
+# define _GL_WARN_ON_USE_ATTRIBUTE(message) \
+ __attribute__ ((__diagnose_if__ (1, message, "warning")))
# elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING
/* Verify the existence of the function. */
# define _GL_WARN_ON_USE(function, message) \
@@ -99,24 +106,35 @@ _GL_WARN_EXTERN_C int _gl_warn_on_use
# endif
#endif
-/* _GL_WARN_ON_USE_CXX (function, rettype, parameters_and_attributes, "string")
- is like _GL_WARN_ON_USE (function, "string"), except that the function is
- declared with the given prototype, consisting of return type, parameters,
- and attributes.
+/* _GL_WARN_ON_USE_CXX (function, rettype_gcc, rettype_clang, parameters_and_attributes, "message")
+ is like _GL_WARN_ON_USE (function, "message"), except that in C++ mode the
+ function is declared with the given prototype, consisting of return type,
+ parameters, and attributes.
This variant is useful for overloaded functions in C++. _GL_WARN_ON_USE does
not work in this case. */
#ifndef _GL_WARN_ON_USE_CXX
-# if 4 < __GNUC__ || (__GNUC__ == 4 && 3 <= __GNUC_MINOR__)
-# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \
-extern rettype function parameters_and_attributes \
- __attribute__ ((__warning__ (msg)))
-# elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING
+# if !defined __cplusplus
+# define _GL_WARN_ON_USE_CXX(function,rettype_gcc,rettype_clang,parameters_and_attributes,msg) \
+ _GL_WARN_ON_USE (function, msg)
+# else
+# if 4 < __GNUC__ || (__GNUC__ == 4 && 3 <= __GNUC_MINOR__)
+/* A compiler attribute is available in gcc versions 4.3.0 and later. */
+# define _GL_WARN_ON_USE_CXX(function,rettype_gcc,rettype_clang,parameters_and_attributes,msg) \
+extern rettype_gcc function parameters_and_attributes \
+ __attribute__ ((__warning__ (msg)))
+# elif __clang_major__ >= 4
+/* Another compiler attribute is available in clang. */
+# define _GL_WARN_ON_USE_CXX(function,rettype_gcc,rettype_clang,parameters_and_attributes,msg) \
+extern rettype_clang function parameters_and_attributes \
+ __attribute__ ((__diagnose_if__ (1, msg, "warning")))
+# elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING
/* Verify the existence of the function. */
-# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \
-extern rettype function parameters_and_attributes
-# else /* Unsupported. */
-# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \
+# define _GL_WARN_ON_USE_CXX(function,rettype_gcc,rettype_clang,parameters_and_attributes,msg) \
+extern rettype_gcc function parameters_and_attributes
+# else /* Unsupported. */
+# define _GL_WARN_ON_USE_CXX(function,rettype_gcc,rettype_clang,parameters_and_attributes,msg) \
_GL_WARN_EXTERN_C int _gl_warn_on_use
+# endif
# endif
#endif
diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h
index 6e007b566db..13ee23031a0 100644
--- a/lib/xalloc-oversized.h
+++ b/lib/xalloc-oversized.h
@@ -1,7 +1,6 @@
/* xalloc-oversized.h -- memory allocation size checking
- Copyright (C) 1990-2000, 2003-2004, 2006-2020 Free Software
- Foundation, Inc.
+ Copyright (C) 1990-2000, 2003-2004, 2006-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
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 57527bb5afc..84c5733918a 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -196,7 +196,6 @@ $(lisp)/finder-inf.el:
autoloads .PHONY: $(lisp)/loaddefs.el
$(lisp)/loaddefs.el: gen-lisp $(LOADDEFS)
- @echo Directories for loaddefs: ${SUBDIRS_ALMOST}
$(AM_V_GEN)$(emacs) -l autoload \
--eval '(setq autoload-ensure-writable t)' \
--eval '(setq autoload-builtin-package-versions t)' \
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 190b3504fa7..dc52a220125 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -209,8 +209,7 @@ it defaults to the value of `abbrev-file-name'.
Optional second argument QUIETLY non-nil means don't display a message."
(interactive
(list
- (read-file-name (format "Read abbrev file (default %s): "
- abbrev-file-name)
+ (read-file-name (format-prompt "Read abbrev file" abbrev-file-name)
nil abbrev-file-name t)))
(load (or file abbrev-file-name) nil quietly)
(setq abbrevs-changed nil))
@@ -255,11 +254,7 @@ have been saved."
(if (abbrev--table-symbols table)
(insert-abbrev-table-description table nil)))
(when (unencodable-char-position (point-min) (point-max) 'utf-8)
- (setq coding-system-for-write
- (if (> emacs-major-version 24)
- 'utf-8-emacs
- ;; For compatibility with Emacs 22 (See Bug#8308)
- 'emacs-mule)))
+ (setq coding-system-for-write 'utf-8-emacs))
(goto-char (point-min))
(insert (format ";;-*-coding: %s;-*-\n" coding-system-for-write))
(write-region nil nil file nil (and (not verbose) 0)))))
@@ -521,14 +516,6 @@ It is nil if the abbrev has already been unexpanded.")
;; "Local (mode-specific) abbrev table of current buffer.")
;; (make-variable-buffer-local 'local-abbrev-table)
-(defcustom pre-abbrev-expand-hook nil
- "Function or functions to be called before abbrev expansion is done.
-This is the first thing that `expand-abbrev' does, and so this may change
-the current abbrev table before abbrev lookup happens."
- :type 'hook
- :group 'abbrev-mode)
-(make-obsolete-variable 'pre-abbrev-expand-hook 'abbrev-expand-function "23.1")
-
(defun clear-abbrev-table (table)
"Undefine all abbrevs in abbrev table TABLE, leaving it empty."
(setq abbrevs-changed t)
@@ -837,16 +824,155 @@ see `define-abbrev' for details."
"Function that `expand-abbrev' uses to perform abbrev expansion.
Takes no argument and should return the abbrev symbol if expansion took place.")
+(defcustom abbrev-suggest nil
+ "Non-nil means suggest using abbrevs to save typing.
+When abbrev mode is active and this option is non-nil, Emacs will
+suggest in the echo area to use an existing abbrev if doing so
+will save enough typing. See `abbrev-suggest-hint-threshold' for
+the definition of \"enough typing\"."
+ :type 'boolean
+ :version "28.1")
+
+(defcustom abbrev-suggest-hint-threshold 3
+ "Threshold for when to suggest to use an abbrev to save typing.
+The threshold is the amount of typing, in terms of the number of
+characters, that would be saved by using the abbrev. The
+thinking is that if the expansion is only a few characters
+longer than the abbrev, the benefit of informing the user is not
+significant. If you always want to be informed about existing
+abbrevs for the text you type, set this value to zero or less.
+This setting only applies if `abbrev-suggest' is non-nil."
+ :type 'number
+ :version "28.1")
+
+(defun abbrev--suggest-get-active-tables-including-parents ()
+ "Return a list of all active abbrev tables, including parent tables."
+ (let* ((tables (abbrev--active-tables))
+ (all tables))
+ (dolist (table tables)
+ (setq all (append (abbrev-table-get table :parents) all)))
+ all))
+
+(defun abbrev--suggest-get-active-abbrev-expansions ()
+ "Return a list of all the active abbrev expansions.
+Includes expansions from parent abbrev tables."
+ (let (expansions)
+ (dolist (table (abbrev--suggest-get-active-tables-including-parents))
+ (mapatoms (lambda (e)
+ (let ((value (symbol-value (abbrev--symbol e table))))
+ (when value
+ (push (cons value (symbol-name e)) expansions))))
+ table))
+ expansions))
+
+(defun abbrev--suggest-count-words (expansion)
+ "Return the number of words in EXPANSION.
+Expansion is a string of one or more words."
+ (length (split-string expansion " " t)))
+
+(defun abbrev--suggest-get-previous-words (n)
+ "Return the N words before point, spaces included."
+ (let ((end (point)))
+ (save-excursion
+ (backward-word n)
+ (replace-regexp-in-string
+ "\\s " " "
+ (buffer-substring-no-properties (point) end)))))
+
+(defun abbrev--suggest-above-threshold (expansion)
+ "Return non-nil if the abbrev in EXPANSION provides significant savings.
+A significant saving, here, is the difference in length between
+the abbrev and the abbrev expansion. EXPANSION is a cons cell
+where the car is the expansion and the cdr is the abbrev."
+ (>= (- (length (car expansion))
+ (length (cdr expansion)))
+ abbrev-suggest-hint-threshold))
+
+(defvar abbrev--suggest-saved-recommendations nil
+ "Keeps a list of expansions that have abbrevs defined.
+The user can show this list by calling
+`abbrev-suggest-show-report'.")
+
+(defun abbrev--suggest-inform-user (expansion)
+ "Display a message to the user about the existing abbrev.
+EXPANSION is a cons cell where the `car' is the expansion and the
+`cdr' is the abbrev."
+ (run-with-idle-timer
+ 1 nil
+ (lambda ()
+ (message "You can write `%s' using the abbrev `%s'."
+ (car expansion) (cdr expansion))))
+ (push expansion abbrev--suggest-saved-recommendations))
+
+(defun abbrev--suggest-shortest-abbrev (new current)
+ "Return the shortest abbrev of NEW and CURRENT.
+NEW and CURRENT are cons cells where the `car' is the expansion
+and the `cdr' is the abbrev."
+ (if (not current)
+ new
+ (if (< (length (cdr new))
+ (length (cdr current)))
+ new
+ current)))
+
+(defun abbrev--suggest-maybe-suggest ()
+ "Suggest an abbrev to the user based on the word(s) before point.
+Uses `abbrev-suggest-hint-threshold' to find out if the user should be
+informed about the existing abbrev."
+ (let (words abbrev-found word-count)
+ (dolist (expansion (abbrev--suggest-get-active-abbrev-expansions))
+ (setq word-count (abbrev--suggest-count-words (car expansion))
+ words (abbrev--suggest-get-previous-words word-count))
+ (let ((case-fold-search t))
+ (when (and (> word-count 0)
+ (string-match (car expansion) words)
+ (abbrev--suggest-above-threshold expansion))
+ (setq abbrev-found (abbrev--suggest-shortest-abbrev
+ expansion abbrev-found)))))
+ (when abbrev-found
+ (abbrev--suggest-inform-user abbrev-found))))
+
+(defun abbrev--suggest-get-totals ()
+ "Return a list of all expansions and how many times they were used.
+Each expansion is a cons cell where the `car' is the expansion
+and the `cdr' is the number of times the expansion has been
+typed."
+ (let (total cell)
+ (dolist (expansion abbrev--suggest-saved-recommendations)
+ (if (not (assoc (car expansion) total))
+ (push (cons (car expansion) 1) total)
+ (setq cell (assoc (car expansion) total))
+ (setcdr cell (1+ (cdr cell)))))
+ total))
+
+(defun abbrev-suggest-show-report ()
+ "Show a buffer with the list of abbrevs you could have used.
+This shows the abbrevs you've \"missed\" because you typed the
+full text instead of the abbrevs that expand into that text."
+ (interactive)
+ (let ((totals (abbrev--suggest-get-totals))
+ (buf (get-buffer-create "*abbrev-suggest*")))
+ (set-buffer buf)
+ (erase-buffer)
+ (insert "** Abbrev expansion usage **
+
+Below is a list of expansions for which abbrevs are defined, and
+the number of times the expansion was typed manually. To display
+and edit all abbrevs, type `M-x edit-abbrevs RET'\n\n")
+ (dolist (expansion totals)
+ (insert (format " %s: %d\n" (car expansion) (cdr expansion))))
+ (display-buffer buf)))
+
(defun expand-abbrev ()
"Expand the abbrev before point, if there is an abbrev there.
Effective when explicitly called even when `abbrev-mode' is nil.
-Before doing anything else, runs `pre-abbrev-expand-hook'.
Calls the value of `abbrev-expand-function' with no argument to do
the work, and returns whatever it does. (That return value should
be the abbrev symbol if expansion occurred, else nil.)"
(interactive)
- (run-hooks 'pre-abbrev-expand-hook)
- (funcall abbrev-expand-function))
+ (or (funcall abbrev-expand-function)
+ (if abbrev-suggest
+ (abbrev--suggest-maybe-suggest))))
(defun abbrev--default-expand ()
"Default function to use for `abbrev-expand-function'.
diff --git a/lisp/align.el b/lisp/align.el
index c1a2b691312..e3bdf77002e 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -129,6 +129,8 @@
"Hook that gets run after the aligner has been loaded."
:type 'hook
:group 'align)
+(make-obsolete-variable 'align-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom align-indent-before-aligning nil
"If non-nil, indent the marked region before aligning it."
@@ -387,7 +389,7 @@ The possible settings for `align-region-separate' are:
(regexp . "\\(^\\s-+[^( \t\n]\\|(\\(\\S-+\\)\\s-+\\)\\S-+\\(\\s-+\\)")
(group . 3)
(modes . align-lisp-modes)
- (run-if . ,(function (lambda () current-prefix-arg))))
+ (run-if . ,(lambda () current-prefix-arg)))
(lisp-alist-dot
(regexp . "\\(\\s-*\\)\\.\\(\\s-*\\)")
@@ -461,7 +463,7 @@ The possible settings for `align-region-separate' are:
(regexp . ",\\(\\s-*\\)[^/ \t\n]")
(repeat . t)
(modes . align-c++-modes)
- (run-if . ,(function (lambda () current-prefix-arg))))
+ (run-if . ,(lambda () current-prefix-arg)))
; (valid
; . ,(function
; (lambda ()
@@ -478,7 +480,7 @@ The possible settings for `align-region-separate' are:
(regexp . ",\\(\\s-*\\)[^# \t\n]")
(repeat . t)
(modes . (append align-perl-modes '(python-mode)))
- (run-if . ,(function (lambda () current-prefix-arg))))
+ (run-if . ,(lambda () current-prefix-arg)))
(c++-comment
(regexp . "\\(\\s-*\\)\\(//.*\\|/\\*.*\\*/\\s-*\\)$")
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index fbdddca7d76..ac49d3bf068 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -207,22 +207,8 @@ See `allout-widgets-mode' for allout widgets mode features."
:version "24.1"
:type 'plist
:group 'allout-widgets)
+(make-obsolete-variable 'allout-widgets-item-image-properties-xemacs nil "28.1")
;;;_ . Developer
-;;;_ = allout-widgets-run-unit-tests-on-load
-(defcustom allout-widgets-run-unit-tests-on-load nil
- "When non-nil, unit tests will be run at end of loading allout-widgets.
-
-Generally, allout widgets code developers are the only ones who'll want to
-set this.
-
-\(If set, this makes it an even better practice to exercise changes by
-doing byte-compilation with a repeat count, so the file is loaded after
-compilation.)
-
-See `allout-widgets-run-unit-tests' to see what's run."
- :version "24.1"
- :type 'boolean
- :group 'allout-widgets-developer)
;;;_ = allout-widgets-time-decoration-activity
(defcustom allout-widgets-time-decoration-activity nil
"Retain timing info of the last cooperative redecoration.
@@ -323,8 +309,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
- (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-widgets-mode-inhibit 'safe-local-variable 'booleanp)
(make-variable-buffer-local 'allout-widgets-mode-inhibit)
;;;_ = allout-inhibit-body-modification-hook
(defvar allout-inhibit-body-modification-hook nil
@@ -415,15 +400,17 @@ not altered with an escape sequence.")
;;;_ , Widget element formatting
;;;_ = allout-item-icon-keymap
(defvar allout-item-icon-keymap
- (let ((km (make-sparse-keymap)))
+ (let ((km (make-sparse-keymap))
+ (as-parent (if (current-local-map)
+ (make-composed-keymap (current-local-map)
+ (current-global-map))
+ (current-global-map))))
+ ;; The keymap parent is reset on the each local var when mode starts.
+ (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 [(return)] 'allout-tree-expand-command)
-;; (define-key km [(meta return)] 'allout-toggle-torso-command)
-;; (define-key km [(down-mouse-1)] 'allout-item-button-click)
-;; (define-key km [(down-mouse-2)] 'allout-toggle-torso-event-command)
;; 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))
@@ -433,17 +420,16 @@ not altered with an escape sequence.")
km)
"General tree-node key bindings.")
+(make-variable-buffer-local 'allout-item-icon-keymap)
;;;_ = allout-item-body-keymap
(defvar allout-item-body-keymap
(let ((km (make-sparse-keymap))
- (local-map (current-local-map)))
-;; (define-key km [(control return)] 'allout-tree-expand-command)
-;; (define-key km [(meta return)] 'allout-toggle-torso-command)
- ;; XXX We need to reset this per buffer's mode; we do so in
- ;; allout-widgets-mode.
- (if local-map
- (set-keymap-parent km local-map))
-
+ (as-parent (if (current-local-map)
+ (make-composed-keymap (current-local-map)
+ (current-global-map))
+ (current-global-map))))
+ ;; The keymap parent is reset on the each local var when mode starts.
+ (set-keymap-parent km as-parent)
km)
"General key bindings for the text content of outline items.")
(make-variable-buffer-local 'allout-item-body-keymap)
@@ -456,6 +442,7 @@ not altered with an escape sequence.")
(set-keymap-parent km allout-item-icon-keymap)
km)
"Keymap used in the item cue area - the space between the icon and headline.")
+(make-variable-buffer-local 'allout-cue-span-keymap)
;;;_ = allout-escapes-category
(defvar allout-escapes-category nil
"Symbol for category of text property used to hide escapes of prefix-like
@@ -566,8 +553,13 @@ outline hot-spot navigation (see `allout-mode')."
(add-to-invisibility-spec '(allout-torso . t))
(add-to-invisibility-spec 'allout-escapes)
- (if (current-local-map)
- (set-keymap-parent allout-item-body-keymap (current-local-map)))
+ (let ((as-parent (if (current-local-map)
+ (make-composed-keymap (current-local-map)
+ (current-global-map))
+ (current-global-map))))
+ (set-keymap-parent allout-item-body-keymap as-parent)
+ ;; allout-cue-span-keymap uses allout-item-icon-keymap as parent.
+ (set-keymap-parent allout-item-icon-keymap as-parent))
(add-hook 'allout-exposure-change-functions
'allout-widgets-exposure-change-recorder nil 'local)
@@ -677,7 +669,7 @@ outline hot-spot navigation (see `allout-mode')."
(setplist 'allout-cue-span-category nil)
(put 'allout-cue-span-category 'evaporate t)
(put 'allout-cue-span-category
- 'modification-hooks '(allout-body-modification-handler))
+ 'modification-hooks '(allout-graphics-modification-handler))
(put 'allout-cue-span-category 'local-map allout-cue-span-keymap)
(put 'allout-cue-span-category 'mouse-face widget-button-face)
(put 'allout-cue-span-category 'pointer 'arrow)
@@ -988,6 +980,7 @@ Generally invoked via `allout-exposure-change-functions'."
;; have to distinguish between concealing and exposing so that, eg,
;; `allout-expose-topic's mix is handled properly.
handled-expose
+ handled-conceal
covered
deactivate-mark)
@@ -1345,64 +1338,6 @@ FROM and TO must be in increasing order, as must be the pairs in RANGES."
(setq new-ranges (nreverse new-ranges))
(if ranges (setq new-ranges (append new-ranges ranges)))
(list (if included-from t) new-ranges)))
-;;;_ > allout-test-range-overlaps ()
-(defun allout-test-range-overlaps ()
- "`allout-range-overlaps' unit tests."
- (let* (ranges
- got
- (try (lambda (from to)
- (setq got (allout-range-overlaps from to ranges))
- (setq ranges (cadr got))
- got)))
-;; ;; biggie:
-;; (setq ranges nil)
-;; ;; ~ .02 to .1 seconds for just repeated listing args instead of funcall
-;; ;; ~ 13 seconds for doing repeated funcall
-;; (message "time-trial: %s, resulting size %s"
-;; (time-trial
-;; '(let ((size 10000)
-;; doing)
-;; (dotimes (count size)
-;; (setq doing (random size))
-;; (funcall try doing (+ doing (random 5)))
-;; ;;(list doing (+ doing (random 5)))
-;; )))
-;; (length ranges))
-;; (sit-for 2)
-
- ;; fresh:
- (setq ranges nil)
- (cl-assert (equal (funcall try 3 5) '(nil ((3 5)))))
- ;; add range at end:
- (cl-assert (equal (funcall try 10 12) '(nil ((3 5) (10 12)))))
- ;; add range at beginning:
- (cl-assert (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12)))))
- ;; insert range somewhere in the middle:
- (cl-assert (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12)))))
- ;; consolidate some:
- (cl-assert (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12)))))
- ;; add more:
- (cl-assert (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17)))))
- ;; add more:
- (cl-assert (equal (funcall try 20 22)
- '(nil ((1 2) (3 9) (10 12) (15 17) (20 22)))))
- ;; encompass more:
- (cl-assert (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22)))))
- ;; encompass all:
- (cl-assert (equal (funcall try 2 25) '(t ((1 25)))))
-
- ;; fresh slate:
- (setq ranges nil)
- (cl-assert (equal (funcall try 20 25) '(nil ((20 25)))))
- (cl-assert (equal (funcall try 30 35) '(nil ((20 25) (30 35)))))
- (cl-assert (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35)))))
- (cl-assert (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35)))))
- (cl-assert (equal (funcall try 10 30) '(t ((10 35)))))
- (cl-assert (equal (funcall try 5 6) '(nil ((5 6) (10 35)))))
- (cl-assert (equal (funcall try 2 100) '(t ((2 100)))))
-
- (setq ranges nil)
- ))
;;;_ > allout-widgetize-buffer (&optional doing)
(defun allout-widgetize-buffer (&optional doing)
"EXAMPLE FUNCTION. Widgetize items in buffer using allout-chart-subtree.
@@ -1502,8 +1437,7 @@ recursive operation."
;; the actual location of the item text:
:location 'allout-item-location
- :button-keymap allout-item-icon-keymap ; XEmacs
- :keymap allout-item-icon-keymap ; Emacs
+ :keymap allout-item-icon-keymap
;; Element regions:
:guides-span nil
@@ -1594,7 +1528,10 @@ We return the item-widget corresponding to the item at point."
(if is-container
(progn (widget-put item-widget :is-container t)
(setq reverse-siblings-chart (list 1)))
- (goto-char (widget-apply parent :actual-position :from))
+ (let ((parent-position (widget-apply parent
+ :actual-position :from)))
+ (when parent-position
+ (goto-char parent-position)))
(if (widget-get parent :is-container)
;; `allout-goto-prefix' will go to first non-container item:
(allout-goto-prefix)
@@ -1994,8 +1931,7 @@ reapplying this method will rectify the glyphs."
;; NOTE: most of the cue-area
(when (not (widget-get item-widget :is-container))
- (let* ((cue-start (or (widget-get item-widget :distinctive-end)
- (widget-get item-widget :icon-end)))
+ (let* ((cue-start (widget-get item-widget :icon-end))
(body-start (widget-get item-widget :body-start))
;(expanded (widget-get item-widget :expanded))
;(has-subitems (widget-get item-widget :has-subitems))
@@ -2050,19 +1986,22 @@ Optional FORCE means force reassignment of the region property."
;;;_ > allout-widgets-undecorate-region (start end)
(defun allout-widgets-undecorate-region (start end)
"Eliminate widgets and decorations for all items in region from START to END."
- (let ((next start)
- widget)
+ (let (done next widget
+ (end (or end (point-max))))
(save-excursion
(goto-char start)
- (while (< (setq next (next-single-char-property-change next
- 'display
- (current-buffer)
- end))
- end)
- (goto-char next)
- (when (setq widget (allout-get-item-widget))
- ;; if the next-property/overly progression got us to a widget:
- (allout-widgets-undecorate-item widget t))))))
+ (while (not done)
+ (when (and (allout-on-current-heading-p)
+ (setq widget (allout-get-item-widget)))
+ (if widget
+ (allout-widgets-undecorate-item widget t)))
+ (goto-char (setq next
+ (next-single-char-property-change (point)
+ 'display
+ (current-buffer)
+ end)))
+ (if (>= next end)
+ (setq done t))))))
;;;_ > allout-widgets-undecorate-text (text)
(defun allout-widgets-undecorate-text (text)
"Eliminate widgets and decorations for all items in TEXT."
@@ -2316,15 +2255,13 @@ We use a caching strategy, so the caller doesn't need to do so."
(allout-widgets-copy-list (cadr got))
(while (and types (not got))
(setq got
- (allout-find-image
+ (find-image
(list (append (list :type (car types)
:file (concat use-dir
(symbol-name name)
"." (symbol-name
(car types))))
- (if (featurep 'xemacs)
- allout-widgets-item-image-properties-xemacs
- allout-widgets-item-image-properties-emacs)
+ allout-widgets-item-image-properties-emacs
))))
(setq types (cdr types)))
(if got
@@ -2345,11 +2282,7 @@ We use a caching strategy, so the caller doesn't need to do so."
'frame-property)
(t nil)))
;;;_ > allout-find-image (specs)
-(defalias 'allout-find-image
- (if (fboundp 'find-image)
- 'find-image
- nil) ; aka, not-yet-implemented for xemacs.
-)
+(define-obsolete-function-alias 'allout-find-image #'find-image "28.1")
;;;_ > allout-widgets-copy-list (list)
(defun allout-widgets-copy-list (list)
;; duplicated from cl.el 'copy-list' as of 2008-08-17
@@ -2374,22 +2307,10 @@ The elements of LIST are not copied, just the list structure itself."
(overlays-in start end)))))
(length button-overlays)))
-;;;_ : Run unit tests:
-(defun allout-widgets-run-unit-tests ()
- (message "Running allout-widget tests...")
-
- (allout-test-range-overlaps)
-
- (message "Running allout-widget tests... Done.")
- (sit-for .5))
-
-(when allout-widgets-run-unit-tests-on-load
- (allout-widgets-run-unit-tests))
-
;;;_ : provide
(provide 'allout-widgets)
-;;;_. Local emacs vars.
-;;;_ , Local variables:
-;;;_ , allout-layout: (-1 : 0)
-;;;_ , End:
+;;;_ . Local emacs vars.
+;;;_ , Local variables:
+;;;_ , allout-layout: (-1 : 0)
+;;;_ , End:
diff --git a/lisp/allout.el b/lisp/allout.el
index 6a7ecbb1ef1..b56071de59e 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -62,8 +62,7 @@
;; The outline menubar additions provide quick reference to many of the
;; features. See the docstring of the variables `allout-layout' and
;; `allout-auto-activation' for details on automatic activation of
-;; `allout-mode' as a minor mode. (`allout-init' is deprecated in favor of
-;; a purely customization-based method.)
+;; `allout-mode' as a minor mode.
;;
;; Note -- the lines beginning with `;;;_' are outline topic headers.
;; Customize `allout-auto-activation' to enable, then revisit this
@@ -78,7 +77,6 @@
;;;_* Dependency loads
(require 'overlay)
-(eval-when-compile (require 'cl-lib))
;;;_* USER CUSTOMIZATION VARIABLES:
@@ -410,8 +408,7 @@ where auto-fill occurs."
:group 'allout)
(make-variable-buffer-local 'allout-use-hanging-indents)
;;;###autoload
-(put 'allout-use-hanging-indents 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-use-hanging-indents 'safe-local-variable 'booleanp)
;;;_ = allout-reindent-bodies
(defcustom allout-reindent-bodies (if allout-use-hanging-indents
'text)
@@ -440,8 +437,7 @@ just the header."
:group 'allout)
(make-variable-buffer-local 'allout-show-bodies)
;;;###autoload
-(put 'allout-show-bodies 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-show-bodies 'safe-local-variable 'booleanp)
;;;_ = allout-beginning-of-line-cycles
(defcustom allout-beginning-of-line-cycles t
@@ -662,8 +658,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
- (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(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.
@@ -711,8 +706,7 @@ is non-nil."
:group 'allout)
(make-variable-buffer-local 'allout-stylish-prefixes)
;;;###autoload
-(put 'allout-stylish-prefixes 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-stylish-prefixes 'safe-local-variable 'booleanp)
;;;_ = allout-numbered-bullet
(defcustom allout-numbered-bullet "#"
@@ -726,10 +720,7 @@ disables numbering maintenance."
:group 'allout)
(make-variable-buffer-local 'allout-numbered-bullet)
;;;###autoload
-(put 'allout-numbered-bullet 'safe-local-variable
- (if (fboundp 'string-or-null-p)
- 'string-or-null-p
- (lambda (x) (or (stringp x) (null x)))))
+(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'.
@@ -738,10 +729,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
- (if (fboundp 'string-or-null-p)
- 'string-or-null-p
- (lambda (x) (or (stringp x) (null x)))))
+(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."
@@ -851,20 +839,6 @@ for restoring when all encryptions are established.")
(defgroup allout-developer nil
"Allout settings developers care about, including topic encryption and more."
:group 'allout)
-;;;_ = allout-run-unit-tests-on-load
-(defcustom allout-run-unit-tests-on-load nil
- "When non-nil, unit tests will be run at end of loading the allout module.
-
-Generally, allout code developers are the only ones who'll want to set this.
-
-\(If set, this makes it an even better practice to exercise changes by
-doing byte-compilation with a repeat count, so the file is loaded after
-compilation.)
-
-See `allout-run-unit-tests' to see what's run."
- :type 'boolean
- :group 'allout-developer)
-
;;;_ + Miscellaneous customization
;;;_ = allout-enable-file-variable-adjustment
@@ -1637,18 +1611,6 @@ non-nil in a lasting way.")
"If t, `allout-mode's last deactivation was deliberate.
So `allout-post-command-business' should not reactivate it...")
(make-variable-buffer-local 'allout-explicitly-deactivated)
-;;;_ > allout-init (mode)
-(defun allout-init (mode)
- "DEPRECATED - configure allout activation by customizing
-`allout-auto-activation'. This function remains around, limited
-from what it did before, for backwards compatibility.
-
-MODE is the activation mode - see `allout-auto-activation' for
-valid values."
- (declare (obsolete allout-auto-activation "23.3"))
- (customize-set-variable 'allout-auto-activation (format "%s" mode))
- (format "%s" mode))
-
;;;_ > allout-setup-menubar ()
(defun allout-setup-menubar ()
"Populate the current buffer's menubar with `allout-mode' stuff."
@@ -1675,10 +1637,8 @@ valid values."
;; least in emacs 21, 22.1, and xemacs 21.4.
(put 'allout-exposure-category 'isearch-open-invisible
'allout-isearch-end-handler)
- (if (featurep 'xemacs)
- (put 'allout-exposure-category 'start-open t)
- (put 'allout-exposure-category 'insert-in-front-hooks
- '(allout-overlay-insert-in-front-handler)))
+ (put 'allout-exposure-category 'insert-in-front-hooks
+ '(allout-overlay-insert-in-front-handler))
(put 'allout-exposure-category 'modification-hooks
'(allout-overlay-interior-modification-handler)))
;;;_ > define-minor-mode allout-mode
@@ -2115,9 +2075,7 @@ internal functions use this feature cohesively bunch changes."
(allout-show-to-offshoot)))
(when (not first)
(setq first (point))))
- (goto-char (if (featurep 'xemacs)
- (next-property-change (1+ (point)) nil end)
- (next-char-property-change (1+ (point)) end))))
+ (goto-char (next-char-property-change (1+ (point)) end)))
(when first
(goto-char first)
(condition-case nil
@@ -2141,18 +2099,7 @@ See `allout-overlay-interior-modification-handler' for details."
(when (and (allout-mode-p) undo-in-progress)
(setq allout-just-did-undo t)
(if (allout-hidden-p)
- (allout-show-children)))
-
- ;; allout-overlay-interior-modification-handler on an overlay handles
- ;; this in other emacs, via `allout-exposure-category's 'modification-hooks.
- (when (and (featurep 'xemacs) (allout-mode-p))
- ;; process all of the pending overlays:
- (save-excursion
- (goto-char beg)
- (let ((overlay (allout-get-invisibility-overlay)))
- (if overlay
- (allout-overlay-interior-modification-handler
- overlay nil beg end nil))))))
+ (allout-show-children))))
;;;_ > allout-isearch-end-handler (&optional overlay)
(defun allout-isearch-end-handler (&optional _overlay)
"Reconcile allout outline exposure on arriving in hidden text after isearch.
@@ -2453,7 +2400,7 @@ Outermost is first."
(progn
(if (and (not (bolp))
(allout-hidden-p (1- (point))))
- (goto-char (allout-previous-single-char-property-change
+ (goto-char (previous-single-char-property-change
(1- (point)) 'invisible)))
(move-beginning-of-line 1))
(allout-depth)
@@ -2499,20 +2446,16 @@ Outermost is first."
(allout-back-to-current-heading)
(allout-end-of-current-line))
(t
- (if (not (allout-mark-active-p))
+ (if (not mark-active)
(push-mark))
(allout-end-of-entry))))))
+
;;;_ > allout-mark-active-p ()
(defun allout-mark-active-p ()
"True if the mark is currently or always active."
- ;; `(cond (boundp...))' (or `(if ...)') invokes special byte-compiler
- ;; provisions, at least in GNU Emacs to prevent warnings about lack of,
- ;; eg, region-active-p.
- (cond ((boundp 'mark-active)
- mark-active)
- ((fboundp 'region-active-p)
- (region-active-p))
- (t)))
+ (declare (obsolete nil "28.1"))
+ mark-active)
+
;;;_ > allout-next-heading ()
(defsubst allout-next-heading ()
"Move to the heading for the topic (possibly invisible) after this one.
@@ -3443,7 +3386,7 @@ Offer one suitable for current depth DEPTH as default."
(format-message
"Select bullet: %s (`%s' default): "
sans-escapes
- (allout-substring-no-properties default-bullet))
+ (substring-no-properties default-bullet))
sans-escapes
t)))
(message "")
@@ -4458,9 +4401,9 @@ Topic exposure is marked with text-properties, to be used by
(if (not (allout-hidden-p))
(setq next
(max (1+ (point))
- (allout-next-single-char-property-change (point)
- 'invisible
- nil end))))
+ (next-single-char-property-change (point)
+ 'invisible
+ nil end))))
(if (or (not next) (eq prev next))
;; still not at start of hidden area -- must not be any left.
(setq done t)
@@ -4499,7 +4442,7 @@ Topic exposure is marked with text-properties, to be used by
(while (not done)
;; at or advance to start of next annotation:
(if (not (get-text-property (point) 'allout-was-hidden))
- (setq next (allout-next-single-char-property-change
+ (setq next (next-single-char-property-change
(point) 'allout-was-hidden nil end)))
(if (or (not next) (eq prev next))
;; no more or not advancing -- must not be any left.
@@ -4510,7 +4453,7 @@ Topic exposure is marked with text-properties, to be used by
;; still not at start of annotation.
(setq done t)
;; advance to just after end of this annotation:
- (setq next (allout-next-single-char-property-change
+ (setq next (next-single-char-property-change
(point) 'allout-was-hidden nil end))
(let ((o (make-overlay prev next nil 'front-advance)))
(overlay-put o 'category 'allout-exposure-category)
@@ -4543,12 +4486,12 @@ however, are left exactly like normal, non-allout-specific yanks."
(interactive "*P")
; Get to beginning, leaving
; region around subject:
- (if (< (allout-mark-marker t) (point))
+ (if (< (mark-marker) (point))
(exchange-point-and-mark))
(save-match-data
(let* ((subj-beg (point))
(into-bol (bolp))
- (subj-end (allout-mark-marker t))
+ (subj-end (mark-marker))
;; 'resituate' if yanking an entire topic into topic header:
(resituate (and (let ((allout-inhibit-aberrance-doublecheck t))
(allout-e-o-prefix-p))
@@ -4642,8 +4585,8 @@ however, are left exactly like normal, non-allout-specific yanks."
t)))
(message ""))))
(if (or into-bol resituate)
- (allout-hide-by-annotation (point) (allout-mark-marker t))
- (allout-deannotate-hidden (allout-mark-marker t) (point)))
+ (allout-hide-by-annotation (point) (mark-marker))
+ (allout-deannotate-hidden (mark-marker) (point)))
(if (not resituate)
(exchange-point-and-mark))
(run-hook-with-args 'allout-structure-added-functions subj-beg subj-end))))
@@ -4752,14 +4695,7 @@ this function."
(when flag
(let ((o (make-overlay from to nil 'front-advance)))
(overlay-put o 'category 'allout-exposure-category)
- (overlay-put o 'evaporate t)
- (when (featurep 'xemacs)
- (let ((props (symbol-plist 'allout-exposure-category)))
- (while props
- (condition-case nil
- ;; as of 2008-02-27, xemacs lacks modification-hooks
- (overlay-put o (pop props) (pop props))
- (error nil))))))
+ (overlay-put o 'evaporate t))
(setq allout-this-command-hid-text t))
(run-hook-with-args 'allout-exposure-change-functions from to flag))
;;;_ > allout-flag-current-subtree (flag)
@@ -5474,11 +5410,9 @@ header and body. The elements of that list are:
(cdr format)))))))
;; Put the list with first at front, to last at back:
(nreverse result))))
-;;;_ > allout-region-active-p ()
-(defmacro allout-region-active-p ()
- (cond ((fboundp 'use-region-p) '(use-region-p))
- ((fboundp 'region-active-p) '(region-active-p))
- (t 'mark-active)))
+
+(define-obsolete-function-alias 'allout-region-active-p 'region-active-p "28.1")
+
;;_ > allout-process-exposed (&optional func from to frombuf
;;; tobuf format)
(defun allout-process-exposed (&optional func from to frombuf tobuf
@@ -5511,7 +5445,7 @@ Defaults:
; defaulting if necessary:
(if (not func) (setq func 'allout-insert-listified))
(if (not (and from to))
- (if (allout-region-active-p)
+ (if (region-active-p)
(setq from (region-beginning) to (region-end))
(setq from (point-min) to (point-max))))
(if frombuf
@@ -5946,7 +5880,7 @@ See `allout-toggle-current-subtree-encryption' for more details."
;; they're encrypted, so the coding system is set to accommodate
;; them.
(setq buffer-file-coding-system
- (allout-select-safe-coding-system subtree-beg subtree-end))
+ (select-safe-coding-system subtree-beg subtree-end))
;; if the coding system for the text being encrypted is different
;; from that prevailing, then there a real risk that the coding
;; system can't be noticed by emacs when the file is visited. to
@@ -6542,204 +6476,15 @@ If BEG is bigger than END we return 0."
(mapcar (lambda (char) (if (= char ?%) "%%" (char-to-string char)))
string)))
(define-obsolete-function-alias 'allout-flatten #'flatten-tree "27.1")
-;;;_ : Compatibility:
-;;;_ : xemacs undo-in-progress provision:
-(unless (boundp 'undo-in-progress)
- (defvar undo-in-progress nil
- "Placeholder defvar for XEmacs compatibility from allout.el.")
- (defadvice undo-more (around allout activate)
- ;; This defadvice used only in emacs that lack undo-in-progress, eg xemacs.
- (let ((undo-in-progress t)) ad-do-it)))
-
-;;;_ > allout-mark-marker to accommodate divergent emacsen:
-(defun allout-mark-marker (&optional force buffer)
- "Accommodate the different signature for `mark-marker' across Emacsen.
-
-XEmacs takes two optional args, while Emacs does not,
-so pass them along when appropriate."
- (if (featurep 'xemacs)
- (apply 'mark-marker force buffer)
- (mark-marker)))
-;;;_ > subst-char-in-string if necessary
-(if (not (fboundp 'subst-char-in-string))
- (defun subst-char-in-string (fromchar tochar string &optional inplace)
- "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
-Unless optional argument INPLACE is non-nil, return a new string."
- (let ((i (length string))
- (newstr (if inplace string (copy-sequence string))))
- (while (> i 0)
- (setq i (1- i))
- (if (eq (aref newstr i) fromchar)
- (aset newstr i tochar)))
- newstr)))
-;;;_ > wholenump if necessary
-(if (not (fboundp 'wholenump))
- (defalias 'wholenump 'natnump))
-;;;_ > remove-overlays if necessary
-(if (not (fboundp 'remove-overlays))
- (defun remove-overlays (&optional beg end name val)
- "Clear BEG and END of overlays whose property NAME has value VAL.
-Overlays might be moved and/or split.
-BEG and END default respectively to the beginning and end of buffer."
- (unless beg (setq beg (point-min)))
- (unless end (setq end (point-max)))
- (if (< end beg)
- (setq beg (prog1 end (setq end beg))))
- (save-excursion
- (dolist (o (overlays-in beg end))
- (when (eq (overlay-get o name) val)
- ;; Either push this overlay outside beg...end
- ;; or split it to exclude beg...end
- ;; or delete it entirely (if it is contained in beg...end).
- (if (< (overlay-start o) beg)
- (if (> (overlay-end o) end)
- (progn
- (move-overlay (copy-overlay o)
- (overlay-start o) beg)
- (move-overlay o end (overlay-end o)))
- (move-overlay o (overlay-start o) beg))
- (if (> (overlay-end o) end)
- (move-overlay o end (overlay-end o))
- (delete-overlay o)))))))
- )
-;;;_ > copy-overlay if necessary -- xemacs ~ 21.4
-(if (not (fboundp 'copy-overlay))
- (defun copy-overlay (o)
- "Return a copy of overlay O."
- (let ((o1 (make-overlay (overlay-start o) (overlay-end o)
- ;; FIXME: there's no easy way to find the
- ;; insertion-type of the two markers.
- (overlay-buffer o)))
- (props (overlay-properties o)))
- (while props
- (overlay-put o1 (pop props) (pop props)))
- o1)))
-;;;_ > add-to-invisibility-spec if necessary -- xemacs ~ 21.4
-(if (not (fboundp 'add-to-invisibility-spec))
- (defun add-to-invisibility-spec (element)
- "Add ELEMENT to `buffer-invisibility-spec'.
-See documentation for `buffer-invisibility-spec' for the kind of elements
-that can be added."
- (if (eq buffer-invisibility-spec t)
- (setq buffer-invisibility-spec (list t)))
- (setq buffer-invisibility-spec
- (cons element buffer-invisibility-spec))))
-;;;_ > remove-from-invisibility-spec if necessary -- xemacs ~ 21.4
-(if (not (fboundp 'remove-from-invisibility-spec))
- (defun remove-from-invisibility-spec (element)
- "Remove ELEMENT from `buffer-invisibility-spec'."
- (if (consp buffer-invisibility-spec)
- (setq buffer-invisibility-spec (delete element
- buffer-invisibility-spec)))))
-;;;_ > move-beginning-of-line if necessary -- older emacs, xemacs
-(if (not (fboundp 'move-beginning-of-line))
- (defun move-beginning-of-line (arg)
- "Move point to beginning of current line as displayed.
-\(This disregards invisible newlines such as those
-which are part of the text that an image rests on.)
-
-With argument ARG not nil or 1, move forward ARG - 1 lines first.
-If point reaches the beginning or end of buffer, it stops there.
-To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
- (interactive "p")
- (or arg (setq arg 1))
- (if (/= arg 1)
- (condition-case nil (line-move (1- arg)) (error nil)))
-
- ;; Move to beginning-of-line, ignoring fields and invisible text.
- (skip-chars-backward "^\n")
- (while (and (not (bobp))
- (let ((prop
- (get-char-property (1- (point)) 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec)))))
- (goto-char (if (featurep 'xemacs)
- (previous-property-change (point))
- (previous-char-property-change (point))))
- (skip-chars-backward "^\n"))
- (vertical-motion 0))
-)
-;;;_ > move-end-of-line if necessary -- Emacs < 22.1, xemacs
-(if (not (fboundp 'move-end-of-line))
- (defun move-end-of-line (arg)
- "Move point to end of current line as displayed.
-\(This disregards invisible newlines such as those
-which are part of the text that an image rests on.)
-
-With argument ARG not nil or 1, move forward ARG - 1 lines first.
-If point reaches the beginning or end of buffer, it stops there.
-To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
- (interactive "p")
- (or arg (setq arg 1))
- (let (done)
- (while (not done)
- (let ((newpos
- (save-excursion
- (let ((goal-column 0))
- (and (condition-case nil
- (or (line-move arg) t)
- (error nil))
- (not (bobp))
- (progn
- (while
- (and
- (not (bobp))
- (let ((prop
- (get-char-property (1- (point))
- 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop
- buffer-invisibility-spec)
- (assq prop
- buffer-invisibility-spec)))))
- (goto-char
- (previous-char-property-change (point))))
- (backward-char 1)))
- (point)))))
- (goto-char newpos)
- (if (and (> (point) newpos)
- (eq (preceding-char) ?\n))
- (backward-char 1)
- (if (and (> (point) newpos) (not (eobp))
- (not (eq (following-char) ?\n)))
- ;; If we skipped something intangible
- ;; and now we're not really at eol,
- ;; keep going.
- (setq arg 1)
- (setq done t)))))))
- )
-;;;_ > allout-next-single-char-property-change -- alias unless lacking
-(defalias 'allout-next-single-char-property-change
- (if (fboundp 'next-single-char-property-change)
- 'next-single-char-property-change
- 'next-single-property-change)
- ;; No docstring because xemacs defalias doesn't support it.
- )
-;;;_ > allout-previous-single-char-property-change -- alias unless lacking
-(defalias 'allout-previous-single-char-property-change
- (if (fboundp 'previous-single-char-property-change)
- 'previous-single-char-property-change
- 'previous-single-property-change)
- ;; No docstring because xemacs defalias doesn't support it.
- )
-;;;_ > allout-select-safe-coding-system
-(defalias 'allout-select-safe-coding-system
- (if (fboundp 'select-safe-coding-system)
- 'select-safe-coding-system
- 'detect-coding-region)
- )
-;;;_ > allout-substring-no-properties
-;; define as alias first, so byte compiler is happy.
-(defalias 'allout-substring-no-properties 'substring-no-properties)
-;; then supplant with definition if underlying alias absent.
-(if (not (fboundp 'substring-no-properties))
- (defun allout-substring-no-properties (string &optional start end)
- (substring string (or start 0) end))
- )
-
+(define-obsolete-function-alias 'allout-mark-marker #'mark-marker "28.1")
+(define-obsolete-function-alias 'allout-substring-no-properties
+ #'substring-no-properties "28.1")
+(define-obsolete-function-alias 'allout-select-safe-coding-system
+ #'select-safe-coding-system "28.1")
+(define-obsolete-function-alias 'allout-previous-single-char-property-change
+ #'previous-single-char-property-change "28.1")
+(define-obsolete-function-alias 'allout-next-single-char-property-change
+ #'next-single-char-property-change "28.1")
;;;_ #10 Unfinished
;;;_ > allout-bullet-isearch (&optional bullet)
(defun allout-bullet-isearch (&optional bullet)
@@ -6758,136 +6503,7 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
(isearch-repeat 'forward)
(isearch-mode t)))
-;;;_ #11 Unit tests -- this should be last item before "Provide"
-;;;_ > allout-run-unit-tests ()
-(defun allout-run-unit-tests ()
- "Run the various allout unit tests."
- (message "Running allout tests...")
- (allout-test-resumptions)
- (message "Running allout tests... Done.")
- (sit-for .5))
-;;;_ : test resumptions:
-;;;_ > allout-tests-obliterate-variable (name)
-(defun allout-tests-obliterate-variable (name)
- "Completely unbind variable with NAME."
- (if (local-variable-p name (current-buffer)) (kill-local-variable name))
- (while (boundp name) (makunbound name)))
-;;;_ > allout-test-resumptions ()
-(defvar allout-tests-globally-unbound nil
- "Fodder for allout resumptions tests -- defvar just for byte compiler.")
-(defvar allout-tests-globally-true nil
- "Fodder for allout resumptions tests -- defvar just for byte compiler.")
-(defvar allout-tests-locally-true nil
- "Fodder for allout resumptions tests -- defvar just for byte compiler.")
-(defun allout-test-resumptions ()
- ;; FIXME: Use ERT.
- "Exercise allout resumptions."
- ;; for each resumption case, we also test that the right local/global
- ;; scopes are affected during resumption effects:
-
- ;; ensure that previously unbound variables return to the unbound state.
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
- (allout-add-resumptions '(allout-tests-globally-unbound t))
- (cl-assert (not (default-boundp 'allout-tests-globally-unbound)))
- (cl-assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
- (cl-assert (boundp 'allout-tests-globally-unbound))
- (cl-assert (equal allout-tests-globally-unbound t))
- (allout-do-resumptions)
- (cl-assert (not (local-variable-p 'allout-tests-globally-unbound
- (current-buffer))))
- (cl-assert (not (boundp 'allout-tests-globally-unbound))))
-
- ;; ensure that variable with prior global value is resumed
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-globally-true)
- (setq allout-tests-globally-true t)
- (allout-add-resumptions '(allout-tests-globally-true nil))
- (cl-assert (equal (default-value 'allout-tests-globally-true) t))
- (cl-assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
- (cl-assert (equal allout-tests-globally-true nil))
- (allout-do-resumptions)
- (cl-assert (not (local-variable-p 'allout-tests-globally-true
- (current-buffer))))
- (cl-assert (boundp 'allout-tests-globally-true))
- (cl-assert (equal allout-tests-globally-true t)))
-
- ;; ensure that prior local value is resumed
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable 'allout-tests-locally-true) t)
- (cl-assert (not (default-boundp 'allout-tests-locally-true))
- nil (concat "Test setup mistake -- variable supposed to"
- " not have global binding, but it does."))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer))
- nil (concat "Test setup mistake -- variable supposed to have"
- " local binding, but it lacks one."))
- (allout-add-resumptions '(allout-tests-locally-true nil))
- (cl-assert (not (default-boundp 'allout-tests-locally-true)))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true nil))
- (allout-do-resumptions)
- (cl-assert (boundp 'allout-tests-locally-true))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true t))
- (cl-assert (not (default-boundp 'allout-tests-locally-true))))
-
- ;; ensure that last of multiple resumptions holds, for various scopes.
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
- (allout-tests-obliterate-variable 'allout-tests-globally-true)
- (setq allout-tests-globally-true t)
- (allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable 'allout-tests-locally-true) t)
- (allout-add-resumptions '(allout-tests-globally-unbound t)
- '(allout-tests-globally-true nil)
- '(allout-tests-locally-true nil))
- (allout-add-resumptions '(allout-tests-globally-unbound 2)
- '(allout-tests-globally-true 3)
- '(allout-tests-locally-true 4))
- ;; reestablish many of the basic conditions are maintained after re-add:
- (cl-assert (not (default-boundp 'allout-tests-globally-unbound)))
- (cl-assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
- (cl-assert (equal allout-tests-globally-unbound 2))
- (cl-assert (default-boundp 'allout-tests-globally-true))
- (cl-assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
- (cl-assert (equal allout-tests-globally-true 3))
- (cl-assert (not (default-boundp 'allout-tests-locally-true)))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true 4))
- (allout-do-resumptions)
- (cl-assert (not (local-variable-p 'allout-tests-globally-unbound
- (current-buffer))))
- (cl-assert (not (boundp 'allout-tests-globally-unbound)))
- (cl-assert (not (local-variable-p 'allout-tests-globally-true
- (current-buffer))))
- (cl-assert (boundp 'allout-tests-globally-true))
- (cl-assert (equal allout-tests-globally-true t))
- (cl-assert (boundp 'allout-tests-locally-true))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true t))
- (cl-assert (not (default-boundp 'allout-tests-locally-true))))
-
- ;; ensure that deliberately unbinding registered variables doesn't foul things
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
- (allout-tests-obliterate-variable 'allout-tests-globally-true)
- (setq allout-tests-globally-true t)
- (allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable 'allout-tests-locally-true) t)
- (allout-add-resumptions '(allout-tests-globally-unbound t)
- '(allout-tests-globally-true nil)
- '(allout-tests-locally-true nil))
- (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
- (allout-tests-obliterate-variable 'allout-tests-globally-true)
- (allout-tests-obliterate-variable 'allout-tests-locally-true)
- (allout-do-resumptions))
- )
-;;;_ % Run unit tests if `allout-run-unit-tests-on-load' is true:
-(when allout-run-unit-tests-on-load
- (allout-run-unit-tests))
-
-;;;_ #12 Provide
+;;;_ #11 Provide
(provide 'allout)
;;;_* Local emacs vars.
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 4130f5aad3c..141ad2353e8 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -536,7 +536,7 @@ codes. Finally, the so changed list of codes is returned."
(cons new (remq new codes))))
(2 (unless (memq new '(20 26 28 29))
;; The standard says `21 doubly underlined' while
- ;; http://en.wikipedia.org/wiki/ANSI_escape_code claims
+ ;; https://en.wikipedia.org/wiki/ANSI_escape_code claims
;; `21 Bright/Bold: off or Underline: Double'.
(remq (- new 20) (pcase new
(22 (remq 1 codes))
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 23f70d10fd4..e7e8955afe8 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1,4 +1,4 @@
-;;; apropos.el --- apropos commands for users and programmers
+;;; apropos.el --- apropos commands for users and programmers -*- lexical-binding: t -*-
;; Copyright (C) 1989, 1994-1995, 2001-2020 Free Software Foundation,
;; Inc.
@@ -82,49 +82,41 @@ commands also has an optional argument to request a more extensive search.
Additionally, this option makes the function `apropos-library'
include key-binding information in its output."
- :group 'apropos
:type 'boolean)
(defface apropos-symbol
'((t (:inherit bold)))
"Face for the symbol name in Apropos output."
- :group 'apropos
:version "24.3")
(defface apropos-keybinding
'((t (:inherit underline)))
"Face for lists of keybinding in Apropos output."
- :group 'apropos
:version "24.3")
(defface apropos-property
'((t (:inherit font-lock-builtin-face)))
"Face for property name in Apropos output, or nil for none."
- :group 'apropos
:version "24.3")
(defface apropos-function-button
'((t (:inherit (font-lock-function-name-face button))))
"Button face indicating a function, macro, or command in Apropos."
- :group 'apropos
:version "24.3")
(defface apropos-variable-button
'((t (:inherit (font-lock-variable-name-face button))))
"Button face indicating a variable in Apropos."
- :group 'apropos
:version "24.3")
(defface apropos-user-option-button
'((t (:inherit (font-lock-variable-name-face button))))
"Button face indicating a user option in Apropos."
- :group 'apropos
:version "24.4")
(defface apropos-misc-button
'((t (:inherit (font-lock-constant-face button))))
"Button face indicating a miscellaneous object type in Apropos."
- :group 'apropos
:version "24.3")
(defcustom apropos-match-face 'match
@@ -132,14 +124,12 @@ include key-binding information in its output."
This applies when you look for matches in the documentation or variable value
for the pattern; the part that matches gets displayed in this font."
:type '(choice (const nil) face)
- :group 'apropos
:version "24.3")
(defcustom apropos-sort-by-scores nil
"Non-nil means sort matches by scores; best match is shown first.
This applies to all `apropos' commands except `apropos-documentation'.
If value is `verbose', the computed score is shown for each match."
- :group 'apropos
:type '(choice (const :tag "off" nil)
(const :tag "on" t)
(const :tag "show scores" verbose)))
@@ -148,7 +138,6 @@ If value is `verbose', the computed score is shown for each match."
"Non-nil means sort matches by scores; best match is shown first.
This applies to `apropos-documentation' only.
If value is `verbose', the computed score is shown for each match."
- :group 'apropos
:type '(choice (const :tag "off" nil)
(const :tag "on" t)
(const :tag "show scores" verbose)))
@@ -160,6 +149,10 @@ If value is `verbose', the computed score is shown for each match."
;; 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)
+
+ ;; Movement keys
+ (define-key map "n" 'apropos-next-symbol)
+ (define-key map "p" 'apropos-previous-symbol)
map)
"Keymap used in Apropos mode.")
@@ -348,7 +341,7 @@ before finding a label."
(defun apropos-words-to-regexp (words wild)
- "Make regexp matching any two of the words in WORDS.
+ "Return a regexp matching any two of the words in WORDS.
WILD should be a subexpression matching wildcards between matches."
(setq words (delete-dups (copy-sequence words)))
(if (null (cdr words))
@@ -380,9 +373,11 @@ kind of objects to search."
(user-error "No word list given"))
pattern)))
-(defun apropos-parse-pattern (pattern)
+(defun apropos-parse-pattern (pattern &optional multiline-p)
"Rewrite a list of words to a regexp matching all permutations.
If PATTERN is a string, that means it is already a regexp.
+MULTILINE-P, if non-nil, means produce a regexp that will match
+the words even if separated by newlines.
This updates variables `apropos-pattern', `apropos-pattern-quoted',
`apropos-regexp', `apropos-words', and `apropos-all-words-regexp'."
(setq apropos-words nil
@@ -393,6 +388,9 @@ This updates variables `apropos-pattern', `apropos-pattern-quoted',
;; any combination of two or more words like this:
;; (a|b|c).*(a|b|c) which may give some false matches,
;; but as long as it also gives the right ones, that's ok.
+ ;; (Actually, when MULTILINE-P is non-nil, instead of '.' we
+ ;; 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 " ")
apropos-pattern-quoted (regexp-quote apropos-pattern))
@@ -409,9 +407,13 @@ This updates variables `apropos-pattern', `apropos-pattern-quoted',
(setq apropos-words (cons s apropos-words)
apropos-all-words (cons a apropos-all-words))))
(setq apropos-all-words-regexp
- (apropos-words-to-regexp apropos-all-words ".+"))
+ (apropos-words-to-regexp apropos-all-words
+ ;; The [^b-a] trick matches any
+ ;; character including a newline.
+ (if multiline-p "[^b-a]+?" ".+")))
(setq apropos-regexp
- (apropos-words-to-regexp apropos-words ".*?")))
+ (apropos-words-to-regexp apropos-words
+ (if multiline-p "[^b-a]*?" ".*?"))))
(setq apropos-pattern-quoted (regexp-quote pattern)
apropos-all-words-regexp pattern
apropos-pattern pattern
@@ -541,6 +543,20 @@ will be buffer-local when set."
(and (local-variable-if-set-p symbol)
(get symbol 'variable-documentation)))))
+;;;###autoload
+(defun apropos-function (pattern)
+ "Show functions that match PATTERN.
+
+PATTERN can be a word, a list of words (separated by spaces),
+or a regexp (using some regexp special characters). If it is a word,
+search for matches for that word as a substring. If it is a list of words,
+search for matches for any two (or more) of those words.
+
+This is the same as running `apropos-command' with a \\[universal-argument] prefix,
+or a non-nil `apropos-do-all' argument."
+ (interactive (list (apropos-read-pattern "function")))
+ (apropos-command pattern t))
+
;; For auld lang syne:
;;;###autoload
(defalias 'command-apropos 'apropos-command)
@@ -640,7 +656,7 @@ search for matches for any two (or more) of those words.
With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil,
consider all symbols (if they match PATTERN).
-Returns list of symbols and documentation found."
+Return list of symbols and documentation found."
(interactive (list (apropos-read-pattern "symbol")
current-prefix-arg))
(setq apropos--current (list #'apropos pattern do-all))
@@ -659,12 +675,11 @@ Returns list of symbols and documentation found."
(defun apropos-library-button (sym)
(if (null sym)
"<nothing>"
- (let ((name (copy-sequence (symbol-name sym))))
+ (let ((name (symbol-name sym)))
(make-text-button name nil
'type 'apropos-library
'face 'apropos-symbol
- 'apropos-symbol name)
- name)))
+ 'apropos-symbol name))))
;;;###autoload
(defun apropos-library (file)
@@ -794,7 +809,7 @@ Returns list of symbols and values found."
(interactive (list (apropos-read-pattern "value")
current-prefix-arg))
(setq apropos--current (list #'apropos-value pattern do-all))
- (apropos-parse-pattern pattern)
+ (apropos-parse-pattern pattern t)
(or do-all (setq do-all apropos-do-all))
(setq apropos-accumulator ())
(let (f v p)
@@ -834,7 +849,7 @@ Optional arg BUFFER (default: current buffer) is the buffer to check."
(interactive (list (apropos-read-pattern "value of buffer-local variable")))
(unless buffer (setq buffer (current-buffer)))
(setq apropos--current (list #'apropos-local-value pattern buffer))
- (apropos-parse-pattern pattern)
+ (apropos-parse-pattern pattern t)
(setq apropos-accumulator ())
(let ((var nil))
(mapatoms
@@ -848,14 +863,12 @@ Optional arg BUFFER (default: current buffer) is the buffer to check."
(setq apropos-accumulator (cons (list symb (apropos-score-str var) nil var)
apropos-accumulator))))))
(let ((apropos-multi-type nil))
- (if (> emacs-major-version 20)
- (apropos-print
- nil "\n----------------\n"
- (format "Buffer `%s' has the following local variables\nmatching %s`%s':"
- (buffer-name buffer)
- (if (consp pattern) "keywords " "")
- pattern))
- (apropos-print nil "\n----------------\n"))))
+ (apropos-print
+ nil "\n----------------\n"
+ (format "Buffer `%s' has the following local variables\nmatching %s`%s':"
+ (buffer-name buffer)
+ (if (consp pattern) "keywords " "")
+ pattern))))
;;;###autoload
(defun apropos-documentation (pattern &optional do-all)
@@ -876,7 +889,7 @@ Returns list of symbols and documentation found."
(interactive (list (apropos-read-pattern "documentation")
current-prefix-arg))
(setq apropos--current (list #'apropos-documentation pattern do-all))
- (apropos-parse-pattern pattern)
+ (apropos-parse-pattern pattern t)
(or do-all (setq do-all apropos-do-all))
(setq apropos-accumulator () apropos-files-scanned ())
(let ((standard-input (get-buffer-create " apropos-temp"))
@@ -917,16 +930,14 @@ Returns list of symbols and documentation found."
(defun apropos-value-internal (predicate symbol function)
- (if (funcall predicate symbol)
- (progn
- (setq symbol (prin1-to-string (funcall function symbol)))
- (if (string-match apropos-regexp symbol)
- (progn
- (if apropos-match-face
- (put-text-property (match-beginning 0) (match-end 0)
- 'face apropos-match-face
- symbol))
- symbol)))))
+ (when (funcall predicate symbol)
+ (setq symbol (prin1-to-string (funcall function symbol)))
+ (when (string-match apropos-regexp symbol)
+ (if apropos-match-face
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face apropos-match-face
+ symbol))
+ symbol)))
(defun apropos-documentation-internal (doc)
(cond
@@ -948,6 +959,10 @@ Returns list of symbols and documentation found."
doc))))
(defun apropos-format-plist (pl sep &optional compare)
+ "Return a string representation of the plist PL.
+Paired elements are separated by the string SEP. Only include
+properties matching the current `apropos-regexp' when COMPARE is
+non-nil."
(setq pl (symbol-plist pl))
(let (p p-out)
(while pl
@@ -956,13 +971,12 @@ Returns list of symbols and documentation found."
(put-text-property 0 (length (symbol-name (car pl)))
'face 'apropos-property p)
(setq p nil))
- (if p
- (progn
- (and compare apropos-match-face
- (put-text-property (match-beginning 0) (match-end 0)
- 'face apropos-match-face
- p))
- (setq p-out (concat p-out (if p-out sep) p))))
+ (when p
+ (and compare apropos-match-face
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face apropos-match-face
+ p))
+ (setq p-out (concat p-out (if p-out sep) p)))
(setq pl (nthcdr 2 pl)))
p-out))
@@ -1270,6 +1284,21 @@ as a heading."
(or (apropos-next-label-button (line-beginning-position))
(error "There is nothing to follow here"))))
+(defun apropos-next-symbol ()
+ "Move cursor down to the next symbol in an apropos-mode buffer."
+ (interactive)
+ (forward-line)
+ (while (and (not (eq (face-at-point) 'apropos-symbol))
+ (< (point) (point-max)))
+ (forward-line)))
+
+(defun apropos-previous-symbol ()
+ "Move cursor back to the last symbol in an apropos-mode buffer."
+ (interactive)
+ (forward-line -1)
+ (while (and (not (eq (face-at-point) 'apropos-symbol))
+ (> (point) (point-min)))
+ (forward-line -1)))
(defun apropos-describe-plist (symbol)
"Display a pretty listing of SYMBOL's plist."
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index c09f78e0d24..c998a8a1f1a 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -1,4 +1,4 @@
-;;; arc-mode.el --- simple editing of archives
+;;; arc-mode.el --- simple editing of archives -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1997-1998, 2001-2020 Free Software Foundation,
;; Inc.
@@ -52,17 +52,17 @@
;; ARCHIVE TYPES: Currently only the archives below are handled, but the
;; structure for handling just about anything is in place.
;;
-;; Arc Lzh Zip Zoo Rar 7z
-;; --------------------------------------------
-;; View listing Intern Intern Intern Intern Y Y
-;; Extract member Y Y Y Y Y Y
-;; Save changed member Y Y Y Y N Y
-;; Add new member N N N N N N
-;; Delete member Y Y Y Y N Y
-;; Rename member Y Y N N N N
-;; Chmod - Y Y - N N
-;; Chown - Y - - N N
-;; Chgrp - Y - - N N
+;; Arc Lzh Zip Zoo Rar 7z Ar
+;; --------------------------------------------------
+;; View listing Intern Intern Intern Intern Y Y Y
+;; Extract member Y Y Y Y Y Y Y
+;; Save changed member Y Y Y Y N Y Y
+;; Add new member N N N N N N N
+;; Delete member Y Y Y Y N Y N
+;; Rename member Y Y N N N N N
+;; Chmod - Y Y - N N N
+;; Chown - Y - - N N N
+;; Chgrp - Y - - N N N
;;
;; Special thanks to Bill Brodie <wbrodie@panix.com> for very useful tips
;; on the first released version of this package.
@@ -101,6 +101,8 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
;; -------------------------------------------------------------------------
;;; Section: Configuration.
@@ -108,22 +110,6 @@
"Simple editing of archives."
:group 'data)
-(defgroup archive-arc nil
- "ARC-specific options to archive."
- :group 'archive)
-
-(defgroup archive-lzh nil
- "LZH-specific options to archive."
- :group 'archive)
-
-(defgroup archive-zip nil
- "ZIP-specific options to archive."
- :group 'archive)
-
-(defgroup archive-zoo nil
- "ZOO-specific options to archive."
- :group 'archive)
-
(defcustom archive-tmpdir
;; make-temp-name is safe here because we use this name
;; to create a directory.
@@ -131,35 +117,48 @@
(expand-file-name (if (eq system-type 'ms-dos) "ar" "archive.tmp")
temporary-file-directory))
"Directory for temporary files made by `arc-mode.el'."
- :type 'directory
- :group 'archive)
+ :type 'directory)
(defcustom archive-remote-regexp "^/[^/:]*[^/:.]:"
"Regexp recognizing archive files names that are not local.
A non-local file is one whose file name is not proper outside Emacs.
A local copy of the archive will be used when updating."
- :type 'regexp
- :group 'archive)
+ :type 'regexp)
(define-obsolete-variable-alias 'archive-extract-hooks
'archive-extract-hook "24.3")
(defcustom archive-extract-hook nil
"Hook run when an archive member has been extracted."
- :type 'hook
- :group 'archive)
+ :type 'hook)
(defcustom archive-visit-single-files nil
"If non-nil, opening an archive with a single file visits that file.
If nil, visiting such an archive displays the archive summary."
:version "25.1"
:type '(choice (const :tag "Visit the single file" t)
- (const :tag "Show the archive summary" nil))
- :group 'archive)
+ (const :tag "Show the archive summary" nil)))
+
+(defcustom archive-hidden-columns '(Ids)
+ "Columns hidden from display."
+ :version "28.1"
+ :type '(set (const Mode)
+ (const Ids)
+ (const Date&Time)
+ (const Ratio)))
+
+(defconst archive-alternate-hidden-columns '(Mode Date&Time)
+ "Columns hidden when `archive-alternate-display' is used.")
+
;; ------------------------------
;; Arc archive configuration
;; We always go via a local file since there seems to be no reliable way
;; to extract to stdout without junk getting added.
+
+(defgroup archive-arc nil
+ "ARC-specific options to archive."
+ :group 'archive)
+
(defcustom archive-arc-extract
'("arc" "x")
"Program and its options to run in order to extract an arc file member.
@@ -168,8 +167,7 @@ name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-arc)
+ (string :format "%v"))))
(defcustom archive-arc-expunge
'("arc" "d")
@@ -178,8 +176,7 @@ Archive and member names will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-arc)
+ (string :format "%v"))))
(defcustom archive-arc-write-file-member
'("arc" "u")
@@ -188,11 +185,14 @@ Archive and member name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-arc)
+ (string :format "%v"))))
;; ------------------------------
;; Lzh archive configuration
+(defgroup archive-lzh nil
+ "LZH-specific options to archive."
+ :group 'archive)
+
(defcustom archive-lzh-extract
'("lha" "pq")
"Program and its options to run in order to extract an lzh file member.
@@ -201,8 +201,7 @@ be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-lzh)
+ (string :format "%v"))))
(defcustom archive-lzh-expunge
'("lha" "d")
@@ -211,8 +210,7 @@ Archive and member names will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-lzh)
+ (string :format "%v"))))
(defcustom archive-lzh-write-file-member
'("lha" "a")
@@ -221,8 +219,7 @@ Archive and member name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-lzh)
+ (string :format "%v"))))
;; ------------------------------
;; Zip archive configuration
@@ -231,6 +228,10 @@ Archive and member name will be added."
(when 7z
(file-name-nondirectory 7z))))
+(defgroup archive-zip nil
+ "ZIP-specific options to archive."
+ :group 'archive)
+
(defcustom archive-zip-extract
(cond ((executable-find "unzip") '("unzip" "-qq" "-c"))
(archive-7z-program `(,archive-7z-program "x" "-so"))
@@ -242,8 +243,7 @@ be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-zip)
+ (string :format "%v"))))
;; For several reasons the latter behavior is not desirable in general.
;; (1) It uses more disk space. (2) Error checking is worse or non-
@@ -260,8 +260,7 @@ Archive and member names will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-zip)
+ (string :format "%v"))))
(defcustom archive-zip-update
(cond ((executable-find "zip") '("zip" "-q"))
@@ -274,8 +273,7 @@ file. Archive and member name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-zip)
+ (string :format "%v"))))
(defcustom archive-zip-update-case
(cond ((executable-find "zip") '("zip" "-q" "-k"))
@@ -288,8 +286,7 @@ Archive and member name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-zip)
+ (string :format "%v"))))
(declare-function msdos-long-file-names "msdos.c")
(defcustom archive-zip-case-fiddle (and (eq system-type 'ms-dos)
@@ -300,11 +297,14 @@ that uses caseless file names.
In addition, this flag forces members added/updated in the zip archive
to be truncated to DOS 8+3 file-name restrictions."
:type 'boolean
- :version "27.1"
- :group 'archive-zip)
+ :version "27.1")
;; ------------------------------
;; Zoo archive configuration
+(defgroup archive-zoo nil
+ "ZOO-specific options to archive."
+ :group 'archive)
+
(defcustom archive-zoo-extract
'("zoo" "xpq")
"Program and its options to run in order to extract a zoo file member.
@@ -313,8 +313,7 @@ be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-zoo)
+ (string :format "%v"))))
(defcustom archive-zoo-expunge
'("zoo" "DqPP")
@@ -323,8 +322,7 @@ Archive and member names will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-zoo)
+ (string :format "%v"))))
(defcustom archive-zoo-write-file-member
'("zoo" "a")
@@ -333,11 +331,14 @@ Archive and member name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-zoo)
+ (string :format "%v"))))
;; ------------------------------
;; 7z archive configuration
+(defgroup archive-7z nil
+ "7Z-specific options to archive."
+ :group 'archive)
+
(defcustom archive-7z-extract
`(,(or archive-7z-program "7z") "x" "-so")
"Program and its options to run in order to extract a 7z file member.
@@ -347,8 +348,7 @@ be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-7z)
+ (string :format "%v"))))
(defcustom archive-7z-expunge
`(,(or archive-7z-program "7z") "d")
@@ -358,8 +358,7 @@ Archive and member names will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-7z)
+ (string :format "%v"))))
(defcustom archive-7z-update
`(,(or archive-7z-program "7z") "u")
@@ -370,18 +369,17 @@ file. Archive and member name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-7z)
+ (string :format "%v"))))
;; -------------------------------------------------------------------------
;;; Section: Variables
(defvar archive-subtype nil "Symbol describing archive type.")
-(defvar archive-file-list-start nil "Position of first contents line.")
-(defvar archive-file-list-end nil "Position just after last contents line.")
-(defvar archive-proper-file-start nil "Position of real archive's start.")
+(defvar-local archive-file-list-start nil "Position of first contents line.")
+(defvar-local archive-file-list-end nil "Position just after last contents line.")
+(defvar-local archive-proper-file-start nil "Position of real archive's start.")
(defvar archive-read-only nil "Non-nil if the archive is read-only on disk.")
-(defvar archive-local-name nil "Name of local copy of remote archive.")
+(defvar-local archive-local-name nil "Name of local copy of remote archive.")
(defvar archive-mode-map
(let ((map (make-keymap)))
(set-keymap-parent map special-mode-map)
@@ -393,6 +391,7 @@ file. Archive and member name will be added."
(define-key map "e" 'archive-extract)
(define-key map "f" 'archive-extract)
(define-key map "\C-m" 'archive-extract)
+ (define-key map "C" 'archive-copy-file)
(define-key map "m" 'archive-mark)
(define-key map "n" 'archive-next-line)
(define-key map "\C-n" 'archive-next-line)
@@ -428,11 +427,13 @@ file. Archive and member name will be added."
(cons "Immediate" (make-sparse-keymap "Immediate")))
(define-key map [menu-bar immediate alternate]
'(menu-item "Alternate Display" archive-alternate-display
- :enable (boundp (archive-name "alternate-display"))
:help "Toggle alternate file info display"))
(define-key map [menu-bar immediate view]
'(menu-item "View This File" archive-view
:help "Display file at cursor in View Mode"))
+ (define-key map [menu-bar immediate view]
+ '(menu-item "Copy This File" archive-copy-file
+ :help "Copy file at cursor to another location"))
(define-key map [menu-bar immediate display]
'(menu-item "Display in Other Window" archive-display-other-window
:help "Display file at cursor in another window"))
@@ -483,36 +484,58 @@ file. Archive and member name will be added."
:help "Delete all flagged files from archive"))
map)
"Local keymap for archive mode listings.")
-(defvar archive-file-name-indent nil "Column where file names start.")
+(defvar-local archive-file-name-indent nil "Column where file names start.")
-(defvar archive-remote nil "Non-nil if the archive is outside file system.")
-(make-variable-buffer-local 'archive-remote)
+(defvar-local archive-remote nil "Non-nil if the archive is outside file system.")
(put 'archive-remote 'permanent-local t)
-(defvar archive-member-coding-system nil "Coding-system of archive member.")
-(make-variable-buffer-local 'archive-member-coding-system)
+(defvar-local archive-member-coding-system nil "Coding-system of archive member.")
-(defvar archive-alternate-display nil
+(defvar-local archive-alternate-display nil
"Non-nil when alternate information is shown.")
-(make-variable-buffer-local 'archive-alternate-display)
(put 'archive-alternate-display 'permanent-local t)
(defvar archive-superior-buffer nil "In archive members, points to archive.")
(put 'archive-superior-buffer 'permanent-local t)
-(defvar archive-subfile-mode nil "Non-nil in archive member buffers.")
-(make-variable-buffer-local 'archive-subfile-mode)
+(defvar-local archive-subfile-mode nil
+ "Non-nil in archive member buffers.
+Its value is an `archive--file-desc'.")
(put 'archive-subfile-mode 'permanent-local t)
-(defvar archive-file-name-coding-system nil)
-(make-variable-buffer-local 'archive-file-name-coding-system)
+(defvar-local archive-file-name-coding-system nil)
(put 'archive-file-name-coding-system 'permanent-local t)
-(defvar archive-files nil
- "Vector of file descriptors.
-Each descriptor is a vector of the form
- [EXT-FILE-NAME INT-FILE-NAME CASE-FIDDLED MODE ...]")
-(make-variable-buffer-local 'archive-files)
+(cl-defstruct (archive--file-desc
+ (:constructor nil)
+ (:constructor archive--file-desc
+ ;; ext-file-name and int-file-name are usually `eq'
+ ;; except when int-file-name is the downcased
+ ;; ext-file-name.
+ (ext-file-name int-file-name mode size time
+ &key pos ratio uid gid)))
+ ext-file-name int-file-name
+ (mode nil :type integer)
+ (size nil :type integer)
+ (time nil :type string)
+ (ratio nil :type string)
+ uid gid
+ pos)
+
+;; Features in formats:
+;;
+;; ARC: size, date&time (date and time strings internally generated)
+;; LZH: size, date&time, mode, uid, gid (mode, date, time generated, ugid:int)
+;; ZIP: size, date&time, mode (mode, date, time generated)
+;; ZOO: size, date&time (date and time strings internally generated)
+;; AR : size, date&time, mode, user, group (internally generated)
+;; RAR: size, date&time, ratio (all as strings, using `lsar')
+;; 7Z : size, date&time (all as strings, using `7z' or `7za')
+;;
+;; LZH has alternate display (with UID/GID i.s.o MODE/DATE/TIME
+
+(defvar-local archive-files nil
+ "Vector of `archive--file-desc' objects.")
;; -------------------------------------------------------------------------
;;; Section: Support functions.
@@ -520,9 +543,9 @@ Each descriptor is a vector of the form
(defun arc-insert-unibyte (&rest args)
"Like insert but don't make unibyte string and eight-bit char multibyte."
(dolist (elt args)
- (if (integerp elt)
- (insert (if (< elt 128) elt (decode-char 'eight-bit elt)))
- (insert elt))))
+ (insert (if (and (integerp elt) (>= elt 128))
+ (decode-char 'eight-bit elt)
+ elt))))
(defsubst archive-name (suffix)
(intern (concat "archive-" (symbol-name archive-subtype) "-" suffix)))
@@ -544,73 +567,19 @@ in which case a second argument, length LEN, should be supplied."
(aref str (- len i)))))
result))
-(defun archive-int-to-mode (mode)
- "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------."
- ;; FIXME: merge with tar-grind-file-mode.
- (string
- (if (zerop (logand 8192 mode))
- (if (zerop (logand 16384 mode)) ?- ?d)
- ?c) ; completeness
- (if (zerop (logand 256 mode)) ?- ?r)
- (if (zerop (logand 128 mode)) ?- ?w)
- (if (zerop (logand 64 mode))
- (if (zerop (logand 2048 mode)) ?- ?S)
- (if (zerop (logand 2048 mode)) ?x ?s))
- (if (zerop (logand 32 mode)) ?- ?r)
- (if (zerop (logand 16 mode)) ?- ?w)
- (if (zerop (logand 8 mode))
- (if (zerop (logand 1024 mode)) ?- ?S)
- (if (zerop (logand 1024 mode)) ?x ?s))
- (if (zerop (logand 4 mode)) ?- ?r)
- (if (zerop (logand 2 mode)) ?- ?w)
- (if (zerop (logand 1 mode)) ?- ?x)))
-
-(defun archive-calc-mode (oldmode newmode &optional error)
+(define-obsolete-function-alias 'archive-int-to-mode
+ 'file-modes-number-to-symbolic "28.1")
+
+(defun archive-calc-mode (oldmode newmode)
"From the integer OLDMODE and the string NEWMODE calculate a new file mode.
NEWMODE may be an octal number including a leading zero in which case it
will become the new mode.\n
NEWMODE may also be a relative specification like \"og-rwx\" in which case
-OLDMODE will be modified accordingly just like chmod(2) would have done.\n
-If optional third argument ERROR is non-nil an error will be signaled if
-the mode is invalid. If ERROR is nil then nil will be returned."
- (cond ((string-match "^0[0-7]*$" newmode)
- (let ((result 0)
- (len (length newmode))
- (i 1))
- (while (< i len)
- (setq result (+ (ash result 3) (aref newmode i) (- ?0))
- i (1+ i)))
- (logior (logand oldmode 65024) result)))
- ((string-match "^\\([agou]+\\)\\([---+=]\\)\\([rwxst]+\\)$" newmode)
- (let ((who 0)
- (result oldmode)
- (op (aref newmode (match-beginning 2)))
- (bits 0)
- (i (match-beginning 3)))
- (while (< i (match-end 3))
- (let ((rwx (aref newmode i)))
- (setq bits (logior bits (cond ((= rwx ?r) 292)
- ((= rwx ?w) 146)
- ((= rwx ?x) 73)
- ((= rwx ?s) 3072)
- ((= rwx ?t) 512)))
- i (1+ i))))
- (while (< who (match-end 1))
- (let* ((whoc (aref newmode who))
- (whomask (cond ((= whoc ?a) 4095)
- ((= whoc ?u) 1472)
- ((= whoc ?g) 2104)
- ((= whoc ?o) 7))))
- (if (= op ?=)
- (setq result (logand result (lognot whomask))))
- (if (= op ?-)
- (setq result (logand result (lognot (logand whomask bits))))
- (setq result (logior result (logand whomask bits)))))
- (setq who (1+ who)))
- result))
- (t
- (if error
- (error "Invalid mode specification: %s" newmode)))))
+OLDMODE will be modified accordingly just like chmod(2) would have done."
+ ;; FIXME: Use `file-modes-symbolic-to-number'!
+ (if (string-match "\\`0[0-7]*\\'" newmode)
+ (logior (logand oldmode #o177000) (string-to-number newmode 8))
+ (file-modes-symbolic-to-number newmode oldmode)))
(defun archive-dosdate (date)
"Stringify dos packed DATE record."
@@ -622,7 +591,8 @@ the mode is invalid. If ERROR is nil then nil will be returned."
(format "%2d-%s-%d"
day
(aref ["Jan" "Feb" "Mar" "Apr" "May" "Jun"
- "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"] (1- month))
+ "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"]
+ (1- month))
year))))
(defun archive-dostime (time)
@@ -658,10 +628,12 @@ Does not signal an error if optional argument NOERROR is non-nil."
(if (and (>= (point) archive-file-list-start)
(< no (length archive-files)))
(let ((item (aref archive-files no)))
- (if (vectorp item)
+ (if (and (archive--file-desc-p item)
+ (let ((mode (archive--file-desc-mode item)))
+ (zerop (logand 16384 mode))))
item
(if (not noerror)
- (error "Entry is not a regular member of the archive"))))
+ (user-error "Entry is not a regular member of the archive"))))
(if (not noerror)
(error "Line does not describe a member of the archive")))))
;; -------------------------------------------------------------------------
@@ -684,41 +656,34 @@ archive.
;; mode on and off. You can corrupt things that way.
(if (zerop (buffer-size))
;; At present we cannot create archives from scratch
- (funcall (or (default-value 'major-mode) 'fundamental-mode))
+ (funcall (or (default-value 'major-mode) #'fundamental-mode))
(if (and (not force) archive-files) nil
(kill-all-local-variables)
(let* ((type (archive-find-type))
(typename (capitalize (symbol-name type))))
- (make-local-variable 'archive-subtype)
- (setq archive-subtype type)
+ (setq-local archive-subtype type)
;; Buffer contains treated image of file before the file contents
- (make-local-variable 'revert-buffer-function)
- (setq revert-buffer-function 'archive-mode-revert)
- (auto-save-mode 0)
+ (add-function :around (local 'revert-buffer-function)
+ #'archive--mode-revert)
- (add-hook 'write-contents-functions 'archive-write-file nil t)
+ (add-hook 'write-contents-functions #'archive-write-file nil t)
- (make-local-variable 'require-final-newline)
- (setq require-final-newline nil)
- (make-local-variable 'local-enable-local-variables)
- (setq local-enable-local-variables nil)
+ (setq-local truncate-lines t)
+ (setq-local require-final-newline nil)
+ (setq-local local-enable-local-variables nil)
;; Prevent loss of data when saving the file.
- (make-local-variable 'file-precious-flag)
- (setq file-precious-flag t)
+ (setq-local file-precious-flag t)
- (make-local-variable 'archive-read-only)
;; Archives which are inside other archives and whose
;; names are invalid for this OS, can't be written.
- (setq archive-read-only
- (or (not (file-writable-p (buffer-file-name)))
- (and archive-subfile-mode
- (string-match file-name-invalid-regexp
- (aref archive-subfile-mode 0)))))
-
- ;; Should we use a local copy when accessing from outside Emacs?
- (make-local-variable 'archive-local-name)
+ (setq-local archive-read-only
+ (or (not (file-writable-p (buffer-file-name)))
+ (and archive-subfile-mode
+ (string-match file-name-invalid-regexp
+ (archive--file-desc-ext-file-name
+ archive-subfile-mode)))))
;; An archive can contain another archive whose name is invalid
;; on local filesystem. Treat such archives as remote.
@@ -728,16 +693,12 @@ archive.
(string-match file-name-invalid-regexp
(buffer-file-name)))))
- (setq major-mode 'archive-mode)
+ (setq major-mode #'archive-mode)
(setq mode-name (concat typename "-Archive"))
;; Run archive-foo-mode-hook and archive-mode-hook
(run-mode-hooks (archive-name "mode-hook") 'archive-mode-hook)
(use-local-map archive-mode-map))
- (make-local-variable 'archive-proper-file-start)
- (make-local-variable 'archive-file-list-start)
- (make-local-variable 'archive-file-list-end)
- (make-local-variable 'archive-file-name-indent)
(setq archive-file-name-coding-system
(or file-name-coding-system
default-file-name-coding-system
@@ -803,7 +764,7 @@ when parsing the archive."
(let ((create-lockfiles nil) ; avoid changing dir mtime by lock_file
(inhibit-read-only t))
(setq archive-proper-file-start (copy-marker (point-min) t))
- (set (make-local-variable 'change-major-mode-hook) 'archive-desummarize)
+ (add-hook 'change-major-mode-hook #'archive-desummarize nil t)
(or shut-up
(message "Parsing archive file..."))
(buffer-disable-undo (current-buffer))
@@ -825,27 +786,35 @@ when parsing the archive."
(goto-char archive-file-list-start)
(archive-next-line no)))
+(cl-defstruct (archive--file-summary
+ (:constructor nil)
+ (:constructor archive--file-summary (text name-start name-end)))
+ text name-start name-end)
+
(defun archive-summarize-files (files)
"Insert a description of a list of files annotated with proper mouse face."
(setq archive-file-list-start (point-marker))
- (setq archive-file-name-indent (if files (aref (car files) 1) 0))
+ ;; Here we assume that they all start at the same column.
+ (setq archive-file-name-indent
+ ;; FIXME: We assume chars=columns (no double-wide chars and such).
+ (if files (archive--file-summary-name-start (car files)) 0))
;; We don't want to do an insert for each element since that takes too
;; long when the archive -- which has to be moved in memory -- is large.
(insert
- (apply
- #'concat
- (mapcar
- (lambda (fil)
- ;; Using `concat' here copies the text also, so we can add
- ;; properties without problems.
- (let ((text (concat (aref fil 0) "\n")))
- (add-text-properties
- (aref fil 1) (aref fil 2)
- '(mouse-face highlight
- help-echo "mouse-2: extract this file into a buffer")
- text)
- text))
- files)))
+ (mapconcat
+ (lambda (fil)
+ ;; Using `concat' here copies the text also, so we can add
+ ;; properties without problems.
+ (let ((text (concat (archive--file-summary-text fil) "\n")))
+ (add-text-properties
+ (archive--file-summary-name-start fil)
+ (archive--file-summary-name-end fil)
+ '(mouse-face highlight
+ help-echo "mouse-2: extract this file into a buffer")
+ text)
+ text))
+ files
+ ""))
(setq archive-file-list-end (point-marker)))
(defun archive-alternate-display ()
@@ -854,7 +823,27 @@ To avoid very long lines archive mode does not show all information.
This function changes the set of information shown for each files."
(interactive)
(setq archive-alternate-display (not archive-alternate-display))
+ (setq-local archive-hidden-columns
+ (if archive-alternate-display
+ archive-alternate-hidden-columns
+ (eval (car (or (get 'archive-hidden-columns 'customized-value)
+ (get 'archive-hidden-columns 'standard-value)))
+ t)))
(archive-resummarize))
+
+(defun archive-hideshow-column (column)
+ "Toggle visibility of COLUMN."
+ (interactive
+ (list (intern
+ (completing-read "Toggle visibility of: "
+ '(Mode Ids Ratio Date&Time)
+ nil t))))
+ (setq-local archive-hidden-columns
+ (if (memq column archive-hidden-columns)
+ (remove column archive-hidden-columns)
+ (cons column archive-hidden-columns)))
+ (archive-resummarize))
+
;; -------------------------------------------------------------------------
;;; Section: Local archive copy handling
@@ -899,7 +888,8 @@ using `make-temp-file', and the generated name is returned."
;; "foo.zip:bar.zip", which is invalid on DOS/Windows.
;; So use the actual name if available.
(archive-name
- (or (and archive-subfile-mode (aref archive-subfile-mode 0))
+ (or (and archive-subfile-mode (archive--file-desc-ext-file-name
+ archive-subfile-mode))
archive)))
(setq archive-local-name
(archive-unique-fname archive-name archive-tmpdir))
@@ -918,6 +908,7 @@ using `make-temp-file', and the generated name is returned."
(lno (archive-get-lineno))
(inhibit-read-only t))
(if unchanged nil
+ ;; FIXME: Use archive-resummarize?
(setq archive-files nil)
(erase-buffer)
(insert-file-contents name)
@@ -968,7 +959,7 @@ using `make-temp-file', and the generated name is returned."
(delete-file tmpfile)))))
(defun archive-file-name-handler (op &rest args)
- (or (eq op 'file-exists-p)
+ (or (eq op #'file-exists-p)
(let ((file-name-handler-alist nil))
(apply op args))))
@@ -1002,14 +993,83 @@ using `make-temp-file', and the generated name is returned."
(kill-local-variable 'buffer-file-coding-system)
(after-insert-file-set-coding (- (point-max) (point-min))))))
+(defun archive-goto-file (file)
+ "Go to FILE in the current buffer.
+FILE should be a relative file name. If FILE can't be found,
+return nil. Otherwise point is returned."
+ (let ((start (point))
+ found)
+ (goto-char (point-min))
+ (while (and (not found)
+ (not (eobp)))
+ (forward-line 1)
+ (when-let ((descr (archive-get-descr t)))
+ (when (equal (archive--file-desc-ext-file-name descr) file)
+ (setq found t))))
+ (if (not found)
+ (progn
+ (goto-char start)
+ nil)
+ (point))))
+
+(defun archive-next-file-displayer (file regexp n)
+ "Return a closure to display the next file after FILE that matches REGEXP."
+ (let ((short (replace-regexp-in-string "\\`.*:" "" file))
+ next)
+ (archive-goto-file short)
+ (while (and (not next)
+ ;; Stop if we reach the end/start of the buffer.
+ (if (> n 0)
+ (not (eobp))
+ (not (save-excursion
+ (beginning-of-line)
+ (bobp)))))
+ (archive-next-line n)
+ (when-let ((descr (archive-get-descr t)))
+ (let ((candidate (archive--file-desc-ext-file-name descr))
+ (buffer (current-buffer)))
+ (when (and candidate
+ (string-match-p regexp candidate))
+ (setq next (lambda ()
+ (kill-buffer (current-buffer))
+ (switch-to-buffer buffer)
+ (archive-extract)))))))
+ (unless next
+ ;; If we didn't find a next/prev file, then restore
+ ;; point.
+ (archive-goto-file short))
+ next))
+
+(defun archive-copy-file (file new-name)
+ "Copy FILE to a location specified by NEW-NAME.
+Interactively, FILE is the file at point, and the function prompts
+for NEW-NAME."
+ (interactive
+ (let ((name (archive--file-desc-ext-file-name (archive-get-descr))))
+ (list name
+ (read-file-name (format "Copy %s to: " name)))))
+ (when (file-directory-p new-name)
+ (setq new-name (expand-file-name file new-name)))
+ (when (and (file-exists-p new-name)
+ (not (yes-or-no-p (format "%s already exists; overwrite? "
+ new-name))))
+ (user-error "Not overwriting %s" new-name))
+ (let* ((descr (archive-get-descr))
+ (archive (buffer-file-name))
+ (extractor (archive-name "extract"))
+ (ename (archive--file-desc-ext-file-name descr)))
+ (with-temp-buffer
+ (archive--extract-file extractor archive ename)
+ (write-region (point-min) (point-max) new-name))))
+
(defun archive-extract (&optional other-window-p event)
"In archive mode, extract this entry of the archive into its own buffer."
(interactive (list nil last-input-event))
(if event (posn-set-point (event-end event)))
(let* ((view-p (eq other-window-p 'view))
(descr (archive-get-descr))
- (ename (aref descr 0))
- (iname (aref descr 1))
+ (ename (archive--file-desc-ext-file-name descr))
+ (iname (archive--file-desc-int-file-name descr))
(archive-buffer (current-buffer))
(arcdir default-directory)
(archive (buffer-file-name))
@@ -1038,32 +1098,12 @@ using `make-temp-file', and the generated name is returned."
(abbreviate-file-name buffer-file-name))
;; Set the default-directory to the dir of the superior buffer.
(setq default-directory arcdir)
- (make-local-variable 'archive-superior-buffer)
- (setq archive-superior-buffer archive-buffer)
+ (setq-local archive-superior-buffer archive-buffer)
(add-hook 'write-file-functions #'archive-write-file-member nil t)
(setq archive-subfile-mode descr)
(setq archive-file-name-coding-system file-name-coding)
(if (and
- (null
- (let (;; We may have to encode the file name argument for
- ;; external programs.
- (coding-system-for-write
- (and enable-multibyte-characters
- archive-file-name-coding-system))
- ;; We read an archive member by no-conversion at
- ;; first, then decode appropriately by calling
- ;; archive-set-buffer-as-visiting-file later.
- (coding-system-for-read 'no-conversion)
- ;; Avoid changing dir mtime by lock_file
- (create-lockfiles nil))
- (condition-case err
- (if (fboundp extractor)
- (funcall extractor archive ename)
- (archive-*-extract archive ename
- (symbol-value extractor)))
- (error
- (ding (message "%s" (error-message-string err)))
- nil))))
+ (null (archive--extract-file extractor archive ename))
just-created)
(progn
(set-buffer-modified-p nil)
@@ -1096,6 +1136,27 @@ using `make-temp-file', and the generated name is returned."
(other-window-p (switch-to-buffer-other-window buffer))
(t (switch-to-buffer buffer))))))
+(defun archive--extract-file (extractor archive ename)
+ (let (;; We may have to encode the file name argument for
+ ;; external programs.
+ (coding-system-for-write
+ (and enable-multibyte-characters
+ archive-file-name-coding-system))
+ ;; We read an archive member by no-conversion at
+ ;; first, then decode appropriately by calling
+ ;; archive-set-buffer-as-visiting-file later.
+ (coding-system-for-read 'no-conversion)
+ ;; Avoid changing dir mtime by lock_file
+ (create-lockfiles nil))
+ (condition-case err
+ (if (fboundp extractor)
+ (funcall extractor archive ename)
+ (archive-*-extract archive ename
+ (symbol-value extractor)))
+ (error
+ (ding (message "%s" (error-message-string err)))
+ nil))))
+
(defun archive-*-extract (archive name command)
(let* ((default-directory (file-name-as-directory archive-tmpdir))
(tmpfile (expand-file-name (file-name-nondirectory name)
@@ -1253,7 +1314,7 @@ using `make-temp-file', and the generated name is returned."
t)
(defun archive-*-write-file-member (archive descr command)
- (let* ((ename (aref descr 0))
+ (let* ((ename (archive--file-desc-ext-file-name descr))
(tmpfile (expand-file-name ename archive-tmpdir))
(top (directory-file-name (file-name-as-directory archive-tmpdir)))
(default-directory (file-name-as-directory top)))
@@ -1270,9 +1331,10 @@ using `make-temp-file', and the generated name is returned."
;; further processing clobbers it (we restore it in
;; archive-write-file-member, above).
(setq archive-member-coding-system last-coding-system-used)
- (if (aref descr 3)
+ (if (archive--file-desc-mode descr)
;; Set the file modes, but make sure we can read it.
- (set-file-modes tmpfile (logior ?\400 (aref descr 3))))
+ (set-file-modes tmpfile
+ (logior ?\400 (archive--file-desc-mode descr))))
(setq ename
(encode-coding-string ename archive-file-name-coding-system))
(let* ((coding-system-for-write 'no-conversion)
@@ -1376,7 +1438,7 @@ Use \\[archive-unmark-all-files] to remove all marks."
"Change the protection bits associated with all marked or this member.
The new protection bits can either be specified as an octal number or
as a relative change like \"g+rw\" as for chmod(2)."
- (interactive "sNew mode (octal or relative): ")
+ (interactive "sNew mode (octal or symbolic): ")
(if archive-read-only (error "Archive is read-only"))
(let ((func (archive-name "chmod-entry")))
(if (fboundp func)
@@ -1415,7 +1477,9 @@ as a relative change like \"g+rw\" as for chmod(2)."
(goto-char archive-file-list-start)
(while (< (point) archive-file-list-end)
(if (= (following-char) ?D)
- (setq files (cons (aref (archive-get-descr) 0) files)))
+ (setq files (cons (archive--file-desc-ext-file-name
+ (archive-get-descr))
+ files)))
(forward-line 1)))
(setq files (nreverse files))
(and files
@@ -1461,12 +1525,11 @@ as a relative change like \"g+rw\" as for chmod(2)."
(error "Renaming is not supported for this archive type"))))
;; Revert the buffer and recompute the dired-like listing.
-(defun archive-mode-revert (&optional _no-auto-save _no-confirm)
+(defun archive--mode-revert (orig-fun &rest args)
(let ((no (archive-get-lineno)))
(setq archive-files nil)
- (let ((revert-buffer-function nil)
- (coding-system-for-read 'no-conversion))
- (revert-buffer t t))
+ (let ((coding-system-for-read 'no-conversion))
+ (apply orig-fun t t (cddr args)))
(archive-mode)
(goto-char archive-file-list-start)
(archive-next-line no)))
@@ -1477,15 +1540,135 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(interactive)
(let ((inhibit-read-only t))
(undo)))
+
+(defun archive--fit (str len)
+ (let* ((spaces (- len (string-width str)))
+ (pre (/ spaces 2)))
+ (if (< spaces 1)
+ (substring str 0 len)
+ (concat (make-string pre ?\s) str (make-string (- spaces pre) ?\s)))))
+
+(defun archive--fit2 (str1 str2 len)
+ (let* ((spaces (- len (string-width str1) (string-width str2))))
+ (if (< spaces 1)
+ (substring (concat str1 str2) 0 len)
+ (concat str1 (make-string spaces ?\s) str2))))
+
+(defun archive--enabled-p (column)
+ (not (memq column archive-hidden-columns)))
+
+(defun archive--summarize-descs (descs)
+ (goto-char (point-min))
+ (if (null descs)
+ (progn (insert "M ... Filename\n")
+ (insert "- ----- ---------------\n")
+ (archive-summarize-files nil)
+ (insert "- ----- ---------------\n"))
+ (let* ((sample (car descs))
+ (maxsize 0)
+ (maxidlen 0)
+ (totalsize 0)
+ (times (archive--enabled-p 'Date&Time))
+ (ids (and (archive--enabled-p 'Ids)
+ (or (archive--file-desc-uid sample)
+ (archive--file-desc-gid sample))))
+ ;; For ratio, date/time, and mode, we presume that
+ ;; they're either present on all entries or on nonel, and that they
+ ;; take the same space on each of them.
+ (ratios (and (archive--enabled-p 'Ratio)
+ (archive--file-desc-ratio sample)))
+ (ratiolen (if ratios (string-width ratios)))
+ (timelen (length (archive--file-desc-time sample)))
+ (samplemode (and (archive--enabled-p 'Mode)
+ (archive--file-desc-mode sample)))
+ (modelen (length (if samplemode (file-modes-number-to-symbolic samplemode)))))
+ (dolist (desc descs)
+ (when ids
+ (let* ((uid (archive--file-desc-uid desc))
+ (gid (archive--file-desc-uid desc))
+ (len (cond
+ ((not uid) (string-width gid))
+ ((not gid) (string-width uid))
+ (t (+ (string-width uid) (string-width gid) 1)))))
+ (if (> len maxidlen) (setq maxidlen len))))
+ (let ((size (archive--file-desc-size desc)))
+ (cl-incf totalsize size)
+ (if (> size maxsize) (setq maxsize size))))
+ (let* ((sizelen (length (number-to-string maxsize)))
+ (dash
+ (concat
+ "- "
+ (if (> modelen 0) (concat (make-string modelen ?-) " "))
+ (if ids (concat (make-string maxidlen ?-) " "))
+ (make-string sizelen ?-) " "
+ (if ratios (concat (make-string (1+ ratiolen) ?-) " "))
+ " "
+ (if times (concat (make-string timelen ?-) " "))
+ "----------------\n"))
+ (startcol (+ 2
+ (if (> modelen 0) (+ 2 modelen) 0)
+ (if ids (+ maxidlen 2) 0)
+ sizelen 2
+ (if ratios (+ 2 ratiolen) 0)
+ (if times (+ timelen 2) 0))))
+ (insert
+ (concat "M "
+ (if (> modelen 0) (concat (archive--fit "Mode" modelen) " "))
+ (if ids (concat (archive--fit2 "Uid" "Gid" maxidlen) " "))
+ (archive--fit "Size" sizelen) " "
+ (if ratios (concat (archive--fit "Cmp" (1+ ratiolen)) " "))
+ " "
+ (if times (concat (archive--fit "Date&time" timelen) " "))
+ " Filename\n"))
+ (insert dash)
+ (archive-summarize-files
+ (mapcar (lambda (desc)
+ (let* ((size (number-to-string
+ (archive--file-desc-size desc)))
+ (text
+ (concat " "
+ (when (> modelen 0)
+ (concat (file-modes-number-to-symbolic
+ (archive--file-desc-mode desc))
+ " "))
+ (when ids
+ (concat (archive--fit2
+ (archive--file-desc-uid desc)
+ (archive--file-desc-gid desc)
+ maxidlen) " "))
+ (make-string (- sizelen (length size)) ?\s)
+ size
+ " "
+ (when ratios
+ (concat (archive--file-desc-ratio desc)
+ "% "))
+ " "
+ (when times
+ (concat (archive--file-desc-time desc)
+ " "))
+ (archive--file-desc-int-file-name desc))))
+ (archive--file-summary
+ text startcol (length text))))
+ descs))
+ (insert dash)
+ (insert (format (format "%%%dd %%s %%d files\n"
+ (+ 2
+ (if (> modelen 0) (+ 2 modelen) 0)
+ (if ids (+ maxidlen 2) 0)
+ sizelen))
+ totalsize
+ (make-string (+ (if times (+ 2 timelen) 0)
+ (if ratios (+ 2 ratiolen) 0) 1)
+ ?\s)
+ (length descs))))))
+ (apply #'vector descs))
+
;; -------------------------------------------------------------------------
;;; Section: Arc Archives
(defun archive-arc-summarize ()
(let ((p 1)
- (totalsize 0)
- (maxlen 8)
- files
- visual)
+ files)
(while (and (< (+ p 29) (point-max))
(= (get-byte p) ?\C-z)
(> (get-byte (1+ p)) 0))
@@ -1498,48 +1681,28 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(modtime (archive-l-e (+ p 21) 2))
(ucsize (archive-l-e (+ p 25) 4))
(fiddle (string= efnname (upcase efnname)))
- (ifnname (if fiddle (downcase efnname) efnname))
- (text (format " %8d %-11s %-8s %s"
- ucsize
- (archive-dosdate moddate)
- (archive-dostime modtime)
- ifnname)))
- (setq maxlen (max maxlen fnlen)
- totalsize (+ totalsize ucsize)
- visual (cons (vector text
- (- (length text) (length ifnname))
- (length text))
- visual)
- files (cons (vector efnname ifnname fiddle nil (1- p))
+ (ifnname (if fiddle (downcase efnname) efnname)))
+ (setq files (cons (archive--file-desc
+ efnname ifnname nil ucsize
+ (concat (archive-dosdate moddate)
+ " " (archive-dostime modtime))
+ :pos (1- p))
files)
p (+ p 29 csize))))
- (goto-char (point-min))
- (let ((dash (concat "- -------- ----------- -------- "
- (make-string maxlen ?-)
- "\n")))
- (insert "M Length Date Time File\n"
- dash)
- (archive-summarize-files (nreverse visual))
- (insert dash
- (format " %8d %d file%s"
- totalsize
- (length files)
- (if (= 1 (length files)) "" "s"))
- "\n"))
- (apply #'vector (nreverse files))))
+ (archive--summarize-descs (nreverse files))))
(defun archive-arc-rename-entry (newname descr)
(if (string-match "[:\\/]" newname)
(error "File names in arc files must not contain a directory component"))
(if (> (length newname) 12)
(error "File names in arc files are limited to 12 characters"))
- (let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0"
- (length newname))))
+ (let ((name (concat newname (make-string (- 13 (length newname)) ?\0)))
(inhibit-read-only t))
(save-restriction
(save-excursion
(widen)
- (goto-char (+ archive-proper-file-start (aref descr 4) 2))
+ (goto-char (+ archive-proper-file-start 2
+ (archive--file-desc-pos descr)))
(delete-char 13)
(arc-insert-unibyte name)))))
;; -------------------------------------------------------------------------
@@ -1547,10 +1710,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(defun archive-lzh-summarize (&optional start)
(let ((p (or start 1)) ;; 1 for .lzh, something further on for .exe
- (totalsize 0)
- (maxlen 8)
- files
- visual)
+ files)
(while (progn (goto-char p) ;beginning of a base header.
(looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-"))
(let* ((hsize (get-byte p)) ;size of the base header (level 0 and 1)
@@ -1561,9 +1721,9 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(time2 (archive-l-e (+ p 17) 2)) ;and UNIX format in level 2 header.)
(hdrlvl (get-byte (+ p 20))) ;header level
thsize ;total header size (base + extensions)
- fnlen efnname osid fiddle ifnname width p2
+ fnlen efnname osid fiddle ifnname p2
neh ;beginning of next extension header (level 1 and 2)
- mode modestr uid gid text dir prname
+ mode uid gid dir prname
gname uname modtime moddate)
(if (= hdrlvl 3) (error "can't handle lzh level 3 header type"))
(when (or (= hdrlvl 0) (= hdrlvl 1))
@@ -1576,26 +1736,26 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(setq neh (+ p2 3)) ;specific to level 1 header
(if (= hdrlvl 2)
(setq neh (+ p 24)))) ;specific to level 2 header
- (if neh ;if level 1 or 2 we expect extension headers to follow
+ (if neh ;if level 1 or 2 we expect extension headers to follow
(let* ((ehsize (archive-l-e neh 2)) ;size of the extension header
(etype (get-byte (+ neh 2)))) ;extension type
(while (not (= ehsize 0))
- (cond
- ((= etype 1) ;file name
+ (cond
+ ((= etype 1) ;file name
(let ((i (+ neh 3)))
(while (< i (+ neh ehsize))
(setq efnname (concat efnname (char-to-string (get-byte i))))
(setq i (1+ i)))))
- ((= etype 2) ;directory name
+ ((= etype 2) ;directory name
(let ((i (+ neh 3)))
(while (< i (+ neh ehsize))
- (setq dir (concat dir
- (if (= (get-byte i)
- 255)
- "/"
- (char-to-string
- (char-after i)))))
- (setq i (1+ i)))))
+ (setq dir (concat dir
+ (if (= (get-byte i)
+ 255)
+ "/"
+ (char-to-string
+ (char-after i)))))
+ (setq i (1+ i)))))
((= etype 80) ;Unix file permission
(setq mode (archive-l-e (+ neh 3) 2)))
((= etype 81) ;UNIX file group/user ID
@@ -1611,7 +1771,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(while (< i (+ neh ehsize))
(setq uname (concat uname (char-to-string (char-after i))))
(setq i (1+ i)))))
- )
+ )
(setq neh (+ neh ehsize))
(setq ehsize (archive-l-e neh 2))
(setq etype (get-byte (+ neh 2))))
@@ -1637,60 +1797,25 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
((= 0 osid) (string= efnname (upcase efnname)))))
(setq ifnname (if fiddle (downcase efnname) efnname))
(setq prname (if dir (concat dir ifnname) ifnname))
- (setq width (if prname (string-width prname) 0))
- (setq modestr (if mode (archive-int-to-mode mode) "??????????"))
(setq moddate (if (= hdrlvl 2)
(archive-unixdate time1 time2) ;level 2 header in UNIX format
(archive-dosdate time2))) ;level 0 and 1 header in DOS format
(setq modtime (if (= hdrlvl 2)
(archive-unixtime time1 time2)
(archive-dostime time1)))
- (setq text (if archive-alternate-display
- (format " %8d %5S %5S %s"
- ucsize
- (or uid "?")
- (or gid "?")
- ifnname)
- (format " %10s %8d %-11s %-8s %s"
- modestr
- ucsize
- moddate
- modtime
- prname)))
- (setq maxlen (max maxlen width)
- totalsize (+ totalsize ucsize)
- visual (cons (vector text
- (- (length text) (length prname))
- (length text))
- visual)
- files (cons (vector prname ifnname fiddle mode (1- p))
- files))
+ (push (archive--file-desc
+ prname ifnname mode ucsize
+ (concat moddate " " modtime)
+ :pos (1- p)
+ :uid (or uname (if uid (number-to-string uid)))
+ :gid (or gname (if gid (number-to-string gid))))
+ files)
(cond ((= hdrlvl 1)
(setq p (+ p hsize 2 csize)))
((or (= hdrlvl 2) (= hdrlvl 0))
(setq p (+ p thsize 2 csize))))
))
- (goto-char (point-min))
- (let ((dash (concat (if archive-alternate-display
- "- -------- ----- ----- "
- "- ---------- -------- ----------- -------- ")
- (make-string maxlen ?-)
- "\n"))
- (header (if archive-alternate-display
- "M Length Uid Gid File\n"
- "M Filemode Length Date Time File\n"))
- (sumline (if archive-alternate-display
- " %8.0f %d file%s"
- " %8.0f %d file%s")))
- (insert header dash)
- (archive-summarize-files (nreverse visual))
- (insert dash
- (format sumline
- totalsize
- (length files)
- (if (= 1 (length files)) "" "s"))
- "\n"))
- (apply #'vector (nreverse files))))
+ (archive--summarize-descs (nreverse files))))
(defconst archive-lzh-alternate-display t)
@@ -1709,7 +1834,8 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(save-restriction
(save-excursion
(widen)
- (let* ((p (+ archive-proper-file-start (aref descr 4)))
+ (let* ((p (+ archive-proper-file-start
+ (archive--file-desc-pos descr)))
(oldhsize (get-byte p))
(oldfnlen (get-byte (+ p 21)))
(newfnlen (length newname))
@@ -1729,7 +1855,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(save-restriction
(widen)
(dolist (fil files)
- (let* ((p (+ archive-proper-file-start (aref fil 4)))
+ (let* ((p (+ archive-proper-file-start (archive--file-desc-pos fil)))
(hsize (get-byte p))
(fnlen (get-byte (+ p 21)))
(p2 (+ p 22 fnlen))
@@ -1746,7 +1872,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(delete-char 1)
(arc-insert-unibyte (archive-lzh-resum (1+ p) hsize)))
(message "Member %s does not have %s field"
- (aref fil 1) errtxt)))))))
+ (archive--file-desc-int-file-name fil) errtxt)))))))
(defun archive-lzh-chown-entry (newuid files)
(archive-lzh-ogm newuid files "an uid" 10))
@@ -1756,8 +1882,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(defun archive-lzh-chmod-entry (newmode files)
(archive-lzh-ogm
- ;; This should work even though newmode will be dynamically accessed.
- (lambda (old) (archive-calc-mode old newmode t))
+ (lambda (old) (archive-calc-mode old newmode))
files "a unix-style mode" 8))
;; -------------------------------------------------------------------------
@@ -1794,11 +1919,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(goto-char (- (point-max) (- 22 18)))
(search-backward-regexp "[P]K\005\006")
(let ((p (archive-l-e (+ (point) 16) 4))
- (maxlen 8)
- (totalsize 0)
- files
- visual
- emacs-int-has-32bits)
+ files)
(when (or (= p #xffffffff) (= p -1))
;; If the offset of end-of-central-directory is 0xFFFFFFFF, this
;; is a Zip64 extended ZIP file format, and we need to glean the
@@ -1824,7 +1945,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(fnlen (archive-l-e (+ p 28) 2))
(exlen (archive-l-e (+ p 30) 2))
(fclen (archive-l-e (+ p 32) 2))
- (lheader (archive-l-e (+ p 42) 4))
+ ;; (lheader (archive-l-e (+ p 42) 4))
(efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen))))
(decode-coding-string
str archive-file-name-coding-system)))
@@ -1848,44 +1969,18 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(logand 1 (get-byte (+ p 38))))
?\222 0)))
(t nil)))
- (modestr (if mode (archive-int-to-mode mode) "??????????"))
(fiddle (and archive-zip-case-fiddle
- (not (not (memq creator '(0 2 4 5 9))))
+ (memq creator '(0 2 4 5 9))
(string= (upcase efnname) efnname)))
- (ifnname (if fiddle (downcase efnname) efnname))
- (width (string-width ifnname))
- (text (format " %10s %8d %-11s %-8s %s"
- modestr
- ucsize
- (archive-dosdate moddate)
- (archive-dostime modtime)
- ifnname)))
- (setq maxlen (max maxlen width)
- totalsize (+ totalsize ucsize)
- visual (cons (vector text
- (- (length text) (length ifnname))
- (length text))
- visual)
- files (cons (if isdir
- nil
- (vector efnname ifnname fiddle mode
- (list (1- p) lheader)))
- files)
+ (ifnname (if fiddle (downcase efnname) efnname)))
+ (setq files (cons (archive--file-desc
+ efnname ifnname mode ucsize
+ (concat (archive-dosdate moddate)
+ " " (archive-dostime modtime))
+ :pos (1- p))
+ files)
p (+ p 46 fnlen exlen fclen))))
- (goto-char (point-min))
- (let ((dash (concat "- ---------- -------- ----------- -------- "
- (make-string maxlen ?-)
- "\n")))
- (insert "M Filemode Length Date Time File\n"
- dash)
- (archive-summarize-files (nreverse visual))
- (insert dash
- (format " %8d %d file%s"
- totalsize
- (length files)
- (if (= 1 (length files)) "" "s"))
- "\n"))
- (apply #'vector (nreverse files))))
+ (archive--summarize-descs (nreverse files))))
(defun archive-zip-extract (archive name)
(cond
@@ -1910,21 +2005,27 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
name)
archive-zip-extract))))
+(defun archive--file-desc-case-fiddled (fd)
+ (not (eq (archive--file-desc-int-file-name fd)
+ (archive--file-desc-ext-file-name fd))))
+
(defun archive-zip-write-file-member (archive descr)
(archive-*-write-file-member
archive
descr
- (if (aref descr 2) archive-zip-update-case archive-zip-update)))
+ (if (archive--file-desc-case-fiddled descr)
+ archive-zip-update-case archive-zip-update)))
(defun archive-zip-chmod-entry (newmode files)
(save-restriction
(save-excursion
(widen)
(dolist (fil files)
- (let* ((p (+ archive-proper-file-start (car (aref fil 4))))
+ (let* ((p (+ archive-proper-file-start
+ (archive--file-desc-pos fil)))
(creator (get-byte (+ p 5)))
- (oldmode (aref fil 3))
- (newval (archive-calc-mode oldmode newmode t))
+ (oldmode (archive--file-desc-mode fil))
+ (newval (archive-calc-mode oldmode newmode))
(inhibit-read-only t))
(cond ((memq creator '(2 3)) ; Unix
(goto-char (+ p 40))
@@ -1943,10 +2044,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(defun archive-zoo-summarize ()
(let ((p (1+ (archive-l-e 25 4)))
- (maxlen 8)
- (totalsize 0)
- files
- visual)
+ files)
(while (and (string= "\334\247\304\375" (buffer-substring p (+ p 4)))
(> (archive-l-e (+ p 6) 4) 0))
(let* ((next (1+ (archive-l-e (+ p 6) 4)))
@@ -1973,36 +2071,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(decode-coding-string
str archive-file-name-coding-system)))
(fiddle (and (= lfnlen 0) (string= efnname (upcase efnname))))
- (ifnname (if fiddle (downcase efnname) efnname))
- (width (string-width ifnname))
- (text (format " %8d %-11s %-8s %s"
- ucsize
- (archive-dosdate moddate)
- (archive-dostime modtime)
- ifnname)))
- (setq maxlen (max maxlen width)
- totalsize (+ totalsize ucsize)
- visual (cons (vector text
- (- (length text) (length ifnname))
- (length text))
- visual)
- files (cons (vector efnname ifnname fiddle nil (1- p))
+ (ifnname (if fiddle (downcase efnname) efnname)))
+ (setq files (cons (archive--file-desc
+ efnname ifnname nil ucsize
+ (concat (archive-dosdate moddate)
+ " " (archive-dostime modtime)))
files)
p next)))
- (goto-char (point-min))
- (let ((dash (concat "- -------- ----------- -------- "
- (make-string maxlen ?-)
- "\n")))
- (insert "M Length Date Time File\n"
- dash)
- (archive-summarize-files (nreverse visual))
- (insert dash
- (format " %8d %d file%s"
- totalsize
- (length files)
- (if (= 1 (length files)) "" "s"))
- "\n"))
- (apply #'vector (nreverse files))))
+ (archive--summarize-descs (nreverse files))))
(defun archive-zoo-extract (archive name)
(archive-extract-by-stdout archive name archive-zoo-extract))
@@ -2014,17 +2090,16 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
;; File is used internally for `archive-rar-exe-summarize'.
(unless file (setq file buffer-file-name))
(let* ((copy (file-local-copy file))
- (maxname 10)
- (maxsize 5)
(files ()))
(with-temp-buffer
- (call-process "lsar" nil t nil "-l" (or file copy))
- (if copy (delete-file copy))
+ (unwind-protect
+ (call-process "lsar" nil t nil "-l" (or file copy))
+ (if copy (delete-file copy)))
(goto-char (point-min))
- (re-search-forward "^\\(\s+=+\s*\\)+\n")
+ (re-search-forward "^\\(?:\s+=+\\)+\s*\n")
(while (looking-at (concat "^\s+[0-9.]+\s+D?-+\s+" ; Flags
"\\([0-9-]+\\)\s+" ; Size
- "\\([-0-9.%]+\\)\s+" ; Ratio
+ "\\([-0-9.]+\\)%?\s+" ; Ratio
"\\([0-9a-zA-Z]+\\)\s+" ; Mode
"\\([0-9-]+\\)\s+" ; Date
"\\([0-9:]+\\)\s+" ; Time
@@ -2033,36 +2108,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(goto-char (match-end 0))
(let ((name (match-string 6))
(size (match-string 1)))
- (if (> (length name) maxname) (setq maxname (length name)))
- (if (> (length size) maxsize) (setq maxsize (length size)))
- (push (vector name name nil nil
- ;; Size, Ratio.
- size (match-string 2)
- ;; Date, Time.
- (match-string 4) (match-string 5))
+ (push (archive--file-desc name name nil
+ ;; Size
+ (string-to-number size)
+ ;; Date&Time.
+ (concat (match-string 4) " " (match-string 5))
+ :ratio (match-string 2))
files))))
- (setq files (nreverse files))
- (goto-char (point-min))
- (let* ((format (format " %%s %%s %%%ds %%5s %%s" maxsize))
- (sep (format format "----------" "-----" (make-string maxsize ?-)
- "-----" ""))
- (column (length sep)))
- (insert (format format " Date " "Time " "Size" "Ratio" "Filename") "\n")
- (insert sep (make-string maxname ?-) "\n")
- (archive-summarize-files (mapcar (lambda (desc)
- (let ((text
- (format format
- (aref desc 6)
- (aref desc 7)
- (aref desc 4)
- (aref desc 5)
- (aref desc 1))))
- (vector text
- column
- (length text))))
- files))
- (insert sep (make-string maxname ?-) "\n")
- (apply #'vector files))))
+ (archive--summarize-descs (nreverse files))))
(defun archive-rar-extract (archive name)
;; unrar-free seems to have no way to extract to stdout or even to a file.
@@ -2109,9 +2162,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
;;; Section: 7z Archives
(defun archive-7z-summarize ()
- (let ((maxname 10)
- (maxsize 5)
- (file buffer-file-name)
+ (let ((file buffer-file-name)
(files ()))
(with-temp-buffer
(call-process archive-7z-program nil t nil "l" "-slt" file)
@@ -2128,29 +2179,9 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(time (save-excursion
(and (re-search-forward "^Modified = \\(.*\\)\n")
(match-string 1)))))
- (if (> (length name) maxname) (setq maxname (length name)))
- (if (> (length size) maxsize) (setq maxsize (length size)))
- (push (vector name name nil nil time nil nil size)
+ (push (archive--file-desc name name nil (string-to-number size) time)
files))))
- (setq files (nreverse files))
- (goto-char (point-min))
- (let* ((format (format " %%%ds %%s %%s" maxsize))
- (sep (format format (make-string maxsize ?-) "-------------------" ""))
- (column (length sep)))
- (insert (format format "Size " "Date Time " " Filename") "\n")
- (insert sep (make-string maxname ?-) "\n")
- (archive-summarize-files (mapcar (lambda (desc)
- (let ((text
- (format format
- (aref desc 7)
- (aref desc 4)
- (aref desc 1))))
- (vector text
- column
- (length text))))
- files))
- (insert sep (make-string maxname ?-) "\n")
- (apply #'vector files))))
+ (archive--summarize-descs (nreverse files))))
(defun archive-7z-extract (archive name)
;; 7z doesn't provide a `quiet' option to suppress non-essential
@@ -2177,79 +2208,43 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(defconst archive-ar-file-header-re
"\\(.\\{16\\}\\)\\([ 0-9]\\{12\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-7]\\{8\\}\\)\\([ 0-9]\\{10\\}\\)`\n")
+(defun archive-ar--name (name)
+ "Return the external name represented by the entry NAME.
+NAME is expected to be the 16-bytes part of an ar record."
+ (cond ((equal name "// ")
+ (propertize ".<ExtNamesTable>." 'face 'italic))
+ ((equal name "/ ")
+ (propertize ".<LookupTable>." 'face 'italic))
+ ((string-match "/? *\\'" name)
+ ;; FIXME: Decode? Add support for longer names?
+ (substring name 0 (match-beginning 0)))))
+
(defun archive-ar-summarize ()
;; File is used internally for `archive-rar-exe-summarize'.
- (let* ((maxname 10)
- (maxtime 16)
- (maxuser 5)
- (maxgroup 5)
- (maxmode 8)
- (maxsize 5)
- (files ()))
+ (let* ((files ()))
(goto-char (point-min))
(search-forward "!<arch>\n")
(while (looking-at archive-ar-file-header-re)
- (let ((name (match-string 1))
- extname
- (time (string-to-number (match-string 2)))
- (user (match-string 3))
- (group (match-string 4))
- (mode (string-to-number (match-string 5) 8))
- (size (string-to-number (match-string 6))))
+ (let* ((name (match-string 1))
+ extname
+ (time (string-to-number (match-string 2)))
+ (user (match-string 3))
+ (group (match-string 4))
+ (mode (string-to-number (match-string 5) 8))
+ (sizestr (match-string 6))
+ (size (string-to-number sizestr)))
;; Move to the beginning of the data.
(goto-char (match-end 0))
(setq time (format-time-string "%Y-%m-%d %H:%M" time))
- (setq extname
- (cond ((equal name "// ")
- (propertize ".<ExtNamesTable>." 'face 'italic))
- ((equal name "/ ")
- (propertize ".<LookupTable>." 'face 'italic))
- ((string-match "/? *\\'" name)
- (substring name 0 (match-beginning 0)))))
+ (setq extname (archive-ar--name name))
(setq user (substring user 0 (string-match " +\\'" user)))
(setq group (substring group 0 (string-match " +\\'" group)))
- (setq mode (tar-grind-file-mode mode))
;; Move to the end of the data.
(forward-char size) (if (eq ?\n (char-after)) (forward-char 1))
- (setq size (number-to-string size))
- (if (> (length name) maxname) (setq maxname (length name)))
- (if (> (length time) maxtime) (setq maxtime (length time)))
- (if (> (length user) maxuser) (setq maxuser (length user)))
- (if (> (length group) maxgroup) (setq maxgroup (length group)))
- (if (> (length mode) maxmode) (setq maxmode (length mode)))
- (if (> (length size) maxsize) (setq maxsize (length size)))
- (push (vector name extname nil mode
- time user group size)
+ (push (archive--file-desc extname extname mode size time
+ :uid user :gid group)
files)))
- (setq files (nreverse files))
- (goto-char (point-min))
- (let* ((format (format "%%%ds %%%ds/%%-%ds %%%ds %%%ds %%s"
- maxmode maxuser maxgroup maxsize maxtime))
- (sep (format format (make-string maxmode ?-)
- (make-string maxuser ?-)
- (make-string maxgroup ?-)
- (make-string maxsize ?-)
- (make-string maxtime ?-) ""))
- (column (length sep)))
- (insert (format format " Mode " "User" "Group" " Size "
- " Date " "Filename")
- "\n")
- (insert sep (make-string maxname ?-) "\n")
- (archive-summarize-files (mapcar (lambda (desc)
- (let ((text
- (format format
- (aref desc 3)
- (aref desc 5)
- (aref desc 6)
- (aref desc 7)
- (aref desc 4)
- (aref desc 1))))
- (vector text
- column
- (length text))))
- files))
- (insert sep (make-string maxname ?-) "\n")
- (apply #'vector files))))
+ (archive--summarize-descs (nreverse files))))
(defun archive-ar-extract (archive name)
(let ((destbuf (current-buffer))
@@ -2266,10 +2261,11 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(let ((this (match-string 1)))
(setq size (string-to-number (match-string 6)))
(goto-char (match-end 0))
- (if (equal name this)
+ (if (equal name (archive-ar--name this))
(setq from (point))
;; Move to the end of the data.
- (forward-char size) (if (eq ?\n (char-after)) (forward-char 1)))))
+ (forward-char size)
+ (if (eq ?\n (char-after)) (forward-char 1)))))
(when from
(set-buffer-multibyte nil)
(with-current-buffer destbuf
@@ -2279,6 +2275,13 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
;; Inform the caller that the call succeeded.
t))))))
+(defun archive-ar-write-file-member (archive descr)
+ (archive-*-write-file-member
+ archive
+ descr
+ '("ar" "r")))
+
+
;; -------------------------------------------------------------------------
;; This line was a mistake; it is kept now for compatibility.
;; rms 15 Oct 98
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 7a0e09b9e8e..50795ce7946 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -2073,7 +2073,9 @@ entries for git.gnus.org:
(setcar
(cdr secret)
(let ((v (car (cdr secret))))
- (lambda () v))))
+ (if (functionp v)
+ (lambda () (funcall v plist))
+ (lambda () v)))))
plist))
items))
;; ensure each item has each key in `returned-keys'
diff --git a/lisp/autoarg.el b/lisp/autoarg.el
index c0307aa92b1..d41527775f4 100644
--- a/lisp/autoarg.el
+++ b/lisp/autoarg.el
@@ -1,4 +1,4 @@
-;;; autoarg.el --- make digit keys supply prefix args
+;;; autoarg.el --- make digit keys supply prefix args -*- lexical-binding: t -*-
;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
@@ -59,9 +59,8 @@
;; (define-key autoarg-mode-map [?\r] 'autoarg-terminate)
(defvar autoarg-kp-digits
- (let (alist)
- (dotimes (i 10 alist)
- (push (cons (intern (format "kp-%d" i)) i) alist))))
+ (mapcar (lambda (i) (cons (intern (format "kp-%d" i)) i))
+ (reverse (number-sequence 0 9))))
(defun autoarg-kp-digit-argument (arg)
"Part of the numeric argument for the next command, like `digit-argument'."
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index 25961d41089..4af3d631a2c 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -396,7 +396,7 @@ Matches the visited file name against the elements of `auto-insert-alist'."
;; which might ask the user for something
(switch-to-buffer (current-buffer))
(if (and (consp action)
- (not (eq (car action) 'lambda)))
+ (not (functionp action)))
(skeleton-insert action)
(funcall action)))))
(if (vectorp action)
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 011febfe728..046ea2b5d6a 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -242,6 +242,8 @@ For more information, see Info node `(emacs)Autorevert'."
:tag "Load Hook"
:group 'auto-revert
:type 'hook)
+(make-obsolete-variable 'auto-revert-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom auto-revert-check-vc-info nil
"If non-nil Auto-Revert Mode reliably updates version control info.
@@ -869,6 +871,62 @@ This is an internal function used by Auto-Revert Mode."
(restore-buffer-modified-p modified)))
(set-visited-file-modtime))
+(defun auto-revert--buffer-candidates ()
+ "Return a prioritized list of buffers to maybe auto-revert.
+The differences between this return value and the reference
+variable `auto-revert-buffer-list' include: 1) this has more
+entries when in global-auto-revert-mode; 2) this prioritizes
+buffers not reverted last time due to user interruption. "
+ (let ((bufs (delq nil
+ ;; Buffers with remote contents shall be reverted only
+ ;; if the connection is established already.
+ (mapcar
+ (lambda (buf)
+ (and (buffer-live-p buf)
+ (with-current-buffer buf
+ (and
+ (or (not (file-remote-p default-directory))
+ (file-remote-p default-directory nil t))
+ buf))))
+ (auto-revert--polled-buffers))))
+ remaining new)
+ ;; Partition `bufs' into two halves depending on whether or not
+ ;; the buffers are in `auto-revert-remaining-buffers'. The two
+ ;; halves are then re-joined with the "remaining" buffers at the
+ ;; head of the list.
+ (dolist (buf auto-revert-remaining-buffers)
+ (when (memq buf bufs)
+ (push buf remaining)))
+ (dolist (buf bufs)
+ (unless (memq buf remaining)
+ (push buf new)))
+ (nreverse (nconc new remaining))))
+
+(defun auto-revert-buffer (buf)
+ "Revert a single buffer.
+
+This is performed as specified by Auto-Revert and Global
+Auto-Revert Modes."
+ (if (not (buffer-live-p buf))
+ (auto-revert-remove-current-buffer buf)
+ (with-current-buffer buf
+ ;; Test if someone has turned off Auto-Revert Mode
+ ;; in a non-standard way, for example by changing
+ ;; major mode.
+ (when (and (not auto-revert-mode)
+ (not auto-revert-tail-mode))
+ (auto-revert-remove-current-buffer))
+ (when (auto-revert-active-p)
+ ;; Enable file notification.
+ ;; Don't bother creating a notifier for non-file buffers
+ ;; unless it explicitly indicates that this works.
+ (when (and auto-revert-use-notify
+ (not auto-revert-notify-watch-descriptor)
+ (or buffer-file-name
+ buffer-auto-revert-by-notification))
+ (auto-revert-notify-add-watch))
+ (auto-revert-handler)))))
+
(defun auto-revert-buffers ()
"Revert buffers as specified by Auto-Revert and Global Auto-Revert Mode.
@@ -892,67 +950,19 @@ are checked first the next time this function is called.
This function is also responsible for removing buffers no longer in
Auto-Revert Mode from `auto-revert-buffer-list', and for canceling
the timer when no buffers need to be checked."
-
(save-match-data
- (let ((bufs (auto-revert--polled-buffers))
- remaining new)
- ;; Buffers with remote contents shall be reverted only if the
- ;; connection is established already.
- (setq bufs (delq nil
- (mapcar
- (lambda (buf)
- (and (buffer-live-p buf)
- (with-current-buffer buf
- (and
- (or (not (file-remote-p default-directory))
- (file-remote-p default-directory nil t))
- buf))))
- bufs)))
- ;; Partition `bufs' into two halves depending on whether or not
- ;; the buffers are in `auto-revert-remaining-buffers'. The two
- ;; halves are then re-joined with the "remaining" buffers at the
- ;; head of the list.
- (dolist (buf auto-revert-remaining-buffers)
- (if (memq buf bufs)
- (push buf remaining)))
- (dolist (buf bufs)
- (if (not (memq buf remaining))
- (push buf new)))
- (setq bufs (nreverse (nconc new remaining)))
+ (let ((bufs (auto-revert--buffer-candidates)))
(while (and bufs
(not (and auto-revert-stop-on-user-input
(input-pending-p))))
- (let ((buf (car bufs)))
- (if (not (buffer-live-p buf))
- ;; Remove dead buffer from `auto-revert-buffer-list'.
- (auto-revert-remove-current-buffer buf)
- (with-current-buffer buf
- ;; Test if someone has turned off Auto-Revert Mode
- ;; in a non-standard way, for example by changing
- ;; major mode.
- (if (and (not auto-revert-mode)
- (not auto-revert-tail-mode)
- (memq buf auto-revert-buffer-list))
- (auto-revert-remove-current-buffer))
- (when (auto-revert-active-p)
- ;; Enable file notification.
- ;; Don't bother creating a notifier for non-file buffers
- ;; unless it explicitly indicates that this works.
- (when (and auto-revert-use-notify
- (not auto-revert-notify-watch-descriptor)
- (or buffer-file-name
- buffer-auto-revert-by-notification))
- (auto-revert-notify-add-watch))
- (auto-revert-handler)))))
- (setq bufs (cdr bufs)))
+ (auto-revert-buffer (pop bufs)))
(setq auto-revert-remaining-buffers bufs)
;; Check if we should cancel the timer.
(unless (auto-revert--need-polling-p)
- (if (timerp auto-revert-timer)
- (cancel-timer auto-revert-timer))
+ (when (timerp auto-revert-timer)
+ (cancel-timer auto-revert-timer))
(setq auto-revert-timer nil)))))
-
;; The end:
(provide 'autorevert)
diff --git a/lisp/battery.el b/lisp/battery.el
index 1d3390070c3..e568ab52460 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -1,8 +1,9 @@
-;;; battery.el --- display battery status information
+;;; battery.el --- display battery status information -*- lexical-binding:t -*-
;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc.
;; Author: Ralph Schleicher <rs@ralph-schleicher.de>
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: hardware
;; This file is part of GNU Emacs.
@@ -22,15 +23,19 @@
;;; Commentary:
-;; There is at present support for GNU/Linux, macOS and Windows. This
-;; library supports both the `/proc/apm' file format of Linux version
-;; 1.3.58 or newer and the `/proc/acpi/' directory structure of Linux
-;; 2.4.20 and 2.6. Darwin (macOS) is supported by using the `pmset'
-;; program. Windows is supported by the GetSystemPowerStatus API call.
+;; There is at present support for GNU/Linux, BSD, macOS, and Windows.
+;; This library supports:
+;; - UPower (https://upower.freedesktop.org) via D-Bus API.
+;; - The `/sys/class/power_supply/' files of Linux >= 2.6.39.
+;; - The `/proc/acpi/' directory structure of Linux 2.4.20 and 2.6.
+;; - The `/proc/apm' file format of Linux version 1.3.58 or newer.
+;; - BSD by using the `apm' program.
+;; - Darwin (macOS) by using the `pmset' program.
+;; - Windows via the GetSystemPowerStatus API call.
;;; Code:
-(require 'timer)
+(require 'dbus)
(eval-when-compile (require 'cl-lib))
(defgroup battery nil
@@ -38,41 +43,75 @@
:prefix "battery-"
:group 'hardware)
-(defcustom battery-upower-device "battery_BAT1"
- "Upower battery device name."
- :version "26.1"
- :type 'string
- :group 'battery)
+(defcustom battery-upower-device nil
+ "Preferred UPower device name(s).
+When `battery-status-function' is set to `battery-upower', this
+user option specifies which power sources to query for status
+information and merge into a single report.
+
+When nil (the default), `battery-upower' queries all present
+battery and line power devices as determined by the UPower
+EnumerateDevices method. A string or a nonempty list of strings
+names particular devices to query instead. UPower battery and
+line power device names typically follow the patterns
+\"battery_BATN\" and \"line_power_ACN\", respectively, with N
+starting at 0 when present. Device names should not include the
+leading D-Bus path \"/org/freedesktop/UPower/devices/\"."
+ :version "28.1"
+ :type '(choice (const :tag "Autodetect all devices" nil)
+ (string :tag "Device")
+ (repeat :tag "Devices" string)))
+
+(defcustom battery-upower-subscribe t
+ "Whether to subscribe to UPower device change signals.
+When nil, battery status information is polled every
+`battery-update-interval' seconds. When non-nil (the default),
+the battery status is also updated whenever a power source is
+added or removed, or when the system starts or stops running on
+battery power.
+
+This only takes effect when `battery-status-function' is set to
+`battery-upower' before enabling `display-battery-mode'."
+ :version "28.1"
+ :type 'boolean)
+
+(defconst battery-upower-service "org.freedesktop.UPower"
+ "Well-known name of the UPower D-Bus service.
+See URL `https://upower.freedesktop.org/docs/ref-dbus.html'.")
+
+(defun battery--files (dir)
+ "Return a list of absolute file names in DIR or nil on error.
+Value does not include \".\" or \"..\"."
+ (ignore-errors (directory-files dir t directory-files-no-dot-files-regexp)))
(defun battery--find-linux-sysfs-batteries ()
- (let ((dirs nil))
- (dolist (file (directory-files "/sys/class/power_supply/" t))
- (when (and (or (file-directory-p file)
- (file-symlink-p file))
- (file-exists-p (expand-file-name "capacity" file)))
- (push file dirs)))
+ "Return a list of all sysfs battery directories."
+ (let (dirs)
+ (dolist (dir (battery--files "/sys/class/power_supply/"))
+ (when (file-exists-p (expand-file-name "capacity" dir))
+ (push dir dirs)))
(nreverse dirs)))
(defcustom battery-status-function
- (cond ((and (eq system-type 'gnu/linux)
- (file-readable-p "/proc/apm"))
- #'battery-linux-proc-apm)
+ (cond ((member battery-upower-service (dbus-list-activatable-names))
+ #'battery-upower)
+ ((and (eq system-type 'gnu/linux)
+ (battery--find-linux-sysfs-batteries))
+ #'battery-linux-sysfs)
((and (eq system-type 'gnu/linux)
(file-directory-p "/proc/acpi/battery"))
#'battery-linux-proc-acpi)
((and (eq system-type 'gnu/linux)
- (file-directory-p "/sys/class/power_supply/")
- (battery--find-linux-sysfs-batteries))
- #'battery-linux-sysfs)
+ (file-readable-p "/proc/apm"))
+ #'battery-linux-proc-apm)
((and (eq system-type 'berkeley-unix)
(file-executable-p "/usr/sbin/apm"))
#'battery-bsd-apm)
((and (eq system-type 'darwin)
- (condition-case nil
- (with-temp-buffer
- (and (eq (call-process "pmset" nil t nil "-g" "ps") 0)
- (> (buffer-size) 0)))
- (error nil)))
+ (ignore-errors
+ (with-temp-buffer
+ (and (eq (call-process "pmset" nil t nil "-g" "ps") 0)
+ (not (bobp))))))
#'battery-pmset)
((fboundp 'w32-battery-status)
#'w32-battery-status))
@@ -84,8 +123,8 @@ Its cons cells are of the form
CONVERSION is the character code of a \"conversion specification\"
introduced by a `%' character in a control string."
- :type '(choice (const nil) function)
- :group 'battery)
+ :version "28.1"
+ :type '(choice (const nil) function))
(defcustom battery-echo-area-format
"Power %L, battery %B (%p%% load, remaining time %t)"
@@ -96,17 +135,20 @@ string are substituted as defined by the current value of the variable
`battery-status-function'. Here are the ones generally available:
%c Current capacity (mAh or mWh)
%r Current rate of charge or discharge
+%L AC line status (verbose)
%B Battery status (verbose)
%b Battery status: empty means high, `-' means low,
`!' means critical, and `+' means charging
%d Temperature (in degrees Celsius)
-%L AC line status (verbose)
%p Battery load percentage
+%s Remaining time (to charge or discharge) in seconds
%m Remaining time (to charge or discharge) in minutes
%h Remaining time (to charge or discharge) in hours
-%t Remaining time (to charge or discharge) in the form `h:min'"
- :type '(choice string (const nil))
- :group 'battery)
+%t Remaining time (to charge or discharge) in the form `h:min'
+
+The full `format-spec' formatting syntax is supported."
+ :link '(info-link "(elisp) Custom Format Strings")
+ :type '(choice string (const nil)))
(defvar battery-mode-line-string nil
"String to display in the mode line.")
@@ -115,11 +157,10 @@ string are substituted as defined by the current value of the variable
(defcustom battery-mode-line-limit 100
"Percentage of full battery load below which display battery status."
:version "24.1"
- :type 'integer
- :group 'battery)
+ :type 'integer)
(defcustom battery-mode-line-format
- (cond ((eq battery-status-function 'battery-linux-proc-acpi)
+ (cond ((eq battery-status-function #'battery-linux-proc-acpi)
"[%b%p%%,%d°C]")
(battery-status-function
"[%b%p%%]"))
@@ -130,34 +171,46 @@ string are substituted as defined by the current value of the variable
`battery-status-function'. Here are the ones generally available:
%c Current capacity (mAh or mWh)
%r Current rate of charge or discharge
+%L AC line status (verbose)
%B Battery status (verbose)
%b Battery status: empty means high, `-' means low,
`!' means critical, and `+' means charging
%d Temperature (in degrees Celsius)
-%L AC line status (verbose)
%p Battery load percentage
+%s Remaining time (to charge or discharge) in seconds
%m Remaining time (to charge or discharge) in minutes
%h Remaining time (to charge or discharge) in hours
-%t Remaining time (to charge or discharge) in the form `h:min'"
- :type '(choice string (const nil))
- :group 'battery)
+%t Remaining time (to charge or discharge) in the form `h:min'
+
+The full `format-spec' formatting syntax is supported."
+ :link '(info-link "(elisp) Custom Format Strings")
+ :type '(choice string (const nil)))
(defcustom battery-update-interval 60
"Seconds after which the battery status will be updated."
- :type 'integer
- :group 'battery)
+ :type 'integer)
(defcustom battery-load-low 25
"Upper bound of low battery load percentage.
A battery load percentage below this number is considered low."
- :type 'integer
- :group 'battery)
+ :type 'integer)
(defcustom battery-load-critical 10
"Upper bound of critical battery load percentage.
A battery load percentage below this number is considered critical."
- :type 'integer
- :group 'battery)
+ :type 'integer)
+
+(defface battery-load-low
+ '((t :inherit warning))
+ "Face used in mode line string when battery load is low.
+See the option `battery-load-low'."
+ :version "28.1")
+
+(defface battery-load-critical
+ '((t :inherit error))
+ "Face used in mode line string when battery load is critical.
+See the option `battery-load-critical'."
+ :version "28.1")
(defvar battery-update-timer nil
"Interval timer object.")
@@ -181,17 +234,21 @@ The text displayed in the mode line is controlled by
`battery-mode-line-format' and `battery-status-function'.
The mode line is be updated every `battery-update-interval'
seconds."
- :global t :group 'battery
+ :global t
(setq battery-mode-line-string "")
(or global-mode-string (setq global-mode-string '("")))
(and battery-update-timer (cancel-timer battery-update-timer))
+ (battery--upower-unsubscribe)
(if (and battery-status-function battery-mode-line-format)
(if (not display-battery-mode)
(setq global-mode-string
(delq 'battery-mode-line-string global-mode-string))
(add-to-list 'global-mode-string 'battery-mode-line-string t)
+ (and (eq battery-status-function #'battery-upower)
+ battery-upower-subscribe
+ (battery--upower-subsribe))
(setq battery-update-timer (run-at-time nil battery-update-interval
- 'battery-update-handler))
+ #'battery-update-handler))
(battery-update))
(message "Battery status not available")
(setq display-battery-mode nil)))
@@ -203,34 +260,42 @@ seconds."
(defun battery-update ()
"Update battery status information in the mode line."
(let* ((data (and battery-status-function (funcall battery-status-function)))
- (percentage (car (read-from-string (cdr (assq ?p data))))))
- (setq battery-mode-line-string
- (propertize (if (and battery-mode-line-format
- (numberp percentage)
- (<= percentage battery-mode-line-limit))
- (battery-format battery-mode-line-format data)
- "")
- 'face
- (and (numberp percentage)
- (<= percentage battery-load-critical)
- 'error)
- 'help-echo "Battery status information")))
- (force-mode-line-update))
+ (percentage (car (read-from-string (cdr (assq ?p data)))))
+ (res (and battery-mode-line-format
+ (or (not (numberp percentage))
+ (<= percentage battery-mode-line-limit))
+ (battery-format battery-mode-line-format data)))
+ (len (length res)))
+ (unless (zerop len)
+ (cond ((not (numberp percentage)))
+ ((< percentage battery-load-critical)
+ (add-face-text-property 0 len 'battery-load-critical t res))
+ ((< percentage battery-load-low)
+ (add-face-text-property 0 len 'battery-load-low t res)))
+ (put-text-property 0 len 'help-echo "Battery status information" res))
+ (setq battery-mode-line-string (or res "")))
+ (force-mode-line-update t))
+
;;; `/proc/apm' interface for Linux.
-(defconst battery-linux-proc-apm-regexp
- (concat "^\\([^ ]+\\)" ; Driver version.
- " \\([^ ]+\\)" ; APM BIOS version.
- " 0x\\([0-9a-f]+\\)" ; APM BIOS flags.
- " 0x\\([0-9a-f]+\\)" ; AC line status.
- " 0x\\([0-9a-f]+\\)" ; Battery status.
- " 0x\\([0-9a-f]+\\)" ; Battery flags.
- " \\(-?[0-9]+\\)%" ; Load percentage.
- " \\(-?[0-9]+\\)" ; Remaining time.
- " \\(.*\\)" ; Time unit.
- "$")
+;; Regular expression matching contents of `/proc/apm'.
+(rx-define battery--linux-proc-apm
+ (: bol (group (+ (not ?\s))) ; Driver version.
+ " " (group (+ (not ?\s))) ; APM BIOS version.
+ " 0x" (group (+ xdigit)) ; APM BIOS flags.
+ " 0x" (group (+ xdigit)) ; AC line status.
+ " 0x" (group (+ xdigit)) ; Battery status.
+ " 0x" (group (+ xdigit)) ; Battery flags.
+ " " (group (? ?-) (+ digit)) ?% ; Load percentage.
+ " " (group (? ?-) (+ digit)) ; Remaining time.
+ " " (group (* nonl)) ; Time unit
+ eol))
+
+(defconst battery-linux-proc-apm-regexp (rx battery--linux-proc-apm)
"Regular expression matching contents of `/proc/apm'.")
+(make-obsolete-variable 'battery-linux-proc-apm-regexp
+ "it is no longer used." "28.1")
(defun battery-linux-proc-apm ()
"Get APM status information from Linux (the kernel).
@@ -250,12 +315,12 @@ The following %-sequences are provided:
%m Remaining time (to charge or discharge) in minutes
%h Remaining time (to charge or discharge) in hours
%t Remaining time (to charge or discharge) in the form `h:min'"
- (let (driver-version bios-version bios-interface line-status
- battery-status battery-status-symbol load-percentage
- seconds minutes hours remaining-time tem)
+ (let ( driver-version bios-version bios-interface line-status
+ battery-status battery-status-symbol load-percentage
+ seconds minutes hours remaining-time tem )
(with-temp-buffer
(ignore-errors (insert-file-contents "/proc/apm"))
- (when (re-search-forward battery-linux-proc-apm-regexp)
+ (when (re-search-forward (rx battery--linux-proc-apm) nil t)
(setq driver-version (match-string 1))
(setq bios-version (match-string 2))
(setq tem (string-to-number (match-string 3) 16))
@@ -268,9 +333,7 @@ The following %-sequences are provided:
(cond ((= tem 0) (setq line-status "off-line"))
((= tem 1) (setq line-status "on-line"))
((= tem 2) (setq line-status "on backup")))
- (setq tem (string-to-number (match-string 6) 16))
- (if (= tem 255)
- (setq battery-status "N/A")
+ (unless (= (string-to-number (match-string 6) 16) 255)
(setq tem (string-to-number (match-string 5) 16))
(cond ((= tem 0) (setq battery-status "high"
battery-status-symbol ""))
@@ -287,7 +350,7 @@ The following %-sequences are provided:
(setq minutes (/ seconds 60)
hours (/ seconds 3600))
(setq remaining-time
- (format "%d:%02d" hours (- minutes (* 60 hours))))))))
+ (format "%d:%02d" hours (% minutes 60)))))))
(list (cons ?v (or driver-version "N/A"))
(cons ?V (or bios-version "N/A"))
(cons ?I (or bios-interface "N/A"))
@@ -295,27 +358,31 @@ The following %-sequences are provided:
(cons ?B (or battery-status "N/A"))
(cons ?b (or battery-status-symbol ""))
(cons ?p (or load-percentage "N/A"))
- (cons ?s (or (and seconds (number-to-string seconds)) "N/A"))
- (cons ?m (or (and minutes (number-to-string minutes)) "N/A"))
- (cons ?h (or (and hours (number-to-string hours)) "N/A"))
+ (cons ?s (if seconds (number-to-string seconds) "N/A"))
+ (cons ?m (if minutes (number-to-string minutes) "N/A"))
+ (cons ?h (if hours (number-to-string hours) "N/A"))
(cons ?t (or remaining-time "N/A")))))
;;; `/proc/acpi/' interface for Linux.
+(rx-define battery--acpi-rate (&rest hour)
+ (: (group (+ digit)) " " (group ?m (in "AW") hour)))
+(rx-define battery--acpi-capacity (battery--acpi-rate ?h))
+
(defun battery-linux-proc-acpi ()
"Get ACPI status information from Linux (the kernel).
-This function works only with the `/proc/acpi/' format introduced
-in Linux version 2.4.20 and 2.6.0.
+This function works only with the `/proc/acpi/' interface
+introduced in Linux version 2.4.20 and 2.6.0.
The following %-sequences are provided:
%c Current capacity (mAh)
-%r Current rate
+%r Current rate of charge or discharge
+%L AC line status (verbose)
%B Battery status (verbose)
%b Battery status, empty means high, `-' means low,
`!' means critical, and `+' means charging
%d Temperature (in degrees Celsius)
-%L AC line status (verbose)
%p Battery load percentage
%m Remaining time (to charge or discharge) in minutes
%h Remaining time (to charge or discharge) in hours
@@ -331,45 +398,51 @@ The following %-sequences are provided:
;; information together since displaying for a variable amount of
;; batteries seems overkill for format-strings.
(with-temp-buffer
- (dolist (dir (ignore-errors (directory-files "/proc/acpi/battery/"
- t "\\`[^.]")))
- (erase-buffer)
- (ignore-errors (insert-file-contents (expand-file-name "state" dir)))
- (when (re-search-forward "present: +yes$" nil t)
- (and (re-search-forward "charging state: +\\(.*\\)$" nil t)
+ (dolist (dir (battery--files "/proc/acpi/battery/"))
+ (ignore-errors
+ (insert-file-contents (expand-file-name "state" dir) nil nil nil t))
+ (goto-char (point-min))
+ (when (re-search-forward (rx "present:" (+ space) "yes" eol) nil t)
+ (and (re-search-forward (rx "charging state:" (+ space)
+ (group (not space) (* nonl)) eol)
+ nil t)
(member charging-state '("unknown" "charged" nil))
;; On most multi-battery systems, most of the time only one
;; battery is "charging"/"discharging", the others are
;; "unknown".
(setq charging-state (match-string 1)))
- (when (re-search-forward "present rate: +\\([0-9]+\\) \\(m[AW]\\)$"
+ (when (re-search-forward (rx "present rate:" (+ space)
+ (battery--acpi-rate) eol)
nil t)
(setq rate (+ (or rate 0) (string-to-number (match-string 1))))
(when (> rate 0)
- (setq rate-type (or (and rate-type
- (if (string= rate-type (match-string 2))
- rate-type
- (error
- "Inconsistent rate types (%s vs. %s)"
- rate-type (match-string 2))))
- (match-string 2)))))
- (when (re-search-forward "remaining capacity: +\\([0-9]+\\) m[AW]h$"
+ (cond ((not rate-type)
+ (setq rate-type (match-string 2)))
+ ((not (string= rate-type (match-string 2)))
+ (error "Inconsistent rate types (%s vs. %s)"
+ rate-type (match-string 2))))))
+ (when (re-search-forward (rx "remaining capacity:" (+ space)
+ battery--acpi-capacity eol)
nil t)
(setq capacity
(+ (or capacity 0) (string-to-number (match-string 1))))))
(goto-char (point-max))
(ignore-errors (insert-file-contents (expand-file-name "info" dir)))
- (when (re-search-forward "present: +yes$" nil t)
- (when (re-search-forward "design capacity: +\\([0-9]+\\) m[AW]h$"
+ (when (re-search-forward (rx "present:" (+ space) "yes" eol) nil t)
+ (when (re-search-forward (rx "design capacity:" (+ space)
+ battery--acpi-capacity eol)
nil t)
(cl-incf design-capacity (string-to-number (match-string 1))))
- (when (re-search-forward "last full capacity: +\\([0-9]+\\) m[AW]h$"
+ (when (re-search-forward (rx "last full capacity:" (+ space)
+ battery--acpi-capacity eol)
nil t)
(cl-incf last-full-capacity (string-to-number (match-string 1))))
- (when (re-search-forward
- "design capacity warning: +\\([0-9]+\\) m[AW]h$" nil t)
+ (when (re-search-forward (rx "design capacity warning:" (+ space)
+ battery--acpi-capacity eol)
+ nil t)
(cl-incf warn (string-to-number (match-string 1))))
- (when (re-search-forward "design capacity low: +\\([0-9]+\\) m[AW]h$"
+ (when (re-search-forward (rx "design capacity low:" (+ space)
+ battery--acpi-capacity eol)
nil t)
(cl-incf low (string-to-number (match-string 1)))))))
(setq full-capacity (if (> last-full-capacity 0)
@@ -383,77 +456,70 @@ The following %-sequences are provided:
60)
rate))
hours (/ minutes 60)))
- (list (cons ?c (or (and capacity (number-to-string capacity)) "N/A"))
+ (list (cons ?c (if capacity (number-to-string capacity) "N/A"))
(cons ?L (or (battery-search-for-one-match-in-files
- (mapcar (lambda (e) (concat e "/state"))
- (ignore-errors
- (directory-files "/proc/acpi/ac_adapter/"
- t "\\`[^.]")))
- "state: +\\(.*\\)$" 1)
-
+ (mapcar (lambda (d) (expand-file-name "state" d))
+ (battery--files "/proc/acpi/ac_adapter/"))
+ (rx "state:" (+ space) (group (not space) (* nonl)) eol)
+ 1)
"N/A"))
(cons ?d (or (battery-search-for-one-match-in-files
- (mapcar (lambda (e) (concat e "/temperature"))
- (ignore-errors
- (directory-files "/proc/acpi/thermal_zone/"
- t "\\`[^.]")))
- "temperature: +\\([0-9]+\\) C$" 1)
-
+ (mapcar (lambda (d) (expand-file-name "temperature" d))
+ (battery--files "/proc/acpi/thermal_zone/"))
+ (rx "temperature:" (+ space) (group (+ digit)) " C" eol)
+ 1)
"N/A"))
- (cons ?r (or (and rate (concat (number-to-string rate) " "
- rate-type)) "N/A"))
+ (cons ?r (if rate
+ (concat (number-to-string rate) " " rate-type)
+ "N/A"))
(cons ?B (or charging-state "N/A"))
- (cons ?b (or (and (string= charging-state "charging") "+")
- (and capacity (< capacity low) "!")
- (and capacity (< capacity warn) "-")
- ""))
- (cons ?h (or (and hours (number-to-string hours)) "N/A"))
- (cons ?m (or (and minutes (number-to-string minutes)) "N/A"))
- (cons ?t (or (and minutes
- (format "%d:%02d" hours (- minutes (* 60 hours))))
- "N/A"))
- (cons ?p (or (and full-capacity capacity
- (> full-capacity 0)
- (number-to-string
- (floor (* 100 capacity) full-capacity)))
- "N/A")))))
+ (cons ?b (cond ((string= charging-state "charging") "+")
+ ((and capacity (< capacity low)) "!")
+ ((and capacity (< capacity warn)) "-")
+ ("")))
+ (cons ?h (if hours (number-to-string hours) "N/A"))
+ (cons ?m (if minutes (number-to-string minutes) "N/A"))
+ (cons ?t (if minutes (format "%d:%02d" hours (% minutes 60)) "N/A"))
+ (cons ?p (if (and full-capacity capacity (> full-capacity 0))
+ (number-to-string (floor (* 100 capacity) full-capacity))
+ "N/A")))))
;;; `/sys/class/power_supply/BATN' interface for Linux.
(defun battery-linux-sysfs ()
- "Get ACPI status information from Linux kernel.
+ "Get sysfs status information from Linux kernel.
This function works only with the new `/sys/class/power_supply/'
-format introduced in Linux version 2.4.25.
+interface introduced in Linux version 2.4.25.
The following %-sequences are provided:
%c Current capacity (mAh or mWh)
-%r Current rate
+%r Current rate of charge or discharge
+%L Power source (verbose)
%B Battery status (verbose)
+%b Battery status, empty means high, `-' means low,
+ `!' means critical, and `+' means charging
%d Temperature (in degrees Celsius)
%p Battery load percentage
-%L AC line status (verbose)
%m Remaining time (to charge or discharge) in minutes
%h Remaining time (to charge or discharge) in hours
%t Remaining time (to charge or discharge) in the form `h:min'"
- (let (charging-state temperature hours
- ;; Some batteries report charges and current, other energy and power.
+ (let (;; Some batteries report charges and current, others energy and power.
;; In order to reliably be able to combine those data, we convert them
;; all to energy/power (since we can't combine different charges if
;; they're not at the same voltage).
(energy-full 0.0)
(energy-now 0.0)
(power-now 0.0)
- (voltage-now 10.8)) ;Arbitrary default, in case the info is missing.
+ (voltage-now 10.8) ; Arbitrary default, in case the info is missing.
+ charging-state temperature hours percentage-now)
;; SysFS provides information about each battery present in the
;; system in a separate subdirectory. We are going to merge the
;; available information together.
(with-temp-buffer
- (dolist (dir (ignore-errors
- (battery--find-linux-sysfs-batteries)))
- (erase-buffer)
- (ignore-errors (insert-file-contents
- (expand-file-name "uevent" dir)))
+ (dolist (dir (battery--find-linux-sysfs-batteries))
+ (ignore-errors
+ (insert-file-contents (expand-file-name "uevent" dir) nil nil nil t))
(goto-char (point-min))
(when (re-search-forward
"POWER_SUPPLY_VOLTAGE_NOW=\\([0-9]*\\)$" nil t)
@@ -489,7 +555,7 @@ The following %-sequences are provided:
voltage-now))
(cl-incf energy-now (* (string-to-number now-string)
voltage-now)))
- ((and (progn (goto-char (point-min)) t)
+ ((and (goto-char (point-min))
(re-search-forward
"POWER_SUPPLY_ENERGY_FULL=\\([0-9]*\\)$" nil t)
(setq full-string (match-string 1))
@@ -498,15 +564,16 @@ The following %-sequences are provided:
(setq now-string (match-string 1)))
(cl-incf energy-full (string-to-number full-string))
(cl-incf energy-now (string-to-number now-string)))))
- (goto-char (point-min))
(unless (zerop power-now)
(let ((remaining (if (string= charging-state "Discharging")
energy-now
(- energy-full energy-now))))
(setq hours (/ remaining power-now)))))))
- (list (cons ?c (cond ((or (> energy-full 0) (> energy-now 0))
- (number-to-string (/ energy-now voltage-now)))
- (t "N/A")))
+ (when (and (> energy-full 0) (> energy-now 0))
+ (setq percentage-now (/ (* 100 energy-now) energy-full)))
+ (list (cons ?c (if (or (> energy-full 0) (> energy-now 0))
+ (number-to-string (/ energy-now voltage-now))
+ "N/A"))
(cons ?r (if (> power-now 0.0)
(format "%.1f" (/ power-now 1000000.0))
"N/A"))
@@ -517,104 +584,205 @@ The following %-sequences are provided:
"N/A"))
(cons ?d (or temperature "N/A"))
(cons ?B (or charging-state "N/A"))
- (cons ?p (cond ((and (> energy-full 0) (> energy-now 0))
- (format "%.1f"
- (/ (* 100 energy-now) energy-full)))
- (t "N/A")))
- (cons ?L (cond
- ((battery-search-for-one-match-in-files
- (list "/sys/class/power_supply/AC/online"
- "/sys/class/power_supply/ACAD/online"
- "/sys/class/power_supply/ADP1/online")
- "1" 0)
- "AC")
- ((battery-search-for-one-match-in-files
- (list "/sys/class/power_supply/AC/online"
- "/sys/class/power_supply/ACAD/online"
- "/sys/class/power_supply/ADP1/online")
- "0" 0)
- "BAT")
- (t "N/A"))))))
+ (cons ?b (cond ((string= charging-state "Charging") "+")
+ ((not percentage-now) "")
+ ((< percentage-now battery-load-critical) "!")
+ ((< percentage-now battery-load-low) "-")
+ ("")))
+ (cons ?p (if percentage-now (format "%.1f" percentage-now) "N/A"))
+ (cons ?L (pcase (battery-search-for-one-match-in-files
+ '("/sys/class/power_supply/AC/online"
+ "/sys/class/power_supply/ACAD/online"
+ "/sys/class/power_supply/ADP1/online")
+ (rx (in "01")) 0)
+ ("0" "BAT")
+ ("1" "AC")
+ (_ "N/A"))))))
-(declare-function dbus-get-property "dbus.el"
- (bus service path interface property))
-
-;;; `upowerd' interface.
-(defsubst battery-upower-prop (pname &optional device)
- (dbus-get-property
- :system
- "org.freedesktop.UPower"
- (concat "/org/freedesktop/UPower/devices/" (or device battery-upower-device))
- "org.freedesktop.UPower"
- pname))
+;;; UPower interface.
+
+(defconst battery-upower-interface "org.freedesktop.UPower"
+ "Name of the UPower D-Bus interface.
+See URL `https://upower.freedesktop.org/docs/UPower.html'.")
+
+(defconst battery-upower-path "/org/freedesktop/UPower"
+ "D-Bus object providing `battery-upower-interface'.")
+
+(defconst battery-upower-device-interface "org.freedesktop.UPower.Device"
+ "Name of the UPower Device D-Bus interface.
+See URL `https://upower.freedesktop.org/docs/Device.html'.")
+
+(defconst battery-upower-device-path "/org/freedesktop/UPower/devices"
+ "D-Bus object providing `battery-upower-device-interface'.")
+
+(defvar battery--upower-signals nil
+ "Handles for UPower signal subscriptions.")
+
+(defun battery--upower-signal-handler (&rest _)
+ "Update battery status on receiving a UPower D-Bus signal."
+ (timer-event-handler battery-update-timer))
+
+(defun battery--upower-props-changed (_interface changed _invalidated)
+ "Update status when system starts/stops running on battery.
+Intended as a UPower PropertiesChanged signal handler."
+ (when (assoc "OnBattery" changed)
+ (battery--upower-signal-handler)))
+
+(defun battery--upower-unsubscribe ()
+ "Unsubscribe from UPower device change signals."
+ (mapc #'dbus-unregister-object battery--upower-signals)
+ (setq battery--upower-signals ()))
+
+(defun battery--upower-subsribe ()
+ "Subscribe to UPower device change signals."
+ (push (dbus-register-signal :system battery-upower-service
+ battery-upower-path
+ dbus-interface-properties
+ "PropertiesChanged"
+ #'battery--upower-props-changed)
+ battery--upower-signals)
+ (dolist (method '("DeviceAdded" "DeviceRemoved"))
+ (push (dbus-register-signal :system battery-upower-service
+ battery-upower-path
+ battery-upower-interface
+ method #'battery--upower-signal-handler)
+ battery--upower-signals)))
+
+(defun battery--upower-device-properties (device)
+ "Return value for all available properties for the UPower DEVICE."
+ (dbus-get-all-properties
+ :system battery-upower-service
+ (expand-file-name device battery-upower-device-path)
+ battery-upower-device-interface))
+
+(defun battery--upower-devices ()
+ "List all UPower devices according to `battery-upower-device'."
+ (cond ((stringp battery-upower-device)
+ (list battery-upower-device))
+ (battery-upower-device)
+ ((dbus-call-method :system battery-upower-service
+ battery-upower-path
+ battery-upower-interface
+ "EnumerateDevices"))))
+
+(defun battery--upower-state (props state)
+ "Merge the UPower battery state in PROPS with STATE.
+This is an extension of the UPower DisplayDevice algorithm for
+merging multiple battery states into one. PROPS is an alist of
+battery properties from `battery-upower-device-interface', and
+STATE is a symbol representing the state to merge with."
+ ;; Map UPower enum into our printable symbols.
+ (let* ((new (pcase (cdr (assoc "State" props))
+ (1 'charging)
+ (2 'discharging)
+ (3 'empty)
+ (4 'fully-charged)
+ (5 'pending-charge)
+ (6 'pending-discharge)))
+ ;; Unknown state represented by nil.
+ (either (delq nil (list new state))))
+ ;; Earlier states override later ones.
+ (car (cond ((memq 'charging either))
+ ((memq 'discharging either))
+ ((memq 'pending-charge either))
+ ((memq 'pending-discharge either))
+ ;; Only options left are full or empty,
+ ;; but if they conflict return nil.
+ ((null (cdr either)) either)
+ ((apply #'eq either) either)))))
(defun battery-upower ()
- "Get battery status from dbus Upower interface.
-This function works only in systems with `upowerd' daemon
-running.
+ "Get battery status from UPower D-Bus interface.
+This function works only in systems that provide a UPower D-Bus
+service.
The following %-sequences are provided:
%c Current capacity (mWh)
-%p Battery load percentage
-%r Current rate
-%B Battery status (verbose)
+%r Current rate of charge or discharge
%L AC line status (verbose)
+%B Battery status (verbose)
+%b Battery status: empty means high, `-' means low,
+ `!' means critical, and `+' means charging
+%d Temperature (in degrees Celsius)
+%p Battery load percentage
%s Remaining time (to charge or discharge) in seconds
%m Remaining time (to charge or discharge) in minutes
%h Remaining time (to charge or discharge) in hours
%t Remaining time (to charge or discharge) in the form `h:min'"
- (let ((percents (battery-upower-prop "Percentage"))
- (time-to-empty (battery-upower-prop "TimeToEmpty"))
- (time-to-full (battery-upower-prop "TimeToFull"))
- (state (battery-upower-prop "State"))
- (online (battery-upower-prop "Online" "line_power_ACAD"))
- (energy (battery-upower-prop "Energy"))
- (energy-rate (battery-upower-prop "EnergyRate"))
- (battery-states '((0 . "unknown") (1 . "charging")
- (2 . "discharging") (3 . "empty")
- (4 . "fully-charged") (5 . "pending-charge")
- (6 . "pending-discharge")))
- seconds minutes hours remaining-time)
- (cond ((and online time-to-full)
- (setq seconds time-to-full))
- ((and (not online) time-to-empty)
- (setq seconds time-to-empty)))
- (when seconds
- (setq minutes (/ seconds 60)
- hours (/ minutes 60)
- remaining-time (format "%d:%02d" hours (mod minutes 60))))
- (list (cons ?c (or (and energy
- (number-to-string (round (* 1000 energy))))
- "N/A"))
- (cons ?p (or (and percents (number-to-string (round percents)))
- "N/A"))
- (cons ?r (or (and energy-rate
- (concat (number-to-string energy-rate) " W"))
- "N/A"))
- (cons ?B (or (and state (cdr (assoc state battery-states)))
- "unknown"))
- (cons ?L (or (and online "on-line") "off-line"))
- (cons ?s (or (and seconds (number-to-string seconds)) "N/A"))
- (cons ?m (or (and minutes (number-to-string minutes)) "N/A"))
- (cons ?h (or (and hours (number-to-string hours)) "N/A"))
- (cons ?t (or remaining-time "N/A")))))
+ (let ((count 0) props type line-status state load temperature
+ secs mins hrs total-energy total-rate total-tte total-ttf)
+ ;; Merge information from all available or specified UPower
+ ;; devices like other `battery-status-function's.
+ (dolist (device (battery--upower-devices))
+ (setq props (battery--upower-device-properties device))
+ (setq type (cdr (assoc "Type" props)))
+ (cond
+ ((and (eq type 1) (not (eq line-status 'online)))
+ ;; It's a line power device: `online' if currently providing
+ ;; power, any other non-nil value if simply present.
+ (setq line-status (if (cdr (assoc "Online" props)) 'online t)))
+ ((and (eq type 2) (cdr (assoc "IsPresent" props)))
+ ;; It's a battery.
+ (setq count (1+ count))
+ (setq state (battery--upower-state props state))
+ (let ((energy (cdr (assoc "Energy" props)))
+ (rate (cdr (assoc "EnergyRate" props)))
+ (percent (cdr (assoc "Percentage" props)))
+ (temp (cdr (assoc "Temperature" props)))
+ (tte (cdr (assoc "TimeToEmpty" props)))
+ (ttf (cdr (assoc "TimeToFull" props))))
+ (when energy (setq total-energy (+ (or total-energy 0) energy)))
+ (when rate (setq total-rate (+ (or total-rate 0) rate)))
+ (when percent (setq load (+ (or load 0) percent)))
+ (when temp (setq temperature (+ (or temperature 0) temp)))
+ (when tte (setq total-tte (+ (or total-tte 0) tte)))
+ (when ttf (setq total-ttf (+ (or total-ttf 0) ttf)))))))
+ (when (> count 1)
+ ;; Averages over multiple batteries.
+ (when load (setq load (/ load count)))
+ (when temperature (setq temperature (/ temperature count))))
+ (when (setq secs (if (eq line-status 'online) total-ttf total-tte))
+ (setq mins (/ secs 60))
+ (setq hrs (/ secs 3600)))
+ (list (cons ?c (if total-energy
+ (format "%.0f" (* total-energy 1000))
+ "N/A"))
+ (cons ?r (if total-rate (format "%.1f W" total-rate) "N/A"))
+ (cons ?L (cond ((eq line-status 'online) "on-line")
+ (line-status "off-line")
+ ("N/A")))
+ (cons ?B (format "%s" (or state 'unknown)))
+ (cons ?b (cond ((eq state 'charging) "+")
+ ((and load (< load battery-load-critical)) "!")
+ ((and load (< load battery-load-low)) "-")
+ ("")))
+ ;; Zero usually means unknown.
+ (cons ?d (if (and temperature (/= temperature 0))
+ (format "%.0f" temperature)
+ "N/A"))
+ (cons ?p (if load (format "%.0f" load) "N/A"))
+ (cons ?s (if secs (number-to-string secs) "N/A"))
+ (cons ?m (if mins (number-to-string mins) "N/A"))
+ (cons ?h (if hrs (number-to-string hrs) "N/A"))
+ (cons ?t (if hrs (format "%d:%02d" hrs (% mins 60)) "N/A")))))
;;; `apm' interface for BSD.
+
(defun battery-bsd-apm ()
"Get APM status information from BSD apm binary.
The following %-sequences are provided:
+%P Advanced power saving mode state (verbose)
%L AC line status (verbose)
%B Battery status (verbose)
%b Battery status, empty means high, `-' means low,
- `!' means critical, and `+' means charging
-%P Advanced power saving mode state (verbose)
-%p Battery charge percentage
-%s Remaining battery charge time in seconds
-%m Remaining battery charge time in minutes
-%h Remaining battery charge time in hours
-%t Remaining battery charge time in the form `h:min'"
+ `!' means critical, and `+' means charging
+%p Battery load percentage
+%s Remaining time (to charge or discharge) in seconds
+%m Remaining time (to charge or discharge) in minutes
+%h Remaining time (to charge or discharge) in hours
+%t Remaining time (to charge or discharge) in the form `h:min'"
(let* ((os-name (car (split-string
;; FIXME: Can't we use something like `system-type'?
(shell-command-to-string "/usr/bin/uname"))))
@@ -680,7 +848,7 @@ The following %-sequences are provided:
(setq seconds (string-to-number battery-life)
minutes (truncate seconds 60)))
(setq hours (truncate minutes 60)
- remaining-time (format "%d:%02d" hours (mod minutes 60))))
+ remaining-time (format "%d:%02d" hours (% minutes 60))))
(list (cons ?L (or line-status "N/A"))
(cons ?B (or (car battery-status) "N/A"))
(cons ?b (or (cdr battery-status) "N/A"))
@@ -688,9 +856,9 @@ The following %-sequences are provided:
"N/A"
battery-percentage))
(cons ?P (or apm-mode "N/A"))
- (cons ?s (or (and seconds (number-to-string seconds)) "N/A"))
- (cons ?m (or (and minutes (number-to-string minutes)) "N/A"))
- (cons ?h (or (and hours (number-to-string hours)) "N/A"))
+ (cons ?s (if seconds (number-to-string seconds) "N/A"))
+ (cons ?m (if minutes (number-to-string minutes) "N/A"))
+ (cons ?h (if hours (number-to-string hours) "N/A"))
(cons ?t (or remaining-time "N/A")))))
@@ -705,21 +873,25 @@ The following %-sequences are provided:
%b Battery status, empty means high, `-' means low,
`!' means critical, and `+' means charging
%p Battery load percentage
-%h Remaining time in hours
-%m Remaining time in minutes
-%t Remaining time in the form `h:min'"
- (let (power-source load-percentage battery-status battery-status-symbol
- remaining-time hours minutes)
+%m Remaining time (to charge or discharge) in minutes
+%h Remaining time (to charge or discharge) in hours
+%t Remaining time (to charge or discharge) in the form `h:min'"
+ (let ( power-source load-percentage battery-status battery-status-symbol
+ remaining-time hours minutes )
(with-temp-buffer
(ignore-errors (call-process "pmset" nil t nil "-g" "ps"))
(goto-char (point-min))
- (when (re-search-forward "\\(?:Currentl?y\\|Now\\) drawing from '\\(AC\\|Battery\\) Power'" nil t)
+ (when (re-search-forward ;; Handle old typo in output.
+ "\\(?:Currentl?y\\|Now\\) drawing from '\\(AC\\|Battery\\) Power'"
+ nil t)
(setq power-source (match-string 1))
- (when (re-search-forward "^ -InternalBattery-0\\([ \t]+(id=[0-9]+)\\)*[ \t]+" nil t)
+ (when (re-search-forward (rx bol " -InternalBattery-0" (+ space)
+ (* "(id=" (+ digit) ")" (+ space)))
+ nil t)
(when (looking-at "\\([0-9]\\{1,3\\}\\)%")
(setq load-percentage (match-string 1))
(goto-char (match-end 0))
- (cond ((looking-at "; charging")
+ (cond ((looking-at-p "; charging")
(setq battery-status "charging"
battery-status-symbol "+"))
((< (string-to-number load-percentage) battery-load-critical)
@@ -750,13 +922,7 @@ The following %-sequences are provided:
(defun battery-format (format alist)
"Substitute %-sequences in FORMAT."
- (replace-regexp-in-string
- "%."
- (lambda (str)
- (let ((char (aref str 1)))
- (if (eq char ?%) "%"
- (or (cdr (assoc char alist)) ""))))
- format t t))
+ (format-spec format alist 'delete))
(defun battery-search-for-one-match-in-files (files regexp match-num)
"Search REGEXP in the content of the files listed in FILES.
diff --git a/lisp/bindings.el b/lisp/bindings.el
index e3fc5637fab..3930f5b52c6 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -411,6 +411,8 @@ zero, otherwise they start from one."
:type 'boolean
:group 'mode-line
:version "26.1")
+(make-obsolete-variable 'column-number-indicator-zero-based
+ 'mode-line-position-column-format "28.1")
(defcustom mode-line-percent-position '(-3 "%p")
"Specification of \"percentage offset\" of window through buffer.
@@ -431,6 +433,41 @@ displayed in `mode-line-position', a component of the default
:group 'mode-line)
(put 'mode-line-percent-position 'risky-local-variable t)
+(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."
+ :type '(list string)
+ :version "28.1"
+ :group 'mode-line)
+
+(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."
+ :type '(list string)
+ :version "28.1"
+ :group 'mode-line)
+
+(defcustom mode-line-position-column-line-format '(" (%l,%c)")
+ "Format used to display combined line/column numbers in the mode line.
+This is used when `column-number-mode' and `line-number-mode' are
+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."
+ :type '(list string)
+ :version "28.1"
+ :group 'mode-line)
+
+(defconst mode-line-position--column-line-properties
+ (list 'local-map mode-line-column-line-number-mode-map
+ 'mouse-face 'mode-line-highlight
+ 'help-echo "Line number and Column number\n\
+mouse-1: Display Line and Column Mode Menu"))
+
(defvar mode-line-position
`((:propertize
mode-line-percent-position
@@ -450,38 +487,30 @@ mouse-1: Display Line and Column Mode Menu")))
(line-number-mode
((column-number-mode
(column-number-indicator-zero-based
- (10 ,(propertize
- " (%l,%c)"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Line number and Column number\n\
-mouse-1: Display Line and Column Mode Menu"))
- (10 ,(propertize
- " (%l,%C)"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Line number and Column number\n\
-mouse-1: Display Line and Column Mode Menu")))
- (6 ,(propertize
- " L%l"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Line Number\n\
-mouse-1: Display Line and Column Mode Menu"))))
- ((column-number-mode
- (column-number-indicator-zero-based
- (5 ,(propertize
- " C%c"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Column number\n\
-mouse-1: Display Line and Column Mode Menu"))
- (5 ,(propertize
- " C%C"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Column number\n\
-mouse-1: Display Line and Column Mode Menu")))))))
+ (10
+ (:propertize
+ mode-line-position-column-line-format
+ ,@mode-line-position--column-line-properties))
+ (10
+ (:propertize
+ (:eval (string-replace
+ "%c" "%C" (car mode-line-position-column-line-format)))
+ ,@mode-line-position--column-line-properties)))
+ (6
+ (:propertize
+ mode-line-position-line-format
+ ,@mode-line-position--column-line-properties))))
+ (column-number-mode
+ (column-number-indicator-zero-based
+ (6
+ (:propertize
+ mode-line-position-column-format
+ (,@mode-line-position--column-line-properties)))
+ (6
+ (:propertize
+ (:eval (string-replace
+ "%c" "%C" (car mode-line-position-column-format)))
+ ,@mode-line-position--column-line-properties))))))
"Mode line construct for displaying the position in the buffer.
Normally displays the buffer percentage and, optionally, the
buffer size, the line number and the column number.")
@@ -1383,6 +1412,9 @@ if `inhibit-field-text-motion' is non-nil."
(define-key ctl-x-map "'" 'expand-abbrev)
(define-key ctl-x-map "\C-b" 'list-buffers)
+(define-key ctl-x-map "\C-j" 'dired-jump)
+(define-key ctl-x-4-map "\C-j" 'dired-jump-other-window)
+
(define-key ctl-x-map "z" 'repeat)
(define-key esc-map "\C-l" 'reposition-window)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index e69d9f529cf..dcb03adadd8 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -200,6 +200,7 @@ A non-nil value may result in truncated bookmark names."
(define-key map "f" 'bookmark-insert-location) ;"f"ind
(define-key map "r" 'bookmark-rename)
(define-key map "d" 'bookmark-delete)
+ (define-key map "D" 'bookmark-delete-all)
(define-key map "l" 'bookmark-load)
(define-key map "w" 'bookmark-write)
(define-key map "s" 'bookmark-save)
@@ -734,8 +735,10 @@ CODING is the symbol of the coding-system in which the file is encoded."
(if (memq (coding-system-base coding) '(undecided prefer-utf-8))
(setq coding 'utf-8-emacs))
(insert
- (format ";;;; Emacs Bookmark Format Version %d ;;;; -*- coding: %S -*-\n"
- bookmark-file-format-version (coding-system-base coding)))
+ (format
+ ";;;; Emacs Bookmark Format Version %d\
+;;;; -*- coding: %S; mode: lisp-data -*-\n"
+ bookmark-file-format-version (coding-system-base coding)))
(insert ";;; This format is meant to be slightly human-readable;\n"
";;; nevertheless, you probably don't want to edit it.\n"
";;; "
@@ -800,7 +803,7 @@ still there, in order, if the topmost one is ever deleted."
(let ((str
(or name
(read-from-minibuffer
- (format "%s (default %s): " prompt default)
+ (format-prompt prompt default)
nil
bookmark-minibuffer-read-name-map
nil nil defaults))))
@@ -920,8 +923,6 @@ annotations."
"# Date: " (current-time-string) "\n"))
-(define-obsolete-variable-alias 'bookmark-read-annotation-text-func
- 'bookmark-edit-annotation-text-func "23.1")
(defvar bookmark-edit-annotation-text-func 'bookmark-default-annotation-text
"Function to return default text to use for a bookmark annotation.
It takes one argument, the name of the bookmark, as a string.")
@@ -1140,17 +1141,6 @@ DISPLAY-FUNC would be `switch-to-buffer-other-window'."
(let ((pop-up-frames t))
(bookmark-jump-other-window bookmark)))
-(defun bookmark-jump-noselect (bookmark)
- "Return the location pointed to by BOOKMARK (see `bookmark-jump').
-The return value has the form (BUFFER . POINT).
-
-Note: this function is deprecated and is present for Emacs 22
-compatibility only."
- (declare (obsolete bookmark-handle-bookmark "23.1"))
- (save-excursion
- (bookmark-handle-bookmark bookmark)
- (cons (current-buffer) (point))))
-
(defun bookmark-handle-bookmark (bookmark-name-or-record)
"Call BOOKMARK-NAME-OR-RECORD's handler or `bookmark-default-handler'
if it has none. This changes current buffer and point and returns nil,
@@ -1372,6 +1362,23 @@ probably because we were called from there."
(bookmark-save)))
+;;;###autoload
+(defun bookmark-delete-all (&optional no-confirm)
+ "Permanently delete all bookmarks.
+If optional argument NO-CONFIRM is non-nil, don't ask for
+confirmation."
+ (interactive "P")
+ (when (or no-confirm
+ (yes-or-no-p "Permanently delete all bookmarks? "))
+ (bookmark-maybe-load-default-file)
+ (setq bookmark-alist-modification-count
+ (+ bookmark-alist-modification-count (length bookmark-alist)))
+ (setq bookmark-alist nil)
+ (bookmark-bmenu-surreptitiously-rebuild-list)
+ (when (bookmark-time-to-save-p)
+ (bookmark-save))))
+
+
(defun bookmark-time-to-save-p (&optional final-time)
"Return t if it is time to save bookmarks to disk, nil otherwise.
Optional argument FINAL-TIME means this is being called when Emacs
@@ -1598,12 +1605,15 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
(define-key map "\C-d" 'bookmark-bmenu-delete-backwards)
(define-key map "x" 'bookmark-bmenu-execute-deletions)
(define-key map "d" 'bookmark-bmenu-delete)
+ (define-key map "D" 'bookmark-bmenu-delete-all)
(define-key map " " 'next-line)
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
(define-key map "\177" 'bookmark-bmenu-backup-unmark)
(define-key map "u" 'bookmark-bmenu-unmark)
+ (define-key map "U" 'bookmark-bmenu-unmark-all)
(define-key map "m" 'bookmark-bmenu-mark)
+ (define-key map "M" 'bookmark-bmenu-mark-all)
(define-key map "l" 'bookmark-bmenu-load)
(define-key map "r" 'bookmark-bmenu-rename)
(define-key map "R" 'bookmark-bmenu-relocate)
@@ -1625,8 +1635,10 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
["Select Marked Bookmarks" bookmark-bmenu-select t]
"---"
["Mark Bookmark" bookmark-bmenu-mark t]
+ ["Mark all Bookmarks" bookmark-bmenu-mark-all t]
["Unmark Bookmark" bookmark-bmenu-unmark t]
["Unmark Backwards" bookmark-bmenu-backup-unmark t]
+ ["Unmark all Bookmarks" bookmark-bmenu-unmark-all t]
["Toggle Display of Filenames" bookmark-bmenu-toggle-filenames t]
["Display Location of Bookmark" bookmark-bmenu-locate t]
"---"
@@ -1634,6 +1646,7 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
["Rename Bookmark" bookmark-bmenu-rename t]
["Relocate Bookmark's File" bookmark-bmenu-relocate t]
["Mark Bookmark for Deletion" bookmark-bmenu-delete t]
+ ["Mark all Bookmarks for Deletion" bookmark-bmenu-delete-all t]
["Delete Marked Bookmarks" bookmark-bmenu-execute-deletions t])
("Annotations"
["Show Annotation for Current Bookmark" bookmark-bmenu-show-annotation t]
@@ -1665,6 +1678,19 @@ Don't affect the buffer ring order."
;;;###autoload
+(defun bookmark-bmenu-get-buffer ()
+ "Return the Bookmark List, building it if it doesn't exists.
+Don't affect the buffer ring order."
+ (or (get-buffer bookmark-bmenu-buffer)
+ (save-excursion
+ (save-window-excursion
+ (bookmark-bmenu-list)
+ (get-buffer bookmark-bmenu-buffer)))))
+
+(custom-add-choice 'tab-bar-new-tab-choice
+ '(const :tag "Bookmark List" bookmark-bmenu-get-buffer))
+
+;;;###autoload
(defun bookmark-bmenu-list ()
"Display a list of existing bookmarks.
The list is displayed in a buffer named `*Bookmark List*'.
@@ -1721,7 +1747,7 @@ deletion, or > if it is flagged for displaying."
;; according to `bookmark-bookmarks-timestamp'.
(defun bookmark-bmenu-set-header ()
"Set the immutable header line."
- (let ((header (concat "%% " "Bookmark")))
+ (let ((header (copy-sequence "%% Bookmark")))
(when bookmark-bmenu-toggle-filenames
(setq header (concat header
(make-string (- bookmark-bmenu-file-column
@@ -1746,6 +1772,7 @@ Letters do not insert themselves; instead, they are commands.
Bookmark names preceded by a \"*\" have annotations.
\\<bookmark-bmenu-mode-map>
\\[bookmark-bmenu-mark] -- mark bookmark to be displayed.
+\\[bookmark-bmenu-mark-all] -- mark all listed bookmarks to be displayed.
\\[bookmark-bmenu-select] -- select bookmark of line point is on.
Also show bookmarks marked using m in other windows.
\\[bookmark-bmenu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names).
@@ -1762,13 +1789,15 @@ Bookmark names preceded by a \"*\" have annotations.
\\[bookmark-bmenu-relocate] -- relocate this bookmark's file (prompts for new file).
\\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down.
\\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up.
-\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]'.
+\\[bookmark-bmenu-delete-all] -- mark all listed bookmarks as to be deleted.
+\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]' or `\\[bookmark-bmenu-delete-all]'.
\\[bookmark-bmenu-save] -- save the current bookmark list in the default file.
With a prefix arg, prompts for a file to save in.
\\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.)
\\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line.
With prefix argument, also move up one line.
\\[bookmark-bmenu-backup-unmark] -- back up a line and remove marks.
+\\[bookmark-bmenu-unmark-all] -- remove all kinds of marks from all listed bookmarks.
\\[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for the current bookmark
in another buffer.
\\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer.
@@ -1935,9 +1964,23 @@ If the annotation does not exist, do nothing."
(bookmark-bmenu-ensure-position))))
+(defun bookmark-bmenu-mark-all ()
+ "Mark all listed bookmarks to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (with-buffer-modified-unmodified
+ (let ((inhibit-read-only t))
+ (while (not (eobp))
+ (delete-char 1)
+ (insert ?>)
+ (forward-line 1))))))
+
+
(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] command."
+You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] or \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark-all] commands."
(interactive)
(let ((bmrk (bookmark-bmenu-bookmark))
(menu (current-buffer))
@@ -2106,6 +2149,20 @@ Optional BACKUP means move up."
(bookmark-bmenu-ensure-position))
+(defun bookmark-bmenu-unmark-all ()
+ "Cancel all requested operations on all listed bookmarks."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (with-buffer-modified-unmodified
+ (let ((inhibit-read-only t))
+ (while (not (eobp))
+ (delete-char 1)
+ (insert " ")
+ (forward-line 1))))))
+
+
(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]."
@@ -2131,6 +2188,22 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
(bookmark-bmenu-ensure-position))
+(defun bookmark-bmenu-delete-all ()
+ "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)
+ (save-excursion
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (with-buffer-modified-unmodified
+ (let ((inhibit-read-only t))
+ (while (not (eobp))
+ (delete-char 1)
+ (insert ?D)
+ (forward-line 1))))))
+
+
(defun bookmark-bmenu-execute-deletions ()
"Delete bookmarks flagged `D'."
(interactive)
@@ -2290,6 +2363,9 @@ strings returned are not."
(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"))
@@ -2322,6 +2398,8 @@ strings returned are not."
;; Load Hook
(defvar bookmark-load-hook nil
"Hook run at the end of loading library `bookmark.el'.")
+(make-obsolete-variable 'bookmark-load-hook
+ "use `with-eval-after-load' instead." "28.1")
;; Exit Hook, called from kill-emacs-hook
(defvar bookmark-exit-hook nil
diff --git a/lisp/bs.el b/lisp/bs.el
index f5cb93b5169..337d22ecf83 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -173,7 +173,12 @@ return a string representing the column's value."
(defun bs--make-header-match-string ()
"Return a regexp matching the first line of a Buffer Selection Menu buffer."
- (concat "^\\(" (mapconcat #'car bs-attributes-list " *") " *$\\)"))
+ (concat "^\\("
+ (apply #'concat (mapcan (lambda (e)
+ (and (not (equal (car e) ""))
+ (list " *" (car e))))
+ bs-attributes-list))
+ " *$\\)"))
;; Font-Lock-Settings
(defvar bs-mode-font-lock-keywords
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 655a76a713c..d06ba287879 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -69,11 +69,26 @@ minus `Buffer-menu-size-width'. This use is deprecated."
"use `Buffer-menu-name-width' and `Buffer-menu-size-width' instead."
"24.3")
-(defcustom Buffer-menu-name-width 19
- "Width of buffer name column in the Buffer Menu."
- :type 'number
+(defun Buffer-menu--dynamic-name-width (buffers)
+ "Return a name column width based on the current window width.
+The width will never exceed the actual width of the buffer names,
+but will never be narrower than 19 characters."
+ (max 19
+ ;; This gives 19 on an 80 column window, and take up
+ ;; proportionally more space as the window widens.
+ (min (truncate (/ (window-width) 4.2))
+ (apply #'max 0 (mapcar (lambda (b)
+ (length (buffer-name b)))
+ buffers)))))
+
+(defcustom Buffer-menu-name-width #'Buffer-menu--dynamic-name-width
+ "Width of buffer name column in the Buffer Menu.
+This can either be a number (used directly) or a function that
+will be called with the list of buffers and should return a
+number."
+ :type '(choice function number)
:group 'Buffer-menu
- :version "24.3")
+ :version "28.1")
(defcustom Buffer-menu-size-width 7
"Width of buffer size column in the Buffer Menu."
@@ -214,9 +229,6 @@ commands.")
map)
"Local keymap for `Buffer-menu-mode' buffers.")
-(define-obsolete-variable-alias 'buffer-menu-mode-hook
- 'Buffer-menu-mode-hook "23.1")
-
(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],
@@ -488,8 +500,9 @@ Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-delete]' are deleted
(defun Buffer-menu-select ()
"Select this line's buffer; also, display buffers marked with `>'.
You can mark buffers with the \\<Buffer-menu-mode-map>`\\[Buffer-menu-mark]' command.
+
This command deletes and replaces all the previously existing windows
-in the selected frame."
+in the selected frame, and will remove any marks."
(interactive)
(let* ((this-buffer (Buffer-menu-buffer t))
(menu-buffer (current-buffer))
@@ -645,25 +658,11 @@ means list those buffers and no others."
(defun list-buffers--refresh (&optional buffer-list old-buffer)
;; Set up `tabulated-list-format'.
- (let ((name-width Buffer-menu-name-width)
- (size-width Buffer-menu-size-width)
+ (let ((size-width Buffer-menu-size-width)
(marked-buffers (Buffer-menu-marked-buffers))
(buffer-menu-buffer (current-buffer))
(show-non-file (not Buffer-menu-files-only))
- entries)
- ;; Handle obsolete variable:
- (if Buffer-menu-buffer+size-width
- (setq name-width (- Buffer-menu-buffer+size-width size-width)))
- (setq tabulated-list-format
- (vector '("C" 1 t :pad-right 0)
- '("R" 1 t :pad-right 0)
- '("M" 1 t)
- `("Buffer" ,name-width t)
- `("Size" ,size-width tabulated-list-entry-size->
- :right-align t)
- `("Mode" ,Buffer-menu-mode-width t)
- '("File" 1 t)))
- (setq tabulated-list-use-header-line Buffer-menu-use-header-line)
+ entries name-width)
;; Collect info for each buffer we're interested in.
(dolist (buffer (or buffer-list
(buffer-list (if Buffer-menu-use-frame-buffer-list
@@ -693,6 +692,22 @@ means list those buffers and no others."
nil nil buffer)))
(Buffer-menu--pretty-file-name file)))
entries)))))
+ (setq name-width (if (functionp Buffer-menu-name-width)
+ (funcall Buffer-menu-name-width (mapcar #'car entries))
+ Buffer-menu-name-width))
+ ;; Handle obsolete variable:
+ (if Buffer-menu-buffer+size-width
+ (setq name-width (- Buffer-menu-buffer+size-width size-width)))
+ (setq tabulated-list-format
+ (vector '("C" 1 t :pad-right 0)
+ '("R" 1 t :pad-right 0)
+ '("M" 1 t)
+ `("Buffer" ,name-width t)
+ `("Size" ,size-width tabulated-list-entry-size->
+ :right-align t)
+ `("Mode" ,Buffer-menu-mode-width t)
+ '("File" 1 t)))
+ (setq tabulated-list-use-header-line Buffer-menu-use-header-line)
(setq tabulated-list-entries (nreverse entries)))
(tabulated-list-init-header))
diff --git a/lisp/button.el b/lisp/button.el
index b3afc4eca25..11317605cee 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -78,6 +78,10 @@
"Keymap useful for buffers containing buttons.
Mode-specific keymaps may want to use this as their parent keymap.")
+(define-minor-mode button-mode
+ "A minor mode for navigating to buttons with the TAB key."
+ :keymap button-buffer-map)
+
;; Default properties for buttons.
(put 'default-button 'face 'button)
(put 'default-button 'mouse-face 'highlight)
@@ -341,15 +345,14 @@ If the property `button-data' is present, it will later be used
as the argument for the `action' callback function instead of the
default argument, which is the button itself.
-BEG can also be a string, in which case it is made into a button.
+BEG can also be a string, in which case a copy of it is made into
+a button and returned.
Also see `insert-text-button'."
(let ((object nil)
(type-entry
(or (plist-member properties 'type)
(plist-member properties :type))))
- (when (stringp beg)
- (setq object beg beg 0 end (length object)))
;; Disallow setting the `category' property directly.
(when (plist-get properties 'category)
(error "Button `category' property may not be set directly"))
@@ -362,6 +365,10 @@ Also see `insert-text-button'."
(setcar type-entry 'category)
(setcar (cdr type-entry)
(button-category-symbol (cadr type-entry))))
+ (when (stringp beg)
+ (setq object (copy-sequence beg))
+ (setq beg 0)
+ (setq end (length object)))
;; Now add all the text properties at once.
(add-text-properties beg end
;; Each button should have a non-eq `button'
@@ -461,18 +468,24 @@ see).
POS defaults to point, except when `push-button' is invoked
interactively as the result of a mouse-event, in which case, the
mouse event is used.
+
If there's no button at POS, do nothing and return nil, otherwise
-return t."
+return t.
+
+To get a description of what function will called when pushing a
+butting, use the `button-describe' command."
(interactive
(list (if (integerp last-command-event) (point) last-command-event)))
(if (and (not (integerp pos)) (eventp pos))
;; POS is a mouse event; switch to the proper window/buffer
(let ((posn (event-start pos)))
(with-current-buffer (window-buffer (posn-window posn))
- (if (posn-string posn)
- ;; mode-line, header-line, or display string event.
- (button-activate (posn-string posn) t)
- (push-button (posn-point posn) t))))
+ (let* ((str (posn-string posn))
+ (str-button (and str (get-text-property (cdr str) 'button (car str)))))
+ (if str-button
+ ;; mode-line, header-line, or display string event.
+ (button-activate str t)
+ (push-button (posn-point posn) t)))))
;; POS is just normal position
(let ((button (button-at (or pos (point)))))
(when button
@@ -550,6 +563,51 @@ Returns the button found."
(interactive "p\nd\nd")
(forward-button (- n) wrap display-message no-error))
+(defun button--describe (properties)
+ "Describe a button's PROPERTIES (an alist) in a *Help* buffer.
+This is a helper function for `button-describe', in order to be possible to
+use `help-setup-xref'.
+
+Each element of PROPERTIES should be of the form (PROPERTY . VALUE)."
+ (help-setup-xref (list #'button--describe properties)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (with-current-buffer (help-buffer)
+ (insert (format-message "This button's type is `%s'."
+ (alist-get 'type properties)))
+ (dolist (prop '(action mouse-action))
+ (let ((name (symbol-name prop))
+ (val (alist-get prop properties)))
+ (when (functionp val)
+ (insert "\n\n"
+ (propertize (capitalize name) 'face 'bold)
+ "\nThe " name " of this button is")
+ (if (symbolp val)
+ (progn
+ (insert (format-message " `%s',\nwhich is " val))
+ (describe-function-1 val))
+ (insert "\n")
+ (princ val))))))))
+
+(defun button-describe (&optional button-or-pos)
+ "Display a buffer with information about the button at point.
+
+When called from Lisp, pass BUTTON-OR-POS as the button to describe, or a
+buffer position where a button is present. If BUTTON-OR-POS is nil, the
+button at point is the button to describe."
+ (interactive "d")
+ (let* ((button (cond ((integer-or-marker-p button-or-pos)
+ (button-at button-or-pos))
+ ((null button-or-pos) (button-at (point)))
+ ((overlayp button-or-pos) button-or-pos)))
+ (props (and button
+ (mapcar (lambda (prop)
+ (cons prop (button-get button prop)))
+ '(type action mouse-action)))))
+ (when props
+ (button--describe props)
+ t)))
+
(provide 'button)
;;; button.el ends here
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el
index e9083b84c61..33fd1af6ffb 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -126,8 +126,8 @@
(defun calc-word-size (n)
(interactive "P")
(calc-wrapper
- (or n (setq n (read-string (format "Binary word size: (default %d) "
- calc-word-size))))
+ (or n (setq n (read-string (format-prompt "Binary word size"
+ calc-word-size))))
(setq n (if (stringp n)
(if (equal n "")
calc-word-size
diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el
index d4562a0cc86..f7e29c6e52c 100644
--- a/lisp/calc/calc-comb.el
+++ b/lisp/calc/calc-comb.el
@@ -241,8 +241,8 @@
(calcFunc-gcd (math-neg a) b))
((Math-looks-negp b)
(calcFunc-gcd a (math-neg b)))
- ((Math-zerop a) b)
- ((Math-zerop b) a)
+ ((Math-zerop a) (math-abs b))
+ ((Math-zerop b) (math-abs a))
((and (Math-ratp a)
(Math-ratp b))
(math-make-frac (math-gcd (if (eq (car-safe a) 'frac) (nth 1 a) a)
@@ -292,15 +292,9 @@
(defconst math-small-factorial-table
(vector 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800
- (math-read-number-simple "479001600")
- (math-read-number-simple "6227020800")
- (math-read-number-simple "87178291200")
- (math-read-number-simple "1307674368000")
- (math-read-number-simple "20922789888000")
- (math-read-number-simple "355687428096000")
- (math-read-number-simple "6402373705728000")
- (math-read-number-simple "121645100408832000")
- (math-read-number-simple "2432902008176640000")))
+ 479001600 6227020800 87178291200 1307674368000 20922789888000
+ 355687428096000 6402373705728000 121645100408832000
+ 2432902008176640000))
(defun calcFunc-fact (n) ; [I I] [F F] [Public]
(let (temp)
@@ -445,12 +439,25 @@
(math-div (calcFunc-fact (math-float n))
(math-mul (calcFunc-fact m)
(calcFunc-fact (math-sub n m))))))
- ((math-negp m) 0)
- ((math-negp n)
- (let ((val (calcFunc-choose (math-add (math-add n m) -1) m)))
+ ;; For the extension to negative integer arguments we follow
+ ;; M. J. Kronenburg, The Binomial Coefficient for Negative Arguments,
+ ;; arXiv:1105.3689v2
+ ((and (math-negp n) (not (math-negp m)))
+ ;; n<0≤m: (n choose m) = (-1)^m (-n+m-1 choose m)
+ (let ((val (calcFunc-choose (math-add (math-sub m n) -1) m)))
(if (math-evenp (math-trunc m))
val
(math-neg val))))
+ ((and (math-negp n) (math-num-integerp n))
+ (if (math-lessp n m)
+ 0
+ ;; m≤n<0: (n choose m) = (-1)^(n-m) (-m-1 choose n-m)
+ (let ((val (calcFunc-choose (math-sub (math-neg m) 1)
+ (math-sub n m))))
+ (if (math-evenp (math-sub n m))
+ val
+ (math-neg val)))))
+ ((math-negp m) 0)
((and (math-num-integerp n)
(Math-lessp n m))
0)
@@ -467,20 +474,23 @@
(math-choose-float-iter tm n 1 1)))))))
(defun math-choose-iter (m n i c)
- (if (and (= (% i 5) 1) (> i 5))
+ (while (<= i m)
+ (when (and (= (% i 5) 1) (> i 5))
(math-working (format "choose(%d)" (1- i)) c))
- (if (<= i m)
- (math-choose-iter m (1- n) (1+ i)
- (math-quotient (math-mul c n) i))
- c))
+ (setq c (math-quotient (math-mul c n) i))
+ (setq n (1- n))
+ (setq i (1+ i)))
+ c)
(defun math-choose-float-iter (count n i c)
- (if (= (% i 5) 1)
+ (while (> count 0)
+ (when (= (% i 5) 1)
(math-working (format "choose(%d)" (1- i)) c))
- (if (> count 0)
- (math-choose-float-iter (1- count) (math-sub n 1) (1+ i)
- (math-div (math-mul c n) i))
- c))
+ (setq c (math-div (math-mul c n) i))
+ (setq n (math-sub n 1))
+ (setq i (1+ i))
+ (setq count (1- count)))
+ c)
;;; Stirling numbers.
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index 5a8f0a38d24..6d70126c098 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -1870,8 +1870,8 @@ and ends on the last Sunday of October at 2 a.m."
(and days (= day (car days))
(setq holiday t)))
(let* ((weekdays (nth 3 math-holidays-cache))
- (weeks (1- (/ (+ day 6) 7)))
- (wkday (- day 1 (* weeks 7))))
+ (weeks (/ day 7))
+ (wkday (mod day 7))) ; Day of week: 0=Sunday, 6=Saturday
(setq delta (+ delta (* weeks (length weekdays))))
(while (and weekdays (< (car weekdays) wkday))
(setq weekdays (cdr weekdays)
@@ -1905,14 +1905,15 @@ and ends on the last Sunday of October at 2 a.m."
(setq delta (1+ delta)))
(setq day (+ day delta)))
(let* ((weekdays (nth 3 math-holidays-cache))
- (bweek (- 7 (length weekdays)))
- (weeks (1- (/ (+ day (1- bweek)) bweek)))
- (wkday (- day 1 (* weeks bweek)))
+ (bweek (- 7 (length weekdays))) ; Business days in a week, 1..7.
+ (weeks (/ day bweek)) ; Whole weeks.
+ (wkday (mod day bweek)) ; Business day in last week, 0..bweek-1
(w 0))
(setq day (+ day (* weeks (length weekdays))))
+ ;; Add business days in the last week; `w' is weekday, 0..6.
(while (if (memq w weekdays)
(setq day (1+ day))
- (> (setq wkday (1- wkday)) 0))
+ (>= (setq wkday (1- wkday)) 0))
(setq w (1+ w)))
(let ((hours (nth 7 math-holidays-cache)))
(if hours
diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el
index add39b6f8b9..14f5e321080 100644
--- a/lisp/calc/calc-funcs.el
+++ b/lisp/calc/calc-funcs.el
@@ -816,25 +816,25 @@
(list
(list 'frac
-174611
- (math-read-number-simple "802857662698291200000"))
+ 802857662698291200000)
(list 'frac
43867
- (math-read-number-simple "5109094217170944000"))
+ 5109094217170944000)
(list 'frac
-3617
- (math-read-number-simple "10670622842880000"))
+ 10670622842880000)
(list 'frac
1
- (math-read-number-simple "74724249600"))
+ 74724249600)
(list 'frac
-691
- (math-read-number-simple "1307674368000"))
+ 1307674368000)
(list 'frac
1
- (math-read-number-simple "47900160"))
+ 47900160)
(list 'frac
-1
- (math-read-number-simple "1209600"))
+ 1209600)
(list 'frac
1
30240)
diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el
index fe241b57c60..2850b33721b 100644
--- a/lisp/calc/calc-mtx.el
+++ b/lisp/calc/calc-mtx.el
@@ -275,7 +275,7 @@ in LUD decomposition."
k (1+ k)))
(setcar (nthcdr j (nth i lu)) sum)
(let ((dum (math-lud-pivot-check sum)))
- (if (Math-lessp big dum)
+ (if (or (math-zerop big) (Math-lessp big dum))
(setq big dum
imax i)))
(setq i (1+ i)))
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el
index 5282b834021..79e6cf5c00c 100644
--- a/lisp/calc/calc-store.el
+++ b/lisp/calc/calc-store.el
@@ -428,11 +428,11 @@
(defun calc-edit-variable (&optional var)
(interactive)
(calc-wrapper
- (or var (setq var (calc-read-var-name
- (if calc-last-edited-variable
- (format "Edit (default %s): "
- (calc-var-name calc-last-edited-variable))
- "Edit: "))))
+ (unless var
+ (setq var (calc-read-var-name
+ (format-prompt "Edit" (and calc-last-edited-variable
+ (calc-var-name
+ calc-last-edited-variable))))))
(or var (setq var calc-last-edited-variable))
(if var
(let* ((value (calc-var-value var)))
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 7b86eb095b0..709c09ea099 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -37,14 +37,14 @@
;;; Updated April 2002 by Jochen Küpper
;;; Updated August 2007, using
-;;; CODATA (http://physics.nist.gov/cuu/Constants/index.html)
-;;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
+;;; CODATA (https://physics.nist.gov/cuu/Constants/index.html)
+;;; NIST (https://physics.nist.gov/Pubs/SP811/appenB9.html)
;;; ESUWM (Encyclopaedia of Scientific Units, Weights and
;;; Measures, by François Cardarelli)
;;; All conversions are exact unless otherwise noted.
;; CODATA values updated February 2016, using 2014 adjustment
-;; http://arxiv.org/pdf/1507.07956.pdf
+;; https://arxiv.org/pdf/1507.07956.pdf
;; Updated November 2018 for the redefinition of the SI
;; https://www.bipm.org/utils/en/pdf/CGPM/Draft-Resolution-A-EN.pdf
@@ -59,7 +59,7 @@
( mi "5280 ft" "Mile" )
( au "149597870691. m" "Astronomical Unit" nil
"149597870691 m (*)")
- ;; (approx) NASA JPL (http://neo.jpl.nasa.gov/glossary/au.html)
+ ;; (approx) NASA JPL (https://neo.jpl.nasa.gov/glossary/au.html)
( lyr "c yr" "Light Year" )
( pc "3.0856775854*10^16 m" "Parsec (**)" nil
"3.0856775854 10^16 m (*)") ;; (approx) ESUWM
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index f5150ca552c..690aaf2687f 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -150,34 +150,16 @@
;; otherwise it just parses the yanked string.
;; Modified to use Emacs 19 extended concept of kill-ring. -- daveg 12/15/96
;;;###autoload
-(defun calc-yank (radix)
- "Yank a value into the Calculator buffer.
-
-Valid numeric prefixes for RADIX: 0, 2, 6, 8
-No radix notation is prepended for any other numeric prefix.
-
-If RADIX is 2, prepend \"2#\" - Binary.
-If RADIX is 8, prepend \"8#\" - Octal.
-If RADIX is 0, prepend \"10#\" - Decimal.
-If RADIX is 6, prepend \"16#\" - Hexadecimal.
+(defun calc-yank-internal (radix thing-raw)
+ "Internal common implementation for yank functions.
-If RADIX is a non-nil list (created using \\[universal-argument]), the user
-will be prompted to enter the radix in the minibuffer.
-
-If RADIX is nil or if the yanked string already has a calc radix prefix, the
-yanked string will be passed on directly to the Calculator buffer without any
-alteration."
- (interactive "P")
+This function is used by both `calc-yank' and `calc-yank-mouse-primary'."
(calc-wrapper
(calc-pop-push-record-list
0 "yank"
(let* (radix-num
radix-notation
valid-num-regexp
- (thing-raw
- (if (fboundp 'current-kill)
- (current-kill 0 t)
- (car kill-ring-yank-pointer)))
(thing
(if (or (null radix)
;; Match examples: -2#10, 10\n(10#10,01)
@@ -232,6 +214,38 @@ alteration."
val))
val))))))))
+;;;###autoload
+(defun calc-yank-mouse-primary (radix)
+ "Yank the current primary selection into the Calculator buffer.
+See `calc-yank' for details about RADIX."
+ (interactive "P")
+ (if (or select-enable-primary
+ select-enable-clipboard)
+ (calc-yank-internal radix (gui-get-primary-selection))
+ ;; Yank from the kill ring.
+ (calc-yank radix)))
+
+;;;###autoload
+(defun calc-yank (radix)
+ "Yank a value into the Calculator buffer.
+
+Valid numeric prefixes for RADIX: 0, 2, 6, 8
+No radix notation is prepended for any other numeric prefix.
+
+If RADIX is 2, prepend \"2#\" - Binary.
+If RADIX is 8, prepend \"8#\" - Octal.
+If RADIX is 0, prepend \"10#\" - Decimal.
+If RADIX is 6, prepend \"16#\" - Hexadecimal.
+
+If RADIX is a non-nil list (created using \\[universal-argument]), the user
+will be prompted to enter the radix in the minibuffer.
+
+If RADIX is nil or if the yanked string already has a calc radix prefix, the
+yanked string will be passed on directly to the Calculator buffer without any
+alteration."
+ (interactive "P")
+ (calc-yank-internal radix (current-kill 0 t)))
+
;;; The Calc set- and get-register commands are modified versions of functions
;;; in register.el
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 648cb7bb807..bf8b006d7c6 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -884,6 +884,8 @@ Used by `calc-user-invocation'.")
(defvar calc-load-hook nil
"Hook run when calc.el is loaded.")
+(make-obsolete-variable 'calc-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defvar calc-window-hook nil
"Hook called to create the Calc window.")
@@ -1085,8 +1087,26 @@ Used by `calc-user-invocation'.")
(append (where-is-internal 'delete-backward-char global-map)
(where-is-internal 'backward-delete-char global-map)
(where-is-internal 'backward-delete-char-untabify global-map)
- '("\C-d"))
- '("\177" "\C-d")))
+ '("\177"))
+ '("\177")))
+
+(mapc (lambda (x)
+ (ignore-errors
+ (define-key calc-digit-map x 'calcDigit-delchar)
+ (define-key calc-mode-map x 'calc-pop)
+ (define-key calc-mode-map
+ (if (and (vectorp x) (featurep 'xemacs))
+ (if (= (length x) 1)
+ (vector (if (consp (aref x 0))
+ (cons 'meta (aref x 0))
+ (list 'meta (aref x 0))))
+ "\e\C-d")
+ (vconcat "\e" x))
+ 'calc-pop-above)))
+ (if calc-scan-for-dels
+ (append (where-is-internal 'delete-forward-char global-map)
+ '("\C-d"))
+ '("\C-d")))
(defvar calc-dispatch-map
(let ((map (make-keymap)))
@@ -1362,6 +1382,29 @@ Notations: 3.14e6 3.14 * 10^6
(set-keymap-parent map calc-mode-map)
map))
+(defun calc--header-line (long short width &optional fudge)
+ "Return a Calc header line appropriate for the buffer width.
+
+LONG is a desired text for a wide window, SHORT is a desired
+abbreviated text, and width is the buffer width, which will be
+some fraction of the 'parent' window width (At the time of
+writing, 2/3 for calc, 1/3 for trail). The optional FUDGE is a
+trial-and-error adjustment number for the edge-cases at the
+border of the two cases."
+ ;; TODO: This could be called as part of a 'window-resize' hook.
+ (setq header-line-format
+ (let* ((len-long (length long))
+ (len-short (length short))
+ (fudge (or fudge 0))
+ ;; fudge for trail is: -3 (added to len-long)
+ ;; (width ) for trail
+ (factor (if (> width (+ len-long fudge)) len-long len-short))
+ (size (max (/ (- width factor) 2) 0))
+ (fill (make-string size ?-))
+ (pre (replace-regexp-in-string ".$" " " fill))
+ (post (replace-regexp-in-string "^." " " fill)))
+ (concat pre (if (= factor len-long) long short) post))))
+
(define-derived-mode calc-trail-mode fundamental-mode "Calc Trail"
"Calc Trail mode.
This mode is used by the *Calc Trail* buffer, which records all results
@@ -1376,9 +1419,9 @@ commands given here will actually operate on the *Calculator* stack."
(setq buffer-read-only t)
(make-local-variable 'overlay-arrow-position)
(make-local-variable 'overlay-arrow-string)
- (when (= (buffer-size) 0)
- (let ((inhibit-read-only t))
- (insert (propertize "Emacs Calculator Trail\n" 'face 'italic)))))
+ (when calc-show-banner
+ (calc--header-line "Emacs Calculator Trail" "Calc Trail"
+ (/ (window-width) 3) -3)))
(defun calc-create-buffer ()
"Create and initialize a buffer for the Calculator."
@@ -1431,7 +1474,6 @@ commands given here will actually operate on the *Calculator* stack."
(pop-to-buffer (current-buffer)))))))
(with-current-buffer (calc-trail-buffer)
(and calc-display-trail
- (= (window-width) (frame-width))
(calc-trail-display 1 t)))
(message "Welcome to the GNU Emacs Calculator! Press `?' or `h' for help, `q' to quit")
(run-hooks 'calc-start-hook)
@@ -1966,13 +2008,11 @@ See calc-keypad for details."
(calc-any-evaltos nil))
(setq calc-any-selections nil)
(erase-buffer)
- (when calc-show-banner
- (insert (propertize "--- Emacs Calculator Mode ---\n"
- 'face 'italic)))
+ (when calc-show-banner
+ (calc--header-line "Emacs Calculator Mode" "Emacs Calc"
+ (* 2 (/ (window-width) 3)) -3))
(while thing
(goto-char (point-min))
- (when calc-show-banner
- (forward-line 1))
(insert (math-format-stack-value (car thing)) "\n")
(setq thing (cdr thing)))
(calc-renumber-stack)
@@ -2056,7 +2096,6 @@ the United States."
(eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
(with-current-buffer calc-trail-buffer
(goto-char (point-min))
- (forward-line 1)
(setq calc-trail-pointer (point-marker))))
calc-trail-buffer)
@@ -2124,10 +2163,8 @@ the United States."
(if (derived-mode-p 'calc-trail-mode)
(progn
(beginning-of-line)
- (if (bobp)
- (forward-line 1)
- (if (eobp)
- (forward-line -1)))
+ (if (eobp)
+ (forward-line -1))
(if (or (bobp) (eobp))
(setq overlay-arrow-position nil) ; trail is empty
(set-marker calc-trail-pointer (point) (current-buffer))
@@ -2141,7 +2178,7 @@ the United States."
(if win
(save-excursion
(forward-line (/ (window-height win) 2))
- (forward-line (- 1 (window-height win)))
+ (forward-line (- 2 (window-height win)))
(set-window-start win (point))
(set-window-point win (+ calc-trail-pointer 4))
(set-buffer calc-main-buffer)
@@ -2341,7 +2378,6 @@ the United States."
(defun calcDigit-key ()
(interactive)
- (goto-char (point-max))
(if (or (and (memq last-command-event '(?+ ?-))
(> (buffer-size) 0)
(/= (preceding-char) ?e))
@@ -2384,8 +2420,7 @@ the United States."
(delete-char 1))
(if (looking-at "-")
(delete-char 1)
- (insert "-")))
- (goto-char (point-max)))
+ (insert "-"))))
((eq last-command-event ?p)
(if (or (calc-minibuffer-contains ".*\\+/-.*")
(calc-minibuffer-contains ".*mod.*")
@@ -2427,7 +2462,7 @@ the United States."
(if (and (memq last-command-event '(?@ ?o ?h ?\' ?m))
(string-match " " calc-hms-format))
(insert " "))
- (if (and (eq this-command last-command)
+ (if (and (memq last-command '(calcDigit-start calcDigit-key))
(eq last-command-event ?.))
(progn
(require 'calc-ext)
@@ -2438,17 +2473,9 @@ the United States."
(setq calc-prev-prev-char calc-prev-char
calc-prev-char last-command-event))
-
(defun calcDigit-backspace ()
(interactive)
- (goto-char (point-max))
- (cond ((calc-minibuffer-contains ".* \\+/- \\'")
- (backward-delete-char 5))
- ((calc-minibuffer-contains ".* mod \\'")
- (backward-delete-char 5))
- ((calc-minibuffer-contains ".* \\'")
- (backward-delete-char 2))
- ((eq last-command 'calcDigit-start)
+ (cond ((eq last-command 'calcDigit-start)
(erase-buffer))
(t (backward-delete-char 1)))
(if (= (calc-minibuffer-size) 0)
@@ -2923,6 +2950,20 @@ the United States."
(- (- (nth 2 a) (nth 2 b)) ldiff))))
+(defun calcDigit-delchar ()
+ (interactive)
+ (cond ((looking-at-p " \\+/- \\'")
+ (delete-char 5))
+ ((looking-at-p " mod \\'")
+ (delete-char 5))
+ ((looking-at-p " \\'")
+ (delete-char 2))
+ ((eq last-command 'calcDigit-start)
+ (erase-buffer))
+ (t (unless (eobp) (delete-char 1))))
+ (when (= (calc-minibuffer-size) 0)
+ (setq last-command-event 13)
+ (calcDigit-nondigit)))
(defvar math-comp-selected)
@@ -3411,12 +3452,10 @@ See Info node `(calc)Defining Functions'."
(defun calc-clear-unread-commands ()
(setq unread-command-events nil))
-(defcalcmodevar math-2-word-size
- (math-read-number-simple "4294967296")
+(defcalcmodevar math-2-word-size 4294967296
"Two to the power of `calc-word-size'.")
-(defcalcmodevar math-half-2-word-size
- (math-read-number-simple "2147483648")
+(defcalcmodevar math-half-2-word-size 2147483648
"One-half of two to the power of `calc-word-size'.")
(when calc-always-load-extensions
diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el
index 67183fb754a..2d38c9c45bc 100644
--- a/lisp/calc/calcalg3.el
+++ b/lisp/calc/calcalg3.el
@@ -470,17 +470,19 @@
(setq defv (calc-invent-independent-variables nv)))
(or defc
(setq defc (calc-invent-parameter-variables nc defv)))
- (let ((vars (read-string (format "Fitting variables (default %s; %s): "
- (mapconcat 'symbol-name
- (mapcar (function (lambda (v)
- (nth 1 v)))
- defv)
- ",")
- (mapconcat 'symbol-name
- (mapcar (function (lambda (v)
- (nth 1 v)))
- defc)
- ","))))
+ (let ((vars (read-string (format-prompt
+ "Fitting variables"
+ (format "%s; %s"
+ (mapconcat 'symbol-name
+ (mapcar (function (lambda (v)
+ (nth 1 v)))
+ defv)
+ ",")
+ (mapconcat 'symbol-name
+ (mapcar (function (lambda (v)
+ (nth 1 v)))
+ defc)
+ ",")))))
(coefs nil))
(setq vars (if (string-match "\\[" vars)
(math-read-expr vars)
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 0367c537b5a..1f3ae842638 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -1018,7 +1018,8 @@
(make-string (+ w 2) ?\_))
(list 'horiz
(if (= h 1)
- "V"
+ (if (char-displayable-p ?√)
+ "√" "V")
(append (list 'vleft (1- a))
(make-list (1- h) " |")
'("\\|")))
diff --git a/lisp/calculator.el b/lisp/calculator.el
index 6996990814d..cd92f992689 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -858,13 +858,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)))))
- (let* ((str (replace-regexp-in-string
- "\\.\\([^0-9].*\\)?$" ".0\\1" str))
- (str (replace-regexp-in-string
- "[eE][+-]?\\([^0-9].*\\)?$" "e0\\1" str)))
- (string-to-number str))))
+ (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)))
+ (float (string-to-number str)))))
(defun calculator-push-curnum ()
"Push the numeric value of the displayed number to the stack."
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index b6bb040dd54..4bfdf3a6cf6 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -57,8 +57,8 @@
(defconst calendar-bahai-month-name-array
["Bahá" "Jalál" "Jamál" "‘Aẓamat" "Núr" "Raḥmat" "Kalimát" "Kamál"
- "Asmá’" "‘Izzat" "Mashíyyat" "‘Ilm" "Qudrat" "Qawl" "Masá’il"
- "Sharaf" "Sulṭán" "Mulk" "‘Alá’"]
+ "Asmá’" "‘Izzat" "Mas͟híyyat" "‘Ilm" "Qudrat" "Qawl" "Masá’il"
+ "S͟haraf" "Sulṭán" "Mulk" "‘Alá’"]
"Array of the month names in the Bahá’í calendar.")
(defconst calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844))
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index 3db12e668ab..05768e10c01 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -350,17 +350,31 @@ If the locale never uses daylight saving time, set this to 0."
:group 'calendar-dst)
(defcustom calendar-standard-time-zone-name
- (or (nth 2 calendar-current-time-zone-cache) "EST")
+ (if (eq calendar-time-zone-style 'numeric)
+ (if calendar-current-time-zone-cache
+ (format-time-string
+ "%z" 0 (* 60 (car calendar-current-time-zone-cache)))
+ "+0000")
+ (or (nth 2 calendar-current-time-zone-cache) "EST"))
"Abbreviated name of standard time zone at `calendar-location-name'.
For example, \"EST\" in New York City, \"PST\" for Los Angeles."
:type 'string
+ :version "28.1"
+ :set-after '(calendar-time-zone-style)
:group 'calendar-dst)
(defcustom calendar-daylight-time-zone-name
- (or (nth 3 calendar-current-time-zone-cache) "EDT")
+ (if (eq calendar-time-zone-style 'numeric)
+ (if calendar-current-time-zone-cache
+ (format-time-string
+ "%z" 0 (* 60 (cadr calendar-current-time-zone-cache)))
+ "+0000")
+ (or (nth 3 calendar-current-time-zone-cache) "EDT"))
"Abbreviated name of daylight saving time zone at `calendar-location-name'.
For example, \"EDT\" in New York City, \"PDT\" for Los Angeles."
:type 'string
+ :version "28.1"
+ :set-after '(calendar-time-zone-style)
:group 'calendar-dst)
(defcustom calendar-daylight-savings-starts-time
diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el
index 1c741317803..918995d0f9b 100644
--- a/lisp/calendar/cal-julian.el
+++ b/lisp/calendar/cal-julian.el
@@ -1,4 +1,4 @@
-;;; cal-julian.el --- calendar functions for the Julian calendar
+;;; cal-julian.el --- calendar functions for the Julian calendar -*- lexical-binding:t -*-
;; Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
@@ -182,23 +182,27 @@ Echo astronomical (Julian) day number unless NOECHO is non-nil."
(calendar-astro-to-absolute daynumber))))
(or noecho (calendar-astro-print-day-number)))
-
-;; The function below is designed to be used in sexp diary entries,
-;; and may be present in users' diary files, so suppress the warning
-;; about this prefix-less dynamic variable. It's called from
-;; `diary-list-sexp-entries', which binds the variable.
-(with-suppressed-warnings ((lexical date))
- (defvar date))
-
;;;###diary-autoload
(defun diary-julian-date ()
"Julian calendar equivalent of date diary entry."
+ ;; This function is designed to be used in sexp diary entries, and
+ ;; may be present in users' diary files, so suppress the warning
+ ;; about this prefix-less dynamic variable. It's called from
+ ;; `diary-list-sexp-entries', which binds the variable.
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(format "Julian date: %s" (calendar-julian-date-string date)))
;; To be called from diary-list-sexp-entries, where DATE is bound.
;;;###diary-autoload
(defun diary-astro-day-number ()
"Astronomical (Julian) day number diary entry."
+ ;; This function is designed to be used in sexp diary entries, and
+ ;; may be present in users' diary files, so suppress the warning
+ ;; about this prefix-less dynamic variable. It's called from
+ ;; `diary-list-sexp-entries', which binds the variable.
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(format "Astronomical (Julian) day number at noon UTC: %s.0"
(calendar-astro-date-string date)))
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 83e7976125f..de9b1f3ff53 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -136,14 +136,13 @@
;; - whatever is passed to diary-remind
(defmacro calendar-dlet* (binders &rest body)
- "Like `let*' but using dynamic scoping."
+ "Like `dlet' but without warnings about non-prefixed var names."
(declare (indent 1) (debug let))
- `(progn
- (with-no-warnings ;Silence "lacks a prefix" warnings!
- ,@(mapcar (lambda (binder)
- `(defvar ,(if (consp binder) (car binder) binder)))
- binders))
- (let* ,binders ,@body)))
+ (let ((vars (mapcar (lambda (binder)
+ (if (consp binder) (car binder) binder))
+ binders)))
+ `(with-suppressed-warnings ((lexical ,@vars))
+ (dlet ,binders ,@body))))
;; Avoid recursive load of calendar when loading cal-menu. Yuck.
(provide 'calendar)
@@ -995,7 +994,7 @@ pre-existing calendar windows."
"Set the style of calendar and diary dates to STYLE (a symbol).
The valid styles are described in the documentation of `calendar-date-style'."
(interactive (list (intern
- (completing-read "Date style: "
+ (completing-read (format-prompt "Date style" "american")
'("american" "european" "iso") nil t
nil nil "american"))))
(or (memq style '(american european iso))
@@ -1062,6 +1061,15 @@ calendar."
:type 'boolean
:group 'holidays)
+;; fixme should have a :set that changes calendar-standard-time-zone-name etc.
+(defcustom calendar-time-zone-style 'symbolic
+ "Your preferred style for time zones.
+If 'numeric, use numeric time zones like \"+0100\".
+Otherwise, use symbolic time zones like \"CET\"."
+ :type '(choice (const numeric) (other symbolic))
+ :version "28.1"
+ :group 'calendar)
+
;;; End of user options.
(calendar-recompute-layout-variables)
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 6d262088479..da98e44926e 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -98,7 +98,7 @@ specifies which face attribute (e.g. `:foreground') to modify, or
that this is a face (`:face') to apply. TYPE is the type of
attribute being applied. Available TYPES (see `diary-attrtype-convert')
are: `string', `symbol', `int', `tnil', `stringtnil'."
- :type '(repeat (list (string :tag "Regular expression")
+ :type '(repeat (list (regexp :tag "Regular expression")
(integer :tag "Sub-expression")
(symbol :tag "Attribute (e.g. :foreground)")
(choice (const string :tag "A string")
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 6847ba97496..dab277487e2 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -6,7 +6,7 @@
;; Created: August 2002
;; Keywords: calendar
;; Human-Keywords: calendar, diary, iCalendar, vCalendar
-;; Version: 0.19
+;; Old-Version: 0.19
;; This file is part of GNU Emacs.
@@ -107,6 +107,7 @@
(defconst icalendar-version "0.19"
"Version number of icalendar.el.")
+(make-obsolete-variable 'icalendar-version nil "28.1")
;; ======================================================================
;; Customizables
@@ -514,9 +515,10 @@ The strings are suitable for assembling into a TZ variable."
(let* ((offsetto (car (cddr (assq 'TZOFFSETTO alist))))
(offsetfrom (car (cddr (assq 'TZOFFSETFROM alist))))
(rrule-value (car (cddr (assq 'RRULE alist))))
+ (rdate-p (and (assq 'RDATE alist) t))
(dtstart (car (cddr (assq 'DTSTART alist))))
- (no-dst (equal offsetto offsetfrom)))
- ;; FIXME: for now we only handle RRULE and not RDATE here.
+ (no-dst (or rdate-p (equal offsetto offsetfrom))))
+ ;; FIXME: the presence of an RDATE is assumed to denote the first day of the year
(when (and offsetto dtstart (or rrule-value no-dst))
(let* ((rrule (icalendar--split-value rrule-value))
(freq (cadr (assq 'FREQ rrule)))
@@ -560,12 +562,13 @@ The strings are suitable for assembling into a TZ variable."
(defun icalendar--parse-vtimezone (alist)
"Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
+Consider only the most recent date specification.
Return nil if timezone cannot be parsed."
(let* ((tz-id (icalendar--convert-string-for-import
(icalendar--get-event-property alist 'TZID)))
- (daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT))))
+ (daylight (cadr (cdar (icalendar--get-most-recent-observance alist 'DAYLIGHT))))
(day (and daylight (icalendar--convert-tz-offset daylight t)))
- (standard (cadr (cdar (icalendar--get-children alist 'STANDARD))))
+ (standard (cadr (cdar (icalendar--get-most-recent-observance alist 'STANDARD))))
(std (and standard (icalendar--convert-tz-offset standard nil))))
(if (and tz-id std)
(cons tz-id
@@ -574,6 +577,28 @@ Return nil if timezone cannot be parsed."
"," (cdr day) "," (cdr std))
(car std))))))
+(defun icalendar--get-most-recent-observance (alist sub-comp)
+ "Return the latest observance for SUB-COMP DAYLIGHT or STANDARD.
+ALIST is a VTIMEZONE potentially containing historical records."
+;FIXME?: "most recent" should be relative to a given date
+ (let ((components (icalendar--get-children alist sub-comp)))
+ (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))))))))
+
(defun icalendar--convert-all-timezones (icalendar)
"Convert all timezones in the ICALENDAR into an alist.
Each element of the alist is a cons (ID . TZ-STRING),
@@ -593,15 +618,18 @@ ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'."
(cdr (assoc id zone-map)))))
(defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift
- zone)
+ source-zone
+ result-zone)
"Return ISODATETIMESTRING in format like `decode-time'.
Converts from ISO-8601 to Emacs representation. If
ISODATETIMESTRING specifies UTC time (trailing letter Z) the
decoded time is given in the local time zone! If optional
parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT
days.
-ZONE, if provided, is the timezone, in any format understood by `encode-time'.
-
+SOURCE-ZONE, if provided, is the timezone for decoding the time,
+in any format understood by `encode-time'.
+RESULT-ZONE, if provided, is the timezone for encoding the result
+in any format understood by `decode-time'.
FIXME: multiple comma-separated values should be allowed!"
(icalendar--dmsg isodatetimestring)
(if isodatetimestring
@@ -623,7 +651,10 @@ FIXME: multiple comma-separated values should be allowed!"
(when (and (> (length isodatetimestring) 15)
;; UTC specifier present
(char-equal ?Z (aref isodatetimestring 15)))
- (setq zone t))
+ (setq source-zone t
+ ;; decode to local time unless result-zone is explicitly given,
+ ;; i.e. do not decode to UTC, i.e. do not (setq result-zone t)
+ ))
;; shift if necessary
(if day-shift
(let ((mdy (calendar-gregorian-from-absolute
@@ -636,9 +667,9 @@ FIXME: multiple comma-separated values should be allowed!"
;; create the decoded date-time
;; FIXME!?!
(let ((decoded-time (list second minute hour day month year
- nil -1 zone)))
+ nil -1 source-zone)))
(condition-case nil
- (decode-time (encode-time decoded-time))
+ (decode-time (encode-time decoded-time) result-zone)
(error
(message "Cannot decode \"%s\"" isodatetimestring)
;; Hope for the best....
@@ -684,9 +715,9 @@ FIXME: multiple comma-separated values should be allowed!"
(setq days (1- days))))
((match-beginning 4) ;days and time
(if (match-beginning 5)
- (setq days (* 7 (read (substring isodurationstring
- (match-beginning 6)
- (match-end 6))))))
+ (setq days (read (substring isodurationstring
+ (match-beginning 6)
+ (match-end 6)))))
(if (match-beginning 7)
(setq hours (read (substring isodurationstring
(match-beginning 8)
diff --git a/lisp/calendar/iso8601.el b/lisp/calendar/iso8601.el
index ae1dab17252..906c29b15f4 100644
--- a/lisp/calendar/iso8601.el
+++ b/lisp/calendar/iso8601.el
@@ -69,6 +69,8 @@
"\\([+-]?[0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)")
(defconst iso8601--outdated-date-match
"--\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)")
+(defconst iso8601--outdated-reduced-precision-date-match
+ "---?\\([0-9][0-9]\\)")
(defconst iso8601--week-date-match
"\\([+-]?[0-9][0-9][0-9][0-9]\\)-?W\\([0-9][0-9]\\)-?\\([0-9]\\)?")
(defconst iso8601--ordinal-date-match
@@ -79,6 +81,7 @@
iso8601--full-date-match
iso8601--without-day-match
iso8601--outdated-date-match
+ iso8601--outdated-reduced-precision-date-match
iso8601--week-date-match
iso8601--ordinal-date-match)))
@@ -136,7 +139,8 @@ See `decode-time' for the meaning of FORM."
(when zone-string
(setf (decoded-time-zone date)
;; The time zone in decoded times are in seconds.
- (* (iso8601-parse-zone zone-string) 60)))
+ (* (iso8601-parse-zone zone-string) 60))
+ (setf (decoded-time-dst date) nil))
date)))
(defun iso8601-parse-date (string)
@@ -201,6 +205,12 @@ See `decode-time' for the meaning of FORM."
(iso8601--decoded-time :year year
:month (decoded-time-month month-day)
:day (decoded-time-day month-day))))
+ ;; Obsolete format with implied year: --MM
+ ((iso8601--match "--\\([0-9][0-9]\\)" string)
+ (iso8601--decoded-time :month (string-to-number (match-string 1 string))))
+ ;; Obsolete format with implied year and month: ---DD
+ ((iso8601--match "---\\([0-9][0-9]\\)" string)
+ (iso8601--decoded-time :day (string-to-number (match-string 1 string))))
(t
(signal 'wrong-type-argument string))))
@@ -332,6 +342,9 @@ Return the number of minutes."
(list start end
(or duration
;; FIXME: Support subseconds.
+ ;; FIXME: It makes no sense to decode a time difference
+ ;; according to (decoded-time-zone end), or according to
+ ;; any other time zone for that matter.
(decode-time (time-subtract (iso8601--encode-time end)
(iso8601--encode-time start))
(or (decoded-time-zone end) 0) 'integer)))))
@@ -354,7 +367,7 @@ Return the number of minutes."
(iso8601--value month)
(iso8601--value year)
nil
- dst
+ (if (or dst zone) dst -1)
zone))
(defun iso8601--encode-time (time)
diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el
index 616d2b0c4ed..1c0f4da0f4b 100644
--- a/lisp/calendar/lunar.el
+++ b/lisp/calendar/lunar.el
@@ -1,4 +1,4 @@
-;;; lunar.el --- calendar functions for phases of the moon
+;;; lunar.el --- calendar functions for phases of the moon -*- lexical-binding:t -*-
;; Copyright (C) 1992-1993, 1995, 1997, 2001-2020 Free Software
;; Foundation, Inc.
@@ -91,6 +91,7 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
(* -0.0016528 time time)
(* -0.00000239 time time time))
360.0))
+ (eclipse (eclipse-check moon-lat phase))
(adjustment
(if (memq phase '(0 2))
(+ (* (- 0.1734 (* 0.000393 time))
@@ -146,7 +147,26 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
(time (* 24 (- date (truncate date))))
(date (calendar-gregorian-from-absolute (truncate date)))
(adj (dst-adjust-time date time)))
- (list (car adj) (apply 'solar-time-string (cdr adj)) phase)))
+ (list (car adj) (apply 'solar-time-string (cdr adj)) phase eclipse)))
+
+;; from "Astronomy with your Personal Computer", Subroutine Eclipse
+;; Line 7000 Peter Duffett-Smith Cambridge University Press 1990
+(defun eclipse-check (moon-lat phase)
+ (let* ((moon-lat (* (/ float-pi 180) moon-lat))
+ (moon-lat (abs (- moon-lat (* (floor (/ moon-lat float-pi))
+ float-pi))))
+ (moon-lat (if (> moon-lat 0.37)
+ (- float-pi moon-lat)
+ moon-lat))
+ (phase-name (cond ((= phase 0) "Solar")
+ ((= phase 2) "Lunar")
+ (t ""))))
+ (cond ((< moon-lat 2.42600766e-1)
+ (concat "** " phase-name " Eclipse **"))
+ ((< moon-lat 0.37)
+ (concat "** " phase-name " Eclipse possible **"))
+ (t
+ ""))))
(defconst lunar-cycles-per-year 12.3685 ; 365.25/29.530588853
"Mean number of lunar cycles per 365.25 day year.")
@@ -222,9 +242,10 @@ use instead of point."
(insert
(mapconcat
(lambda (x)
- (format "%s: %s %s" (calendar-date-string (car x))
+ (format "%s: %s %s %s" (calendar-date-string (car x))
(lunar-phase-name (nth 2 x))
- (cadr x)))
+ (cadr x)
+ (car (last x))))
(lunar-phase-list m1 y1) "\n")))
(message "Computing phases of the moon...done"))))
@@ -234,6 +255,8 @@ use instead of point."
If called with an optional prefix argument ARG, prompts for month and year.
This function is suitable for execution in an init file."
(interactive "P")
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(save-excursion
(let* ((date (if arg (calendar-read-date t)
(calendar-current-date)))
@@ -241,18 +264,17 @@ This function is suitable for execution in an init file."
(displayed-year (calendar-extract-year date)))
(calendar-lunar-phases))))
-;; The function below is designed to be used in sexp diary entries,
-;; and may be present in users' diary files, so suppress the warning
-;; about this prefix-less dynamic variable. It's called from
-;; `diary-list-sexp-entries', which binds the variable.
-(with-suppressed-warnings ((lexical date))
- (defvar date))
-
;;;###diary-autoload
(defun diary-lunar-phases (&optional mark)
"Moon phases diary entry.
An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
+ ;; This function is designed to be used in sexp diary entries, and
+ ;; may be present in users' diary files, so suppress the warning
+ ;; about this prefix-less dynamic variable. It's called from
+ ;; `diary-list-sexp-entries', which binds the variable.
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(let* ((index (lunar-index date))
(phase (lunar-phase index)))
(while (calendar-date-compare phase (list date))
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index 7110a81f0de..b199fca2db5 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -149,62 +149,62 @@ letters, digits, plus or minus signs or colons."
;;;###autoload
(defun parse-time-string (string)
"Parse the time in STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
-STRING should be something resembling an RFC 822 (or later) date-time, e.g.,
-\"Fri, 25 Mar 2016 16:24:56 +0100\", but this function is
+STRING should be an ISO 8601 time string, e.g., \"2020-01-15T16:12:21-08:00\",
+or something resembling an RFC 822 (or later) date-time, e.g.,
+\"Wed, 15 Jan 2020 16:12:21 -0800\". This function is
somewhat liberal in what format it accepts, and will attempt to
return a \"likely\" value even for somewhat malformed strings.
The values returned are identical to those of `decode-time', but
any unknown values other than DST are returned as nil, and an
unknown DST value is returned as -1."
- (let ((time (list nil nil nil nil nil nil nil -1 nil))
- (temp (parse-time-tokenize (downcase string))))
- (while temp
- (let ((parse-time-elt (pop temp))
- (rules parse-time-rules)
- (exit nil))
- (while (and rules (not exit))
- (let* ((rule (pop rules))
- (slots (pop rule))
- (predicate (pop rule))
- (parse-time-val))
- (when (and (not (nth (car slots) time)) ;not already set
- (setq parse-time-val
- (cond ((and (consp predicate)
- (not (functionp predicate)))
- (and (numberp parse-time-elt)
- (<= (car predicate) parse-time-elt)
- (or (not (cdr predicate))
- (<= parse-time-elt
- (cadr predicate)))
- parse-time-elt))
- ((symbolp predicate)
- (cdr (assoc parse-time-elt
- (symbol-value predicate))))
- ((funcall predicate)))))
- (setq exit t)
- (while slots
- (let ((new-val (if rule
- (let ((this (pop rule)))
- (if (vectorp this)
- (cl-parse-integer
- parse-time-elt
- :start (aref this 0)
- :end (aref this 1))
- (funcall this)))
- parse-time-val)))
- (setf (nth (pop slots) time) new-val))))))))
- time))
+ (condition-case ()
+ (iso8601-parse string)
+ (wrong-type-argument
+ (let ((time (list nil nil nil nil nil nil nil -1 nil))
+ (temp (parse-time-tokenize (downcase string))))
+ (while temp
+ (let ((parse-time-elt (pop temp))
+ (rules parse-time-rules)
+ (exit nil))
+ (while (and rules (not exit))
+ (let* ((rule (pop rules))
+ (slots (pop rule))
+ (predicate (pop rule))
+ (parse-time-val))
+ (when (and (not (nth (car slots) time)) ;not already set
+ (setq parse-time-val
+ (cond ((and (consp predicate)
+ (not (functionp predicate)))
+ (and (numberp parse-time-elt)
+ (<= (car predicate) parse-time-elt)
+ (or (not (cdr predicate))
+ (<= parse-time-elt
+ (cadr predicate)))
+ parse-time-elt))
+ ((symbolp predicate)
+ (cdr (assoc parse-time-elt
+ (symbol-value predicate))))
+ ((funcall predicate)))))
+ (setq exit t)
+ (while slots
+ (let ((new-val (if rule
+ (let ((this (pop rule)))
+ (if (vectorp this)
+ (cl-parse-integer
+ parse-time-elt
+ :start (aref this 0)
+ :end (aref this 1))
+ (funcall this)))
+ parse-time-val)))
+ (setf (nth (pop slots) time) new-val))))))))
+ time))))
(defun parse-iso8601-time-string (date-string)
- "Parse an ISO 8601 time string, such as 2016-12-01T23:35:06-05:00.
-If DATE-STRING cannot be parsed, it falls back to
-`parse-time-string'."
- (when-let ((time
- (if (iso8601-valid-p date-string)
- (decoded-time-set-defaults (iso8601-parse date-string))
- ;; Fall back to having `parse-time-string' do fancy
- ;; things for us.
- (parse-time-string date-string))))
+ "Parse an ISO 8601 time string, such as \"2020-01-15T16:12:21-08:00\".
+Fall back on parsing something resembling an RFC 822 (or later) date-time.
+This function is like `parse-time-string' except that it returns
+a Lisp timestamp when successful."
+ (when-let ((time (parse-time-string date-string)))
(encode-time time)))
(provide 'parse-time)
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index 6a813e9ee82..05bb3164e12 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -209,7 +209,6 @@ Returns nil if nothing was entered."
(defun solar-setup ()
"Prompt for `calendar-longitude', `calendar-latitude', `calendar-time-zone'."
- (beep)
(or calendar-longitude
(setq calendar-longitude
(solar-get-number
@@ -840,7 +839,9 @@ This function is suitable for execution in an init file."
"E" "W"))))))
(calendar-standard-time-zone-name
(if (< arg 16) calendar-standard-time-zone-name
- (cond ((zerop calendar-time-zone) "UTC")
+ (cond ((zerop calendar-time-zone)
+ (if (eq calendar-time-zone-style 'numeric)
+ "+0000" "UTC"))
((< calendar-time-zone 0)
(format "UTC%dmin" calendar-time-zone))
(t (format "UTC+%dmin" calendar-time-zone)))))
@@ -1013,7 +1014,10 @@ Requires floating point."
(let* ((m displayed-month)
(y displayed-year)
(calendar-standard-time-zone-name
- (if calendar-time-zone calendar-standard-time-zone-name "UTC"))
+ (cond
+ (calendar-time-zone calendar-standard-time-zone-name)
+ ((eq calendar-time-zone-style 'numeric) "+0000")
+ (t "UTC")))
(calendar-daylight-savings-starts
(if calendar-time-zone calendar-daylight-savings-starts))
(calendar-daylight-savings-ends
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 1e589ece29d..638d8c1f884 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -355,6 +355,8 @@ is output until the first non-zero unit is encountered."
(defun date-days-in-month (year month)
"The number of days in MONTH in YEAR."
+ (unless (and (numberp month) (<= 1 month 12))
+ (error "Month %s is invalid" month))
(if (= month 2)
(if (date-leap-year-p year)
29
@@ -399,10 +401,10 @@ changes in daylight saving time are not taken into account."
(when (decoded-time-year delta)
(cl-incf (decoded-time-year time) (decoded-time-year delta)))
- ;; Months are pretty simple.
+ ;; Months are pretty simple, but start at 1 (for January).
(when (decoded-time-month delta)
- (let ((new (+ (decoded-time-month time) (decoded-time-month delta))))
- (setf (decoded-time-month time) (mod new 12))
+ (let ((new (+ (1- (decoded-time-month time)) (decoded-time-month delta))))
+ (setf (decoded-time-month time) (1+ (mod new 12)))
(cl-incf (decoded-time-year time) (/ new 12))))
;; Adjust for month length (as described in the doc string).
@@ -515,17 +517,31 @@ TIME is modified and returned."
(unless (decoded-time-year time)
(setf (decoded-time-year time) 0))
- ;; When we don't have a time zone and we don't have a DST, then mark
- ;; it as unknown.
- (when (and (not (decoded-time-zone time))
- (not (decoded-time-dst time)))
- (setf (decoded-time-dst time) -1))
+ ;; When we don't have a time zone, default to DEFAULT-ZONE without
+ ;; DST if DEFAULT-ZONE if given, and to unknown DST otherwise.
+ (unless (decoded-time-zone time)
+ (if default-zone
+ (progn (setf (decoded-time-zone time) default-zone)
+ (setf (decoded-time-dst time) nil))
+ (setf (decoded-time-dst time) -1)))
- (when (and (not (decoded-time-zone time))
- default-zone)
- (setf (decoded-time-zone time) 0))
time)
+(defun decoded-time-period (time)
+ "Interpret DECODED as a period and return its length in seconds.
+For computational purposes, years are 365 days long and months
+are 30 days long."
+ (+ (if (consp (decoded-time-second time))
+ ;; Fractional second.
+ (/ (float (car (decoded-time-second time)))
+ (cdr (decoded-time-second time)))
+ (or (decoded-time-second time) 0))
+ (* (or (decoded-time-minute time) 0) 60)
+ (* (or (decoded-time-hour time) 0) 60 60)
+ (* (or (decoded-time-day time) 0) 60 60 24)
+ (* (or (decoded-time-month time) 0) 60 60 24 30)
+ (* (or (decoded-time-year time) 0) 60 60 24 365)))
+
(provide 'time-date)
;;; time-date.el ends here
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index ca9f16ef20b..18ca05af4c5 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -193,6 +193,8 @@ to today."
(defcustom timeclock-load-hook nil
"Hook that gets run after timeclock has been loaded."
:type 'hook)
+(make-obsolete-variable 'timeclock-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom timeclock-in-hook nil
"A hook run every time an \"in\" event is recorded."
@@ -595,9 +597,9 @@ arguments of `completing-read'."
(defun timeclock-ask-for-project ()
"Ask the user for the project they are clocking into."
(completing-read
- (format "Clock into which project (default %s): "
- (or timeclock-last-project
- (car timeclock-project-list)))
+ (format-prompt "Clock into which project"
+ (or timeclock-last-project
+ (car timeclock-project-list)))
timeclock-project-list
nil nil nil nil
(or timeclock-last-project
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index a49f428a3c8..3975a9ba6a9 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -1937,11 +1937,13 @@ their associated keys and their effects."
(find-file-noselect file 'nowarn)
(set-window-buffer (selected-window)
(set-buffer (find-buffer-visiting file)))
- ;; If this command was invoked outside of a Todo mode buffer,
- ;; the call to todo-current-category above returned nil. If
- ;; we just entered Todo mode now, then cat was set to the
- ;; file's first category, but if todo-mode was already
- ;; enabled, cat did not get set, so we have to do that.
+ ;; If FILE is not in Todo mode, set it now, which also sets
+ ;; CAT to the file's first category.
+ (unless (derived-mode-p 'todo-mode) (todo-mode))
+ ;; But if FILE was already in todo-mode and the item insertion
+ ;; command was invoked outside of a Todo mode buffer, the
+ ;; above calls to todo-current-category returned nil, so we
+ ;; have to explicitly set CAT to the current category.
(unless cat
(setq cat (todo-current-category)))
(setq todo-current-todo-file file)
@@ -2169,7 +2171,9 @@ the item at point."
(if comment-delete
(when (todo-y-or-n-p "Delete comment? ")
(delete-region (match-beginning 0) (match-end 0)))
- (replace-match (read-string prompt (cons (match-string 1) 1))
+ (replace-match (save-match-data
+ (read-string prompt
+ (cons (match-string 1) 1)))
nil nil nil 1))
(if comment-delete
(user-error "There is no comment to delete")
@@ -2348,25 +2352,35 @@ made in the number or names of categories."
((or (string= omonth "*") (= mm 13))
(user-error "Cannot increment *"))
(t
- (let ((mminc (+ mm inc (if (< inc 0) 12 0))))
- ;; Increment or decrement month by INC
- ;; modulo 12.
- (setq mm (% mminc 12))
- ;; If result is 0, make month December.
- (setq mm (if (= mm 0) 12 (abs mm)))
+ (let* ((mmo mm)
+ ;; Change by 12 or more months?
+ (bigincp (>= (abs inc) 12))
+ ;; Month number is in range 1..12.
+ (mminc (+ mm (% inc 12)))
+ (mm (% (+ mminc 12) 12))
+ ;; 12n mod 12 = 0, so 0 is December.
+ (mm (if (= mm 0) 12 mm))
+ ;; Does change in month cross year?
+ (mmcmp (cond ((< inc 0) (> mm mmo))
+ ((> inc 0) (< mm mmo))))
+ (yyadjust (if bigincp
+ (+ (abs (/ inc 12))
+ (if mmcmp 1 0))
+ 1)))
;; Adjust year if necessary.
- (setq year (or (and (cond ((> mminc 12)
- (+ yy (/ mminc 12)))
- ((< mminc 1)
- (- yy (/ mminc 12) 1))
- (t yy))
- (number-to-string yy))
- oyear)))
- ;; Return the changed numerical month as
- ;; a string or the corresponding month name.
- (if omonth
- (number-to-string mm)
- (aref tma-array (1- mm))))))
+ (setq yy (cond ((and (< inc 0)
+ (or mmcmp bigincp))
+ (- yy yyadjust))
+ ((and (> inc 0)
+ (or mmcmp bigincp))
+ (+ yy yyadjust))
+ (t yy)))
+ (setq year (number-to-string yy))
+ ;; Return the changed numerical month as
+ ;; a string or the corresponding month name.
+ (if omonth
+ (number-to-string mm)
+ (aref tma-array (1- mm)))))))
;; Since the number corresponding to the arbitrary
;; month name "*" is out of the range of
;; calendar-last-day-of-month, set it to 1
@@ -4062,7 +4076,9 @@ regexp items."
((equal (file-name-extension f) "todt") "top")
((equal (file-name-extension f) "tody") "diary"))))
(push (cons (concat sf-name " (" type ")") f) falist)))
- (setq file (completing-read "Choose a filtered items file: " falist nil t nil
+ (setq file (completing-read (format-prompt "Choose a filtered items file"
+ (caar falist))
+ falist nil t nil
'todo--fifiles-history (caar falist)))
(setq file (cdr (assoc-string file falist)))
(find-file file)
@@ -4710,9 +4726,8 @@ name in `todo-directory'. See also the documentation string of
(todo-convert-legacy-date-time)))
(forward-line))
(setq file (concat todo-directory
- (read-string
- (format "Save file as (default \"%s\"): " default)
- nil nil default)
+ (read-string (format-prompt "Save file as" default)
+ nil nil default)
".todo"))
(unless (file-exists-p todo-directory)
(make-directory todo-directory))
@@ -5923,8 +5938,15 @@ categories from `todo-category-completions-files'."
(todo-absolute-file-name
(let ((files (mapcar #'todo-short-file-name catfil)))
(completing-read (format str cat) files)))))))
- ;; Default to the current file.
- (unless file0 (setq file0 todo-current-todo-file))
+ ;; When called without arg FILE, use fallback todo file.
+ (unless file0 (setq file0 (or todo-current-todo-file
+ ;; If we're outside of todo-mode
+ ;; but there is a current todo
+ ;; file, use it.
+ todo-global-current-todo-file
+ ;; Else, use the default todo file.
+ (todo-absolute-file-name
+ todo-default-todo-file))))
;; First validate only a name passed interactively from
;; todo-add-category, which must be of a nonexistent category.
(unless (and (assoc cat categories) (not add))
@@ -6087,11 +6109,12 @@ Valid time strings are those matching `diary-time-regexp'.
Typing `<return>' at the prompt returns the current time, if the
user option `todo-always-add-time-string' is non-nil, otherwise
the empty string (i.e., no time string)."
- (let (valid answer)
+ (let ((default (when todo-always-add-time-string
+ (format-time-string "%H:%M")))
+ valid answer)
(while (not valid)
- (setq answer (read-string "Enter a clock time: " nil nil
- (when todo-always-add-time-string
- (format-time-string "%H:%M"))))
+ (setq answer (read-string (format-prompt "Enter a clock time" default)
+ nil nil default))
(when (or (string= "" answer)
(string-match diary-time-regexp answer))
(setq valid t)))
@@ -6419,8 +6442,7 @@ Filtered Items mode following todo (not done) items."
("i" todo-insert-item)
("k" todo-delete-item)
("m" todo-move-item)
- ("u" todo-item-undone)
- ([remap newline] newline-and-indent))
+ ("u" todo-item-undone))
"List of key bindings for Todo mode only.")
(defvar todo-key-bindings-t+a+f
@@ -6486,7 +6508,6 @@ Filtered Items mode following todo (not done) items."
(defvar todo-edit-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-x\C-q" 'todo-edit-quit)
- (define-key map [remap newline] 'newline-and-indent)
map)
"Todo Edit mode keymap.")
@@ -6645,7 +6666,6 @@ Added to `window-configuration-change-hook' in Todo mode."
(setq-local font-lock-defaults '(todo-font-lock-keywords t))
(setq-local revert-buffer-function #'todo-revert-buffer)
(setq-local tab-width todo-indent-to-here)
- (setq-local indent-line-function #'todo-indent)
(when todo-wrap-lines
(visual-line-mode)
(setq wrap-prefix (make-string todo-indent-to-here 32))))
@@ -6720,6 +6740,7 @@ Added to `window-configuration-change-hook' in Todo mode."
\\{todo-edit-mode-map}"
(todo-modes-set-1)
+ (setq-local indent-line-function #'todo-indent)
(if (> (buffer-size) (- (point-max) (point-min)))
;; Editing one item in an indirect buffer, so buffer-file-name is nil.
(setq-local todo-current-todo-file todo-global-current-todo-file)
diff --git a/lisp/cdl.el b/lisp/cdl.el
index adc05f1bb52..c8025a9f530 100644
--- a/lisp/cdl.el
+++ b/lisp/cdl.el
@@ -1,4 +1,4 @@
-;;; cdl.el --- Common Data Language (CDL) utility functions for GNU Emacs
+;;; cdl.el --- Common Data Language (CDL) utility functions for GNU Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el
index 78a72dd889c..44cce389cb3 100644
--- a/lisp/cedet/data-debug.el
+++ b/lisp/cedet/data-debug.el
@@ -38,7 +38,7 @@
;; "Calculate something complicated at point, and return it."
;; (interactive) ;; function not normally interactive
;; (let ((stuff (do-stuff)))
-;; (when (interactive-p)
+;; (when (called-interactively-p 'interactive)
;; (data-debug-show-stuff stuff "myStuff"))
;; stuff))
@@ -49,9 +49,9 @@
;;; Compatibility
;;
-(defalias 'data-debug-overlay-properties 'overlay-properties)
-(defalias 'data-debug-overlay-p 'overlayp)
-(defalias 'dd-propertize 'propertize)
+(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
;;
@@ -73,7 +73,7 @@ The attributes belong to the tag PARENT."
"Insert all the parts of OVERLAY.
PREFIX specifies what to insert at the start of each line."
(let ((attrprefix (concat (make-string (length prefix) ? ) "# "))
- (proplist (data-debug-overlay-properties overlay)))
+ (proplist (overlay-properties overlay)))
(data-debug-insert-property-list
proplist attrprefix)
)
@@ -393,10 +393,10 @@ PREBUTTONTEXT is some text between prefix and the stuff list button."
(lambda (key value)
(data-debug-insert-thing
key prefix
- (dd-propertize "key " 'face font-lock-comment-face))
+ (propertize "key " 'face font-lock-comment-face))
(data-debug-insert-thing
value prefix
- (dd-propertize "val " 'face font-lock-comment-face)))
+ (propertize "val " 'face font-lock-comment-face)))
hash-table))
(defun data-debug-insert-hash-table-from-point (point)
@@ -415,9 +415,9 @@ PREBUTTONTEXT is some text between prefix and the stuff list button."
(defun data-debug-insert-hash-table-button (hash-table prefix prebuttontext)
"Insert HASH-TABLE as expandable button with recursive prefix PREFIX and PREBUTTONTEXT in front of the button text."
- (let ((string (dd-propertize (format "%s" hash-table)
+ (let ((string (propertize (format "%s" hash-table)
'face 'font-lock-keyword-face)))
- (insert (dd-propertize
+ (insert (propertize
(concat prefix prebuttontext string)
'ddebug hash-table
'ddebug-indent (length prefix)
@@ -444,7 +444,7 @@ PREBUTTONTEXT is some text between prefix and the stuff list button."
(data-debug-insert-thing (car (cdr rest))
prefix
(concat
- (dd-propertize (format "%s" (car rest))
+ (propertize (format "%s" (car rest))
'face font-lock-comment-face)
" : "))
(setq rest (cdr (cdr rest))))
@@ -468,9 +468,9 @@ PREBUTTONTEXT is some text between prefix and the stuff list button."
A Symbol is a simple thing, but this provides some face and prefix rules.
PREFIX is the text that precedes the button.
PREBUTTONTEXT is some text between prefix and the thing."
- (let ((string (dd-propertize (format "#<WIDGET %s>" (car widget))
+ (let ((string (propertize (format "#<WIDGET %s>" (car widget))
'face 'font-lock-keyword-face)))
- (insert (dd-propertize
+ (insert (propertize
(concat prefix prebuttontext string)
'ddebug widget
'ddebug-indent (length prefix)
@@ -613,7 +613,7 @@ PREBUTTONTEXT is some text between prefix and the stuff vector button."
(symbol-value symbol)
(concat (make-string indent ? ) "> ")
(concat
- (dd-propertize "value"
+ (propertize "value"
'face 'font-lock-comment-face)
" ")))
(data-debug-insert-property-list
@@ -628,13 +628,13 @@ PREFIX is the text that precedes the button.
PREBUTTONTEXT is some text between prefix and the symbol button."
(let ((string
(cond ((fboundp symbol)
- (dd-propertize (concat "#'" (symbol-name symbol))
+ (propertize (concat "#'" (symbol-name symbol))
'face 'font-lock-function-name-face))
((boundp symbol)
- (dd-propertize (concat "'" (symbol-name symbol))
+ (propertize (concat "'" (symbol-name symbol))
'face 'font-lock-variable-name-face))
(t (format "'%s" symbol)))))
- (insert (dd-propertize
+ (insert (propertize
(concat prefix prebuttontext string)
'ddebug symbol
'ddebug-indent (length prefix)
@@ -657,7 +657,7 @@ PREBUTTONTEXT is some text between prefix and the thing."
(while (string-match "\t" newstr)
(setq newstr (replace-match "\\t" t t newstr)))
(insert prefix prebuttontext
- (dd-propertize (format "\"%s\"" newstr)
+ (propertize (format "\"%s\"" newstr)
'face font-lock-string-face)
"\n" )))
@@ -668,7 +668,7 @@ A Symbol is a simple thing, but this provides some face and prefix rules.
PREFIX is the text that precedes the button.
PREBUTTONTEXT is some text between prefix and the thing."
(insert prefix prebuttontext
- (dd-propertize (format "%S" thing)
+ (propertize (format "%S" thing)
'face font-lock-string-face)
"\n"))
@@ -737,10 +737,10 @@ FACE is the face to use."
(null . data-debug-insert-nil)
;; Overlay
- (data-debug-overlay-p . data-debug-insert-overlay-button)
+ (overlayp . data-debug-insert-overlay-button)
;; Overlay list
- ((lambda (thing) (and (consp thing) (data-debug-overlay-p (car thing)))) .
+ ((lambda (thing) (and (consp thing) (overlayp (car thing)))) .
data-debug-insert-overlay-list-button)
;; Buffer
@@ -880,7 +880,7 @@ If PARENT is non-nil, it is somehow related as a parent to thing."
comment-end ""
buffer-read-only t)
(setq-local comment-start-skip
- "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
(buffer-disable-undo)
(set (make-local-variable 'font-lock-global-modes) nil)
(font-lock-mode -1)
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index 1418ad9539d..41252815734 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -470,7 +470,7 @@ To be used in hook functions."
;; Emacs 21 has no buffer file name for directory edits.
;; so we need to add these hacks in.
(eq major-mode 'dired-mode)
- (eq major-mode 'vc-dired-mode))
+ (eq major-mode 'vc-dir-mode))
(ede-minor-mode 1)))
(define-minor-mode ede-minor-mode
@@ -481,7 +481,7 @@ controlled project, then this mode is activated automatically
provided `global-ede-mode' is enabled."
:group 'ede
(cond ((or (eq major-mode 'dired-mode)
- (eq major-mode 'vc-dired-mode))
+ (eq major-mode 'vc-dir-mode))
(ede-dired-minor-mode (if ede-minor-mode 1 -1)))
(ede-minor-mode
(if (not ede-constructing)
@@ -1515,8 +1515,11 @@ It does not apply the value to buffers."
(when project-dir
(ede-directory-get-open-project project-dir 'ROOT))))
-(cl-defmethod project-roots ((project ede-project))
- (list (ede-project-root-directory project)))
+(cl-defmethod project-root ((project ede-project))
+ (ede-project-root-directory project))
+
+;;; FIXME: Could someone look into implementing `project-ignores' for
+;;; EDE and/or a faster `project-files'?
(add-hook 'project-find-functions #'project-try-ede)
@@ -1527,8 +1530,7 @@ It does not apply the value to buffers."
;; If this does not occur after the provide, we can get a recursive
;; load. Yuck!
-(if (featurep 'speedbar)
- (ede-speedbar-file-setup)
- (add-hook 'speedbar-load-hook 'ede-speedbar-file-setup))
+(with-eval-after-load 'speedbar
+ (ede-speedbar-file-setup))
;;; ede.el ends here
diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el
index ee8aa5db1b7..f0dbccb7fc1 100644
--- a/lisp/cedet/ede/cpp-root.el
+++ b/lisp/cedet/ede/cpp-root.el
@@ -478,21 +478,6 @@ Argument COMMAND is the command to use for compiling the target."
"Don't rescan this project from the sources."
(message "cpp-root has nothing to rescan."))
-;;; Quick Hack
-(defun ede-create-lots-of-projects-under-dir (dir projfile &rest attributes)
- "Create a bunch of projects under directory DIR.
-PROJFILE is a file name sans directory that indicates a subdirectory
-is a project directory.
-Generic ATTRIBUTES, such as :include-path can be added.
-Note: This needs some work."
- (let ((files (directory-files dir t)))
- (dolist (F files)
- (if (file-exists-p (expand-file-name projfile F))
- `(ede-cpp-root-project (file-name-nondirectory F)
- :name (file-name-nondirectory F)
- :file (expand-file-name projfile F)
- attributes)))))
-
(provide 'ede/cpp-root)
;; Local variables:
diff --git a/lisp/cedet/ede/detect.el b/lisp/cedet/ede/detect.el
index 3e4499cd39e..fe23501807a 100644
--- a/lisp/cedet/ede/detect.el
+++ b/lisp/cedet/ede/detect.el
@@ -35,16 +35,6 @@
(require 'ede/auto) ;; Autoload settings.
-(when (or (<= emacs-major-version 23)
- ;; predicate as name added in Emacs 24.2
- (and (= emacs-major-version 24)
- (< emacs-minor-version 2)))
- (message "Loading CEDET fallback autoload library.")
- (require 'cedet/dominate
- (expand-file-name "../../../etc/fallback-libraries/dominate.el"
- (file-name-directory load-file-name))))
-
-
;;; BASIC PROJECT SCAN
;;
(defun ede--detect-stop-scan-p (dir)
diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el
index bfcbd40fcce..a052c5c61e7 100644
--- a/lisp/cedet/ede/emacs.el
+++ b/lisp/cedet/ede/emacs.el
@@ -234,20 +234,19 @@ All files need the macros from lisp.h!"
(let* ((D (car dirs))
(ed (expand-file-name D base))
(ef (expand-file-name name ed)))
- (if (file-exists-p ef)
- (setq ans ef)
- ;; Not in this dir? How about subdirs?
- (let ((dirfile (directory-files ed t))
- (moredirs nil)
- )
- ;; Get all the subdirs.
- (dolist (DF dirfile)
- (when (and (file-directory-p DF)
- (not (string-match "\\.$" DF)))
- (push DF moredirs)))
- ;; Try again.
- (setq ans (ede-emacs-find-in-directories name ed moredirs))
- ))
+ (when (file-exists-p ed)
+ (if (file-exists-p ef)
+ (setq ans ef)
+ ;; Not in this dir? How about subdirs?
+ (let ((dirfile (directory-files ed t))
+ (moredirs nil))
+ ;; Get all the subdirs.
+ (dolist (DF dirfile)
+ (when (and (file-directory-p DF)
+ (not (string-match "\\.$" DF)))
+ (push DF moredirs)))
+ ;; Try again.
+ (setq ans (ede-emacs-find-in-directories name ed moredirs)))))
(setq dirs (cdr dirs))))
ans))
diff --git a/lisp/cedet/ede/make.el b/lisp/cedet/ede/make.el
index ecce3e7105b..140e7387a68 100644
--- a/lisp/cedet/ede/make.el
+++ b/lisp/cedet/ede/make.el
@@ -32,29 +32,15 @@
(declare-function inversion-check-version "inversion")
-(if (fboundp 'locate-file)
- (defsubst ede--find-executable (exec)
- "Return an expanded file name for a program EXEC on the exec path."
- (locate-file exec exec-path))
-
- ;; Else, older version of Emacs.
-
- (defsubst ede--find-executable (exec)
- "Return an expanded file name for a program EXEC on the exec path."
- (let ((p exec-path)
- (found nil))
- (while (and p (not found))
- (let ((f (expand-file-name exec (car p))))
- (if (file-exists-p f)
- (setq found f)))
- (setq p (cdr p)))
- found))
- )
+(defsubst ede--find-executable (exec)
+ "Return an expanded file name for a program EXEC on the exec path."
+ (declare (obsolete locate-file "28.1"))
+ (locate-file exec exec-path))
(defvar ede-make-min-version "3.0"
"Minimum version of GNU make required.")
-(defcustom ede-make-command (cond ((ede--find-executable "gmake")
+(defcustom ede-make-command (cond ((executable-find "gmake")
"gmake")
(t "make")) ;; What to do?
"The MAKE command to use for EDE when compiling.
diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el
index 63fb62b5a57..b85b397af2d 100644
--- a/lisp/cedet/ede/pconf.el
+++ b/lisp/cedet/ede/pconf.el
@@ -56,8 +56,9 @@ don't do it. A value of nil means to just do it.")
(and (eq ede-pconf-create-file-query 'ask)
(not (eq ede-pconf-create-file-query 'never))
(not (y-or-n-p
- (format "I had to create the %s file for you. Ok? " file)))
- (error "Quit")))))))
+ (format "I had to create the %s file for you. Ok? "
+ file))))
+ (error "Quit"))))))
(cl-defmethod ede-proj-configure-synchronize ((this ede-proj-project))
diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el
index a0af4a4ddc5..bcd672133db 100644
--- a/lisp/cedet/ede/proj-elisp.el
+++ b/lisp/cedet/ede/proj-elisp.el
@@ -153,18 +153,9 @@ Bonus: Return a cons cell: (COMPILED . UPTODATE)."
(let* ((fsrc (expand-file-name src dir))
(elc (concat (file-name-sans-extension fsrc) ".elc")))
(with-no-warnings
- (if (< emacs-major-version 24)
- ;; Does not have `byte-recompile-file'
- (if (or (not (file-exists-p elc))
- (file-newer-than-file-p fsrc elc))
- (progn
- (setq comp (1+ comp))
- (byte-compile-file fsrc))
- (setq utd (1+ utd)))
-
- (if (eq (byte-recompile-file fsrc nil 0) t)
- (setq comp (1+ comp))
- (setq utd (1+ utd)))))))
+ (if (eq (byte-recompile-file fsrc nil 0) t)
+ (setq comp (1+ comp))
+ (setq utd (1+ utd))))))
(oref obj source))
(message "All Emacs Lisp sources are up to date in %s" (eieio-object-name obj))
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index 58a35d7d8a0..71321e12da3 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -82,8 +82,6 @@ introduced."
This variable is for internal use only, and its content depends on the
external parser used.")
(make-variable-buffer-local 'semantic--parse-table)
-(semantic-varalias-obsolete 'semantic-toplevel-bovine-table
- 'semantic--parse-table "23.2")
(defvar semantic-symbol->name-assoc-list
'((type . "Types")
@@ -112,17 +110,6 @@ in classes, such as protection labels.")
"Value for `case-fold-search' when parsing.")
(make-variable-buffer-local 'semantic-case-fold)
-(defvar semantic-expand-nonterminal nil
- "Function to call for each nonterminal production.
-Return a list of non-terminals derived from the first argument, or nil
-if it does not need to be expanded.
-Languages with compound definitions should use this function to expand
-from one compound symbol into several. For example, in C the definition
- int a, b;
-is easily parsed into one tag. This function should take this
-compound tag and turn it into two tags, one for A, and the other for B.")
-(make-variable-buffer-local 'semantic-expand-nonterminal)
-
(defvar semantic--buffer-cache nil
"A cache of the fully parsed buffer.
If no significant changes have been made (based on the state) then
@@ -134,8 +121,6 @@ If you need a tag list, use `semantic-fetch-tags'. If you need the
cached values for some reason, chances are you can add a hook to
`semantic-after-toplevel-cache-change-hook'.")
(make-variable-buffer-local 'semantic--buffer-cache)
-(semantic-varalias-obsolete 'semantic-toplevel-bovine-cache
- 'semantic--buffer-cache "23.2")
(defvar semantic-unmatched-syntax-cache nil
"A cached copy of unmatched syntax tokens.")
@@ -171,18 +156,6 @@ It is called before any request for tags is made via the function
`semantic-fetch-tags' by an application.
If any hook returns a nil value, the cached value is returned
immediately, even if it is empty.")
-(semantic-varalias-obsolete 'semantic-before-toplevel-bovination-hook
- 'semantic--before-fetch-tags-hook "23.2")
-
-(defvar semantic-after-toplevel-bovinate-hook nil
- "Hooks run after a toplevel parse.
-It is not run if the toplevel parse command is called, and buffer does
-not need to be fully reparsed.
-For language specific hooks, make sure you define this as a local hook.
-
-This hook should not be used any more.
-Use `semantic-after-toplevel-cache-change-hook' instead.")
-(make-obsolete-variable 'semantic-after-toplevel-bovinate-hook nil "23.2")
(defvar semantic-after-toplevel-cache-change-hook nil
"Hooks run after the buffer tag list has changed.
@@ -305,13 +278,6 @@ This hook is for database functions which intend to swap in a tag table.
This guarantees that the DB will go before other modes that require
a parse of the buffer.")
-(semantic-varalias-obsolete 'semantic-init-hooks
- 'semantic-init-hook "23.2")
-(semantic-varalias-obsolete 'semantic-init-mode-hooks
- 'semantic-init-mode-hook "23.2")
-(semantic-varalias-obsolete 'semantic-init-db-hooks
- 'semantic-init-db-hook "23.2")
-
(defsubst semantic-error-if-unparsed ()
"Raise an error if current buffer was not parsed by Semantic."
(unless semantic-new-buffer-fcn-was-run
@@ -516,8 +482,6 @@ is requested."
(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)
- ;; Old model. Delete someday.
- ;;(run-hooks 'semantic-after-toplevel-bovinate-hook)
(run-hook-with-args 'semantic-after-toplevel-cache-change-hook
semantic--buffer-cache)
@@ -540,17 +504,12 @@ is requested."
(setq semantic--completion-cache nil)
;; Refresh the display of unmatched syntax tokens if enabled
(run-hook-with-args 'semantic-unmatched-syntax-hook
- semantic-unmatched-syntax-cache)
- ;; Old Semantic 1.3 hook API. Maybe useful forever?
- (run-hooks 'semantic-after-toplevel-bovinate-hook)
- )
+ semantic-unmatched-syntax-cache))
(defvar semantic-working-type 'percent
"The type of working message to use when parsing.
'percent means we are doing a linear parse through the buffer.
'dynamic means we are reparsing specific tags.")
-(semantic-varalias-obsolete 'semantic-bovination-working-type
- 'semantic-working-type "23.2")
(defvar semantic-minimum-working-buffer-size (* 1024 5)
"The minimum size of a buffer before working messages are displayed.
@@ -586,8 +545,6 @@ was marked unparseable, then do nothing, and return the cache."
(semantic-active-p)
;; Application hooks say the buffer is safe for parsing
(run-hook-with-args-until-failure
- 'semantic-before-toplevel-bovination-hook)
- (run-hook-with-args-until-failure
'semantic--before-fetch-tags-hook)
;; If the buffer was previously marked unparseable,
;; then don't waste our time.
@@ -690,11 +647,6 @@ Does nothing if the current buffer doesn't need reparsing."
;; Return if we are lexically safe
lexically-safe))))
-(defun semantic-bovinate-toplevel (&optional ignored)
- "Backward compatibility function."
- (semantic-fetch-tags))
-(make-obsolete 'semantic-bovinate-toplevel 'semantic-fetch-tags "23.2")
-
;; Another approach is to let Emacs call the parser on idle time, when
;; needed, use `semantic-fetch-available-tags' to only retrieve
;; available tags, and setup the `semantic-after-*-hook' hooks to
@@ -812,20 +764,6 @@ This function returns semantic tags without overlays."
;; Please move away from these functions, and try using semantic 2.x
;; interfaces instead.
;;
-(defsubst semantic-bovinate-region-until-error
- (start end nonterm &optional depth)
- "NOTE: Use `semantic-parse-region' instead.
-
-Bovinate between START and END starting with NONTERM.
-Optional DEPTH specifies how many levels of parenthesis to enter.
-This command will parse until an error is encountered, and return
-the list of everything found until that moment.
-This is meant for finding variable definitions at the beginning of
-code blocks in methods. If `bovine-inner-scope' can also support
-commands, use `semantic-bovinate-from-nonterminal-full'."
- (semantic-parse-region start end nonterm depth t))
-(make-obsolete 'semantic-bovinate-region-until-error
- 'semantic-parse-region "23.2")
(defsubst semantic-bovinate-from-nonterminal
(start end nonterm &optional depth length)
@@ -840,21 +778,6 @@ tokens."
(semantic-lex start end (or depth 1) length)
nonterm))))
-(defsubst semantic-bovinate-from-nonterminal-full
- (start end nonterm &optional depth)
- "NOTE: Use `semantic-parse-region' instead.
-
-Bovinate from within a nonterminal lambda from START to END.
-Iterates until all the space between START and END is exhausted.
-Argument NONTERM is the nonterminal symbol to start with.
-If NONTERM is nil, use `bovine-block-toplevel'.
-Optional argument DEPTH is the depth of lists to dive into.
-When used in a `lambda' of a MATCH-LIST, there is no need to include
-a START and END part."
- (semantic-parse-region start end nonterm (or depth 1)))
-(make-obsolete 'semantic-bovinate-from-nonterminal-full
- 'semantic-parse-region "23.2")
-
;;; User interface
(defun semantic-force-refresh ()
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index 358829a4568..3649d1c2f1f 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -46,27 +46,10 @@
(declare-function c-forward-conditional "cc-cmds")
(declare-function ede-system-include-path "ede")
-;;; Compatibility
-;;
(eval-when-compile (require 'cc-mode))
-(if (fboundp 'c-end-of-macro)
- (eval-and-compile
- (defalias 'semantic-c-end-of-macro 'c-end-of-macro))
- ;; From cc-mode 5.30
- (defun semantic-c-end-of-macro ()
- "Go to the end of a preprocessor directive.
-More accurately, move point to the end of the closest following line
-that doesn't end with a line continuation backslash.
-
-This function does not do any hidden buffer changes."
- (while (progn
- (end-of-line)
- (when (and (eq (char-before) ?\\)
- (not (eobp)))
- (forward-char)
- t))))
- )
+(define-obsolete-function-alias 'semantic-c-end-of-macro
+ #'c-end-of-macro "28.1")
;;; Code:
(with-suppressed-warnings ((obsolete define-child-mode))
@@ -266,7 +249,7 @@ Return the defined symbol as a special spp lex token."
(semantic-lex-analyzer #'semantic-cpp-lexer)
(raw-stream
(semantic-lex-spp-stream-for-macro (save-excursion
- (semantic-c-end-of-macro)
+ (c-end-of-macro)
;; HACK - If there's a C comment after
;; the macro, do not parse it.
(if (looking-back "/\\*.*" beginning-of-define)
@@ -590,7 +573,7 @@ case, we must skip it since it is the ELSE part."
(define-lex-regex-analyzer semantic-lex-c-macrobits
"Ignore various forms of #if/#else/#endif conditionals."
"^\\s-*#\\s-*\\(if\\(n?def\\)?\\|endif\\|elif\\|else\\)"
- (semantic-c-end-of-macro)
+ (c-end-of-macro)
(setq semantic-lex-end-point (point))
nil)
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index 656c63b7eed..bbed1d94f20 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -420,7 +420,6 @@ Return a bovination list to use."
:parent (symbol-name (nth 2 form))
:documentation (semantic-elisp-do-doc (nth 4 form))
)))
- define-mode-overload-implementation ;; obsoleted
define-mode-local-override
)
@@ -650,7 +649,7 @@ define-mode-overload\\)\
))
(when fun
;; Do not return FUN IFF the cursor is on FUN.
- ;; Huh? Thats because if cursor is on fun, it is
+ ;; Huh? That's because if cursor is on fun, it is
;; the current symbol, and not the current function.
(if (save-excursion
(condition-case nil
diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el
index 7b835b85097..10afb065320 100644
--- a/lisp/cedet/semantic/bovine/grammar.el
+++ b/lisp/cedet/semantic/bovine/grammar.el
@@ -143,8 +143,7 @@ expanded from elsewhere."
form (cdr form))
;; Hack for dealing with new reading of unquotes outside of
;; backquote (introduced in 2010-12-06T16:37:26Z!monnier@iro.umontreal.ca).
- (when (and (>= emacs-major-version 24)
- (listp first)
+ (when (and (listp first)
(or (equal (car first) '\,)
(equal (car first) '\,@)))
(if (listp (cadr first))
diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el
index 93ad27586ed..b2a25bf8eef 100644
--- a/lisp/cedet/semantic/bovine/scm.el
+++ b/lisp/cedet/semantic/bovine/scm.el
@@ -69,7 +69,7 @@ Attempts a simple prototype for calling or using TAG."
;; Note: Analyzer from Henry S. Thompson
(define-lex-regex-analyzer semantic-lex-scheme-symbol
"Detect and create symbol and keyword tokens."
- "\\(\\sw\\([:]\\|\\sw\\|\\s_\\)*\\)"
+ "\\(\\sw\\|\\s_\\)+"
;; (message "symbol: %s" (match-string 0))
(semantic-lex-push-token
(semantic-lex-token
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index 7abc4360f64..b262ab710f6 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -1635,10 +1635,10 @@ This will not happen if you directly set this variable via `setq'."
:group 'semantic
:version "24.3"
:type 'integer
- :set '(lambda (sym var)
- (set-default sym var)
- (when (boundp 'x-max-tooltip-size)
- (setcdr x-max-tooltip-size (max (1+ var) (cdr x-max-tooltip-size))))))
+ :set (lambda (sym var)
+ (set-default sym var)
+ (when (boundp 'x-max-tooltip-size)
+ (setcdr x-max-tooltip-size (max (1+ var) (cdr x-max-tooltip-size))))))
(defclass semantic-displayer-tooltip (semantic-displayer-traditional)
diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el
index a3219af7d3e..d63e5bc4869 100644
--- a/lisp/cedet/semantic/db-ebrowse.el
+++ b/lisp/cedet/semantic/db-ebrowse.el
@@ -74,7 +74,7 @@ By default, include only headers since the semantic use of EBrowse
is only for searching via semanticdb, and thus only headers would
be searched."
:group 'semanticdb
- :type 'string)
+ :type 'regexp)
;;; SEMANTIC Database related Code
;;; Classes:
@@ -181,7 +181,8 @@ is specified by `semanticdb-default-save-directory'."
"Load all semanticdb controlled EBROWSE caches."
(interactive)
(let ((f (directory-files semanticdb-default-save-directory
- t (concat semanticdb-ebrowse-default-file-name
+ t (concat (regexp-quote
+ semanticdb-ebrowse-default-file-name)
"-load\\.el\\'")
t)))
(while f
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index 510f931fa9f..86ccf28ad02 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -1245,7 +1245,7 @@ See `semanticdb-find-translate-path' for details on PATH.
The argument BRUTISH will be set so that searching includes all tables
in the current project.
FIND-FILE-MATCH indicates that any time a match is found, the file
-associated wit that tag should be loaded into a buffer."
+associated with that tag should be loaded into a buffer."
(semanticdb-find-tags-collector
(lambda (table tags)
(semanticdb-deep-find-tags-by-name-method table name tags))
@@ -1257,7 +1257,7 @@ See `semanticdb-find-translate-path' for details on PATH.
The argument BRUTISH will be set so that searching includes all tables
in the current project.
FIND-FILE-MATCH indicates that any time a match is found, the file
-associated wit that tag should be loaded into a buffer."
+associated with that tag should be loaded into a buffer."
(semanticdb-find-tags-collector
(lambda (table tags)
(semanticdb-deep-find-tags-for-completion-method table prefix tags))
diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el
index 0ab03ef49ef..16a30b6cfbc 100644
--- a/lisp/cedet/semantic/db-mode.el
+++ b/lisp/cedet/semantic/db-mode.el
@@ -69,10 +69,6 @@ database, which can be saved for future Emacs sessions."
(dolist (elt semanticdb-hooks)
(remove-hook (cadr elt) (car elt)))))
-(semantic-varalias-obsolete 'semanticdb-mode-hooks
- 'global-semanticdb-minor-mode-hook "23.2")
-
-
(defun semanticdb-toggle-global-mode ()
"Toggle use of the Semantic Database feature.
Update the environment of Semantic enabled buffers accordingly."
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index aaf43a17293..60a65b195bc 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -89,7 +89,7 @@ same major mode as the current buffer.")
:documentation "The tags belonging to this table.")
(db-refs :initform nil
:documentation
- "List of `semanticdb-table' objects refering to this one.
+ "List of `semanticdb-table' objects referring to this one.
These aren't saved, but are instead recalculated after load.
See the file semanticdb-ref.el for how this slot is used.")
(index :type semanticdb-abstract-search-index
@@ -764,7 +764,7 @@ If a particular major mode wants to search any mode, put the
Do not set the value of this variable permanently.")
(defmacro semanticdb-with-match-any-mode (&rest body)
- "A Semanticdb search occurring withing BODY will search tags in all modes.
+ "A Semanticdb search occurring within BODY will search tags in all modes.
This temporarily sets `semanticdb-match-any-mode' while executing BODY."
(declare (indent 0) (debug t))
`(let ((semanticdb-match-any-mode t))
diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el
index 8eb6a3bbd5d..293692000df 100644
--- a/lisp/cedet/semantic/decorate/mode.el
+++ b/lisp/cedet/semantic/decorate/mode.el
@@ -204,9 +204,6 @@ Also make sure old decorations in the area are completely flushed."
(defvar semantic-decorate-pending-decoration-hook nil
"Normal hook run to perform pending decoration changes.")
-(semantic-varalias-obsolete 'semantic-decorate-pending-decoration-hooks
- 'semantic-decorate-pending-decoration-hook "23.2")
-
(defun semantic-decorate-add-pending-decoration (fcn &optional buffer)
"Add a pending decoration change represented by FCN.
Applies only to the current BUFFER.
diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el
index 47afa25dd74..60ab6033aec 100644
--- a/lisp/cedet/semantic/dep.el
+++ b/lisp/cedet/semantic/dep.el
@@ -183,16 +183,8 @@ macro `defcustom-mode-local-semantic-dependency-system-include-path'."
;;
;; methods for finding files on a provided path.
(defmacro semantic--dependency-find-file-on-path (file path)
- (if (fboundp 'locate-file)
- `(locate-file ,file ,path)
- `(let ((p ,path)
- (found nil))
- (while (and p (not found))
- (let ((f (expand-file-name ,file (car p))))
- (if (file-exists-p f)
- (setq found f)))
- (setq p (cdr p)))
- found)))
+ (declare (obsolete locate-file "28.1"))
+ `(locate-file ,file ,path))
(defvar ede-minor-mode)
(defvar ede-object)
@@ -216,11 +208,11 @@ provided mode, not from the current major mode."
(when (file-exists-p file)
(setq found file))
(when (and (not found) (not systemp))
- (setq found (semantic--dependency-find-file-on-path file locp)))
+ (setq found (locate-file file locp)))
(when (and (not found) edesys)
- (setq found (semantic--dependency-find-file-on-path file edesys)))
+ (setq found (locate-file file edesys)))
(when (not found)
- (setq found (semantic--dependency-find-file-on-path file sysp)))
+ (setq found (locate-file file sysp)))
(if found (expand-file-name found))))
diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el
index 8b39e775789..896bc3bb42e 100644
--- a/lisp/cedet/semantic/doc.el
+++ b/lisp/cedet/semantic/doc.el
@@ -93,8 +93,7 @@ just the lexical token and not the string."
Attempt to strip out comment syntactic sugar.
Argument NOSNARF means don't modify the found text.
If NOSNARF is `lex', then return the lex token."
- (let* ((semantic-ignore-comments nil)
- (semantic-lex-analyzer #'semantic-comment-lexer))
+ (let* ((semantic-lex-analyzer #'semantic-comment-lexer))
(if (memq nosnarf '(lex flex)) ;; keep `flex' for compatibility
(car (semantic-lex (point) (1+ (point))))
(let ((ct (semantic-lex-token-text
diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el
index 2464833859b..d435ff6b6e9 100644
--- a/lisp/cedet/semantic/ede-grammar.el
+++ b/lisp/cedet/semantic/ede-grammar.el
@@ -142,19 +142,10 @@ Lays claim to all -by.el, and -wy.el files."
(match-string 1 package)))
(src (ede-expand-filename obj fname))
(csrc (concat (file-name-sans-extension src) ".elc")))
- (if (< emacs-major-version 24)
- ;; Does not have `byte-recompile-file'
- (if (or (not (file-exists-p csrc))
- (file-newer-than-file-p src csrc))
- (progn
- (setq comp (1+ comp))
- (byte-compile-file src))
- (setq utd (1+ utd)))
- ;; Emacs 24 and newer
- (with-no-warnings
- (if (eq (byte-recompile-file src nil 0) t)
- (setq comp (1+ comp))
- (setq utd (1+ utd))))))))
+ (with-no-warnings
+ (if (eq (byte-recompile-file src nil 0) t)
+ (setq comp (1+ comp))
+ (setq utd (1+ utd)))))))
(oref obj source))
(message "All Semantic Grammar sources are up to date in %s" (eieio-object-name obj))
(cons comp utd)))
diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el
index a1225dfeee9..e4319c7d1b3 100644
--- a/lisp/cedet/semantic/edit.el
+++ b/lisp/cedet/semantic/edit.el
@@ -121,9 +121,6 @@ incremental reparse.")
"Hook run after the incremental parser fails.
When this happens, the buffer is marked as needing a full reparse.")
-(semantic-varalias-obsolete 'semantic-edits-incremental-reparse-failed-hooks
- 'semantic-edits-incremental-reparse-failed-hook "23.2")
-
(defcustom semantic-edits-verbose-flag nil
"Non-nil means the incremental parser is verbose.
If nil, errors are still displayed, but informative messages are not."
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index 7a1273d6534..c86cd3abf3d 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -68,13 +68,11 @@
;; Since Emacs 22 major mode functions should use `run-mode-hooks' to
;; run major mode hooks.
-(defalias 'semantic-run-mode-hooks
- (if (fboundp 'run-mode-hooks)
- 'run-mode-hooks
- 'run-hooks))
+(define-obsolete-function-alias 'semantic-run-mode-hooks 'run-mode-hooks "28.1")
- ;; Fancy compat usage now handled in cedet-compat
-(defalias 'semantic-subst-char-in-string 'subst-char-in-string)
+;; Fancy compat usage now handled in cedet-compat
+(define-obsolete-function-alias 'semantic-subst-char-in-string
+ 'subst-char-in-string "28.1")
(defun semantic-delete-overlay-maybe (overlay)
"Delete OVERLAY if it is a semantic token overlay."
@@ -175,6 +173,7 @@ Remove self from `post-command-hook' if it is empty."
;;
(defun semantic-overload-symbol-from-function (name)
"Return the symbol for overload used by NAME, the defined symbol."
+ (declare (obsolete define-obsolete-function-alias "28.1"))
(let ((sym-name (symbol-name name)))
(if (string-match "^semantic-" sym-name)
(intern (substring sym-name (match-end 0)))
@@ -184,6 +183,7 @@ Remove self from `post-command-hook' if it is empty."
"Make OLDFNALIAS an alias for NEWFN.
Mark OLDFNALIAS as obsolete, such that the byte compiler
will throw a warning when it encounters this symbol."
+ (declare (obsolete define-obsolete-function-alias "28.1"))
(defalias oldfnalias newfn)
(make-obsolete oldfnalias newfn when)
(when (and (mode-local--function-overload-p newfn)
@@ -198,13 +198,14 @@ will throw a warning when it encounters this symbol."
"%s: `%s' obsoletes overload `%s'"
byte-compile-current-file
newfn
- (semantic-overload-symbol-from-function oldfnalias))
- ))
+ (with-suppressed-warnings ((obsolete semantic-overload-symbol-from-function))
+ (semantic-overload-symbol-from-function oldfnalias)))))
(defun semantic-varalias-obsolete (oldvaralias newvar when)
"Make OLDVARALIAS an alias for variable NEWVAR.
Mark OLDVARALIAS as obsolete, such that the byte compiler
will throw a warning when it encounters this symbol."
+ (declare (obsolete define-obsolete-variable-alias "28.1"))
(make-obsolete-variable oldvaralias newvar when)
(condition-case nil
(defvaralias oldvaralias newvar)
@@ -258,9 +259,6 @@ FUNCTION does not have arguments. When FUNCTION is entered
(defalias 'semantic-map-mode-buffers 'mode-local-map-mode-buffers)
-(semantic-alias-obsolete 'define-mode-overload-implementation
- 'define-mode-local-override "23.2")
-
(defun semantic-install-function-overrides (overrides &optional transient)
"Install the function OVERRIDES in the specified environment.
OVERRIDES must be an alist ((OVERLOAD . FUNCTION) ...) where OVERLOAD
@@ -398,13 +396,10 @@ into `mode-local-init-hook'." file filename)
;; "define-lex-regex-type-analyzer"
;; "define-lex-string-type-analyzer"
;; "define-lex-block-type-analyzer"
-;; ;;"define-mode-overload-implementation"
;; ;;"define-semantic-child-mode"
;; "define-semantic-idle-service"
;; "define-semantic-decoration-style"
;; "define-wisent-lexer"
-;; "semantic-alias-obsolete"
-;; "semantic-varalias-obsolete"
;; "semantic-make-obsolete-overload"
;; "defcustom-mode-local-semantic-dependency-system-include-path"
;; ))
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index 62c86f9d12d..f71ac6c413e 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -142,7 +142,7 @@ It ignores whitespaces, newlines and comments."
"Return expansion of built-in ASSOC expression.
ARGS are ASSOC's key value list."
(let ((key t))
- `(semantic-tag-make-assoc-list
+ `(semantic-tag-make-plist
,@(mapcar #'(lambda (i)
(prog1
(if key
@@ -1251,6 +1251,7 @@ common grammar menu."
"Setup an XEmacs grammar menu in variable SYMBOL.
MODE-MENU is an optional specific menu whose items are appended to the
common grammar menu."
+ (declare (obsolete nil "28.1"))
(let ((items (make-symbol "items"))
(path (make-symbol "path")))
`(progn
@@ -1306,7 +1307,7 @@ the change bounds to encompass the whole nonterminal tag."
;; Look within the line for a ; following an even number of backslashes
;; after either a non-backslash or the line beginning.
(set (make-local-variable 'comment-start-skip)
- "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
(set (make-local-variable 'indent-line-function)
'semantic-grammar-indent)
(set (make-local-variable 'fill-paragraph-function)
@@ -1663,6 +1664,42 @@ Select the buffer containing the tag's definition, and move point there."
(defvar semantic-grammar-eldoc-last-data (cons nil nil))
+(defun semantic--docstring-format-sym-doc (prefix doc &optional face)
+ "Combine PREFIX and DOC, and shorten the result to fit in the echo area.
+
+When PREFIX is a symbol, propertize its symbol name with FACE
+before combining it with DOC. If FACE is not provided, just
+apply the nil face.
+
+See also: `eldoc-echo-area-use-multiline-p'."
+ ;; Hoisted from old `eldoc-docstring-format-sym-doc'.
+ ;; If the entire line cannot fit in the echo area, the symbol name may be
+ ;; truncated or eliminated entirely from the output to make room for the
+ ;; description.
+ (when (symbolp prefix)
+ (setq prefix (concat (propertize (symbol-name prefix) 'face face) ": ")))
+ (let* ((ea-multi eldoc-echo-area-use-multiline-p)
+ ;; Subtract 1 from window width since emacs will not write
+ ;; any chars to the last column, or in later versions, will
+ ;; cause a wraparound and resize of the echo area.
+ (ea-width (1- (window-width (minibuffer-window))))
+ (strip (- (+ (length prefix)
+ (length doc))
+ ea-width)))
+ (cond ((or (<= strip 0)
+ (eq ea-multi t)
+ (and ea-multi (> (length doc) ea-width)))
+ (concat prefix doc))
+ ((> (length doc) ea-width)
+ (substring (format "%s" doc) 0 ea-width))
+ ((>= strip (string-match-p ":? *\\'" prefix))
+ doc)
+ (t
+ ;; Show the end of the partial symbol name, rather
+ ;; than the beginning, since the former is more likely
+ ;; to be unique given package namespace conventions.
+ (concat (substring prefix strip) doc)))))
+
(defun semantic-grammar-eldoc-get-macro-docstring (macro expander)
"Return a one-line docstring for the given grammar MACRO.
EXPANDER is the name of the function that expands MACRO."
@@ -1681,19 +1718,18 @@ EXPANDER is the name of the function that expands MACRO."
(setq doc (eldoc-function-argstring expander))))
(when doc
(setq doc
- (eldoc-docstring-format-sym-doc
+ (semantic--docstring-format-sym-doc
macro (format "==> %s %s" expander doc) 'default))
(setq semantic-grammar-eldoc-last-data (cons expander doc)))
doc))
((fboundp 'elisp-get-fnsym-args-string) ;; Emacs≥25
- (elisp-get-fnsym-args-string
- expander nil
- (concat (propertize (symbol-name macro)
+ (concat (propertize (symbol-name macro)
'face 'font-lock-keyword-face)
" ==> "
(propertize (symbol-name macro)
'face 'font-lock-function-name-face)
- ": ")))))
+ ": "
+ (elisp-get-fnsym-args-string expander nil )))))
(define-mode-local-override semantic-idle-summary-current-symbol-info
semantic-grammar-mode ()
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index 76218249c59..8301b195309 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -472,11 +472,6 @@ This hook is not protected from lexical errors.")
If any hook function throws an error, this variable is reset to nil.
This hook is not protected from lexical errors.")
-(semantic-varalias-obsolete 'semantic-before-idle-scheduler-reparse-hooks
- 'semantic-before-idle-scheduler-reparse-hook "23.2")
-(semantic-varalias-obsolete 'semantic-after-idle-scheduler-reparse-hooks
- 'semantic-after-idle-scheduler-reparse-hook "23.2")
-
(defun semantic-idle-scheduler-refresh-tags ()
"Refreshes the current buffer's tags.
This is called by `semantic-idle-scheduler-function' to update the
@@ -734,10 +729,6 @@ specific to a major mode. For example, in jde mode:
(define-overloadable-function semantic-idle-summary-current-symbol-info ()
"Return a string message describing the current context.")
-(make-obsolete-overload 'semantic-eldoc-current-symbol-info
- 'semantic-idle-summary-current-symbol-info
- "23.2")
-
(defcustom semantic-idle-summary-mode-hook nil
"Hook run at the end of `semantic-idle-summary'."
:group 'semantic
diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el
index 19e0515ac63..25f7fdb8426 100644
--- a/lisp/cedet/semantic/imenu.el
+++ b/lisp/cedet/semantic/imenu.el
@@ -44,9 +44,8 @@
;; Because semantic imenu tags will hose the current imenu handling
;; code in speedbar, force semantic/sb in.
-(if (featurep 'speedbar)
- (require 'semantic/sb)
- (add-hook 'speedbar-load-hook (lambda () (require 'semantic/sb))))
+(with-eval-after-load 'speedbar
+ (require 'semantic/sb))
(defgroup semantic-imenu nil
"Semantic interface to Imenu."
@@ -89,8 +88,6 @@ This option is ignored if `semantic-imenu-bucketize-file' is nil."
:group 'semantic-imenu
:type 'boolean)
(make-variable-buffer-local 'semantic-imenu-expand-type-members)
-(semantic-varalias-obsolete 'semantic-imenu-expand-type-parts
- 'semantic-imenu-expand-type-members "23.2")
(defcustom semantic-imenu-bucketize-type-members t
"Non-nil if members of a type should be grouped into buckets.
@@ -99,8 +96,6 @@ Overridden to nil if `semantic-imenu-bucketize-file' is nil."
:group 'semantic-imenu
:type 'boolean)
(make-variable-buffer-local 'semantic-imenu-bucketize-type-members)
-(semantic-varalias-obsolete 'semantic-imenu-bucketize-type-parts
- 'semantic-imenu-bucketize-type-members "23.2")
(defcustom semantic-imenu-sort-bucket-function nil
"Function to use when sorting tags in the buckets of functions.
@@ -146,8 +141,6 @@ Tags of those classes will be given submenu with children.
By default, a `type' has interesting children. In Texinfo, however, a
`section' has interesting children.")
(make-variable-buffer-local 'semantic-imenu-expandable-tag-classes)
-(semantic-varalias-obsolete 'semantic-imenu-expandable-token
- 'semantic-imenu-expandable-tag-classes "23.2")
;;; Code:
(defun semantic-imenu-tag-overlay (tag)
diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el
index 80d03dc629b..cc53f69691b 100644
--- a/lisp/cedet/semantic/java.el
+++ b/lisp/cedet/semantic/java.el
@@ -253,9 +253,6 @@ Optional argument COLOR indicates that color should be mixed in."
'semantic-format-tag-prototype-default)
tag parent color)))
-(semantic-alias-obsolete 'semantic-java-prototype-nonterminal
- 'semantic-format-tag-prototype-java-mode "23.2")
-
;; Include Tag Name
;;
@@ -324,7 +321,7 @@ If NOSNARF is `lex', then return the semantic lex token."
(defvar semantic-java-doc-line-tags nil
"Valid javadoc line tags.
Ordered following Sun's Tag Convention at
-<http://java.sun.com/products/jdk/javadoc/writingdoccomments/index.html>")
+<https://java.sun.com/products/jdk/javadoc/writingdoccomments/index.html>")
(defvar semantic-java-doc-with-name-tags nil
"Javadoc tags which have a name.")
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index b8812de05b6..e6e124eb812 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -70,7 +70,7 @@
(require 'semantic)
(require 'semantic/lex)
-(declare-function semantic-c-end-of-macro "semantic/bovine/c")
+(declare-function c-end-of-macro "cc-engine")
;;; Code:
(defvar semantic-lex-spp-macro-symbol-obarray nil
@@ -946,7 +946,7 @@ by another macro."
(save-excursion
(let ((start (match-beginning 0))
(end (match-end 0))
- (peom (save-excursion (semantic-c-end-of-macro) (point))))
+ (peom (save-excursion (c-end-of-macro) (point))))
(condition-case nil
(progn
;; This will throw an error if no closing paren can be found.
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index 500a09d492f..809271ddccd 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -1069,7 +1069,7 @@ Only in effect if `debug-on-error' is also non-nil."
"For SYNTAX, execute FORMS with protection for unterminated syntax.
If FORMS throws an error, treat this as a syntax problem, and
execute the unterminated syntax code. FORMS should return a position.
-Irregardless of an error, the cursor should be moved to the end of
+Regardless of an error, the cursor should be moved to the end of
the desired syntax, and a position returned.
If `debug-on-error' is set, errors are not caught, so that you can
debug them.
@@ -1701,9 +1701,6 @@ If there is no error, then the last value of FORMS is returned."
`(let* ((semantic-lex-unterminated-syntax-end-function
(lambda (,syntax ,start ,end)
(throw ',symbol ,syntax)))
- ;; Delete the below when semantic-flex is fully retired.
- (semantic-flex-unterminated-syntax-end-function
- semantic-lex-unterminated-syntax-end-function)
(,ret (catch ',symbol
(save-excursion
,@forms
@@ -1751,32 +1748,12 @@ If there is no error, then the last value of FORMS is returned."
))
;;; Compatibility with Semantic 1.x lexical analysis
-;;
-;; NOTE: DELETE THIS SOMEDAY SOON
-
-(semantic-alias-obsolete 'semantic-flex-start 'semantic-lex-token-start "23.2")
-(semantic-alias-obsolete 'semantic-flex-end 'semantic-lex-token-end "23.2")
-(semantic-alias-obsolete 'semantic-flex-text 'semantic-lex-token-text "23.2")
-(semantic-alias-obsolete 'semantic-flex-make-keyword-table 'semantic-lex-make-keyword-table "23.2")
-(semantic-alias-obsolete 'semantic-flex-keyword-p 'semantic-lex-keyword-p "23.2")
-(semantic-alias-obsolete 'semantic-flex-keyword-put 'semantic-lex-keyword-put "23.2")
-(semantic-alias-obsolete 'semantic-flex-keyword-get 'semantic-lex-keyword-get "23.2")
-(semantic-alias-obsolete 'semantic-flex-map-keywords 'semantic-lex-map-keywords "23.2")
-(semantic-alias-obsolete 'semantic-flex-keywords 'semantic-lex-keywords "23.2")
-(semantic-alias-obsolete 'semantic-flex-buffer 'semantic-lex-buffer "23.2")
-(semantic-alias-obsolete 'semantic-flex-list 'semantic-lex-list "23.2")
-
-;; This simple scanner uses the syntax table to generate a stream of
-;; simple tokens of the form:
-;;
-;; (SYMBOL START . END)
-;;
-;; Where symbol is the type of thing it is. START and END mark that
-;; objects boundary.
(defvar semantic-flex-tokens semantic-lex-tokens
"An alist of semantic token types.
See variable `semantic-lex-tokens'.")
+(make-obsolete-variable 'semantic-flex-tokens
+ 'semantic-lex-tokens "28.1")
(defvar semantic-flex-unterminated-syntax-end-function
(lambda (_syntax _syntax-start flex-end) flex-end)
@@ -1788,6 +1765,8 @@ FLEX-END is where the lexical analysis was asked to end.
This function can be used for languages that can intelligently fix up
broken syntax, or the exit lexical analysis via `throw' or `signal'
when finding unterminated syntax.")
+(make-obsolete-variable 'semantic-flex-unterminated-syntax-end-function
+ nil "28.1")
(defvar semantic-flex-extensions nil
"Buffer local extensions to the lexical analyzer.
@@ -1799,6 +1778,7 @@ nil is also a valid return value.
TYPE can be any type of symbol, as long as it doesn't occur as a
nonterminal in the language definition.")
(make-variable-buffer-local 'semantic-flex-extensions)
+(make-obsolete-variable 'semantic-flex-extensions nil "28.1")
(defvar semantic-flex-syntax-modifications nil
"Changes to the syntax table for this buffer.
@@ -1809,237 +1789,47 @@ CHAR is the char passed to `modify-syntax-entry',
and CLASS is the string also passed to `modify-syntax-entry' to define
what syntax class CHAR has.")
(make-variable-buffer-local 'semantic-flex-syntax-modifications)
+(make-obsolete-variable 'semantic-flex-syntax-modifications nil "28.1")
(defvar semantic-ignore-comments t
"Default comment handling.
The value t means to strip comments when flexing; nil means
to keep comments as part of the token stream.")
(make-variable-buffer-local 'semantic-ignore-comments)
+(make-obsolete-variable 'semantic-ignore-comments nil "28.1")
(defvar semantic-flex-enable-newlines nil
"When flexing, report newlines as syntactic elements.
Useful for languages where the newline is a special case terminator.
Only set this on a per mode basis, not globally.")
(make-variable-buffer-local 'semantic-flex-enable-newlines)
+(make-obsolete-variable 'semantic-flex-enable-newlines nil "28.1")
(defvar semantic-flex-enable-whitespace nil
"When flexing, report whitespace as syntactic elements.
Useful for languages where the syntax is whitespace dependent.
Only set this on a per mode basis, not globally.")
(make-variable-buffer-local 'semantic-flex-enable-whitespace)
+(make-obsolete-variable 'semantic-flex-enable-whitespace nil "28.1")
(defvar semantic-flex-enable-bol nil
"When flexing, report beginning of lines as syntactic elements.
Useful for languages like python which are indentation sensitive.
Only set this on a per mode basis, not globally.")
(make-variable-buffer-local 'semantic-flex-enable-bol)
+(make-obsolete-variable 'semantic-flex-enable-bol nil "28.1")
(defvar semantic-number-expression semantic-lex-number-expression
"See variable `semantic-lex-number-expression'.")
(make-variable-buffer-local 'semantic-number-expression)
+(make-obsolete-variable 'semantic-number-expression
+ 'semantic-lex-number-expression "28.1")
(defvar semantic-flex-depth 0
"Default flexing depth.
This specifies how many lists to create tokens in.")
(make-variable-buffer-local 'semantic-flex-depth)
-
-(defun semantic-flex (start end &optional depth length)
- "Using the syntax table, do something roughly equivalent to flex.
-Semantically check between START and END. Optional argument DEPTH
-indicates at what level to scan over entire lists.
-The return value is a token stream. Each element is a list, such of
-the form (symbol start-expression . end-expression) where SYMBOL
-denotes the token type.
-See `semantic-flex-tokens' variable for details on token types.
-END does not mark the end of the text scanned, only the end of the
-beginning of text scanned. Thus, if a string extends past END, the
-end of the return token will be larger than END. To truly restrict
-scanning, use `narrow-to-region'.
-The last argument, LENGTH specifies that `semantic-flex' should only
-return LENGTH tokens."
- (declare (obsolete define-lex "23.2"))
- (if (not semantic-flex-keywords-obarray)
- (setq semantic-flex-keywords-obarray [ nil ]))
- (let ((ts nil)
- (pos (point))
- (ep nil)
- (curdepth 0)
- (cs (if comment-start-skip
- (concat "\\(\\s<\\|" comment-start-skip "\\)")
- (concat "\\(\\s<\\)")))
- (newsyntax (copy-syntax-table (syntax-table)))
- (mods semantic-flex-syntax-modifications)
- ;; Use the default depth if it is not specified.
- (depth (or depth semantic-flex-depth)))
- ;; Update the syntax table
- (while mods
- (modify-syntax-entry (car (car mods)) (car (cdr (car mods))) newsyntax)
- (setq mods (cdr mods)))
- (with-syntax-table newsyntax
- (goto-char start)
- (while (and (< (point) end) (or (not length) (<= (length ts) length)))
- (cond
- ;; catch beginning of lines when needed.
- ;; Must be done before catching any other tokens!
- ((and semantic-flex-enable-bol
- (bolp)
- ;; Just insert a (bol N . N) token in the token stream,
- ;; without moving the point. N is the point at the
- ;; beginning of line.
- (setq ts (cons (cons 'bol (cons (point) (point))) ts))
- nil)) ;; CONTINUE
- ;; special extensions, includes whitespace, nl, etc.
- ((and semantic-flex-extensions
- (let ((fe semantic-flex-extensions)
- (r nil))
- (while fe
- (if (looking-at (car (car fe)))
- (setq ts (cons (funcall (cdr (car fe))) ts)
- r t
- fe nil
- ep (point)))
- (setq fe (cdr fe)))
- (if (and r (not (car ts))) (setq ts (cdr ts)))
- r)))
- ;; catch newlines when needed
- ((looking-at "\\s-*\\(\n\\|\\s>\\)")
- (if semantic-flex-enable-newlines
- (setq ep (match-end 1)
- ts (cons (cons 'newline
- (cons (match-beginning 1) ep))
- ts))))
- ;; catch whitespace when needed
- ((looking-at "\\s-+")
- (if semantic-flex-enable-whitespace
- ;; Language wants whitespaces, link them together.
- (if (eq (car (car ts)) 'whitespace)
- (setcdr (cdr (car ts)) (match-end 0))
- (setq ts (cons (cons 'whitespace
- (cons (match-beginning 0)
- (match-end 0)))
- ts)))))
- ;; numbers
- ((and semantic-number-expression
- (looking-at semantic-number-expression))
- (setq ts (cons (cons 'number
- (cons (match-beginning 0)
- (match-end 0)))
- ts)))
- ;; symbols
- ((looking-at "\\(\\sw\\|\\s_\\)+")
- (setq ts (cons (cons
- ;; Get info on if this is a keyword or not
- (or (semantic-lex-keyword-p (match-string 0))
- 'symbol)
- (cons (match-beginning 0) (match-end 0)))
- ts)))
- ;; Character quoting characters (ie, \n as newline)
- ((looking-at "\\s\\+")
- (setq ts (cons (cons 'charquote
- (cons (match-beginning 0) (match-end 0)))
- ts)))
- ;; Open parens, or semantic-lists.
- ((looking-at "\\s(")
- (if (or (not depth) (< curdepth depth))
- (progn
- (setq curdepth (1+ curdepth))
- (setq ts (cons (cons 'open-paren
- (cons (match-beginning 0) (match-end 0)))
- ts)))
- (setq ts (cons
- (cons 'semantic-list
- (cons (match-beginning 0)
- (save-excursion
- (condition-case nil
- (forward-list 1)
- ;; This case makes flex robust
- ;; to broken lists.
- (error
- (goto-char
- (funcall
- semantic-flex-unterminated-syntax-end-function
- 'semantic-list
- start end))))
- (setq ep (point)))))
- ts))))
- ;; Close parens
- ((looking-at "\\s)")
- (setq ts (cons (cons 'close-paren
- (cons (match-beginning 0) (match-end 0)))
- ts))
- (setq curdepth (1- curdepth)))
- ;; String initiators
- ((looking-at "\\s\"")
- ;; Zing to the end of this string.
- (setq ts (cons (cons 'string
- (cons (match-beginning 0)
- (save-excursion
- (condition-case nil
- (forward-sexp 1)
- ;; This case makes flex
- ;; robust to broken strings.
- (error
- (goto-char
- (funcall
- semantic-flex-unterminated-syntax-end-function
- 'string
- start end))))
- (setq ep (point)))))
- ts)))
- ;; comments
- ((looking-at cs)
- (if (and semantic-ignore-comments
- (not semantic-flex-enable-whitespace))
- ;; If the language doesn't deal with comments nor
- ;; whitespaces, ignore them here.
- (let ((comment-start-point (point)))
- (forward-comment 1)
- (if (eq (point) comment-start-point)
- ;; In this case our start-skip string failed
- ;; to work properly. Lets try and move over
- ;; whatever white space we matched to begin
- ;; with.
- (skip-syntax-forward "-.'" (point-at-eol))
- ;;(forward-comment 1)
- ;; Generate newline token if enabled
- (if (and semantic-flex-enable-newlines
- (bolp))
- (backward-char 1)))
- (if (eq (point) comment-start-point)
- (error "Strange comment syntax prevents lexical analysis"))
- (setq ep (point)))
- (let ((tk (if semantic-ignore-comments 'whitespace 'comment)))
- (save-excursion
- (forward-comment 1)
- ;; Generate newline token if enabled
- (if (and semantic-flex-enable-newlines
- (bolp))
- (backward-char 1))
- (setq ep (point)))
- ;; Language wants comments or want them as whitespaces,
- ;; link them together.
- (if (eq (car (car ts)) tk)
- (setcdr (cdr (car ts)) ep)
- (setq ts (cons (cons tk (cons (match-beginning 0) ep))
- ts))))))
- ;; punctuation
- ((looking-at "\\(\\s.\\|\\s$\\|\\s'\\)")
- (setq ts (cons (cons 'punctuation
- (cons (match-beginning 0) (match-end 0)))
- ts)))
- ;; unknown token
- (t
- (error "What is that?")))
- (goto-char (or ep (match-end 0)))
- (setq ep nil)))
- ;; maybe catch the last beginning of line when needed
- (and semantic-flex-enable-bol
- (= (point) end)
- (bolp)
- (setq ts (cons (cons 'bol (cons (point) (point))) ts)))
- (goto-char pos)
- ;;(message "Flexing muscles...done")
- (nreverse ts)))
+(make-obsolete-variable 'semantic-flex-depth nil "28.1")
(provide 'semantic/lex)
diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el
index 23f5f89274f..fc7f9dbcb64 100644
--- a/lisp/cedet/semantic/symref/list.el
+++ b/lisp/cedet/semantic/symref/list.el
@@ -85,10 +85,12 @@ current project to find references to the input SYM. The
references are the organized by file and the name of the function
they are used in.
Display the references in `semantic-symref-results-mode'."
- (interactive (list (let ((tag (semantic-current-tag)))
- (read-string " Symrefs for: " nil nil
- (when tag
- (regexp-quote (semantic-tag-name tag)))))))
+ (interactive (list (let* ((tag (semantic-current-tag))
+ (default (when tag
+ (regexp-quote
+ (semantic-tag-name tag)))))
+ (read-string (format-prompt " Symrefs for" default)
+ nil nil default))))
;; FIXME: Shouldn't the input be in Emacs regexp format, for
;; consistency? Converting it to extended is not hard.
(semantic-fetch-tags)
diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el
index 50d43fe9342..23f4b29cbd6 100644
--- a/lisp/cedet/semantic/tag-file.el
+++ b/lisp/cedet/semantic/tag-file.el
@@ -101,9 +101,6 @@ PARENT can also be a `semanticdb-table' object."
)
)
-(make-obsolete-overload 'semantic-find-nonterminal
- 'semantic-go-to-tag "23.2")
-
;;; Dependencies
;;
;; A tag which is of type 'include specifies a dependency.
@@ -175,9 +172,6 @@ Depends on `semantic-dependency-include-path' for searching. Always searches
nil)
)))
-(make-obsolete-overload 'semantic-find-dependency
- 'semantic-dependency-tag-file "23.2")
-
;;; PROTOTYPE FILE
;;
;; In C, a function in the .c file often has a representation in a
@@ -199,13 +193,6 @@ file prototypes belong in."
(if (re-search-forward "::Header:: \\([a-zA-Z0-9.]+\\)" nil t)
(match-string 1))))))
-(semantic-alias-obsolete 'semantic-find-nonterminal
- 'semantic-go-to-tag "23.2")
-
-(semantic-alias-obsolete 'semantic-find-dependency
- 'semantic-dependency-tag-file "23.2")
-
-
(provide 'semantic/tag-file)
;; Local variables:
diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el
index 16179a53cd5..3ee11df7d8e 100644
--- a/lisp/cedet/semantic/tag-ls.el
+++ b/lisp/cedet/semantic/tag-ls.el
@@ -190,7 +190,7 @@ See `semantic-tag-similar-p' for details."
;; will contain the info needed to determine the full name.
(define-overloadable-function semantic-tag-full-package (tag &optional stream-or-buffer)
"Return the fully qualified package name of TAG in a package hierarchy.
-STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream',
+STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-tag-table',
but must be a toplevel semantic tag stream that contains TAG.
A Package Hierarchy is defined in UML by the way classes and methods
are organized on disk. Some languages use this concept such that a
@@ -213,7 +213,7 @@ Return the name of the first tag of class `package' in STREAM."
(define-overloadable-function semantic-tag-full-name (tag &optional stream-or-buffer)
"Return the fully qualified name of TAG in the package hierarchy.
-STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream',
+STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-tag-table',
but must be a toplevel semantic tag stream that contains TAG.
A Package Hierarchy is defined in UML by the way classes and methods
are organized on disk. Some languages use this concept such that a
@@ -233,9 +233,6 @@ resolve issues where a method in a class in a package is present."
(or stream-or-buffer tag))))
(:override-with-args (tag stream))))
-(make-obsolete-overload 'semantic-nonterminal-full-name
- 'semantic-tag-full-name "23.2")
-
(defun semantic-tag-full-name-default (tag stream)
"Default method for `semantic-tag-full-name'.
Return the name of TAG found in the toplevel STREAM."
@@ -287,9 +284,6 @@ is to return a symbol based on type modifiers."
(setq parent (semantic-tag-calculate-parent tag)))
(:override))
-(make-obsolete-overload 'semantic-nonterminal-protection
- 'semantic-tag-protection "23.2")
-
(defun semantic-tag-protection-default (tag &optional parent)
"Return the protection of TAG as a child of PARENT default action.
See `semantic-tag-protection'."
@@ -377,9 +371,6 @@ 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.")
-(make-obsolete-overload 'semantic-nonterminal-abstract
- 'semantic-tag-abstract-p "23.2")
-
(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'."
@@ -400,9 +391,6 @@ 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.")
-(make-obsolete-overload 'semantic-nonterminal-leaf
- 'semantic-tag-leaf-p "23.2")
-
(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'."
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index ca5c068d348..e677264c5a9 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -1328,26 +1328,6 @@ This function is overridable with the symbol `insert-foreign-tag'."
(defconst semantic-token-incompatible-version
semantic-tag-incompatible-version)
-(defsubst semantic-token-type-parent (tag)
- "Return the parent of the type that TAG describes.
-The return value is a list. A value of nil means no parents.
-The `car' of the list is either the parent class, or a list
-of parent classes. The `cdr' of the list is the list of
-interfaces, or abstract classes which are parents of TAG."
- (cons (semantic-tag-get-attribute tag :superclasses)
- (semantic-tag-type-interfaces tag)))
-
-(make-obsolete 'semantic-token-type-parent
- "\
-use `semantic-tag-type-superclass' \
-and `semantic-tag-type-interfaces' instead" "23.2")
-
-(semantic-alias-obsolete 'semantic-tag-make-assoc-list
- 'semantic-tag-make-plist "23.2")
-
-(semantic-varalias-obsolete 'semantic-expand-nonterminal
- 'semantic-tag-expand-function "23.2")
-
(provide 'semantic/tag)
;; Local variables:
diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el
index c64d56b2e21..7df7dfcb75f 100644
--- a/lisp/cedet/semantic/util.el
+++ b/lisp/cedet/semantic/util.el
@@ -79,9 +79,6 @@ If FILE is not loaded, and semanticdb is not available, find the file
(with-current-buffer (find-file-noselect file)
(semantic-fetch-tags))))))
-(semantic-alias-obsolete 'semantic-file-token-stream
- 'semantic-file-tag-table "23.2")
-
(declare-function semanticdb-abstract-table-child-p "semantic/db" (obj) t)
(declare-function semanticdb-refresh-table "semantic/db")
(declare-function semanticdb-get-tags "semantic/db" (arg &rest args) t)
@@ -137,9 +134,6 @@ buffer, or a filename. If SOMETHING is nil return nil."
;; don't know what it is
(t nil)))
-(semantic-alias-obsolete 'semantic-something-to-stream
- 'semantic-something-to-tag-table "23.2")
-
;;; Completion APIs
;;
;; These functions provide minibuffer reading/completion for lists of
@@ -307,7 +301,6 @@ If TAG is not specified, use the tag at point."
semantic-init-db-hook
semantic-unmatched-syntax-hook
semantic--before-fetch-tags-hook
- semantic-after-toplevel-bovinate-hook
semantic-after-toplevel-cache-change-hook
semantic-before-toplevel-cache-flush-hook
semantic-dump-parse
diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el
index 527a35c9ae1..15d1313dfa4 100644
--- a/lisp/cedet/semantic/wisent.el
+++ b/lisp/cedet/semantic/wisent.el
@@ -43,11 +43,6 @@
"Extra lookahead token.
When non-nil it is directly returned by `wisent-lex-function'.")
-;; Maintain this alias for compatibility until all WY grammars have
-;; been translated again to Elisp code.
-(semantic-alias-obsolete 'wisent-lex-make-token-table
- 'semantic-lex-make-type-table "23.2")
-
(defmacro wisent-lex-eoi ()
"Return an End-Of-Input lexical token.
The EOI token is like this: ($EOI \"\" POINT-MAX . POINT-MAX)."
diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el
index 4e9927f23f1..42c5756b987 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -3053,7 +3053,7 @@ one.")
(defsubst wisent-ISVALID-TOKEN (x)
"Return non-nil if X is a character or an allowed symbol."
- (or (wisent-char-p x)
+ (or (characterp x)
(wisent-ISVALID-VAR x)))
(defun wisent-push-token (symbol &optional nocheck)
@@ -3143,7 +3143,7 @@ the rule."
(cond
((or (memq item token-list) (memq item var-list)))
;; Create new literal character token
- ((wisent-char-p item) (wisent-push-token item t))
+ ((characterp item) (wisent-push-token item t))
((error "Symbol `%s' is used, but is not defined as a token and has no rules"
item))))
(setq rhl (1+ rhl)
diff --git a/lisp/cedet/semantic/wisent/wisent.el b/lisp/cedet/semantic/wisent/wisent.el
index d8a35d3e7d3..a0a8bed1eaf 100644
--- a/lisp/cedet/semantic/wisent/wisent.el
+++ b/lisp/cedet/semantic/wisent/wisent.el
@@ -55,11 +55,8 @@
;;;; Runtime stuff
;;;; -------------
-;;; Compatibility
-(eval-and-compile
- (if (fboundp 'char-valid-p)
- (defalias 'wisent-char-p 'char-valid-p)
- (defalias 'wisent-char-p 'char-or-char-int-p)))
+(define-obsolete-function-alias 'wisent-char-p
+ #'characterp "28.1")
;;; Printed representation of terminals and nonterminals
(defconst wisent-escape-sequence-strings
@@ -80,7 +77,7 @@
(defsubst wisent-item-to-string (item)
"Return a printed representation of ITEM.
ITEM can be a nonterminal or terminal symbol, or a character literal."
- (if (wisent-char-p item)
+ (if (characterp item)
(or (cdr (assq item wisent-escape-sequence-strings))
(format "'%c'" item))
(symbol-name item)))
diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el
index 4151b17c885..fdb44695918 100644
--- a/lisp/cedet/srecode/document.el
+++ b/lisp/cedet/srecode/document.el
@@ -89,7 +89,7 @@ versions of names. This is an alist with each element of the form:
MATCH is a regexp to match in the type field.
RESULT is a string."
:group 'document
- :type '(repeat (cons (string :tag "Regexp")
+ :type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
(defcustom srecode-document-autocomment-function-alist
@@ -145,7 +145,7 @@ 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 (string :tag "Regexp")
+ :type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
(defcustom srecode-document-autocomment-common-nouns-abbrevs
@@ -176,7 +176,7 @@ versions of names. This is an alist with each element of the form:
MATCH is a regexp to match in the type field.
RESULT is a string."
:group 'document
- :type '(repeat (cons (string :tag "Regexp")
+ :type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
(defcustom srecode-document-autocomment-return-first-alist
@@ -193,7 +193,7 @@ This is an alist with each element of the form:
MATCH is a regexp to match in the type field.
RESULT is a string."
:group 'document
- :type '(repeat (cons (string :tag "Regexp")
+ :type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
(defcustom srecode-document-autocomment-return-last-alist
@@ -214,7 +214,7 @@ 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 (string :tag "Regexp")
+ :type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
(defcustom srecode-document-autocomment-param-alist
@@ -234,7 +234,7 @@ 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 (string :tag "Regexp")
+ :type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
(defcustom srecode-document-autocomment-param-type-alist
@@ -259,7 +259,7 @@ This is an alist with each element of the form:
MATCH is a regexp to match in the type field.
RESULT is a string."
:group 'document
- :type '(repeat (cons (string :tag "Regexp")
+ :type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
;;;###autoload
diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el
index 26c14892efd..5b2dd034743 100644
--- a/lisp/cedet/srecode/semantic.el
+++ b/lisp/cedet/srecode/semantic.el
@@ -201,7 +201,7 @@ variable default values, and other things."
(let ((tag (or srecode-semantic-selected-tag
(srecode-semantic-tag-from-kill-ring))))
(when (not tag)
- "No tag for current template. Use the semantic kill-ring.")
+ (error "No tag for current template. Use the semantic kill-ring."))
(srecode-semantic-apply-tag-to-dict
(srecode-semantic-tag (semantic-tag-name tag)
:prime tag)
diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el
index 6b8c3034a4c..4c1e030fceb 100644
--- a/lisp/cedet/srecode/srt-mode.el
+++ b/lisp/cedet/srecode/srt-mode.el
@@ -195,7 +195,7 @@ we can tell font lock about them.")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'comment-start-skip)
- "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
(set (make-local-variable 'font-lock-defaults)
'(srecode-font-lock-keywords
nil ;; perform string/comment fontification
diff --git a/lisp/char-fold.el b/lisp/char-fold.el
index f8a303956e3..34561a2efe6 100644
--- a/lisp/char-fold.el
+++ b/lisp/char-fold.el
@@ -324,6 +324,13 @@ from which to start."
(while (< i end)
(pcase (aref string i)
(?\s (setq spaces (1+ spaces)))
+ ((pred (lambda (c) (and char-fold-symmetric
+ (if isearch-regexp
+ isearch-regexp-lax-whitespace
+ isearch-lax-whitespace)
+ (stringp search-whitespace-regexp)
+ (string-match-p search-whitespace-regexp (char-to-string c)))))
+ (setq spaces (1+ spaces)))
(c (when (> spaces 0)
(push (char-fold--make-space-string spaces) out)
(setq spaces 0))
@@ -370,11 +377,7 @@ from which to start."
(setq i (1+ i)))
(when (> spaces 0)
(push (char-fold--make-space-string spaces) out))
- (let ((regexp (apply #'concat (nreverse out))))
- ;; Limited by `MAX_BUF_SIZE' in `regex-emacs.c'.
- (if (> (length regexp) 5000)
- (regexp-quote string)
- regexp))))
+ (apply #'concat (nreverse out))))
;;; Commands provided for completeness.
diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el
index d590b9ecf61..7191b933e41 100644
--- a/lisp/cmuscheme.el
+++ b/lisp/cmuscheme.el
@@ -327,9 +327,8 @@ With a prefix argument switch off tracing of procedure PROC."
(interactive
(list (let ((current (symbol-at-point))
(action (if current-prefix-arg "Untrace" "Trace")))
- (if current
- (read-string (format "%s procedure [%s]: " action current) nil nil (symbol-name current))
- (read-string (format "%s procedure: " action))))
+ (read-string (format-prompt "%s procedure" current action)
+ nil nil (and current (symbol-name current))))
current-prefix-arg))
(when (= (length proc) 0)
(error "Invalid procedure name"))
@@ -517,6 +516,8 @@ command to run."
This is a good place to put keybindings."
:type 'hook
:group 'cmuscheme)
+(make-obsolete-variable 'cmuscheme-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(run-hooks 'cmuscheme-load-hook)
diff --git a/lisp/comint.el b/lisp/comint.el
index 3e76c5d02b0..611947605fb 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -223,6 +223,13 @@ This variable is buffer-local."
(other :tag "on" t))
:group 'comint)
+(defcustom comint-highlight-input t
+ "If non-nil, highlight input with `comint-highlight-input' face.
+Otherwise keep the original highlighting untouched."
+ :version "28.1"
+ :type 'boolean
+ :group 'comint)
+
(defface comint-highlight-input '((t (:weight bold)))
"Face to use to highlight user input."
:group 'comint)
@@ -249,6 +256,10 @@ to set this in a mode hook, rather than customize the default value."
file)
:group 'comint)
+(defvar comint-input-ring-file-prefix nil
+ "The prefix to skip when parsing the input ring file.
+This is useful in Zsh when the extended_history option is on.")
+
(defcustom comint-scroll-to-bottom-on-input nil
"Controls whether input to interpreter causes window to scroll.
If nil, then do not scroll. If t or `all', scroll all windows showing buffer.
@@ -731,7 +742,7 @@ contents are sent to the process as its initial input.
If PROGRAM is a string, any more args are arguments to PROGRAM.
Return the (possibly newly created) process buffer."
- (or (fboundp 'start-file-process)
+ (or (fboundp 'make-process)
(error "Multi-processing is not supported for this system"))
(setq buffer (get-buffer-create (or buffer (concat "*" name "*"))))
;; If no process, or nuked process, crank up a new one and put buffer in
@@ -809,18 +820,10 @@ series of processes in the same Comint buffer. The hook
(goto-char (point-max))
(set-marker (process-mark proc) (point))
;; Feed it the startfile.
- (cond (startfile
- ;;This is guaranteed to wait long enough
- ;;but has bad results if the comint does not prompt at all
- ;; (while (= size (buffer-size))
- ;; (sleep-for 1))
- ;;I hope 1 second is enough!
- (sleep-for 1)
- (goto-char (point-max))
- (insert-file-contents startfile)
- (setq startfile (buffer-substring (point) (point-max)))
- (delete-region (point) (point-max))
- (comint-send-string proc startfile)))
+ (when startfile
+ (comint-send-string proc (with-temp-buffer
+ (insert-file-contents startfile)
+ (buffer-string))))
(run-hooks 'comint-exec-hook)
buffer)))
@@ -987,8 +990,20 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'."
(setq end (match-beginning 0)))
(setq start
(if (re-search-backward ring-separator nil t)
- (match-end 0)
- (point-min)))
+ (progn
+ (when (and comint-input-ring-file-prefix
+ (looking-at
+ comint-input-ring-file-prefix))
+ ;; Skip zsh extended_history stamps
+ (goto-char (match-end 0)))
+ (match-end 0))
+ (progn
+ (goto-char (point-min))
+ (when (and comint-input-ring-file-prefix
+ (looking-at
+ comint-input-ring-file-prefix))
+ (goto-char (match-end 0)))
+ (point))))
(setq history (buffer-substring start end))
(goto-char start)
(when (and (not (string-match history-ignore history))
@@ -1758,7 +1773,7 @@ Argument 0 is the command name."
((>= mth 0) (1- (- count mth)))
(t (1- (- mth))))))
(mapconcat
- (function (lambda (a) a)) (nthcdr n (nreverse (nthcdr m args))) " "))))
+ (lambda (a) a) (nthcdr n (nreverse (nthcdr m args))) " "))))
;;
;; Input processing stuff
@@ -1881,9 +1896,10 @@ Similarly for Soar, Scheme, etc."
(end (if no-newline (point) (1- (point)))))
(with-silent-modifications
(when (> end beg)
- (add-text-properties beg end
- '(front-sticky t
- font-lock-face comint-highlight-input))
+ (when comint-highlight-input
+ (add-text-properties beg end
+ '( font-lock-face comint-highlight-input
+ front-sticky t )))
(unless comint-use-prompt-regexp
;; Give old user input a field property of `input', to
;; distinguish it from both process output and unsent
@@ -2350,6 +2366,7 @@ a buffer local variable."
;; For compatibility.
(defun comint-read-noecho (prompt &optional _ignore)
+ (declare (obsolete read-passwd "28.1"))
(read-passwd prompt))
;; These three functions are for entering text you don't want echoed or
@@ -2398,11 +2415,13 @@ Security bug: your string can still be temporarily recovered with
(defun comint-watch-for-password-prompt (string)
"Prompt in the minibuffer for password and send without echoing.
Looks for a match to `comint-password-prompt-regexp' in order
-to detect the need to (prompt and) send a password.
+to detect the need to (prompt and) send a password. Ignores any
+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 string))
+ (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)))
(let ((comint--prompt-recursion-depth (1+ comint--prompt-recursion-depth)))
@@ -3124,7 +3143,7 @@ See `comint-word'."
"\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)"
"\\|{\\(?1:[^{}]+\\)}\\)"
(when (memq system-type '(ms-dos windows-nt))
- "\\|%\\(?1:[^\\\\/]*\\)%")
+ "\\|%\\(?1:[^\\/]*\\)%")
(when comint-file-name-quote-list
"\\|\\\\\\(.\\)")))
(qupos nil)
@@ -3425,7 +3444,7 @@ the completions."
(eq (window-buffer (posn-window (event-start first)))
(get-buffer "*Completions*"))
(memq (key-binding key)
- '(mouse-choose-completion choose-completion))))
+ '(choose-completion))))
;; If the user does choose-completion with the mouse,
;; execute the command, then delete the completion window.
(progn
@@ -3641,7 +3660,7 @@ and does not normally need to be invoked by the end user or programmer."
(setq-local comint-redirect-previous-input-string "")
(setq mode-line-process
- (if mode-line-process
+ (if (and mode-line-process (stringp (elt mode-line-process 0)))
(list (concat (elt mode-line-process 0) " Redirection"))
(list ":%s Redirection")))))
diff --git a/lisp/completion.el b/lisp/completion.el
index b2864746fc7..e4a004f1908 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -399,13 +399,6 @@ Used to decide whether to save completions.")
:up)
(t :neither))))))
-;; Tests -
-;; (cmpl-string-case-type "123ABCDEF456") --> :up
-;; (cmpl-string-case-type "123abcdef456") --> :down
-;; (cmpl-string-case-type "123aBcDeF456") --> :mixed
-;; (cmpl-string-case-type "123456") --> :neither
-;; (cmpl-string-case-type "Abcde123") --> :capitalized
-
(defun cmpl-coerce-string-case (string case-type)
(cond ((eq case-type :down) (downcase string))
((eq case-type :up) (upcase string))
@@ -424,12 +417,6 @@ Used to decide whether to save completions.")
;; as is
string-to-coerce))))
-;; Tests -
-;; (cmpl-merge-string-cases "AbCdEf456" "abc") --> AbCdEf456
-;; (cmpl-merge-string-cases "abcdef456" "ABC") --> ABCDEF456
-;; (cmpl-merge-string-cases "ABCDEF456" "Abc") --> Abcdef456
-;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456
-
(defun cmpl-hours-since-origin ()
(floor (time-convert nil 'integer) 3600))
@@ -1226,45 +1213,6 @@ String must be longer than `completion-prefix-min-length'."
(set cmpl-db-prefix-symbol nil)))))
(error "Unknown completion `%s'" completion-string))))
-;; Tests --
-;; - Add and Find -
-;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
-;; (find-exact-completion "banana") --> ("banana" 0 nil 0)
-;; (find-exact-completion "bana") --> nil
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
-;; (add-completion-to-head "banish") --> ("banish" 0 nil 0)
-;; (find-exact-completion "banish") --> ("banish" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
-;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
-;;
-;; - Deleting -
-;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
-;; (delete-completion "banner")
-;; (find-exact-completion "banner") --> nil
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
-;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
-;; (delete-completion "banana")
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
-;; (delete-completion "banner")
-;; (delete-completion "banish")
-;; (find-cmpl-prefix-entry "ban") --> nil
-;; (delete-completion "banner") --> error
-;;
-;; - Tail -
-;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
-;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban")) -->(("banana" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) -->(("banish" ...))
-;;
-
;;---------------------------------------------------------------------------
;; Database Update :: Interface level routines
@@ -1276,11 +1224,7 @@ String must be longer than `completion-prefix-min-length'."
(defun interactive-completion-string-reader (prompt)
(let* ((default (symbol-under-or-before-point))
- (new-prompt
- (if default
- (format "%s (default %s): " prompt default)
- (format "%s: " prompt)))
- (read (completing-read new-prompt cmpl-obarray)))
+ (read (completing-read (format-prompt prompt default) cmpl-obarray)))
(if (zerop (length read)) (setq read (or default "")))
(list read)))
@@ -1365,29 +1309,6 @@ Completions added this way will automatically be saved if
(set-completion-num-uses entry 1)
(setq cmpl-completions-accepted-p t)))))))
-;; Tests --
-;; - Add and Find -
-;; (add-completion "banana" 5 10)
-;; (find-exact-completion "banana") --> ("banana" 5 10 0)
-;; (add-completion "banana" 6)
-;; (find-exact-completion "banana") --> ("banana" 6 10 0)
-;; (add-completion "banish")
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
-;;
-;; - Accepting -
-;; (setq completion-to-accept "banana")
-;; (accept-completion)
-;; (find-exact-completion "banana") --> ("banana" 7 10)
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
-;; (setq completion-to-accept "banish")
-;; (add-completion "banner")
-;; (car (find-cmpl-prefix-entry "ban"))
-;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...))
-;;
-;; - Deleting -
-;; (kill-completion "banish")
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...))
-
;;---------------------------------------------------------------------------
;; Searching the database
@@ -1509,46 +1430,6 @@ If there are no more entries, try cdabbrev and then return only a string."
;; Completely unsuccessful, return nil
))
-;; Tests --
-;; - Add and Find -
-;; (add-completion "banana")
-;; (completion-search-reset "ban")
-;; (completion-search-next 0) --> "banana"
-;;
-;; - Discrimination -
-;; (add-completion "cumberland")
-;; (add-completion "cumberbund")
-;; cumbering
-;; (completion-search-reset "cumb")
-;; (completion-search-peek t) --> "cumberbund"
-;; (completion-search-next 0) --> "cumberbund"
-;; (completion-search-peek t) --> "cumberland"
-;; (completion-search-next 1) --> "cumberland"
-;; (completion-search-peek nil) --> nil
-;; (completion-search-next 2) --> "cumbering" {cdabbrev}
-;; (completion-search-next 3) --> nil or "cumming"{depends on context}
-;; (completion-search-next 1) --> "cumberland"
-;; (completion-search-peek t) --> "cumbering" {cdabbrev}
-;;
-;; - Accepting -
-;; (completion-search-next 1) --> "cumberland"
-;; (setq completion-to-accept "cumberland")
-;; (completion-search-reset "foo")
-;; (completion-search-reset "cum")
-;; (completion-search-next 0) --> "cumberland"
-;;
-;; - Deleting -
-;; (kill-completion "cumberland")
-;; cummings
-;; (completion-search-reset "cum")
-;; (completion-search-next 0) --> "cumberbund"
-;; (completion-search-next 1) --> "cummings"
-;;
-;; - Ignoring Capitalization -
-;; (completion-search-reset "CuMb")
-;; (completion-search-next 0) --> "cumberbund"
-
-
;;-----------------------------------------------
;; COMPLETE
@@ -1737,12 +1618,6 @@ Prefix args ::
"\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*"
"A regexp that searches for Lisp definition form.")
-;; Tests -
-;; (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8
-;; (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9
-;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10
-;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9
-
;; Parses all the definition names from a Lisp mode buffer and adds them to
;; the completion database.
(defun add-completions-from-lisp-buffer ()
diff --git a/lisp/composite.el b/lisp/composite.el
index 77c5cd87b88..47d91c5d212 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -660,7 +660,7 @@ All non-spacing characters have this function in
;; align it at the center of the glyph of the
;; enclosing mark hoping that the enclosing mark
;; is big enough. We also have to adjust the
- ;; x-offset and width of the mark ifself properly
+ ;; x-offset and width of the mark itself properly
;; depending on how the glyph is designed.
;; (non-spacing or not). For instance, when we
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index e2fd7febd2f..9003b7fc1b5 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -51,6 +51,25 @@ ldefs-boot\\|cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
(defalias sym e))))
'(defcustom defface defgroup)))
+(defun custom--get-def (expr)
+ (if (not (memq (car-safe expr)
+ '( define-minor-mode define-globalized-minor-mode)))
+ expr
+ ;; For define-minor-mode, we don't want to evaluate the whole
+ ;; expression, because it tends to define functions which aren't
+ ;; usable (because they call other functions that were skipped).
+ ;; Concretely it gave us an error
+ ;; "void-function bug-reference--run-auto-setup"
+ ;; when subsequently loading `cus-load.el'.
+ (let ((es (list (macroexpand-all expr)))
+ defs)
+ (while es
+ (let ((e (pop es)))
+ (pcase e
+ (`(progn . ,exps) (setq es (append exps es)))
+ (`(custom-declare-variable . ,_) (push e defs)))))
+ (macroexp-progn (nreverse defs)))))
+
(defun custom-make-dependencies ()
"Batch function to extract custom dependencies from .el files.
Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
@@ -70,7 +89,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(directory-files subdir nil
"\\`[^=.].*\\.el\\'"))))
(progress (make-progress-reporter
- (byte-compile-info-string "Scanning files for custom")
+ (byte-compile-info "Scanning files for custom")
0 (length files) nil 10)))
(with-temp-buffer
(dolist (elem files)
@@ -102,12 +121,16 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
"^(def\\(custom\\|face\\|group\\|ine\\(?:-globalized\\)?-minor-mode\\)" nil t)
(beginning-of-line)
(let ((type (match-string 1))
- (expr (read (current-buffer))))
+ (expr (custom--get-def (read (current-buffer)))))
(condition-case nil
- (let ((custom-dont-initialize t))
+ (let ((custom-dont-initialize t)
+ (sym (nth 1 expr)))
+ (put (if (eq (car-safe sym) 'quote)
+ (cadr sym)
+ sym)
+ 'custom-where name)
;; Eval to get the 'custom-group, -tag,
;; -version, group-documentation etc properties.
- (put (nth 1 expr) 'custom-where name)
(eval expr))
;; Eval failed for some reason. Eg maybe the
;; defcustom uses something defined earlier
@@ -127,8 +150,8 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
type)))))))))))
(error nil)))))))
(progress-reporter-done progress))
- (byte-compile-info-message "Generating %s..."
- generated-custom-dependencies-file)
+ (byte-compile-info
+ (format "Generating %s..." generated-custom-dependencies-file) t)
(set-buffer (find-file-noselect generated-custom-dependencies-file))
(setq buffer-undo-list t)
(erase-buffer)
@@ -148,7 +171,8 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(when found
(push (cons (symbol-name symbol)
(with-output-to-string
- (prin1 (sort found 'string<)))) alist))))))
+ (prin1 (sort found #'string<))))
+ alist))))))
(dolist (e (sort alist (lambda (e1 e2) (string< (car e1) (car e2)))))
(insert "(put '" (car e) " 'custom-loads '" (cdr e) ")\n")))
(insert "\
@@ -217,8 +241,8 @@ 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"))
(save-buffer)
- (byte-compile-info-message "Generating %s...done"
- generated-custom-dependencies-file))
+ (byte-compile-info
+ (format "Generating %s...done" generated-custom-dependencies-file) t))
(provide 'cus-dep)
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 490d9055ecf..a62b623c44f 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -408,10 +408,6 @@ Use group `text' for this instead. This group is deprecated."
"Input from the menus."
:group 'environment)
-(defgroup dnd nil
- "Handling data from drag and drop."
- :group 'environment)
-
(defgroup auto-save nil
"Preventing accidental loss of data."
:group 'files)
@@ -485,10 +481,8 @@ Return a list suitable for use in `interactive'."
(default (and (symbolp v) (custom-variable-p v) (symbol-name v)))
(enable-recursive-minibuffers t)
val)
- (setq val (completing-read
- (if default (format "Customize variable (default %s): " default)
- "Customize variable: ")
- obarray 'custom-variable-p t nil nil default))
+ (setq val (completing-read (format-prompt "Customize variable" default)
+ obarray 'custom-variable-p t nil nil default))
(list (if (equal val "")
(if (symbolp v) v nil)
(intern val)))))
@@ -561,7 +555,7 @@ value unless you are sure you know what it does."
(unless no-suffix
(goto-char (point-max))
(insert "..."))
- (buffer-string)))))
+ (propertize (buffer-string) 'custom-data symbol)))))
(defcustom custom-unlispify-tag-names t
"Display tag names as words instead of symbols if non-nil."
@@ -801,16 +795,19 @@ has been executed, nil otherwise."
If a setting was edited and set before, this saves it. If a
setting was merely edited before, this sets it then saves it."
(interactive)
- (when (custom-command-apply
- (lambda (child)
- (when (memq (widget-get child :custom-state)
- '(modified set changed rogue))
- (widget-apply child :custom-mark-to-save)))
- "Save all settings in this buffer? " t)
- ;; Save changes to buffer and redraw.
- (custom-save-all)
- (dolist (child custom-options)
- (widget-apply child :custom-state-set-and-redraw))))
+ (let (edited-widgets)
+ (when (custom-command-apply
+ (lambda (child)
+ (when (memq (widget-get child :custom-state)
+ '(modified set changed rogue))
+ (push child edited-widgets)
+ (widget-apply child :custom-mark-to-save)))
+ "Save all settings in this buffer? " t)
+ ;; Save changes to buffer.
+ (custom-save-all)
+ ;; Redraw and recalculate the state when necessary.
+ (dolist (widget edited-widgets)
+ (widget-apply widget :custom-state-set-and-redraw)))))
(defun custom-reset (_widget &optional event)
"Select item from reset menu."
@@ -1081,9 +1078,7 @@ for the MODE to customize."
(if (and group (not current-prefix-arg))
major-mode
(intern
- (completing-read (if group
- (format "Mode (default %s): " major-mode)
- "Mode: ")
+ (completing-read (format-prompt "Mode" (and group major-mode))
obarray
'custom-group-of-mode
t nil nil (if group (symbol-name major-mode))))))))
@@ -1216,8 +1211,8 @@ that were added or redefined since that version."
(interactive
(list
(read-from-minibuffer
- (format "Customize options changed, since version (default %s): "
- customize-changed-options-previous-release))))
+ (format-prompt "Customize options changed, since version"
+ customize-changed-options-previous-release))))
(if (equal since-version "")
(setq since-version nil)
(unless (condition-case nil
@@ -2682,7 +2677,7 @@ try matching its doc string against `custom-guess-doc-alist'."
:sample-face (if obsolete
'custom-variable-obsolete
'custom-variable-tag)
- tag)
+ :tag tag)
buttons)
(push (widget-create-child-and-convert
widget type
@@ -3565,19 +3560,24 @@ the present value is saved to its :shown-value property instead."
(widget-put widget :buttons buttons))
;; Draw an ordinary `custom-face' widget
- (let ((opoint (point)))
- ;; Visibility indicator.
- (push (widget-create-child-and-convert
- widget 'custom-visibility
- :help-echo "Hide or show this face."
- :on "Hide" :off "Show"
- :on-glyph "down" :off-glyph "right"
- :action 'custom-toggle-hide-face
- (not hiddenp))
- buttons)
- ;; Face name (tag).
- (insert " " tag)
- (widget-specify-sample widget opoint (point)))
+ ;; Visibility indicator.
+ (push (widget-create-child-and-convert
+ widget 'custom-visibility
+ :help-echo "Hide or show this face."
+ :on "Hide" :off "Show"
+ :on-glyph "down" :off-glyph "right"
+ :action 'custom-toggle-hide-face
+ (not hiddenp))
+ buttons)
+ ;; Face name (tag).
+ (insert " ")
+ (push (widget-create-child-and-convert
+ widget 'face-link
+ :button-face 'link
+ :tag tag
+ :action (lambda (&rest _x)
+ (find-face-definition symbol)))
+ buttons)
(insert
(cond ((eq custom-buffer-style 'face) " ")
((string-match-p "face\\'" tag) ":")
@@ -3825,7 +3825,17 @@ Optional EVENT is the location for the menu."
(defun custom-face-save (widget)
"Save the face edited by WIDGET."
- (custom-face-mark-to-save widget)
+ (let ((form (widget-get widget :custom-form)))
+ (if (memq form '(all lisp))
+ (custom-face-mark-to-save widget)
+ ;; The user is working on only a selected terminal type;
+ ;; make sure we save the entire spec to `custom-file'. (Bug #40866)
+ (custom-face-edit-all widget)
+ (custom-face-mark-to-save widget)
+ (if (eq form 'selected)
+ (custom-face-edit-selected widget)
+ ;; `form' is edit or mismatch; can't happen.
+ (widget-put widget :custom-form form))))
(custom-save-all)
(custom-face-state-set-and-redraw widget))
@@ -4831,7 +4841,10 @@ The format is suitable for use with `easy-menu-define'."
(error "You can't edit this part of the Custom buffer"))
(defun Custom-newline (pos &optional event)
- "Invoke button at POS, or refuse to allow editing of Custom buffer."
+ "Invoke button at POS, or refuse to allow editing of Custom buffer.
+
+To see what function the widget will call, use the
+`widget-describe' command."
(interactive "@d")
(let ((button (get-char-property pos 'button)))
;; If there is no button at point, then use the one at the start
@@ -4855,8 +4868,6 @@ If several parents are listed, go to the first of them."
(parent (downcase (widget-get button :tag))))
(customize-group parent)))))
-(define-obsolete-variable-alias 'custom-mode-hook 'Custom-mode-hook "23.1")
-
(defcustom Custom-mode-hook nil
"Hook called when entering Custom mode."
:type 'hook
@@ -4927,8 +4938,6 @@ if that value is non-nil."
(put 'Custom-mode 'mode-class 'special)
-(define-obsolete-function-alias 'custom-mode 'Custom-mode "23.1")
-
;;; The End.
(provide 'cus-edit)
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index ed4cf046fcf..cc766aa4509 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -166,9 +166,11 @@
:help-echo "Control box around text."
(const :tag "Off" nil)
(list :tag "Box"
- :value (:line-width 2 :color "grey75" :style released-button)
- (const :format "" :value :line-width)
- (integer :tag "Width")
+ :value (:line-width (2 . 2) :color "grey75" :style released-button)
+ (const :format "" :value :line-width)
+ (cons :tag "Width" :extra-offset 2
+ (integer :tag "Vertical")
+ (integer :tag "Horizontal"))
(const :format "" :value :color)
(choice :tag "Color" (const :tag "*" nil) color)
(const :format "" :value :style)
@@ -181,15 +183,19 @@
(and real-value
(let ((lwidth
(or (and (consp real-value)
- (plist-get real-value :line-width))
+ (if (listp (cdr real-value))
+ (plist-get real-value :line-width)
+ real-value))
(and (integerp real-value) real-value)
- 1))
+ '(1 . 1)))
(color
(or (and (consp real-value) (plist-get real-value :color))
(and (stringp real-value) real-value)
nil))
(style
(and (consp real-value) (plist-get real-value :style))))
+ (if (integerp lwidth)
+ (setq lwidth (cons (abs lwidth) lwidth)))
(list :line-width lwidth :color color :style style))))
;; filter to make customized-value suitable for storing
(lambda (cus-value)
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 6632687da47..3fd6ac031c0 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -73,9 +73,11 @@
'(choice
(const :tag "Frame default" t)
(const :tag "Filled box" box)
+ (cons :tag "Box with specified size"
+ (const box) integer)
(const :tag "Hollow cursor" hollow)
(const :tag "Vertical bar" bar)
- (cons :tag "Vertical bar with specified width"
+ (cons :tag "Vertical bar with specified height"
(const bar) integer)
(const :tag "Horizontal bar" hbar)
(cons :tag "Horizontal bar with specified width"
@@ -98,6 +100,11 @@
(ctl-arrow display boolean)
(truncate-lines display boolean)
(word-wrap display boolean)
+ (word-wrap-by-category
+ display boolean "28.1"
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (when value (require 'kinsoku))))
(selective-display-ellipses display boolean)
(indicate-empty-lines fringe boolean)
(indicate-buffer-boundaries
@@ -622,7 +629,9 @@ since it could result in memory overflow and make Emacs crash."
(scroll-margin windows integer)
(maximum-scroll-margin windows float "26.1")
(hscroll-margin windows integer "22.1")
- (hscroll-step windows number "22.1")
+ (hscroll-step windows
+ (choice (const :tag "Center horizontally" nil)
+ number) "22.1")
(truncate-partial-width-windows
display
(choice (integer :tag "Truncate if narrower than")
@@ -782,7 +791,11 @@ since it could result in memory overflow and make Emacs crash."
"27.1"
:safe (lambda (value) (or (characterp value) (null value))))
;; xfaces.c
- (scalable-fonts-allowed display boolean "22.1")
+ (scalable-fonts-allowed
+ display (choice (const :tag "Don't allow scalable fonts" nil)
+ (const :tag "Allow any scalable font" t)
+ (repeat regexp))
+ "22.1")
;; xfns.c
(x-bitmap-file-path installation
(repeat (directory :format "%v")))
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index b0decfe7b72..dc463e05f92 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -419,14 +419,13 @@ It includes all variables in list VARS."
(widget-value child)
;; Child is null if the widget is closed (hidden).
(car (widget-get widget :shown-value)))))
- (when (boundp symbol)
- (unless (bolp)
- (princ "\n"))
- (princ " '(")
- (prin1 symbol)
- (princ " ")
- (prin1 (custom-quote value))
- (princ ")")))))
+ (unless (bolp)
+ (princ "\n"))
+ (princ " '(")
+ (prin1 symbol)
+ (princ " ")
+ (prin1 (custom-quote value))
+ (princ ")"))))
(if (bolp)
(princ " "))
(princ ")")
@@ -454,7 +453,7 @@ It includes all faces in list FACES."
;; Child is null if the widget is closed (hidden).
((widget-get widget :shown-value))
(t (custom-face-get-current-spec symbol)))))
- (when (and (facep symbol) value)
+ (when value
(princ (if (bolp) " '(" "\n '("))
(prin1 symbol)
(princ " ")
diff --git a/lisp/custom.el b/lisp/custom.el
index 885c486c5e4..cc445fe765b 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -758,6 +758,9 @@ Return non-nil if the `customized-value' property actually changed."
(progn (put symbol 'customized-value (list (custom-quote value)))
(custom-push-theme 'theme-value symbol 'user 'set
(custom-quote value)))
+ (custom-push-theme 'theme-value symbol 'user
+ (if (get symbol 'saved-value) 'set 'reset)
+ (custom-quote value))
(put symbol 'customized-value nil))
;; Changed?
(not (equal customized (get symbol 'customized-value)))))
@@ -904,7 +907,15 @@ See `custom-known-themes' for a list of known themes."
(boundp symbol))
(let ((sv (get symbol 'standard-value))
(val (symbol-value symbol)))
- (unless (and sv (equal (eval (car sv)) val))
+ (unless (or
+ ;; We only do this trick if the current value
+ ;; is different from the standard value.
+ (and sv (equal (eval (car sv)) val))
+ ;; And we don't do it if we would end up recording
+ ;; the same value for the user theme. This way we avoid
+ ;; having ((user VALUE) (changed VALUE)). That would be
+ ;; useless, because we don't disable the user theme.
+ (and (eq theme 'user) (equal (custom-quote val) value)))
(setq old `((changed ,(custom-quote val))))))))
(put symbol prop (cons (list theme value) old)))
(put theme 'theme-settings
@@ -1365,13 +1376,14 @@ function runs. To disable other themes, use `disable-theme'."
obarray (lambda (sym) (get sym 'theme-settings)) t))))
(unless (custom-theme-p theme)
(error "Undefined Custom theme %s" theme))
- (let ((settings (get theme 'theme-settings)))
+ (let ((settings (get theme 'theme-settings)) ; '(prop symbol theme value)
+ ;; We are enabling the theme, so don't inhibit enabling it. (Bug#34027)
+ (custom--inhibit-theme-enable nil))
;; Loop through theme settings, recalculating vars/faces.
(dolist (s settings)
(let* ((prop (car s))
- (symbol (cadr s))
- (spec-list (get symbol prop)))
- (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list)))
+ (symbol (cadr s)))
+ (custom-push-theme prop symbol theme 'set (nth 3 s))
(cond
((eq prop 'theme-face)
(custom-theme-recalc-face symbol))
@@ -1440,7 +1452,7 @@ 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))))
- (put symbol prop val)
+ (custom-push-theme prop symbol theme 'reset)
(cond
((eq prop 'theme-value)
(custom-theme-recalc-variable symbol))
@@ -1541,6 +1553,20 @@ Each of the arguments ARGS has this form:
This means reset VARIABLE. (The argument IGNORED is ignored)."
(apply #'custom-theme-reset-variables 'user args))
+(defun custom-add-choice (variable choice)
+ "Add CHOICE to the custom type of VARIABLE.
+If a choice with the same tag already exists, no action is taken."
+ (let ((choices (get variable 'custom-type)))
+ (unless (eq (car choices) 'choice)
+ (error "Not a choice type: %s" choices))
+ (unless (seq-find (lambda (elem)
+ (equal (caddr (member :tag elem))
+ (caddr (member :tag choice))))
+ (cdr choices))
+ ;; Put the new choice at the end.
+ (put variable 'custom-type
+ (append choices (list choice))))))
+
;;; The End.
(provide 'custom)
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 1dbbd421489..ec9a9680137 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -141,8 +141,7 @@ otherwise."
(wid-field (get-char-property pos 'field))
(wid-button (get-char-property pos 'button))
(wid-doc (get-char-property pos 'widget-doc))
- ;; If button.el is not loaded, we have no buttons in the text.
- (button (and (fboundp 'button-at) (button-at pos)))
+ (button (button-at pos))
(button-type (and button (button-type button)))
(button-label (and button (button-label button)))
(widget (or wid-field wid-button wid-doc)))
@@ -211,7 +210,7 @@ multilingual development.
This is a fairly large file, not typically present on GNU systems.
At the time of writing it is at the URL
-`http://www.unicode.org/Public/UNIDATA/UnicodeData.txt'."
+`https://www.unicode.org/Public/UNIDATA/UnicodeData.txt'."
:group 'mule
:version "22.1"
:type '(choice (const :tag "None" nil)
@@ -763,6 +762,8 @@ The character information includes:
(to (nth 4 composition))
glyph)
(if (fontp font)
+ ;; GUI frame: show composition in terms of
+ ;; font glyphs and characters.
(progn
(insert " using this font:\n "
(symbol-name (font-get font :type))
@@ -772,12 +773,25 @@ The character information includes:
(while (and (<= from to)
(setq glyph (lgstring-glyph gstring from)))
(insert (format " %S\n" glyph))
- (setq from (1+ from))))
+ (setq from (1+ from)))
+ (when (and (stringp (car composition))
+ (string-match "\"\\([^\"]+\\)\"" (car composition)))
+ (insert "with these character(s):\n")
+ (let ((chars (match-string 1 (car composition))))
+ (dotimes (i (length chars))
+ (let ((char (aref chars i)))
+ (insert (format " %s (#x%x) %s\n"
+ (describe-char-padded-string char) char
+ (get-char-code-property
+ char 'name))))))))
+ ;; TTY frame: show composition in terms of characters.
(insert " by these characters:\n")
(while (and (<= from to)
(setq glyph (lgstring-glyph gstring from)))
- (insert (format " %c (#x%x)\n"
- (lglyph-char glyph) (lglyph-char glyph)))
+ (insert (format " %c (#x%x) %s\n"
+ (lglyph-char glyph) (lglyph-char glyph)
+ (get-char-code-property
+ (lglyph-char glyph) 'name)))
(setq from (1+ from)))))
(insert " by the rule:\n\t(")
(let ((first t))
@@ -919,7 +933,7 @@ condition, the function may return string longer than WIDTH, see
(t name)))))))
;;;###autoload
-(defun describe-char-eldoc ()
+(defun describe-char-eldoc (_callback &rest _)
"Return a description of character at point for use by ElDoc mode.
Return nil if character at point is a printable ASCII
@@ -929,10 +943,17 @@ Otherwise return a description formatted by
of `eldoc-echo-area-use-multiline-p' variable and width of
minibuffer window for width limit.
-This function is meant to be used as a value of
-`eldoc-documentation-function' variable."
+This function can be used as a value of
+`eldoc-documentation-functions' variable."
(let ((ch (following-char)))
(when (and (not (zerop ch)) (or (< ch 32) (> ch 127)))
+ ;; TODO: investigate if the new `eldoc-documentation-functions'
+ ;; API could significantly improve this. JT@2020-07-07: Indeed,
+ ;; instead of returning a string tailored here for the echo area
+ ;; exclusively, we could call the (now unused) argument
+ ;; _CALLBACK with hints on how to shorten the string if needed,
+ ;; or with multiple usable strings which ElDoc picks according
+ ;; to its space constraints.
(describe-char-eldoc--format
ch
(unless (eq eldoc-echo-area-use-multiline-p t)
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 94de6c885e5..7a7f1d07c93 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -344,7 +344,7 @@ to the value obtained by evaluating FORM."
Each element is a regular expression. Buffers with a name matched by any of
these won't be deleted."
:version "23.3" ; added Warnings - bug#6336
- :type '(repeat string)
+ :type '(repeat regexp)
:group 'desktop)
;;;###autoload
@@ -534,7 +534,7 @@ can guess how to load the mode's definition.")
'((defining-kbd-macro nil)
(isearch-mode nil)
(vc-mode nil)
- (vc-dired-mode nil)
+ (vc-dir-mode nil)
(erc-track-minor-mode nil)
(savehist-mode nil))
"Table mapping minor mode variables to minor mode functions.
diff --git a/lisp/dframe.el b/lisp/dframe.el
index 2c421470a54..efe2bc57d93 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -7,6 +7,7 @@
(defvar dframe-version "1.3"
"The current version of the dedicated frame library.")
+(make-obsolete-variable 'dframe-version nil "28.1")
;; This file is part of GNU Emacs.
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 7f988540c2c..6034d12f323 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -60,24 +60,132 @@ Isolated means that STRING is surrounded by spaces or at the beginning/end
of a string followed/prefixed with an space.
The regexp capture the preceding blank, STRING and the following blank as
the groups 1, 2 and 3 respectively."
- (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string))
+ (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string))
-(defun dired--star-or-qmark-p (string match &optional keep)
+(defun dired--star-or-qmark-p (string match &optional keep start)
"Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'.
MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter
means STRING contains either \"?\" or `\\=`?\\=`' or \"*\".
If optional arg KEEP is non-nil, then preserve the match data. Otherwise,
this function changes it and saves MATCH as the second match group.
+START is the position to start matching from.
Isolated means that MATCH is surrounded by spaces or at the beginning/end
of STRING followed/prefixed with an space. A match to `\\=`?\\=`',
isolated or not, is also valid."
- (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))))
+ (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))
(when (or (null match) (equal match "?"))
- (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps)))
- (cl-some (lambda (x)
- (funcall (if keep #'string-match-p #'string-match) x string))
- regexps)))
+ (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)"))
+ (funcall (if keep #'string-match-p #'string-match) regexp string start)))
+
+(defun dired--need-confirm-positions (command string)
+ "Search for non-isolated matches of STRING in COMMAND.
+Return a list of positions that match STRING, but would not be
+considered \"isolated\" by `dired--star-or-qmark-p'."
+ (cl-assert (= (length string) 1))
+ (let ((start 0)
+ (isolated-char-positions nil)
+ (confirm-positions nil)
+ (regexp (regexp-quote string)))
+ ;; Collect all ? and * surrounded by spaces and `?`.
+ (while (dired--star-or-qmark-p command string nil start)
+ (push (cons (match-beginning 2) (match-end 2))
+ isolated-char-positions)
+ (setq start (match-end 2)))
+ ;; Now collect any remaining ? and *.
+ (setq start 0)
+ (while (string-match regexp command start)
+ (unless (cl-member (match-beginning 0) isolated-char-positions
+ :test (lambda (pos match)
+ (<= (car match) pos (cdr match))))
+ (push (match-beginning 0) confirm-positions))
+ (setq start (match-end 0)))
+ confirm-positions))
+
+(defun dired--mark-positions (positions)
+ (let ((markers (make-string
+ (1+ (apply #'max positions))
+ ?\s)))
+ (dolist (pos positions)
+ (setf (aref markers pos) ?^))
+ markers))
+
+(defun dired--highlight-no-subst-chars (positions command mark)
+ (cl-callf substring-no-properties command)
+ (dolist (pos positions)
+ (add-face-text-property pos (1+ pos) 'warning nil command))
+ (if mark
+ (concat command "\n" (dired--mark-positions positions))
+ command))
+
+(defun dired--no-subst-explain (buf char-positions command mark-positions)
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert
+ (format-message "\
+If your command contains occurrences of `*' surrounded by
+whitespace, `dired-do-shell-command' substitutes them for the
+entire file list to process. Otherwise, if your command contains
+occurrences of `?' surrounded by whitespace or `%s', Dired will
+run the command once for each file, substituting `?' for each
+file name.
+
+Your command contains occurrences of `%s' that will not be
+substituted, and will be passed through normally to the shell.
+
+%s
+
+(Press ^ to %s markers below these occurrences.)
+"
+ "`"
+ (string (aref command (car char-positions)))
+ (dired--highlight-no-subst-chars char-positions command mark-positions)
+ (if mark-positions "remove" "add")))))
+
+(defun dired--no-subst-ask (char nb-occur details)
+ (let ((hilit-char (propertize (string char) 'face 'warning))
+ (choices `(?y ?n ?? ,@(when details '(?^)))))
+ (read-char-from-minibuffer
+ (format-message
+ (ngettext
+ "%d occurrence of `%s' will not be substituted. Proceed? (%s) "
+ "%d occurrences of `%s' will not be substituted. Proceed? (%s) "
+ nb-occur)
+ nb-occur hilit-char (mapconcat #'string choices ", "))
+ choices)))
+
+(defun dired--no-subst-confirm (char-positions command)
+ (let ((help-buf (get-buffer-create "*Dired help*"))
+ (char (aref command (car char-positions)))
+ (nb-occur (length char-positions))
+ (done nil)
+ (details nil)
+ (markers nil)
+ proceed)
+ (unwind-protect
+ (save-window-excursion
+ (while (not done)
+ (cl-case (dired--no-subst-ask char nb-occur details)
+ (?y
+ (setq done t
+ proceed t))
+ (?n
+ (setq done t
+ proceed nil))
+ (??
+ (if details
+ (progn
+ (quit-window nil details)
+ (setq details nil))
+ (dired--no-subst-explain
+ help-buf char-positions command markers)
+ (setq details (display-buffer help-buf))))
+ (?^
+ (setq markers (not markers))
+ (dired--no-subst-explain
+ help-buf char-positions command markers)))))
+ (kill-buffer help-buf))
+ proceed))
;;;###autoload
(defun dired-diff (file &optional switches)
@@ -134,16 +242,27 @@ the string of command switches used as the third argument of `diff'."
(file-name-directory default)
(dired-current-directory))
(dired-dwim-target-directory)))
- (defaults (dired-dwim-target-defaults (list current) target-dir)))
+ (defaults (append
+ (if (backup-file-name-p current)
+ ;; This is a backup file -- put the other
+ ;; main file, and the other backup files into
+ ;; the `M-n' list.
+ (delete (expand-file-name current)
+ (cons (expand-file-name
+ (file-name-sans-versions current))
+ (file-backup-file-names
+ (file-name-sans-versions current))))
+ ;; Non-backup file -- use the backup files as
+ ;; `M-n' candidates.
+ (file-backup-file-names current))
+ (dired-dwim-target-defaults (list current) target-dir))))
(list
(minibuffer-with-setup-hook
(lambda ()
(set (make-local-variable 'minibuffer-default-add-function) nil)
(setq minibuffer-default defaults))
- (read-file-name
- (format "Diff %s with%s: " current
- (if default (format " (default %s)" default) ""))
- target-dir default t))
+ (read-file-name (format-prompt "Diff %s with" default current)
+ target-dir default t))
(if current-prefix-arg
(read-string "Options for diff: "
(if (stringp diff-switches)
@@ -205,7 +324,10 @@ Examples of PREDICATE:
(not (and (= (file-attribute-user-id fa1) - mark files with different UID
(file-attribute-user-id fa2))
(= (file-attribute-group-id fa1) - and GID.
- (file-attribute-group-id fa2))))"
+ (file-attribute-group-id fa2))))
+
+If the region is active in Transient Mark mode, mark files
+only in the active region if `dired-mark-region' is non-nil."
(interactive
(list
(let* ((target-dir (dired-dwim-target-directory))
@@ -409,7 +531,8 @@ has no effect on MS-Windows."
(set-file-modes
file
(if num-modes num-modes
- (file-modes-symbolic-to-number modes (file-modes file)))))
+ (file-modes-symbolic-to-number modes (file-modes file 'nofollow)))
+ 'nofollow))
(dired-do-redisplay arg)))
;;;###autoload
@@ -684,7 +807,7 @@ are executed in the background on each file sequentially waiting
for each command to terminate before running the next command.
In shell syntax this means separating the individual commands with `;'.
-The output appears in the buffer `*Async Shell Command*'."
+The output appears in the buffer named by `shell-command-buffer-name-async'."
(interactive
(let ((files (dired-get-marked-files t current-prefix-arg nil nil t)))
(list
@@ -722,16 +845,16 @@ it, write `*\"\"' in place of just `*'. This is equivalent to just
`*' in the shell, but avoids Dired's special handling.
If COMMAND ends in `&', `;', or `;&', it is executed in the
-background asynchronously, and the output appears in the buffer
-`*Async Shell Command*'. When operating on multiple files and COMMAND
-ends in `&', the shell command is executed on each file in parallel.
-However, when COMMAND ends in `;' or `;&' then commands are executed
-in the background on each file sequentially waiting for each command
-to terminate before running the next command. You can also use
-`dired-do-async-shell-command' that automatically adds `&'.
+background asynchronously, and the output appears in the buffer named
+by `shell-command-buffer-name-async'. When operating on multiple files
+and COMMAND ends in `&', the shell command is executed on each file
+in parallel. However, when COMMAND ends in `;' or `;&', then commands
+are executed in the background on each file sequentially waiting for
+each command to terminate before running the next command. You can
+also use `dired-do-async-shell-command' that automatically adds `&'.
Otherwise, COMMAND is executed synchronously, and the output
-appears in the buffer `*Shell Command Output*'.
+appears in the buffer named by `shell-command-buffer-name'.
This feature does not try to redisplay Dired buffers afterward, as
there's no telling what files COMMAND may have changed.
@@ -757,28 +880,19 @@ prompted for the shell command to use interactively."
(dired-read-shell-command "! on %s: " current-prefix-arg files)
current-prefix-arg
files)))
- (cl-flet ((need-confirm-p
- (cmd str)
- (let ((res cmd)
- (regexp (regexp-quote str)))
- ;; Drop all ? and * surrounded by spaces and `?`.
- (while (and (string-match regexp res)
- (dired--star-or-qmark-p res str))
- (setq res (replace-match "" t t res 2)))
- (string-match regexp res))))
(let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep)))
(no-subst (not (dired--star-or-qmark-p command "?" 'keep)))
+ (confirmations nil)
;; Get confirmation for wildcards that may have been meant
;; to control substitution of a file name or the file name list.
- (ok (cond ((not (or on-each no-subst))
- (error "You can not combine `*' and `?' substitution marks"))
- ((need-confirm-p command "*")
- (y-or-n-p (format-message
- "Confirm--do you mean to use `*' as a wildcard? ")))
- ((need-confirm-p command "?")
- (y-or-n-p (format-message
- "Confirm--do you mean to use `?' as a wildcard? ")))
- (t))))
+ (ok (cond
+ ((not (or on-each no-subst))
+ (error "You can not combine `*' and `?' substitution marks"))
+ ((setq confirmations (dired--need-confirm-positions command "*"))
+ (dired--no-subst-confirm confirmations command))
+ ((setq confirmations (dired--need-confirm-positions command "?"))
+ (dired--no-subst-confirm confirmations command))
+ (t))))
(cond ((not ok) (message "Command canceled"))
(t
(if on-each
@@ -789,7 +903,7 @@ prompted for the shell command to use interactively."
nil file-list)
;; execute the shell command
(dired-run-shell-command
- (dired-shell-stuff-it command file-list nil arg))))))))
+ (dired-shell-stuff-it command file-list nil arg)))))))
;; Might use {,} for bash or csh:
(defvar dired-mark-prefix ""
@@ -948,13 +1062,17 @@ With a prefix argument, kill that many lines starting with the current line.
"Kill all marked lines (not the files).
With a prefix argument, kill that many lines starting with the current line.
\(A negative argument kills backward.)
+
If you use this command with a prefix argument to kill the line
for a file that is a directory, which you have inserted in the
Dired buffer as a subdirectory, then it deletes that subdirectory
from the buffer as well.
+
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)."
+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.
(interactive "P")
(if arg
@@ -1006,8 +1124,8 @@ command with a prefix argument (the value does not matter)."
(defvar dired-compress-file-suffixes
'(
;; "tar -zxf" isn't used because it's not available on the
- ;; Solaris10 version of tar. Solaris10 becomes obsolete in 2021.
- ;; Same thing on AIX 7.1.
+ ;; 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 -")
("\\.tgz\\'" "" "gzip -dc %i | tar -xf -")
("\\.gz\\'" "" "gunzip")
@@ -1060,8 +1178,6 @@ 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.")
-(declare-function format-spec "format-spec.el" (format specification))
-
;;;###autoload
(defun dired-do-compress-to ()
"Compress selected files and directories to an archive.
@@ -1069,7 +1185,6 @@ Prompt for the archive file name.
Choose the archiving command based on the archive file-name extension
and `dired-compress-files-alist'."
(interactive)
- (require 'format-spec)
(let* ((in-files (dired-get-marked-files nil nil nil nil t))
(out-file (expand-file-name (read-file-name "Compress to: ")))
(rule (cl-find-if
@@ -1089,12 +1204,12 @@ and `dired-compress-files-alist'."
(when (zerop
(dired-shell-command
(format-spec (cdr rule)
- `((?\o . ,(shell-quote-argument out-file))
- (?\i . ,(mapconcat
- (lambda (file-desc)
- (shell-quote-argument (file-name-nondirectory
- file-desc)))
- in-files " "))))))
+ `((?o . ,(shell-quote-argument out-file))
+ (?i . ,(mapconcat
+ (lambda (in-file)
+ (shell-quote-argument
+ (file-name-nondirectory in-file)))
+ in-files " "))))))
(message (ngettext "Compressed %d file to %s"
"Compressed %d files to %s"
(length in-files))
@@ -1531,17 +1646,13 @@ files matching `dired-omit-regexp'."
;;;###autoload
(defun dired-remove-file (file)
+ "Remove entry FILE on each dired buffer.
+Note this doesn't delete FILE in the file system.
+See `dired-delete-file' in case you wish that."
(dired-fun-in-all-buffers
(file-name-directory file) (file-name-nondirectory file)
#'dired-remove-entry file))
-(defun dired-remove-entry (file)
- (save-excursion
- (and (dired-goto-file file)
- (let (buffer-read-only)
- (delete-region (progn (beginning-of-line) (point))
- (line-beginning-position 2))))))
-
;;;###autoload
(defun dired-relist-file (file)
"Create or update the line for FILE in all Dired buffers it would belong in."
@@ -1599,7 +1710,7 @@ Special value `always' suppresses confirmation."
(defun dired-copy-file (from to ok-flag)
(dired-handle-overwrite to)
(dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t
- dired-recursive-copies))
+ dired-recursive-copies dired-copy-dereference))
(declare-function make-symbolic-link "fileio.c")
@@ -1622,7 +1733,8 @@ If `ask', ask for user confirmation."
(dired-create-directory dir))))
(defun dired-copy-file-recursive (from to ok-flag &optional
- preserve-time top recursive)
+ preserve-time top recursive
+ dereference)
(when (and (eq t (file-attribute-type (file-attributes from)))
(file-in-directory-p to from))
(error "Cannot copy `%s' into its subdirectory `%s'" from to))
@@ -1634,7 +1746,8 @@ If `ask', ask for user confirmation."
(copy-directory from to preserve-time)
(or top (dired-handle-overwrite to))
(condition-case err
- (if (stringp (file-attribute-type attrs))
+ (if (and (not dereference)
+ (stringp (file-attribute-type attrs)))
;; It is a symlink
(make-symbolic-link (file-attribute-type attrs) to ok-flag)
(dired-maybe-create-dirs (file-name-directory to))
@@ -1656,6 +1769,9 @@ rename them using `vc-rename-file'."
;;;###autoload
(defun dired-rename-file (file newname ok-if-already-exists)
+ "Rename FILE to NEWNAME.
+Signal a `file-already-exists' error if a file NEWNAME already exists
+unless OK-IF-ALREADY-EXISTS is non-nil."
(dired-handle-overwrite newname)
(dired-maybe-create-dirs (file-name-directory newname))
(if (and dired-vc-rename-file
@@ -1670,7 +1786,8 @@ rename them using `vc-rename-file'."
(set-visited-file-name newname nil t)))
(dired-remove-file file)
;; See if it's an inserted subdir, and rename that, too.
- (dired-rename-subdir file newname))
+ (when (file-directory-p file)
+ (dired-rename-subdir file newname)))
(defun dired-rename-subdir (from-dir to-dir)
(setq from-dir (file-name-as-directory from-dir)
@@ -1685,7 +1802,7 @@ rename them using `vc-rename-file'."
(if (and buffer-file-name
(dired-in-this-tree-p buffer-file-name expanded-from-dir))
(let ((modflag (buffer-modified-p))
- (to-file (dired-replace-in-string
+ (to-file (replace-regexp-in-string
(concat "^" (regexp-quote from-dir))
to-dir
buffer-file-name)))
@@ -1749,7 +1866,7 @@ rename them using `vc-rename-file'."
;; Update buffer-local dired-subdir-alist and dired-switches-alist
(let ((cons (assoc-string (car elt) dired-switches-alist))
(cur-dir (dired-normalize-subdir
- (dired-replace-in-string regexp newtext (car elt)))))
+ (replace-regexp-in-string regexp newtext (car elt)))))
(setcar elt cur-dir)
(when cons (setcar cons cur-dir))))))
@@ -1973,6 +2090,10 @@ Optional arg HOW-TO determines how to treat the target.
(apply (car into-dir) operation rfn-list fn-list target (cdr into-dir))
(if (not (or dired-one-file into-dir))
(error "Marked %s: target must be a directory: %s" operation target))
+ (if (and (not (file-directory-p (car fn-list)))
+ (not (file-directory-p target))
+ (directory-name-p 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
@@ -2156,6 +2277,9 @@ See HOW-TO argument for `dired-do-create-files'.")
;;;###autoload
(defun dired-do-copy (&optional arg)
"Copy all marked (or next ARG) files, or copy the current file.
+ARG has to be numeric for above functionality. See
+`dired-get-marked-files' for more details.
+
When operating on just the current file, prompt for the new name.
When operating on multiple or marked files, prompt for a target
@@ -2169,10 +2293,18 @@ If `dired-copy-preserve-time' is non-nil, this command preserves
the modification time of each old file in the copy, similar to
the \"-p\" option for the \"cp\" shell command.
-This command copies symbolic links by creating new ones, similar
-to the \"-d\" option for the \"cp\" shell command."
+This command copies symbolic links by creating new ones,
+similar to the \"-d\" option for the \"cp\" shell command.
+But if `dired-copy-dereference' is non-nil, the symbolic
+links are dereferenced and then copied, similar to the \"-L\"
+option for the \"cp\" shell command. If ARG is a cons with
+element 4 (`\\[universal-argument]'), the inverted value of
+`dired-copy-dereference' will be used."
(interactive "P")
- (let ((dired-recursive-copies dired-recursive-copies))
+ (let ((dired-recursive-copies dired-recursive-copies)
+ (dired-copy-dereference (if (equal arg '(4))
+ (not dired-copy-dereference)
+ dired-copy-dereference)))
(dired-do-create-files 'copy #'dired-copy-file
"Copy"
arg dired-keep-marker-copy
@@ -2480,7 +2612,7 @@ This function takes some pains to conform to `ls -lR' output."
(push (cons dirname switches) dired-switches-alist)))
(when switches-have-R
(dired-build-subdir-alist switches)
- (setq switches (dired-replace-in-string "R" "" switches))
+ (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)
@@ -2581,7 +2713,7 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
(let ((dired-actual-switches
(or switches
dired-subdir-switches
- (dired-replace-in-string "R" "" dired-actual-switches))))
+ (string-replace "R" "" dired-actual-switches))))
(if (equal dirname (car (car (last dired-subdir-alist))))
;; If doing the top level directory of the buffer,
;; redo it as specified in dired-directory.
@@ -2685,12 +2817,6 @@ When called interactively and not on a subdir line, go to this subdir's line."
(if (dired-get-subdir) 1 0))))
(dired-next-subdir (- arg) no-error-if-not-found no-skip))
-(defun dired-subdir-min ()
- (save-excursion
- (if (not (dired-prev-subdir 0 t t))
- (error "Not in a subdir!")
- (point))))
-
;;;###autoload
(defun dired-goto-subdir (dir)
"Go to end of header line of DIR in this dired buffer.
@@ -2783,15 +2909,6 @@ Lower levels are unaffected."
;;; hiding
-(defun dired-unhide-subdir ()
- (with-silent-modifications
- (dired--unhide (dired-subdir-min) (dired-subdir-max))))
-
-(defun dired-subdir-hidden-p (dir)
- (save-excursion
- (dired-goto-subdir dir)
- (dired--hidden-p)))
-
;;;###autoload
(defun dired-hide-subdir (arg)
"Hide or unhide the current subdirectory and move to next directory.
@@ -3045,6 +3162,69 @@ instead."
(backward-delete-char 1))
(message "%s" (buffer-string)))))
+
+;;; Version control from dired
+
+(declare-function vc-dir-unmark-all-files "vc-dir")
+(declare-function vc-dir-mark-files "vc-dir")
+
+;;;###autoload
+(defun dired-vc-next-action (verbose)
+ "Do the next version control operation on marked files/directories.
+When only files are marked then call `vc-next-action' with the
+same value of the VERBOSE argument.
+When also directories are marked then call `vc-dir' and mark
+the same files/directories in the VC-Dir buffer that were marked
+in the Dired buffer."
+ (interactive "P")
+ (let* ((marked-files
+ (dired-get-marked-files nil nil nil nil t))
+ (mark-files
+ (when (cl-some #'file-directory-p marked-files)
+ ;; Fix deficiency of Dired by adding slash to dirs
+ (mapcar (lambda (file)
+ (if (file-directory-p file)
+ (file-name-as-directory file)
+ file))
+ marked-files))))
+ (if mark-files
+ (let ((transient-hook (make-symbol "vc-dir-mark-files")))
+ (fset transient-hook
+ (lambda ()
+ (remove-hook 'vc-dir-refresh-hook transient-hook t)
+ (vc-dir-unmark-all-files t)
+ (vc-dir-mark-files mark-files)))
+ (vc-dir-root)
+ (add-hook 'vc-dir-refresh-hook transient-hook nil t))
+ (vc-next-action verbose))))
+
+(declare-function vc-compatible-state "vc")
+
+;;;###autoload
+(defun dired-vc-deduce-fileset (&optional state-model-only-files not-state-changing)
+ (let ((backend (vc-responsible-backend default-directory))
+ (files (dired-get-marked-files nil nil nil nil t))
+ only-files-list
+ state
+ model)
+ (when (and (not not-state-changing) (cl-some #'file-directory-p files))
+ (user-error "State changing VC operations on directories supported only in `vc-dir'"))
+
+ (when state-model-only-files
+ (setq only-files-list (mapcar (lambda (file) (cons file (vc-state file))) files))
+ (setq state (cdar only-files-list))
+ ;; Check that all files are in a consistent state, since we use that
+ ;; state to decide which operation to perform.
+ (dolist (crt (cdr only-files-list))
+ (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))
+ (when (and state (not (eq state 'unregistered)))
+ (setq model (vc-checkout-model backend only-files-list))))
+ (list backend files only-files-list state model)))
+
+
(provide 'dired-aux)
;; Local Variables:
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 623a1dd3255..b09ef900c1d 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -64,21 +64,8 @@ mbox format, and so cannot be distinguished in this way."
:type 'boolean
:group 'dired-keys)
-(defcustom dired-bind-jump t
- "Non-nil means bind `dired-jump' to C-x C-j, otherwise do not.
-Setting this variable directly after dired-x is loaded has no effect -
-use \\[customize]."
- :type 'boolean
- :set (lambda (sym val)
- (if (set sym val)
- (progn
- (define-key ctl-x-map "\C-j" 'dired-jump)
- (define-key ctl-x-4-map "\C-j" 'dired-jump-other-window))
- (if (eq 'dired-jump (lookup-key ctl-x-map "\C-j"))
- (define-key ctl-x-map "\C-j" nil))
- (if (eq 'dired-jump-other-window (lookup-key ctl-x-4-map "\C-j"))
- (define-key ctl-x-4-map "\C-j" nil))))
- :group 'dired-keys)
+(defvar dired-bind-jump t)
+(make-obsolete-variable 'dired-bind-jump "not used." "28.1")
(defcustom dired-bind-man t
"Non-nil means bind `dired-man' to \"N\" in Dired, otherwise do not.
@@ -137,6 +124,7 @@ folding to be used on case-insensitive filesystems only."
(file-name-case-insensitive-p dir)
dired-omit-case-fold))
+;;;###autoload
(define-minor-mode dired-omit-mode
"Toggle omission of uninteresting files in Dired (Dired-Omit mode).
@@ -307,7 +295,6 @@ To see the options you can set, use M-x customize-group RET dired-x RET.
See also the functions:
`dired-flag-extension'
`dired-virtual'
- `dired-jump'
`dired-man'
`dired-vm'
`dired-rmail'
@@ -326,21 +313,19 @@ See also the functions:
(when file
(file-name-extension file))))
(suffix
- (read-string (format "%s extension%s: "
- (if (equal current-prefix-arg '(4))
- "UNmarking"
- "Marking")
- (if default
- (format " (default %s)" default)
- "")) nil nil default))
+ (read-string (format-prompt
+ "%s extension" default
+ (if (equal current-prefix-arg '(4))
+ "UNmarking"
+ "Marking"))
+ nil nil default))
(marker
(pcase current-prefix-arg
('(4) ?\s)
('(16)
(let* ((dflt (char-to-string dired-marker-char))
(input (read-string
- (format
- "Marker character to use (default %s): " dflt)
+ (format-prompt "Marker character to use" dflt)
nil nil dflt)))
(aref input 0)))
(_ dired-marker-char))))
@@ -447,68 +432,7 @@ See variables `dired-texinfo-unclean-extensions',
dired-bibtex-unclean-extensions
dired-tex-unclean-extensions
(list ".dvi"))))
-
-(defvar archive-superior-buffer)
-(defvar tar-superior-buffer)
-;;; JUMP.
-;;;###autoload
-(defun dired-jump (&optional other-window file-name)
- "Jump to Dired buffer corresponding to current buffer.
-If in a file, Dired the current directory and move to file's line.
-If in Dired already, pop up a level and goto old directory's line.
-In case the proper Dired file line cannot be found, refresh the dired
-buffer and try again.
-When OTHER-WINDOW is non-nil, jump to Dired buffer in other window.
-When FILE-NAME is non-nil, jump to its line in Dired.
-Interactively with prefix argument, read FILE-NAME."
- (interactive
- (list nil (and current-prefix-arg
- (read-file-name "Jump to Dired file: "))))
- (cond
- ((and (bound-and-true-p archive-subfile-mode)
- (buffer-live-p archive-superior-buffer))
- (switch-to-buffer archive-superior-buffer))
- ((and (bound-and-true-p tar-subfile-mode)
- (buffer-live-p tar-superior-buffer))
- (switch-to-buffer tar-superior-buffer))
- (t
- ;; Expand file-name before `dired-goto-file' call:
- ;; `dired-goto-file' requires its argument to be an absolute
- ;; file name; the result of `read-file-name' could be
- ;; an abbreviated file name (Bug#24409).
- (let* ((file (or (and file-name (expand-file-name file-name))
- buffer-file-name))
- (dir (if file (file-name-directory file) default-directory)))
- (if (and (eq major-mode 'dired-mode) (null file-name))
- (progn
- (setq dir (dired-current-directory))
- (dired-up-directory other-window)
- (unless (dired-goto-file dir)
- ;; refresh and try again
- (dired-insert-subdir (file-name-directory dir))
- (dired-goto-file dir)))
- (if other-window
- (dired-other-window dir)
- (dired dir))
- (if file
- (or (dired-goto-file file)
- ;; refresh and try again
- (progn
- (dired-insert-subdir (file-name-directory file))
- (dired-goto-file file))
- ;; Toggle omitting, if it is on, and try again.
- (when dired-omit-mode
- (dired-omit-mode)
- (dired-goto-file file)))))))))
-
-;;;###autoload
-(defun dired-jump-other-window (&optional file-name)
- "Like \\[dired-jump] (`dired-jump') but in other window."
- (interactive
- (list (and current-prefix-arg
- (read-file-name "Jump to Dired file: "))))
- (dired-jump t file-name))
;;; OMITTING.
@@ -623,7 +547,9 @@ interactively, prompt for REGEXP.
With prefix argument, unflag all those files.
Optional fourth argument LOCALP is as in `dired-get-filename'.
Optional fifth argument CASE-FOLD-P specifies the value of
-`case-fold-search' used for matching REGEXP."
+`case-fold-search' used for matching REGEXP.
+If the region is active in Transient Mark mode, operate only on
+files in the active region if `dired-mark-region' is non-nil."
(interactive
(list (read-regexp
"Mark unmarked files matching regexp (default all): "
@@ -1386,7 +1312,9 @@ present for some values of `ls-lisp-emulation'.
This function operates only on the buffer content and does not
refer at all to the underlying file system. Contrast this with
-`find-dired', which might be preferable for the task at hand."
+`find-dired', which might be preferable for the task at hand.
+If the region is active in Transient Mark mode, mark files
+only in the active region if `dired-mark-region' is non-nil."
;; Using sym="" instead of nil avoids the trap of
;; (string-match "foo" sym) into which a user would soon fall.
;; Give `equal' instead of `=' in the example, as this works on
diff --git a/lisp/dired.el b/lisp/dired.el
index 4d0c2abdf55..08b19a02250 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -77,6 +77,27 @@ If nil, `dired-listing-switches' is used."
: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.
+Some shells enable this feature by default (e.g. zsh or fish).
+
+See `dired-enable-globstar-in-shell' for a list of shells
+that support globstar and disable it by default.
+
+Note that the implementations of globstar have small differences
+between shells. You must check your shell documentation to see
+what to expect."
+ :type 'boolean
+ :group 'dired
+ :version "28.1")
+
+(defconst dired-enable-globstar-in-shell
+ '(("ksh" . "set -G")
+ ("bash" . "shopt -s globstar"))
+ "Alist of (SHELL . COMMAND), where COMMAND enables globstar in SHELL.
+If `dired-maybe-use-globstar' is non-nil, then `dired-insert-directory'
+checks this alist to enable globstar in the shell subprocess.")
+
(defcustom dired-chown-program
(purecopy (cond ((executable-find "chown") "chown")
((file-executable-p "/usr/sbin/chown") "/usr/sbin/chown")
@@ -125,7 +146,7 @@ For more details, see Info node `(emacs)ls in Lisp'."
"Informs Dired about how `ls -lF' marks symbolic links.
Set this to t if `ls' (or whatever program is specified by
`insert-directory-program') with `-lF' marks the symbolic link
-itself with a trailing @ (usually the case under Ultrix).
+itself with a trailing @ (usually the case under Ultrix and macOS).
Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to
nil (the default), if it gives `bar@ -> foo', set it to t.
@@ -216,6 +237,12 @@ The target is used in the prompt for file copy, rename etc."
:type 'boolean
:group 'dired)
+(defcustom dired-copy-dereference nil
+ "If non-nil, Dired dereferences symlinks when copying them.
+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.
(define-obsolete-variable-alias 'dired-free-space-program
@@ -230,6 +257,8 @@ The target is used in the prompt for file copy, rename etc."
You can customize key bindings or load extensions with this."
:group 'dired
:type 'hook)
+(make-obsolete-variable 'dired-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom dired-mode-hook nil
"Run at the very end of `dired-mode'."
@@ -294,6 +323,36 @@ new Dired buffers."
:version "26.1"
:group 'dired)
+(defcustom dired-mark-region 'file
+ "Defines what commands that mark files do with the active region.
+
+When nil, marking commands don't operate on all files in the
+active region. They process their prefix arguments as usual.
+
+When the value of this option is non-nil, then all Dired commands
+that mark or unmark files will operate on all files in the region
+if the region is active in Transient Mark mode.
+
+When `file', the region marking is based on the file name.
+This means don't mark the file if the end of the region is
+before the file name displayed on the Dired line, so the file name
+is visually outside the region. This behavior is consistent with
+marking files without the region using the key `m' that advances
+point to the next line after marking the file. Thus the number
+of keys used to mark files is the same as the number of keys
+used to select the region, e.g. `M-2 m' marks 2 files, and
+`C-SPC M-2 n m' marks 2 files, and `M-2 S-down m' marks 2 files.
+
+When `line', the region marking is based on Dired lines,
+so include the file into marking if the end of the region
+is anywhere on its Dired line, except the beginning of the line."
+ :type '(choice
+ (const :tag "Don't mark files in active region" nil)
+ (const :tag "Exclude file name outside of region" file)
+ (const :tag "Include the file at region end line" line))
+ :group 'dired
+ :version "28.1")
+
;; Internal variables
(defvar dired-marker-char ?* ; the answer is 42
@@ -475,6 +534,14 @@ Subexpression 2 must end right before the \\n.")
(defvar dired-symlink-face 'dired-symlink
"Face name used for symbolic links.")
+(defface dired-broken-symlink
+ '((((class color))
+ :foreground "yellow1" :background "red1" :weight bold)
+ (t :weight bold :slant italic :underline t))
+ "Face used for broken symbolic links."
+ :group 'dired-faces
+ :version "28.1")
+
(defface dired-special
'((t (:inherit font-lock-variable-name-face)))
"Face used for sockets, pipes, block devices and char devices."
@@ -538,6 +605,20 @@ Subexpression 2 must end right before the \\n.")
(list dired-re-dir
'(".+" (dired-move-to-filename) nil (0 dired-directory-face)))
;;
+ ;; Broken Symbolic link.
+ (list dired-re-sym
+ (list (lambda (end)
+ (let* ((file (dired-file-name-at-point))
+ (truename (ignore-errors (file-truename file))))
+ ;; either not existent target or circular link
+ (and (not (and truename (file-exists-p truename)))
+ (search-forward-regexp "\\(.+\\) \\(->\\) ?\\(.+\\)" end t))))
+ '(dired-move-to-filename)
+ nil
+ '(1 'dired-broken-symlink)
+ '(2 dired-symlink-face)
+ '(3 'dired-broken-symlink)))
+ ;;
;; Symbolic link to a directory.
(list dired-re-sym
(list (lambda (end)
@@ -610,12 +691,20 @@ Subexpression 2 must end right before the \\n.")
PREDICATE is evaluated on each line, with point at beginning of line.
MSG is a noun phrase for the type of files being marked.
It should end with a noun that can be pluralized by adding `s'.
+
+In Transient Mark mode, if the mark is active, operate on the contents
+of the region if `dired-mark-region' is non-nil. Otherwise, operate
+on the whole buffer.
+
Return value is the number of files marked, or nil if none were marked."
- `(let ((inhibit-read-only t) count)
+ `(let ((inhibit-read-only t) count
+ (use-region-p (dired-mark--region-use-p))
+ (beg (dired-mark--region-beginning))
+ (end (dired-mark--region-end)))
(save-excursion
(setq count 0)
(when ,msg
- (message "%s %ss%s..."
+ (message "%s %ss%s%s..."
(cond ((eq dired-marker-char ?\s) "Unmarking")
((eq dired-del-marker dired-marker-char)
"Flagging")
@@ -623,22 +712,28 @@ Return value is the number of files marked, or nil if none were marked."
,msg
(if (eq dired-del-marker dired-marker-char)
" for deletion"
- "")))
- (goto-char (point-min))
- (while (not (eobp))
+ "")
+ (if use-region-p
+ " in region"
+ "")))
+ (goto-char beg)
+ (while (< (point) end)
(when ,predicate
(unless (= (following-char) dired-marker-char)
(delete-char 1)
(insert dired-marker-char)
(setq count (1+ count))))
(forward-line 1))
- (when ,msg (message "%s %s%s %s%s"
+ (when ,msg (message "%s %s%s %s%s%s"
count
,msg
(dired-plural-s count)
(if (eq dired-marker-char ?\s) "un" "")
(if (eq dired-marker-char dired-del-marker)
- "flagged" "marked"))))
+ "flagged" "marked")
+ (if use-region-p
+ " in region"
+ ""))))
(and (> count 0) count)))
(defmacro dired-map-over-marks (body arg &optional show-progress
@@ -757,6 +852,32 @@ ERROR can be a string with the error message."
(user-error (if (stringp error) error "No files specified")))
result))
+(defun dired-mark--region-use-p ()
+ "Whether Dired marking commands should act on region."
+ (and dired-mark-region
+ (region-active-p)
+ (> (region-end) (region-beginning))))
+
+(defun dired-mark--region-beginning ()
+ "Return the value of the region beginning aligned to Dired file lines."
+ (if (dired-mark--region-use-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (line-beginning-position))
+ (point-min)))
+
+(defun dired-mark--region-end ()
+ "Return the value of the region end aligned to Dired file lines."
+ (if (dired-mark--region-use-p)
+ (save-excursion
+ (goto-char (region-end))
+ (if (if (eq dired-mark-region 'line)
+ (not (bolp))
+ (get-text-property (1- (point)) 'dired-filename))
+ (line-end-position)
+ (line-beginning-position)))
+ (point-max)))
+
;; The dired command
@@ -849,7 +970,6 @@ If a directory or nothing is found at point, return nil."
(if (and file-name
(not (file-directory-p file-name)))
file-name)))
-(put 'dired-mode 'grep-read-files 'dired-grep-read-files)
;;;###autoload (define-key ctl-x-map "d" 'dired)
;;;###autoload
@@ -1149,15 +1269,11 @@ wildcards, erases the buffer, and builds the subdir-alist anew
;; default-directory and dired-actual-switches must be buffer-local
;; and initialized by now.
- (let (dirname
- ;; This makes read-in much faster.
- ;; In particular, it prevents the font lock hook from running
- ;; until the directory is all read in.
- (inhibit-modification-hooks t))
- (if (consp dired-directory)
- (setq dirname (car dired-directory))
- (setq dirname dired-directory))
- (setq dirname (expand-file-name dirname))
+ (let ((dirname
+ (expand-file-name
+ (if (consp dired-directory)
+ (car dired-directory)
+ dired-directory))))
(save-excursion
;; This hook which may want to modify dired-actual-switches
;; based on dired-directory, e.g. with ange-ftp to a SysV host
@@ -1167,17 +1283,25 @@ wildcards, erases the buffer, and builds the subdir-alist anew
(setq buffer-undo-list nil))
(setq-local file-name-coding-system
(or coding-system-for-read file-name-coding-system))
- (let ((inhibit-read-only t)
- ;; Don't make undo entries for readin.
- (buffer-undo-list t))
- (widen)
- (erase-buffer)
- (dired-readin-insert))
- (goto-char (point-min))
- ;; Must first make alist buffer local and set it to nil because
- ;; dired-build-subdir-alist will call dired-clear-alist first
- (setq-local dired-subdir-alist nil)
- (dired-build-subdir-alist)
+ (widen)
+ ;; We used to bind `inhibit-modification-hooks' to try and speed up
+ ;; execution, in particular, to prevent the font-lock hook from running
+ ;; until the directory is all read in.
+ ;; It's not clear why font-lock would be a significant issue
+ ;; here, but I used `combine-change-calls' which should provide the
+ ;; same performance advantages without the problem of breaking
+ ;; users of after/before-change-functions.
+ (combine-change-calls (point-min) (point-max)
+ (let ((inhibit-read-only t)
+ ;; Don't make undo entries for readin.
+ (buffer-undo-list t))
+ (erase-buffer)
+ (dired-readin-insert))
+ (goto-char (point-min))
+ ;; Must first make alist buffer local and set it to nil because
+ ;; dired-build-subdir-alist will call dired-clear-alist first
+ (setq-local dired-subdir-alist nil)
+ (dired-build-subdir-alist))
(let ((attributes (file-attributes dirname)))
(if (eq (car attributes) t)
(set-visited-file-modtime (file-attribute-modification-time
@@ -1380,7 +1504,7 @@ see `dired-use-ls-dired' for more details.")
;; "--dired", so we cannot add it to the `process-file'
;; call for wildcards.
(when (file-remote-p dir)
- (setq switches (dired-replace-in-string "--dired" "" switches)))
+ (setq switches (string-replace "--dired" "" switches)))
(let* ((default-directory (car dir-wildcard))
(script (format "ls %s %s" switches (cdr dir-wildcard)))
(remotep (file-remote-p dir))
@@ -1389,6 +1513,13 @@ see `dired-use-ls-dired' for more details.")
(executable-find explicit-shell-file-name))
(executable-find "sh")))
(switch (if remotep "-c" shell-command-switch)))
+ ;; Enable globstar
+ (when-let ((globstar dired-maybe-use-globstar)
+ (enable-it
+ (assoc-default
+ (file-truename sh) dired-enable-globstar-in-shell
+ (lambda (reg shell) (string-match reg shell)))))
+ (setq script (format "%s; %s" enable-it script)))
(unless
(zerop
(process-file sh nil (current-buffer) nil switch script))
@@ -1811,6 +1942,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
(define-key map "\177" 'dired-unmark-backward)
(define-key map [remap undo] 'dired-undo)
(define-key map [remap advertised-undo] 'dired-undo)
+ (define-key map [remap vc-next-action] 'dired-vc-next-action)
;; thumbnail manipulation (image-dired)
(define-key map "\C-td" 'image-dired-display-thumbs)
(define-key map "\C-tt" 'image-dired-tag-files)
@@ -2134,8 +2266,15 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
'(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" dired-do-delete
- :help "Delete current file or all marked files"))
+ `(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"))
@@ -2149,6 +2288,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
;; Dired mode is suitable only for specially formatted data.
(put 'dired-mode 'mode-class 'special)
+(defvar grep-read-files-function)
;; Autoload cookie needed by desktop.el
;;;###autoload
(defun dired-mode (&optional dirname switches)
@@ -2210,7 +2350,6 @@ Hooks (use \\[describe-variable] to see their documentation):
`dired-before-readin-hook'
`dired-after-readin-hook'
`dired-mode-hook'
- `dired-load-hook'
Keybindings:
\\{dired-mode-map}"
@@ -2243,6 +2382,7 @@ Keybindings:
(setq-local font-lock-defaults
'(dired-font-lock-keywords t nil nil beginning-of-line))
(setq-local desktop-save-buffer 'dired-desktop-buffer-misc-data)
+ (setq-local grep-read-files-function #'dired-grep-read-files)
(setq dired-switches-alist nil)
(hack-dir-local-variables-non-file-buffer) ; before sorting
(dired-sort-other dired-actual-switches t)
@@ -2445,6 +2585,21 @@ Otherwise, display it in another buffer."
;;; Functions for extracting and manipulating file names in Dired buffers.
+(defun dired-unhide-subdir ()
+ (with-silent-modifications
+ (dired--unhide (dired-subdir-min) (dired-subdir-max))))
+
+(defun dired-subdir-hidden-p (dir)
+ (save-excursion
+ (dired-goto-subdir dir)
+ (dired--hidden-p)))
+
+(defun dired-subdir-min ()
+ (save-excursion
+ (if (not (dired-prev-subdir 0 t t))
+ (error "Not in a subdir!")
+ (point))))
+
(defun dired-get-filename (&optional localp no-error-if-not-filep)
"In Dired, return name of file mentioned on this line.
Value returned normally includes the directory name.
@@ -2455,10 +2610,17 @@ it occurs in the buffer, and a value of t means construct name relative to
Optional arg NO-ERROR-IF-NOT-FILEP means treat `.' and `..' as
regular filenames and return nil if no filename on this line.
Otherwise, an error occurs in these cases."
- (let (case-fold-search file p1 p2 already-absolute)
+ (let ((hidden (and dired-subdir-alist
+ (dired-subdir-hidden-p
+ (dired-current-directory))))
+ case-fold-search file p1 p2 already-absolute)
+ (when hidden
+ (dired-unhide-subdir))
(save-excursion
(if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
(setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
+ (when hidden
+ (dired-hide-subdir 1))
;; nil if no file on this line, but no-error-if-not-filep is t:
(if (setq file (and p1 p2 (buffer-substring p1 p2)))
(progn
@@ -2768,12 +2930,12 @@ You can then feed the file name(s) to other commands with \\[yank]."
;; Keeping Dired buffers in sync with the filesystem and with each other
(defun dired-buffers-for-dir (dir &optional file)
-;; 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.
-;; 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.
+ "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.
+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."
(setq dir (file-name-as-directory dir))
(let (result buf)
(dolist (elt dired-buffers)
@@ -3170,8 +3332,8 @@ Any other value means to ask for each directory."
(const :tag "Confirm for each top directory only" top))
:group 'dired)
-;; Match anything but `.' and `..'.
-(defvar dired-re-no-dot (rx (or (not ".") "...")))
+(define-obsolete-variable-alias 'dired-re-no-dot
+ 'directory-files-no-dot-files-regexp "28.1")
;; Delete file, possibly delete a directory and all its files.
;; This function is useful outside of dired. One could change its name
@@ -3193,7 +3355,9 @@ TRASH non-nil means to trash the file instead of deleting, provided
;; but more efficient
(if (not (eq t (car (file-attributes file))))
(delete-file file trash)
- (let* ((empty-dir-p (null (directory-files file t dired-re-no-dot))))
+ (let* ((empty-dir-p (null (directory-files
+ file t
+ directory-files-no-dot-files-regexp))))
(if (and recursive (not empty-dir-p))
(unless (eq recursive 'always)
(let ((prompt
@@ -3320,18 +3484,28 @@ Return list of buffers where FUN succeeded (i.e., returned non-nil)."
(let (success-list)
(dolist (buf (dired-buffers-for-dir (expand-file-name directory) file))
(with-current-buffer buf
- (if (apply fun args)
- (push buf success-list))))
+ (when (apply fun args)
+ (push (buffer-name buf) success-list))))
;; FIXME: AFAICT, this return value is not used by any of the callers!
success-list))
;; Delete the entry for FILE from
-(defun dired-delete-entry (file)
+(defun dired-remove-entry (file)
+ "Remove entry FILE in the current dired buffer.
+Note this doesn't delete FILE in the file system.
+See `dired-delete-file' in case you wish that."
(save-excursion
(and (dired-goto-file file)
(let ((inhibit-read-only t))
(delete-region (progn (beginning-of-line) (point))
- (save-excursion (forward-line 1) (point))))))
+ (line-beginning-position 2))))))
+
+(defun dired-delete-entry (file)
+ "Remove entry FILE in the current dired buffer.
+Like `dired-remove-entry' followed by `dired-clean-up-after-deletion'.
+Note this doesn't delete FILE in the file system.
+See `dired-delete-file' in case you wish that."
+ (dired-remove-entry file)
(dired-clean-up-after-deletion file))
(defvar dired-clean-up-buffers-too)
@@ -3460,26 +3634,27 @@ argument or confirmation)."
;; Mark *Marked Files* window as softly-dedicated, to prevent
;; other buffers e.g. *Completions* from reusing it (bug#17554).
(display-buffer-mark-dedicated 'soft))
- (with-displayed-buffer-window
+ (with-current-buffer-window
buffer
- (cons 'display-buffer-below-selected
- '((window-height . fit-window-to-buffer)
- (preserve-size . (nil . t))))
+ `(display-buffer-below-selected
+ (window-height . fit-window-to-buffer)
+ (preserve-size . (nil . t))
+ (body-function
+ . ,#'(lambda (_window)
+ ;; Handle (t FILE) just like (FILE), here. That value is
+ ;; used (only in some cases), to mean just one file that was
+ ;; marked, rather than the current line file.
+ (dired-format-columns-of-files
+ (if (eq (car files) t) (cdr files) files))
+ (remove-text-properties (point-min) (point-max)
+ '(mouse-face nil help-echo nil))
+ (setq tab-line-exclude nil))))
#'(lambda (window _value)
(with-selected-window window
(unwind-protect
(apply function args)
(when (window-live-p window)
- (quit-restore-window window 'kill)))))
- ;; Handle (t FILE) just like (FILE), here. That value is
- ;; used (only in some cases), to mean just one file that was
- ;; marked, rather than the current line file.
- (with-current-buffer buffer
- (dired-format-columns-of-files
- (if (eq (car files) t) (cdr files) files))
- (remove-text-properties (point-min) (point-max)
- '(mouse-face nil help-echo nil))
- (setq tab-line-exclude nil))))))
+ (quit-restore-window window 'kill)))))))))
(defun dired-format-columns-of-files (files)
(let ((beg (point)))
@@ -3578,7 +3753,8 @@ no ARGth marked file is found before this line."
(defun dired-mark (arg &optional interactive)
"Mark the file at point in the Dired buffer.
-If the region is active, mark all files in the region.
+If the region is active in Transient Mark mode, mark all files
+in the region if `dired-mark-region' is non-nil.
Otherwise, with a prefix arg, mark files on the next ARG lines.
If on a subdir headerline, mark all its files except `.' and `..'.
@@ -3589,13 +3765,20 @@ this subdir."
(interactive (list current-prefix-arg t))
(cond
;; Mark files in the active region.
- ((and interactive (use-region-p))
+ ((and interactive dired-mark-region
+ (region-active-p)
+ (> (region-end) (region-beginning)))
(save-excursion
(let ((beg (region-beginning))
(end (region-end)))
(dired-mark-files-in-region
(progn (goto-char beg) (line-beginning-position))
- (progn (goto-char end) (line-beginning-position))))))
+ (progn (goto-char end)
+ (if (if (eq dired-mark-region 'line)
+ (not (bolp))
+ (get-text-property (1- (point)) 'dired-filename))
+ (line-end-position)
+ (line-beginning-position)))))))
;; Mark subdir files from the subdir headerline.
((dired-get-subdir)
(save-excursion (dired-mark-subdir-files)))
@@ -3643,12 +3826,18 @@ in the active region."
"Toggle marks: marked files become unmarked, and vice versa.
Flagged files (indicated with flags such as `C' and `D', not
with `*') are not affected, and `.' and `..' are never toggled.
-As always, hidden subdirs are not affected."
+As always, hidden subdirs are not affected.
+
+In Transient Mark mode, if the mark is active, operate on the contents
+of the region if `dired-mark-region' is non-nil. Otherwise, operate
+on the whole buffer."
(interactive)
(save-excursion
- (goto-char (point-min))
- (let ((inhibit-read-only t))
- (while (not (eobp))
+ (let ((inhibit-read-only t)
+ (beg (dired-mark--region-beginning))
+ (end (dired-mark--region-end)))
+ (goto-char beg)
+ (while (< (point) end)
(or (dired-between-files)
(looking-at-p dired-re-dot)
;; use subst instead of insdel because it does not move
@@ -3676,6 +3865,9 @@ As always, hidden subdirs are not affected."
A prefix argument means to unmark them instead.
`.' and `..' are never marked.
+If the region is active in Transient Mark mode, mark files
+only in the active region if `dired-mark-region' is non-nil.
+
REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' for
object files--just `.o' will mark more than you might think."
(interactive
@@ -3727,6 +3919,9 @@ object files--just `.o' will mark more than you might think."
A prefix argument means to unmark them instead.
`.' and `..' are never marked.
+If the region is active in Transient Mark mode, mark files
+only in the active region if `dired-mark-region' is non-nil.
+
Note that if a file is visited in an Emacs buffer, and
`dired-always-read-filesystem' is nil, this command will
look in the buffer without revisiting the file, so the results might
@@ -3771,14 +3966,18 @@ The match is against the non-directory part of the filename. Use `^'
(defun dired-mark-symlinks (unflag-p)
"Mark all symbolic links.
-With prefix argument, unmark or unflag all those files."
+With prefix argument, unmark or unflag all those files.
+If the region is active in Transient Mark mode, mark files
+only in the active region if `dired-mark-region' is non-nil."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
(dired-mark-if (looking-at-p dired-re-sym) "symbolic link")))
(defun dired-mark-directories (unflag-p)
"Mark all directory file lines except `.' and `..'.
-With prefix argument, unmark or unflag all those files."
+With prefix argument, unmark or unflag all those files.
+If the region is active in Transient Mark mode, mark files
+only in the active region if `dired-mark-region' is non-nil."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
(dired-mark-if (and (looking-at-p dired-re-dir)
@@ -3787,7 +3986,9 @@ With prefix argument, unmark or unflag all those files."
(defun dired-mark-executables (unflag-p)
"Mark all executable files.
-With prefix argument, unmark or unflag all those files."
+With prefix argument, unmark or unflag all those files.
+If the region is active in Transient Mark mode, mark files
+only in the active region if `dired-mark-region' is non-nil."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
(dired-mark-if (looking-at-p dired-re-exe) "executable file")))
@@ -3797,7 +3998,9 @@ With prefix argument, unmark or unflag all those files."
(defun dired-flag-auto-save-files (&optional unflag-p)
"Flag for deletion files whose names suggest they are auto save files.
-A prefix argument says to unmark or unflag those files instead."
+A prefix argument says to unmark or unflag those files instead.
+If the region is active in Transient Mark mode, flag files
+only in the active region if `dired-mark-region' is non-nil."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\s dired-del-marker)))
(dired-mark-if
@@ -3837,7 +4040,9 @@ A prefix argument says to unmark or unflag those files instead."
(defun dired-flag-backup-files (&optional unflag-p)
"Flag all backup files (names ending with `~') for deletion.
-With prefix argument, unmark or unflag these files."
+With prefix argument, unmark or unflag these files.
+If the region is active in Transient Mark mode, flag files
+only in the active region if `dired-mark-region' is non-nil."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\s dired-del-marker)))
(dired-mark-if
@@ -3860,25 +4065,28 @@ With prefix argument, unmark or unflag these files."
(defun dired-change-marks (&optional old new)
"Change all OLD marks to NEW marks.
OLD and NEW are both characters used to mark files."
+ (declare (advertised-calling-convention (old new) "28.1"))
(interactive
(let* ((cursor-in-echo-area t)
(old (progn (message "Change (old mark): ") (read-char)))
(new (progn (message "Change %c marks to (new mark): " old)
(read-char))))
(list old new)))
- (if (or (eq old ?\r) (eq new ?\r))
- (ding)
- (let ((string (format "\n%c" old))
- (inhibit-read-only t))
- (save-excursion
- (goto-char (point-min))
- (while (search-forward string nil t)
- (if (if (= old ?\s)
- (save-match-data
- (dired-get-filename 'no-dir t))
- t)
- (subst-char-in-region (match-beginning 0)
- (match-end 0) old new)))))))
+ (dolist (c (list new old))
+ (if (or (not (char-displayable-p c))
+ (eq c ?\r))
+ (user-error "Invalid mark character: `%c'" c)))
+ (let ((string (format "\n%c" old))
+ (inhibit-read-only t))
+ (save-excursion
+ (goto-char (point-min))
+ (while (search-forward string nil t)
+ (if (if (= old ?\s)
+ (save-match-data
+ (dired-get-filename 'no-dir t))
+ t)
+ (subst-char-in-region (match-beginning 0)
+ (match-end 0) old new))))))
(defun dired-unmark-all-marks ()
"Remove all marks from all files in the Dired buffer."
@@ -4019,22 +4227,50 @@ format, use `\\[universal-argument] \\[dired]'.")
"Non-nil means the Dired sort command is disabled.
The idea is to set this buffer-locally in special Dired buffers.")
+(defcustom dired-switches-in-mode-line nil
+ "How to indicate `dired-actual-switches' in mode-line.
+Possible values:
+ * `nil': Indicate name-or-date sort order, if possible.
+ Else show full switches.
+ * `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
+ :type '(choice
+ (const :tag "Indicate by name or date, else full" nil)
+ (const :tag "Show full switches" as-is)
+ (integer :tag "Show first N chars of switches" :value 10)
+ (function :tag "Format with function" :value identity)))
+
(defun dired-sort-set-mode-line ()
- ;; Set mode line display according to dired-actual-switches.
- ;; Mode line display of "by name" or "by date" guarantees the user a
- ;; match with the corresponding regexps. Non-matching switches are
- ;; shown literally.
+ "Set mode-line according to option `dired-switches-in-mode-line'."
(when (eq major-mode 'dired-mode)
(setq mode-name
- (let (case-fold-search)
- (cond ((string-match-p
- dired-sort-by-name-regexp dired-actual-switches)
- "Dired by name")
- ((string-match-p
- dired-sort-by-date-regexp dired-actual-switches)
- "Dired by date")
- (t
- (concat "Dired " dired-actual-switches)))))
+ (let ((case-fold-search nil))
+ (if dired-switches-in-mode-line
+ (concat
+ "Dired"
+ (cond ((integerp dired-switches-in-mode-line)
+ (let* ((l1 (length dired-actual-switches))
+ (xs (substring
+ dired-actual-switches
+ 0 (min l1 dired-switches-in-mode-line)))
+ (l2 (length xs)))
+ (if (zerop l2)
+ xs
+ (concat " " xs (and (< l2 l1) "…")))))
+ ((functionp dired-switches-in-mode-line)
+ (format " %s" (funcall
+ dired-switches-in-mode-line
+ dired-actual-switches)))
+ (t (concat " " dired-actual-switches))))
+ (cond ((string-match-p dired-sort-by-name-regexp
+ dired-actual-switches)
+ "Dired by name")
+ ((string-match-p dired-sort-by-date-regexp
+ dired-actual-switches)
+ "Dired by date")
+ (t (concat "Dired " dired-actual-switches))))))
(force-mode-line-update)))
(define-obsolete-function-alias 'dired-sort-set-modeline
@@ -4082,11 +4318,10 @@ With a prefix argument, edit the current listing switches instead."
(dired-sort-set-mode-line)
(revert-buffer))
-;; Some user code loads dired especially for this.
-;; Don't do that--use replace-regexp-in-string instead.
(defun dired-replace-in-string (regexp newtext string)
;; Replace REGEXP with NEWTEXT everywhere in STRING and return result.
;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
+ (declare (obsolete replace-regexp-in-string "28.1"))
(let ((result "") (start 0) mb me)
(while (string-match regexp string start)
(setq mb (match-beginning 0)
@@ -4289,6 +4524,70 @@ Ask means pop up a menu for the user to select one of copy, move or link."
(add-to-list 'desktop-buffer-mode-handlers
'(dired-mode . dired-restore-desktop-buffer))
+
+;;;; Jump to Dired
+
+(defvar archive-superior-buffer)
+(defvar tar-superior-buffer)
+
+;;;###autoload
+(defun dired-jump (&optional other-window file-name)
+ "Jump to Dired buffer corresponding to current buffer.
+If in a file, Dired the current directory and move to file's line.
+If in Dired already, pop up a level and goto old directory's line.
+In case the proper Dired file line cannot be found, refresh the dired
+buffer and try again.
+When OTHER-WINDOW is non-nil, jump to Dired buffer in other window.
+When FILE-NAME is non-nil, jump to its line in Dired.
+Interactively with prefix argument, read FILE-NAME."
+ (interactive
+ (list nil (and current-prefix-arg
+ (read-file-name "Jump to Dired file: "))))
+ (cond
+ ((and (bound-and-true-p archive-subfile-mode)
+ (buffer-live-p archive-superior-buffer))
+ (switch-to-buffer archive-superior-buffer))
+ ((and (bound-and-true-p tar-subfile-mode)
+ (buffer-live-p tar-superior-buffer))
+ (switch-to-buffer tar-superior-buffer))
+ (t
+ ;; Expand file-name before `dired-goto-file' call:
+ ;; `dired-goto-file' requires its argument to be an absolute
+ ;; file name; the result of `read-file-name' could be
+ ;; an abbreviated file name (Bug#24409).
+ (let* ((file (or (and file-name (expand-file-name file-name))
+ buffer-file-name))
+ (dir (if file (file-name-directory file) default-directory)))
+ (if (and (eq major-mode 'dired-mode) (null file-name))
+ (progn
+ (setq dir (dired-current-directory))
+ (dired-up-directory other-window)
+ (unless (dired-goto-file dir)
+ ;; refresh and try again
+ (dired-insert-subdir (file-name-directory dir))
+ (dired-goto-file dir)))
+ (if other-window
+ (dired-other-window dir)
+ (dired dir))
+ (if file
+ (or (dired-goto-file file)
+ ;; refresh and try again
+ (progn
+ (dired-insert-subdir (file-name-directory file))
+ (dired-goto-file file))
+ ;; Toggle omitting, if it is on, and try again.
+ (when (bound-and-true-p dired-omit-mode)
+ (dired-omit-mode)
+ (dired-goto-file file)))))))))
+
+;;;###autoload
+(defun dired-jump-other-window (&optional file-name)
+ "Like \\[dired-jump] (`dired-jump') but in other window."
+ (interactive
+ (list (and current-prefix-arg
+ (read-file-name "Jump to Dired file: "))))
+ (dired-jump t file-name))
+
(provide 'dired)
(run-hooks 'dired-load-hook) ; for your customizations
diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el
index 3a0bbd2c9c2..ad0c18d1b38 100644
--- a/lisp/dirtrack.el
+++ b/lisp/dirtrack.el
@@ -196,9 +196,6 @@ directory."
(remove-hook 'comint-preoutput-filter-functions 'dirtrack t)))
-(define-obsolete-function-alias 'dirtrack-debug-toggle 'dirtrack-debug-mode
- "23.1")
-(define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1")
(define-minor-mode dirtrack-debug-mode
"Toggle Dirtrack debugging."
nil nil nil
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index fe63573c0a3..2e88d350245 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -221,7 +221,7 @@ for a graphical frame."
(defun make-glyph-code (char &optional face)
"Return a glyph code representing char CHAR with face FACE."
;; Due to limitations on Emacs integer values, faces with
- ;; face id greater that 512 are silently ignored.
+ ;; face id greater than 512 are silently ignored.
(if (not face)
char
(let ((fid (face-id face)))
diff --git a/lisp/display-fill-column-indicator.el b/lisp/display-fill-column-indicator.el
index 3391aa371b7..e1395f000bf 100644
--- a/lisp/display-fill-column-indicator.el
+++ b/lisp/display-fill-column-indicator.el
@@ -57,12 +57,13 @@ See Info node `Displaying Boundaries' for details."
(progn
(setq display-fill-column-indicator t)
(unless display-fill-column-indicator-character
- (if (and (char-displayable-p ?\u2502)
- (or (not (display-graphic-p))
- (eq (aref (query-font (car (internal-char-font nil ?\u2502))) 0)
- (face-font 'default))))
- (setq display-fill-column-indicator-character ?\u2502)
- (setq display-fill-column-indicator-character ?|))))
+ (setq display-fill-column-indicator-character
+ (if (and (char-displayable-p ?\u2502)
+ (or (not (display-graphic-p))
+ (eq (aref (query-font (car (internal-char-font nil ?\u2502))) 0)
+ (face-font 'default))))
+ ?\u2502
+ ?|))))
(setq display-fill-column-indicator nil)))
(defun display-fill-column-indicator--turn-on ()
@@ -73,9 +74,7 @@ See Info node `Displaying Boundaries' for details."
;;;###autoload
(define-globalized-minor-mode global-display-fill-column-indicator-mode
- display-fill-column-indicator-mode display-fill-column-indicator--turn-on
- ;; See bug#41145
- :group 'display-fill-column-indicator)
+ display-fill-column-indicator-mode display-fill-column-indicator--turn-on)
(provide 'display-fill-column-indicator)
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 905659e817b..815a4afbecd 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -1,4 +1,4 @@
-;;; dnd.el --- drag and drop support
+;;; dnd.el --- drag and drop support -*- lexical-binding: t; -*-
;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
@@ -33,6 +33,9 @@
;;; Customizable variables
+(defgroup dnd nil
+ "Handling data from drag and drop."
+ :group 'environment)
;;;###autoload
(defcustom dnd-protocol-alist
@@ -54,14 +57,13 @@ If no match is found, the URL is inserted as text by calling `dnd-insert-text'.
The function shall return the action done (move, copy, link or private)
if some action was made, or nil if the URL is ignored."
:version "22.1"
- :type '(repeat (cons (regexp) (function)))
- :group 'dnd)
+ :type '(repeat (cons (regexp) (function))))
(defcustom dnd-open-remote-file-function
(if (eq system-type 'windows-nt)
- 'dnd-open-local-file
- 'dnd-open-remote-url)
+ #'dnd-open-local-file
+ #'dnd-open-remote-url)
"The function to call when opening a file on a remote machine.
The function will be called with two arguments, URI and ACTION.
See `dnd-open-file' for details.
@@ -71,15 +73,13 @@ Predefined functions are `dnd-open-local-file' and `dnd-open-remote-url'.
is the default on MS-Windows. `dnd-open-remote-url' uses `url-handler-mode'
and is the default except for MS-Windows."
:version "22.1"
- :type 'function
- :group 'dnd)
+ :type 'function)
(defcustom dnd-open-file-other-window nil
"If non-nil, always use find-file-other-window to open dropped files."
:version "22.1"
- :type 'boolean
- :group 'dnd)
+ :type 'boolean)
;; Functions
@@ -87,13 +87,11 @@ and is the default except for MS-Windows."
(defun dnd-handle-one-url (window action url)
"Handle one dropped url by calling the appropriate handler.
The handler is first located by looking at `dnd-protocol-alist'.
-If no match is found here, and the value of `browse-url-browser-function'
-is a pair of (REGEXP . FUNCTION), those regexps are tried for a match.
-If no match is found, just call `dnd-insert-text'.
-WINDOW is where the drop happened, ACTION is the action for the drop,
-URL is what has been dropped.
-Returns ACTION."
- (require 'browse-url)
+If no match is found here, `browse-url-handlers' and
+`browse-url-default-handlers' are searched for a match.
+If no match is found, just call `dnd-insert-text'. WINDOW is
+where the drop happened, ACTION is the action for the drop, URL
+is what has been dropped. Returns ACTION."
(let (ret)
(or
(catch 'done
@@ -102,14 +100,13 @@ Returns ACTION."
(setq ret (funcall (cdr bf) url action))
(throw 'done t)))
nil)
- (when (not (functionp browse-url-browser-function))
- (catch 'done
- (dolist (bf browse-url-browser-function)
- (when (string-match (car bf) url)
- (setq ret 'private)
- (funcall (cdr bf) url action)
- (throw 'done t)))
- nil))
+ (catch 'done
+ (let ((browser (browse-url-select-handler url 'internal)))
+ (when browser
+ (setq ret 'private)
+ (funcall browser url action)
+ (throw 'done t)))
+ nil)
(progn
(dnd-insert-text window action url)
(setq ret 'private)))
@@ -136,7 +133,8 @@ Return nil if URI is not a local file."
(string-equal sysname-no-dot hostname)))
(concat "file://" (substring uri (+ 7 (length hostname))))))))
-(defsubst dnd-unescape-uri (uri)
+(defun dnd--unescape-uri (uri)
+ ;; Merge with corresponding code in URL library.
(replace-regexp-in-string
"%[[:xdigit:]][[:xdigit:]]"
(lambda (arg)
@@ -160,7 +158,7 @@ Return nil if URI is not a local file."
'utf-8
(or file-name-coding-system
default-file-name-coding-system))))
- (and f (setq f (decode-coding-string (dnd-unescape-uri f) coding)))
+ (and f (setq f (decode-coding-string (dnd--unescape-uri f) coding)))
(when (and f must-exist (not (file-readable-p f)))
(setq f nil))
f))
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 9f5dc40ea16..8aaf38aab21 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -24,8 +24,8 @@
;; doc-view.el requires GNU Emacs 22.1 or newer. You also need Ghostscript,
;; `dvipdf' (comes with Ghostscript) or `dvipdfm' (comes with teTeX or TeXLive)
-;; and `pdftotext', which comes with xpdf (http://www.foolabs.com/xpdf/) or
-;; poppler (http://poppler.freedesktop.org/).
+;; and `pdftotext', which comes with xpdf (https://www.foolabs.com/xpdf/) or
+;; poppler (https://poppler.freedesktop.org/).
;;; Commentary:
@@ -435,6 +435,9 @@ Typically \"page-%s.png\".")
(define-key map (kbd "c m") 'doc-view-set-slice-using-mouse)
(define-key map (kbd "c b") 'doc-view-set-slice-from-bounding-box)
(define-key map (kbd "c r") 'doc-view-reset-slice)
+ ;; Centering the image
+ (define-key map (kbd "c h") 'doc-view-center-page-horizontally)
+ (define-key map (kbd "c v") 'doc-view-center-page-vertically)
;; Searching
(define-key map (kbd "C-s") 'doc-view-search)
(define-key map (kbd "<find>") 'doc-view-search)
@@ -693,8 +696,6 @@ at the top edge of the page moves to the previous page."
;; time-window of loose permissions otherwise.
(with-file-modes #o0700 (make-directory dir))
(file-already-exists
- (when (file-symlink-p dir)
- (error "Danger: %s points to a symbolic link" dir))
;; In case it was created earlier with looser rights.
;; We could check the mode info returned by file-attributes, but it's
;; a pain to parse and it may not tell you what we want under
@@ -704,7 +705,7 @@ at the top edge of the page moves to the previous page."
;; sure we have write-access to the directory and that we own it, thus
;; closing a bunch of security holes.
(condition-case error
- (set-file-modes dir #o0700)
+ (set-file-modes dir #o0700 'nofollow)
(file-error
(error
(format "Unable to use temporary directory %s: %s"
@@ -742,8 +743,7 @@ It's a subdirectory of `doc-view-cache-directory'."
Document types are symbols like `dvi', `ps', `pdf', or `odf' (any
OpenDocument format)."
(and (display-graphic-p)
- (or (image-type-available-p 'imagemagick)
- (image-type-available-p 'png))
+ (image-type-available-p 'png)
(cond
((eq type 'dvi)
(and (doc-view-mode-p 'pdf)
@@ -771,10 +771,7 @@ OpenDocument format)."
(defun doc-view-enlarge (factor)
"Enlarge the document by FACTOR."
(interactive (list doc-view-shrink-factor))
- (if (and doc-view-scale-internally
- (eq (plist-get (cdr (doc-view-current-image)) :type)
- 'imagemagick))
- ;; ImageMagick supports on-the-fly-rescaling.
+ (if doc-view-scale-internally
(let ((new (ceiling (* factor doc-view-image-width))))
(unless (equal new doc-view-image-width)
(setq-local doc-view-image-width new)
@@ -794,9 +791,7 @@ OpenDocument format)."
(defun doc-view-scale-reset ()
"Reset the document size/zoom level to the initial one."
(interactive)
- (if (and doc-view-scale-internally
- (eq (plist-get (cdr (doc-view-current-image)) :type)
- 'imagemagick))
+ (if doc-view-scale-internally
(progn
(kill-local-variable 'doc-view-image-width)
(doc-view-insert-image
@@ -929,6 +924,32 @@ Resize the containing frame if needed."
(when new-frame-params
(modify-frame-parameters (selected-frame) new-frame-params))))
+(defun doc-view-center-page-horizontally ()
+ "Center page horizontally when page is wider than window."
+ (interactive)
+ (let ((page-width (car (image-size (doc-view-current-image) 'pixel)))
+ (window-width (window-body-width nil 'pixel))
+ ;; How much do we scroll in order to center the page?
+ (pixel-hscroll 0)
+ ;; How many pixels are there in a column?
+ (col-in-pixel (/ (window-body-width nil 'pixel)
+ (window-body-width nil))))
+ (when (> page-width window-width)
+ (setq pixel-hscroll (/ (- page-width window-width) 2))
+ (set-window-hscroll (selected-window)
+ (/ pixel-hscroll col-in-pixel)))))
+
+(defun doc-view-center-page-vertically ()
+ "Center page vertically when page is wider than window."
+ (interactive)
+ (let ((page-height (cdr (image-size (doc-view-current-image) 'pixel)))
+ (window-height (window-body-height nil 'pixel))
+ ;; How much do we scroll in order to center the page?
+ (pixel-scroll 0))
+ (when (> page-height window-height)
+ (setq pixel-scroll (/ (- page-height window-height) 2))
+ (set-window-vscroll (selected-window) pixel-scroll 'pixel))))
+
(defun doc-view-reconvert-doc ()
"Reconvert the current document.
Should be invoked when the cached images aren't up-to-date."
@@ -1299,26 +1320,31 @@ dragging it to its bottom-right corner. See also
(defun doc-view-get-bounding-box ()
"Get the BoundingBox information of the current page."
- (let* ((page (doc-view-current-page))
- (doc (let ((cache-doc (doc-view-current-cache-doc-pdf)))
- (if (file-exists-p cache-doc)
- cache-doc
- doc-view--buffer-file-name)))
- (o (shell-command-to-string
- (concat doc-view-ghostscript-program
- " -dSAFER -dBATCH -dNOPAUSE -q -sDEVICE=bbox "
- (format "-dFirstPage=%s -dLastPage=%s %s"
- page page doc)))))
- (save-match-data
- (when (string-match (concat "%%BoundingBox: "
- "\\([[:digit:]]+\\) \\([[:digit:]]+\\) "
- "\\([[:digit:]]+\\) \\([[:digit:]]+\\)")
- o)
- (mapcar #'string-to-number
- (list (match-string 1 o)
- (match-string 2 o)
- (match-string 3 o)
- (match-string 4 o)))))))
+ (let ((page (doc-view-current-page))
+ (doc (let ((cache-doc (doc-view-current-cache-doc-pdf)))
+ (if (file-exists-p cache-doc)
+ cache-doc
+ doc-view--buffer-file-name))))
+ (with-temp-buffer
+ (when (eq 0 (ignore-errors
+ (process-file doc-view-ghostscript-program nil t
+ nil "-dSAFER" "-dBATCH" "-dNOPAUSE" "-q"
+ "-sDEVICE=bbox"
+ (format "-dFirstPage=%s" page)
+ (format "-dLastPage=%s" page)
+ doc)))
+ (goto-char (point-min))
+ (save-match-data
+ (when (re-search-forward
+ (concat "%%BoundingBox: "
+ "\\([[:digit:]]+\\) \\([[:digit:]]+\\) "
+ "\\([[:digit:]]+\\) \\([[:digit:]]+\\)")
+ nil t)
+ (mapcar #'string-to-number
+ (list (match-string 1)
+ (match-string 2)
+ (match-string 3)
+ (match-string 4)))))))))
(defvar doc-view-paper-sizes
'((a4 595 842)
@@ -1395,12 +1421,11 @@ ARGS is a list of image descriptors."
;; Only insert the image if the buffer is visible.
(when (window-live-p (overlay-get ol 'window))
(let* ((image (if (and file (file-readable-p file))
- (if (not (and doc-view-scale-internally
- (fboundp 'imagemagick-types)))
+ (if (not doc-view-scale-internally)
(apply #'create-image file doc-view--image-type nil args)
(unless (member :width args)
(setq args `(,@args :width ,doc-view-image-width)))
- (apply #'create-image file 'imagemagick nil args))))
+ (apply #'create-image file doc-view--image-type nil args))))
(slice (doc-view-current-slice))
(img-width (and image (car (image-size image))))
(displayed-img-width (if (and image slice)
@@ -2052,8 +2077,8 @@ See the command `doc-view-mode' for more information on this mode."
(when (memq (selected-frame) (alist-get 'frames attrs))
(let ((geom (alist-get 'geometry attrs)))
(when geom
- (setq monitor-top (nth 0 geom))
- (setq monitor-left (nth 1 geom))
+ (setq monitor-left (nth 0 geom))
+ (setq monitor-top (nth 1 geom))
(setq monitor-width (nth 2 geom))
(setq monitor-height (nth 3 geom))))))
(let ((frame (make-frame
diff --git a/lisp/dom.el b/lisp/dom.el
index 34df0e9af4c..bf4a56ab9f5 100644
--- a/lisp/dom.el
+++ b/lisp/dom.el
@@ -67,6 +67,12 @@
(setcdr old value)
(setcar (cdr node) (nconc (cadr node) (list (cons attribute value)))))))
+(defun dom-remove-attribute (node attribute)
+ "Remove ATTRIBUTE from NODE."
+ (setq node (dom-ensure-node node))
+ (when-let ((old (assoc attribute (cadr node))))
+ (setcar (cdr node) (delq old (cadr node)))))
+
(defmacro dom-attr (node attr)
"Return the attribute ATTR from NODE.
A typical attribute is `href'."
@@ -263,6 +269,50 @@ white-space."
(insert ")")
(insert "\n" (make-string (1+ column) ? ))))))))
+(defun dom-print (dom &optional pretty xml)
+ "Print DOM at point as HTML/XML.
+If PRETTY, indent the HTML/XML logically.
+If XML, generate XML instead of HTML."
+ (let ((column (current-column)))
+ (insert (format "<%s" (dom-tag dom)))
+ (let ((attr (dom-attributes dom)))
+ (dolist (elem attr)
+ ;; In HTML, these are boolean attributes that should not have
+ ;; an = value.
+ (if (and (memq (car elem)
+ '(async autofocus autoplay checked
+ contenteditable controls default
+ defer disabled formNoValidate frameborder
+ hidden ismap itemscope loop
+ multiple muted nomodule novalidate open
+ readonly required reversed
+ scoped selected typemustmatch))
+ (cdr elem)
+ (not xml))
+ (insert (format " %s" (car elem)))
+ (insert (format " %s=%S" (car elem) (cdr elem))))))
+ (let* ((children (dom-children dom))
+ (non-text nil))
+ (if (null children)
+ (insert " />")
+ (insert ">")
+ (dolist (child children)
+ (if (stringp child)
+ (insert child)
+ (setq non-text t)
+ (when pretty
+ (insert "\n" (make-string (+ column 2) ? )))
+ (dom-print child pretty xml)))
+ ;; If we inserted non-text child nodes, or a text node that
+ ;; ends with a newline, then we indent the end tag.
+ (when (and pretty
+ (or (bolp)
+ non-text))
+ (unless (bolp)
+ (insert "\n"))
+ (insert (make-string column ? )))
+ (insert (format "</%s>" (dom-tag dom)))))))
+
(provide 'dom)
;;; dom.el ends here
diff --git a/lisp/dos-vars.el b/lisp/dos-vars.el
index 0f58277fe51..47d1f83de9e 100644
--- a/lisp/dos-vars.el
+++ b/lisp/dos-vars.el
@@ -1,4 +1,4 @@
-;;; dos-vars.el --- MS-Dos specific user options
+;;; dos-vars.el --- MS-Dos specific user options -*- lexical-binding:t -*-
;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
@@ -31,15 +31,13 @@
(defcustom msdos-shells '("command.com" "4dos.com" "ndos.com")
"List of shells that use `/c' instead of `-c' and a backslashed command."
- :type '(repeat string)
- :group 'dos-fns)
+ :type '(repeat string))
(defcustom dos-codepage-setup-hook nil
"List of functions to be called after the DOS terminal and coding
systems are set up. This is the place, e.g., to set specific entries
in `standard-display-table' as appropriate for your codepage, if
`IT-display-table-setup' doesn't do a perfect job."
- :group 'dos-fns
:type '(hook)
:version "20.3.3")
diff --git a/lisp/double.el b/lisp/double.el
index 639d041a1dc..8e5090034cf 100644
--- a/lisp/double.el
+++ b/lisp/double.el
@@ -99,7 +99,7 @@ but not `C-u X' or `ESC X' since the X is not the prefix key."
(load-library "isearch"))
(define-key isearch-mode-map [ignore]
- (function (lambda () (interactive) (isearch-update))))
+ (lambda () (interactive) (isearch-update)))
(defun double-translate-key (prompt)
;; Translate input events using double map.
diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el
index 7285021676c..079fce88def 100644
--- a/lisp/ebuff-menu.el
+++ b/lisp/ebuff-menu.el
@@ -162,6 +162,7 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry.
(message "")))
(when select
(set-buffer buffer)
+ (goto-char select)
(let ((opoint (point-marker)))
(Buffer-menu-execute)
(goto-char (point-min))
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
index ad39116c680..81373202c51 100644
--- a/lisp/ehelp.el
+++ b/lisp/ehelp.el
@@ -219,7 +219,7 @@ BUFFER is put back into its original major mode."
'electric-help-retain))))
(Electric-command-loop
'exit
- (function (lambda ()
+ (lambda ()
(sit-for 0) ;necessary if last command was end-of-buffer or
;beginning-of-buffer - otherwise pos-visible-in-window-p
;will yield a wrong result.
@@ -241,7 +241,7 @@ BUFFER is put back into its original major mode."
(t
(cond (standard "Press SPC to scroll, DEL to scroll back, q to exit, r to retain ")
(both)
- (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))))))
+ (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain "))))))))
t))))
diff --git a/lisp/elide-head.el b/lisp/elide-head.el
index 57940456660..a892754d723 100644
--- a/lisp/elide-head.el
+++ b/lisp/elide-head.el
@@ -1,4 +1,4 @@
-;;; elide-head.el --- hide headers in files
+;;; elide-head.el --- hide headers in files -*- lexical-binding: t; -*-
;; Copyright (C) 1999, 2001-2020 Free Software Foundation, Inc.
@@ -63,12 +63,10 @@ The cars of elements of the list are searched for in order. Text is
elided with an invisible overlay from the end of the line where the
first match is found to the end of the match for the corresponding
cdr."
- :group 'elide-head
- :type '(alist :key-type (string :tag "Start regexp")
- :value-type (string :tag "End regexp")))
+ :type '(alist :key-type (regexp :tag "Start regexp")
+ :value-type (regexp :tag "End regexp")))
-(defvar elide-head-overlay nil)
-(make-variable-buffer-local 'elide-head-overlay)
+(defvar-local elide-head-overlay nil)
;;;###autoload
(defun elide-head (&optional arg)
@@ -108,7 +106,7 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks."
(overlay-put elide-head-overlay 'after-string "...")))))))
(defun elide-head-show ()
- "Show a header elided current buffer by \\[elide-head]."
+ "Show a header in the current buffer elided by \\[elide-head]."
(interactive)
(if (and (overlayp elide-head-overlay)
(overlay-buffer elide-head-overlay))
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index deac45892ea..0ebd2741d2e 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1856,7 +1856,7 @@ function at point for which PREDICATE returns non-nil)."
"There are no qualifying advised functions")))
(let* ((function
(completing-read
- (format "%s (default %s): " (or prompt "Function") default)
+ (format-prompt (or prompt "Function") default)
ad-advised-functions
(if predicate
(lambda (function)
@@ -1884,7 +1884,7 @@ class of FUNCTION)."
(cl-return class)))
(error "ad-read-advice-class: `%s' has no advices" function)))
(let ((class (completing-read
- (format "%s (default %s): " (or prompt "Class") default)
+ (format-prompt (or prompt "Class") default)
ad-advice-class-completion-table nil t)))
(if (equal class "")
default
@@ -1902,8 +1902,8 @@ An optional PROMPT is used to prompt for the name."
(error "ad-read-advice-name: `%s' has no %s advice"
function class)
(car (car name-completion-table))))
- (prompt (format "%s (default %s): " (or prompt "Name") default))
- (name (completing-read prompt name-completion-table nil t)))
+ (name (completing-read (format-prompt (or prompt "Name") default)
+ name-completion-table nil t)))
(if (equal name "")
(intern default)
(intern name))))
@@ -1923,9 +1923,9 @@ be used to prompt for the function."
(defun ad-read-regexp (&optional prompt)
"Read a regular expression from the minibuffer."
(let ((regexp (read-from-minibuffer
- (concat (or prompt "Regular expression")
- (if (equal ad-last-regexp "") ": "
- (format " (default %s): " ad-last-regexp))))))
+ (format-prompt (or prompt "Regular expression")
+ (and (not (equal ad-last-regexp ""))
+ ad-last-regexp)))))
(setq ad-last-regexp
(if (equal regexp "") ad-last-regexp regexp))))
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index dc7461d93ee..e6e3fd9da10 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -1,4 +1,4 @@
-;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*-
+;;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*-
;; Copyright (C) 1991-1997, 2001-2020 Free Software Foundation, Inc.
@@ -254,12 +254,12 @@ expression, in which case we want to handle forms differently."
;; the doc-string in FORM.
;; Those properties are now set in lisp-mode.el.
-(defun autoload-find-generated-file ()
+(defun autoload-find-generated-file (file)
"Visit the autoload file for the current buffer, and return its buffer."
(let ((enable-local-variables :safe)
(enable-local-eval nil)
- (delay-mode-hooks t)
- (file (autoload-generated-file)))
+ (find-file-hook nil)
+ (delay-mode-hooks t))
;; We used to use `raw-text' to read this file, but this causes
;; problems when the file contains non-ASCII characters.
(with-current-buffer (find-file-noselect
@@ -267,18 +267,20 @@ expression, in which case we want to handle forms differently."
(if (zerop (buffer-size)) (insert (autoload-rubric file nil t)))
(current-buffer))))
-(defun autoload-generated-file ()
- "Return `generated-autoload-file' as an absolute name.
-If local to the current buffer, expand using the default directory;
-otherwise, using `source-directory'/lisp."
- (expand-file-name generated-autoload-file
+(defun autoload-generated-file (outfile)
+ "Return OUTFILE as an absolute name.
+If `generated-autoload-file' is bound locally in the current
+buffer, that is used instead, and it is expanded using the
+default directory; otherwise, `source-directory'/lisp is used."
+ (expand-file-name (if (local-variable-p 'generated-autoload-file)
+ generated-autoload-file
+ outfile)
;; File-local settings of generated-autoload-file should
;; be interpreted relative to the file's location,
;; of course.
(if (not (local-variable-p 'generated-autoload-file))
(expand-file-name "lisp" source-directory))))
-
(defun autoload-read-section-header ()
"Read a section header form.
Since continuation lines have been marked as comments,
@@ -453,13 +455,12 @@ which lists the file name and which functions are in it, etc."
(defvar no-update-autoloads nil
"File local variable to prevent scanning this file for autoload cookies.")
-(defun autoload-file-load-name (file)
+(defun autoload-file-load-name (file outfile)
"Compute the name that will be used to load FILE."
;; OUTFILE should be the name of the global loaddefs.el file, which
;; is expected to be at the root directory of the files we're
;; scanning for autoloads and will be in the `load-path'.
- (let* ((outfile (default-value 'generated-autoload-file))
- (name (file-relative-name file (file-name-directory outfile)))
+ (let* ((name (file-relative-name file (file-name-directory outfile)))
(names '())
(dir (file-name-directory outfile)))
;; If `name' has directory components, only keep the
@@ -489,8 +490,9 @@ If FILE is being visited in a buffer, the contents of the buffer
are used.
Return non-nil in the case where no autoloads were added at point."
(interactive "fGenerate autoloads for file: ")
- (let ((generated-autoload-file buffer-file-name))
- (autoload-generate-file-autoloads file (current-buffer))))
+ (let ((autoload-modified-buffers nil))
+ (autoload-generate-file-autoloads file (current-buffer) buffer-file-name)
+ autoload-modified-buffers))
(defvar autoload-compute-prefixes t
"If non-nil, autoload will add code to register the prefixes used in a file.
@@ -604,11 +606,10 @@ Don't try to split prefixes that are already longer than that.")
prefix file dropped)
nil))))
prefixes)))
- `(if (fboundp 'register-definition-prefixes)
- (register-definition-prefixes ,file ',(sort (delq nil strings)
- 'string<)))))))
+ `(register-definition-prefixes ,file ',(sort (delq nil strings)
+ 'string<))))))
-(defun autoload--setup-output (otherbuf outbuf absfile load-name)
+(defun autoload--setup-output (otherbuf outbuf absfile load-name output-file)
(let ((outbuf
(or (if otherbuf
;; A file-local setting of
@@ -616,7 +617,7 @@ Don't try to split prefixes that are already longer than that.")
;; should ignore OUTBUF.
nil
outbuf)
- (autoload-find-destination absfile load-name)
+ (autoload-find-destination absfile load-name output-file)
;; The file has autoload cookies, but they're
;; already up-to-date. If OUTFILE is nil, the
;; entries are in the expected OUTBUF,
@@ -673,23 +674,16 @@ Don't try to split prefixes that are already longer than that.")
More specifically those definitions will not be considered for the
`register-definition-prefixes' call.")
-;; When called from `generate-file-autoloads' we should ignore
-;; `generated-autoload-file' altogether. When called from
-;; `update-file-autoloads' we don't know `outbuf'. And when called from
-;; `update-directory-autoloads' it's in between: we know the default
-;; `outbuf' but we should obey any file-local setting of
-;; `generated-autoload-file'.
(defun autoload-generate-file-autoloads (file &optional outbuf outfile)
"Insert an autoload section for FILE in the appropriate buffer.
Autoloads are generated for defuns and defmacros in FILE
marked by `generate-autoload-cookie' (which see).
+
If FILE is being visited in a buffer, the contents of the buffer are used.
OUTBUF is the buffer in which the autoload statements should be inserted.
-If OUTBUF is nil, it will be determined by `autoload-generated-file'.
-If provided, OUTFILE is expected to be the file name of OUTBUF.
-If OUTFILE is non-nil and FILE specifies a `generated-autoload-file'
-different from OUTFILE, then OUTBUF is ignored.
+If OUTBUF is nil, the output will go to OUTFILE, unless there's a
+buffer-local setting of `generated-autoload-file' in FILE.
Return non-nil if and only if FILE adds no autoloads to OUTFILE
\(or OUTBUF if OUTFILE is nil). The actual return value is
@@ -717,16 +711,19 @@ FILE's modification time."
(setq load-name
(if (stringp generated-autoload-load-name)
generated-autoload-load-name
- (autoload-file-load-name absfile)))
+ (autoload-file-load-name absfile outfile)))
;; FIXME? Comparing file-names for equality with just equal
;; is fragile, eg if one has an automounter prefix and one
;; does not, but both refer to the same physical file.
(when (and outfile
+ (not outbuf)
(not
(if (memq system-type '(ms-dos windows-nt))
(equal (downcase outfile)
- (downcase (autoload-generated-file)))
- (equal outfile (autoload-generated-file)))))
+ (downcase (autoload-generated-file
+ outfile)))
+ (equal outfile (autoload-generated-file
+ outfile)))))
(setq otherbuf t))
(save-excursion
(save-restriction
@@ -740,7 +737,8 @@ FILE's modification time."
(file-name-sans-extension
(file-name-nondirectory file))))
(setq output-start (autoload--setup-output
- otherbuf outbuf absfile load-name))
+ otherbuf outbuf absfile
+ load-name outfile))
(let ((standard-output (marker-buffer output-start))
(print-quoted t))
(princ `(push (purecopy
@@ -758,7 +756,8 @@ FILE's modification time."
;; If not done yet, figure out where to insert this text.
(unless output-start
(setq output-start (autoload--setup-output
- otherbuf outbuf absfile load-name)))
+ otherbuf outbuf absfile
+ load-name outfile)))
(autoload--print-cookie-text output-start load-name file))
((= (following-char) ?\;)
;; Don't read the comment.
@@ -789,7 +788,7 @@ FILE's modification time."
((not otherbuf)
(unless output-start
(setq output-start (autoload--setup-output
- nil outbuf absfile load-name)))
+ nil outbuf absfile load-name outfile)))
(let ((autoload-print-form-outbuf
(marker-buffer output-start)))
(autoload-print-form form)))
@@ -801,9 +800,8 @@ FILE's modification time."
;; then passing otherbuf=nil is enough, but if
;; outbuf is nil, that won't cut it, so we
;; locally bind generated-autoload-file.
- (let ((generated-autoload-file
- (default-value 'generated-autoload-file)))
- (autoload--setup-output nil outbuf absfile load-name)))
+ (autoload--setup-output nil outbuf absfile load-name
+ outfile))
(autoload-print-form-outbuf
(marker-buffer other-output-start)))
(autoload-print-form form)
@@ -895,7 +893,7 @@ FILE's modification time."
(cons (lambda () (ignore-errors (delete-file tempfile)))
kill-emacs-hook)))
(unless (= temp-modes desired-modes)
- (set-file-modes tempfile desired-modes))
+ (set-file-modes tempfile desired-modes 'nofollow))
(write-region (point-min) (point-max) tempfile nil 1)
(backup-buffer)
(rename-file tempfile buffer-file-name t))
@@ -925,19 +923,22 @@ Return FILE if there was no autoload cookie in it, else nil."
(interactive (list (read-file-name "Update autoloads for file: ")
current-prefix-arg
(read-file-name "Write autoload definitions to file: ")))
- (let* ((generated-autoload-file (or outfile generated-autoload-file))
- (autoload-modified-buffers nil)
+ (let* ((autoload-modified-buffers nil)
;; We need this only if the output file handles more than one input.
;; See https://debbugs.gnu.org/22213#38 and subsequent.
(autoload-timestamps t)
- (no-autoloads (autoload-generate-file-autoloads file)))
+ (no-autoloads (autoload-generate-file-autoloads
+ file nil
+ (if (local-variable-p 'generated-autoload-file)
+ generated-autoload-file
+ outfile))))
(if autoload-modified-buffers
(if save-after (autoload-save-buffers))
(if (called-interactively-p 'interactive)
(message "Autoload section for %s is up to date." file)))
(if no-autoloads file)))
-(defun autoload-find-destination (file load-name)
+(defun autoload-find-destination (file load-name output-file)
"Find the destination point of the current buffer's autoloads.
FILE is the file name of the current buffer.
LOAD-NAME is the name as it appears in the output.
@@ -947,12 +948,12 @@ removes any prior now out-of-date autoload entries."
(catch 'up-to-date
(let* ((buf (current-buffer))
(existing-buffer (if buffer-file-name buf))
- (output-file (autoload-generated-file))
+ (output-file (autoload-generated-file output-file))
(output-time (if (file-exists-p output-file)
(file-attribute-modification-time
(file-attributes output-file))))
(found nil))
- (with-current-buffer (autoload-find-generated-file)
+ (with-current-buffer (autoload-find-generated-file output-file)
;; This is to make generated-autoload-file have Unix EOLs, so
;; that it is portable to all platforms.
(or (eq 0 (coding-system-eol-type buffer-file-coding-system))
@@ -1033,12 +1034,31 @@ The function does NOT recursively descend into subdirectories of the
directory or directories specified.
In an interactive call, prompt for a default output file for the
-autoload definitions, and temporarily bind the variable
-`generated-autoload-file' to this value. When called from Lisp,
-use the existing value of `generated-autoload-file'. If any Lisp
-file binds `generated-autoload-file' as a file-local variable,
-write its autoloads into the specified file instead."
+autoload definitions. When called from Lisp, use the existing
+value of `generated-autoload-file'. If any Lisp file binds
+`generated-autoload-file' as a file-local variable, write its
+autoloads into the specified file instead."
+ (declare (obsolete make-directory-autoloads "28.1"))
(interactive "DUpdate autoloads from directory: ")
+ (make-directory-autoloads
+ dirs
+ (if (called-interactively-p 'interactive)
+ (read-file-name "Write autoload definitions to file: ")
+ generated-autoload-file)))
+
+;;;###autoload
+(defun make-directory-autoloads (dir output-file)
+ "Update autoload definitions for Lisp files in the directories DIRS.
+DIR can be either a single directory or a list of
+directories. (The latter usage is discouraged.)
+
+The autoloads will be written to OUTPUT-FILE. If any Lisp file
+binds `generated-autoload-file' as a file-local variable, write
+its autoloads into the specified file instead.
+
+The function does NOT recursively descend into subdirectories of the
+directory or directories specified."
+ (interactive "DUpdate autoloads from directory: \nFWrite to file: ")
(let* ((files-re (let ((tmp nil))
(dolist (suf (get-load-suffixes))
;; We don't use module-file-suffix below because
@@ -1049,10 +1069,10 @@ write its autoloads into the specified file instead."
(push suf tmp)))
(concat "\\`[^=.].*" (regexp-opt tmp t) "\\'")))
(files (apply #'nconc
- (mapcar (lambda (dir)
- (directory-files (expand-file-name dir)
- t files-re))
- dirs)))
+ (mapcar (lambda (d)
+ (directory-files (expand-file-name d)
+ t files-re))
+ (if (consp dir) dir (list dir)))))
(done ()) ;Files processed; to remove duplicates.
(changed nil) ;Non-nil if some change occurred.
(last-time)
@@ -1060,16 +1080,12 @@ write its autoloads into the specified file instead."
;; files because of file-local autoload-generated-file settings.
(no-autoloads nil)
(autoload-modified-buffers nil)
- (generated-autoload-file
- (if (called-interactively-p 'interactive)
- (read-file-name "Write autoload definitions to file: ")
- generated-autoload-file))
(output-time
- (if (file-exists-p generated-autoload-file)
- (file-attribute-modification-time
- (file-attributes generated-autoload-file)))))
+ (and (file-exists-p output-file)
+ (file-attribute-modification-time
+ (file-attributes output-file)))))
- (with-current-buffer (autoload-find-generated-file)
+ (with-current-buffer (autoload-find-generated-file output-file)
(save-excursion
;; Canonicalize file names and remove the autoload file itself.
(setq files (delete (file-relative-name buffer-file-name)
@@ -1124,10 +1140,9 @@ write its autoloads into the specified file instead."
;; Elements remaining in FILES have no existing autoload sections yet.
(let ((no-autoloads-time (or last-time '(0 0 0 0)))
(progress (make-progress-reporter
- (byte-compile-info-string
+ (byte-compile-info
(concat "Scraping files for "
- (file-relative-name
- generated-autoload-file)))
+ (file-relative-name output-file)))
0 (length files) nil 10))
(file-count 0)
file-time)
@@ -1167,6 +1182,19 @@ write its autoloads into the specified file instead."
;; file-local autoload-generated-file settings.
(autoload-save-buffers))))
+(defun batch-update-autoloads--summary (strings)
+ (let ((message ""))
+ (while strings
+ (when (> (length (concat message " " (car strings))) 64)
+ (byte-compile-info (concat message " ...") t "SCRAPE")
+ (setq message ""))
+ (setq message (if (zerop (length message))
+ (car strings)
+ (concat message " " (car strings))))
+ (setq strings (cdr strings)))
+ (when (> (length message) 0)
+ (byte-compile-info message t "SCRAPE"))))
+
;;;###autoload
(defun batch-update-autoloads ()
"Update loaddefs.el autoloads in batch mode.
@@ -1190,8 +1218,9 @@ should be non-nil)."
(or (string-match "\\`site-" file)
(push (expand-file-name file) autoload-excludes)))))))
(let ((args command-line-args-left))
+ (batch-update-autoloads--summary args)
(setq command-line-args-left nil)
- (apply #'update-directory-autoloads args)))
+ (make-directory-autoloads args generated-autoload-file)))
(provide 'autoload)
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index a7fcc5cb8f2..2fa5a878801 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -81,7 +81,7 @@ result. The overhead of the `lambda's is accounted for."
(gcs (make-symbol "gcs"))
(gc (make-symbol "gc"))
(code (byte-compile `(lambda () ,@forms)))
- (lambda-code (byte-compile '(lambda ()))))
+ (lambda-code (byte-compile '(lambda ()))))
`(let ((,gc gc-elapsed)
(,gcs gcs-done))
(list ,(if (or (symbolp repetitions) (> repetitions 1))
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 850af93571f..d168c255121 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -149,9 +149,6 @@
;; | ip -- 4 byte vector
;; | bits LEN -- List with bits set in LEN bytes.
;;
-;; -- Note: 32 bit values may be limited by emacs' INTEGER
-;; implementation limits.
-;;
;; -- Example: `bits 2' will unpack 0x28 0x1c to (2 3 4 11 13)
;; and 0x1c 0x28 to (3 5 10 11 12).
@@ -635,7 +632,7 @@ If optional second arg SEP is a string, use that as separator."
(bindat-format-vector vect "%d" (if (stringp sep) sep ".")))
(defun bindat-vector-to-hex (vect &optional sep)
- "Format vector VECT in hex format separated by dots.
+ "Format vector VECT in hex format separated by colons.
If optional second arg SEP is a string, use that as separator."
(bindat-format-vector vect "%02x" (if (stringp sep) sep ":")))
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 90ab8911c39..65e4e446266 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -227,7 +227,7 @@
;;; byte-compile optimizers to support inlining
-(put 'inline 'byte-optimizer 'byte-optimize-inline-handler)
+(put 'inline 'byte-optimizer #'byte-optimize-inline-handler)
(defun byte-optimize-inline-handler (form)
"byte-optimize-handler for the `inline' special-form."
@@ -391,13 +391,6 @@
(and (nth 1 form)
(not for-effect)
form))
- ((eq (car-safe fn) 'lambda)
- (let ((newform (byte-compile-unfold-lambda form)))
- (if (eq newform form)
- ;; Some error occurred, avoid infinite recursion
- form
- (byte-optimize-form-code-walker newform for-effect))))
- ((eq (car-safe fn) 'closure) form)
((memq fn '(let let*))
;; recursively enter the optimizer for the bindings and body
;; of a let or let*. This for depth-firstness: forms that
@@ -444,13 +437,6 @@
;; will be optimized away in the lap-optimize pass.
(cons fn (byte-optimize-body (cdr form) for-effect)))
- ((eq fn 'with-output-to-temp-buffer)
- ;; this is just like the above, except for the first argument.
- (cons fn
- (cons
- (byte-optimize-form (nth 1 form) nil)
- (byte-optimize-body (cdr (cdr form)) for-effect))))
-
((eq fn 'if)
(when (< (length form) 3)
(byte-compile-warn "too few arguments for `if'"))
@@ -480,6 +466,13 @@
backwards)))))
(cons fn (mapcar 'byte-optimize-form (cdr form)))))
+ ((eq fn 'while)
+ (unless (consp (cdr form))
+ (byte-compile-warn "too few arguments for `while'"))
+ (cons fn
+ (cons (byte-optimize-form (cadr form) nil)
+ (byte-optimize-body (cddr form) t))))
+
((eq fn 'interactive)
(byte-compile-warn "misplaced interactive spec: `%s'"
(prin1-to-string form))
@@ -491,15 +484,12 @@
form)
((eq fn 'condition-case)
- (if byte-compile--use-old-handlers
- ;; Will be optimized later.
- form
- `(condition-case ,(nth 1 form) ;Not evaluated.
- ,(byte-optimize-form (nth 2 form) for-effect)
- ,@(mapcar (lambda (clause)
- `(,(car clause)
- ,@(byte-optimize-body (cdr clause) for-effect)))
- (nthcdr 3 form)))))
+ `(condition-case ,(nth 1 form) ;Not evaluated.
+ ,(byte-optimize-form (nth 2 form) for-effect)
+ ,@(mapcar (lambda (clause)
+ `(,(car clause)
+ ,@(byte-optimize-body (cdr clause) for-effect)))
+ (nthcdr 3 form))))
((eq fn 'unwind-protect)
;; the "protected" part of an unwind-protect is compiled (and thus
@@ -514,12 +504,7 @@
((eq fn 'catch)
(cons fn
(cons (byte-optimize-form (nth 1 form) nil)
- (if byte-compile--use-old-handlers
- ;; The body of a catch is compiled (and thus
- ;; optimized) as a top-level form, so don't do it
- ;; here.
- (cdr (cdr form))
- (byte-optimize-body (cdr form) for-effect)))))
+ (byte-optimize-body (cdr form) for-effect))))
((eq fn 'ignore)
;; Don't treat the args to `ignore' as being
@@ -531,6 +516,15 @@
;; Needed as long as we run byte-optimize-form after cconv.
((eq fn 'internal-make-closure) form)
+ ((eq (car-safe fn) 'lambda)
+ (let ((newform (byte-compile-unfold-lambda form)))
+ (if (eq newform form)
+ ;; Some error occurred, avoid infinite recursion
+ form
+ (byte-optimize-form newform for-effect))))
+
+ ((eq (car-safe fn) 'closure) form)
+
((byte-code-function-p fn)
(cons fn (mapcar #'byte-optimize-form (cdr form))))
@@ -555,20 +549,10 @@
;; Otherwise, no args can be considered to be for-effect,
;; even if the called function is for-effect, because we
;; don't know anything about that function.
- (let ((args (mapcar #'byte-optimize-form (cdr form))))
- (if (and (get fn 'pure)
- (byte-optimize-all-constp args))
- (list 'quote (apply fn (mapcar #'eval args)))
- (cons fn args)))))))
-
-(defun byte-optimize-all-constp (list)
- "Non-nil if all elements of LIST satisfy `macroexp-const-p'."
- (let ((constant t))
- (while (and list constant)
- (unless (macroexp-const-p (car list))
- (setq constant nil))
- (setq list (cdr list)))
- constant))
+ (let ((form (cons fn (mapcar #'byte-optimize-form (cdr form)))))
+ (if (get fn 'pure)
+ (byte-optimize-constant-args form)
+ form))))))
(defun byte-optimize-form (form &optional for-effect)
"The source-level pass of the optimizer."
@@ -664,45 +648,36 @@
(setq args (cons (car rest) args)))
(setq rest (cdr rest)))
(if (cdr constants)
- (if args
- (list (car form)
- (apply (car form) constants)
- (if (cdr args)
- (cons (car form) (nreverse args))
- (car args)))
- (apply (car form) constants))
- form)))
+ (let ((const (apply (car form) (nreverse constants))))
+ (if args
+ (append (list (car form) const)
+ (nreverse args))
+ const))
+ form)))
-;; Portable Emacs integers fall in this range.
-(defconst byte-opt--portable-max #x1fffffff)
-(defconst byte-opt--portable-min (- -1 byte-opt--portable-max))
-
-;; True if N is a number that works the same on all Emacs platforms.
-;; Portable Emacs fixnums are exactly representable as floats on all
-;; Emacs platforms, and (except for -0.0) any floating-point number
-;; that equals one of these integers must be the same on all
-;; platforms. Although other floating-point numbers such as 0.5 are
-;; also portable, it can be tricky to characterize them portably so
-;; they are not optimized.
-(defun byte-opt--portable-numberp (n)
- (and (numberp n)
- (<= byte-opt--portable-min n byte-opt--portable-max)
- (= n (floor n))
- (not (and (floatp n) (zerop n)
- (condition-case () (< (/ n) 0) (error))))))
-
-;; Use OP to reduce any leading prefix of portable numbers in the list
-;; (cons ACCUM ARGS) down to a single portable number, and return the
+(defun byte-optimize-min-max (form)
+ "Optimize `min' and `max'."
+ (let ((opt (byte-optimize-associative-math form)))
+ (if (and (consp opt) (memq (car opt) '(min max))
+ (= (length opt) 4))
+ ;; (OP x y z) -> (OP (OP x y) z), in order to use binary byte ops.
+ (list (car opt)
+ (list (car opt) (nth 1 opt) (nth 2 opt))
+ (nth 3 opt))
+ opt)))
+
+;; Use OP to reduce any leading prefix of constant numbers in the list
+;; (cons ACCUM ARGS) down to a single number, and return the
;; resulting list A of arguments. The idea is that applying OP to A
;; is equivalent to (but likely more efficient than) applying OP to
;; (cons ACCUM ARGS), on any Emacs platform. Do not make any special
;; provision for (- X) or (/ X); for example, it is the caller’s
;; responsibility that (- 1 0) should not be "optimized" to (- 1).
(defun byte-opt--arith-reduce (op accum args)
- (when (byte-opt--portable-numberp accum)
+ (when (numberp accum)
(let (accum1)
- (while (and (byte-opt--portable-numberp (car args))
- (byte-opt--portable-numberp
+ (while (and (numberp (car args))
+ (numberp
(setq accum1 (condition-case ()
(funcall op accum (car args))
(error))))
@@ -725,6 +700,9 @@
(integer (if integer-is-first arg1 arg2))
(other (if integer-is-first arg2 arg1)))
(list (if (eq integer 1) '1+ '1-) other)))
+ ;; (+ x y z) -> (+ (+ x y) z)
+ ((= (length args) 3)
+ `(+ ,(byte-optimize-plus `(+ ,(car args) ,(cadr args))) ,@(cddr args)))
;; not further optimized
((equal args (cdr form)) form)
(t (cons '+ args)))))
@@ -747,35 +725,19 @@
;; (- x -1) --> (1+ x)
((equal (cdr args) '(-1))
(list '1+ (car args)))
- ;; (- n) -> -n, where n and -n are portable numbers.
+ ;; (- n) -> -n, where n and -n are constant numbers.
;; This must be done separately since byte-opt--arith-reduce
;; is not applied to (- n).
((and (null (cdr args))
- (byte-opt--portable-numberp (car args))
- (byte-opt--portable-numberp (- (car args))))
+ (numberp (car args)))
(- (car args)))
+ ;; (- x y z) -> (- (- x y) z)
+ ((= (length args) 3)
+ `(- ,(byte-optimize-minus `(- ,(car args) ,(cadr args))) ,@(cddr args)))
;; not further optimized
((equal args (cdr form)) form)
(t (cons '- args))))))
-(defun byte-optimize-1+ (form)
- (let ((args (cdr form)))
- (when (null (cdr args))
- (let ((n (car args)))
- (when (and (byte-opt--portable-numberp n)
- (byte-opt--portable-numberp (1+ n)))
- (setq form (1+ n))))))
- form)
-
-(defun byte-optimize-1- (form)
- (let ((args (cdr form)))
- (when (null (cdr args))
- (let ((n (car args)))
- (when (and (byte-opt--portable-numberp n)
- (byte-opt--portable-numberp (1- n)))
- (setq form (1- n))))))
- form)
-
(defun byte-optimize-multiply (form)
(let* ((args (remq 1 (byte-opt--arith-reduce #'* 1 (cdr form)))))
(cond
@@ -783,6 +745,10 @@
((null args) 1)
;; (* n) -> n, where n is a number
((and (null (cdr args)) (numberp (car args))) (car args))
+ ;; (* x y z) -> (* (* x y) z)
+ ((= (length args) 3)
+ `(* ,(byte-optimize-multiply `(* ,(car args) ,(cadr args)))
+ ,@(cddr args)))
;; not further optimized
((equal args (cdr form)) form)
(t (cons '* args)))))
@@ -811,10 +777,10 @@
(condition-case ()
(list 'quote (eval form))
(error form)))
- (t ;; This can enable some lapcode optimizations.
+ (t ;; Moving the constant to the end can enable some lapcode optimizations.
(list (car form) (nth 2 form) (nth 1 form)))))
-(defun byte-optimize-predicate (form)
+(defun byte-optimize-constant-args (form)
(let ((ok t)
(rest (cdr form)))
(while (and rest ok)
@@ -829,9 +795,6 @@
(defun byte-optimize-identity (form)
(if (and (cdr form) (null (cdr (cdr form))))
(nth 1 form)
- (byte-compile-warn "identity called with %d arg%s, but requires 1"
- (length (cdr form))
- (if (= 1 (length (cdr form))) "" "s"))
form))
(defun byte-optimize--constant-symbol-p (expr)
@@ -864,21 +827,27 @@
;; Arity errors reported elsewhere.
form))
+(defun byte-optimize-assoc (form)
+ ;; Replace 2-argument `assoc' with `assq', `rassoc' with `rassq',
+ ;; if the first arg is a symbol.
+ (if (and (= (length form) 3)
+ (byte-optimize--constant-symbol-p (nth 1 form)))
+ (cons (if (eq (car form) 'assoc) 'assq 'rassq)
+ (cdr form))
+ form))
+
(defun byte-optimize-memq (form)
;; (memq foo '(bar)) => (and (eq foo 'bar) '(bar))
- (if (/= (length (cdr form)) 2)
- (byte-compile-warn "memq called with %d arg%s, but requires 2"
- (length (cdr form))
- (if (= 1 (length (cdr form))) "" "s"))
- (let ((list (nth 2 form)))
- (when (and (eq (car-safe list) 'quote)
+ (if (= (length (cdr form)) 2)
+ (let ((list (nth 2 form)))
+ (if (and (eq (car-safe list) 'quote)
(listp (setq list (cadr list)))
(= (length list) 1))
- (setq form (byte-optimize-and
- `(and ,(byte-optimize-predicate
- `(eq ,(nth 1 form) ',(nth 0 list)))
- ',list)))))
- (byte-optimize-predicate form)))
+ `(and (eq ,(nth 1 form) ',(nth 0 list))
+ ',list)
+ form))
+ ;; Arity errors reported elsewhere.
+ form))
(defun byte-optimize-concat (form)
"Merge adjacent constant arguments to `concat'."
@@ -907,58 +876,34 @@
form ; No improvement.
(cons 'concat (nreverse newargs)))))
-(put 'identity 'byte-optimizer 'byte-optimize-identity)
-(put 'memq 'byte-optimizer 'byte-optimize-memq)
-(put 'memql 'byte-optimizer 'byte-optimize-member)
-(put 'member 'byte-optimizer 'byte-optimize-member)
-
-(put '+ 'byte-optimizer 'byte-optimize-plus)
-(put '* 'byte-optimizer 'byte-optimize-multiply)
-(put '- 'byte-optimizer 'byte-optimize-minus)
-(put '/ 'byte-optimizer 'byte-optimize-divide)
-(put 'max 'byte-optimizer 'byte-optimize-associative-math)
-(put 'min 'byte-optimizer 'byte-optimize-associative-math)
-
-(put '= 'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'eq 'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'eql 'byte-optimizer 'byte-optimize-equal)
-(put 'equal 'byte-optimizer 'byte-optimize-equal)
-(put 'string= 'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'string-equal 'byte-optimizer 'byte-optimize-binary-predicate)
-
-(put '< 'byte-optimizer 'byte-optimize-predicate)
-(put '> 'byte-optimizer 'byte-optimize-predicate)
-(put '<= 'byte-optimizer 'byte-optimize-predicate)
-(put '>= 'byte-optimizer 'byte-optimize-predicate)
-(put '1+ 'byte-optimizer 'byte-optimize-1+)
-(put '1- 'byte-optimizer 'byte-optimize-1-)
-(put 'not 'byte-optimizer 'byte-optimize-predicate)
-(put 'null 'byte-optimizer 'byte-optimize-predicate)
-(put 'consp 'byte-optimizer 'byte-optimize-predicate)
-(put 'listp 'byte-optimizer 'byte-optimize-predicate)
-(put 'symbolp 'byte-optimizer 'byte-optimize-predicate)
-(put 'stringp 'byte-optimizer 'byte-optimize-predicate)
-(put 'string< 'byte-optimizer 'byte-optimize-predicate)
-(put 'string-lessp 'byte-optimizer 'byte-optimize-predicate)
-(put 'proper-list-p 'byte-optimizer 'byte-optimize-predicate)
-
-(put 'logand 'byte-optimizer 'byte-optimize-predicate)
-(put 'logior 'byte-optimizer 'byte-optimize-predicate)
-(put 'logxor 'byte-optimizer 'byte-optimize-predicate)
-(put 'lognot 'byte-optimizer 'byte-optimize-predicate)
-
-(put 'car 'byte-optimizer 'byte-optimize-predicate)
-(put 'cdr 'byte-optimizer 'byte-optimize-predicate)
-(put 'car-safe 'byte-optimizer 'byte-optimize-predicate)
-(put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate)
-
-(put 'concat 'byte-optimizer 'byte-optimize-concat)
+(put 'identity 'byte-optimizer #'byte-optimize-identity)
+(put 'memq 'byte-optimizer #'byte-optimize-memq)
+(put 'memql 'byte-optimizer #'byte-optimize-member)
+(put 'member 'byte-optimizer #'byte-optimize-member)
+(put 'assoc 'byte-optimizer #'byte-optimize-assoc)
+(put 'rassoc 'byte-optimizer #'byte-optimize-assoc)
+
+(put '+ 'byte-optimizer #'byte-optimize-plus)
+(put '* 'byte-optimizer #'byte-optimize-multiply)
+(put '- 'byte-optimizer #'byte-optimize-minus)
+(put '/ 'byte-optimizer #'byte-optimize-divide)
+(put 'max 'byte-optimizer #'byte-optimize-min-max)
+(put 'min 'byte-optimizer #'byte-optimize-min-max)
+
+(put '= 'byte-optimizer #'byte-optimize-binary-predicate)
+(put 'eq 'byte-optimizer #'byte-optimize-binary-predicate)
+(put 'eql 'byte-optimizer #'byte-optimize-equal)
+(put 'equal 'byte-optimizer #'byte-optimize-equal)
+(put 'string= 'byte-optimizer #'byte-optimize-binary-predicate)
+(put 'string-equal 'byte-optimizer #'byte-optimize-binary-predicate)
+
+(put 'concat 'byte-optimizer #'byte-optimize-concat)
;; I'm not convinced that this is necessary. Doesn't the optimizer loop
;; take care of this? - Jamie
;; I think this may some times be necessary to reduce ie (quote 5) to 5,
;; so arithmetic optimizers recognize the numeric constant. - Hallvard
-(put 'quote 'byte-optimizer 'byte-optimize-quote)
+(put 'quote 'byte-optimizer #'byte-optimize-quote)
(defun byte-optimize-quote (form)
(if (or (consp (nth 1 form))
(and (symbolp (nth 1 form))
@@ -981,7 +926,7 @@
nil))
((null (cdr (cdr form)))
(nth 1 form))
- ((byte-optimize-predicate form))))
+ ((byte-optimize-constant-args form))))
(defun byte-optimize-or (form)
;; Throw away nil's, and simplify if less than 2 args.
@@ -994,7 +939,7 @@
(setq form (copy-sequence form)
rest (setcdr (memq (car rest) form) nil))))
(if (cdr (cdr form))
- (byte-optimize-predicate form)
+ (byte-optimize-constant-args form)
(nth 1 form))))
(defun byte-optimize-cond (form)
@@ -1076,16 +1021,16 @@
(if (nth 1 form)
form))
-(put 'and 'byte-optimizer 'byte-optimize-and)
-(put 'or 'byte-optimizer 'byte-optimize-or)
-(put 'cond 'byte-optimizer 'byte-optimize-cond)
-(put 'if 'byte-optimizer 'byte-optimize-if)
-(put 'while 'byte-optimizer 'byte-optimize-while)
+(put 'and 'byte-optimizer #'byte-optimize-and)
+(put 'or 'byte-optimizer #'byte-optimize-or)
+(put 'cond 'byte-optimizer #'byte-optimize-cond)
+(put 'if 'byte-optimizer #'byte-optimize-if)
+(put 'while 'byte-optimizer #'byte-optimize-while)
;; byte-compile-negation-optimizer lives in bytecomp.el
-(put '/= 'byte-optimizer 'byte-compile-negation-optimizer)
-(put 'atom 'byte-optimizer 'byte-compile-negation-optimizer)
-(put 'nlistp 'byte-optimizer 'byte-compile-negation-optimizer)
+(put '/= 'byte-optimizer #'byte-compile-negation-optimizer)
+(put 'atom 'byte-optimizer #'byte-compile-negation-optimizer)
+(put 'nlistp 'byte-optimizer #'byte-compile-negation-optimizer)
(defun byte-optimize-funcall (form)
@@ -1099,26 +1044,29 @@
(defun byte-optimize-apply (form)
;; If the last arg is a literal constant, turn this into a funcall.
;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...).
- (let ((fn (nth 1 form))
- (last (nth (1- (length form)) form))) ; I think this really is fastest
- (or (if (or (null last)
- (eq (car-safe last) 'quote))
- (if (listp (nth 1 last))
- (let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
- (nconc (list 'funcall fn) butlast
- (mapcar (lambda (x) (list 'quote x)) (nth 1 last))))
- (byte-compile-warn
- "last arg to apply can't be a literal atom: `%s'"
- (prin1-to-string last))
- nil))
- form)))
-
-(put 'funcall 'byte-optimizer 'byte-optimize-funcall)
-(put 'apply 'byte-optimizer 'byte-optimize-apply)
-
-
-(put 'let 'byte-optimizer 'byte-optimize-letX)
-(put 'let* 'byte-optimizer 'byte-optimize-letX)
+ (if (= (length form) 2)
+ ;; single-argument `apply' is not worth optimizing (bug#40968)
+ form
+ (let ((fn (nth 1 form))
+ (last (nth (1- (length form)) form))) ; I think this really is fastest
+ (or (if (or (null last)
+ (eq (car-safe last) 'quote))
+ (if (listp (nth 1 last))
+ (let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
+ (nconc (list 'funcall fn) butlast
+ (mapcar (lambda (x) (list 'quote x)) (nth 1 last))))
+ (byte-compile-warn
+ "last arg to apply can't be a literal atom: `%s'"
+ (prin1-to-string last))
+ nil))
+ form))))
+
+(put 'funcall 'byte-optimizer #'byte-optimize-funcall)
+(put 'apply 'byte-optimizer #'byte-optimize-apply)
+
+
+(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
@@ -1134,17 +1082,17 @@
(list 'let* (reverse (cdr binds)) (nth 1 (car binds)) nil)))))
-(put 'nth 'byte-optimizer 'byte-optimize-nth)
+(put 'nth 'byte-optimizer #'byte-optimize-nth)
(defun byte-optimize-nth (form)
(if (= (safe-length form) 3)
(if (memq (nth 1 form) '(0 1))
(list 'car (if (zerop (nth 1 form))
(nth 2 form)
(list 'cdr (nth 2 form))))
- (byte-optimize-predicate form))
+ form)
form))
-(put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr)
+(put 'nthcdr 'byte-optimizer #'byte-optimize-nthcdr)
(defun byte-optimize-nthcdr (form)
(if (= (safe-length form) 3)
(if (memq (nth 1 form) '(0 1 2))
@@ -1153,14 +1101,14 @@
(while (>= (setq count (1- count)) 0)
(setq form (list 'cdr form)))
form)
- (byte-optimize-predicate form))
+ 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.
-(put 'set 'byte-optimizer 'byte-optimize-set)
+(put 'set 'byte-optimizer #'byte-optimize-set)
(defun byte-optimize-set (form)
(let ((var (car-safe (cdr-safe form))))
(cond
@@ -1220,15 +1168,16 @@
length line-beginning-position line-end-position
local-variable-if-set-p local-variable-p locale-info
log log10 logand logb logcount logior lognot logxor lsh
- make-list make-string make-symbol marker-buffer max member memq min
- minibuffer-selected-window minibuffer-window
+ make-byte-code make-list make-string make-symbol marker-buffer max
+ member memq 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
prefix-numeric-value previous-window prin1-to-string propertize
degrees-to-radians
radians-to-degrees rassq rassoc read-from-string regexp-quote
region-beginning region-end reverse round
- sin sqrt string string< string= string-equal string-lessp string-to-char
+ sin sqrt string string< string= string-equal string-lessp
+ string-search string-to-char
string-to-number substring
sxhash sxhash-equal sxhash-eq sxhash-eql
symbol-function symbol-name symbol-plist symbol-value string-make-unibyte
@@ -1296,9 +1245,9 @@
;; Pure functions are side-effect free functions whose values depend
;; only on their arguments, not on the platform. For these functions,
;; calls with constant arguments can be evaluated at compile time.
-;; This may shift runtime errors to compile time. For example, logand
-;; is pure since its results are machine-independent, whereas ash is
-;; not pure because (ash 1 29)'s value depends on machine word size.
+;; For example, ash is pure since its results are machine-independent,
+;; whereas lsh is not pure because (lsh -1 -1)'s value depends on the
+;; fixnum range.
;;
;; When deciding whether a function is pure, do not worry about
;; mutable strings or markers, as they are so unlikely in real code
@@ -1308,9 +1257,42 @@
;; values if a marker is moved.
(let ((pure-fns
- '(% concat logand logcount logior lognot logxor
- regexp-opt regexp-quote
- string-to-char string-to-syntax symbol-name)))
+ '(concat regexp-opt regexp-quote
+ string-to-char string-to-syntax symbol-name
+ eq eql
+ = /= < <= => > min max
+ + - * / % mod abs ash 1+ 1- sqrt
+ logand logior lognot logxor logcount
+ copysign isnan ldexp float logb
+ floor ceiling round truncate
+ ffloor fceiling fround ftruncate
+ string= string-equal string< string-lessp
+ string-search
+ consp atom listp nlistp propert-list-p
+ sequencep arrayp vectorp stringp bool-vector-p hash-table-p
+ null not
+ numberp integerp floatp natnump characterp
+ integer-or-marker-p number-or-marker-p char-or-string-p
+ symbolp keywordp
+ type-of
+ identity ignore
+
+ ;; The following functions are pure up to mutation of their
+ ;; arguments. This is pure enough for the purposes of
+ ;; constant folding, but not necessarily for all kinds of
+ ;; code motion.
+ car cdr car-safe cdr-safe nth nthcdr last
+ equal
+ length safe-length
+ memq memql member
+ ;; `assoc' and `assoc-default' are excluded since they are
+ ;; impure if the test function is (consider `string-match').
+ assq rassq rassoc
+ plist-get lax-plist-get plist-member
+ aref elt
+ bool-vector-subsetp
+ bool-vector-count-population bool-vector-count-consecutive
+ )))
(while pure-fns
(put (car pure-fns) 'pure t)
(setq pure-fns (cdr pure-fns)))
@@ -1510,13 +1492,13 @@
byte-current-buffer byte-stack-ref))
(defconst byte-compile-side-effect-free-ops
- (nconc
+ (append
'(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax
byte-buffer-substring byte-string= byte-string< byte-nthcdr byte-elt
- byte-member byte-assq byte-quo byte-rem)
+ byte-member byte-assq byte-quo byte-rem byte-substring)
byte-compile-side-effect-and-error-free-ops))
;; This crock is because of the way DEFVAR_BOOL variables work.
@@ -2195,7 +2177,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
(or noninteractive (message "compiling %s...done" x)))
'(byte-optimize-form
byte-optimize-body
- byte-optimize-predicate
+ byte-optimize-constant-args
byte-optimize-binary-predicate
;; Inserted some more than necessary, to speed it up.
byte-optimize-form-code-walker
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 70fe06085dc..5279a57cd0c 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -82,65 +82,84 @@ The return value of this function is not used."
;; We define macro-declaration-alist here because it is needed to
;; handle declarations in macro definitions and this is the first file
-;; loaded by loadup.el that uses declarations in macros.
+;; loaded by loadup.el that uses declarations in macros. We specify
+;; the values as named aliases so that `describe-variable' prints
+;; something useful; cf. Bug#40491. We can only use backquotes inside
+;; the lambdas and not for those properties that are used by functions
+;; loaded before backquote.el.
+
+(defalias 'byte-run--set-advertised-calling-convention
+ #'(lambda (f _args arglist when)
+ (list 'set-advertised-calling-convention
+ (list 'quote f) (list 'quote arglist) (list 'quote when))))
+
+(defalias 'byte-run--set-obsolete
+ #'(lambda (f _args new-name when)
+ (list 'make-obsolete
+ (list 'quote f) (list 'quote new-name) (list 'quote when))))
+
+(defalias 'byte-run--set-interactive-only
+ #'(lambda (f _args instead)
+ (list 'function-put (list 'quote f)
+ ''interactive-only (list 'quote instead))))
+
+(defalias 'byte-run--set-pure
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''pure (list 'quote val))))
+
+(defalias 'byte-run--set-side-effect-free
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''side-effect-free (list 'quote val))))
+
+(defalias 'byte-run--set-compiler-macro
+ #'(lambda (f args compiler-function)
+ (if (not (eq (car-safe compiler-function) 'lambda))
+ `(eval-and-compile
+ (function-put ',f 'compiler-macro #',compiler-function))
+ (let ((cfname (intern (concat (symbol-name f) "--anon-cmacro")))
+ ;; Avoid cadr/cddr so we can use `compiler-macro' before
+ ;; defining cadr/cddr.
+ (data (cdr compiler-function)))
+ `(progn
+ (eval-and-compile
+ (function-put ',f 'compiler-macro #',cfname))
+ ;; Don't autoload the compiler-macro itself, since the
+ ;; macroexpander will find this file via `f's autoload,
+ ;; if needed.
+ :autoload-end
+ (eval-and-compile
+ (defun ,cfname (,@(car data) ,@args)
+ ,@(cdr data))))))))
+
+(defalias 'byte-run--set-doc-string
+ #'(lambda (f _args pos)
+ (list 'function-put (list 'quote f)
+ ''doc-string-elt (list 'quote pos))))
+
+(defalias 'byte-run--set-indent
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''lisp-indent-function (list 'quote val))))
;; Add any new entries to info node `(elisp)Declare Form'.
(defvar defun-declarations-alist
(list
- ;; We can only use backquotes inside the lambdas and not for those
- ;; properties that are used by functions loaded before backquote.el.
(list 'advertised-calling-convention
- #'(lambda (f _args arglist when)
- (list 'set-advertised-calling-convention
- (list 'quote f) (list 'quote arglist) (list 'quote when))))
- (list 'obsolete
- #'(lambda (f _args new-name when)
- (list 'make-obsolete
- (list 'quote f) (list 'quote new-name) (list 'quote when))))
- (list 'interactive-only
- #'(lambda (f _args instead)
- (list 'function-put (list 'quote f)
- ''interactive-only (list 'quote instead))))
+ #'byte-run--set-advertised-calling-convention)
+ (list 'obsolete #'byte-run--set-obsolete)
+ (list 'interactive-only #'byte-run--set-interactive-only)
;; FIXME: Merge `pure' and `side-effect-free'.
- (list 'pure
- #'(lambda (f _args val)
- (list 'function-put (list 'quote f)
- ''pure (list 'quote val)))
+ (list 'pure #'byte-run--set-pure
"If non-nil, the compiler can replace calls with their return value.
This may shift errors from run-time to compile-time.")
- (list 'side-effect-free
- #'(lambda (f _args val)
- (list 'function-put (list 'quote f)
- ''side-effect-free (list 'quote val)))
+ (list 'side-effect-free #'byte-run--set-side-effect-free
"If non-nil, calls can be ignored if their value is unused.
If `error-free', drop calls even if `byte-compile-delete-errors' is nil.")
- (list 'compiler-macro
- #'(lambda (f args compiler-function)
- (if (not (eq (car-safe compiler-function) 'lambda))
- `(eval-and-compile
- (function-put ',f 'compiler-macro #',compiler-function))
- (let ((cfname (intern (concat (symbol-name f) "--anon-cmacro")))
- ;; Avoid cadr/cddr so we can use `compiler-macro' before
- ;; defining cadr/cddr.
- (data (cdr compiler-function)))
- `(progn
- (eval-and-compile
- (function-put ',f 'compiler-macro #',cfname))
- ;; Don't autoload the compiler-macro itself, since the
- ;; macroexpander will find this file via `f's autoload,
- ;; if needed.
- :autoload-end
- (eval-and-compile
- (defun ,cfname (,@(car data) ,@args)
- ,@(cdr data))))))))
- (list 'doc-string
- #'(lambda (f _args pos)
- (list 'function-put (list 'quote f)
- ''doc-string-elt (list 'quote pos))))
- (list 'indent
- #'(lambda (f _args val)
- (list 'function-put (list 'quote f)
- ''lisp-indent-function (list 'quote val)))))
+ (list 'compiler-macro #'byte-run--set-compiler-macro)
+ (list 'doc-string #'byte-run--set-doc-string)
+ (list 'indent #'byte-run--set-indent))
"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,
@@ -150,18 +169,22 @@ to set this property.
This is used by `declare'.")
+(defalias 'byte-run--set-debug
+ #'(lambda (name _args spec)
+ (list 'progn :autoload-end
+ (list 'put (list 'quote name)
+ ''edebug-form-spec (list 'quote spec)))))
+
+(defalias 'byte-run--set-no-font-lock-keyword
+ #'(lambda (name _args val)
+ (list 'function-put (list 'quote name)
+ ''no-font-lock-keyword (list 'quote val))))
+
(defvar macro-declarations-alist
(cons
- (list 'debug
- #'(lambda (name _args spec)
- (list 'progn :autoload-end
- (list 'put (list 'quote name)
- ''edebug-form-spec (list 'quote spec)))))
+ (list 'debug #'byte-run--set-debug)
(cons
- (list 'no-font-lock-keyword
- #'(lambda (name _args val)
- (list 'function-put (list 'quote name)
- ''no-font-lock-keyword (list 'quote val))))
+ (list 'no-font-lock-keyword #'byte-run--set-no-font-lock-keyword)
defun-declarations-alist))
"List associating properties of macros to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is a function.
@@ -553,13 +576,26 @@ Otherwise, return nil. For internal use only."
(mapconcat (lambda (char) (format "`?\\%c'" char))
sorted ", ")))))
+(defun byte-compile-info (string &optional message type)
+ "Format STRING in a way that looks pleasing in the compilation output.
+If MESSAGE, output the message, too.
+
+If TYPE, it should be a string that says what the information
+type is. This defaults to \"INFO\"."
+ (let ((string (format " %-9s%s" (or type "INFO") string)))
+ (when message
+ (message "%s" string))
+ string))
+
(defun byte-compile-info-string (&rest args)
"Format ARGS in a way that looks pleasing in the compilation output."
- (format " %-9s%s" "INFO" (apply #'format args)))
+ (declare (obsolete byte-compile-info "28.1"))
+ (byte-compile-info (apply #'format args)))
(defun byte-compile-info-message (&rest args)
"Message format ARGS in a way that looks pleasing in the compilation output."
- (message "%s" (apply #'byte-compile-info-string args)))
+ (declare (obsolete byte-compile-info "28.1"))
+ (byte-compile-info (apply #'format args) t))
;; I nuked this because it's not a good idea for users to think of using it.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 90745a3a2f3..7c95c918009 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -719,14 +719,15 @@ otherwise pop it")
"to make a binding to record entire window configuration")
(byte-defop 140 0 byte-save-restriction
"to make a binding to record the current buffer clipping restrictions")
-(byte-defop 141 -1 byte-catch
+(byte-defop 141 -1 byte-catch-OBSOLETE ; Not generated since Emacs 25.
"for catch. Takes, on stack, the tag and an expression for the body")
(byte-defop 142 -1 byte-unwind-protect
"for unwind-protect. Takes, on stack, an expression for the unwind-action")
;; For condition-case. Takes, on stack, the variable to bind,
;; an expression for the body, and a list of clauses.
-(byte-defop 143 -2 byte-condition-case)
+;; Not generated since Emacs 25.
+(byte-defop 143 -2 byte-condition-case-OBSOLETE)
(byte-defop 144 0 byte-temp-output-buffer-setup-OBSOLETE)
(byte-defop 145 -1 byte-temp-output-buffer-show-OBSOLETE)
@@ -1201,7 +1202,7 @@ message buffer `default-directory'."
byte-compile-last-warned-form))))
(insert (format "\nIn %s:\n" form)))
(when level
- (insert (format "%s%s" file pos))))
+ (insert (format "%s%s " file pos))))
(setq byte-compile-last-logged-file byte-compile-current-file
byte-compile-last-warned-form byte-compile-current-form)
entry)
@@ -2007,7 +2008,7 @@ The value is non-nil if there were no errors, nil if errors."
(delete-file tempfile)))
kill-emacs-hook)))
(unless (= temp-modes desired-modes)
- (set-file-modes tempfile 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
@@ -2139,55 +2140,13 @@ With argument ARG, insert value in current buffer after the form."
;; Make warnings about unresolved functions
;; give the end of the file as their position.
(setq byte-compile-last-position (point-max))
- (byte-compile-warn-about-unresolved-functions))
- ;; Fix up the header at the front of the output
- ;; if the buffer contains multibyte characters.
- (and byte-compile-current-file
- (with-current-buffer byte-compile--outbuffer
- (byte-compile-fix-header byte-compile-current-file))))
+ (byte-compile-warn-about-unresolved-functions)))
byte-compile--outbuffer)))
-(defun byte-compile-fix-header (_filename)
- "If the current buffer has any multibyte characters, insert a version test."
- (when (< (point-max) (position-bytes (point-max)))
- (goto-char (point-min))
- ;; Find the comment that describes the version condition.
- (search-forward "\n;;; This file uses")
- (narrow-to-region (line-beginning-position) (point-max))
- ;; Find the first line of ballast semicolons.
- (search-forward ";;;;;;;;;;")
- (beginning-of-line)
- (narrow-to-region (point-min) (point))
- (let ((old-header-end (point))
- (minimum-version "23")
- delta)
- (delete-region (point-min) (point-max))
- (insert
- ";;; This file contains utf-8 non-ASCII characters,\n"
- ";;; and so cannot be loaded into Emacs 22 or earlier.\n"
- ;; Have to check if emacs-version is bound so that this works
- ;; in files loaded early in loadup.el.
- "(and (boundp 'emacs-version)\n"
- ;; If there is a name at the end of emacs-version,
- ;; don't try to check the version number.
- " (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
- (format " (string-lessp emacs-version \"%s\")\n" minimum-version)
- ;; Because the header must fit in a fixed width, we cannot
- ;; insert arbitrary-length file names (Bug#11585).
- " (error \"`%s' was compiled for "
- (format "Emacs %s or later\" #$))\n\n" minimum-version))
- ;; Now compensate for any change in size, to make sure all
- ;; positions in the file remain valid.
- (setq delta (- (point-max) old-header-end))
- (goto-char (point-max))
- (widen)
- (delete-char delta))))
-
(defun byte-compile-insert-header (_filename outbuffer)
"Insert a header at the start of OUTBUFFER.
Call from the source buffer."
- (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
- (dynamic byte-compile-dynamic)
+ (let ((dynamic byte-compile-dynamic)
(optimize byte-optimize))
(with-current-buffer outbuffer
(goto-char (point-min))
@@ -2201,7 +2160,19 @@ Call from the source buffer."
;; 0 string ;ELC GNU Emacs Lisp compiled file,
;; >4 byte x version %d
(insert
- ";ELC" 23 "\000\000\000\n"
+ ";ELC"
+ (let ((version
+ (if (zerop emacs-minor-version)
+ ;; Let's allow silently loading into Emacs-27
+ ;; files compiled with Emacs-28.0.NN since the two can
+ ;; be almost identical (e.g. right after cutting the
+ ;; release branch) and people running the development
+ ;; branch can be presumed to know that it's risky anyway.
+ (1- emacs-major-version) emacs-major-version)))
+ ;; Make sure the version is a plain byte that doesn't end the comment!
+ (cl-assert (and (> version 13) (< version 128)))
+ version)
+ "\000\000\000\n"
";;; Compiled\n"
";;; in Emacs version " emacs-version "\n"
";;; with"
@@ -2213,19 +2184,7 @@ Call from the source buffer."
".\n"
(if dynamic ";;; Function definitions are lazy-loaded.\n"
"")
- "\n;;; This file uses "
- (if dynamic-docstrings
- "dynamic docstrings, first added in Emacs 19.29"
- "opcodes that do not exist in Emacs 18")
- ".\n\n"
- ;; Note that byte-compile-fix-header may change this.
- ";;; This file does not contain utf-8 non-ASCII characters,\n"
- ";;; and so can be loaded in Emacs versions earlier than 23.\n\n"
- ;; Insert semicolons as ballast, so that byte-compile-fix-header
- ;; can delete them so as to keep the buffer positions
- ;; constant for the actual compiled code.
- ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
- ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))))
+ "\n\n"))))
(defun byte-compile-output-file-form (form)
;; Write the given form to the output buffer, being careful of docstrings
@@ -3215,7 +3174,8 @@ for symbols generated by the byte compiler itself."
(t "."))))
(if (eq (car-safe (symbol-function (car form))) 'macro)
(byte-compile-report-error
- (format "Forgot to expand macro %s in %S" (car form) form)))
+ (format "`%s' defined after use in %S (missing `require' of a library file?)"
+ (car form) form)))
(if (and handler
;; Make sure that function exists.
(and (functionp handler)
@@ -3463,7 +3423,7 @@ for symbols generated by the byte compiler itself."
(if (equal-including-properties (car elt) ,const)
(setq result elt)))
result)
- (assq ,const byte-compile-constants))
+ (assoc ,const byte-compile-constants #'eql))
(car (setq byte-compile-constants
(cons (list ,const) byte-compile-constants)))))
@@ -3491,7 +3451,7 @@ the opcode to be used. If function is a list, the first element
is the function and the second element is the bytecode-symbol.
The second element may be nil, meaning there is no opcode.
COMPILE-HANDLER is the function to use to compile this byte-op, or
-may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.
+may be the abbreviations 0, 1, 2, 2-and, 3, 0-1, 1-2, 1-3, or 2-3.
If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(let (opcode)
(if (symbolp function)
@@ -3510,6 +3470,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(0-1 . byte-compile-zero-or-one-arg)
(1-2 . byte-compile-one-or-two-args)
(2-3 . byte-compile-two-or-three-args)
+ (1-3 . byte-compile-one-to-three-args)
)))
compile-handler
(intern (concat "byte-compile-"
@@ -3620,10 +3581,10 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(byte-defop-compiler (% byte-rem) 2)
(byte-defop-compiler aset 3)
-(byte-defop-compiler max byte-compile-associative)
-(byte-defop-compiler min byte-compile-associative)
-(byte-defop-compiler (+ byte-plus) byte-compile-associative)
-(byte-defop-compiler (* byte-mult) byte-compile-associative)
+(byte-defop-compiler max byte-compile-min-max)
+(byte-defop-compiler min byte-compile-min-max)
+(byte-defop-compiler (+ byte-plus) byte-compile-variadic-numeric)
+(byte-defop-compiler (* byte-mult) byte-compile-variadic-numeric)
;;####(byte-defop-compiler move-to-column 1)
(byte-defop-compiler-1 interactive byte-compile-noop)
@@ -3694,6 +3655,13 @@ These implicitly `and' together a bunch of two-arg bytecodes."
((= len 4) (byte-compile-three-args form))
(t (byte-compile-subr-wrong-args form "2-3")))))
+(defun byte-compile-one-to-three-args (form)
+ (let ((len (length form)))
+ (cond ((= len 2) (byte-compile-three-args (append form '(nil nil))))
+ ((= len 3) (byte-compile-three-args (append form '(nil))))
+ ((= len 4) (byte-compile-three-args form))
+ (t (byte-compile-subr-wrong-args form "1-3")))))
+
(defun byte-compile-noop (_form)
(byte-compile-constant nil))
@@ -3763,30 +3731,36 @@ discarding."
(if byte-compile--for-effect (setq byte-compile--for-effect nil)
(byte-compile-out 'byte-constant (nth 1 form))))
-;; Compile a function that accepts one or more args and is right-associative.
-;; We do it by left-associativity so that the operations
-;; are done in the same order as in interpreted code.
-;; We treat the one-arg case, as in (+ x), like (+ x 0).
-;; in order to convert markers to numbers, and trigger expected errors.
-(defun byte-compile-associative (form)
+;; Compile a pure function that accepts zero or more numeric arguments
+;; and has an opcode for the binary case.
+;; Single-argument calls are assumed to be numeric identity and are
+;; compiled as (* x 1) in order to convert markers to numbers and
+;; trigger type errors.
+(defun byte-compile-variadic-numeric (form)
+ (pcase (length form)
+ (1
+ ;; No args: use the identity value for the operation.
+ (byte-compile-constant (eval form)))
+ (2
+ ;; One arg: compile (OP x) as (* x 1). This is identity for
+ ;; all numerical values including -0.0, infinities and NaNs.
+ (byte-compile-form (nth 1 form))
+ (byte-compile-constant 1)
+ (byte-compile-out (get '* 'byte-opcode) 0))
+ (3
+ (byte-compile-form (nth 1 form))
+ (byte-compile-form (nth 2 form))
+ (byte-compile-out (get (car form) 'byte-opcode) 0))
+ (_
+ ;; >2 args: compile as a single function call.
+ (byte-compile-normal-call form))))
+
+(defun byte-compile-min-max (form)
+ "Byte-compile calls to `min' or `max'."
(if (cdr form)
- (let ((opcode (get (car form) 'byte-opcode))
- args)
- (if (and (< 3 (length form))
- (memq opcode (list (get '+ 'byte-opcode)
- (get '* 'byte-opcode))))
- ;; Don't use binary operations for > 2 operands, as that
- ;; may cause overflow/truncation in float operations.
- (byte-compile-normal-call form)
- (setq args (copy-sequence (cdr form)))
- (byte-compile-form (car args))
- (setq args (cdr args))
- (or args (setq args '(0)
- opcode (get '+ 'byte-opcode)))
- (dolist (arg args)
- (byte-compile-form arg)
- (byte-compile-out opcode 0))))
- (byte-compile-constant (eval form))))
+ (byte-compile-variadic-numeric form)
+ ;; No args: warn and emit code that raises an error when executed.
+ (byte-compile-normal-call form)))
;; more complicated compiler macros
@@ -3801,7 +3775,7 @@ discarding."
(byte-defop-compiler indent-to)
(byte-defop-compiler insert)
(byte-defop-compiler-1 function byte-compile-function-form)
-(byte-defop-compiler-1 - byte-compile-minus)
+(byte-defop-compiler (- byte-diff) byte-compile-minus)
(byte-defop-compiler (/ byte-quo) byte-compile-quo)
(byte-defop-compiler nconc)
@@ -3868,30 +3842,17 @@ discarding."
((byte-compile-normal-call form)))))
(defun byte-compile-minus (form)
- (let ((len (length form)))
- (cond
- ((= 1 len) (byte-compile-constant 0))
- ((= 2 len)
- (byte-compile-form (cadr form))
- (byte-compile-out 'byte-negate 0))
- ((= 3 len)
- (byte-compile-form (nth 1 form))
- (byte-compile-form (nth 2 form))
- (byte-compile-out 'byte-diff 0))
- ;; Don't use binary operations for > 2 operands, as that may
- ;; cause overflow/truncation in float operations.
- (t (byte-compile-normal-call form)))))
+ (if (/= (length form) 2)
+ (byte-compile-variadic-numeric form)
+ (byte-compile-form (cadr form))
+ (byte-compile-out 'byte-negate 0)))
(defun byte-compile-quo (form)
- (let ((len (length form)))
- (cond ((< len 2)
- (byte-compile-subr-wrong-args form "1 or more"))
- ((= len 3)
- (byte-compile-two-args form))
- (t
- ;; Don't use binary operations for > 2 operands, as that
- ;; may cause overflow/truncation in float operations.
- (byte-compile-normal-call form)))))
+ (if (= (length form) 3)
+ (byte-compile-two-args form)
+ ;; N-ary `/' is not the left-reduction of binary `/' because if any
+ ;; argument is a float, then everything is done in floating-point.
+ (byte-compile-normal-call form)))
(defun byte-compile-nconc (form)
(let ((len (length form)))
@@ -4534,96 +4495,25 @@ binding slots have been popped."
;; (byte-defop-compiler-1 save-window-excursion) ;Obsolete: now a macro.
;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro.
-(defvar byte-compile--use-old-handlers nil
- "If nil, use new byte codes introduced in Emacs-24.4.")
-
(defun byte-compile-catch (form)
(byte-compile-form (car (cdr form)))
- (if (not byte-compile--use-old-handlers)
- (let ((endtag (byte-compile-make-tag)))
- (byte-compile-goto 'byte-pushcatch endtag)
- (byte-compile-body (cddr form) nil)
- (byte-compile-out 'byte-pophandler)
- (byte-compile-out-tag endtag))
- (pcase (cddr form)
- (`(:fun-body ,f)
- (byte-compile-form `(list 'funcall ,f)))
- (body
- (byte-compile-push-constant
- (byte-compile-top-level (cons 'progn body) byte-compile--for-effect))))
- (byte-compile-out 'byte-catch 0)))
+ (let ((endtag (byte-compile-make-tag)))
+ (byte-compile-goto 'byte-pushcatch endtag)
+ (byte-compile-body (cddr form) nil)
+ (byte-compile-out 'byte-pophandler)
+ (byte-compile-out-tag endtag)))
(defun byte-compile-unwind-protect (form)
(pcase (cddr form)
(`(:fun-body ,f)
- (byte-compile-form
- (if byte-compile--use-old-handlers `(list (list 'funcall ,f)) f)))
+ (byte-compile-form f))
(handlers
- (if byte-compile--use-old-handlers
- (byte-compile-push-constant
- (byte-compile-top-level-body handlers t))
- (byte-compile-form `#'(lambda () ,@handlers)))))
+ (byte-compile-form `#'(lambda () ,@handlers))))
(byte-compile-out 'byte-unwind-protect 0)
(byte-compile-form-do-effect (car (cdr form)))
(byte-compile-out 'byte-unbind 1))
(defun byte-compile-condition-case (form)
- (if byte-compile--use-old-handlers
- (byte-compile-condition-case--old form)
- (byte-compile-condition-case--new form)))
-
-(defun byte-compile-condition-case--old (form)
- (let* ((var (nth 1 form))
- (fun-bodies (eq var :fun-body))
- (byte-compile-bound-variables
- (if (and var (not fun-bodies))
- (cons var byte-compile-bound-variables)
- byte-compile-bound-variables)))
- (byte-compile-set-symbol-position 'condition-case)
- (unless (symbolp var)
- (byte-compile-warn
- "`%s' is not a variable-name or nil (in condition-case)" var))
- (if fun-bodies (setq var (make-symbol "err")))
- (byte-compile-push-constant var)
- (if fun-bodies
- (byte-compile-form `(list 'funcall ,(nth 2 form)))
- (byte-compile-push-constant
- (byte-compile-top-level (nth 2 form) byte-compile--for-effect)))
- (let ((compiled-clauses
- (mapcar
- (lambda (clause)
- (let ((condition (car clause)))
- (cond ((not (or (symbolp condition)
- (and (listp condition)
- (let ((ok t))
- (dolist (sym condition)
- (if (not (symbolp sym))
- (setq ok nil)))
- ok))))
- (byte-compile-warn
- "`%S' is not a condition name or list of such (in condition-case)"
- condition))
- ;; (not (or (eq condition 't)
- ;; (and (stringp (get condition 'error-message))
- ;; (consp (get condition
- ;; 'error-conditions)))))
- ;; (byte-compile-warn
- ;; "`%s' is not a known condition name
- ;; (in condition-case)"
- ;; condition))
- )
- (if fun-bodies
- `(list ',condition (list 'funcall ,(cadr clause) ',var))
- (cons condition
- (byte-compile-top-level-body
- (cdr clause) byte-compile--for-effect)))))
- (cdr (cdr (cdr form))))))
- (if fun-bodies
- (byte-compile-form `(list ,@compiled-clauses))
- (byte-compile-push-constant compiled-clauses)))
- (byte-compile-out 'byte-condition-case 0)))
-
-(defun byte-compile-condition-case--new (form)
(let* ((var (nth 1 form))
(body (nth 2 form))
(depth byte-compile-depth)
@@ -4861,6 +4751,14 @@ binding slots have been popped."
(defun byte-compile-form-make-variable-buffer-local (form)
(byte-compile-keep-pending form 'byte-compile-normal-call))
+;; Make `make-local-variable' declare the variable locally
+;; dynamic - this suppresses some unnecessary warnings
+(byte-defop-compiler-1 make-local-variable
+ byte-compile-make-local-variable)
+(defun byte-compile-make-local-variable (form)
+ (pcase form (`(,_ ',var) (byte-compile--declare-var var)))
+ (byte-compile-normal-call form))
+
(put 'function-put 'byte-hunk-handler 'byte-compile-define-symbol-prop)
(put 'define-symbol-prop 'byte-hunk-handler 'byte-compile-define-symbol-prop)
(defun byte-compile-define-symbol-prop (form)
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index e2e59337d7b..351a097ad19 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -462,20 +462,7 @@ places where they originally did not directly appear."
;; and may be an invalid expression (e.g. ($# . 678)).
(cdr forms)))))
- ;condition-case
- ((and `(condition-case ,var ,protected-form . ,handlers)
- (guard byte-compile--use-old-handlers))
- (let ((newform (cconv--convert-function
- () (list protected-form) env form)))
- `(condition-case :fun-body ,newform
- ,@(mapcar (lambda (handler)
- (list (car handler)
- (cconv--convert-function
- (list (or var cconv--dummy-var))
- (cdr handler) env form)))
- handlers))))
-
- ; condition-case with new byte-codes.
+ ; condition-case
(`(condition-case ,var ,protected-form . ,handlers)
`(condition-case ,var
,(cconv-convert protected-form env extend)
@@ -496,10 +483,8 @@ places where they originally did not directly appear."
`((let ((,var (list ,var))) ,@body))))))
handlers))))
- (`(,(and head (or (and 'catch (guard byte-compile--use-old-handlers))
- 'unwind-protect))
- ,form . ,body)
- `(,head ,(cconv-convert form env extend)
+ (`(unwind-protect ,form . ,body)
+ `(unwind-protect ,(cconv-convert form env extend)
:fun-body ,(cconv--convert-function () body env form)))
(`(setq . ,forms) ; setq special form
@@ -718,15 +703,6 @@ and updates the data stored in ENV."
(`(quote . ,_) nil) ; quote form
(`(function . ,_) nil) ; same as quote
- ((and `(condition-case ,var ,protected-form . ,handlers)
- (guard byte-compile--use-old-handlers))
- ;; FIXME: The bytecode for condition-case forces us to wrap the
- ;; form and handlers in closures.
- (cconv--analyze-function () (list protected-form) env form)
- (dolist (handler handlers)
- (cconv--analyze-function (if var (list var)) (cdr handler)
- env form)))
-
(`(condition-case ,var ,protected-form . ,handlers)
(cconv-analyze-form protected-form env)
(when (and var (symbolp var) (byte-compile-not-lexical-var-p var))
@@ -741,9 +717,7 @@ and updates the data stored in ENV."
form "variable"))))
;; FIXME: The bytecode for unwind-protect forces us to wrap the unwind.
- (`(,(or (and 'catch (guard byte-compile--use-old-handlers))
- 'unwind-protect)
- ,form . ,body)
+ (`(unwind-protect ,form . ,body)
(cconv-analyze-form form env)
(cconv--analyze-function () body env form))
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index 2321ac1ed50..964836a32ac 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -105,9 +105,7 @@ Useful if new Emacs is used on B&W display.")
(car cl)
"white"))
(set-face-foreground nf "black")
- (if (and chart-face-use-pixmaps
- pl
- (fboundp 'set-face-background-pixmap))
+ (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)))))
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
index 144385ea27c..208214f2e6e 100644
--- a/lisp/emacs-lisp/check-declare.el
+++ b/lisp/emacs-lisp/check-declare.el
@@ -1,8 +1,9 @@
-;;; check-declare.el --- Check declare-function statements
+;;; check-declare.el --- Check declare-function statements -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
;; Author: Glenn Morris <rgm@gnu.org>
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp, tools, maint
;; This file is part of GNU Emacs.
@@ -248,7 +249,7 @@ TYPE is a string giving the nature of the error.
Optional LINE is the claim's line number; otherwise, search for the claim.
Display warning in `check-declare-warning-buffer'."
(let ((warning-prefix-function
- (lambda (level entry)
+ (lambda (_level entry)
(insert (format "%s:%d:" (file-relative-name file) (or line 0)))
entry))
(warning-fill-prefix " "))
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 797493743c0..23121c245ef 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -3,7 +3,7 @@
;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.6.2
+;; Old-Version: 0.6.2
;; Keywords: docs, maint, lisp
;; This file is part of GNU Emacs.
@@ -170,6 +170,7 @@
;;; 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
@@ -1248,13 +1249,8 @@ checking of documentation strings.
;;; Subst utils
;;
-(defsubst checkdoc-run-hooks (hookvar &rest args)
- "Run hooks in HOOKVAR with ARGS."
- (if (fboundp 'run-hook-with-args-until-success)
- (apply #'run-hook-with-args-until-success hookvar args)
- ;; This method was similar to above. We ignore the warning
- ;; since we will use the above for future Emacs versions
- (apply #'run-hook-with-args hookvar args)))
+(define-obsolete-function-alias 'checkdoc-run-hooks
+ #'run-hook-with-args-until-success "28.1")
(defsubst checkdoc-create-common-verbs-regexp ()
"Rebuild the contents of `checkdoc-common-verbs-regexp'."
@@ -1577,7 +1573,8 @@ mouse-[0-3]\\)\\)\\>"))
;; a prefix.
(let ((disambiguate
(completing-read
- "Disambiguating Keyword (default variable): "
+ (format-prompt "Disambiguating Keyword"
+ "variable")
'(("function") ("command") ("variable")
("option") ("symbol"))
nil t nil nil "variable")))
@@ -1872,7 +1869,7 @@ Replace with \"%s\"? " original replace)
;; and reliance on the Ispell program.
(checkdoc-ispell-docstring-engine e take-notes)
;; User supplied checks
- (save-excursion (checkdoc-run-hooks 'checkdoc-style-functions fp e))
+ (save-excursion (run-hook-with-args-until-success 'checkdoc-style-functions fp e))
;; Done!
)))
@@ -2383,7 +2380,7 @@ Code:, and others referenced in the style guide."
err
(or
;; Generic Full-file checks (should be comment related)
- (checkdoc-run-hooks 'checkdoc-comment-style-functions)
+ (run-hook-with-args-until-success 'checkdoc-comment-style-functions)
err))
;; Done with full file comment checks
err)))
@@ -2642,7 +2639,7 @@ function called to create the messages."
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert "\n\n\C-l\n*** " label ": "
- check-type " V " checkdoc-version)))))
+ check-type)))))
(defun checkdoc-error (point msg)
"Store POINT and MSG as errors in the checkdoc diagnostic buffer."
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index ce6fb625bc0..5bf74792c08 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -72,8 +72,7 @@ strings case-insensitively."
(cond ((eq x y) t)
((stringp x)
(and (stringp y) (= (length x) (length y))
- (or (string-equal x y)
- (string-equal (downcase x) (downcase y))))) ;Lazy but simple!
+ (eq (compare-strings x nil nil y nil nil t) t)))
((numberp x)
(and (numberp y) (= x y)))
((consp x)
@@ -553,10 +552,9 @@ too large if positive or too small if negative)."
(seq-subseq seq start end))
;;;###autoload
-(defun cl-concatenate (type &rest sequences)
+(defalias 'cl-concatenate #'seq-concatenate
"Concatenate, into a sequence of type TYPE, the argument SEQUENCEs.
-\n(fn TYPE SEQUENCE...)"
- (apply #'seq-concatenate type sequences))
+\n(fn TYPE SEQUENCE...)")
;;; List functions.
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 4e8423eb5b1..02da07daaf4 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -211,7 +211,16 @@ DEFAULT-BODY, if present, is used as the body of a default method.
[&rest [&or
("declare" &rest sexp)
(":argument-precedence-order" &rest sexp)
- (&define ":method" [&rest atom]
+ (&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)))
@@ -432,9 +441,8 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
(&define ; this means we are defining something
[&or name ("setf" name :name setf)]
;; ^^ This is the methods symbol
- [ &rest atom ] ; Multiple qualifiers are allowed.
- ; Like in CLOS spec, we support
- ; any non-list values.
+ [ &rest cl-generic-method-qualifier ]
+ ;; Multiple qualifiers are allowed.
cl-generic-method-args ; arguments
lambda-doc ; documentation string
def-body))) ; part to be debugged
diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
index fd8715962a3..66502da668a 100644
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -46,14 +46,12 @@
"Maximum depth to backtrack out from a sublist for structured indentation.
If this variable is 0, no backtracking will occur and forms such as `flet'
may not be correctly indented."
- :type 'integer
- :group 'lisp-indent)
+ :type 'integer)
(defcustom lisp-tag-indentation 1
"Indentation of tags relative to containing list.
This variable is used by the function `lisp-indent-tagbody'."
- :type 'integer
- :group 'lisp-indent)
+ :type 'integer)
(defcustom lisp-tag-body-indentation 3
"Indentation of non-tagged lines relative to containing list.
@@ -64,32 +62,30 @@ the special form. If the value is t, the body of tags will be indented
as a block at the same indentation as the first s-expression following
the tag. In this case, any forms before the first tag are indented
by `lisp-body-indent'."
- :type 'integer
- :group 'lisp-indent)
+ :type 'integer)
(defcustom lisp-backquote-indentation t
"Whether or not to indent backquoted lists as code.
If nil, indent backquoted lists as data, i.e., like quoted lists."
- :type 'boolean
- :group 'lisp-indent)
+ :type 'boolean)
-(defcustom lisp-loop-keyword-indentation 3
+(defcustom lisp-loop-keyword-indentation 6
"Indentation of loop keywords in extended loop forms."
:type 'integer
- :group 'lisp-indent)
+ :version "28.1")
-(defcustom lisp-loop-forms-indentation 5
+(defcustom lisp-loop-forms-indentation 6
"Indentation of forms in extended loop forms."
:type 'integer
- :group 'lisp-indent)
+ :version "28.1")
-(defcustom lisp-simple-loop-indentation 3
+(defcustom lisp-simple-loop-indentation 1
"Indentation of forms in simple loop forms."
:type 'integer
- :group 'lisp-indent)
+ :version "28.1")
(defcustom lisp-lambda-list-keyword-alignment nil
"Whether to vertically align lambda-list keywords together.
@@ -107,16 +103,14 @@ If non-nil, alignment is done with the first keyword
&key key1 key2)
#|...|#)"
:version "24.1"
- :type 'boolean
- :group 'lisp-indent)
+ :type 'boolean)
(defcustom lisp-lambda-list-keyword-parameter-indentation 2
"Indentation of lambda list keyword parameters.
See `lisp-lambda-list-keyword-parameter-alignment'
for more information."
:version "24.1"
- :type 'integer
- :group 'lisp-indent)
+ :type 'integer)
(defcustom lisp-lambda-list-keyword-parameter-alignment nil
"Whether to vertically align lambda-list keyword parameters together.
@@ -135,8 +129,7 @@ If non-nil, alignment is done with the first parameter
key3 key4)
#|...|#)"
:version "24.1"
- :type 'boolean
- :group 'lisp-indent)
+ :type 'boolean)
(defcustom lisp-indent-backquote-substitution-mode t
"How to indent substitutions in backquotes.
@@ -148,8 +141,7 @@ In any case, do not backtrack beyond a backquote substitution.
Until Emacs 25.1, the nil behavior was hard-wired."
:version "25.1"
- :type '(choice (const corrected) (const nil) (const t))
- :group 'lisp-indent)
+ :type '(choice (const corrected) (const nil) (const t)))
(defvar lisp-indent-defun-method '(4 &lambda &body)
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 7a26d9a90fd..86ee94e87e0 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -619,8 +619,11 @@ If ALIST is non-nil, the new pairs are prepended to it."
(macroexp-let2* nil ((start from) (end to))
(funcall do `(substring ,getter ,start ,end)
(lambda (v)
- (funcall setter `(cl--set-substring
- ,getter ,start ,end ,v))))))))
+ (macroexp-let2 nil v v
+ `(progn
+ ,(funcall setter `(cl--set-substring
+ ,getter ,start ,end ,v))
+ ,v))))))))
;;; Miscellaneous.
@@ -660,6 +663,7 @@ 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."
:global t
+ :group 'tools
(cond
(cl-old-struct-compat-mode
(advice-add 'type-of :around #'cl--old-struct-type-of))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 78d083fcc63..147a0a8f5a4 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -75,7 +75,7 @@
;; one, you may want to amend the other, too.
;;;###autoload
(define-obsolete-function-alias 'cl--compiler-macro-cXXr
- 'internal--compiler-macro-cXXr "25.1")
+ #'internal--compiler-macro-cXXr "25.1")
;;; Some predicates for analyzing Lisp forms.
;; These are used by various
@@ -199,7 +199,7 @@ The name is made by appending a number to PREFIX, default \"T\"."
[&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
&optional "&allow-other-keys"]]
[&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
+ &or (cl-lambda-arg &optional def-form) arg]]
. [&or arg nil])))
(def-edebug-spec cl-&optional-arg
@@ -219,7 +219,7 @@ The name is made by appending a number to PREFIX, default \"T\"."
[&optional ["&key" cl-&key-arg &rest cl-&key-arg
&optional "&allow-other-keys"]]
[&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
+ &or (cl-lambda-arg &optional def-form) arg]]
. [&or arg nil])))
(def-edebug-spec cl-type-spec sexp)
@@ -328,8 +328,7 @@ FORM is of the form (ARGS . BODY)."
(setq cl--bind-lets (nreverse cl--bind-lets))
;; (cl-assert (eq :dummy (nth 1 (car cl--bind-lets))))
(list '&rest (car (pop cl--bind-lets))))))))
- `(nil
- (,@(nreverse simple-args) ,@rest-args)
+ `((,@(nreverse simple-args) ,@rest-args)
,@header
,(macroexp-let* cl--bind-lets
(macroexp-progn
@@ -366,9 +365,7 @@ more details.
def-body))
(doc-string 3)
(indent 2))
- (let* ((res (cl--transform-lambda (cons args body) name))
- (form `(defun ,name ,@(cdr res))))
- (if (car res) `(progn ,(car res) ,form) form)))
+ `(defun ,name ,@(cl--transform-lambda (cons args body) name)))
;;;###autoload
(defmacro cl-iter-defun (name args &rest body)
@@ -387,9 +384,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
(doc-string 3)
(indent 2))
(require 'generator)
- (let* ((res (cl--transform-lambda (cons args body) name))
- (form `(iter-defun ,name ,@(cdr res))))
- (if (car res) `(progn ,(car res) ,form) form)))
+ `(iter-defun ,name ,@(cl--transform-lambda (cons args body) name)))
;; The lambda list for macros is different from that of normal lambdas.
;; Note that &environment is only allowed as first or last items in the
@@ -407,7 +402,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
arg]]
&optional "&allow-other-keys"]]
[&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
+ &or (cl-macro-arg &optional def-form) arg]]
[&optional "&environment" arg]
)))
@@ -426,7 +421,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
arg]]
&optional "&allow-other-keys"]]
[&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
+ &or (cl-macro-arg &optional def-form) arg]]
. [&or arg nil])))
;;;###autoload
@@ -455,9 +450,7 @@ more details.
(&define name cl-macro-list cl-declarations-or-string def-body))
(doc-string 3)
(indent 2))
- (let* ((res (cl--transform-lambda (cons args body) name))
- (form `(defmacro ,name ,@(cdr res))))
- (if (car res) `(progn ,(car res) ,form) form)))
+ `(defmacro ,name ,@(cl--transform-lambda (cons args body) name)))
(def-edebug-spec cl-lambda-expr
(&define ("lambda" cl-lambda-list
@@ -480,9 +473,7 @@ Like normal `function', except that if argument is a lambda form,
its argument list allows full Common Lisp conventions."
(declare (debug (&or symbolp cl-lambda-expr)))
(if (eq (car-safe func) 'lambda)
- (let* ((res (cl--transform-lambda (cdr func) 'cl-none))
- (form `(function (lambda . ,(cdr res)))))
- (if (car res) `(progn ,(car res) ,form) form))
+ `(function (lambda . ,(cl--transform-lambda (cdr func) 'cl-none)))
`(function ,func)))
(defun cl--make-usage-var (x)
@@ -723,9 +714,9 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
(let ((comp (or (memq 'compile when) (memq :compile-toplevel when)))
(cl--not-toplevel t))
(if (or (memq 'load when) (memq :load-toplevel when))
- (if comp (cons 'progn (mapcar 'cl--compile-time-too body))
+ (if comp (cons 'progn (mapcar #'cl--compile-time-too body))
`(if nil nil ,@body))
- (progn (if comp (eval (cons 'progn body))) nil)))
+ (progn (if comp (eval (cons 'progn body) lexical-binding)) nil)))
(and (or (memq 'eval when) (memq :execute when))
(cons 'progn body))))
@@ -734,13 +725,13 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
(setq form (macroexpand
form (cons '(cl-eval-when) byte-compile-macro-environment))))
(cond ((eq (car-safe form) 'progn)
- (cons 'progn (mapcar 'cl--compile-time-too (cdr form))))
+ (cons 'progn (mapcar #'cl--compile-time-too (cdr form))))
((eq (car-safe form) 'cl-eval-when)
(let ((when (nth 1 form)))
(if (or (memq 'eval when) (memq :execute when))
`(cl-eval-when (compile ,@when) ,@(cddr form))
form)))
- (t (eval form) form)))
+ (t (eval form lexical-binding) form)))
;;;###autoload
(defmacro cl-load-time-value (form &optional _read-only)
@@ -766,7 +757,7 @@ The result of the body appears to the compiler as a quoted constant."
;; temp is set before we use it.
(print set byte-compile--outbuffer))
temp)
- `',(eval form)))
+ `',(eval form lexical-binding)))
;;; Conditional control structures.
@@ -889,7 +880,7 @@ This is compatible with Common Lisp, but note that `defun' and
;;; The "cl-loop" macro.
(defvar cl--loop-args) (defvar cl--loop-accum-var) (defvar cl--loop-accum-vars)
-(defvar cl--loop-bindings) (defvar cl--loop-body)
+(defvar cl--loop-bindings) (defvar cl--loop-body) (defvar cl--loop-conditions)
(defvar cl--loop-finally)
(defvar cl--loop-finish-flag) ;Symbol set to nil to exit the loop?
(defvar cl--loop-first-flag)
@@ -966,7 +957,8 @@ For more details, see Info node `(cl)Loop Facility'.
(cl--loop-accum-var nil) (cl--loop-accum-vars nil)
(cl--loop-initially nil) (cl--loop-finally nil)
(cl--loop-iterator-function nil) (cl--loop-first-flag nil)
- (cl--loop-symbol-macs nil))
+ (cl--loop-symbol-macs nil)
+ (cl--loop-conditions nil))
;; Here is more or less how those dynbind vars are used after looping
;; over cl--parse-loop-clause:
;;
@@ -1034,6 +1026,13 @@ For more details, see Info node `(cl)Loop Facility'.
(list `(cl-symbol-macrolet ,cl--loop-symbol-macs ,@body))))
`(cl-block ,cl--loop-name ,@body)))))
+(defmacro cl--push-clause-loop-body (clause)
+ "Apply CLAUSE to both `cl--loop-conditions' and `cl--loop-body'."
+ (macroexp-let2 nil sym clause
+ `(progn
+ (push ,sym cl--loop-conditions)
+ (push ,sym cl--loop-body))))
+
;; Below is a complete spec for cl-loop, in several parts that correspond
;; to the syntax given in CLtL2. The specs do more than specify where
;; the forms are; it also specifies, as much as Edebug allows, all the
@@ -1184,8 +1183,6 @@ For more details, see Info node `(cl)Loop Facility'.
;; (def-edebug-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))
(hash-types '(hash-key hash-keys hash-value hash-values))
@@ -1264,11 +1261,11 @@ For more details, see Info node `(cl)Loop Facility'.
(if end-var (push (list end-var end) loop-for-bindings))
(if step-var (push (list step-var step)
loop-for-bindings))
- (if end
- (push (list
- (if down (if excl '> '>=) (if excl '< '<=))
- var (or end-var end))
- cl--loop-body))
+ (when end
+ (cl--push-clause-loop-body
+ (list
+ (if down (if excl '> '>=) (if excl '< '<=))
+ var (or end-var end))))
(push (list var (list (if down '- '+) var
(or step-var step 1)))
loop-for-steps)))
@@ -1278,7 +1275,7 @@ For more details, see Info node `(cl)Loop Facility'.
(temp (if (and on (symbolp var))
var (make-symbol "--cl-var--"))))
(push (list temp (pop cl--loop-args)) loop-for-bindings)
- (push `(consp ,temp) cl--loop-body)
+ (cl--push-clause-loop-body `(consp ,temp))
(if (eq word 'in-ref)
(push (list var `(car ,temp)) cl--loop-symbol-macs)
(or (eq temp var)
@@ -1301,33 +1298,31 @@ For more details, see Info node `(cl)Loop Facility'.
((eq word '=)
(let* ((start (pop cl--loop-args))
(then (if (eq (car cl--loop-args) 'then)
- (cl--pop2 cl--loop-args) start)))
+ (cl--pop2 cl--loop-args) start))
+ (first-assign (or cl--loop-first-flag
+ (setq cl--loop-first-flag
+ (make-symbol "--cl-var--")))))
(push (list var nil) loop-for-bindings)
(if (or ands (eq (car cl--loop-args) 'and))
(progn
- (push `(,var
- (if ,(or cl--loop-first-flag
- (setq cl--loop-first-flag
- (make-symbol "--cl-var--")))
- ,start ,var))
- loop-for-sets)
- (push (list var then) loop-for-steps))
- (push (list var
- (if (eq start then) start
- `(if ,(or cl--loop-first-flag
- (setq cl--loop-first-flag
- (make-symbol "--cl-var--")))
- ,start ,then)))
- loop-for-sets))))
+ (push `(,var (if ,first-assign ,start ,var)) loop-for-sets)
+ (push `(,var (if ,(car (cl--loop-build-ands
+ (nreverse cl--loop-conditions)))
+ ,then ,var))
+ loop-for-steps))
+ (push (if (eq start then)
+ `(,var ,then)
+ `(,var (if ,first-assign ,start ,then)))
+ loop-for-sets))))
((memq word '(across across-ref))
(let ((temp-vec (make-symbol "--cl-vec--"))
(temp-idx (make-symbol "--cl-idx--")))
(push (list temp-vec (pop cl--loop-args)) loop-for-bindings)
(push (list temp-idx -1) loop-for-bindings)
- (push `(< (setq ,temp-idx (1+ ,temp-idx))
- (length ,temp-vec))
- cl--loop-body)
+ (push `(setq ,temp-idx (1+ ,temp-idx)) cl--loop-body)
+ (cl--push-clause-loop-body
+ `(< ,temp-idx (length ,temp-vec)))
(if (eq word 'across-ref)
(push (list var `(aref ,temp-vec ,temp-idx))
cl--loop-symbol-macs)
@@ -1351,17 +1346,16 @@ For more details, see Info node `(cl)Loop Facility'.
(push (list temp-seq seq) loop-for-bindings)
(push (list temp-idx 0) loop-for-bindings)
(if ref
- (let ((temp-len (make-symbol "--cl-len--")))
+ (let ((temp-len (make-symbol "--cl-len--")))
(push (list temp-len `(length ,temp-seq))
loop-for-bindings)
(push (list var `(elt ,temp-seq ,temp-idx))
cl--loop-symbol-macs)
- (push `(< ,temp-idx ,temp-len) cl--loop-body))
+ (cl--push-clause-loop-body `(< ,temp-idx ,temp-len)))
(push (list var nil) loop-for-bindings)
- (push `(and ,temp-seq
- (or (consp ,temp-seq)
- (< ,temp-idx (length ,temp-seq))))
- cl--loop-body)
+ (cl--push-clause-loop-body `(and ,temp-seq
+ (or (consp ,temp-seq)
+ (< ,temp-idx (length ,temp-seq)))))
(push (list var `(if (consp ,temp-seq)
(pop ,temp-seq)
(aref ,temp-seq ,temp-idx)))
@@ -1457,9 +1451,8 @@ For more details, see Info node `(cl)Loop Facility'.
(push (list var '(selected-frame))
loop-for-bindings)
(push (list temp nil) loop-for-bindings)
- (push `(prog1 (not (eq ,var ,temp))
- (or ,temp (setq ,temp ,var)))
- cl--loop-body)
+ (cl--push-clause-loop-body `(prog1 (not (eq ,var ,temp))
+ (or ,temp (setq ,temp ,var))))
(push (list var `(next-frame ,var))
loop-for-steps)))
@@ -1480,9 +1473,8 @@ For more details, see Info node `(cl)Loop Facility'.
(push (list minip `(minibufferp (window-buffer ,var)))
loop-for-bindings)
(push (list temp nil) loop-for-bindings)
- (push `(prog1 (not (eq ,var ,temp))
- (or ,temp (setq ,temp ,var)))
- cl--loop-body)
+ (cl--push-clause-loop-body `(prog1 (not (eq ,var ,temp))
+ (or ,temp (setq ,temp ,var))))
(push (list var `(next-window ,var ,minip))
loop-for-steps)))
@@ -1498,17 +1490,17 @@ For more details, see Info node `(cl)Loop Facility'.
(pop cl--loop-args))
(if (and ands loop-for-bindings)
(push (nreverse loop-for-bindings) cl--loop-bindings)
- (setq cl--loop-bindings (nconc (mapcar 'list loop-for-bindings)
- cl--loop-bindings)))
+ (setq cl--loop-bindings (nconc (mapcar #'list loop-for-bindings)
+ cl--loop-bindings)))
(if loop-for-sets
(push `(progn
,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
t)
cl--loop-body))
- (if loop-for-steps
- (push (cons (if ands 'cl-psetq 'setq)
- (apply 'append (nreverse loop-for-steps)))
- cl--loop-steps))))
+ (when loop-for-steps
+ (push (cons (if ands 'cl-psetq 'setq)
+ (apply #'append (nreverse loop-for-steps)))
+ cl--loop-steps))))
((eq word 'repeat)
(let ((temp (make-symbol "--cl-var--")))
@@ -1700,7 +1692,7 @@ If BODY is `setq', then use SPECS for assignments rather than for bindings."
(push binding new))))
(if (eq body 'setq)
(let ((set (cons (if par 'cl-psetq 'setq)
- (apply 'nconc (nreverse new)))))
+ (apply #'nconc (nreverse new)))))
(if temps `(let* ,(nreverse temps) ,set) set))
`(,(if par 'let 'let*)
,(nconc (nreverse temps) (nreverse new)) ,@body))))
@@ -1826,7 +1818,7 @@ For more details, see `cl-do*' description in Info node `(cl) Iteration'.
(and sets
(list (cons (if (or star (not (cdr sets)))
'setq 'cl-psetq)
- (apply 'append sets))))))
+ (apply #'append sets))))))
,@(or (cdr endtest) '(nil)))))
;;;###autoload
@@ -2024,7 +2016,12 @@ info node `(cl) Function Bindings' for details.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1)
- (debug ((&rest [&or (&define name function-form) (cl-defun)])
+ (debug ((&rest [&or (&define name :unique "cl-flet@" function-form)
+ (&define name :unique "cl-flet@"
+ cl-lambda-list
+ cl-declarations-or-string
+ [&optional ("interactive" interactive)]
+ def-body)])
cl-declarations body)))
(let ((binds ()) (newenv macroexpand-all-environment))
(dolist (binding bindings)
@@ -2105,10 +2102,9 @@ This is like `cl-flet', but for macros instead of functions.
(if (null bindings) (macroexp-progn body)
(let* ((name (caar bindings))
(res (cl--transform-lambda (cdar bindings) name)))
- (eval (car res))
(macroexpand-all (macroexp-progn body)
(cons (cons name
- (eval `(cl-function (lambda ,@(cdr res))) t))
+ (eval `(function (lambda ,@res)) t))
macroexpand-all-environment))))))
(defun cl--sm-macroexpand (orig-fun exp &optional env)
@@ -2472,7 +2468,7 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
\(fn PLACE...)"
(declare (debug (&rest place)))
- (if (not (memq nil (mapcar 'symbolp args)))
+ (if (not (memq nil (mapcar #'symbolp args)))
(and (cdr args)
(let ((sets nil)
(first (car args)))
@@ -2872,7 +2868,9 @@ Supported keywords for slots are:
(append pred-form '(t))
`(and ,pred-form t)))
forms)
- (push `(put ',name 'cl-deftype-satisfies ',predicate) forms))
+ (push `(eval-and-compile
+ (put ',name 'cl-deftype-satisfies ',predicate))
+ forms))
(let ((pos 0) (descp descs))
(while descp
(let* ((desc (pop descp))
@@ -2971,15 +2969,27 @@ Supported keywords for slots are:
constrs))
(pcase-dolist (`(,cname ,args ,doc) constrs)
(let* ((anames (cl--arglist-args args))
- (make (cl-mapcar (function (lambda (s d) (if (memq s anames) s d)))
- slots defaults)))
- (push `(,cldefsym ,cname
+ (make (cl-mapcar (lambda (s d) (if (memq s anames) s d))
+ slots defaults))
+ ;; `cl-defsubst' is fundamentally broken: it substitutes
+ ;; its arguments into the body's `sexp' much too naively
+ ;; when inlinling, which results in various problems.
+ ;; For example it generates broken code if your
+ ;; argument's name happens to be the same as some
+ ;; function used within the body.
+ ;; E.g. (cl-defsubst sm-foo (list) (list list))
+ ;; will expand `(sm-foo 1)' to `(1 1)' rather than to `(list t)'!
+ ;; Try to catch this known case!
+ (con-fun (or type #'record))
+ (unsafe-cl-defsubst
+ (or (memq con-fun args) (assq con-fun args))))
+ (push `(,(if unsafe-cl-defsubst 'cl-defun cldefsym) ,cname
(&cl-defs (nil ,@descs) ,@args)
,(if (stringp doc) doc
(format "Constructor for objects of type `%s'." name))
,@(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
'((declare (side-effect-free t))))
- (,(or type #'record) ,@make))
+ (,con-fun ,@make))
forms)))
(if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
;; Don't bother adding to cl-custom-print-functions since it's not used
@@ -3132,13 +3142,35 @@ Of course, we really can't know that for sure, so it's just a heuristic."
(or (cdr (assq sym byte-compile-function-environment))
(cdr (assq sym byte-compile-macro-environment))))))
-(put 'null 'cl-deftype-satisfies #'null)
-(put 'atom 'cl-deftype-satisfies #'atom)
-(put 'real 'cl-deftype-satisfies #'numberp)
-(put 'fixnum 'cl-deftype-satisfies #'integerp)
-(put 'base-char 'cl-deftype-satisfies #'characterp)
-(put 'character 'cl-deftype-satisfies #'natnump)
-
+(pcase-dolist (`(,type . ,pred)
+ ;; Mostly kept in alphabetical order.
+ '((array . arrayp)
+ (atom . atom)
+ (base-char . characterp)
+ (boolean . booleanp)
+ (bool-vector . bool-vector-p)
+ (buffer . bufferp)
+ (character . natnump)
+ (char-table . char-table-p)
+ (hash-table . hash-table-p)
+ (cons . consp)
+ (fixnum . integerp)
+ (float . floatp)
+ (function . functionp)
+ (integer . integerp)
+ (keyword . keywordp)
+ (list . listp)
+ (number . numberp)
+ (null . null)
+ (real . numberp)
+ (sequence . sequencep)
+ (string . stringp)
+ (symbol . symbolp)
+ (vector . vectorp)
+ ;; FIXME: Do we really want to consider this a type?
+ (integer-or-marker . integer-or-marker-p)
+ ))
+ (put type 'cl-deftype-satisfies pred))
;;;###autoload
(define-inline cl-typep (val type)
@@ -3207,7 +3239,10 @@ STRING is an optional description of the desired type."
(macroexp-let2 macroexp-copyable-p temp form
`(progn (or (cl-typep ,temp ',type)
(signal 'wrong-type-argument
- (list ,(or string `',type) ,temp ',form)))
+ (list ,(or string `',(if (eq 'satisfies
+ (car-safe type))
+ (cadr type) type))
+ ,temp ',form)))
nil))))
;;;###autoload
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index 65483d0813a..89d106ee489 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -270,12 +270,6 @@ with empty strings removed."
(remove-hook 'choose-completion-string-functions
'crm--choose-completion-string)))
-(define-obsolete-function-alias 'crm-minibuffer-complete 'crm-complete "23.1")
-(define-obsolete-function-alias
- 'crm-minibuffer-completion-help 'crm-completion-help "23.1")
-(define-obsolete-function-alias
- 'crm-minibuffer-complete-and-exit 'crm-complete-and-exit "23.1")
-
;; testing and debugging
;; (defun crm-init-test-environ ()
;; "Set up some variables for testing."
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 8cd0bdef648..0e4135b253e 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -670,9 +670,7 @@ Redefining FUNCTION also cancels it."
(when (special-form-p fn)
(setq fn nil))
(setq val (completing-read
- (if fn
- (format "Debug on entry to function (default %s): " fn)
- "Debug on entry to function: ")
+ (format-prompt "Debug on entry to function" fn)
obarray
#'(lambda (symbol)
(and (fboundp symbol)
@@ -775,8 +773,7 @@ another symbol also cancels it."
(let* ((var-at-point (variable-at-point))
(var (and (symbolp var-at-point) var-at-point))
(val (completing-read
- (concat "Debug when setting variable"
- (if var (format " (default %s): " var) ": "))
+ (format-prompt "Debug when setting variable" var)
obarray #'boundp
t nil nil (and var (symbol-name var)))))
(list (if (equal val "") var (intern val)))))
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 3eafad177dd..6a11f1c3949 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -364,6 +364,7 @@ which more-or-less shadow%s %s's corresponding table%s."
(defsubst derived-mode-setup-function-name (mode)
"Construct a setup-function name based on a MODE name."
+ (declare (obsolete nil "28.1"))
(intern (concat (symbol-name mode) "-setup")))
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 51b7db24f3c..c2faac8085b 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -57,10 +57,9 @@ If OBJECT is not already compiled, we compile it, but do not
redefine OBJECT if it is a symbol."
(interactive
(let* ((fn (function-called-at-point))
- (prompt (if fn (format "Disassemble function (default %s): " fn)
- "Disassemble function: "))
(def (and fn (symbol-name fn))))
- (list (intern (completing-read prompt obarray 'fboundp t nil nil def))
+ (list (intern (completing-read (format-prompt "Disassemble function" fn)
+ obarray 'fboundp t nil nil def))
nil 0 t)))
(if (and (consp object) (not (functionp object)))
(setq object `(lambda () ,object)))
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 59e2e2e08ff..fdc1233540e 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -1,4 +1,4 @@
-;;; easy-mmode.el --- easy definition for major and minor modes
+;;; easy-mmode.el --- easy definition for major and minor modes -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 2000-2020 Free Software Foundation, Inc.
@@ -87,7 +87,10 @@ replacing its case-insensitive matches with the literal string in LIGHTER."
If called interactively, enable %s if ARG is positive, and
disable it if ARG is zero or negative. If called from Lisp,
also enable the mode if ARG is omitted or nil, and toggle it
-if ARG is `toggle'; disable the mode otherwise.")
+if ARG is `toggle'; disable the mode otherwise.
+
+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)
(let ((doc (or doc (format "Toggle %s on or off.
@@ -154,9 +157,6 @@ BODY contains code to execute each time the mode is enabled or disabled.
the minor mode is global):
:group GROUP Custom group name to use in all generated `defcustom' forms.
- Defaults to MODE without the possible trailing \"-mode\".
- Don't use this default group name unless you have written a
- `defgroup' to define that group properly.
: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.
@@ -259,12 +259,6 @@ For example, you could write
(unless initialize
(setq initialize '(:initialize 'custom-initialize-default)))
- (unless group
- ;; We might as well provide a best-guess default group.
- (setq group
- `(:group ',(intern (replace-regexp-in-string
- "-mode\\'" "" mode-name)))))
-
;; TODO? Mark booleans as safe if booleanp? Eg abbrev-mode.
(unless type (setq type '(:type 'boolean)))
@@ -341,6 +335,9 @@ or call the function `%s'."))))
No problems result if this variable is not bound.
`add-hook' automatically binds it. (This is true for all hook variables.)"
modefun)))
+ ;; Allow using using `M-x customize-variable' on the hook.
+ (put ',hook 'custom-type 'hook)
+ (put ',hook 'standard-value (list nil))
;; Define the minor-mode keymap.
,(unless (symbolp keymap) ;nil is also a symbol.
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 6ba8b997f84..73dabef3fa5 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -29,16 +29,6 @@
;;; Code:
-(defvar easy-menu-precalculate-equivalent-keybindings nil
- "Determine when equivalent key bindings are computed for easy-menu menus.
-It can take some time to calculate the equivalent key bindings that are shown
-in a menu. If the variable is on, then this calculation gives a (maybe
-noticeable) delay when a mode is first entered. If the variable is off, then
-this delay will come when a menu is displayed the first time. If you never use
-menus, turn this variable off, otherwise it is probably better to keep it on.")
-(make-obsolete-variable
- 'easy-menu-precalculate-equivalent-keybindings nil "23.1")
-
(defsubst easy-menu-intern (s)
(if (stringp s) (intern s) s))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index a0bc6562bc9..7ff6d68c3ec 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -555,7 +555,7 @@ already is one.)"
;; Compatibility with old versions.
-(defalias 'edebug-all-defuns 'edebug-all-defs)
+(define-obsolete-function-alias 'edebug-all-defuns #'edebug-all-defs "28.1")
;;;###autoload
(defun edebug-all-defs ()
@@ -741,6 +741,21 @@ Maybe clear the markers and delete the symbol's edebug property?"
;;; Offsets for reader
+(defun edebug-get-edebug-or-ghost (name)
+ "Get NAME's value of property `edebug' or property `ghost-edebug'.
+
+The idea is that should function NAME be recompiled whilst
+debugging is in progress, property `edebug' will get set to a
+marker. The needed data will then come from property
+`ghost-edebug'."
+ (let ((e (get name 'edebug)))
+ (if (consp e)
+ e
+ (let ((g (get name 'ghost-edebug)))
+ (if (consp g)
+ g
+ e)))))
+
;; Define a structure to represent offset positions of expressions.
;; Each offset structure looks like: (before . after) for constituents,
;; or for structures that have elements: (before <subexpressions> . after)
@@ -1168,6 +1183,12 @@ purpose by adding an entry to this alist, and setting
;; Not edebugging this form, so reset the symbol's edebug
;; property to be just a marker at the definition's source code.
;; This only works for defs with simple names.
+
+ ;; Preserve the `edebug' property in case there's
+ ;; debugging still under way.
+ (let ((ghost (get def-name 'edebug)))
+ (if (consp ghost)
+ (put def-name 'ghost-edebug ghost)))
(put def-name 'edebug (point-marker))
;; Also nil out dependent defs.
'(mapcar (function
@@ -1208,7 +1229,7 @@ purpose by adding an entry to this alist, and setting
"Wrap the FORMS of a definition body."
(if edebug-def-interactive
`(let ((,(edebug-interactive-p-name)
- (interactive-p)))
+ (called-interactively-p 'interactive)))
,(edebug-make-enter-wrapper forms))
(edebug-make-enter-wrapper forms)))
@@ -1219,6 +1240,13 @@ purpose by adding an entry to this alist, and setting
;; since it wraps the list of forms with a call to `edebug-enter'.
;; Uses the dynamically bound vars edebug-def-name and edebug-def-args.
;; Do this after parsing since that may find a name.
+ (when (string-match-p (rx bos "edebug-anon" (+ digit) eos)
+ (symbol-name edebug-old-def-name))
+ ;; FIXME: Due to Bug#42701, we reset an anonymous name so that
+ ;; backtracking doesn't generate duplicate definitions. It would
+ ;; be better to not define wrappers in the case of a non-matching
+ ;; specification branch to begin with.
+ (setq edebug-old-def-name nil))
(setq edebug-def-name
(or edebug-def-name edebug-old-def-name (gensym "edebug-anon")))
`(edebug-enter
@@ -1411,6 +1439,8 @@ contains a circular object."
(cons window (window-start window)))))
;; Store the edebug data in symbol's property list.
+ ;; We actually want to remove this property entirely, but can't.
+ (put edebug-def-name 'ghost-edebug nil)
(put edebug-def-name 'edebug
;; A struct or vector would be better here!!
(list edebug-form-begin-marker
@@ -1423,8 +1453,8 @@ contains a circular object."
)))
(defun edebug--restore-breakpoints (name)
- (let ((data (get name 'edebug)))
- (when (listp data)
+ (let ((data (edebug-get-edebug-or-ghost name)))
+ (when (consp data)
(let ((offsets (nth 2 data))
(breakpoints (nth 1 data))
(start (nth 0 data))
@@ -1702,18 +1732,22 @@ contains a circular object."
(&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.
@@ -1832,9 +1866,6 @@ contains a circular object."
;; This means nothing matched, so it is OK.
nil) ;; So, return nothing
-
-(def-edebug-spec &key edebug-match-&key)
-
(defun edebug-match-&key (cursor specs)
;; Following specs must look like (<name> <spec>) ...
;; where <name> is the name of a keyword, and spec is its spec.
@@ -1847,6 +1878,15 @@ contains a circular object."
(car (cdr pair))))
specs))))
+(defun edebug-match-&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)))
+ (goto-char edebug-error-point)
+ (error "%s"
+ (if (stringp error-string)
+ error-string
+ "String expected after &error in edebug-spec"))))
(defun edebug-match-gate (_cursor)
;; Simply set the gate to prevent backtracking at this level.
@@ -2005,6 +2045,27 @@ contains a circular object."
spec))
nil)
+(defun edebug-match-:unique (_cursor spec)
+ "Match a `:unique PREFIX' specifier.
+SPEC is the symbol name prefix for `gensym'."
+ (let ((suffix (gensym spec)))
+ (setq edebug-def-name
+ (if edebug-def-name
+ ;; Construct a new name by appending to previous name.
+ (intern (format "%s@%s" edebug-def-name suffix))
+ 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))
@@ -2105,10 +2166,10 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'."
(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)
- edebug-spec-list
stringp
[edebug-lambda-list-keywordp &rest edebug-spec]
[keywordp gate edebug-spec]
@@ -2216,6 +2277,8 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'."
(def-edebug-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)
@@ -2755,6 +2818,7 @@ See `edebug-behavior-alist' for implementations.")
(edebug-stop))
(edebug-overlay-arrow)
+ (edebug--overlay-breakpoints edebug-function)
(unwind-protect
(if (or edebug-stop
@@ -2832,7 +2896,6 @@ See `edebug-behavior-alist' for implementations.")
(if (not (eq edebug-buffer edebug-outside-buffer))
(goto-char edebug-outside-point))
(if (marker-buffer (edebug-mark-marker))
- ;; Does zmacs-regions need to be nil while doing set-marker?
(set-marker (edebug-mark-marker) edebug-outside-mark))
)) ; unwind-protect
;; None of the following is done if quit or signal occurs.
@@ -2844,6 +2907,7 @@ See `edebug-behavior-alist' for implementations.")
(goto-char edebug-buffer-outside-point))
;; ... nothing more.
)
+ (edebug--overlay-breakpoints-remove (point-min) (point-max))
;; Could be an option to keep eval display up.
(if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
(with-timeout-unsuspend edebug-with-timeout-suspend)
@@ -3118,7 +3182,7 @@ before returning. The default is one second."
;; Return (function . index) of the nearest edebug stop point.
(let* ((edebug-def-name (edebug-form-data-symbol))
(edebug-data
- (let ((data (get edebug-def-name 'edebug)))
+ (let ((data (edebug-get-edebug-or-ghost edebug-def-name)))
(if (or (null data) (markerp data))
(error "%s is not instrumented for Edebug" edebug-def-name))
data)) ; we could do it automatically, if data is a marker.
@@ -3155,7 +3219,7 @@ before returning. The default is one second."
(if edebug-stop-point
(let* ((edebug-def-name (car edebug-stop-point))
(index (cdr edebug-stop-point))
- (edebug-data (get edebug-def-name 'edebug))
+ (edebug-data (edebug-get-edebug-or-ghost edebug-def-name))
;; pull out parts of edebug-data
(edebug-def-mark (car edebug-data))
@@ -3196,7 +3260,7 @@ the breakpoint."
(if edebug-stop-point
(let* ((edebug-def-name (car edebug-stop-point))
(index (cdr edebug-stop-point))
- (edebug-data (get edebug-def-name 'edebug))
+ (edebug-data (edebug-get-edebug-or-ghost edebug-def-name))
;; pull out parts of edebug-data
(edebug-def-mark (car edebug-data))
@@ -3228,7 +3292,45 @@ the breakpoint."
(setcar (cdr edebug-data) edebug-breakpoints)
(goto-char position)
- ))))
+ (edebug--overlay-breakpoints edebug-def-name)))))
+
+(define-fringe-bitmap 'edebug-breakpoint
+ "\x3c\x7e\xff\xff\xff\xff\x7e\x3c")
+
+(defun edebug--overlay-breakpoints (function)
+ (let* ((data (edebug-get-edebug-or-ghost function))
+ (start (nth 0 data))
+ (breakpoints (nth 1 data))
+ (offsets (nth 2 data)))
+ ;; First remove all old breakpoint overlays.
+ (edebug--overlay-breakpoints-remove
+ start (+ start (aref offsets (1- (length offsets)))))
+ ;; Then make overlays for the breakpoints (but only when we are in
+ ;; edebug mode).
+ (when edebug-active
+ (dolist (breakpoint breakpoints)
+ (let* ((pos (+ start (aref offsets (car breakpoint))))
+ (overlay (make-overlay pos (1+ pos)))
+ (face (if (nth 4 breakpoint)
+ (progn
+ (overlay-put overlay
+ 'help-echo "Disabled breakpoint")
+ (overlay-put overlay
+ 'face 'edebug-disabled-breakpoint))
+ (overlay-put overlay 'help-echo "Breakpoint")
+ (overlay-put overlay 'face 'edebug-enabled-breakpoint))))
+ (overlay-put overlay 'edebug t)
+ (let ((fringe (make-overlay pos pos)))
+ (overlay-put fringe 'edebug t)
+ (overlay-put fringe 'before-string
+ (propertize
+ "x" 'display
+ `(left-fringe edebug-breakpoint ,face)))))))))
+
+(defun edebug--overlay-breakpoints-remove (start end)
+ (dolist (overlay (overlays-in start end))
+ (when (overlay-get overlay 'edebug)
+ (delete-overlay overlay))))
(defun edebug-set-breakpoint (arg)
"Set the breakpoint of nearest sexp.
@@ -3236,9 +3338,9 @@ With prefix argument, make it a temporary breakpoint."
(interactive "P")
;; If the form hasn't been instrumented yet, do it now.
(when (and (not edebug-active)
- (let ((data (get (edebug--form-data-name
- (edebug-get-form-data-entry (point)))
- 'edebug)))
+ (let ((data (edebug-get-edebug-or-ghost
+ (edebug--form-data-name
+ (edebug-get-form-data-entry (point))))))
(or (null data) (markerp data))))
(edebug-defun))
(edebug-modify-breakpoint t nil arg))
@@ -3252,7 +3354,7 @@ With prefix argument, make it a temporary breakpoint."
"Unset all the breakpoints in the current form."
(interactive)
(let* ((name (edebug-form-data-symbol))
- (breakpoints (nth 1 (get name 'edebug))))
+ (breakpoints (nth 1 (edebug-get-edebug-or-ghost name))))
(unless breakpoints
(user-error "There are no breakpoints in %s" name))
(save-excursion
@@ -3268,12 +3370,13 @@ With prefix argument, make it a temporary breakpoint."
(user-error "No stop point near point"))
(let* ((name (car stop-point))
(index (cdr stop-point))
- (data (get name 'edebug))
+ (data (edebug-get-edebug-or-ghost name))
(breakpoint (assq index (nth 1 data))))
(unless breakpoint
(user-error "No breakpoint near point"))
(setf (nth 4 breakpoint)
- (not (nth 4 breakpoint))))))
+ (not (nth 4 breakpoint)))
+ (edebug--overlay-breakpoints name))))
(defun edebug-set-global-break-condition (expression)
"Set `edebug-global-break-condition' to EXPRESSION."
@@ -3448,7 +3551,7 @@ instrument cannot be found, signal an error."
(goto-char func-marker)
(edebug-eval-top-level-form)
(list func)))
- ((consp func-marker)
+ ((and (consp func-marker) (consp (symbol-function func)))
(message "%s is already instrumented." func)
(list func))
(t
@@ -3667,7 +3770,6 @@ Return the result of the last expression."
(prin1-to-string edebug-arg))
(cdr value) ", ")))
-(defvar print-readably) ; defined by lemacs
;; Alternatively, we could change the definition of
;; edebug-safe-prin1-to-string to only use these if defined.
@@ -3675,8 +3777,7 @@ Return the result of the last expression."
(let ((print-escape-newlines t)
(print-length (or edebug-print-length print-length))
(print-level (or edebug-print-level print-level))
- (print-circle (or edebug-print-circle print-circle))
- (print-readably nil)) ; lemacs uses this.
+ (print-circle (or edebug-print-circle print-circle)))
(edebug-prin1-to-string value)))
(defun edebug-compute-previous-result (previous-value)
@@ -4223,7 +4324,7 @@ Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME."
(let* ((index (backtrace-get-index))
(frame (nth index backtrace-frames)))
(when (edebug--frame-def-name frame)
- (let* ((data (get (edebug--frame-def-name frame) 'edebug))
+ (let* ((data (edebug-get-edebug-or-ghost (edebug--frame-def-name frame)))
(marker (nth 0 data))
(offsets (nth 2 data)))
(pop-to-buffer (marker-buffer marker))
@@ -4307,7 +4408,7 @@ reinstrument it."
(let* ((function (edebug-form-data-symbol))
(counts (get function 'edebug-freq-count))
(coverages (get function 'edebug-coverage))
- (data (get function 'edebug))
+ (data (edebug-get-edebug-or-ghost function))
(def-mark (car data)) ; mark at def start
(edebug-points (nth 2 data))
(i (1- (length edebug-points)))
@@ -4465,7 +4566,7 @@ With prefix argument, make it a temporary breakpoint."
(if edebug-stop-point
(let* ((edebug-def-name (car edebug-stop-point))
(index (cdr edebug-stop-point))
- (edebug-data (get edebug-def-name 'edebug))
+ (edebug-data (edebug-get-edebug-or-ghost edebug-def-name))
(edebug-breakpoints (car (cdr edebug-data)))
(edebug-break-data (assq index edebug-breakpoints))
(edebug-break-condition (car (cdr edebug-break-data)))
@@ -4479,17 +4580,6 @@ With prefix argument, make it a temporary breakpoint."
(edebug-modify-breakpoint t condition arg))
(easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
-
-;;; Autoloading of Edebug accessories
-
-;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu
-(defun edebug--require-cl-read ()
- (require 'edebug-cl-read))
-
-(if (featurep 'cl-read)
- (add-hook 'edebug-setup-hook #'edebug--require-cl-read)
- ;; The following causes edebug-cl-read to be loaded when you load cl-read.el.
- (add-hook 'cl-read-load-hooks #'edebug--require-cl-read))
;;; Finalize Loading
@@ -4525,7 +4615,6 @@ With prefix argument, make it a temporary breakpoint."
(run-with-idle-timer 0 nil #'(lambda () (unload-feature 'edebug)))))
(remove-hook 'called-interactively-p-functions
#'edebug--called-interactively-skip)
- (remove-hook 'cl-read-load-hooks #'edebug--require-cl-read)
(edebug-uninstall-read-eval-functions)
;; Continue standard unloading.
nil)
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index f6746eb981f..a484c2ff382 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -252,119 +252,87 @@ being pedantic."
(error
"Invalid object: %s is not an object of class %s nor a subclass"
(car ret) class))
- (setq ret (eieio-persistent-convert-list-to-object ret))
+ (setq ret (eieio-persistent-make-instance (car ret) (cdr ret)))
(oset ret file filename))
(kill-buffer " *tmp eieio read*"))
ret))
-(defun eieio-persistent-convert-list-to-object (inputlist)
- "Convert the INPUTLIST, representing object creation to an object.
-While it is possible to just `eval' the INPUTLIST, this code instead
-validates the existing list, and explicitly creates objects instead of
-calling eval. This avoids the possibility of accidentally running
-malicious code.
-
-Note: This function recurses when a slot of :type of some object is
-identified, and needing more object creation."
- (let* ((objclass (nth 0 inputlist))
- ;; Earlier versions of `object-write' added a string name for
- ;; the object, now obsolete.
- (slots (nthcdr
- (if (stringp (nth 1 inputlist)) 2 1)
- inputlist))
- (createslots nil)
- (class
- (progn
- ;; If OBJCLASS is an eieio autoload object, then we need to
- ;; load it.
- (eieio--full-class-object objclass))))
-
- (while slots
- (let ((initarg (car slots))
- (value (car (cdr slots))))
-
- ;; Make sure that the value proposed for SLOT is valid.
- ;; In addition, strip out quotes, list functions, and update
- ;; object constructors as needed.
- (setq value (eieio-persistent-validate/fix-slot-value
- class (eieio--initarg-to-attribute class initarg) value))
-
- (push initarg createslots)
- (push value createslots)
- )
-
- (setq slots (cdr (cdr slots))))
-
- (apply #'make-instance objclass (nreverse createslots))
-
- ;;(eval inputlist)
- ))
-
-(defun eieio-persistent-validate/fix-slot-value (class slot proposed-value)
- "Validate that in CLASS, the SLOT with PROPOSED-VALUE is good, then fix.
-A limited number of functions, such as quote, list, and valid object
-constructor functions are considered valid.
-Second, any text properties will be stripped from strings."
+(cl-defgeneric eieio-persistent-make-instance (objclass inputlist)
+ "Convert INPUTLIST, representing slot values, to an instance of OBJCLASS.
+Clean slot values, and possibly recursively create additional
+objects found there."
+ (:method
+ ((objclass (subclass eieio-default-superclass)) inputlist)
+
+ (let ((slots (if (stringp (car inputlist))
+ ;; Earlier versions of `object-write' added a
+ ;; string name for the object, now obsolete.
+ (cdr inputlist)
+ inputlist))
+ (createslots nil))
+ ;; If OBJCLASS is an eieio autoload object, then we need to
+ ;; load it (we don't need the return value).
+ (eieio--full-class-object objclass)
+ (while slots
+ (let ((initarg (car slots))
+ (value (car (cdr slots))))
+
+ ;; Strip out quotes, list functions, and update object
+ ;; constructors as needed.
+ (setq value (eieio-persistent-fix-value value))
+
+ (push initarg createslots)
+ (push value createslots))
+
+ (setq slots (cdr (cdr slots))))
+
+ (apply #'make-instance objclass (nreverse createslots)))))
+
+(defun eieio-persistent-fix-value (proposed-value)
+ "Fix PROPOSED-VALUE.
+Remove leading quotes from lists, and the symbol `list' from the
+head of lists. Explicitly construct any objects found, and strip
+any text properties from string values.
+
+This function will descend into the contents of lists, hash
+tables, and vectors."
(cond ((consp proposed-value)
;; Lists with something in them need special treatment.
- (let* ((slot-idx (- (eieio--slot-name-index class slot)
- (eval-when-compile eieio--object-num-slots)))
- (type (cl--slot-descriptor-type (aref (eieio--class-slots class)
- slot-idx)))
- (classtype (eieio-persistent-slot-type-is-class-p type)))
-
- (cond ((eq (car proposed-value) 'quote)
- (car (cdr proposed-value)))
-
- ;; An empty list sometimes shows up as (list), which is dumb, but
- ;; we need to support it for backward compat.
- ((and (eq (car proposed-value) 'list)
- (= (length proposed-value) 1))
- nil)
-
- ;; List of object constructors.
- ((and (eq (car proposed-value) 'list)
- ;; 2nd item is a list.
- (consp (car (cdr proposed-value)))
- ;; 1st elt of 2nd item is a class name.
- (class-p (car (car (cdr proposed-value))))
- )
-
- ;; Check the value against the input class type.
- ;; If something goes wrong, issue a smart warning
- ;; about how a :type is needed for this to work.
- (unless (and
- ;; Do we have a type?
- (consp classtype) (class-p (car classtype)))
- (error "In save file, list of object constructors found, but no :type specified for slot %S of type %S"
- slot classtype))
-
- ;; We have a predicate, but it doesn't satisfy the predicate?
- (dolist (PV (cdr proposed-value))
- (unless (child-of-class-p (car PV) (car classtype))
- (error "Invalid object: slot member %s does not match class %s"
- (car PV) (car classtype))))
-
- ;; We have a list of objects here. Lets load them
- ;; in.
- (let ((objlist nil))
- (dolist (subobj (cdr proposed-value))
- (push (eieio-persistent-convert-list-to-object subobj)
- objlist))
- ;; return the list of objects ... reversed.
- (nreverse objlist)))
- ;; We have a slot with a single object that can be
- ;; saved here. Recurse and evaluate that
- ;; sub-object.
- ((and classtype
- (seq-some
- (lambda (elt)
- (child-of-class-p (car proposed-value) elt))
- (if (listp classtype) classtype (list classtype))))
- (eieio-persistent-convert-list-to-object
- proposed-value))
- (t
- proposed-value))))
+ (cond ((eq (car proposed-value) 'quote)
+ (while (eq (car-safe proposed-value) 'quote)
+ (setq proposed-value (car (cdr proposed-value))))
+ proposed-value)
+
+ ;; An empty list sometimes shows up as (list), which is dumb, but
+ ;; we need to support it for backward compar.
+ ((and (eq (car proposed-value) 'list)
+ (= (length proposed-value) 1))
+ nil)
+
+ ;; List of object constructors.
+ ((and (eq (car proposed-value) 'list)
+ ;; 2nd item is a list.
+ (consp (car (cdr proposed-value)))
+ ;; 1st elt of 2nd item is a class name.
+ (class-p (car (car (cdr proposed-value)))))
+
+ ;; We have a list of objects here. Lets load them
+ ;; in.
+ (let ((objlist nil))
+ (dolist (subobj (cdr proposed-value))
+ (push (eieio-persistent-make-instance
+ (car subobj) (cdr subobj))
+ objlist))
+ ;; return the list of objects ... reversed.
+ (nreverse objlist)))
+ ;; We have a slot with a single object that can be
+ ;; saved here. Recurse and evaluate that
+ ;; sub-object.
+ ((class-p (car proposed-value))
+ (eieio-persistent-make-instance
+ (car proposed-value) (cdr proposed-value)))
+ (t
+ proposed-value)))
;; For hash-tables and vectors, the top-level `read' will not
;; "look inside" member values, so we need to do that
;; explicitly. Because `eieio-override-prin1' is recursive in
@@ -375,10 +343,9 @@ Second, any text properties will be stripped from strings."
(lambda (key value)
(setf (gethash key proposed-value)
(if (class-p (car-safe value))
- (eieio-persistent-convert-list-to-object
- value)
- (eieio-persistent-validate/fix-slot-value
- class slot value))))
+ (eieio-persistent-make-instance
+ (car value) (cdr value))
+ (eieio-persistent-fix-value value))))
proposed-value)
proposed-value)
@@ -387,72 +354,18 @@ Second, any text properties will be stripped from strings."
(let ((val (aref proposed-value i)))
(aset proposed-value i
(if (class-p (car-safe val))
- (eieio-persistent-convert-list-to-object
- val)
- (eieio-persistent-validate/fix-slot-value
- class slot val)))))
+ (eieio-persistent-make-instance
+ (car val) (cdr val))
+ (eieio-persistent-fix-value val)))))
proposed-value)
- ((stringp proposed-value)
- ;; Else, check for strings, remove properties.
- (substring-no-properties proposed-value))
-
- (t
- ;; Else, just return whatever the constant was.
- proposed-value))
- )
-
-(defun eieio-persistent-slot-type-is-class-p (type)
- "Return the class referred to in TYPE.
-If no class is referenced there, then return nil."
- (cond ((class-p type)
- ;; If the type is a class, then return it.
- type)
- ((and (eq 'list-of (car-safe type)) (class-p (cadr type)))
- ;; If it is the type of a list of a class, then return that class and
- ;; the type.
- (cons (cadr type) type))
-
- ((and (symbolp type) (get type 'cl-deftype-handler))
- ;; Macro-expand the type according to cl-deftype definitions.
- (eieio-persistent-slot-type-is-class-p
- (funcall (get type 'cl-deftype-handler))))
-
- ;; FIXME: foo-child should not be a valid type!
- ((and (symbolp type) (string-match "-child\\'" (symbol-name type))
- (class-p (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- (unless eieio-backward-compatibility
- (error "Use of bogus %S type instead of %S"
- type (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- ;; If it is the predicate ending with -child, then return
- ;; that class. Unfortunately, in EIEIO, typep of just the
- ;; class is the same as if we used -child, so no further work needed.
- (intern-soft (substring (symbol-name type) 0
- (match-beginning 0))))
- ;; FIXME: foo-list should not be a valid type!
- ((and (symbolp type) (string-match "-list\\'" (symbol-name type))
- (class-p (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- (unless eieio-backward-compatibility
- (error "Use of bogus %S type instead of (list-of %S)"
- type (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- ;; If it is the predicate ending with -list, then return
- ;; that class and the predicate to use.
- (cons (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))
- type))
-
- ((eq (car-safe type) 'or)
- ;; If type is a list, and is an `or', return all valid class
- ;; types within the `or' statement.
- (seq-filter #'eieio-persistent-slot-type-is-class-p (cdr type)))
+ ((stringp proposed-value)
+ ;; Else, check for strings, remove properties.
+ (substring-no-properties proposed-value))
(t
- ;; No match, not a class.
- nil)))
+ ;; Else, just return whatever the constant was.
+ proposed-value)))
(cl-defmethod object-write ((this eieio-persistent) &optional comment)
"Write persistent object THIS out to the current stream.
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 1e53f30a2ae..3bc65d0d4c5 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -730,7 +730,8 @@ Argument FN is the function calling this verifier."
(guard (not (memq name eieio--known-slot-names))))
(macroexp--warn-and-return
(format-message "Unknown slot `%S'" name) exp 'compile-only))
- (_ exp)))))
+ (_ exp))))
+ (gv-setter eieio-oset))
(cl-check-type slot symbol)
(cl-check-type obj (or eieio-object class))
(let* ((class (cond ((symbolp obj)
@@ -755,6 +756,7 @@ Argument FN is the function calling this verifier."
(defun eieio-oref-default (obj 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))
(cl-check-type slot symbol)
(let* ((cl (cond ((symbolp obj) (cl--find-class obj))
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index dda90373069..59af7e12d21 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -278,14 +278,7 @@ are not abstract."
(if eieio-class-speedbar-key-map
nil
- (if (not (featurep 'speedbar))
- (add-hook 'speedbar-load-hook (lambda ()
- (eieio-class-speedbar-make-map)
- (speedbar-add-expansion-list
- '("EIEIO"
- eieio-class-speedbar-menu
- eieio-class-speedbar-key-map
- eieio-class-speedbar))))
+ (with-eval-after-load 'speedbar
(eieio-class-speedbar-make-map)
(speedbar-add-expansion-list '("EIEIO"
eieio-class-speedbar-menu
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el
index c11608da5d8..5c6e0e516d1 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -140,11 +140,7 @@ MENU-VAR is the symbol containing an easymenu compatible menu part to use.
MODENAME is a string used to identify this browser mode.
FETCHER is a generic function used to fetch the base object list used when
creating the speedbar display."
- (if (not (featurep 'speedbar))
- (add-hook 'speedbar-load-hook
- (list 'lambda nil
- (list 'eieio-speedbar-create-engine
- map-fn map-var menu-var modename fetcher)))
+ (with-eval-after-load 'speedbar
(eieio-speedbar-create-engine map-fn map-var menu-var modename fetcher)))
(defun eieio-speedbar-create-engine (map-fn map-var menu-var modename fetcher)
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 9f8b639e52d..810affa7227 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -351,24 +351,20 @@ Elements of FIELDS can be of the form (NAME PAT) in which case the
contents of field NAME is matched against PAT, or they can be of
the form NAME which is a shorthand for (NAME NAME)."
(declare (debug (&rest [&or (sexp pcase-PAT) sexp])))
- (let ((is (make-symbol "table")))
- ;; FIXME: This generates a horrendous mess of redundant let bindings.
- ;; `pcase' needs to be improved somehow to introduce let-bindings more
- ;; sparingly, or the byte-compiler needs to be taught to optimize
- ;; them away.
- ;; FIXME: `pcase' does not do a good job here of sharing tests&code among
- ;; various branches.
- `(and (pred eieio-object-p)
- (app eieio-pcase-slot-index-table ,is)
- ,@(mapcar (lambda (field)
- (let* ((name (if (consp field) (car field) field))
- (pat (if (consp field) (cadr field) field))
- (i (make-symbol "index")))
- `(and (let (and ,i (pred natnump))
- (eieio-pcase-slot-index-from-index-table
- ,is ',name))
- (app (pcase--flip aref ,i) ,pat))))
- fields))))
+ ;; FIXME: This generates a horrendous mess of redundant let bindings.
+ ;; `pcase' needs to be improved somehow to introduce let-bindings more
+ ;; sparingly, or the byte-compiler needs to be taught to optimize
+ ;; them away.
+ ;; FIXME: `pcase' does not do a good job here of sharing tests&code among
+ ;; various branches.
+ `(and (pred eieio-object-p)
+ ,@(mapcar (lambda (field)
+ (pcase-exhaustive field
+ (`(,name ,pat)
+ `(app (pcase--flip eieio-oref ',name) ,pat))
+ ((pred symbolp)
+ `(app (pcase--flip eieio-oref ',field) ,field))))
+ fields)))
;;; Simple generators, and query functions. None of these would do
;; well embedded into an object.
@@ -649,14 +645,6 @@ If SLOT is unbound, do nothing."
nil
(eieio-oset object slot (delete item (eieio-oref object slot)))))
-;;; Here are some CLOS items that need the CL package
-;;
-
-;; FIXME: Shouldn't this be a more complex gv-expander which extracts the
-;; common code between oref and oset, so as to reduce the redundant work done
-;; in (push foo (oref bar baz)), like we do for the `nth' expander?
-(gv-define-simple-setter eieio-oref eieio-oset)
-
;;;
;; We want all objects created by EIEIO to have some default set of
@@ -887,7 +875,7 @@ this object."
;; Now output readable lisp to recreate this object
;; It should look like this:
;; (<constructor> <name> <slot> <slot> ... )
- ;; Each slot's slot is writen using its :writer.
+ ;; Each slot's slot is written using its :writer.
(when eieio-print-indentation
(princ (make-string (* eieio-print-depth 2) ? )))
(princ "(")
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 7a7b8ec1647..9e38e5908ed 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -5,6 +5,11 @@
;; Author: Noah Friedman <friedman@splode.com>
;; Keywords: extensions
;; Created: 1995-10-06
+;; Version: 1.10.0
+;; Package-Requires: ((emacs "26.3"))
+
+;; This is a GNU ELPA :core package. Avoid functionality that is not
+;; compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.
@@ -32,20 +37,18 @@
;; the one-line documentation for that variable instead, to remind you of
;; that variable's meaning.
-;; One useful way to enable this minor mode is to put the following in your
-;; .emacs:
-;;
-;; (add-hook 'emacs-lisp-mode-hook 'eldoc-mode)
-;; (add-hook 'lisp-interaction-mode-hook 'eldoc-mode)
-;; (add-hook 'ielm-mode-hook 'eldoc-mode)
-;; (add-hook 'eval-expression-minibuffer-setup-hook 'eldoc-mode)
+;; This mode is now enabled by default in all major modes that provide
+;; support for it, such as `emacs-lisp-mode'.
+;; This is controlled by `global-eldoc-mode'.
-;; Major modes for other languages may use ElDoc by defining an
-;; appropriate function as the buffer-local value of
-;; `eldoc-documentation-function'.
+;; Major modes for other languages may use ElDoc by adding an
+;; appropriate function to the buffer-local value of
+;; `eldoc-documentation-functions'.
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(defgroup eldoc nil
"Show function arglist or variable docstring in echo area."
:group 'lisp
@@ -57,20 +60,23 @@ If user input arrives before this interval of time has elapsed after the
last input, no documentation will be printed.
If this variable is set to 0, no idle time is required."
- :type 'number
- :group 'eldoc)
+ :type 'number)
(defcustom eldoc-print-after-edit nil
"If non-nil eldoc info is only shown when editing.
Changing the value requires toggling `eldoc-mode'."
+ :type 'boolean)
+
+(defcustom eldoc-display-truncation-message t
+ "If non-nil, provide verbose help when a message has been truncated.
+If nil, truncated messages will just have \"...\" appended."
:type 'boolean
- :group 'eldoc)
+ :version "28.1")
;;;###autoload
(defcustom eldoc-minor-mode-string (purecopy " ElDoc")
"String to display in mode line when ElDoc Mode is enabled; nil for none."
- :type '(choice string (const :tag "None" nil))
- :group 'eldoc)
+ :type '(choice string (const :tag "None" nil)))
(defcustom eldoc-argument-case #'identity
"Case to display argument names of functions, as a symbol.
@@ -79,42 +85,51 @@ Actually, any name of a function which takes a string as an argument and
returns another string is acceptable.
Note that this variable has no effect, unless
-`eldoc-documentation-function' handles it explicitly."
+`eldoc-documentation-strategy' handles it explicitly."
:type '(radio (function-item upcase)
(function-item downcase)
- function)
- :group 'eldoc)
+ function))
(make-obsolete-variable 'eldoc-argument-case nil "25.1")
(defcustom eldoc-echo-area-use-multiline-p 'truncate-sym-name-if-fit
- "Allow long ElDoc messages to resize echo area display.
-If value is t, never attempt to truncate messages; complete symbol name
-and function arglist or 1-line variable documentation will be displayed
-even if echo area must be resized to fit.
-
-If value is any non-nil value other than t, symbol name may be truncated
-if it will enable the function arglist or documentation string to fit on a
-single line without resizing window. Otherwise, behavior is just like
-former case.
-
-If value is nil, messages are always truncated to fit in a single line of
-display in the echo area. Function or variable symbol name may be
-truncated to make more of the arglist or documentation string visible.
-
-Note that this variable has no effect, unless
-`eldoc-documentation-function' handles it explicitly."
- :type '(radio (const :tag "Always" t)
- (const :tag "Never" nil)
- (const :tag "Yes, but truncate symbol names if it will\
- enable argument list to fit on one line" truncate-sym-name-if-fit))
- :group 'eldoc)
+ "Allow long ElDoc doc strings to resize echo area display.
+If value is t, never attempt to truncate messages, even if the
+echo area must be resized to fit.
+
+If value is a number (integer or floating point), it has the
+semantics of `max-mini-window-height', constraining the resizing
+for ElDoc purposes only.
+
+Any resizing respects `max-mini-window-height'.
+
+If value is any non-nil symbol other than t, the part of the doc
+string that represents the symbol's name may be truncated if it
+will enable the rest of the doc string to fit on a single line,
+without resizing the echo area.
+
+If value is nil, a doc string is always truncated to fit in a
+single line of display in the echo area."
+ :type '(radio (const :tag "Always" t)
+ (float :tag "Fraction of frame height" 0.25)
+ (integer :tag "Number of lines" 5)
+ (const :tag "Never" nil)
+ (const :tag "Yes, but ask major-mode to truncate
+ symbol names if it will\ enable argument list to fit on one
+ line" truncate-sym-name-if-fit)))
+
+(defcustom eldoc-prefer-doc-buffer nil
+ "Prefer ElDoc's documentation buffer if it is showing in some frame.
+If this variable's value is t and a piece of documentation needs
+to be truncated to fit in the echo area, do so if ElDoc's
+documentation buffer is not already showing, since the buffer
+always holds the full documentation."
+ :type 'boolean)
(defface eldoc-highlight-function-argument
'((t (:inherit bold)))
"Face used for the argument at point in a function's argument list.
-Note that this face has no effect unless the `eldoc-documentation-function'
-handles it explicitly."
- :group 'eldoc)
+Note that this face has no effect unless the `eldoc-documentation-strategy'
+handles it explicitly.")
;;; No user options below here.
@@ -155,7 +170,7 @@ directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'.")
This is used to determine if `eldoc-idle-delay' is changed by the user.")
(defvar eldoc-message-function #'eldoc-minibuffer-message
- "The function used by `eldoc-message' to display messages.
+ "The function used by `eldoc--message' to display messages.
It should receive the same arguments as `message'.")
(defun eldoc-edit-message-commands ()
@@ -182,8 +197,7 @@ area displays information about a function or variable in the
text where point is. If point is on a documented variable, it
displays the first line of that variable's doc string. Otherwise
it displays the argument list of the function called in the
-expression point is on."
- :group 'eldoc :lighter eldoc-minor-mode-string
+expression point is on." :lighter eldoc-minor-mode-string
(setq eldoc-last-message nil)
(cond
((not (eldoc--supported-p))
@@ -193,24 +207,23 @@ expression point is on."
(eldoc-mode
(when eldoc-print-after-edit
(setq-local eldoc-message-commands (eldoc-edit-message-commands)))
- (add-hook 'post-command-hook 'eldoc-schedule-timer nil t)
- (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area nil t))
+ (add-hook 'post-command-hook #'eldoc-schedule-timer nil t)
+ (add-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area nil t))
(t
(kill-local-variable 'eldoc-message-commands)
- (remove-hook 'post-command-hook 'eldoc-schedule-timer t)
- (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t)
+ (remove-hook 'post-command-hook #'eldoc-schedule-timer t)
+ (remove-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area t)
(when eldoc-timer
(cancel-timer eldoc-timer)
(setq eldoc-timer nil)))))
;;;###autoload
(define-globalized-minor-mode global-eldoc-mode eldoc-mode turn-on-eldoc-mode
- :group 'eldoc
:initialize 'custom-initialize-delay
:init-value t
;; For `read--expression', the usual global mode mechanism of
;; `change-major-mode-hook' runs in the minibuffer before
- ;; `eldoc-documentation-function' is set, so `turn-on-eldoc-mode'
+ ;; `eldoc-documentation-strategy' is set, so `turn-on-eldoc-mode'
;; does nothing. Configure and enable eldoc from
;; `eval-expression-minibuffer-setup-hook' instead.
(if global-eldoc-mode
@@ -222,21 +235,24 @@ expression point is on."
(defun eldoc--eval-expression-setup ()
;; Setup `eldoc', similar to `emacs-lisp-mode'. FIXME: Call
;; `emacs-lisp-mode' itself?
- (add-function :before-until (local 'eldoc-documentation-function)
- #'elisp-eldoc-documentation-function)
+ (cond ((<= emacs-major-version 27)
+ (declare-function elisp-eldoc-documentation-function "elisp-mode")
+ (add-function :before-until (local 'eldoc-documentation-function)
+ #'elisp-eldoc-documentation-function))
+ (t (add-hook 'eldoc-documentation-functions
+ #'elisp-eldoc-var-docstring nil t)
+ (add-hook 'eldoc-documentation-functions
+ #'elisp-eldoc-funcall nil t)
+ (setq eldoc-documentation-strategy 'eldoc-documentation-default)))
(eldoc-mode +1))
;;;###autoload
(defun turn-on-eldoc-mode ()
"Turn on `eldoc-mode' if the buffer has ElDoc support enabled.
-See `eldoc-documentation-function' for more detail."
+See `eldoc-documentation-strategy' for more detail."
(when (eldoc--supported-p)
(eldoc-mode 1)))
-(defun eldoc--supported-p ()
- "Non-nil if an ElDoc function is set for this buffer."
- (not (memq eldoc-documentation-function '(nil ignore))))
-
(defun eldoc-schedule-timer ()
"Ensure `eldoc-timer' is running.
@@ -252,7 +268,9 @@ reflect the change."
(when (or eldoc-mode
(and global-eldoc-mode
(eldoc--supported-p)))
- (eldoc-print-current-symbol-info))))))
+ ;; Don't ignore, but also don't full-on signal errors
+ (with-demoted-errors "eldoc error: %s"
+ (eldoc-print-current-symbol-info)) )))))
;; If user has changed the idle delay, update the timer.
(cond ((not (= eldoc-idle-delay eldoc-current-idle-delay))
@@ -277,28 +295,29 @@ Otherwise work like `message'."
(or (window-in-direction 'above (minibuffer-window))
(minibuffer-selected-window)
(get-largest-window)))
- (when mode-line-format
- (unless (and (listp mode-line-format)
- (assq 'eldoc-mode-line-string mode-line-format))
+ (when (and mode-line-format
+ (not (and (listp mode-line-format)
+ (assq 'eldoc-mode-line-string mode-line-format))))
(setq mode-line-format
(list "" '(eldoc-mode-line-string
(" " eldoc-mode-line-string " "))
- mode-line-format))))
+ mode-line-format)))
(setq eldoc-mode-line-string
(when (stringp format-string)
(apply #'format-message format-string args)))
(force-mode-line-update)))
- (apply 'message format-string args)))
+ (apply #'message format-string args)))
-(defun eldoc-message (&optional string)
+(make-obsolete
+ 'eldoc-message "use `eldoc-documentation-functions' instead." "eldoc-1.1.0")
+(defun eldoc-message (&optional string) (eldoc--message string))
+(defun eldoc--message (&optional string)
"Display STRING as an ElDoc message if it's non-nil.
Also store it in `eldoc-last-message' and return that value."
(let ((omessage eldoc-last-message))
(setq eldoc-last-message string)
- ;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages
- ;; are recorded in a log. Do not put eldoc messages in that log since
- ;; they are Legion.
+ ;; Do not put eldoc messages in the log since they are Legion.
;; Emacs way of preventing log messages.
(let ((message-log-max nil))
(cond (eldoc-last-message
@@ -311,33 +330,58 @@ Also store it in `eldoc-last-message' and return that value."
(and (symbolp command)
(intern-soft (symbol-name command) eldoc-message-commands)))
-;; This function goes on pre-command-hook for XEmacs or when using idle
-;; timers in Emacs. Motion commands clear the echo area for some reason,
+;; This function goes on pre-command-hook.
+;; Motion commands clear the echo area for some reason,
;; which make eldoc messages flicker or disappear just before motion
;; begins. This function reprints the last eldoc message immediately
;; before the next command executes, which does away with the flicker.
;; This doesn't seem to be required for Emacs 19.28 and earlier.
+;; FIXME: The above comment suggests we don't really understand why
+;; this is needed. Maybe it's not needed any more, but if it is
+;; we should figure out why.
(defun eldoc-pre-command-refresh-echo-area ()
"Reprint `eldoc-last-message' in the echo area."
(and eldoc-last-message
(not (minibufferp)) ;We don't use the echo area when in minibuffer.
(if (and (eldoc-display-message-no-interference-p)
(eldoc--message-command-p this-command))
- (eldoc-message eldoc-last-message)
- ;; No need to call eldoc-message since the echo area will be cleared
+ (eldoc--message eldoc-last-message)
+ ;; No need to call eldoc--message since the echo area will be cleared
;; for us, but do note that the last-message will be gone.
(setq eldoc-last-message nil))))
-;; Decide whether now is a good time to display a message.
+(defvar-local eldoc--last-request-state nil
+ "Tuple containing information about last ElDoc request.")
+(defun eldoc--request-state ()
+ "Compute information to store in `eldoc--last-request-state'."
+ (list (current-buffer) (buffer-modified-tick) (point)))
+
(defun eldoc-display-message-p ()
- "Return non-nil when it is appropriate to display an ElDoc message."
- (and (eldoc-display-message-no-interference-p)
- ;; If this-command is non-nil while running via an idle
- ;; timer, we're still in the middle of executing a command,
- ;; e.g. a query-replace where it would be annoying to
- ;; overwrite the echo area.
- (not this-command)
- (eldoc--message-command-p last-command)))
+ (eldoc--request-docs-p (eldoc--request-state)))
+(make-obsolete 'eldoc-display-message-p
+ "Use `eldoc-documentation-functions' instead."
+ "eldoc-1.6.0")
+
+(defun eldoc--request-docs-p (request-state)
+ "Return non-nil when it is appropriate to request docs.
+REQUEST-STATE is a candidate for `eldoc--last-request-state'"
+ (and
+ ;; FIXME: The original idea behind this function is to protect the
+ ;; Echo area from ElDoc interference, but since that is only one of
+ ;; the possible outlets of ElDoc, this must soon be reworked.
+ (eldoc-display-message-no-interference-p)
+ (not (and eldoc--doc-buffer
+ (get-buffer-window eldoc--doc-buffer)
+ (equal request-state
+ (with-current-buffer
+ eldoc--doc-buffer
+ eldoc--last-request-state))))
+ ;; If this-command is non-nil while running via an idle
+ ;; timer, we're still in the middle of executing a command,
+ ;; e.g. a query-replace where it would be annoying to
+ ;; overwrite the echo area.
+ (not this-command)
+ (eldoc--message-command-p last-command)))
;; Check various conditions about the current environment that might make
@@ -347,74 +391,416 @@ Also store it in `eldoc-last-message' and return that value."
(not (or executing-kbd-macro (bound-and-true-p edebug-active))))
-;;;###autoload
-(defvar eldoc-documentation-function #'ignore
- "Function to call to return doc string.
-The function of no args should return a one-line string for displaying
-doc about a function etc. appropriate to the context around point.
-It should return nil if there's no doc appropriate for the context.
-Typically doc is returned if point is on a function-like name or in its
-arg list.
-
-The result is used as is, so the function must explicitly handle
-the variables `eldoc-argument-case' and `eldoc-echo-area-use-multiline-p',
-and the face `eldoc-highlight-function-argument', if they are to have any
-effect.
-
-Major modes should modify this variable using `add-function', for example:
- (add-function :before-until (local \\='eldoc-documentation-function)
- #\\='foo-mode-eldoc-function)
-so that the global documentation function (i.e. the default value of the
-variable) is taken into account if the major mode specific function does not
+(defvar eldoc-documentation-functions nil
+ "Hook of functions that produce doc strings.
+
+A doc string is typically relevant if point is on a function-like
+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
+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
+ return either the doc string, or nil if there's no doc
+ appropriate for the context.
+
+- If the computation of said doc string (or the decision whether
+ there is one at all) is expensive or can't be performed
+ directly, the hook function should return a non-nil, non-string
+ value and arrange for CALLBACK to be called at a later time,
+ using asynchronous processes or other asynchronous mechanisms.
+
+To call the CALLBACK function, the hook function must pass it an
+obligatory argument DOCSTRING, a string containing the
+documentation, followed by an optional list of keyword-value
+pairs of the form (:KEY VALUE :KEY2 VALUE2...). KEY can be:
+
+* `:thing', VALUE is a short string or symbol designating what is
+ being reported on. The documentation display engine can elect
+ to remove this information depending on space constraints;
+
+* `:face', VALUE is a symbol designating a face to use when
+ displaying `:thing''s value.
+
+Major modes should modify this hook locally, for example:
+ (add-hook \\='eldoc-documentation-functions #\\='foo-mode-eldoc nil t)
+so that the global value (i.e. the default value of the hook) is
+taken into account if the major mode specific function does not
return any documentation.")
-(defun eldoc-print-current-symbol-info ()
- "Print the text produced by `eldoc-documentation-function'."
- ;; This is run from post-command-hook or some idle timer thing,
- ;; so we need to be careful that errors aren't ignored.
- (with-demoted-errors "eldoc error: %s"
- (if (not (eldoc-display-message-p))
- ;; Erase the last message if we won't display a new one.
- (when eldoc-last-message
- (eldoc-message nil))
- (let ((non-essential t))
- ;; Only keep looking for the info as long as the user hasn't
- ;; requested our attention. This also locally disables inhibit-quit.
- (while-no-input
- (eldoc-message (funcall eldoc-documentation-function)))))))
-
-;; If the entire line cannot fit in the echo area, the symbol name may be
-;; truncated or eliminated entirely from the output to make room for the
-;; description.
-(defun eldoc-docstring-format-sym-doc (prefix doc &optional face)
- "Combine PREFIX and DOC, and shorten the result to fit in the echo area.
-
-When PREFIX is a symbol, propertize its symbol name with FACE
-before combining it with DOC. If FACE is not provided, just
-apply the nil face.
-
-See also: `eldoc-echo-area-use-multiline-p'."
- (when (symbolp prefix)
- (setq prefix (concat (propertize (symbol-name prefix) 'face face) ": ")))
- (let* ((ea-multi eldoc-echo-area-use-multiline-p)
- ;; Subtract 1 from window width since emacs will not write
- ;; any chars to the last column, or in later versions, will
- ;; cause a wraparound and resize of the echo area.
- (ea-width (1- (window-width (minibuffer-window))))
- (strip (- (+ (length prefix) (length doc)) ea-width)))
- (cond ((or (<= strip 0)
- (eq ea-multi t)
- (and ea-multi (> (length doc) ea-width)))
- (concat prefix doc))
- ((> (length doc) ea-width)
- (substring (format "%s" doc) 0 ea-width))
- ((>= strip (string-match-p ":? *\\'" prefix))
- doc)
+(defvar eldoc--doc-buffer nil "Buffer displaying latest ElDoc-produced docs.")
+
+(defun eldoc-doc-buffer (&optional interactive)
+ "Get latest *eldoc* help buffer. Interactively, display it."
+ (interactive (list t))
+ (prog1
+ (if (and eldoc--doc-buffer (buffer-live-p eldoc--doc-buffer))
+ eldoc--doc-buffer
+ (setq eldoc--doc-buffer (get-buffer-create "*eldoc*")))
+ (when interactive (display-buffer eldoc--doc-buffer))))
+
+
+(defun eldoc--handle-docs (docs)
+ "Display multiple DOCS in echo area.
+DOCS is a list of (STRING PLIST...). It is already sorted.
+Honor most of `eldoc-echo-area-use-multiline-p'."
+ ;; If there's nothing to report clear the echo area, but don't erase
+ ;; the last *eldoc* buffer.
+ (if (null docs) (eldoc--message nil)
+ (let*
+ ;; Otherwise, establish some parameters.
+ ((width (1- (window-width (minibuffer-window))))
+ (val (if (and (symbolp eldoc-echo-area-use-multiline-p)
+ eldoc-echo-area-use-multiline-p)
+ max-mini-window-height
+ eldoc-echo-area-use-multiline-p))
+ (available (cl-typecase val
+ (float (truncate (* (frame-height) val)))
+ (integer val)
+ (t 1)))
+ (things-reported-on)
+ (request eldoc--last-request-state)
+ single-doc single-doc-sym)
+ ;; Then, compose the contents of the `*eldoc*' buffer.
+ (with-current-buffer (eldoc-doc-buffer)
+ ;; Set doc-buffer's `eldoc--last-request-state', too
+ (setq eldoc--last-request-state request)
+ (let ((inhibit-read-only t))
+ (erase-buffer) (setq buffer-read-only t)
+ (local-set-key "q" 'quit-window)
+ (cl-loop for (docs . rest) on docs
+ for (this-doc . plist) = docs
+ for thing = (plist-get plist :thing)
+ when thing do
+ (cl-pushnew thing things-reported-on)
+ (setq this-doc
+ (concat
+ (propertize (format "%s" thing)
+ 'face (plist-get plist :face))
+ ": "
+ this-doc))
+ do (insert this-doc)
+ when rest do (insert "\n")))
+ ;; Rename the buffer.
+ (when things-reported-on
+ (rename-buffer (format "*eldoc for %s*"
+ (mapconcat (lambda (s) (format "%s" s))
+ things-reported-on
+ ", ")))))
+ ;; Finally, output to the echo area. I'm pretty sure nicer
+ ;; strategies can be used here, probably by splitting this
+ ;; function into some `eldoc-display-functions' special hook.
+ (let ((echo-area-message
+ (cond
+ (;; We handle the `truncate-sym-name-if-fit' special
+ ;; case first, by checking if for a lot of special
+ ;; conditions.
+ (and
+ (eq 'truncate-sym-name-if-fit eldoc-echo-area-use-multiline-p)
+ (null (cdr docs))
+ (setq single-doc (caar docs))
+ (setq single-doc-sym
+ (format "%s" (plist-get (cdar docs) :thing)))
+ (< (length single-doc) width)
+ (not (string-match "\n" single-doc))
+ (> (+ (length single-doc) (length single-doc-sym) 2) width))
+ single-doc)
+ ((> available 1)
+ ;; The message takes one extra line, so if we don't
+ ;; display that, we have one extra line to use.
+ (unless eldoc-display-truncation-message
+ (setq available (1+ available)))
+ (with-current-buffer (eldoc-doc-buffer)
+ (cl-loop
+ initially
+ (goto-char (point-min))
+ (goto-char (line-end-position (1+ available)))
+ for truncated = nil then t
+ for needed
+ = (let ((truncate-lines message-truncate-lines))
+ (count-screen-lines (point-min) (point) t
+ (minibuffer-window)))
+ while (> needed (if truncated (1- available) available))
+ do (goto-char (line-end-position (if truncated 0 -1)))
+ (while (and (not (bobp)) (bolp)) (goto-char (line-end-position 0)))
+ finally
+ (unless (and truncated
+ eldoc-prefer-doc-buffer
+ (get-buffer-window eldoc--doc-buffer))
+ (cl-return
+ (concat
+ (buffer-substring (point-min) (point))
+ (and
+ truncated
+ (if eldoc-display-truncation-message
+ (format
+ "\n(Documentation truncated. Use `%s' to see rest)"
+ (substitute-command-keys "\\[eldoc-doc-buffer]"))
+ "..."))))))))
+ ((= available 1)
+ ;; Truncate "brutally." ; FIXME: use `eldoc-prefer-doc-buffer' too?
+ (with-current-buffer (eldoc-doc-buffer)
+ (truncate-string-to-width
+ (buffer-substring (goto-char (point-min)) (line-end-position 1)) width))))))
+ (when echo-area-message
+ (eldoc--message echo-area-message))))))
+
+(defun eldoc-documentation-default ()
+ "Show first doc string for item at point.
+Default value for `eldoc-documentation-strategy'."
+ (run-hook-with-args-until-success 'eldoc-documentation-functions
+ (eldoc--make-callback :patient)))
+
+(defun eldoc--documentation-compose-1 (eagerlyp)
+ "Helper function for composing multiple doc strings.
+If EAGERLYP is non-nil show documentation as soon as possible,
+else wait for all doc strings."
+ (run-hook-wrapped 'eldoc-documentation-functions
+ (lambda (f)
+ (let* ((callback (eldoc--make-callback
+ (if eagerlyp :eager :patient)))
+ (str (funcall f callback)))
+ (if (or (null str) (stringp str)) (funcall callback str))
+ nil)))
+ t)
+
+(defun eldoc-documentation-compose ()
+ "Show multiple doc strings at once after waiting for all.
+Meant as a value for `eldoc-documentation-strategy'."
+ (eldoc--documentation-compose-1 nil))
+
+(defun eldoc-documentation-compose-eagerly ()
+ "Show multiple doc strings at once as soon as possible.
+Meant as a value for `eldoc-documentation-strategy'."
+ (eldoc--documentation-compose-1 t))
+
+(defun eldoc-documentation-enthusiast ()
+ "Show most important doc string produced so far.
+Meant as a value for `eldoc-documentation-strategy'."
+ (run-hook-wrapped 'eldoc-documentation-functions
+ (lambda (f)
+ (let* ((callback (eldoc--make-callback :enthusiast))
+ (str (funcall f callback)))
+ (if (stringp str) (funcall callback str))
+ nil)))
+ t)
+
+;; JT@2020-07-10: ElDoc is pre-loaded, so in Emacs < 28 we can't
+;; make the "old" `eldoc-documentation-function' point to the new
+;; `eldoc-documentation-strategy', so we do the reverse. This allows
+;; for ElDoc to be loaded in those older Emacs versions and work with
+;; whomever (major-modes, extensions, user) sets one or the other
+;; variable.
+(defmacro eldoc--documentation-strategy-defcustom
+ (main secondary value docstring &rest more)
+ "Defcustom helper macro for sorting `eldoc-documentation-strategy'."
+ (declare (indent 2))
+ `(if (< emacs-major-version 28)
+ (progn
+ (defcustom ,secondary ,value ,docstring ,@more)
+ (define-obsolete-variable-alias ',main ',secondary "eldoc-1.1.0"))
+ (progn
+ (defcustom ,main ,value ,docstring ,@more)
+ (defvaralias ',secondary ',main ,docstring))))
+
+(eldoc--documentation-strategy-defcustom eldoc-documentation-strategy
+ eldoc-documentation-function
+ #'eldoc-documentation-default
+ "How to collect and organize results of `eldoc-documentation-functions'.
+
+This variable controls how `eldoc-documentation-functions', which
+specifies the sources of documentation, is queried and how its
+results are organized before being displayed to the user. The
+following values are allowed:
+
+- `eldoc-documentation-default': calls functions in the special
+ hook in order until one is found that produces a doc string
+ value. Display only that value;
+
+- `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;
+
+- `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
+ relative order of doc strings;
+
+- `eldoc-documentation-enthusiast': calls all functions in the
+ special hook and displays only the most important resulting
+ docstring one at any given time. A function appearing first in
+ the special hook is considered more important.
+
+This variable can also be set to a function of no args that
+returns something other than a string or nil and allows for some
+or all of the special hook `eldoc-documentation-functions' to be
+run. In that case, the strategy function should follow that
+other variable's protocol closely and endeavor to display the
+resulting doc strings itself.
+
+For backward compatibility to the \"old\" protocol, this variable
+can also be set to a function that returns nil or a doc string,
+depending whether or not there is documentation to display at
+all."
+ :link '(info-link "(emacs) Lisp Doc")
+ :type '(radio (function-item eldoc-documentation-default)
+ (function-item eldoc-documentation-compose)
+ (function-item eldoc-documentation-compose-eagerly)
+ (function-item eldoc-documentation-enthusiast)
+ (function :tag "Other function"))
+ :version "28.1")
+
+(defun eldoc--supported-p ()
+ "Non-nil if an ElDoc function is set for this buffer."
+ (and (not (memq eldoc-documentation-strategy '(nil ignore)))
+ (or eldoc-documentation-functions
+ ;; The old API had major modes set `eldoc-documentation-function'
+ ;; to provide eldoc support. It's impossible now to determine
+ ;; reliably whether the `eldoc-documentation-strategy' provides
+ ;; eldoc support (as in the old API) or whether it just provides
+ ;; a way to combine the results of the
+ ;; `eldoc-documentation-functions' (as in the new API).
+ ;; But at least if it's set buffer-locally it's a good hint that
+ ;; there's some eldoc support in the current buffer.
+ (local-variable-p 'eldoc-documentation-strategy))))
+
+(defvar eldoc--enthusiasm-curbing-timer nil
+ "Timer used by the `eldoc-documentation-enthusiast' strategy.
+When a doc string is encountered, it must endure a certain amount
+of time unchallenged until it is displayed to the user. This
+prevents blinking if a lower priority docstring comes in shortly
+before a higher priority one.")
+
+(defalias 'eldoc #'eldoc-print-current-symbol-info)
+
+;; This variable should be unbound, but that confuses
+;; `describe-symbol' for some reason.
+(defvar eldoc--make-callback nil "Helper for function `eldoc--make-callback'.")
+
+;; JT@2020-07-08: the below docstring for the internal function
+;; `eldoc--invoke-strategy' could be moved to
+;; `eldoc-documentation-strategy' or thereabouts if/when we decide to
+;; extend or publish the `make-callback' protocol.
+(defun eldoc--make-callback (method)
+ "Make callback suitable for `eldoc-documentation-functions'.
+The return value is a function FN whose lambda list is (STRING
+&rest PLIST) and can be called by those functions. Its
+responsibility is always to register the docstring STRING along
+with options specified in PLIST as the documentation to display
+for each particular situation.
+
+METHOD specifies how the callback behaves relative to other
+competing elements in `eldoc-documentation-functions'. It can
+have the following values:
+
+- `:enthusiast' says to display STRING as soon as possible if
+ there's no higher priority doc string;
+
+- `:patient' says to display STRING along with all other
+ competing strings but only when all of all
+ `eldoc-documentation-functions' have been collected;
+
+- `:eager' says to display STRING along with all other competing
+ strings so far, as soon as possible."
+ (funcall eldoc--make-callback method))
+
+(defun eldoc--invoke-strategy ()
+ "Invoke `eldoc-documentation-strategy' function.
+
+That function's job is to run the `eldoc-documentation-functions'
+special hook, using the `run-hook' family of functions. ElDoc's
+built-in strategy functions play along with the
+`eldoc--make-callback' protocol, using it to produce callback to
+feed to the functgions of `eldoc-documentation-functions'.
+
+Other third-party strategy functions do 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 the docstrings eventually produced."
+ (let* (;; How many callbacks have been created by the strategy
+ ;; function and passed to elements of
+ ;; `eldoc-documentation-functions'.
+ (howmany 0)
+ ;; How many calls to callbacks we're still waiting on. Used
+ ;; by `:patient'.
+ (want 0)
+ ;; The doc strings and corresponding options registered so
+ ;; far.
+ (docs-registered '()))
+ (cl-labels
+ ((register-doc
+ (pos string plist)
+ (when (and string (> (length string) 0))
+ (push (cons pos (cons string plist)) docs-registered)))
+ (display-doc
+ ()
+ (eldoc--handle-docs
+ (mapcar #'cdr
+ (setq docs-registered
+ (sort docs-registered
+ (lambda (a b) (< (car a) (car b))))))))
+ (make-callback
+ (method)
+ (let ((pos (prog1 howmany (cl-incf howmany))))
+ (cl-ecase method
+ (:enthusiast
+ (lambda (string &rest plist)
+ (when (and string (cl-loop for (p) in docs-registered
+ never (< p pos)))
+ (setq docs-registered '())
+ (register-doc pos string plist))
+ (when (and (timerp eldoc--enthusiasm-curbing-timer)
+ (memq eldoc--enthusiasm-curbing-timer
+ timer-list))
+ (cancel-timer eldoc--enthusiasm-curbing-timer))
+ (setq eldoc--enthusiasm-curbing-timer
+ (run-at-time (unless (zerop pos) 0.3)
+ nil #'display-doc))
+ t))
+ (:patient
+ (cl-incf want)
+ (lambda (string &rest plist)
+ (register-doc pos string plist)
+ (when (zerop (cl-decf want)) (display-doc))
+ t))
+ (:eager
+ (lambda (string &rest plist)
+ (register-doc pos string plist)
+ (display-doc)
+ t))))))
+ (let* ((eldoc--make-callback #'make-callback)
+ (res (funcall eldoc-documentation-strategy)))
+ ;; Observe the old and the new protocol:
+ (cond (;; Old protocol: got string, output immediately;
+ (stringp res) (register-doc 0 res nil) (display-doc))
+ (;; Old protocol: got nil, clear the echo area;
+ (null res) (eldoc--message nil))
+ (;; New protocol: trust callback will be called;
+ t))))))
+
+(defun eldoc-print-current-symbol-info (&optional interactive)
+ "Document thing at point."
+ (interactive '(t))
+ (let ((token (eldoc--request-state)))
+ (cond (interactive
+ (eldoc--invoke-strategy))
+ ((not (eldoc--request-docs-p token))
+ ;; Erase the last message if we won't display a new one.
+ (when eldoc-last-message
+ (eldoc--message nil)))
(t
- ;; Show the end of the partial symbol name, rather
- ;; than the beginning, since the former is more likely
- ;; to be unique given package namespace conventions.
- (concat (substring prefix strip) doc)))))
+ (let ((non-essential t))
+ (setq eldoc--last-request-state token)
+ ;; Only keep looking for the info as long as the user hasn't
+ ;; requested our attention. This also locally disables
+ ;; inhibit-quit.
+ (while-no-input
+ (eldoc--invoke-strategy)))))))
;; When point is in a sexp, the function args are not reprinted in the echo
;; area after every possible interactive command because some of them print
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index f68c0faf09d..a94978ac47b 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -342,9 +342,9 @@ Use optional LIST if provided instead."
(interactive
(list
(intern
- (completing-read "Master function: " obarray
- #'elp--instrumented-p
- t nil nil (if elp-master (symbol-name elp-master))))))
+ (let ((default (if elp-master (symbol-name elp-master))))
+ (completing-read (format-prompt "Master function" default)
+ obarray #'elp--instrumented-p t nil nil default)))))
;; When there's a master function, recording is turned off by default.
(setq elp-master funsym
elp-record-p nil)
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 622f5654b25..6569b8ccc87 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -177,6 +177,18 @@ test for `called-interactively' in the command will fail."
(cl-assert (not unread-command-events) t)
return-value))
+(defmacro ert-simulate-keys (keys &rest body)
+ "Execute BODY with KEYS as pseudo-interactive input."
+ (declare (debug t) (indent 1))
+ `(let ((unread-command-events
+ ;; Add some C-g to try and make sure we still exit
+ ;; in case something goes wrong.
+ (append ,keys '(?\C-g ?\C-g ?\C-g)))
+ ;; Tell `read-from-minibuffer' not to read from stdin when in
+ ;; batch mode.
+ (executing-kbd-macro t))
+ ,@body))
+
(defun ert-run-idle-timers ()
"Run all idle timers (from `timer-idle-list')."
(dolist (timer (copy-sequence timer-idle-list))
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 3c4891b49ae..ebb27e8a62c 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -515,7 +515,14 @@ Returns nil if they are."
`(cdr ,cdr-x)
(cl-assert (equal a b) t)
nil))))))))
- ((pred arrayp)
+ ((pred cl-struct-p)
+ (cl-loop for slot in (cl-struct-slot-info (type-of a))
+ for ai across a
+ for bi across b
+ for xf = (ert--explain-equal-rec ai bi)
+ do (when xf (cl-return `(struct-field ,(car slot) ,xf)))
+ finally (cl-assert (equal a b) t)))
+ ((or (pred arrayp) (pred recordp))
;; For mixed unibyte/multibyte string comparisons, make both multibyte.
(when (and (stringp a)
(xor (multibyte-string-p a) (multibyte-string-p b)))
@@ -1628,9 +1635,7 @@ Signals an error if no test name was read."
nil)))
(ert-test (setq default (ert-test-name default))))
(when add-default-to-prompt
- (setq prompt (if (null default)
- (format "%s: " prompt)
- (format "%s (default %s): " prompt default))))
+ (setq prompt (format-prompt prompt default)))
(let ((input (completing-read prompt obarray #'ert-test-boundp
t nil history default nil)))
;; completing-read returns an empty string if default was nil and
@@ -2016,9 +2021,7 @@ and how to display message."
(car ert--selector-history)
"t")))
(read
- (completing-read (if (null default)
- "Run tests: "
- (format "Run tests (default %s): " default))
+ (completing-read (format-prompt "Run tests" default)
obarray #'ert-test-boundp nil nil
'ert--selector-history default nil)))
nil))
diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el
index 78ada3e076d..5112322cfd6 100644
--- a/lisp/emacs-lisp/ewoc.el
+++ b/lisp/emacs-lisp/ewoc.el
@@ -205,15 +205,26 @@ NODE and leaving the new node's start there. Return the new node."
(defun ewoc--refresh-node (pp node dll)
"Redisplay the element represented by NODE using the pretty-printer PP."
- (let ((inhibit-read-only t)
- (m (ewoc--node-start-marker node))
- (R (ewoc--node-right node)))
- ;; First, remove the string from the buffer:
- (delete-region m (ewoc--node-start-marker R))
- ;; Calculate and insert the string.
- (goto-char m)
- (funcall pp (ewoc--node-data node))
- (ewoc--adjust m (point) R dll)))
+ (let* ((m (ewoc--node-start-marker node))
+ (R (ewoc--node-right node))
+ (end (ewoc--node-start-marker R))
+ (inhibit-read-only t)
+ (offset (if (= (point) end)
+ 'end
+ (when (< m (point) end)
+ (- (point) m)))))
+ (save-excursion
+ ;; First, remove the string from the buffer:
+ (delete-region m end)
+ ;; Calculate and insert the string.
+ (goto-char m)
+ (funcall pp (ewoc--node-data node))
+ (setq end (point))
+ (ewoc--adjust m (point) R dll))
+ (when offset
+ (goto-char (if (eq offset 'end)
+ end
+ (min (+ m offset) (1- end)))))))
(defun ewoc--wrap (func)
(lambda (data)
@@ -342,11 +353,10 @@ arguments will be passed to MAP-FUNCTION."
((footer (ewoc--footer ewoc))
(pp (ewoc--pretty-printer ewoc))
(node (ewoc--node-nth dll 1)))
- (save-excursion
- (while (not (eq node footer))
- (if (apply map-function (ewoc--node-data node) args)
- (ewoc--refresh-node pp node dll))
- (setq node (ewoc--node-next dll node))))))
+ (while (not (eq node footer))
+ (if (apply map-function (ewoc--node-data node) args)
+ (ewoc--refresh-node pp node dll))
+ (setq node (ewoc--node-next dll node)))))
(defun ewoc-delete (ewoc &rest nodes)
"Delete NODES from EWOC."
@@ -461,9 +471,8 @@ If the EWOC is empty, nil is returned."
Delete current text first, thus effecting a \"refresh\"."
(ewoc--set-buffer-bind-dll-let* ewoc
((pp (ewoc--pretty-printer ewoc)))
- (save-excursion
- (dolist (node nodes)
- (ewoc--refresh-node pp node dll)))))
+ (dolist (node nodes)
+ (ewoc--refresh-node pp node dll))))
(defun ewoc-goto-prev (ewoc arg)
"Move point to the ARGth previous element in EWOC.
@@ -566,9 +575,8 @@ Return nil if the buffer has been deleted."
(hf-pp (ewoc--hf-pp ewoc)))
(setf (ewoc--node-data head) header
(ewoc--node-data foot) footer)
- (save-excursion
- (ewoc--refresh-node hf-pp head dll)
- (ewoc--refresh-node hf-pp foot dll))))
+ (ewoc--refresh-node hf-pp head dll)
+ (ewoc--refresh-node hf-pp foot dll)))
(provide 'ewoc)
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 167ead3ce02..ee94e1fbff7 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -61,7 +61,7 @@
"^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\
ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\
foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\
-menu-bar-make-toggle\\)"
+menu-bar-make-toggle\\|menu-bar-make-toggle-command\\)"
find-function-space-re
"\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)")
"The regexp used by `find-function' to search for a function definition.
@@ -279,25 +279,17 @@ Interactively, prompt for LIBRARY using the one at or near point."
(switch-to-buffer (find-file-noselect (find-library-name library)))
(run-hooks 'find-function-after-hook)))
+;;;###autoload
(defun read-library-name ()
"Read and return a library name, defaulting to the one near point.
A library name is the filename of an Emacs Lisp library located
in a directory under `load-path' (or `find-function-source-path',
if non-nil)."
- (let* ((suffix-regexp (mapconcat
- (lambda (suffix)
- (concat (regexp-quote suffix) "\\'"))
- (find-library-suffixes)
- "\\|"))
- (table (cl-loop for dir in (or find-function-source-path load-path)
- when (file-readable-p dir)
- append (mapcar
- (lambda (file)
- (replace-regexp-in-string suffix-regexp
- "" file))
- (directory-files dir nil
- suffix-regexp))))
+ (let* ((dirs (or find-function-source-path load-path))
+ (suffixes (find-library-suffixes))
+ (table (apply-partially 'locate-file-completion-table
+ dirs suffixes))
(def (if (eq (function-called-at-point) 'require)
;; `function-called-at-point' may return 'require
;; with `point' anywhere on this line. So wrap the
@@ -313,9 +305,7 @@ if non-nil)."
(thing-at-point 'symbol))))
(when (and def (not (test-completion def table)))
(setq def nil))
- (completing-read (if def
- (format "Library name (default %s): " def)
- "Library name: ")
+ (completing-read (format-prompt "Library name" def)
table nil nil nil nil def)))
;;;###autoload
@@ -483,12 +473,10 @@ otherwise uses `variable-at-point'."
(prompt-type (cdr (assq type '((nil . "function")
(defvar . "variable")
(defface . "face")))))
- (prompt (concat "Find " prompt-type
- (and symb (format " (default %s)" symb))
- ": "))
(enable-recursive-minibuffers t))
(list (intern (completing-read
- prompt obarray predicate
+ (format-prompt "Find %s" symb prompt-type)
+ obarray predicate
t nil nil (and symb (symbol-name symb)))))))
(defun find-function-do-it (symbol type switch-fn)
diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el
index 50b157b16a4..d92ca5b9337 100644
--- a/lisp/emacs-lisp/float-sup.el
+++ b/lisp/emacs-lisp/float-sup.el
@@ -1,4 +1,4 @@
-;;; float-sup.el --- define some constants useful for floating point numbers.
+;;; float-sup.el --- define some constants useful for floating point numbers. -*- lexical-binding:t -*-
;; Copyright (C) 1985-1987, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index 26ab2679e22..c95c758a571 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -153,7 +153,7 @@ DYNAMIC-VAR bound to STATIC-VAR."
(defun cps--add-state (kind body)
"Create a new CPS state of KIND with BODY and return the state's name."
(declare (indent 1))
- (let* ((state (cps--gensym "cps-state-%s-" kind)))
+ (let ((state (cps--gensym "cps-state-%s-" kind)))
(push (list state body cps--cleanup-function) cps--states)
(push state cps--bindings)
state))
@@ -673,7 +673,7 @@ When called as a function, NAME returns an iterator value that
encapsulates the state of a computation that produces a sequence
of values. Callers can retrieve each value using `iter-next'."
(declare (indent defun)
- (debug (&define name lambda-list lambda-doc def-body))
+ (debug (&define name lambda-list lambda-doc &rest sexp))
(doc-string 3))
(cl-assert lexical-binding)
(let* ((parsed-body (macroexp-parse-body body))
@@ -687,14 +687,14 @@ of values. Callers can retrieve each value using `iter-next'."
"Return a lambda generator.
`iter-lambda' is to `iter-defun' as `lambda' is to `defun'."
(declare (indent defun)
- (debug (&define lambda-list lambda-doc def-body)))
+ (debug (&define lambda-list lambda-doc &rest sexp)))
(cl-assert lexical-binding)
`(lambda ,arglist
,(cps-generate-evaluator body)))
(defmacro iter-make (&rest body)
"Return a new iterator."
- (declare (debug t))
+ (declare (debug (&rest sexp)))
(cps-generate-evaluator body))
(defconst iter-empty (lambda (_op _val) (signal 'iter-end-of-sequence nil))
@@ -720,7 +720,7 @@ is blocked."
Evaluate BODY with VAR bound to each value from ITERATOR.
Return the value with which ITERATOR finished iteration."
(declare (indent 1)
- (debug ((symbolp form) body)))
+ (debug ((symbolp form) &rest sexp)))
(let ((done-symbol (cps--gensym "iter-do-iterator-done"))
(condition-symbol (cps--gensym "iter-do-condition"))
(it-symbol (cps--gensym "iter-do-iterator"))
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el
index 06ef5800568..3bc6d021dc8 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -116,6 +116,10 @@ instead (which see).")
function-list &optional docstring)
"Create a new generic mode MODE.
+A \"generic\" mode is a simple major mode with basic support for
+comment syntax and Font Lock mode, but otherwise does not have
+any special keystrokes or functionality available.
+
MODE is the name of the command for the generic mode; don't quote it.
The optional DOCSTRING is the documentation for the mode command. If
you do not supply it, `define-generic-mode' uses a default
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 065a9688770..5470b8532fc 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -166,15 +166,25 @@ arguments as NAME. DO is a function as defined in `gv-get'."
;; (`(expand ,expander) `(gv-define-expand ,name ,expander))
(_ (message "Unknown %s declaration %S" symbol handler) nil))))
+;; Additions for `declare'. We specify the values as named aliases so
+;; that `describe-variable' prints something useful; cf. Bug#40491.
+
+;;;###autoload
+(defsubst gv--expander-defun-declaration (&rest args)
+ (apply #'gv--defun-declaration 'gv-expander args))
+
+;;;###autoload
+(defsubst gv--setter-defun-declaration (&rest args)
+ (apply #'gv--defun-declaration 'gv-setter args))
+
;;;###autoload
(or (assq 'gv-expander defun-declarations-alist)
- (let ((x `(gv-expander
- ,(apply-partially #'gv--defun-declaration 'gv-expander))))
+ (let ((x (list 'gv-expander #'gv--expander-defun-declaration)))
(push x macro-declarations-alist)
(push x defun-declarations-alist)))
;;;###autoload
(or (assq 'gv-setter defun-declarations-alist)
- (push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter))
+ (push (list 'gv-setter #'gv--setter-defun-declaration)
defun-declarations-alist))
;; (defmacro gv-define-expand (name expander)
@@ -214,7 +224,7 @@ 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 sexp def-body)))
+ (declare (indent 2) (debug (&define name :name gv-setter sexp def-body)))
`(gv-define-expander ,name
(lambda (do &rest args)
(declare-function
@@ -407,6 +417,17 @@ The return value is the last VAL in the list.
`(delq ,p ,getter))))))
,v))))))))))
+(gv-define-expander plist-get
+ (lambda (do plist prop)
+ (macroexp-let2 macroexp-copyable-p key prop
+ (gv-letplace (getter setter) plist
+ (macroexp-let2 nil p `(cdr (plist-member ,getter ,key))
+ (funcall do
+ `(car ,p)
+ (lambda (val)
+ `(if ,p
+ (setcar ,p ,val)
+ ,(funcall setter `(cons ,key (cons ,val ,getter)))))))))))
;;; Some occasionally handy extensions.
@@ -517,9 +538,12 @@ This macro only makes sense when used in a place."
(gv-letplace (dgetter dsetter) d
(funcall do
`(cons ,agetter ,dgetter)
- (lambda (v) `(progn
- ,(funcall asetter `(car ,v))
- ,(funcall dsetter `(cdr ,v)))))))))
+ (lambda (v)
+ (macroexp-let2 nil v v
+ `(progn
+ ,(funcall asetter `(car ,v))
+ ,(funcall dsetter `(cdr ,v))
+ ,v))))))))
(put 'logand 'gv-expander
(lambda (do place &rest masks)
@@ -529,9 +553,12 @@ This macro only makes sense when used in a place."
(funcall
do `(logand ,getter ,mask)
(lambda (v)
- (funcall setter
- `(logior (logand ,v ,mask)
- (logand ,getter (lognot ,mask))))))))))
+ (macroexp-let2 nil v v
+ `(progn
+ ,(funcall setter
+ `(logior (logand ,v ,mask)
+ (logand ,getter (lognot ,mask))))
+ ,v))))))))
;;; References
diff --git a/lisp/emacs-lisp/hierarchy.el b/lisp/emacs-lisp/hierarchy.el
new file mode 100644
index 00000000000..8cef029c4cf
--- /dev/null
+++ b/lisp/emacs-lisp/hierarchy.el
@@ -0,0 +1,579 @@
+;;; hierarchy.el --- Library to create and display hierarchy structures -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Damien Cassou <damien@cassou.me>
+;; Maintainer: emacs-devel@gnu.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Library to create, query, navigate and display hierarchy structures.
+
+;; Creation: After having created a hierarchy with `hierarchy-new',
+;; populate it by calling `hierarchy-add-tree' or
+;; `hierarchy-add-trees'. You can then optionally sort its element
+;; with `hierarchy-sort'.
+
+;; Querying: You can learn more about your hierarchy by using
+;; functions such as `hierarchy-roots', `hierarchy-has-item',
+;; `hierarchy-length', `hierarchy-parent', `hierarchy-descendant-p'.
+
+;; Navigation: When your hierarchy is ready, you can use
+;; `hierarchy-map-item', `hierarchy-map', and `map-tree' to apply
+;; functions to elements of the hierarchy.
+
+;; Display: You can display a hierarchy as a tabulated list using
+;; `hierarchy-tabulated-display' and as an expandable/foldable tree
+;; using `hierarchy-convert-to-tree-widget'. The
+;; `hierarchy-labelfn-*' functions will help you display each item of
+;; the hierarchy the way you want it.
+
+;;; Limitation:
+
+;; - Current implementation uses #'equal to find and distinguish
+;; elements. Support for user-provided equality definition is
+;; desired but not yet implemented;
+;;
+;; - nil can't be added to a hierarchy;
+;;
+;; - the hierarchy is computed eagerly.
+
+;;; Code:
+
+(require 'seq)
+(require 'map)
+(require 'subr-x)
+(require 'cl-lib)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helpers
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(cl-defstruct (hierarchy
+ (:constructor hierarchy--make)
+ (:conc-name hierarchy--))
+ (roots (list)) ; list of the hierarchy roots (no parent)
+ (parents (make-hash-table :test 'equal)) ; map an item to its parent
+ (children (make-hash-table :test 'equal)) ; map an item to its childre
+ ;; cache containing the set of all items in the hierarchy
+ (seen-items (make-hash-table :test 'equal))) ; map an item to t
+
+(defun hierarchy--seen-items-add (hierarchy item)
+ "In HIERARCHY, add ITEM to seen items."
+ (map-put! (hierarchy--seen-items hierarchy) item t))
+
+(defun hierarchy--compute-roots (hierarchy)
+ "Search roots of HIERARCHY and return them."
+ (cl-set-difference
+ (map-keys (hierarchy--seen-items hierarchy))
+ (map-keys (hierarchy--parents hierarchy))
+ :test #'equal))
+
+(defun hierarchy--sort-roots (hierarchy sortfn)
+ "Compute, sort and store the roots of HIERARCHY.
+
+SORTFN is a function taking two items of the hierarchy as parameter and
+returning non-nil if the first parameter is lower than the second."
+ (setf (hierarchy--roots hierarchy)
+ (sort (hierarchy--compute-roots hierarchy)
+ sortfn)))
+
+(defun hierarchy--add-relation (hierarchy item parent acceptfn)
+ "In HIERARCHY, add ITEM as child of PARENT.
+
+ACCEPTFN is a function returning non-nil if its parameter (any object)
+should be an item of the hierarchy."
+ (let* ((existing-parent (hierarchy-parent hierarchy item))
+ (has-parent-p (funcall acceptfn existing-parent)))
+ (cond
+ ((and has-parent-p (not (equal existing-parent parent)))
+ (error "An item (%s) can only have one parent: '%s' vs '%s'"
+ item existing-parent parent))
+ ((not has-parent-p)
+ (let ((existing-children (map-elt (hierarchy--children hierarchy)
+ parent (list))))
+ (map-put! (hierarchy--children hierarchy)
+ parent (append existing-children (list item))))
+ (map-put! (hierarchy--parents hierarchy) item parent)))))
+
+(defun hierarchy--set-equal (list1 list2 &rest cl-keys)
+ "Return non-nil if LIST1 and LIST2 have same elements.
+
+I.e., if every element of LIST1 also appears in LIST2 and if
+every element of LIST2 also appears in LIST1.
+
+CL-KEYS are key-value pairs just like in `cl-subsetp'. Supported
+keys are :key and :test."
+ (and (apply 'cl-subsetp list1 list2 cl-keys)
+ (apply 'cl-subsetp list2 list1 cl-keys)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Creation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun hierarchy-new ()
+ "Create a hierarchy and return it."
+ (hierarchy--make))
+
+(defun hierarchy-add-tree (hierarchy item parentfn &optional childrenfn acceptfn)
+ "In HIERARCHY, add ITEM.
+
+PARENTFN is either nil or a function defining the child-to-parent
+relationship: this function takes an item as parameter and should return
+the parent of this item in the hierarchy. If the item has no parent in the
+hierarchy (i.e., it should be a root), the function should return an object
+not accepted by acceptfn (i.e., nil for the default value of acceptfn).
+
+CHILDRENFN is either nil or a function defining the parent-to-children
+relationship: this function takes an item as parameter and should return a
+list of children of this item in the hierarchy.
+
+If both PARENTFN and CHILDRENFN are non-nil, the results of PARENTFN and
+CHILDRENFN are expected to be coherent with each other.
+
+ACCEPTFN is a function returning non-nil if its parameter (any object)
+should be an item of the hierarchy. By default, ACCEPTFN returns non-nil
+if its parameter is non-nil."
+ (unless (hierarchy-has-item hierarchy item)
+ (let ((acceptfn (or acceptfn #'identity)))
+ (hierarchy--seen-items-add hierarchy item)
+ (let ((parent (and parentfn (funcall parentfn item))))
+ (when (funcall acceptfn parent)
+ (hierarchy--add-relation hierarchy item parent acceptfn)
+ (hierarchy-add-tree hierarchy parent parentfn childrenfn)))
+ (let ((children (and childrenfn (funcall childrenfn item))))
+ (mapc (lambda (child)
+ (when (funcall acceptfn child)
+ (hierarchy--add-relation hierarchy child item acceptfn)
+ (hierarchy-add-tree hierarchy child parentfn childrenfn)))
+ children)))))
+
+(defun hierarchy-add-trees (hierarchy items parentfn &optional childrenfn acceptfn)
+ "Call `hierarchy-add-tree' on HIERARCHY and each element of ITEMS.
+
+PARENTFN, CHILDRENFN and ACCEPTFN have the same meaning as in `hierarchy-add'."
+ (seq-map (lambda (item)
+ (hierarchy-add-tree hierarchy item parentfn childrenfn acceptfn))
+ items))
+
+(defun hierarchy-add-list (hierarchy list &optional wrap childrenfn)
+ "Add to HIERARCHY the sub-lists in LIST.
+
+If WRAP is non-nil, allow duplicate items in LIST by wraping each
+item in a cons (id . item). The root's id is 1.
+
+CHILDRENFN is a function (defaults to `cdr') taking LIST as a
+parameter which should return LIST's children (a list). Each
+child is (recursively) passed as a parameter to CHILDRENFN to get
+its own children. Because of this parameter, LIST can be
+anything, not necessarily a list."
+ (let* ((childrenfn (or childrenfn #'cdr))
+ (id 0)
+ (wrapfn (lambda (item)
+ (if wrap
+ (cons (setq id (1+ id)) item)
+ item)))
+ (unwrapfn (if wrap #'cdr #'identity)))
+ (hierarchy-add-tree
+ hierarchy (funcall wrapfn list) nil
+ (lambda (item)
+ (mapcar wrapfn (funcall childrenfn
+ (funcall unwrapfn item)))))
+ hierarchy))
+
+(defun hierarchy-from-list (list &optional wrap childrenfn)
+ "Create and return a hierarchy built from LIST.
+
+This function passes LIST, WRAP and CHILDRENFN unchanged to
+`hierarchy-add-list'."
+ (hierarchy-add-list (hierarchy-new) list wrap childrenfn))
+
+(defun hierarchy-sort (hierarchy &optional sortfn)
+ "Modify HIERARCHY so that its roots and item's children are sorted.
+
+SORTFN is a function taking two items of the hierarchy as parameter and
+returning non-nil if the first parameter is lower than the second. By
+default, SORTFN is `string-lessp'."
+ (let ((sortfn (or sortfn #'string-lessp)))
+ (hierarchy--sort-roots hierarchy sortfn)
+ (mapc (lambda (parent)
+ (setf
+ (map-elt (hierarchy--children hierarchy) parent)
+ (sort (map-elt (hierarchy--children hierarchy) parent) sortfn)))
+ (map-keys (hierarchy--children hierarchy)))))
+
+(defun hierarchy-extract-tree (hierarchy item)
+ "Return a copy of HIERARCHY with ITEM's descendants and parents."
+ (if (not (hierarchy-has-item hierarchy item))
+ nil
+ (let ((tree (hierarchy-new)))
+ (hierarchy-add-tree tree item
+ (lambda (each) (hierarchy-parent hierarchy each))
+ (lambda (each)
+ (when (or (equal each item)
+ (hierarchy-descendant-p hierarchy each item))
+ (hierarchy-children hierarchy each))))
+ tree)))
+
+(defun hierarchy-copy (hierarchy)
+ "Return a copy of HIERARCHY.
+
+Items in HIERARCHY are shared, but structure is not."
+ (hierarchy-map-hierarchy (lambda (item _) (identity item)) hierarchy))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Querying
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun hierarchy-items (hierarchy)
+ "Return a list of all items of HIERARCHY."
+ (map-keys (hierarchy--seen-items hierarchy)))
+
+(defun hierarchy-has-item (hierarchy item)
+ "Return t if HIERARCHY includes ITEM."
+ (map-contains-key (hierarchy--seen-items hierarchy) item))
+
+(defun hierarchy-empty-p (hierarchy)
+ "Return t if HIERARCHY is empty."
+ (= 0 (hierarchy-length hierarchy)))
+
+(defun hierarchy-length (hierarchy)
+ "Return the number of items in HIERARCHY."
+ (hash-table-count (hierarchy--seen-items hierarchy)))
+
+(defun hierarchy-has-root (hierarchy item)
+ "Return t if one of HIERARCHY's roots is ITEM.
+
+A root is an item with no parent."
+ (seq-contains-p (hierarchy-roots hierarchy) item))
+
+(defun hierarchy-roots (hierarchy)
+ "Return all roots of HIERARCHY.
+
+A root is an item with no parent."
+ (let ((roots (hierarchy--roots hierarchy)))
+ (or roots
+ (hierarchy--compute-roots hierarchy))))
+
+(defun hierarchy-leafs (hierarchy &optional node)
+ "Return all leafs of HIERARCHY.
+
+A leaf is an item with no child.
+
+If NODE is an item of HIERARCHY, only return leafs under NODE."
+ (let ((leafs (cl-set-difference
+ (map-keys (hierarchy--seen-items hierarchy))
+ (map-keys (hierarchy--children hierarchy)))))
+ (if (hierarchy-has-item hierarchy node)
+ (seq-filter (lambda (item)
+ (hierarchy-descendant-p hierarchy item node))
+ leafs)
+ leafs)))
+
+(defun hierarchy-parent (hierarchy item)
+ "In HIERARCHY, return parent of ITEM."
+ (map-elt (hierarchy--parents hierarchy) item))
+
+(defun hierarchy-children (hierarchy parent)
+ "In HIERARCHY, return children of PARENT."
+ (map-elt (hierarchy--children hierarchy) parent (list)))
+
+(defun hierarchy-child-p (hierarchy item1 item2)
+ "In HIERARCHY, return non-nil if and only if ITEM1 is a child of ITEM2."
+ (equal (hierarchy-parent hierarchy item1) item2))
+
+(defun hierarchy-descendant-p (hierarchy item1 item2)
+ "In HIERARCHY, return non-nil if and only if ITEM1 is a descendant of ITEM2.
+
+ITEM1 is a descendant of ITEM2 if and only if both are items of HIERARCHY
+and either:
+
+- ITEM1 is child of ITEM2, or
+- ITEM1's parent is a descendant of ITEM2."
+ (and
+ (hierarchy-has-item hierarchy item1)
+ (hierarchy-has-item hierarchy item2)
+ (or
+ (hierarchy-child-p hierarchy item1 item2)
+ (hierarchy-descendant-p
+ hierarchy (hierarchy-parent hierarchy item1) item2))))
+
+(defun hierarchy-equal (hierarchy1 hierarchy2)
+ "Return t if HIERARCHY1 and HIERARCHY2 are equal.
+
+Two equal hierarchies share the same items and the same
+relationships among them."
+ (and (hierarchy-p hierarchy1)
+ (hierarchy-p hierarchy2)
+ (= (hierarchy-length hierarchy1) (hierarchy-length hierarchy2))
+ ;; parents are the same
+ (seq-every-p (lambda (child)
+ (equal (hierarchy-parent hierarchy1 child)
+ (hierarchy-parent hierarchy2 child)))
+ (map-keys (hierarchy--parents hierarchy1)))
+ ;; children are the same
+ (seq-every-p (lambda (parent)
+ (hierarchy--set-equal
+ (hierarchy-children hierarchy1 parent)
+ (hierarchy-children hierarchy2 parent)
+ :test #'equal))
+ (map-keys (hierarchy--children hierarchy1)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Navigation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun hierarchy-map-item (func item hierarchy &optional indent)
+ "Return the result of applying FUNC to ITEM and its descendants in HIERARCHY.
+
+This function navigates the tree top-down: FUNCTION is first called on item
+and then on each of its children. Results are concatenated in a list.
+
+INDENT is a number (default 0) representing the indentation of ITEM in
+HIERARCHY. FUNC should take 2 argument: the item and its indentation
+level."
+ (let ((indent (or indent 0)))
+ (cons
+ (funcall func item indent)
+ (seq-mapcat (lambda (child) (hierarchy-map-item func child
+ hierarchy (1+ indent)))
+ (hierarchy-children hierarchy item)))))
+
+(defun hierarchy-map (func hierarchy &optional indent)
+ "Return the result of applying FUNC to each element of HIERARCHY.
+
+This function navigates the tree top-down: FUNCTION is first called on each
+root. To do so, it calls `hierarchy-map-item' on each root
+sequentially. Results are concatenated in a list.
+
+FUNC should take 2 arguments: the item and its indentation level.
+
+INDENT is a number (default 0) representing the indentation of HIERARCHY's
+roots."
+ (let ((indent (or indent 0)))
+ (seq-mapcat (lambda (root) (hierarchy-map-item func root hierarchy indent))
+ (hierarchy-roots hierarchy))))
+
+(defun hierarchy-map-tree (function hierarchy &optional item indent)
+ "Apply FUNCTION on each item of HIERARCHY under ITEM.
+
+This function navigates the tree bottom-up: FUNCTION is first called on
+leafs and the result is passed as parameter when calling FUNCTION on
+parents.
+
+FUNCTION should take 3 parameters: the current item, its indentation
+level (a number), and a list representing the result of applying
+`hierarchy-map-tree' to each child of the item.
+
+INDENT is 0 by default and is passed as second parameter to FUNCTION.
+INDENT is incremented by 1 at each level of the tree.
+
+This function returns the result of applying FUNCTION to ITEM (the first
+root if nil)."
+ (let ((item (or item (car (hierarchy-roots hierarchy))))
+ (indent (or indent 0)))
+ (funcall function item indent
+ (mapcar (lambda (child)
+ (hierarchy-map-tree function hierarchy
+ child (1+ indent)))
+ (hierarchy-children hierarchy item)))))
+
+(defun hierarchy-map-hierarchy (function hierarchy)
+ "Apply FUNCTION to each item of HIERARCHY in a new hierarchy.
+
+FUNCTION should take 2 parameters, the current item and its
+indentation level (a number), and should return an item to be
+added to the new hierarchy."
+ (let* ((items (make-hash-table :test #'equal))
+ (transform (lambda (item) (map-elt items item))))
+ ;; Make 'items', a table mapping original items to their
+ ;; transformation
+ (hierarchy-map (lambda (item indent)
+ (map-put! items item (funcall function item indent)))
+ hierarchy)
+ (hierarchy--make
+ :roots (mapcar transform (hierarchy-roots hierarchy))
+ :parents (let ((result (make-hash-table :test #'equal)))
+ (map-apply (lambda (child parent)
+ (map-put! result
+ (funcall transform child)
+ (funcall transform parent)))
+ (hierarchy--parents hierarchy))
+ result)
+ :children (let ((result (make-hash-table :test #'equal)))
+ (map-apply (lambda (parent children)
+ (map-put! result
+ (funcall transform parent)
+ (seq-map transform children)))
+ (hierarchy--children hierarchy))
+ result)
+ :seen-items (let ((result (make-hash-table :test #'equal)))
+ (map-apply (lambda (item v)
+ (map-put! result
+ (funcall transform item)
+ v))
+ (hierarchy--seen-items hierarchy))
+ result))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Display
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun hierarchy-labelfn-indent (labelfn &optional indent-string)
+ "Return a function rendering LABELFN indented with INDENT-STRING.
+
+INDENT-STRING defaults to a 2-space string. Indentation is
+multiplied by the depth of the displayed item."
+ (let ((indent-string (or indent-string " ")))
+ (lambda (item indent)
+ (dotimes (_ indent) (insert indent-string))
+ (funcall labelfn item indent))))
+
+(defun hierarchy-labelfn-button (labelfn actionfn)
+ "Return a function rendering LABELFN in a button.
+
+Clicking the button triggers ACTIONFN. ACTIONFN is a function
+taking an item of HIERARCHY and an indentation value (a number)
+as input. This function is called when an item is clicked. The
+return value of ACTIONFN is ignored."
+ (lambda (item indent)
+ (let ((start (point)))
+ (funcall labelfn item indent)
+ (make-text-button start (point)
+ 'action (lambda (_) (funcall actionfn item indent))))))
+
+(defun hierarchy-labelfn-button-if (labelfn buttonp actionfn)
+ "Return a function rendering LABELFN as a button if BUTTONP.
+
+Pass LABELFN and ACTIONFN to `hierarchy-labelfn-button' if
+BUTTONP is non-nil. Otherwise, render LABELFN without making it
+a button.
+
+BUTTONP is a function taking an item of HIERARCHY and an
+indentation value (a number) as input."
+ (lambda (item indent)
+ (if (funcall buttonp item indent)
+ (funcall (hierarchy-labelfn-button labelfn actionfn) item indent)
+ (funcall labelfn item indent))))
+
+(defun hierarchy-labelfn-to-string (labelfn item indent)
+ "Execute LABELFN on ITEM and INDENT. Return result as a string."
+ (with-temp-buffer
+ (funcall labelfn item indent)
+ (buffer-substring (point-min) (point-max))))
+
+(defun hierarchy-print (hierarchy &optional to-string)
+ "Insert HIERARCHY in current buffer as plain text.
+
+Use TO-STRING to convert each element to a string. TO-STRING is
+a function taking an item of HIERARCHY as input and returning a
+string. If nil, TO-STRING defaults to a call to `format' with \"%s\"."
+ (let ((to-string (or to-string (lambda (item) (format "%s" item)))))
+ (hierarchy-map
+ (hierarchy-labelfn-indent (lambda (item _)
+ (insert (funcall to-string item) "\n")))
+ hierarchy)))
+
+(defun hierarchy-to-string (hierarchy &optional to-string)
+ "Return a string representing HIERARCHY.
+
+TO-STRING is passed unchanged to `hierarchy-print'."
+ (with-temp-buffer
+ (hierarchy-print hierarchy to-string)
+ (buffer-substring (point-min) (point-max))))
+
+(defun hierarchy-tabulated-imenu-action (_item-name position)
+ "Move to ITEM-NAME at POSITION in current buffer."
+ (goto-char position)
+ (back-to-indentation))
+
+(define-derived-mode hierarchy-tabulated-mode tabulated-list-mode "Hierarchy tabulated"
+ "Major mode to display a hierarchy as a tabulated list."
+ (setq-local imenu-generic-expression
+ ;; debbugs: 26457 - Cannot pass a function to
+ ;; imenu-generic-expression. Add
+ ;; `hierarchy-tabulated-imenu-action' to the end of the
+ ;; list when bug is fixed
+ '(("Item" "^[[:space:]]+\\(?1:.+\\)$" 1))))
+
+(defun hierarchy-tabulated-display (hierarchy labelfn &optional buffer)
+ "Display HIERARCHY as a tabulated list in `hierarchy-tabulated-mode'.
+
+LABELFN is a function taking an item of HIERARCHY and an indentation
+level (a number) as input and inserting a string to be displayed in the
+table.
+
+The tabulated list is displayed in BUFFER, or a newly created buffer if
+nil. The buffer is returned."
+ (let ((buffer (or buffer (generate-new-buffer "hierarchy-tabulated"))))
+ (with-current-buffer buffer
+ (hierarchy-tabulated-mode)
+ (setq tabulated-list-format
+ (vector '("Item name" 0 nil)))
+ (setq tabulated-list-entries
+ (hierarchy-map (lambda (item indent)
+ (list item (vector (hierarchy-labelfn-to-string
+ labelfn item indent))))
+ hierarchy))
+ (tabulated-list-init-header)
+ (tabulated-list-print))
+ buffer))
+
+(declare-function widget-convert "wid-edit")
+(defun hierarchy-convert-to-tree-widget (hierarchy labelfn)
+ "Return a tree-widget for HIERARCHY.
+
+LABELFN is a function taking an item of HIERARCHY and an indentation
+value (a number) as parameter and inserting a string to be displayed as a
+node label."
+ (require 'wid-edit)
+ (require 'tree-widget)
+ (hierarchy-map-tree (lambda (item indent children)
+ (widget-convert
+ 'tree-widget
+ :tag (hierarchy-labelfn-to-string labelfn item indent)
+ :args children))
+ hierarchy))
+
+(defun hierarchy-tree-display (hierarchy labelfn &optional buffer)
+ "Display HIERARCHY as a tree widget in a new buffer.
+
+HIERARCHY and LABELFN are passed unchanged to
+`hierarchy-convert-to-tree-widget'.
+
+The tree widget is displayed in BUFFER, or a newly created buffer if
+nil. The buffer is returned."
+ (let ((buffer (or buffer (generate-new-buffer "*hierarchy-tree*")))
+ (tree-widget (hierarchy-convert-to-tree-widget hierarchy labelfn)))
+ (with-current-buffer buffer
+ (setq-local buffer-read-only t)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (widget-create tree-widget)
+ (goto-char (point-min))
+ (special-mode)))
+ buffer))
+
+(provide 'hierarchy)
+
+;;; hierarchy.el ends here
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index ceb9b6bea5f..0d57bc16a3a 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -485,7 +485,18 @@ absent, return nil."
(lm-with-file file
(let ((start (lm-commentary-start)))
(when start
- (buffer-substring-no-properties start (lm-commentary-end))))))
+ (replace-regexp-in-string ; Get rid of...
+ "[[:blank:]]*$" "" ; trailing white-space
+ (replace-regexp-in-string
+ (format "%s\\|%s\\|%s"
+ ;; commentary header
+ (concat "^;;;[[:blank:]]*\\("
+ lm-commentary-header
+ "\\):[[:blank:]\n]*")
+ "^;;[[:blank:]]*" ; double semicolon prefix
+ "[[:blank:]\n]*\\'") ; trailing new-lines
+ "" (buffer-substring-no-properties
+ start (lm-commentary-end))))))))
(defun lm-homepage (&optional file)
"Return the homepage in file FILE, or current buffer if FILE is nil."
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index fa857cd4c6b..352210f859d 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -200,7 +200,9 @@
(save-excursion
(ignore-errors
(goto-char pos)
- (or (eql (char-before) ?\')
+ ;; '(lambda ..) is not a funcall position, but #'(lambda ...) is.
+ (or (and (eql (char-before) ?\')
+ (not (eql (char-before (1- (point))) ?#)))
(let* ((ppss (syntax-ppss))
(paren-posns (nth 9 ppss))
(parent
@@ -456,7 +458,7 @@ This will generate compile-time constants from BINDINGS."
(,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>")
(0 font-lock-builtin-face))
;; ELisp and CLisp `&' keywords as types.
- (,(concat "\\_<\\&" lisp-mode-symbol-regexp "\\_>")
+ (,(concat "\\_<&" lisp-mode-symbol-regexp "\\_>")
. font-lock-type-face)
;; ELisp regexp grouping constructs
(,(lambda (bound)
@@ -504,14 +506,12 @@ This will generate compile-time constants from BINDINGS."
(1 font-lock-constant-face prepend))
;; Uninterned symbols, e.g., (defpackage #:my-package ...)
;; must come before keywords below to have effect
- (,(concat "\\(#:\\)\\(" lisp-mode-symbol-regexp "\\)")
- (1 font-lock-comment-delimiter-face)
- (2 font-lock-doc-face))
+ (,(concat "#:" lisp-mode-symbol-regexp "") 0 font-lock-builtin-face)
;; Constant values.
(,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>")
(0 font-lock-builtin-face))
;; ELisp and CLisp `&' keywords as types.
- (,(concat "\\_<\\&" lisp-mode-symbol-regexp "\\_>")
+ (,(concat "\\_<&" lisp-mode-symbol-regexp "\\_>")
. font-lock-type-face)
;; This is too general -- rms.
;; A user complained that he has functions whose names start with `do'
@@ -611,6 +611,8 @@ Value for `adaptive-fill-function'."
;; a single docstring. Let's fix it here.
(if (looking-at "\\s-+\"[^\n\"]+\"\\s-*$") ""))
+;; Maybe this should be discouraged/obsoleted and users should be
+;; encouraged to use `lisp-data-mode` instead.
(defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive
elisp)
"Common initialization routine for lisp modes.
@@ -658,6 +660,14 @@ font-lock keywords will not be case sensitive."
(setq-local electric-pair-skip-whitespace 'chomp)
(setq-local electric-pair-open-newline-between-pairs nil))
+;;;###autoload
+(define-derived-mode lisp-data-mode prog-mode "Lisp-Data"
+ "Major mode for buffers holding data written in Lisp syntax."
+ :group 'lisp
+ (lisp-mode-variables t t nil)
+ (setq-local electric-quote-string t)
+ (setq imenu-case-fold-search nil))
+
(defun lisp-outline-level ()
"Lisp mode `outline-level' function."
(let ((len (- (match-end 0) (match-beginning 0))))
@@ -737,7 +747,7 @@ font-lock keywords will not be case sensitive."
"Keymap for ordinary Lisp mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
-(define-derived-mode lisp-mode prog-mode "Lisp"
+(define-derived-mode lisp-mode lisp-data-mode "Lisp"
"Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
Commands:
Delete converts tabs to spaces as it moves back.
@@ -746,10 +756,10 @@ Blank lines separate paragraphs. Semicolons start comments.
\\{lisp-mode-map}
Note that `run-lisp' may be used either to start an inferior Lisp job
or to switch back to an existing one."
- (lisp-mode-variables nil t)
+ (setq-local lisp-indent-function 'common-lisp-indent-function)
(setq-local find-tag-default-function 'lisp-find-tag-default)
(setq-local comment-start-skip
- "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
(setq imenu-case-fold-search t))
(defun lisp-find-tag-default ()
@@ -775,8 +785,6 @@ or to switch back to an existing one."
nil)))
(comment-indent-default)))
-(define-obsolete-function-alias 'lisp-mode-auto-fill 'do-auto-fill "23.1")
-
(defcustom lisp-indent-offset nil
"If non-nil, indent second line of expressions that many more columns."
:group 'lisp
@@ -946,6 +954,7 @@ is the buffer position of the start of the containing expression."
;; setting this to a number inhibits calling hook
(desired-indent nil)
(retry t)
+ whitespace-after-open-paren
calculate-lisp-indent-last-sexp containing-sexp)
(cond ((or (markerp parse-start) (integerp parse-start))
(goto-char parse-start))
@@ -975,6 +984,7 @@ is the buffer position of the start of the containing expression."
nil
;; Innermost containing sexp found
(goto-char (1+ containing-sexp))
+ (setq whitespace-after-open-paren (looking-at (rx whitespace)))
(if (not calculate-lisp-indent-last-sexp)
;; indent-point immediately follows open paren.
;; Don't call hook.
@@ -989,9 +999,11 @@ is the buffer position of the start of the containing expression."
calculate-lisp-indent-last-sexp)
;; This is the first line to start within the containing sexp.
;; It's almost certainly a function call.
- (if (= (point) calculate-lisp-indent-last-sexp)
+ (if (or (= (point) calculate-lisp-indent-last-sexp)
+ whitespace-after-open-paren)
;; Containing sexp has nothing before this line
- ;; except the first element. Indent under that element.
+ ;; except the first element, or the first element is
+ ;; preceded by whitespace. Indent under that element.
nil
;; Skip the first element, find start of second (the first
;; argument of the function call) and indent under.
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 043cf01d2e9..35590123ee6 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -55,7 +55,7 @@ This affects `insert-parentheses' and `insert-pair'."
"If non-nil, `forward-sexp' delegates to this function.
Should take the same arguments and behave similarly to `forward-sexp'.")
-(defun forward-sexp (&optional arg)
+(defun forward-sexp (&optional arg interactive)
"Move forward across one balanced expression (sexp).
With ARG, do it that many times. Negative arg -N means move
backward across N balanced expressions. This command assumes
@@ -64,23 +64,32 @@ point is not in a string or comment. Calls
If unable to move over a sexp, signal `scan-error' with three
arguments: a message, the start of the obstacle (usually a
parenthesis or list marker of some kind), and end of the
-obstacle."
- (interactive "^p")
- (or arg (setq arg 1))
- (if forward-sexp-function
- (funcall forward-sexp-function arg)
- (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
- (if (< arg 0) (backward-prefix-chars))))
-
-(defun backward-sexp (&optional arg)
+obstacle. 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 _
+ (forward-sexp arg nil)
+ (scan-error (user-error (if (> arg 0)
+ "No next sexp"
+ "No previous sexp"))))
+ (or arg (setq arg 1))
+ (if forward-sexp-function
+ (funcall forward-sexp-function arg)
+ (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
+ (if (< arg 0) (backward-prefix-chars)))))
+
+(defun backward-sexp (&optional arg interactive)
"Move backward across one balanced expression (sexp).
With ARG, do it that many times. Negative arg -N means
move forward across N balanced expressions.
This command assumes point is not in a string or comment.
-Uses `forward-sexp' to do the work."
- (interactive "^p")
+Uses `forward-sexp' to do the work.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "^p\nd")
(or arg (setq arg 1))
- (forward-sexp (- arg)))
+ (forward-sexp (- arg) interactive))
(defun mark-sexp (&optional arg allow-extend)
"Set mark ARG sexps from point.
@@ -99,50 +108,78 @@ This command assumes point is not in a string or comment."
(set-mark
(save-excursion
(goto-char (mark))
- (forward-sexp arg)
+ (condition-case error
+ (forward-sexp arg)
+ (scan-error
+ (user-error (if (equal (cadr error)
+ "Containing expression ends prematurely")
+ "No more sexp to select"
+ (cadr error)))))
(point))))
(t
(push-mark
(save-excursion
- (forward-sexp (prefix-numeric-value arg))
+ (condition-case error
+ (forward-sexp (prefix-numeric-value arg))
+ (scan-error
+ (user-error (if (equal (cadr error)
+ "Containing expression ends prematurely")
+ "No sexp to select"
+ (cadr error)))))
(point))
nil t))))
-(defun forward-list (&optional arg)
+(defun forward-list (&optional arg interactive)
"Move forward across one balanced group of parentheses.
This command will also work on other parentheses-like expressions
defined by the current language mode.
With ARG, do it that many times.
Negative arg -N means move backward across N groups of parentheses.
-This command assumes point is not in a string or comment."
- (interactive "^p")
- (or arg (setq arg 1))
- (goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))
-
-(defun backward-list (&optional arg)
+This command assumes point is not in a string or 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 _
+ (forward-list arg nil)
+ (scan-error (user-error (if (> arg 0)
+ "No next group"
+ "No previous group"))))
+ (or arg (setq arg 1))
+ (goto-char (or (scan-lists (point) arg 0) (buffer-end arg)))))
+
+(defun backward-list (&optional arg interactive)
"Move backward across one balanced group of parentheses.
This command will also work on other parentheses-like expressions
defined by the current language mode.
With ARG, do it that many times.
Negative arg -N means move forward across N groups of parentheses.
-This command assumes point is not in a string or comment."
- (interactive "^p")
+This command assumes point is not in a string or comment.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "^p\nd")
(or arg (setq arg 1))
- (forward-list (- arg)))
+ (forward-list (- arg) interactive))
-(defun down-list (&optional arg)
+(defun down-list (&optional arg interactive)
"Move forward down one level of parentheses.
This command will also work on other parentheses-like expressions
defined by the current language mode.
With ARG, do this that many times.
A negative argument means move backward but still go down a level.
-This command assumes point is not in a string or comment."
- (interactive "^p")
- (or arg (setq arg 1))
- (let ((inc (if (> arg 0) 1 -1)))
- (while (/= arg 0)
- (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
- (setq arg (- arg inc)))))
+This command assumes point is not in a string or 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 _
+ (down-list arg nil)
+ (scan-error (user-error "At bottom level")))
+ (or arg (setq arg 1))
+ (let ((inc (if (> arg 0) 1 -1)))
+ (while (/= arg 0)
+ (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
+ (setq arg (- arg inc))))))
(defun backward-up-list (&optional arg escape-strings no-syntax-crossing)
"Move backward out of one level of parentheses.
@@ -229,26 +266,39 @@ point is unspecified."
(or (< inc 0)
(forward-comment 1))
(setf arg (+ arg inc)))
- (signal (car err) (cdr err))))))
+ (if no-syntax-crossing
+ ;; Assume called interactively; don't signal an error.
+ (user-error "At top level")
+ (signal (car err) (cdr err)))))))
(setq arg (- arg inc)))))
-(defun kill-sexp (&optional arg)
+(defun kill-sexp (&optional arg interactive)
"Kill the sexp (balanced expression) following point.
With ARG, kill that many sexps after point.
Negative arg -N means kill N sexps before point.
-This command assumes point is not in a string or comment."
- (interactive "p")
- (let ((opoint (point)))
- (forward-sexp (or arg 1))
- (kill-region opoint (point))))
-
-(defun backward-kill-sexp (&optional arg)
+This command assumes point is not in a string or 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 _
+ (kill-sexp arg nil)
+ (scan-error (user-error (if (> arg 0)
+ "No next sexp"
+ "No previous sexp"))))
+ (let ((opoint (point)))
+ (forward-sexp (or arg 1))
+ (kill-region opoint (point)))))
+
+(defun backward-kill-sexp (&optional arg interactive)
"Kill the sexp (balanced expression) preceding point.
With ARG, kill that many sexps before point.
Negative arg -N means kill N sexps after point.
-This command assumes point is not in a string or comment."
- (interactive "p")
- (kill-sexp (- (or arg 1))))
+This command assumes point is not in a string or comment.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "p\nd")
+ (kill-sexp (- (or arg 1)) interactive))
;; After Zmacs:
(defun kill-backward-up-list (&optional arg)
@@ -482,7 +532,8 @@ is called as a function to find the defun's end."
(if (looking-at "\\s<\\|\n")
(forward-line 1))))))
(funcall end-of-defun-function)
- (funcall skip)
+ (when (<= arg 1)
+ (funcall skip))
(cond
((> arg 0)
;; Moving forward.
@@ -734,12 +785,37 @@ This command assumes point is not in a string or comment."
(insert-pair arg ?\( ?\)))
(defun delete-pair (&optional arg)
- "Delete a pair of characters enclosing ARG sexps following point.
-A negative ARG deletes a pair of characters around preceding ARG sexps."
- (interactive "p")
- (unless arg (setq arg 1))
- (save-excursion (forward-sexp arg) (delete-char (if (> arg 0) -1 1)))
- (delete-char (if (> arg 0) 1 -1)))
+ "Delete a pair of characters enclosing ARG sexps that follow point.
+A negative ARG deletes a pair around the preceding ARG sexps instead."
+ (interactive "P")
+ (if arg
+ (setq arg (prefix-numeric-value arg))
+ (setq arg 1))
+ (if (< arg 0)
+ (save-excursion
+ (skip-chars-backward " \t")
+ (save-excursion
+ (let ((close-char (char-before)))
+ (forward-sexp arg)
+ (unless (member (list (char-after) close-char)
+ (mapcar (lambda (p)
+ (if (= (length p) 3) (cdr p) p))
+ insert-pair-alist))
+ (error "Not after matching pair"))
+ (delete-char 1)))
+ (delete-char -1))
+ (save-excursion
+ (skip-chars-forward " \t")
+ (save-excursion
+ (let ((open-char (char-after)))
+ (forward-sexp arg)
+ (unless (member (list open-char (char-before))
+ (mapcar (lambda (p)
+ (if (= (length p) 3) (cdr p) p))
+ insert-pair-alist))
+ (error "Not before matching pair"))
+ (delete-char -1)))
+ (delete-char 1))))
(defun raise-sexp (&optional arg)
"Raise ARG sexps higher up the tree."
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 67f5b3cf24e..9c23344baca 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -4,7 +4,7 @@
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Keywords: convenience, map, hash-table, alist, array
-;; Version: 2.0
+;; Version: 2.1
;; Package-Requires: ((emacs "25"))
;; Package: map
@@ -56,8 +56,10 @@ 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.
-Each element can also be a SYMBOL, which is an abbreviation of a (KEY
-PAT) tuple of the form (\\='SYMBOL SYMBOL).
+Each element can also be a SYMBOL, which is an abbreviation of
+a (KEY PAT) tuple of the form (\\='SYMBOL SYMBOL). When SYMBOL
+is a keyword, it is an abbreviation of the form (:SYMBOL SYMBOL),
+useful for binding plist values.
Keys in ARGS not found in the map are ignored, and the match doesn't
fail."
@@ -486,9 +488,12 @@ 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)
- (if (consp elt)
- `(app (pcase--flip map-elt ,(car elt)) ,(cadr elt))
- `(app (pcase--flip map-elt ',elt) ,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)
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 85a15c96be5..b779aa27888 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -5,18 +5,20 @@
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: extensions, lisp, tools
-;; 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/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index fc8dfe12ca2..1f81e07754b 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -397,6 +397,26 @@ synchronously."
:type 'boolean
:version "25.1")
+(defcustom package-name-column-width 30
+ "Column width for the Package name in the package menu."
+ :type 'number
+ :version "28.1")
+
+(defcustom package-version-column-width 14
+ "Column width for the Package version in the package menu."
+ :type 'number
+ :version "28.1")
+
+(defcustom package-status-column-width 12
+ "Column width for the Package status in the package menu."
+ :type 'number
+ :version "28.1")
+
+(defcustom package-archive-column-width 8
+ "Column width for the Package status in the package menu."
+ :type 'number
+ :version "28.1")
+
;;; `package-desc' object definition
;; This is the struct used internally to represent packages.
@@ -421,9 +441,9 @@ synchronously."
&aux
(name (intern name-string))
(version (version-to-list version-string))
- (reqs (mapcar #'(lambda (elt)
- (list (car elt)
- (version-to-list (cadr elt))))
+ (reqs (mapcar (lambda (elt)
+ (list (car elt)
+ (version-to-list (cadr elt))))
(if (eq 'quote (car requirements))
(nth 1 requirements)
requirements)))
@@ -670,9 +690,9 @@ updates `package-alist'."
(progn (package-load-all-descriptors)
package-alist)))
-(defun define-package (_name-string _version-string
- &optional _docstring _requirements
- &rest _extra-properties)
+(defun define-package ( _name-string _version-string
+ &optional _docstring _requirements
+ &rest _extra-properties)
"Define a new package.
NAME-STRING is the name of the package, as a string.
VERSION-STRING is the version of the package, as a string.
@@ -798,7 +818,7 @@ correspond to previously loaded files (those returned by
;; FIXME: not the friendliest, but simple.
(require 'info)
(info-initialize)
- (push pkg-dir Info-directory-list))
+ (add-to-list 'Info-directory-list pkg-dir))
(push name package-activated-list)
;; Don't return nil.
t)))
@@ -926,7 +946,6 @@ untar into a directory named DIR; otherwise, signal an error."
(if (> (length file-list) 1) 'tar 'single))))
('tar
(make-directory package-user-dir t)
- ;; FIXME: should we delete PKG-DIR if it exists?
(let* ((default-directory (file-name-as-directory package-user-dir)))
(package-untar-buffer dirname)))
('single
@@ -994,7 +1013,6 @@ untar into a directory named DIR; otherwise, signal an error."
(write-region (autoload-rubric file "package" nil) nil file nil 'silent))
file)
-(defvar generated-autoload-file)
(defvar autoload-timestamps)
(defvar version-control)
@@ -1002,14 +1020,14 @@ untar into a directory named DIR; otherwise, signal an error."
"Generate autoloads in PKG-DIR for package named NAME."
(let* ((auto-name (format "%s-autoloads.el" name))
;;(ignore-name (concat name "-pkg.el"))
- (generated-autoload-file (expand-file-name auto-name pkg-dir))
+ (output-file (expand-file-name auto-name pkg-dir))
;; We don't need 'em, and this makes the output reproducible.
(autoload-timestamps nil)
(backup-inhibited t)
(version-control 'never))
- (package-autoload-ensure-default-file generated-autoload-file)
- (update-directory-autoloads pkg-dir)
- (let ((buf (find-buffer-visiting generated-autoload-file)))
+ (package-autoload-ensure-default-file output-file)
+ (make-directory-autoloads pkg-dir output-file)
+ (let ((buf (find-buffer-visiting output-file)))
(when buf (kill-buffer buf)))
auto-name))
@@ -1200,8 +1218,8 @@ The return result is a `package-desc'."
cipher-algorithm
digest-algorithm
compress-algorithm))
-(declare-function epg-verify-string "epg" (context signature
- &optional signed-text))
+(declare-function epg-verify-string "epg" ( context signature
+ &optional signed-text))
(declare-function epg-context-result-for "epg" (context name))
(declare-function epg-signature-status "epg" (signature) t)
(declare-function epg-signature-to-string "epg" (signature))
@@ -2082,7 +2100,8 @@ to install it but still mark it as selected."
(package-compute-transaction () (list (list pkg))))))
(progn
(package-download-transaction transaction)
- (package--quickstart-maybe-refresh))
+ (package--quickstart-maybe-refresh)
+ (message "Package `%s' installed." name))
(message "`%s' is already installed" name))))
(defun package-strip-rcs-id (str)
@@ -2318,10 +2337,7 @@ will be deleted."
(setq guess nil))
(setq packages (mapcar #'symbol-name packages))
(let ((val
- (completing-read (if guess
- (format "Describe package (default %s): "
- guess)
- "Describe package: ")
+ (completing-read (format-prompt "Describe package" guess)
packages nil t nil nil (when guess
(symbol-name guess)))))
(list (and (> (length val) 0) (intern val)))))))
@@ -2377,18 +2393,9 @@ The description is read from the installed package files."
result
;; Look for Commentary header.
- (let ((mainsrcfile (expand-file-name (format "%s.el" (package-desc-name desc))
- srcdir)))
- (when (file-readable-p mainsrcfile)
- (with-temp-buffer
- (insert (or (lm-commentary mainsrcfile) ""))
- (goto-char (point-min))
- (when (re-search-forward "^;;; Commentary:\n" nil t)
- (replace-match ""))
- (while (re-search-forward "^\\(;+ ?\\)" nil t)
- (replace-match ""))
- (buffer-string))))
- )))
+ (lm-commentary (expand-file-name
+ (format "%s.el" (package-desc-name desc)) srcdir))
+ "")))
(defun describe-package-1 (pkg)
"Insert the package description for PKG.
@@ -2583,16 +2590,10 @@ Helper function for `describe-package'."
(if built-in
;; For built-in packages, get the description from the
;; Commentary header.
- (let ((fn (locate-file (format "%s.el" name) load-path
- load-file-rep-suffixes))
- (opoint (point)))
- (insert (or (lm-commentary fn) ""))
- (save-excursion
- (goto-char opoint)
- (when (re-search-forward "^;;; Commentary:\n" nil t)
- (replace-match ""))
- (while (re-search-forward "^\\(;+ ?\\)" nil t)
- (replace-match ""))))
+ (insert (or (lm-commentary (locate-file (format "%s.el" name)
+ load-path
+ load-file-rep-suffixes))
+ ""))
(if (package-installed-p desc)
;; For installed packages, get the description from the
@@ -2695,15 +2696,19 @@ either a full name or nil, and EMAIL is a valid email address."
(define-key map "i" 'package-menu-mark-install)
(define-key map "U" 'package-menu-mark-upgrades)
(define-key map "r" 'revert-buffer)
- (define-key map (kbd "/ k") 'package-menu-filter-by-keyword)
- (define-key map (kbd "/ n") 'package-menu-filter-by-name)
- (define-key map (kbd "/ /") 'package-menu-clear-filter)
(define-key map "~" 'package-menu-mark-obsolete-for-deletion)
(define-key map "x" 'package-menu-execute)
(define-key map "h" 'package-menu-quick-help)
(define-key map "H" #'package-menu-hide-package)
(define-key map "?" 'package-menu-describe-package)
(define-key map "(" #'package-menu-toggle-hiding)
+ (define-key map (kbd "/ /") 'package-menu-clear-filter)
+ (define-key map (kbd "/ a") 'package-menu-filter-by-archive)
+ (define-key map (kbd "/ k") 'package-menu-filter-by-keyword)
+ (define-key map (kbd "/ n") 'package-menu-filter-by-name)
+ (define-key map (kbd "/ s") 'package-menu-filter-by-status)
+ (define-key map (kbd "/ v") 'package-menu-filter-by-version)
+ (define-key map (kbd "/ m") 'package-menu-filter-marked)
map)
"Local keymap for `package-menu-mode' buffers.")
@@ -2729,8 +2734,12 @@ either a full name or nil, and EMAIL is a valid email address."
"--"
("Filter Packages"
+ ["Filter by Archive" package-menu-filter-by-archive :help "Filter packages by archive"]
["Filter by Keyword" package-menu-filter-by-keyword :help "Filter packages by keyword"]
["Filter by Name" package-menu-filter-by-name :help "Filter packages by name"]
+ ["Filter by Status" package-menu-filter-by-status :help "Filter packages by status"]
+ ["Filter by Version" package-menu-filter-by-version :help "Filter packages by version"]
+ ["Filter Marked" package-menu-filter-marked :help "Filter packages marked for upgrade"]
["Clear Filter" package-menu-clear-filter :help "Clear package list filter"])
["Hide by Regexp" package-menu-hide-package :help "Hide all packages matching a regexp"]
@@ -2757,11 +2766,11 @@ Letters do not insert themselves; instead, they are commands.
(package-menu--transaction-status
package-menu--transaction-status)))
(setq tabulated-list-format
- `[("Package" 18 package-menu--name-predicate)
- ("Version" 13 package-menu--version-predicate)
- ("Status" 10 package-menu--status-predicate)
+ `[("Package" ,package-name-column-width package-menu--name-predicate)
+ ("Version" ,package-version-column-width package-menu--version-predicate)
+ ("Status" ,package-status-column-width package-menu--status-predicate)
,@(if (cdr package-archives)
- '(("Archive" 10 package-menu--archive-predicate)))
+ `(("Archive" ,package-archive-column-width package-menu--archive-predicate)))
("Description" 0 package-menu--description-predicate)])
(setq tabulated-list-padding 2)
(setq tabulated-list-sort-key (cons "Status" nil))
@@ -3040,8 +3049,21 @@ When none are given, the package matches."
found)
t))
-(defun package-menu--generate (remember-pos packages &optional keywords)
- "Populate the Package Menu.
+(defun package-menu--display (remember-pos suffix)
+ "Display the Package Menu.
+If REMEMBER-POS is non-nil, keep point on the same entry.
+
+If SUFFIX is non-nil, append that to \"Package\" for the first
+column in the header line."
+ (setf (car (aref tabulated-list-format 0))
+ (if suffix
+ (concat "Package[" suffix "]")
+ "Package"))
+ (tabulated-list-init-header)
+ (tabulated-list-print remember-pos))
+
+(defun package-menu--generate (remember-pos &optional packages keywords)
+ "Populate and display the Package Menu.
If REMEMBER-POS is non-nil, keep point on the same entry.
PACKAGES should be t, which means to display all known packages,
or a list of package names (symbols) to display.
@@ -3049,13 +3071,10 @@ or a list of package names (symbols) to display.
With KEYWORDS given, only packages with those keywords are
shown."
(package-menu--refresh packages keywords)
- (setf (car (aref tabulated-list-format 0))
- (if keywords
- (let ((filters (mapconcat #'identity keywords ",")))
- (concat "Package[" filters "]"))
- "Package"))
- (tabulated-list-init-header)
- (tabulated-list-print remember-pos))
+ (package-menu--display remember-pos
+ (when keywords
+ (let ((filters (mapconcat #'identity keywords ",")))
+ (concat "Package[" filters "]")))))
(defun package-menu--print-info (pkg)
"Return a package entry suitable for `tabulated-list-entries'.
@@ -3699,48 +3718,192 @@ shown."
(select-window win)
(switch-to-buffer buf))))
+(defun package-menu--filter-by (predicate suffix)
+ "Filter \"*Packages*\" buffer by PREDICATE and add SUFFIX to header.
+PREDICATE is a function which will be called with one argument, a
+`package-desc' object, and returns t if that object should be
+listed in the Package Menu.
+
+SUFFIX is passed on to `package-menu--display' and is added to
+the header line of the first column."
+ ;; Update `tabulated-list-entries' so that it contains all
+ ;; packages before searching.
+ (package-menu--refresh t nil)
+ (let (found-entries)
+ (dolist (entry tabulated-list-entries)
+ (when (funcall predicate (car entry))
+ (push entry found-entries)))
+ (if found-entries
+ (progn
+ (setq tabulated-list-entries found-entries)
+ (package-menu--display t suffix))
+ (user-error "No packages found"))))
+
+(defun package-menu-filter-by-archive (archive)
+ "Filter the \"*Packages*\" buffer by ARCHIVE.
+Display only packages from package archive ARCHIVE.
+
+When called interactively, prompt for ARCHIVE, which can be a
+comma-separated string. If ARCHIVE is empty, show all packages.
+
+When called from Lisp, ARCHIVE can be a string or a list of
+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))))
+ (package--ensure-package-menu-mode)
+ (let ((re (if (listp archive)
+ (regexp-opt archive)
+ archive)))
+ (package-menu--filter-by (lambda (pkg-desc)
+ (let ((pkg-archive (package-desc-archive pkg-desc)))
+ (and pkg-archive
+ (string-match-p re pkg-archive))))
+ (concat "archive:" (if (listp archive)
+ (string-join archive ",")
+ archive)))))
+
(defun package-menu-filter-by-keyword (keyword)
"Filter the \"*Packages*\" buffer by KEYWORD.
-Show only those items that relate to the specified KEYWORD.
-
-KEYWORD can be a string or a list of strings. If it is a list, a
-package will be displayed if it matches any of the keywords.
-Interactively, it is a list of strings separated by commas.
-
-KEYWORD can also be used to filter by status or archive name by
-using keywords like \"arc:gnu\" and \"status:available\".
-Statuses available include \"incompat\", \"available\",
-\"built-in\" and \"installed\"."
- (interactive
- (list (completing-read-multiple
- "Keywords (comma separated): " (package-all-keywords))))
+Display only packages with specified KEYWORD.
+
+When called interactively, prompt for KEYWORD, which can be a
+comma-separated string. If KEYWORD is empty, show all packages.
+
+When called from Lisp, KEYWORD can be a string or a list of
+strings. If KEYWORD is nil or the empty string, show all
+packages."
+ (interactive (list (completing-read-multiple
+ "Keywords (comma separated): "
+ (package-all-keywords))))
+ (when (stringp keyword)
+ (setq keyword (list keyword)))
(package--ensure-package-menu-mode)
- (package-show-package-list t (if (stringp keyword)
- (list keyword)
- keyword)))
+ (if (not keyword)
+ (package-menu--generate t t)
+ (package-menu--filter-by (lambda (pkg-desc)
+ (package--has-keyword-p pkg-desc keyword))
+ (concat "keyword:" (string-join keyword ",")))))
(define-obsolete-function-alias
'package-menu-filter #'package-menu-filter-by-keyword "27.1")
(defun package-menu-filter-by-name (name)
- "Filter the \"*Packages*\" buffer by NAME.
-Show only those items whose name matches the regular expression
-NAME. If NAME is nil or the empty string, show all packages."
- (interactive (list (read-from-minibuffer "Filter by name (regexp): ")))
+ "Filter the \"*Packages*\" buffer by NAME regexp.
+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)")))
(package--ensure-package-menu-mode)
(if (or (not name) (string-empty-p name))
- (package-show-package-list t nil)
- ;; Update `tabulated-list-entries' so that it contains all
- ;; packages before searching.
- (package-menu--refresh t nil)
- (let (matched)
- (dolist (entry tabulated-list-entries)
- (let* ((pkg-name (package-desc-name (car entry))))
- (when (string-match name (symbol-name pkg-name))
- (push pkg-name matched))))
- (if matched
- (package-show-package-list matched nil)
- (user-error "No packages found")))))
+ (package-menu--generate t t)
+ (package-menu--filter-by (lambda (pkg-desc)
+ (string-match-p name (symbol-name
+ (package-desc-name pkg-desc))))
+ (format "name:%s" name))))
+
+(defun package-menu-filter-by-status (status)
+ "Filter the \"*Packages*\" buffer by STATUS.
+Display only packages with specified STATUS.
+
+When called interactively, prompt for STATUS, which can be a
+comma-separated string. If STATUS is empty, show all packages.
+
+When called from Lisp, STATUS can be a string or a list of
+strings. If STATUS is nil or the empty string, show all
+packages."
+ (interactive (list (completing-read "Filter by status: "
+ '("avail-obso"
+ "available"
+ "built-in"
+ "dependency"
+ "disabled"
+ "external"
+ "held"
+ "incompat"
+ "installed"
+ "new"
+ "unsigned"))))
+ (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))))
+
+(defun package-menu-filter-by-version (version predicate)
+ "Filter the \"*Packages*\" buffer by VERSION and PREDICATE.
+Display only packages with a matching version.
+
+When called interactively, prompt for one of the qualifiers `<',
+`>' or `=', and a package version. Show only packages that has a
+lower (`<'), equal (`=') or higher (`>') version than the
+specified one.
+
+When called from Lisp, VERSION should be a version string and
+PREDICATE should be the symbol `=', `<' or `>'.
+
+If VERSION is nil or the empty string, show all packages."
+ (interactive (let ((choice (intern
+ (char-to-string
+ (read-char-choice
+ "Filter by version? [Type =, <, > or q] "
+ '(?< ?> ?= ?q))))))
+ (if (eq choice 'q)
+ '(quit nil)
+ (list (read-from-minibuffer
+ (concat "Filter by version ("
+ (pcase choice
+ ('= "= equal to")
+ ('< "< less than")
+ ('> "> greater than"))
+ "): "))
+ choice))))
+ (unless (equal predicate 'quit)
+ (if (or (not version) (string-empty-p version))
+ (package-menu--generate t t)
+ (package-menu--filter-by
+ (let ((fun (pcase predicate
+ ('= #'version-list-=)
+ ('< #'version-list-<)
+ ('> (lambda (a b) (not (version-list-<= a b))))
+ (_ (error "Unknown predicate: %s" predicate))))
+ (ver (version-to-list version)))
+ (lambda (pkg-desc)
+ (funcall fun (package-desc-version pkg-desc) ver)))
+ (format "versions:%s%s" predicate version)))))
+
+(defun package-menu-filter-marked ()
+ "Filter \"*Packages*\" buffer by non-empty upgrade mark.
+Unlike other filters, this leaves the marks intact."
+ (interactive)
+ (package--ensure-package-menu-mode)
+ (widen)
+ (let (found-entries mark pkg-id entry marks)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq mark (char-after))
+ (unless (eq mark ?\s)
+ (setq pkg-id (tabulated-list-get-id))
+ (setq entry (package-menu--print-info-simple pkg-id))
+ (push entry found-entries)
+ ;; remember the mark
+ (push (cons pkg-id mark) marks))
+ (forward-line))
+ (if found-entries
+ (progn
+ (setq tabulated-list-entries found-entries)
+ (package-menu--display t nil)
+ ;; redo the marks, but we must remember the marks!!
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq mark (cdr (assq (tabulated-list-get-id) marks)))
+ (tabulated-list-put-tag (char-to-string mark) t)))
+ (user-error "No packages found")))))
(defun package-menu-clear-filter ()
"Clear any filter currently applied to the \"*Packages*\" buffer."
@@ -3789,6 +3952,7 @@ The return value is a string (or nil in case we can't find it)."
(or (lm-header "package-version")
(lm-header "version")))))))))
+
;;;; Quickstart: precompute activation actions for faster start up.
;; Activating packages via `package-initialize' is costly: for N installed
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 36b93fa7ac5..09c48d095cc 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -344,7 +344,8 @@ of the elements of LIST is performed as if by `pcase-let'.
(seen '())
(codegen
(lambda (code vars)
- (let ((prev (assq code seen)))
+ (let ((vars (pcase--fgrep vars code))
+ (prev (assq code seen)))
(if (not prev)
(let ((res (pcase-codegen code vars)))
(push (list code vars res) seen)
@@ -398,7 +399,10 @@ of the elements of LIST is performed as if by `pcase-let'.
(if (pcase--small-branch-p (cdr case))
;; Don't bother sharing multiple
;; occurrences of this leaf since it's small.
- #'pcase-codegen codegen)
+ (lambda (code vars)
+ (pcase-codegen code
+ (pcase--fgrep vars code)))
+ codegen)
(cdr case)
vars))))
cases))))
@@ -590,7 +594,7 @@ MATCH is the pattern that needs to be matched, of the form:
((null (cdr else-alts)) (car else-alts))
(t (cons (car match) (nreverse else-alts)))))))
((memq match '(:pcase--succeed :pcase--fail)) (cons match match))
- (t (error "Uknown MATCH %s" match))))
+ (t (error "Unknown MATCH %s" match))))
(defun pcase--split-rest (sym splitter rest)
(let ((then-rest '())
@@ -687,14 +691,22 @@ MATCH is the pattern that needs to be matched, of the form:
'(nil . :pcase--fail)
'(:pcase--fail . nil))))))
-(defun pcase--fgrep (vars sexp)
- "Check which of the symbols VARS appear in SEXP."
+(defun pcase--fgrep (bindings sexp)
+ "Return those of the BINDINGS which might be used in SEXP."
(let ((res '()))
- (while (consp sexp)
- (dolist (var (pcase--fgrep vars (pop sexp)))
- (unless (memq var res) (push var res))))
- (and (memq sexp vars) (not (memq sexp res)) (push sexp res))
- res))
+ (while (and (consp sexp) bindings)
+ (dolist (binding (pcase--fgrep bindings (pop sexp)))
+ (push binding res)
+ (setq bindings (remove binding bindings))))
+ (if (vectorp sexp)
+ ;; With backquote, code can appear within vectors as well.
+ ;; This wouldn't be needed if we `macroexpand-all' before
+ ;; calling pcase--fgrep, OTOH.
+ (pcase--fgrep bindings (mapcar #'identity sexp))
+ (let ((tmp (assq sexp bindings)))
+ (if tmp
+ (cons tmp res)
+ res)))))
(defun pcase--self-quoting-p (upat)
(or (keywordp upat) (integerp upat) (stringp upat)))
@@ -713,7 +725,7 @@ MATCH is the pattern that needs to be matched, of the form:
(pcase--app-subst-match match sym fun nsym))
(cdr match))))
((memq match '(:pcase--succeed :pcase--fail)) match)
- (t (error "Uknown MATCH %s" match))))
+ (t (error "Unknown MATCH %s" match))))
(defun pcase--app-subst-rest (rest sym fun nsym)
(mapcar (lambda (branch)
@@ -734,13 +746,11 @@ MATCH is the pattern that needs to be matched, of the form:
"Build a function call to FUN with arg ARG."
(if (symbolp fun)
`(,fun ,arg)
- (let* (;; `vs' is an upper bound on the vars we need.
- (vs (pcase--fgrep (mapcar #'car vars) fun))
- (env (mapcar (lambda (var)
- (list var (cdr (assq var vars))))
- vs))
+ (let* (;; `env' is an upper bound on the bindings we need.
+ (env (mapcar (lambda (x) (list (car x) (cdr x)))
+ (pcase--fgrep vars fun)))
(call (progn
- (when (memq arg vs)
+ (when (assq arg env)
;; `arg' is shadowed by `env'.
(let ((newsym (gensym "x")))
(push (list newsym arg) env)
@@ -748,7 +758,7 @@ MATCH is the pattern that needs to be matched, of the form:
(if (functionp fun)
`(funcall #',fun ,arg)
`(,@fun ,arg)))))
- (if (null vs)
+ (if (null env)
call
;; Let's not replace `vars' in `fun' since it's
;; too difficult to do it right, instead just
@@ -759,10 +769,12 @@ MATCH is the pattern that needs to be matched, of the form:
"Build an expression that will evaluate EXP."
(let* ((found (assq exp vars)))
(if found (cdr found)
- (let* ((vs (pcase--fgrep (mapcar #'car vars) exp))
- (env (mapcar (lambda (v) (list v (cdr (assq v vars))))
- vs)))
- (if env (macroexp-let* env exp) exp)))))
+ (let* ((env (pcase--fgrep vars exp)))
+ (if env
+ (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x)))
+ env)
+ exp)
+ exp)))))
;; It's very tempting to use `pcase' below, tho obviously, it'd create
;; bootstrapping problems.
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 5e01895b9fc..78ae3a8c1e5 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -96,7 +96,7 @@
;; out.
;; Q: But how can I then make out the sub-expressions?
-;; A: Thats where the `sub-expression mode' comes in. In it only the
+;; A: That's where the `sub-expression mode' comes in. In it only the
;; digit keys are assigned to perform an update that will flash the
;; corresponding subexp only.
@@ -489,7 +489,7 @@ Optional argument SYNTAX must be specified if called non-interactively."
(interactive
(list (intern
(completing-read
- (format "Select syntax (default %s): " reb-re-syntax)
+ (format-prompt "Select syntax" reb-re-syntax)
'(read string sregex rx)
nil t nil nil (symbol-name reb-re-syntax)
'reb-change-syntax-hist))))
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 6564563e7ec..8d8d071031c 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1381,7 +1381,7 @@ To make local rx extensions, use `rx-let' for `rx',
For more details, see Info node `(elisp) Extending Rx'.
\(fn NAME [(ARGS...)] RX)"
- (declare (indent 1))
+ (declare (indent defun))
`(eval-and-compile
(put ',name 'rx-definition ',(rx--make-binding name definition))
',name))
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index e3037a71901..d60f974aee1 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -4,7 +4,7 @@
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Keywords: sequences
-;; Version: 2.21
+;; Version: 2.22
;; Package: seq
;; Maintainer: emacs-devel@gnu.org
@@ -348,6 +348,7 @@ If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called."
(setq acc (funcall function acc elt)))
acc)))
+;;;###autoload
(cl-defgeneric seq-every-p (pred sequence)
"Return non-nil if (PRED element) is non-nil for all elements of SEQUENCE."
(catch 'seq--break
@@ -491,6 +492,7 @@ keys. Keys are compared using `equal'."
SEQUENCE must be a sequence of numbers or markers."
(apply #'min (seq-into sequence 'list)))
+;;;###autoload
(cl-defgeneric seq-max (sequence)
"Return the largest element of SEQUENCE.
SEQUENCE must be a sequence of numbers or markers."
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index 4ff129e367a..dd614dd792c 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -55,9 +55,6 @@
:prefix "load-path-shadows-"
:group 'lisp)
-(define-obsolete-variable-alias 'shadows-compare-text-p
- 'load-path-shadows-compare-text "23.3")
-
(defcustom load-path-shadows-compare-text nil
"If non-nil, then shadowing files are reported only if their text differs.
This is slower, but filters out some innocuous shadowing."
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 60d8fa591e9..1b700afd12d 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -52,6 +52,13 @@
;; error because the parser just automatically does something. Better yet,
;; we can afford to use a sloppy grammar.
+;; The benefits of this approach were presented in the following article,
+;; which includes a kind of tutorial to get started with SMIE:
+;;
+;; 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
+
;; 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
@@ -63,6 +70,7 @@
;; Since then, some of that code has been beaten into submission, but the
;; smie-indent-keyword is still pretty obscure.
+
;; Conflict resolution:
;;
;; - One source of conflicts is when you have:
@@ -1356,9 +1364,9 @@ Only meaningful when called from within `smie-rules-function'."
(funcall smie-rules-function :elem 'basic))
smie-indent-basic))
-(defun smie-indent--rule (method token
- ;; FIXME: Too many parameters.
- &optional after parent base-pos)
+(defun smie-indent--rule ( method token
+ ;; FIXME: Too many parameters.
+ &optional after parent base-pos)
"Compute indentation column according to `smie-rules-function'.
METHOD and TOKEN are passed to `smie-rules-function'.
AFTER is the position after TOKEN, if known.
@@ -2112,10 +2120,9 @@ position corresponding to each rule."
(throw 'found (list kind token
(or (nth 3 rewrite) res)))))))))
(default-new (smie-config--guess-value sig))
- (newstr (read-string (format "Adjust rule (%S %S -> %S) to%s: "
- (nth 0 sig) (nth 1 sig) (nth 2 sig)
- (if (not default-new) ""
- (format " (default %S)" default-new)))
+ (newstr (read-string (format-prompt
+ "Adjust rule (%S %S -> %S) to" default-new
+ (nth 0 sig) (nth 1 sig) (nth 2 sig))
nil nil (format "%S" default-new)))
(new (car (read-from-string newstr))))
(let ((old (rassoc sig smie-config--buffer-local)))
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 044c9aada0d..e6abb39ddc6 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -156,6 +156,7 @@ are non-nil, then the result is non-nil."
,@(or body `(,res))))
`(let* () ,@(or body '(t))))))
+;;;###autoload
(defmacro if-let (spec then &rest else)
"Bind variables according to SPEC and evaluate THEN or ELSE.
Evaluate each binding in turn, as in `let*', stopping if a
@@ -236,6 +237,15 @@ REGEXP defaults to \"[ \\t\\n\\r]+\"."
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 \"...\"."
+ (let ((strlen (length string)))
+ (if (<= strlen length)
+ string
+ (setq length (max 0 (- length 3)))
+ (concat "..." (substring string (max 0 (- strlen 1 length)))))))
+
(defsubst string-blank-p (string)
"Check whether STRING is either empty or only whitespace.
The following characters count as whitespace here: space, tab, newline and
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index f4f077264be..62f1b16d75c 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -63,9 +63,10 @@ override the buffer's syntax table for special syntactic constructs that
cannot be handled just by the buffer's syntax-table.
The specified function may call `syntax-ppss' on any position
-before END, but it should not call `syntax-ppss-flush-cache',
-which means that it should not call `syntax-ppss' on some
-position and later modify the buffer on some earlier position.
+before END, but if it calls `syntax-ppss' on some
+position and later modifies the buffer on some earlier position,
+then it is its responsibility to call `syntax-ppss-flush-cache' to flush
+the now obsolete ppss info from the cache.
Note: When this variable is a function, it must apply _all_ the
`syntax-table' properties needed in the given text interval.
@@ -143,14 +144,28 @@ delimiter or an Escaped or Char-quoted character."))
(point-max))))
(cons beg end))
-(defun syntax-propertize--shift-groups (re n)
- (replace-regexp-in-string
- "\\\\(\\?\\([0-9]+\\):"
- (lambda (s)
- (replace-match
- (number-to-string (+ n (string-to-number (match-string 1 s))))
- t t s 1))
- re t t))
+(defun syntax-propertize--shift-groups-and-backrefs (re n)
+ (let ((new-re (replace-regexp-in-string
+ "\\\\(\\?\\([0-9]+\\):"
+ (lambda (s)
+ (replace-match
+ (number-to-string
+ (+ n (string-to-number (match-string 1 s))))
+ t t s 1))
+ re t t))
+ (pos 0))
+ (while (string-match "\\\\\\([0-9]+\\)" new-re pos)
+ (setq pos (+ 1 (match-beginning 1)))
+ (when (save-match-data
+ ;; With \N, the \ must be in a subregexp context, i.e.,
+ ;; not in a character class or in a \{\} repetition.
+ (subregexp-context-p new-re (match-beginning 0)))
+ (let ((shifted (+ n (string-to-number (match-string 1 new-re)))))
+ (when (> shifted 9)
+ (error "There may be at most nine back-references"))
+ (setq new-re (replace-match (number-to-string shifted)
+ t t new-re 1)))))
+ new-re))
(defmacro syntax-propertize-precompile-rules (&rest rules)
"Return a precompiled form of RULES to pass to `syntax-propertize-rules'.
@@ -194,7 +209,8 @@ for subsequent HIGHLIGHTs.
Also SYNTAX is free to move point, in which case RULES may not be applied to
some parts of the text or may be applied several times to other parts.
-Note: back-references in REGEXPs do not work."
+Note: There may be at most nine back-references in the REGEXPs of
+all RULES in total."
(declare (debug (&rest &or symbolp ;FIXME: edebug this eval step.
(form &rest
(numberp
@@ -223,7 +239,7 @@ Note: back-references in REGEXPs do not work."
;; tell when *this* match 0 has succeeded.
(cl-incf offset)
(setq re (concat "\\(" re "\\)")))
- (setq re (syntax-propertize--shift-groups re offset))
+ (setq re (syntax-propertize--shift-groups-and-backrefs re offset))
(let ((code '())
(condition
(cond
@@ -325,6 +341,11 @@ END) suitable for `syntax-propertize-function'."
(defvar-local syntax-ppss-table nil
"Syntax-table to use during `syntax-ppss', if any.")
+(defvar-local syntax-propertize--inhibit-flush nil
+ "If non-nil, `syntax-ppss-flush-cache' only flushes the ppss cache.
+Otherwise it flushes both the ppss cache and the properties
+set by `syntax-propertize'")
+
(defun syntax-propertize (pos)
"Ensure that syntax-table properties are set until POS (a buffer point)."
(when (< syntax-propertize--done pos)
@@ -350,23 +371,27 @@ END) suitable for `syntax-propertize-function'."
(end (max pos
(min (point-max)
(+ start syntax-propertize-chunk-size))))
- (funs syntax-propertize-extend-region-functions))
- (while funs
- (let ((new (funcall (pop funs) start end))
- ;; Avoid recursion!
- (syntax-propertize--done most-positive-fixnum))
- (if (or (null new)
- (and (>= (car new) start) (<= (cdr new) end)))
- nil
- (setq start (car new))
- (setq end (cdr new))
- ;; If there's been a change, we should go through the
- ;; list again since this new position may
- ;; warrant a different answer from one of the funs we've
- ;; already seen.
- (unless (eq funs
- (cdr syntax-propertize-extend-region-functions))
- (setq funs syntax-propertize-extend-region-functions)))))
+ (first t)
+ (repeat t))
+ (while repeat
+ (setq repeat nil)
+ (run-hook-wrapped
+ 'syntax-propertize-extend-region-functions
+ (lambda (f)
+ (let ((new (funcall f start end))
+ ;; Avoid recursion!
+ (syntax-propertize--done most-positive-fixnum))
+ (if (or (null new)
+ (and (>= (car new) start) (<= (cdr new) end)))
+ nil
+ (setq start (car new))
+ (setq end (cdr new))
+ ;; If there's been a change, we should go through the
+ ;; list again since this new position may
+ ;; warrant a different answer from one of the funs we've
+ ;; already seen.
+ (unless first (setq repeat t))))
+ (setq first nil))))
;; Flush ppss cache between the original value of `start' and that
;; set above by syntax-propertize-extend-region-functions.
(syntax-ppss-flush-cache start)
@@ -376,8 +401,13 @@ END) suitable for `syntax-propertize-function'."
;; (message "syntax-propertizing from %s to %s" start end)
(remove-text-properties start end
'(syntax-table nil syntax-multiline nil))
- ;; Avoid recursion!
- (let ((syntax-propertize--done most-positive-fixnum))
+ ;; Make sure we only let-bind it buffer-locally.
+ (make-local-variable 'syntax-propertize--inhibit-flush)
+ ;; Let-bind `syntax-propertize--done' to avoid infinite recursion!
+ (let ((syntax-propertize--done most-positive-fixnum)
+ ;; Let `syntax-propertize-function' call
+ ;; `syntax-ppss-flush-cache' without worries.
+ (syntax-propertize--inhibit-flush t))
(funcall syntax-propertize-function start end)))))))))
;;; Link syntax-propertize with syntax.c.
@@ -456,7 +486,8 @@ These are valid when the buffer has no restriction.")
(defun syntax-ppss-flush-cache (beg &rest ignored)
"Flush the cache of `syntax-ppss' starting at position BEG."
;; Set syntax-propertize to refontify anything past beg.
- (setq syntax-propertize--done (min beg syntax-propertize--done))
+ (unless syntax-propertize--inhibit-flush
+ (setq syntax-propertize--done (min beg syntax-propertize--done)))
;; Flush invalid cache entries.
(dolist (cell (list syntax-ppss-wide syntax-ppss-narrow))
(pcase cell
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 501cc3a29e0..b13f609f882 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -547,10 +547,10 @@ Return the column number after insertion."
;; Don't truncate to `width' if the next column is align-right
;; and has some space left, truncate to `available-space' instead.
(when (and not-last-col
- (> label-width available-space)
- (setq label (truncate-string-to-width
- label available-space nil nil t t)
- label-width available-space)))
+ (> label-width available-space))
+ (setq label (truncate-string-to-width
+ label available-space nil nil t t)
+ label-width available-space))
(setq label (bidi-string-mark-left-to-right label))
(when (and right-align (> width label-width))
(let ((shift (- width label-width)))
diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el
index b6e98f59a7a..61bd98d3cfe 100644
--- a/lisp/emacs-lisp/text-property-search.el
+++ b/lisp/emacs-lisp/text-property-search.el
@@ -137,11 +137,19 @@ and if a matching region is found, moves point to its beginning."
nil)
;; We're standing in the property we're looking for, so find the
;; end.
- ((and (text-property--match-p
- value (get-text-property (1- (point)) property)
- predicate)
- (not not-current))
- (text-property--find-end-backward (1- (point)) property value predicate))
+ ((text-property--match-p
+ value (get-text-property (1- (point)) property)
+ predicate)
+ (let ((origin (point))
+ (match (text-property--find-end-backward
+ (1- (point)) property value predicate)))
+ ;; When we want to ignore the current element, then repeat the
+ ;; search if we haven't moved out of it yet.
+ (if (and not-current
+ (equal (get-text-property (point) property)
+ (get-text-property origin property)))
+ (text-property-search-backward property value predicate)
+ match)))
(t
(let ((origin (point))
(ended nil)
diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el
index 4fa31f32673..00d09696d2a 100644
--- a/lisp/emacs-lisp/timer-list.el
+++ b/lisp/emacs-lisp/timer-list.el
@@ -32,41 +32,49 @@
"List all timers in a buffer."
(interactive)
(pop-to-buffer-same-window (get-buffer-create "*timer-list*"))
- (let ((inhibit-read-only t))
- (erase-buffer)
- (timer-list-mode)
- (dolist (timer (append timer-list timer-idle-list))
- (insert (format "%4s %10s %8s %s"
- ;; Idle.
- (if (aref timer 7) "*" " ")
- ;; Next time.
- (let ((time (list (aref timer 1)
- (aref timer 2)
- (aref timer 3))))
- (format "%.2f"
- (float-time
- (if (aref timer 7)
- time
- (time-subtract time nil)))))
- ;; Repeat.
- (let ((repeat (aref timer 4)))
- (cond
- ((numberp repeat)
- (format "%.2f" (/ repeat 60)))
- ((null repeat)
- "-")
- (t
- (format "%s" repeat))))
- ;; Function.
- (let ((cl-print-compiled 'static)
- (cl-print-compiled-button nil)
- (print-escape-newlines t))
- (cl-prin1-to-string (aref timer 5)))))
- (put-text-property (line-beginning-position)
- (1+ (line-beginning-position))
- 'timer timer)
- (insert "\n")))
- (goto-char (point-min)))
+ (timer-list-mode)
+ (tabulated-list-init-header)
+ (setq tabulated-list-entries
+ (mapcar
+ (lambda (timer)
+ (list
+ nil
+ `[ ;; Idle.
+ ,(propertize
+ (if (aref timer 7) " *" " ")
+ 'help-echo "* marks idle timers"
+ 'timer timer)
+ ;; Next time.
+ ,(propertize
+ (let ((time (list (aref timer 1)
+ (aref timer 2)
+ (aref timer 3))))
+ (format "%10.2f"
+ (float-time
+ (if (aref timer 7)
+ time
+ (time-subtract time nil)))))
+ 'help-echo "Time in sec till next invocation")
+ ;; Repeat.
+ ,(propertize
+ (let ((repeat (aref timer 4)))
+ (cond
+ ((numberp repeat)
+ (format "%8.1f" repeat))
+ ((null repeat)
+ " -")
+ (t
+ (format "%8s" repeat))))
+ 'help-echo "Symbol: repeat; number: repeat interval in sec")
+ ;; Function.
+ ,(propertize
+ (let ((cl-print-compiled 'static)
+ (cl-print-compiled-button nil)
+ (print-escape-newlines t))
+ (cl-prin1-to-string (aref timer 5)))
+ 'help-echo "Function called by timer")]))
+ (append timer-list timer-idle-list)))
+ (tabulated-list-print))
;; This command can be destructive if they don't know what they are
;; doing. Kids, don't try this at home!
;;;###autoload (put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
@@ -74,24 +82,47 @@
(defvar timer-list-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "c" 'timer-list-cancel)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
(easy-menu-define nil map ""
'("Timers"
["Cancel" timer-list-cancel t]))
map))
-(define-derived-mode timer-list-mode special-mode "Timer-List"
+(define-derived-mode timer-list-mode tabulated-list-mode "Timer-List"
"Mode for listing and controlling timers."
- (setq bidi-paragraph-direction 'left-to-right)
- (setq truncate-lines t)
(buffer-disable-undo)
(setq-local revert-buffer-function #'list-timers)
- (setq buffer-read-only t)
- (setq header-line-format
- (concat (propertize " " 'display '(space :align-to 0))
- (format "%4s %10s %8s %s"
- "Idle" "Next" "Repeat" "Function"))))
+ (setq tabulated-list-format
+ '[("Idle" 6 timer-list--idle-predicate)
+ (" Next" 12 timer-list--next-predicate)
+ (" Repeat" 11 timer-list--repeat-predicate)
+ ("Function" 10 timer-list--function-predicate)]))
+
+(defun timer-list--idle-predicate (A B)
+ "Predicate to sort Timer-List by the Idle column."
+ (let ((iA (aref (cadr A) 0))
+ (iB (aref (cadr B) 0)))
+ (cond ((string= iA iB)
+ (timer-list--next-predicate A B))
+ ((string= iA " *") nil)
+ (t t))))
+
+(defun timer-list--next-predicate (A B)
+ "Predicate to sort Timer-List by the Next column."
+ (let ((nA (string-to-number (aref (cadr A) 1)))
+ (nB (string-to-number (aref (cadr B) 1))))
+ (< nA nB)))
+
+(defun timer-list--repeat-predicate (A B)
+ "Predicate to sort Timer-List by the Repeat column."
+ (let ((rA (aref (cadr A) 2))
+ (rB (aref (cadr B) 2)))
+ (string< rA rB)))
+
+(defun timer-list--function-predicate (A B)
+ "Predicate to sort Timer-List by the Next column."
+ (let ((fA (aref (cadr A) 3))
+ (fB (aref (cadr B) 3)))
+ (string< fA fB)))
(defun timer-list-cancel ()
"Cancel the timer on the line under point."
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 9eb8feed0f1..61fd05cbb80 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -378,9 +378,6 @@ This function returns a timer object which you can use in
(decoded-time-year now)
(decoded-time-zone now)))))))
- (or (time-equal-p time time)
- (error "Invalid time format"))
-
(let ((timer (timer-create)))
(timer-set-time timer time repeat)
(timer-set-function timer function args)
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index 4ebb7ff711d..627305689c7 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -265,20 +265,13 @@ be printed along with the arguments in the trace."
If `current-prefix-arg' is non-nil, also read a buffer and a \"context\"
\(Lisp expression). Return (FUNCTION BUFFER FUNCTION-CONTEXT)."
(cons
- (let ((default (function-called-at-point))
- (beg (string-match ":[ \t]*\\'" prompt)))
- (intern (completing-read (if default
- (format
- "%s (default %s)%s"
- (substring prompt 0 beg)
- default
- (if beg (substring prompt beg) ": "))
- prompt)
+ (let ((default (function-called-at-point)))
+ (intern (completing-read (format-prompt prompt default)
obarray 'fboundp t nil nil
(if default (symbol-name default)))))
(when current-prefix-arg
(list
- (read-buffer "Output to buffer: " trace-buffer)
+ (read-buffer (format-prompt "Output to buffer" trace-buffer))
(let ((exp
(let ((minibuffer-completing-symbol t))
(read-from-minibuffer "Context expression: "
@@ -308,7 +301,7 @@ functions that switch buffers, or do any other display-oriented
stuff - use `trace-function-background' instead.
To stop tracing a function, use `untrace-function' or `untrace-all'."
- (interactive (trace--read-args "Trace function: "))
+ (interactive (trace--read-args "Trace function"))
(trace-function-internal function buffer nil context))
;;;###autoload
@@ -316,7 +309,7 @@ To stop tracing a function, use `untrace-function' or `untrace-all'."
"Trace calls to function FUNCTION, quietly.
This is like `trace-function-foreground', but without popping up
the output buffer or changing the window configuration."
- (interactive (trace--read-args "Trace function in background: "))
+ (interactive (trace--read-args "Trace function in background"))
(trace-function-internal function buffer t context))
;;;###autoload
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index cd960618a0a..e10c149d89c 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -1,4 +1,4 @@
-;;; warnings.el --- log and display warnings
+;;; warnings.el --- log and display warnings -*- lexical-binding:t -*-
;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
@@ -68,25 +68,25 @@ Each element looks like (ALIAS . LEVEL) and defines ALIAS as
equivalent to LEVEL. LEVEL must be defined in `warning-levels';
it may not itself be an alias.")
-(defvaralias 'display-warning-minimum-level 'warning-minimum-level)
+(define-obsolete-variable-alias 'display-warning-minimum-level
+ 'warning-minimum-level "28.1")
(defcustom warning-minimum-level :warning
"Minimum severity level for displaying the warning buffer.
If a warning's severity level is lower than this,
the warning is logged in the warnings buffer, but the buffer
is not immediately displayed. See also `warning-minimum-log-level'."
- :group 'warnings
:type '(choice (const :emergency) (const :error)
(const :warning) (const :debug))
:version "22.1")
-(defvaralias 'log-warning-minimum-level 'warning-minimum-log-level)
+(define-obsolete-variable-alias 'log-warning-minimum-level
+ 'warning-minimum-log-level "28.1")
(defcustom warning-minimum-log-level :warning
"Minimum severity level for logging a warning.
If a warning severity level is lower than this,
the warning is completely ignored.
Value must be lower or equal than `warning-minimum-level',
because warnings not logged aren't displayed either."
- :group 'warnings
:type '(choice (const :emergency) (const :error)
(const :warning) (const :debug))
:version "22.1")
@@ -100,7 +100,6 @@ Thus, (foo bar) as an element matches (foo bar)
or (foo bar ANYTHING...) as TYPE.
If TYPE is a symbol FOO, that is equivalent to the list (FOO),
so only the element (FOO) will match it."
- :group 'warnings
:type '(repeat (repeat symbol))
:version "22.1")
@@ -115,7 +114,6 @@ or (foo bar ANYTHING...) as TYPE.
If TYPE is a symbol FOO, that is equivalent to the list (FOO),
so only the element (FOO) will match it.
See also `warning-suppress-log-types'."
- :group 'warnings
:type '(repeat (repeat symbol))
:version "22.1")
@@ -202,6 +200,21 @@ SUPPRESS-LIST is the list of kinds of warnings to suppress."
;; we return t.
some-match))
+(define-button-type 'warning-suppress-warning
+ 'action #'warning-suppress-action
+ 'help-echo "mouse-2, RET: Don't display this warning automatically")
+(defun warning-suppress-action (button)
+ (customize-save-variable 'warning-suppress-types
+ (cons (list (button-get button 'warning-type))
+ warning-suppress-types)))
+(define-button-type 'warning-suppress-log-warning
+ 'action #'warning-suppress-log-action
+ 'help-echo "mouse-2, RET: Don't log this warning")
+(defun warning-suppress-log-action (button)
+ (customize-save-variable 'warning-suppress-log-types
+ (cons (list (button-get button 'warning-type))
+ warning-suppress-types)))
+
;;;###autoload
(defun display-warning (type message &optional level buffer-name)
"Display a warning message, MESSAGE.
@@ -229,7 +242,12 @@ See the `warnings' custom group for user customization features.
See also `warning-series', `warning-prefix-function',
`warning-fill-prefix', and `warning-fill-column' for additional
-programming features."
+programming features.
+
+This will also display buttons allowing the user to permanently
+disable automatic display of the warning or disable the warning
+entirely by setting `warning-suppress-types' or
+`warning-suppress-log-types' on their behalf."
(if (not (or after-init-time noninteractive (daemonp)))
;; Ensure warnings that happen early in the startup sequence
;; are visible when startup completes (bug#20792).
@@ -274,6 +292,17 @@ programming features."
(insert (format (nth 1 level-info)
(format warning-type-format typename))
message)
+ ;; Don't output the buttons when doing batch compilation
+ ;; and similar.
+ (unless noninteractive
+ (insert " ")
+ (insert-button "Disable showing"
+ 'type 'warning-suppress-warning
+ 'warning-type type)
+ (insert " ")
+ (insert-button "Disable logging"
+ 'type 'warning-suppress-log-warning
+ 'warning-type type))
(funcall newline)
(when (and warning-fill-prefix (not (string-match "\n" message)))
(let ((fill-prefix warning-fill-prefix)
diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el
index 5f393a01e8c..ba75a93035e 100644
--- a/lisp/emacs-lock.el
+++ b/lisp/emacs-lock.el
@@ -176,11 +176,12 @@ Return a value appropriate for `kill-buffer-query-functions' (which see)."
arg)
((and (eq arg current-prefix-arg) (consp current-prefix-arg))
;; called with C-u M-x emacs-lock-mode, so ask the user
- (intern (completing-read "Locking mode: "
- '("all" "exit" "kill")
- nil t nil nil
- (symbol-name
- emacs-lock-default-locking-mode))))
+ (intern (completing-read
+ (format-prompt "Locking mode"
+ emacs-lock-default-locking-mode)
+ '("all" "exit" "kill")
+ nil t nil nil
+ (symbol-name emacs-lock-default-locking-mode))))
((eq mode t)
;; turn on, so use previous setting, or customized default
(or emacs-lock--old-mode emacs-lock-default-locking-mode))
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 26a1a8955f4..926305e6077 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -860,7 +860,7 @@ With numeric prefix arg, copy to register 0-9 instead."
(defun cua-cancel ()
"Cancel the active region, rectangle, or global mark."
(interactive)
- (setq mark-active nil)
+ (deactivate-mark)
(if (fboundp 'cua--cancel-rectangle)
(cua--cancel-rectangle)))
@@ -1379,9 +1379,10 @@ the prefix fallback behavior."
(cond
(cua-mode
- (setq cua--saved-state
- (list
- (and (boundp 'delete-selection-mode) delete-selection-mode)))
+ (unless cua--saved-state
+ (setq cua--saved-state
+ (list
+ (and (boundp 'delete-selection-mode) delete-selection-mode))))
(if cua-delete-selection
(delete-selection-mode 1)
(if (and (boundp 'delete-selection-mode) delete-selection-mode)
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 663995a0a11..9c3251e0e6f 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -735,7 +735,7 @@ If command is repeated at same position, delete the rectangle."
(setq cua--last-killed-rectangle (cons (and kill-ring (car kill-ring)) killed-rectangle))
(if ring
(kill-new (mapconcat
- (function (lambda (row) (concat row "\n")))
+ (lambda (row) (concat row "\n"))
killed-rectangle "")))))
(defun cua--activate-rectangle ()
@@ -1071,7 +1071,7 @@ The text previously in the rectangle is overwritten by the blanks."
(cua--copy-rectangle-to-global-mark t))
(let* ((rect (cua--extract-rectangle))
(text (mapconcat
- (function (lambda (row) (concat row "\n")))
+ (lambda (row) (concat row "\n"))
rect "")))
(setq arg (cua--prefix-arg arg))
(if cua--register
@@ -1150,9 +1150,9 @@ The numbers are formatted according to the FORMAT string."
(list (if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
(string-to-number
- (read-string "Start value: (0) " nil nil "0")))
+ (read-string (format-prompt "Start value" 0) nil nil "0")))
(string-to-number
- (read-string "Increment: (1) " nil nil "1"))
+ (read-string (format-prompt "Increment" 1) nil nil "1"))
(read-string (concat "Format: (" cua--rectangle-seq-format ") "))))
(if (= (length format) 0)
(setq format cua--rectangle-seq-format)
diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el
index 2fffcbb154a..5dd81fab3b6 100644
--- a/lisp/emulation/edt-mapper.el
+++ b/lisp/emulation/edt-mapper.el
@@ -510,7 +510,8 @@
(if window-system (concat "-" (upcase (symbol-name window-system))))
"-keys")))
(set-visited-file-name
- (read-file-name (format "Save key mapping to file (default %s): " file) nil file)))
+ (read-file-name (format-prompt "Save key mapping to file" file)
+ nil file)))
(save-buffer)
(message "That's it! Press any key to exit")
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index 8dc18ebc85e..e70b44658d5 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -178,10 +178,8 @@
(defvar edt-user-global-map)
(defvar rect-start-point)
-;;;
-;;; Version Information
-;;;
(defconst edt-version "4.0" "EDT Emulation version number.")
+(make-obsolete-variable 'edt-version nil "28.1")
;;;
;;; User Configurable Variables
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index ca7fcaf2d91..dd7648c2b77 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -466,24 +466,7 @@
(assoc major-mode viper-emacs-state-modifier-alist)))
(cdr
(assoc major-mode viper-emacs-state-modifier-alist))
- viper-empty-keymap))
- ))
-
- ;; This var is not local in Emacs, so we make it local. It must be local
- ;; because although the stack of minor modes can be the same for all buffers,
- ;; the associated *keymaps* can be different. In Viper,
- ;; viper-vi-local-user-map, viper-insert-local-user-map, and others can have
- ;; different keymaps for different buffers. Also, the keymaps associated
- ;; with viper-vi/insert-state-modifier-minor-mode can be different.
- ;; ***This is needed only in case emulation-mode-map-alists is not defined.
- ;; In emacs with emulation-mode-map-alists, nothing needs to be done
- (unless
- (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- (set (make-local-variable 'minor-mode-map-alist)
- (viper-append-filter-alist
- (append viper--intercept-key-maps viper--key-maps)
- minor-mode-map-alist)))
- )
+ viper-empty-keymap)))))
@@ -711,7 +694,7 @@
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")
- (if (viper= (viper-last-command-char) ?\\)
+ (if (viper= last-command-event ?\\)
(message "Switched to EMACS state for the next command..."))
(viper-escape-to-state arg events 'emacs-state))
@@ -893,16 +876,7 @@ LOAD-FILE is the name of the file where the specific minor mode is defined.
Suffixes such as .el or .elc should be stripped."
(interactive "sEnter name of the load file: ")
-
- (eval-after-load load-file '(viper-normalize-minor-mode-map-alist))
-
- ;; Change the default for minor-mode-map-alist each time a harnessed minor
- ;; mode adds its own keymap to the a-list.
- (unless
- (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- (eval-after-load
- load-file '(setq-default minor-mode-map-alist minor-mode-map-alist)))
- )
+ (eval-after-load load-file '(viper-normalize-minor-mode-map-alist)))
(defun viper-ESC (arg)
@@ -1175,7 +1149,7 @@ as a Meta key and any number of multiple escapes are allowed."
"Begin numeric argument for the next command."
(interactive "P")
(viper-prefix-arg-value
- (viper-last-command-char) (if (consp arg) (cdr arg) nil)))
+ last-command-event (if (consp arg) (cdr arg) nil)))
(defun viper-command-argument (arg)
"Accept a motion command as an argument."
@@ -1183,7 +1157,7 @@ as a Meta key and any number of multiple escapes are allowed."
(let ((viper-intermediate-command 'viper-command-argument))
(condition-case nil
(viper-prefix-arg-com
- (viper-last-command-char)
+ last-command-event
(cond ((null arg) nil)
((consp arg) (car arg))
((integerp arg) arg)
@@ -1590,7 +1564,7 @@ invokes the command before that, etc."
;; Hook used in viper-undo
(defun viper-after-change-undo-hook (beg end _len)
- (if (and (boundp 'undo-in-progress) undo-in-progress)
+ (if undo-in-progress
(setq undo-beg-posn beg
undo-end-posn (or end beg))
;; some other hooks may be changing various text properties in
@@ -1624,9 +1598,9 @@ invokes the command before that, etc."
(pos-visible-in-window-p before-undo-pt))
(progn
(push-mark (point-marker) t)
- (viper-sit-for-short 300)
+ (sit-for 0.3)
(goto-char undo-end-posn)
- (viper-sit-for-short 300)
+ (sit-for 0.3)
(if (pos-visible-in-window-p undo-beg-posn)
(goto-char before-undo-pt)
(goto-char undo-beg-posn)))
@@ -1912,15 +1886,11 @@ Undo previous insertion and inserts new."
(or unread-command-events
executing-kbd-macro
(sit-for 840))
- (if (fboundp 'minibuffer-prompt-end)
- (delete-region (minibuffer-prompt-end) (point-max))
- (erase-buffer))
+ (delete-region (minibuffer-prompt-end) (point-max))
(insert viper-initial)))
(defsubst viper-minibuffer-real-start ()
- (if (fboundp 'minibuffer-prompt-end)
- (minibuffer-prompt-end)
- (point-min)))
+ (minibuffer-prompt-end))
(defun viper-minibuffer-post-command-hook()
(when (active-minibuffer-window)
@@ -1934,7 +1904,7 @@ Undo previous insertion and inserts new."
"Exit minibuffer Viper way."
(interactive)
(let (command)
- (setq command (local-key-binding (char-to-string (viper-last-command-char))))
+ (setq command (local-key-binding (char-to-string last-command-event)))
(run-hooks 'viper-minibuffer-exit-hook)
(if command
(command-execute command)
@@ -2909,7 +2879,7 @@ If point is on a widget or a button, simulate clicking on that widget/button."
(and (consp widget)
(get (widget-type widget) 'widget-type))))
(widget-button-press (point))
- (if (and (fboundp 'button-at) (fboundp 'push-button) (button-at (point)))
+ (if (button-at (point))
(push-button)
;; not a widget or a button
(save-excursion
@@ -4721,8 +4691,7 @@ Please, specify your level now: "))
(interactive "cViper register to point: ")
(let ((val (get-register char)))
(cond
- ((and (fboundp 'frame-configuration-p)
- (frame-configuration-p val))
+ ((frame-configuration-p val)
(set-frame-configuration val))
((window-configuration-p val)
(set-window-configuration val))
@@ -4765,8 +4734,7 @@ Please, specify your level now: "))
(viper-color-display-p (if (viper-window-display-p)
(viper-color-display-p)
'non-x))
- (viper-frame-parameters (if (fboundp 'frame-parameters)
- (frame-parameters (selected-frame))))
+ (viper-frame-parameters (frame-parameters (selected-frame)))
(viper-minibuffer-emacs-face (if (viper-has-face-support-p)
(facep
viper-minibuffer-emacs-face)
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index 511c68f24a7..6c4afe519f2 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -922,6 +922,8 @@ Should be set in `viper-custom-file-name'."
"Hooks run just after loading Viper."
:type 'hook
:group 'viper-hooks)
+(make-obsolete-variable 'viper-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defun viper-restore-cursor-type ()
(condition-case nil
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el
index 1b149b12e41..d76cf71b314 100644
--- a/lisp/emulation/viper-keym.el
+++ b/lisp/emulation/viper-keym.el
@@ -184,7 +184,7 @@ In insert mode, this key also functions as Meta."
:type 'string
:group 'viper)
-(defconst viper-ESC-key [escape]
+(defconst viper-ESC-key (kbd "ESC")
"Key used to ESC.")
diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el
index 294705f7c3a..928a3ef00ee 100644
--- a/lisp/emulation/viper-mous.el
+++ b/lisp/emulation/viper-mous.el
@@ -66,20 +66,13 @@ or a triple-click."
;; time interval in millisecond within which successive clicks are
;; considered related
(defcustom viper-multiclick-timeout (if (viper-window-display-p)
- (if (featurep 'xemacs)
- mouse-track-multi-click-time
- double-click-time)
+ double-click-time
500)
"Time interval in millisecond within which successive mouse clicks are
considered related."
:type 'integer
:group 'viper-mouse)
-;; current event click count; XEmacs only
-(defvar viper-current-click-count 0)
-;; time stamp of the last click event; XEmacs only
-(defvar viper-last-click-event-timestamp 0)
-
;; Local variable used to toggle wraparound search on click.
(viper-deflocalvar viper-mouse-click-search-noerror t)
@@ -105,7 +98,7 @@ considered related."
;;; Code
(defsubst viper-multiclick-p ()
- (not (viper-sit-for-short viper-multiclick-timeout t)))
+ (not (sit-for (/ viper-multiclick-timeout 1000.0) t)))
;; Returns window where click occurs
(defun viper-mouse-click-window (click)
@@ -279,11 +272,9 @@ See `viper-surrounding-word' for the definition of a word in this case."
(setq interrupting-event (read-event))
(viper-mouse-event-p last-input-event)))
(progn ; interrupted wait
- (setq viper-global-prefix-argument arg)
- ;; count this click for XEmacs
- (viper-event-click-count click))
+ (setq viper-global-prefix-argument arg))
;; uninterrupted wait or the interrupting event wasn't a mouse event
- (setq click-count (viper-event-click-count click))
+ (setq click-count (event-click-count click))
(if (> click-count 1)
(setq arg viper-global-prefix-argument
viper-global-prefix-argument nil))
@@ -300,33 +291,8 @@ See `viper-surrounding-word' for the definition of a word in this case."
(string-match "\\(mouse-\\|frame\\|screen\\|track\\)"
(prin1-to-string (viper-event-key event)))))
-;; XEmacs has no double-click events. So, we must simulate.
-;; So, we have to simulate event-click-count.
-(defun viper-event-click-count (click)
- (if (featurep 'xemacs) (viper-event-click-count-xemacs click)
- (event-click-count click)))
-
-(when (featurep 'xemacs)
-
- ;; kind of semaphore for updating viper-current-click-count
- (defvar viper-counting-clicks-p nil)
-
- (defun viper-event-click-count-xemacs (click)
- (let ((time-delta (- (event-timestamp click)
- viper-last-click-event-timestamp))
- inhibit-quit)
- (while viper-counting-clicks-p
- (ignore))
- (setq viper-counting-clicks-p t)
- (if (> time-delta viper-multiclick-timeout)
- (setq viper-current-click-count 0))
- (discard-input)
- (setq viper-current-click-count (1+ viper-current-click-count)
- viper-last-click-event-timestamp (event-timestamp click))
- (setq viper-counting-clicks-p nil)
- (if (viper-sit-for-short viper-multiclick-timeout t)
- viper-current-click-count
- 0))))
+(define-obsolete-function-alias 'viper-event-click-count
+ 'event-click-count "28.1")
(declare-function viper-forward-word "viper-cmd" (arg))
(declare-function viper-adjust-window "viper-cmd" ())
@@ -364,11 +330,9 @@ this command.
(setq viper-global-prefix-argument (or viper-global-prefix-argument
arg)
;; remember command that was before the multiclick
- this-command last-command)
- ;; make sure we counted this event---needed for XEmacs only
- (viper-event-click-count click))
+ this-command last-command))
;; uninterrupted wait
- (setq click-count (viper-event-click-count click))
+ (setq click-count (event-click-count click))
(setq click-word (viper-mouse-click-get-word click nil click-count))
(if (> click-count 1)
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index ebad850e6b7..83e45e1cd0c 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -205,6 +205,7 @@ Otherwise return the normal value."
;; incorrect. However, this gives correct result in our cases, since we are
;; testing for sufficiently high Emacs versions.
(defun viper-check-version (op major minor &optional type-of-emacs)
+ (declare (obsolete nil "28.1"))
(if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version))
(and (cond ((eq type-of-emacs 'xemacs) (featurep 'xemacs))
((eq type-of-emacs 'emacs) (featurep 'emacs))
@@ -785,14 +786,11 @@ Otherwise return the normal value."
(defun viper-check-minibuffer-overlay ()
(if (overlayp viper-minibuffer-overlay)
(move-overlay
- viper-minibuffer-overlay
- (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)
- (1+ (buffer-size)))
+ viper-minibuffer-overlay (minibuffer-prompt-end) (1+ (buffer-size)))
(setq viper-minibuffer-overlay
;; make overlay open-ended
(make-overlay
- (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)
- (1+ (buffer-size))
+ (minibuffer-prompt-end) (1+ (buffer-size))
(current-buffer) nil 'rear-advance))))
@@ -807,9 +805,8 @@ Otherwise return the normal value."
(define-obsolete-function-alias 'viper-abbreviate-file-name
'abbreviate-file-name "27.1")
-;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg
-;; in sit-for, so this function smooths out the differences.
(defsubst viper-sit-for-short (val &optional nodisp)
+ (declare (obsolete nil "28.1"))
(sit-for (/ val 1000.0) nodisp))
;; EVENT may be a single event of a sequence of events
@@ -867,11 +864,10 @@ Otherwise return the normal value."
;; Uses different timeouts for ESC-sequences and others
(defun viper-fast-keysequence-p ()
- (not (viper-sit-for-short
- (if (viper-ESC-event-p last-input-event)
- (viper-ESC-keyseq-timeout)
- viper-fast-keyseq-timeout)
- t)))
+ (not (sit-for (/ (if (viper-ESC-event-p last-input-event)
+ (viper-ESC-keyseq-timeout)
+ viper-fast-keyseq-timeout) 1000.0)
+ t)))
(define-obsolete-function-alias 'viper-read-event-convert-to-char
'read-event "27.1")
@@ -919,6 +915,7 @@ Otherwise return the normal value."
basis)))
(defun viper-last-command-char ()
+ (declare (obsolete nil "28.1"))
last-command-event)
(defun viper-key-to-emacs-key (key)
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 492c31bde74..59ca6298eb9 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -695,9 +695,6 @@ It also can't undo some Viper settings."
'mark-even-if-inactive viper-saved-non-viper-variables))
;; Ideally, we would like to be able to de-localize local variables
- (unless
- (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- (viper-delocalize-var 'minor-mode-map-alist))
(viper-delocalize-var 'require-final-newline)
;; deactivate all advices done by Viper.
@@ -705,11 +702,9 @@ It also can't undo some Viper settings."
(setq viper-mode nil)
- (when (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- (setq emulation-mode-map-alists
- (delq 'viper--intercept-key-maps
- (delq 'viper--key-maps emulation-mode-map-alists))
- ))
+ (setq emulation-mode-map-alists
+ (delq 'viper--intercept-key-maps
+ (delq 'viper--key-maps emulation-mode-map-alists)))
(viper-delocalize-var 'viper-vi-minibuffer-minor-mode)
(viper-delocalize-var 'viper-insert-minibuffer-minor-mode)
@@ -943,13 +938,11 @@ Two differences:
(setq viper-vi-state-cursor-color color-name)))
- (when (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- ;; needs to be as early as possible
- (add-to-ordered-list
- 'emulation-mode-map-alists 'viper--intercept-key-maps 100)
- ;; needs to be after cua-mode
- (add-to-ordered-list 'emulation-mode-map-alists 'viper--key-maps 500)
- )
+ ;; needs to be as early as possible
+ (add-to-ordered-list
+ 'emulation-mode-map-alists 'viper--intercept-key-maps 100)
+ ;; needs to be after cua-mode
+ (add-to-ordered-list 'emulation-mode-map-alists 'viper--key-maps 500)
;; Emacs shell, ange-ftp, and comint-based modes
(add-hook 'comint-mode-hook #'viper-comint-mode-hook) ; comint
@@ -1062,10 +1055,7 @@ This may be needed if the previous `:map' command terminated abnormally."
(viper--advice-add 'add-minor-mode :after
(lambda (&rest _)
"Run viper-normalize-minor-mode-map-alist after adding a minor mode."
- (viper-normalize-minor-mode-map-alist)
- (unless
- (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- (setq-default minor-mode-map-alist minor-mode-map-alist))))
+ (viper-normalize-minor-mode-map-alist)))
;; catch frame switching event
(if (viper-window-display-p)
@@ -1221,7 +1211,6 @@ These two lines must come in the order given."))
(viper-harness-minor-mode "outline")
(viper-harness-minor-mode "allout")
(viper-harness-minor-mode "xref")
- (viper-harness-minor-mode "lmenu")
(viper-harness-minor-mode "vc")
(viper-harness-minor-mode "ltx-math") ; LaTeX-math-mode in AUC-TeX, which
(viper-harness-minor-mode "latex") ; sits in one of these two files
@@ -1254,12 +1243,7 @@ These two lines must come in the order given."))
;; Without setting the default, new buffers that come up in emacs mode have
;; minor-mode-map-alist = nil, unless we call viper-change-state-*
(when (eq viper-current-state 'emacs-state)
- (viper-change-state-to-emacs)
- (unless
- (and (fboundp 'add-to-ordered-list)
- (boundp 'emulation-mode-map-alists))
- (setq-default minor-mode-map-alist minor-mode-map-alist))
- )
+ (viper-change-state-to-emacs))
(if (this-major-mode-requires-vi-state major-mode)
(viper-mode))
diff --git a/lisp/epa-dired.el b/lisp/epa-dired.el
index f601d426566..4ff1ba33941 100644
--- a/lisp/epa-dired.el
+++ b/lisp/epa-dired.el
@@ -1,4 +1,5 @@
;;; epa-dired.el --- the EasyPG Assistant, dired extension -*- lexical-binding: t -*-
+
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
@@ -29,48 +30,40 @@
(defun epa-dired-do-decrypt ()
"Decrypt marked files."
(interactive)
- (let ((file-list (dired-get-marked-files)))
- (while file-list
- (epa-decrypt-file (expand-file-name (car file-list)))
- (setq file-list (cdr file-list)))
- (revert-buffer)))
+ (dolist (file (dired-get-marked-files))
+ (epa-decrypt-file (expand-file-name file)))
+ (revert-buffer))
;;;###autoload
(defun epa-dired-do-verify ()
"Verify marked files."
(interactive)
- (let ((file-list (dired-get-marked-files)))
- (while file-list
- (epa-verify-file (expand-file-name (car file-list)))
- (setq file-list (cdr file-list)))))
+ (dolist (file (dired-get-marked-files))
+ (epa-verify-file (expand-file-name file))))
;;;###autoload
(defun epa-dired-do-sign ()
"Sign marked files."
(interactive)
- (let ((file-list (dired-get-marked-files)))
- (while file-list
- (epa-sign-file
- (expand-file-name (car file-list))
- (epa-select-keys (epg-make-context) "Select keys for signing.
+ (dolist (file (dired-get-marked-files))
+ (epa-sign-file
+ (expand-file-name file)
+ (epa-select-keys (epg-make-context) "Select keys for signing.
If no one is selected, default secret key is used. "
- nil t)
- (y-or-n-p "Make a detached signature? "))
- (setq file-list (cdr file-list)))
- (revert-buffer)))
+ nil t)
+ (y-or-n-p "Make a detached signature? ")))
+ (revert-buffer))
;;;###autoload
(defun epa-dired-do-encrypt ()
"Encrypt marked files."
(interactive)
- (let ((file-list (dired-get-marked-files)))
- (while file-list
- (epa-encrypt-file
- (expand-file-name (car file-list))
- (epa-select-keys (epg-make-context) "Select recipients for encryption.
-If no one is selected, symmetric encryption will be performed. "))
- (setq file-list (cdr file-list)))
- (revert-buffer)))
+ (dolist (file (dired-get-marked-files))
+ (epa-encrypt-file
+ (expand-file-name file)
+ (epa-select-keys (epg-make-context) "Select recipients for encryption.
+If no one is selected, symmetric encryption will be performed. ")))
+ (revert-buffer))
(provide 'epa-dired)
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index dedf20b0d77..7fd41784746 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -1,4 +1,5 @@
;;; epa-file.el --- the EasyPG Assistant, transparent file encryption -*- lexical-binding: t -*-
+
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
@@ -21,9 +22,13 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+;;; Dependencies
(require 'epa)
(require 'epa-hook)
+(eval-when-compile (require 'subr-x))
+
+;;; Options
(defcustom epa-file-cache-passphrase-for-symmetric-encryption nil
"If non-nil, cache passphrase for symmetric encryption.
@@ -40,26 +45,18 @@ Note that this option has no effect if you use GnuPG 2.0."
(defcustom epa-file-select-keys nil
"Control whether or not to pop up the key selection dialog.
-If t, always asks user to select recipients.
+If t, always ask user to select recipients.
If nil, query user only when `epa-file-encrypt-to' is not set.
-If neither t nor nil, doesn't ask user. In this case, symmetric
+If neither t nor nil, don't ask user. In this case, symmetric
encryption is used."
:type '(choice (const :tag "Ask always" t)
(const :tag "Ask when recipients are not set" nil)
(const :tag "Don't ask" silent))
:group 'epa-file)
-(defvar epa-file-passphrase-alist nil)
-
-(eval-and-compile
- (if (fboundp 'encode-coding-string)
- (defalias 'epa-file--encode-coding-string 'encode-coding-string)
- (defalias 'epa-file--encode-coding-string 'identity)))
+;;; Other
-(eval-and-compile
- (if (fboundp 'decode-coding-string)
- (defalias 'epa-file--decode-coding-string 'decode-coding-string)
- (defalias 'epa-file--decode-coding-string 'identity)))
+(defvar epa-file-passphrase-alist nil)
(defun epa-file-passphrase-callback-function (context key-id file)
(if (and epa-file-cache-passphrase-for-symmetric-encryption
@@ -71,8 +68,8 @@ encryption is used."
(or (copy-sequence (cdr entry))
(progn
(unless entry
- (setq entry (list file)
- epa-file-passphrase-alist
+ (setq entry (list file))
+ (setq epa-file-passphrase-alist
(cons entry
epa-file-passphrase-alist)))
(setq passphrase (epa-passphrase-callback-function context
@@ -82,6 +79,8 @@ encryption is used."
passphrase))))
(epa-passphrase-callback-function context key-id file)))
+;;; File Handler
+
(defvar epa-inhibit nil
"Non-nil means don't try to decrypt .gpg files when operating on them.")
@@ -117,8 +116,17 @@ encryption is used."
(let ((error epa-file-error))
(save-window-excursion
(kill-buffer))
- (signal 'file-missing
- (cons "Opening input file" (cdr error)))))
+ (if (nth 3 error)
+ (user-error "Wrong passphrase: %s" (nth 3 error))
+ (signal 'file-missing
+ (cons "Opening input file" (cdr error))))))
+
+(defun epa--wrong-password-p (context)
+ (let ((error-string (epg-context-error-output context)))
+ (and (string-match
+ "decryption failed: \\(Bad session key\\|No secret key\\)"
+ error-string)
+ (match-string 1 error-string))))
(defvar last-coding-system-used)
(defun epa-file-insert-file-contents (file &optional visit beg end replace)
@@ -161,15 +169,28 @@ encryption is used."
(nth 3 error)))
(let ((exists (file-exists-p local-file)))
(when exists
- ;; Hack to prevent find-file from opening empty buffer
- ;; when decryption failed (bug#6568). See the place
- ;; where `find-file-not-found-functions' are called in
- ;; `find-file-noselect-1'.
- (setq-local epa-file-error error)
- (add-hook 'find-file-not-found-functions
- 'epa-file--find-file-not-found-function
- nil t)
- (epa-display-error context))
+ (if-let ((wrong-password (epa--wrong-password-p context)))
+ ;; Don't display the *error* buffer if we just
+ ;; have a wrong password; let the later error
+ ;; handler notify the user.
+ (setq error (append error (list wrong-password)))
+ (epa-display-error context))
+ ;; When the .gpg file isn't an encrypted file (e.g.,
+ ;; it's a keyring.gpg file instead), then gpg will
+ ;; say "Unexpected exit" as the error message. In
+ ;; that case, just display the bytes.
+ (if (equal (caddr error) "Unexpected; Exit")
+ (setq string (with-temp-buffer
+ (insert-file-contents-literally local-file)
+ (buffer-string)))
+ ;; Hack to prevent find-file from opening empty buffer
+ ;; when decryption failed (bug#6568). See the place
+ ;; where `find-file-not-found-functions' are called in
+ ;; `find-file-noselect-1'.
+ (setq-local epa-file-error error)
+ (add-hook 'find-file-not-found-functions
+ 'epa-file--find-file-not-found-function
+ nil t)))
(signal (if exists 'file-error 'file-missing)
(cons "Opening input file" (cdr error))))))
(set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)!
@@ -236,11 +257,7 @@ encryption is used."
(setq file (expand-file-name file))
(let* ((coding-system (or coding-system-for-write
(if (fboundp 'select-safe-coding-system)
- ;; This is needed since Emacs 22 has
- ;; no-conversion setting for *.gpg in
- ;; `auto-coding-alist'.
- (let ((buffer-file-name
- (file-name-sans-extension file)))
+ (let ((buffer-file-name file))
(select-safe-coding-system
(point-min) (point-max)))
buffer-file-coding-system)))
@@ -266,7 +283,7 @@ encryption is used."
(epg-encrypt-string
context
(if (stringp start)
- (epa-file--encode-coding-string start coding-system)
+ (encode-coding-string start coding-system)
(unless start
(setq start (point-min)
end (point-max)))
@@ -280,8 +297,8 @@ encryption is used."
;; decrypted contents.
(format-encode-buffer (with-current-buffer buffer
buffer-file-format))
- (epa-file--encode-coding-string (buffer-string)
- coding-system)))
+ (encode-coding-string (buffer-string)
+ coding-system)))
(if (or (eq epa-file-select-keys t)
(and (null epa-file-select-keys)
(not (local-variable-p 'epa-file-encrypt-to
@@ -317,6 +334,8 @@ If no one is selected, symmetric encryption will be performed. "
(message "Wrote %s" buffer-file-name))))
(put 'write-region 'epa-file 'epa-file-write-region)
+;;; Commands
+
(defun epa-file-select-keys ()
"Select recipients for encryption."
(interactive)
diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el
index d424e7a9faf..6f12f8a6bfa 100644
--- a/lisp/epa-hook.el
+++ b/lisp/epa-hook.el
@@ -1,4 +1,5 @@
;;; epa-hook.el --- preloaded code to enable epa-file.el -*- lexical-binding: t -*-
+
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
@@ -35,10 +36,10 @@
(defcustom epa-file-name-regexp (purecopy "\\.gpg\\(~\\|\\.~[0-9]+~\\)?\\'")
"Regexp which matches filenames to be encrypted with GnuPG.
-If you set this outside Custom while epa-file is already enabled, you
-have to call `epa-file-name-regexp-update' after setting it to
-properly update file-name-handler-alist. Setting this through Custom
-does that automatically."
+If you set this outside Custom while epa-file is already enabled,
+you have to call `epa-file-name-regexp-update' after setting it
+to properly update `file-name-handler-alist'. Setting this
+through Custom does that automatically."
:type 'regexp
:group 'epa-file
:set 'epa-file--file-name-regexp-set)
@@ -72,6 +73,9 @@ May either be a string or a list of strings.")
(list epa-file-name-regexp nil 'epa-file))
(defun epa-file-name-regexp-update ()
+ "Update `file-name-handler-alist' after configuring outside Custom.
+After setting `epa-file-name-regexp-update' outside the Custom
+interface, update `file-name-handler-alist'."
(interactive)
(unless (equal (car epa-file-handler) epa-file-name-regexp)
(setcar epa-file-handler epa-file-name-regexp)))
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index 63475256ca8..3ad4da16c89 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -1,4 +1,5 @@
;;; epa-mail.el --- the EasyPG Assistant, minor-mode for mail composer -*- lexical-binding: t -*-
+
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
@@ -21,10 +22,13 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+;;; Dependencies
(require 'epa)
(require 'mail-utils)
+;;; Local Mode
+
(defvar epa-mail-mode-map
(let ((keymap (make-sparse-keymap)))
(define-key keymap "\C-c\C-ed" 'epa-mail-decrypt)
@@ -45,11 +49,20 @@
(defvar epa-mail-mode-on-hook nil)
(defvar epa-mail-mode-off-hook nil)
+(defcustom epa-mail-offer-skip t
+ "If non-nil, when a recipient has no key, ask whether to skip it.
+Otherwise, signal an error."
+ :type 'boolean
+ :version "28.1"
+ :group 'epa-mail)
+
;;;###autoload
(define-minor-mode epa-mail-mode
"A minor-mode for composing encrypted/clearsigned mails."
nil " epa-mail" epa-mail-mode-map)
+;;; Utilities
+
(defun epa-mail--find-usable-key (keys usage)
"Find a usable key from KEYS for USAGE.
USAGE would be `sign' or `encrypt'."
@@ -64,6 +77,8 @@ USAGE would be `sign' or `encrypt'."
(setq pointer (cdr pointer))))
(setq keys (cdr keys)))))
+;;; Commands
+
;;;###autoload
(defun epa-mail-decrypt ()
"Decrypt OpenPGP armors in the current buffer.
@@ -210,10 +225,12 @@ If no one is selected, symmetric encryption will be performed. "
recipient))
'encrypt)))
(unless (or recipient-key
- (y-or-n-p
- (format
- "No public key for %s; skip it? "
- recipient)))
+ (and epa-mail-offer-skip
+ (y-or-n-p
+ (format
+ "No public key for %s; skip it? "
+ recipient)))
+ )
(error "No public key for %s" recipient))
(if recipient-key (list recipient-key))))
default-recipients)))))
@@ -241,6 +258,8 @@ The buffer is expected to contain a mail message."
(interactive)
(epa-import-armor-in-region (point-min) (point-max)))
+;;; Global Mode
+
;;;###autoload
(define-minor-mode epa-global-mail-mode
"Minor mode to hook EasyPG into Mail mode."
diff --git a/lisp/epa.el b/lisp/epa.el
index 47c177e6cd5..25e055c201f 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -21,13 +21,15 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+;;; Dependencies
(require 'epg)
(require 'font-lock)
-(require 'widget)
-(eval-when-compile (require 'wid-edit))
+(eval-when-compile (require 'subr-x))
(require 'derived)
+;;; Options
+
(defgroup epa nil
"The EasyPG Assistant"
:version "23.1"
@@ -56,11 +58,6 @@ If neither t nor nil, ask user for confirmation."
:type 'integer
:group 'epa)
-(defgroup epa-faces nil
- "Faces for epa-mode."
- :version "23.1"
- :group 'epa)
-
(defcustom epa-mail-aliases nil
"Alist of aliases of email addresses that stand for encryption keys.
Each element is a list of email addresses (ALIAS EXPANSIONS...).
@@ -76,6 +73,13 @@ The command `epa-mail-encrypt' uses this."
:group 'epa
:version "24.4")
+;;; Faces
+
+(defgroup epa-faces nil
+ "Faces for epa-mode."
+ :version "23.1"
+ :group 'epa)
+
(defface epa-validity-high
'((default :weight bold)
(((class color) (background dark)) :foreground "PaleTurquoise"))
@@ -117,13 +121,15 @@ The command `epa-mail-encrypt' uses this."
'((default :weight bold)
(((class color) (background dark)) :foreground "PaleTurquoise"))
"Face for the name of the attribute field."
- :group 'epa)
+ :version "28.1"
+ :group 'epa-faces)
(defface epa-field-body
'((default :slant italic)
(((class color) (background dark)) :foreground "turquoise"))
"Face for the body of the attribute field."
- :group 'epa)
+ :version "28.1"
+ :group 'epa-faces)
(defcustom epa-validity-face-alist
'((unknown . epa-validity-disabled)
@@ -138,16 +144,11 @@ The command `epa-mail-encrypt' uses this."
(full . epa-validity-high)
(ultimate . epa-validity-high))
"An alist mapping validity values to faces."
+ :version "28.1"
:type '(repeat (cons symbol face))
- :group 'epa)
+ :group 'epa-faces)
-(defvar epa-font-lock-keywords
- '(("^\\*"
- (0 'epa-mark))
- ("^\t\\([^\t:]+:\\)[ \t]*\\(.*\\)$"
- (1 'epa-field-name)
- (2 'epa-field-body)))
- "Default expressions to addon in epa-mode.")
+;;; Variables
(defconst epa-pubkey-algorithm-letter-alist
'((1 . ?R)
@@ -185,6 +186,9 @@ You should bind this variable with `let', but do not set it globally.")
(defvar epa-key-list-mode-map
(let ((keymap (make-sparse-keymap))
(menu-map (make-sparse-keymap)))
+ (define-key keymap "\C-m" 'epa-show-key)
+ (define-key keymap [?\t] 'forward-button)
+ (define-key keymap [backtab] 'backward-button)
(define-key keymap "m" 'epa-mark-key)
(define-key keymap "u" 'epa-unmark-key)
(define-key keymap "d" 'epa-decrypt-file)
@@ -245,53 +249,43 @@ You should bind this variable with `let', but do not set it globally.")
(defvar epa-exit-buffer-function #'quit-window)
-(define-widget 'epa-key 'push-button
- "Button for representing an epg-key object."
- :format "%[%v%]"
- :button-face-get 'epa--key-widget-button-face-get
- :value-create 'epa--key-widget-value-create
- :action 'epa--key-widget-action
- :help-echo 'epa--key-widget-help-echo)
-
-(defun epa--key-widget-action (widget &optional _event)
- (save-selected-window
- (epa--show-key (widget-get widget :value))))
-
-(defun epa--key-widget-value-create (widget)
- (let* ((key (widget-get widget :value))
- (primary-sub-key (car (epg-key-sub-key-list key)))
- (primary-user-id (car (epg-key-user-id-list key))))
- (insert (format "%c "
- (if (epg-sub-key-validity primary-sub-key)
- (car (rassq (epg-sub-key-validity primary-sub-key)
- epg-key-validity-alist))
- ? ))
- (epg-sub-key-id primary-sub-key)
- " "
- (if primary-user-id
- (if (stringp (epg-user-id-string primary-user-id))
- (epg-user-id-string primary-user-id)
- (epg-decode-dn (epg-user-id-string primary-user-id)))
- ""))))
-
-(defun epa--key-widget-button-face-get (widget)
- (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list
- (widget-get widget :value))))))
- (if validity
- (cdr (assq validity epa-validity-face-alist))
- 'default)))
-
-(defun epa--key-widget-help-echo (widget)
- (format "Show %s"
- (epg-sub-key-id (car (epg-key-sub-key-list
- (widget-get widget :value))))))
+(defun epa--button-key-text (key)
+ (let ((primary-sub-key (car (epg-key-sub-key-list key)))
+ (primary-user-id (car (epg-key-user-id-list key)))
+ (validity (epg-sub-key-validity (car (epg-key-sub-key-list key)))))
+ (propertize
+ (concat
+ (propertize
+ (format "%c "
+ (if (epg-sub-key-validity primary-sub-key)
+ (car (rassq (epg-sub-key-validity primary-sub-key)
+ epg-key-validity-alist))
+ ? ))
+ 'help-echo (format "Validity: %s"
+ (epg-sub-key-validity primary-sub-key)))
+ (propertize
+ (concat
+ (epg-sub-key-id primary-sub-key)
+ " "
+ (if primary-user-id
+ (if (stringp (epg-user-id-string primary-user-id))
+ (epg-user-id-string primary-user-id)
+ (epg-decode-dn (epg-user-id-string primary-user-id)))
+ ""))
+ 'help-echo (format "Show %s"
+ (epg-sub-key-id (car (epg-key-sub-key-list key))))))
+ 'face
+ (if validity
+ (cdr (assq validity epa-validity-face-alist))
+ 'default))))
+
+;;; Modes
(define-derived-mode epa-key-list-mode special-mode "EPA Keys"
"Major mode for `epa-list-keys'."
(buffer-disable-undo)
(setq truncate-lines t
buffer-read-only t)
- (setq-local font-lock-defaults '(epa-font-lock-keywords t))
(make-local-variable 'epa-exit-buffer-function)
(setq-local revert-buffer-function #'epa--key-list-revert-buffer))
@@ -300,7 +294,6 @@ You should bind this variable with `let', but do not set it globally.")
(buffer-disable-undo)
(setq truncate-lines t
buffer-read-only t)
- (setq-local font-lock-defaults '(epa-font-lock-keywords t))
(make-local-variable 'epa-exit-buffer-function))
(define-derived-mode epa-info-mode special-mode "EPA Info"
@@ -309,6 +302,9 @@ You should bind this variable with `let', but do not set it globally.")
(setq truncate-lines t
buffer-read-only t))
+;;; Commands
+;;;; Marking
+
(defun epa-mark-key (&optional arg)
"Mark a key on the current line.
If ARG is non-nil, unmark the key."
@@ -331,37 +327,27 @@ If ARG is non-nil, mark the key."
(interactive "P")
(epa-mark-key (not arg)))
+;;;; Quitting
+
(defun epa-exit-buffer ()
- "Exit the current buffer.
-`epa-exit-buffer-function' is called if it is set."
+ "Exit the current buffer using `epa-exit-buffer-function'."
(interactive)
(funcall epa-exit-buffer-function))
-(defun epa--insert-keys (keys)
- (save-excursion
- (save-restriction
- (narrow-to-region (point) (point))
- (let (point)
- (while keys
- (setq point (point))
- (insert " ")
- (add-text-properties point (point)
- (list 'epa-key (car keys)
- 'front-sticky nil
- 'rear-nonsticky t
- 'start-open t
- 'end-open t))
- (widget-create 'epa-key :value (car keys))
- (insert "\n")
- (setq keys (cdr keys))))
- (add-text-properties (point-min) (point-max)
- (list 'epa-list-keys t
- 'front-sticky nil
- 'rear-nonsticky t
- 'start-open t
- 'end-open t)))))
+;;;; Listing and Selecting
-(defun epa--list-keys (name secret)
+(defun epa--insert-keys (keys)
+ (dolist (key keys)
+ (insert
+ (propertize
+ (concat " " (epa--button-key-text key))
+ 'epa-key key))
+ (insert "\n")))
+
+(defun epa--list-keys (name secret &optional doc)
+ "NAME specifies which key to list.
+SECRET says list data on the secret key (default, the public key).
+DOC is documentation text to insert at the start."
(unless (and epa-keys-buffer
(buffer-live-p epa-keys-buffer))
(setq epa-keys-buffer (generate-new-buffer "*Keys*")))
@@ -371,16 +357,29 @@ If ARG is non-nil, mark the key."
buffer-read-only
(point (point-min))
(context (epg-make-context epa-protocol)))
+
+ ;; Find the end of the documentation text at the start.
+ ;; Set POINT to where it ends, or nil if ends at eob.
(unless (get-text-property point 'epa-list-keys)
(setq point (next-single-property-change point 'epa-list-keys)))
+
+ ;; If caller specified documentation text for that, replace the old
+ ;; documentation text (if any) with what was specified.
+ ;; Otherwise, preserve whatever intro text is present.
+ (when doc
+ (if (or point (not (eobp)))
+ (delete-region (point-min) point))
+ (insert doc)
+ (setq point (point)))
+
+ ;; Now delete the key description text, if any.
(when point
(delete-region point
(or (next-single-property-change point 'epa-list-keys)
(point-max)))
(goto-char point))
- (epa--insert-keys (epg-list-keys context name secret))
- (widget-setup)
- (set-keymap-parent (current-local-map) widget-keymap))
+
+ (epa--insert-keys (epg-list-keys context name secret)))
(make-local-variable 'epa-list-keys-arguments)
(setq epa-list-keys-arguments (list name secret))
(goto-char (point-min))
@@ -396,7 +395,13 @@ If ARG is non-nil, mark the key."
(car epa-list-keys-arguments)))))
(list (if (equal name "") nil name)))
(list nil)))
- (epa--list-keys name nil))
+ (epa--list-keys name nil
+ "The letters at the start of a line have these meanings.
+e expired key. n never trust. m trust marginally. u trust ultimately.
+f trust fully (keys you have signed, usually).
+q trust status questionable. - trust status unspecified.
+ See GPG documentation for more explanation.
+\n"))
;;;###autoload
(defun epa-list-secret-keys (&optional name)
@@ -430,40 +435,34 @@ If ARG is non-nil, mark the key."
(unless (and epa-keys-buffer
(buffer-live-p epa-keys-buffer))
(setq epa-keys-buffer (generate-new-buffer "*Keys*")))
- (with-current-buffer epa-keys-buffer
- (epa-key-list-mode)
- ;; C-c C-c is the usual way to finish the selection (bug#11159).
- (define-key (current-local-map) "\C-c\C-c" 'exit-recursive-edit)
- (let ((inhibit-read-only t)
- buffer-read-only)
- (erase-buffer)
- (insert prompt "\n"
- (substitute-command-keys "\
+ (save-window-excursion
+ (with-current-buffer epa-keys-buffer
+ (epa-key-list-mode)
+ ;; C-c C-c is the usual way to finish the selection (bug#11159).
+ (define-key (current-local-map) "\C-c\C-c" 'exit-recursive-edit)
+ (let ((inhibit-read-only t)
+ buffer-read-only)
+ (erase-buffer)
+ (insert prompt "\n"
+ (substitute-command-keys "\
- `\\[epa-mark-key]' to mark a key on the line
- `\\[epa-unmark-key]' to unmark a key on the line\n"))
- (widget-create 'push-button
- :notify (lambda (&rest _ignore) (abort-recursive-edit))
- :help-echo
- "Click here or \\[abort-recursive-edit] to cancel"
- "Cancel")
- (widget-create 'push-button
- :notify (lambda (&rest _ignore) (exit-recursive-edit))
- :help-echo
- "Click here or \\[exit-recursive-edit] to finish"
- "OK")
- (insert "\n\n")
- (epa--insert-keys keys)
- (widget-setup)
- (set-keymap-parent (current-local-map) widget-keymap)
- (setq epa-exit-buffer-function #'abort-recursive-edit)
- (goto-char (point-min))
- (let ((display-buffer-mark-dedicated 'soft))
- (pop-to-buffer (current-buffer))))
- (unwind-protect
- (progn
- (recursive-edit)
- (epa--marked-keys))
- (kill-buffer epa-keys-buffer))))
+ (insert-button "[Cancel]"
+ 'action (lambda (_button) (abort-recursive-edit)))
+ (insert " ")
+ (insert-button "[OK]"
+ 'action (lambda (_button) (exit-recursive-edit)))
+ (insert "\n\n")
+ (epa--insert-keys keys)
+ (setq epa-exit-buffer-function #'abort-recursive-edit)
+ (goto-char (point-min))
+ (let ((display-buffer-mark-dedicated 'soft))
+ (pop-to-buffer (current-buffer))))
+ (unwind-protect
+ (progn
+ (recursive-edit)
+ (epa--marked-keys))
+ (kill-buffer epa-keys-buffer)))))
;;;###autoload
(defun epa-select-keys (context prompt &optional names secret)
@@ -476,6 +475,16 @@ If SECRET is non-nil, list secret keys instead of public keys."
(let ((keys (epg-list-keys context names secret)))
(epa--select-keys prompt keys)))
+;;;; Key Details
+
+(defun epa-show-key ()
+ "Show a key on the current line."
+ (interactive)
+ (if-let ((key (get-text-property (point) 'epa-key)))
+ (save-selected-window
+ (epa--show-key key))
+ (error "No key on this line")))
+
(defun epa--show-key (key)
(let* ((primary-sub-key (car (epg-key-sub-key-list key)))
(entry (assoc (epg-sub-key-id primary-sub-key)
@@ -554,6 +563,8 @@ If SECRET is non-nil, list secret keys instead of public keys."
(goto-char (point-min))
(pop-to-buffer (current-buffer))))
+;;;; Encryption and Signatures
+
(defun epa-display-info (info)
(if epa-popup-info-window
(save-selected-window
@@ -607,10 +618,6 @@ If SECRET is non-nil, list secret keys instead of public keys."
(goto-char (point-min)))
(display-buffer buffer)))))
-(defun epa-display-verify-result (verify-result)
- (declare (obsolete epa-display-info "23.1"))
- (epa-display-info (epg-verify-result-to-string verify-result)))
-
(defun epa-passphrase-callback-function (context key-id handback)
(if (eq key-id 'SYM)
(read-passwd
@@ -1068,16 +1075,7 @@ If no one is selected, default secret key is used. "
'start-open t
'end-open t)))))
-(defalias 'epa--derived-mode-p
- (if (fboundp 'derived-mode-p)
- #'derived-mode-p
- (lambda (&rest modes)
- "Non-nil if the current major mode is derived from one of MODES.
-Uses the `derived-mode-parent' property of the symbol to trace backwards."
- (let ((parent major-mode))
- (while (and (not (memq parent modes))
- (setq parent (get parent 'derived-mode-parent))))
- parent))))
+(define-obsolete-function-alias 'epa--derived-mode-p 'derived-mode-p "28.1")
;;;###autoload
(defun epa-encrypt-region (start end recipients sign signers)
@@ -1154,6 +1152,8 @@ If no one is selected, symmetric encryption will be performed. ")
'start-open t
'end-open t)))))
+;;;; Key Management
+
;;;###autoload
(defun epa-delete-keys (keys &optional allow-secret)
"Delete selected KEYS."
@@ -1190,7 +1190,7 @@ If no one is selected, symmetric encryption will be performed. ")
(if (epg-context-result-for context 'import)
(epa-display-info (epg-import-result-to-string
(epg-context-result-for context 'import))))
- ;; FIXME: Why not use the (otherwise unused) epa--derived-mode-p?
+ ;; FIXME: Why not use the derived-mode-p?
(if (eq major-mode 'epa-key-list-mode)
(apply #'epa--list-keys epa-list-keys-arguments))))
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index daa9a5abd17..9f0c7e4c509 100644
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -22,6 +22,7 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+;;; Prelude
(eval-when-compile (require 'cl-lib))
@@ -34,6 +35,8 @@
(define-obsolete-variable-alias 'epg-bug-report-address
'report-emacs-bug-address "27.1")
+;;; Options
+
(defgroup epg ()
"Interface to the GNU Privacy Guard (GnuPG)."
:tag "EasyPG"
@@ -106,6 +109,8 @@ through the minibuffer, instead of external Pinentry program."
Note that the buffer name starts with a space."
:type 'boolean)
+;;; Constants
+
(defconst epg-gpg-minimum-version "1.4.3")
(defconst epg-gpg2-minimum-version "2.1.6")
@@ -133,6 +138,8 @@ The first element of each entry is protocol symbol, which is
either `OpenPGP' or `CMS'. The second element is a function
which constructs a configuration object (actually a plist).")
+;;; "Configuration"
+
(defvar epg--configurations nil)
;;;###autoload
@@ -202,13 +209,13 @@ version requirement is met."
(cond
((eq type 'group)
(if (string-match "\\`\\([^:]+\\):" args)
- (setq groups
- (cons (cons (downcase (match-string 1 args))
- (delete "" (split-string
- (substring args
- (match-end 0))
- ";")))
- groups))
+ (setq groups
+ (cons (cons (downcase (match-string 1 args))
+ (delete "" (split-string
+ (substring args
+ (match-end 0))
+ ";")))
+ groups))
(if epg-debug
(message "Invalid group configuration: %S" args))))
((memq type '(pubkey cipher digest compress))
diff --git a/lisp/epg.el b/lisp/epg.el
index 222fd913e17..920b85398f3 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1,4 +1,5 @@
;;; epg.el --- the EasyPG Library -*- lexical-binding: t -*-
+
;; Copyright (C) 1999-2000, 2002-2020 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
@@ -21,10 +22,15 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+;;; Prelude
(require 'epg-config)
(eval-when-compile (require 'cl-lib))
+(define-error 'epg-error "GPG error")
+
+;;; Variables
+
(defvar epg-user-id nil
"GnuPG ID of your default identity.")
@@ -41,6 +47,8 @@
(defvar epg-agent-file nil)
(defvar epg-agent-mtime nil)
+;;; Enums
+
;; from gnupg/common/openpgpdefs.h
(defconst epg-cipher-algorithm-alist
'((0 . "NONE")
@@ -123,7 +131,7 @@
(defconst epg-no-data-reason-alist
'((1 . "No armored data")
- (2 . "Expected a packet but did not found one")
+ (2 . "Expected a packet but did not find one")
(3 . "Invalid packet found, this may indicate a non OpenPGP message")
(4 . "Signature expected but not found")))
@@ -169,7 +177,8 @@
(defvar epg-prompt-alist nil)
-(define-error 'epg-error "GPG error")
+;;; Structs
+;;;; Data Struct
(cl-defstruct (epg-data
(:constructor nil)
@@ -180,6 +189,9 @@
(file nil :read-only t)
(string nil :read-only t))
+;;;; Context Struct
+(declare-function epa-passphrase-callback-function "epa.el")
+
(cl-defstruct (epg-context
(:constructor nil)
(:constructor epg-context--make
@@ -204,7 +216,7 @@
cipher-algorithm
digest-algorithm
compress-algorithm
- (passphrase-callback (list #'epg-passphrase-callback-function))
+ (passphrase-callback (list #'epa-passphrase-callback-function))
progress-callback
edit-callback
signers
@@ -218,6 +230,8 @@
(error-output "")
error-buffer)
+;;;; Context Methods
+
;; This is not an alias, just so we can mark it as autoloaded.
;;;###autoload
(defun epg-make-context (&optional protocol armor textmode include-certs
@@ -281,6 +295,8 @@ callback data (if any)."
(declare (obsolete setf "25.1"))
(setf (epg-context-signers context) signers))
+;;;; Other Structs
+
(cl-defstruct (epg-signature
(:constructor nil)
(:constructor epg-make-signature
@@ -385,6 +401,8 @@ callback data (if any)."
secret-unchanged not-imported
imports)
+;;; Functions
+
(defun epg-context-result-for (context name)
"Return the result of CONTEXT associated with NAME."
(cdr (assq name (epg-context-result context))))
@@ -404,37 +422,28 @@ callback data (if any)."
(pubkey-algorithm (epg-signature-pubkey-algorithm signature))
(key-id (epg-signature-key-id signature)))
(concat
- (cond ((eq (epg-signature-status signature) 'good)
- "Good signature from ")
- ((eq (epg-signature-status signature) 'bad)
- "Bad signature from ")
- ((eq (epg-signature-status signature) 'expired)
- "Expired signature from ")
- ((eq (epg-signature-status signature) 'expired-key)
- "Signature made by expired key ")
- ((eq (epg-signature-status signature) 'revoked-key)
- "Signature made by revoked key ")
- ((eq (epg-signature-status signature) 'no-pubkey)
- "No public key for "))
+ (cl-case (epg-signature-status signature)
+ (good "Good signature from ")
+ (bad "Bad signature from ")
+ (expired "Expired signature from ")
+ (expired-key "Signature made by expired key ")
+ (revoked-key "Signature made by revoked key ")
+ (no-pubkey "No public key for "))
key-id
- (if user-id
- (concat " "
- (if (stringp user-id)
- (epg--decode-percent-escape-as-utf-8 user-id)
- (epg-decode-dn user-id)))
- "")
- (if (epg-signature-validity signature)
- (format " (trust %s)" (epg-signature-validity signature))
- "")
- (if (epg-signature-creation-time signature)
- (format-time-string " created at %Y-%m-%dT%T%z"
- (epg-signature-creation-time signature))
- "")
- (if pubkey-algorithm
- (concat " using "
- (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist))
- (format "(unknown algorithm %d)" pubkey-algorithm)))
- ""))))
+ (and user-id
+ (concat " "
+ (if (stringp user-id)
+ (epg--decode-percent-escape-as-utf-8 user-id)
+ (epg-decode-dn user-id))))
+ (and (epg-signature-validity signature)
+ (format " (trust %s)" (epg-signature-validity signature)))
+ (and (epg-signature-creation-time signature)
+ (format-time-string " created at %Y-%m-%dT%T%z"
+ (epg-signature-creation-time signature)))
+ (and pubkey-algorithm
+ (concat " using "
+ (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist))
+ (format "(unknown algorithm %d)" pubkey-algorithm)))))))
(defun epg-verify-result-to-string (verify-result)
"Convert VERIFY-RESULT to a human readable string."
@@ -859,6 +868,8 @@ callback data (if any)."
(format "Untrusted key %s %s. Use anyway? " key-id user-id))
"Use untrusted key anyway? ")))
+;;; Status Functions
+
(defun epg--status-GET_BOOL (context string)
(let (inhibit-quit)
(condition-case nil
@@ -1234,18 +1245,7 @@ callback data (if any)."
(epg-context-result-for context 'import-status)))
(epg-context-set-result-for context 'import-status nil)))
-(defun epg-passphrase-callback-function (context key-id _handback)
- (declare (obsolete epa-passphrase-callback-function "23.1"))
- (if (eq key-id 'SYM)
- (read-passwd "Passphrase for symmetric encryption: "
- (eq (epg-context-operation context) 'encrypt))
- (read-passwd
- (if (eq key-id 'PIN)
- "Passphrase for PIN: "
- (let ((entry (assoc key-id epg-user-id-alist)))
- (if entry
- (format "Passphrase for %s %s: " key-id (cdr entry))
- (format "Passphrase for %s: " key-id)))))))
+;;; Functions
(defun epg--list-keys-1 (context name mode)
(let ((args (append (if (epg-context-home-directory context)
@@ -1303,6 +1303,8 @@ callback data (if any)."
(if (aref line 6)
(epg--time-from-seconds (aref line 6)))))
+;;; Public Functions
+
(defun epg-list-keys (context &optional name mode)
"Return a list of epg-key objects matched with NAME.
If MODE is nil or `public', only public keyring should be searched.
@@ -1683,7 +1685,8 @@ Otherwise, it makes a cleartext signature."
(if (epg-context-result-for context 'error)
(let ((errors (epg-context-result-for context 'error)))
(signal 'epg-error
- (list "Sign failed" (epg-errors-to-string errors))))))
+ (list "Sign failed" (epg-errors-to-string errors))))
+ (signal 'epg-error '("Signing failed (unknown reason)"))))
(epg-read-output context))
(epg-delete-output-file context)
(if input-file
@@ -2031,6 +2034,8 @@ If you are unsure, use synchronous version of this function
(epg-errors-to-string errors))))))
(epg-reset context)))
+;;; Decode Functions
+
(defun epg--decode-percent-escape (string)
(setq string (encode-coding-string string 'raw-text))
(let ((index 0))
diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el
index 0950cec4f7f..0923ed6e735 100644
--- a/lisp/erc/erc-autoaway.el
+++ b/lisp/erc/erc-autoaway.el
@@ -54,7 +54,7 @@ If `erc-autoaway-idle-method' is `emacs', you must call this
function each time you change `erc-autoaway-idle-seconds'."
(interactive)
(when erc-autoaway-idletimer
- (erc-cancel-timer erc-autoaway-idletimer))
+ (cancel-timer erc-autoaway-idletimer))
(setq erc-autoaway-idletimer
(run-with-idle-timer erc-autoaway-idle-seconds
t
@@ -133,7 +133,7 @@ Related variables: `erc-public-away-p' and `erc-away-nickname'."
(remove-hook 'erc-after-connect 'erc-autoaway-insinuate-maybe)
(remove-hook 'erc-disconnected-hook 'erc-autoaway-remove-maybe))
((eq erc-autoaway-idle-method 'emacs)
- (erc-cancel-timer erc-autoaway-idletimer)
+ (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))))
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 526e854beca..1cf0bb49217 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -98,7 +98,6 @@
;;; Code:
-(require 'erc-compat)
(eval-when-compile (require 'cl-lib))
;; There's a fairly strong mutual dependency between erc.el and erc-backend.el.
;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the
@@ -375,7 +374,7 @@ 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 (string :tag "Target")
+ :type '(repeat (cons (regexp :tag "Target")
coding-system)))
(defcustom erc-server-connect-function #'erc-open-network-stream
@@ -520,7 +519,8 @@ If no subword-mode is active, then this is
"Set up a timer to periodically ping the current server.
The current buffer is given by BUFFER."
(with-current-buffer buffer
- (and erc-server-ping-handler (erc-cancel-timer erc-server-ping-handler))
+ (when erc-server-ping-handler
+ (cancel-timer erc-server-ping-handler))
(when erc-server-send-ping-interval
(setq erc-server-ping-handler (run-with-timer
4 erc-server-send-ping-interval
@@ -533,7 +533,7 @@ The current buffer is given by BUFFER."
(if timer-tuple
;; this buffer already has a timer. Cancel it and set the new one
(progn
- (erc-cancel-timer (cdr timer-tuple))
+ (cancel-timer (cdr timer-tuple))
(setf (cdr (assq buffer erc-server-ping-timer-alist)) erc-server-ping-handler))
;; no existing timer for this buffer. Add new one
@@ -731,7 +731,7 @@ Conditionally try to reconnect and take appropriate action."
(erc-with-all-buffers-of-server cproc nil
(setq erc-server-connected nil))
(when erc-server-ping-handler
- (progn (erc-cancel-timer erc-server-ping-handler)
+ (progn (cancel-timer erc-server-ping-handler)
(setq erc-server-ping-handler nil)))
(run-hook-with-args 'erc-disconnected-hook
(erc-current-nick) (system-name) "")
@@ -781,7 +781,7 @@ value of `erc-server-coding-system'."
(pop precedence))
(when precedence
(setq coding (car precedence)))))
- (erc-decode-coding-string str coding)))
+ (decode-coding-string str coding t)))
;; proposed name, not used by anything yet
(defun erc-send-line (text display-fn)
@@ -856,7 +856,7 @@ Additionally, detect whether the IRC process has hung."
;; remove timer if the server buffer has been killed
(let ((timer (assq buf erc-server-ping-timer-alist)))
(when timer
- (erc-cancel-timer (cdr timer))
+ (cancel-timer (cdr timer))
(setcdr timer nil)))))
;; From Circe
@@ -864,41 +864,42 @@ Additionally, detect whether the IRC process has hung."
"Send messages in `erc-server-flood-queue'.
See `erc-server-flood-margin' for an explanation of the flood
protection algorithm."
- (with-current-buffer buffer
- (let ((now (current-time)))
- (when erc-server-flood-timer
- (erc-cancel-timer erc-server-flood-timer)
- (setq erc-server-flood-timer nil))
- (when (time-less-p erc-server-flood-last-message now)
- (setq erc-server-flood-last-message (erc-emacs-time-to-erc-time now)))
- (while (and erc-server-flood-queue
- (time-less-p erc-server-flood-last-message
- (time-add now erc-server-flood-margin)))
- (let ((msg (caar erc-server-flood-queue))
- (encoding (cdar erc-server-flood-queue)))
- (setq erc-server-flood-queue (cdr erc-server-flood-queue)
- erc-server-flood-last-message
- (+ erc-server-flood-last-message
- erc-server-flood-penalty))
- (erc-log-irc-protocol msg 'outbound)
- (erc-log (concat "erc-server-send-queue: "
- msg "(" (buffer-name buffer) ")"))
- (when (erc-server-process-alive)
- (condition-case nil
- ;; Set encoding just before sending the string
- (progn
- (when (fboundp 'set-process-coding-system)
- (set-process-coding-system erc-server-process
- 'raw-text encoding))
- (process-send-string erc-server-process msg))
- ;; Sometimes the send can occur while the process is
- ;; being killed, which results in a weird SIGPIPE error.
- ;; Catch this and ignore it.
- (error nil)))))
- (when erc-server-flood-queue
- (setq erc-server-flood-timer
- (run-at-time (+ 0.2 erc-server-flood-penalty)
- nil #'erc-server-send-queue buffer))))))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (let ((now (current-time)))
+ (when erc-server-flood-timer
+ (cancel-timer erc-server-flood-timer)
+ (setq erc-server-flood-timer nil))
+ (when (time-less-p erc-server-flood-last-message now)
+ (setq erc-server-flood-last-message (erc-emacs-time-to-erc-time now)))
+ (while (and erc-server-flood-queue
+ (time-less-p erc-server-flood-last-message
+ (time-add now erc-server-flood-margin)))
+ (let ((msg (caar erc-server-flood-queue))
+ (encoding (cdar erc-server-flood-queue)))
+ (setq erc-server-flood-queue (cdr erc-server-flood-queue)
+ erc-server-flood-last-message
+ (+ erc-server-flood-last-message
+ erc-server-flood-penalty))
+ (erc-log-irc-protocol msg 'outbound)
+ (erc-log (concat "erc-server-send-queue: "
+ msg "(" (buffer-name buffer) ")"))
+ (when (erc-server-process-alive)
+ (condition-case nil
+ ;; Set encoding just before sending the string
+ (progn
+ (when (fboundp 'set-process-coding-system)
+ (set-process-coding-system erc-server-process
+ 'raw-text encoding))
+ (process-send-string erc-server-process msg))
+ ;; Sometimes the send can occur while the process is
+ ;; being killed, which results in a weird SIGPIPE error.
+ ;; Catch this and ignore it.
+ (error nil)))))
+ (when erc-server-flood-queue
+ (setq erc-server-flood-timer
+ (run-at-time (+ 0.2 erc-server-flood-penalty)
+ nil #'erc-server-send-queue buffer)))))))
(defun erc-message (message-command line &optional force)
"Send LINE to the server as a privmsg or a notice.
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 5e6f7c8d107..b799b2427c6 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -198,12 +198,12 @@ PAR is a number of a regexp grouping whose text will be passed to
:inline t
(integer :tag "Regexp section number")))))
-(defcustom erc-emacswiki-url "http://www.emacswiki.org/cgi-bin/wiki.pl?"
+(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 "http://www.emacswiki.org/elisp/"
+(defcustom erc-emacswiki-lisp-url "https://www.emacswiki.org/elisp/"
"URL of the EmacsWiki ELisp area."
:group 'erc-button
:type 'string)
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index fc45725f789..4afe6a7614b 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -170,11 +170,11 @@ PARSED is an `erc-parsed' response struct."
(string-match "^\\([-\\+]\\)\\(.+\\)$" msg))
(setf (erc-response.contents parsed)
(if erc-capab-identify-mode
- (erc-propertize (match-string 2 msg)
- 'erc-identified
- (if (string= (match-string 1 msg) "+")
- 1
- 0))
+ (propertize (match-string 2 msg)
+ 'erc-identified
+ (if (string= (match-string 1 msg) "+")
+ 1
+ 0))
(match-string 2 msg)))
nil)))
@@ -190,9 +190,9 @@ PARSED is an `erc-parsed' response struct."
;; assuming the first use of `nickname' is the sender's nick
(re-search-forward (regexp-quote nickname) nil t))
(goto-char (match-beginning 0))
- (insert (erc-propertize erc-capab-identify-prefix
- 'font-lock-face
- 'erc-capab-identify-unidentified))))))
+ (insert (propertize erc-capab-identify-prefix
+ 'font-lock-face
+ 'erc-capab-identify-unidentified))))))
(defun erc-capab-identify-get-unidentified-nickname (parsed)
"Return the nickname of the user if unidentified.
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 26701cec1e4..1bce986a806 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -419,15 +419,15 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
(pcomplete-here
(pcase (intern (downcase (pcomplete-arg 1)))
('chat (mapcar (lambda (elt) (plist-get elt :nick))
- (erc-remove-if-not
+ (cl-remove-if-not
#'(lambda (elt)
(eq (plist-get elt :type) 'CHAT))
erc-dcc-list)))
- ('close (erc-delete-dups
+ ('close (delete-dups
(mapcar (lambda (elt) (symbol-name (plist-get elt :type)))
erc-dcc-list)))
('get (mapcar #'erc-dcc-nick
- (erc-remove-if-not
+ (cl-remove-if-not
#'(lambda (elt)
(eq (plist-get elt :type) 'GET))
erc-dcc-list)))
@@ -435,7 +435,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
(pcomplete-here
(pcase (intern (downcase (pcomplete-arg 2)))
('get (mapcar (lambda (elt) (plist-get elt :file))
- (erc-remove-if-not
+ (cl-remove-if-not
#'(lambda (elt)
(and (eq (plist-get elt :type) 'GET)
(erc-nick-equal-p (erc-extract-nick
@@ -443,7 +443,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
(pcomplete-arg 1))))
erc-dcc-list)))
('close (mapcar #'erc-dcc-nick
- (erc-remove-if-not
+ (cl-remove-if-not
#'(lambda (elt)
(eq (plist-get elt :type)
(intern (upcase (pcomplete-arg 1)))))
@@ -516,8 +516,8 @@ PROC is the server process."
(filename (or file (plist-get elt :file) "unknown")))
(if elt
(let* ((file (read-file-name
- (format "Local filename (default %s): "
- (file-name-nondirectory filename))
+ (format-prompt "Local filename"
+ (file-name-nondirectory filename))
(or erc-dcc-get-default-directory
default-directory)
(expand-file-name (file-name-nondirectory filename)
@@ -627,17 +627,17 @@ that subcommand."
?q query ?n nick ?u login ?h host))))
(defconst erc-dcc-ctcp-query-send-regexp
- (concat "^DCC SEND \\("
+ (concat "^DCC SEND \\(?:"
;; Following part matches either filename without spaces
;; or filename enclosed in double quotes with any number
;; of escaped double quotes inside.
- "\"\\(\\(.*?\\(\\\\\"\\)?\\)+?\\)\"\\|\\([^ ]+\\)"
+ "\"\\(\\(?:\\\\\"\\|[^\"\\]\\)+\\)\"\\|\\([^ ]+\\)"
"\\) \\([0-9]+\\) \\([0-9]+\\) *\\([0-9]*\\)"))
(define-inline erc-dcc-unquote-filename (filename)
(inline-quote
- (erc-replace-regexp-in-string "\\\\\\\\" "\\"
- (erc-replace-regexp-in-string "\\\\\"" "\"" ,filename t t) t t)))
+ (replace-regexp-in-string "\\\\\\\\" "\\"
+ (replace-regexp-in-string "\\\\\"" "\"" ,filename t t) t t)))
(defun erc-dcc-handle-ctcp-send (proc query nick login host to)
"This is called if a CTCP DCC SEND subcommand is sent to the client.
@@ -653,11 +653,11 @@ It extracts the information about the dcc request and adds it to
?r "SEND" ?n nick ?u login ?h host))
((string-match erc-dcc-ctcp-query-send-regexp query)
(let ((filename
- (or (match-string 5 query)
- (erc-dcc-unquote-filename (match-string 2 query))))
- (ip (erc-decimal-to-ip (match-string 6 query)))
- (port (match-string 7 query))
- (size (match-string 8 query)))
+ (or (match-string 2 query)
+ (erc-dcc-unquote-filename (match-string 1 query))))
+ (ip (erc-decimal-to-ip (match-string 3 query)))
+ (port (match-string 4 query))
+ (size (match-string 5 query)))
;; FIXME: a warning really should also be sent
;; if the ip address != the host the dcc sender is on.
(erc-display-message
@@ -1193,8 +1193,8 @@ other client."
(setq posn (match-end 0))
(erc-display-message
nil nil proc
- 'dcc-chat-privmsg ?n (erc-propertize erc-dcc-from 'font-lock-face
- 'erc-nick-default-face) ?m line))
+ 'dcc-chat-privmsg ?n (propertize erc-dcc-from 'font-lock-face
+ 'erc-nick-default-face) ?m line))
(setq erc-dcc-unprocessed-output (substring str posn)))))
(defun erc-dcc-chat-buffer-killed ()
diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el
index 1e65f8f4275..3a9a4a4bac6 100644
--- a/lisp/erc/erc-desktop-notifications.el
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -31,6 +31,7 @@
(require 'erc)
(require 'xml)
(require 'notifications)
+(require 'erc-goodies)
(require 'erc-match)
(require 'dbus)
@@ -62,12 +63,12 @@ This will replace the last notification sent with this function."
;; setting the current buffer to the existing query buffer)
(dbus-ignore-errors
(setq erc-notifications-last-notification
- (let ((channel (if privp (erc-get-buffer nick) (current-buffer))))
+ (let* ((channel (if privp (erc-get-buffer nick) (current-buffer)))
+ (title (format "%s in %s" (xml-escape-string nick t) channel))
+ (body (xml-escape-string (erc-controls-strip msg) t)))
(notifications-notify :bus erc-notifications-bus
- :title (format "%s in %s"
- (xml-escape-string nick)
- channel)
- :body (xml-escape-string msg)
+ :title title
+ :body body
:replaces-id erc-notifications-last-notification
:app-icon erc-notifications-icon
:actions '("default" "Switch to buffer")
diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el
index 1032af7a304..5c2faff96de 100644
--- a/lisp/erc/erc-ezbounce.el
+++ b/lisp/erc/erc-ezbounce.el
@@ -34,7 +34,7 @@
(defcustom erc-ezb-regexp "^ezbounce!srv$"
"Regexp used by the EZBouncer to identify itself to the user."
:group 'erc-ezbounce
- :type 'string)
+ :type 'regexp)
(defcustom erc-ezb-login-alist '()
"Alist of logins suitable for the server we're connecting to.
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 39a8be5e0cf..d09caf7aa12 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -38,7 +38,7 @@
:group 'erc)
;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t)
-(erc-define-minor-mode erc-fill-mode
+(define-minor-mode erc-fill-mode
"Toggle ERC fill mode.
With a prefix argument ARG, enable ERC fill mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 94d5de280c6..a475f0a1770 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -232,6 +232,10 @@ The value `erc-interpret-controls-p' must also be t for this to work."
"ERC bold face."
:group 'erc-faces)
+(defface erc-italic-face '((t :slant italic))
+ "ERC italic face."
+ :group 'erc-faces)
+
(defface erc-inverse-face
'((t :foreground "White" :background "Black"))
"ERC inverse face."
@@ -383,6 +387,7 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options."
(erc-controls-strip s))
(erc-interpret-controls-p
(let ((boldp nil)
+ (italicp nil)
(inversep nil)
(underlinep nil)
(fg nil)
@@ -394,13 +399,14 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options."
(start (match-beginning 0))
(end (+ (match-beginning 0)
(length (match-string 5 s)))))
- (setq s (erc-replace-match-subexpression-in-string
- "" s control 1 start))
+ (setq s (replace-match "" nil nil s 1))
(cond ((and erc-interpret-mirc-color (or fg-color bg-color))
(setq fg fg-color)
(setq bg bg-color))
((string= control "\C-b")
(setq boldp (not boldp)))
+ ((string= control "\C-]")
+ (setq italicp (not italicp)))
((string= control "\C-v")
(setq inversep (not inversep)))
((string= control "\C-_")
@@ -413,13 +419,14 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options."
(ding)))
((string= control "\C-o")
(setq boldp nil
+ italicp nil
inversep nil
underlinep nil
fg nil
bg nil))
(t nil))
(erc-controls-propertize
- start end boldp inversep underlinep fg bg s)))
+ start end boldp italicp inversep underlinep fg bg s)))
s))
(t s)))))
@@ -432,13 +439,13 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options."
s)))
(defvar erc-controls-remove-regexp
- "\C-b\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?"
+ "\C-b\\|\C-]\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?"
"Regular expression which matches control characters to remove.")
(defvar erc-controls-highlight-regexp
- (concat "\\(\C-b\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|"
+ (concat "\\(\C-b\\|\C-]\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|"
"\C-c\\([0-9][0-9]?\\)?\\(,\\([0-9][0-9]?\\)\\)?\\)"
- "\\([^\C-b\C-v\C-_\C-c\C-g\C-o\n]*\\)")
+ "\\([^\C-b\C-]\C-v\C-_\C-c\C-g\C-o\n]*\\)")
"Regular expression which matches control chars and the text to highlight.")
(defun erc-controls-highlight ()
@@ -451,6 +458,7 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'."
(replace-match "")))
(erc-interpret-controls-p
(let ((boldp nil)
+ (italicp nil)
(inversep nil)
(underlinep nil)
(fg nil)
@@ -467,6 +475,8 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'."
(setq bg bg-color))
((string= control "\C-b")
(setq boldp (not boldp)))
+ ((string= control "\C-]")
+ (setq italicp (not italicp)))
((string= control "\C-v")
(setq inversep (not inversep)))
((string= control "\C-_")
@@ -479,16 +489,17 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'."
(ding)))
((string= control "\C-o")
(setq boldp nil
+ italicp nil
inversep nil
underlinep nil
fg nil
bg nil))
(t nil))
(erc-controls-propertize start end
- boldp inversep underlinep fg bg)))))
+ boldp italicp inversep underlinep fg bg)))))
(t nil)))
-(defun erc-controls-propertize (from to boldp inversep underlinep fg bg
+(defun erc-controls-propertize (from to boldp italicp inversep underlinep fg bg
&optional str)
"Prepend properties from IRC control characters between FROM and TO.
If optional argument STR is provided, apply to STR, otherwise prepend properties
@@ -500,6 +511,9 @@ to a region in the current buffer."
(append (if boldp
'(erc-bold-face)
nil)
+ (if italicp
+ '(erc-italic-face)
+ nil)
(if inversep
'(erc-inverse-face)
nil)
diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el
index 280d6bfe0f1..79c111082f6 100644
--- a/lisp/erc/erc-join.el
+++ b/lisp/erc/erc-join.el
@@ -113,7 +113,7 @@ servers, presumably in the same domain."
This is called from a timer set up by `erc-autojoin-channels'."
(if erc--autojoin-timer
(setq erc--autojoin-timer
- (erc-cancel-timer erc--autojoin-timer)))
+ (cancel-timer erc--autojoin-timer)))
(with-current-buffer buffer
;; Don't kick of another delayed autojoin or try to wait for
;; another ident response:
@@ -127,7 +127,7 @@ This is called from a timer set up by `erc-autojoin-channels'."
This function is run from `erc-nickserv-identified-hook'."
(if erc--autojoin-timer
(setq erc--autojoin-timer
- (erc-cancel-timer erc--autojoin-timer)))
+ (cancel-timer erc--autojoin-timer)))
(when (eq erc-autojoin-timing 'ident)
(let ((server (or erc-session-server erc-server-announced-name))
(joined (mapcar (lambda (buf)
@@ -153,18 +153,20 @@ This function is run from `erc-nickserv-identified-hook'."
'erc-autojoin-channels-delayed
server nick (current-buffer))))
;; `erc-autojoin-timing' is `connect':
- (dolist (l erc-autojoin-channels-alist)
- (when (string-match (car l) server)
- (let ((server (or erc-session-server erc-server-announced-name)))
+ (let ((server (or erc-session-server erc-server-announced-name)))
+ (dolist (l erc-autojoin-channels-alist)
+ (when (string-match-p (car l) server)
(dolist (chan (cdr l))
- (let ((buffer (erc-get-buffer chan)))
- ;; Only auto-join the channels that we aren't already in
- ;; using a different nick.
+ (let ((buffer
+ (car (erc-buffer-filter
+ (lambda ()
+ (let ((current (erc-default-target)))
+ (and (stringp current)
+ (string-match-p (car l)
+ (or erc-session-server erc-server-announced-name))
+ (string-equal (erc-downcase chan)
+ (erc-downcase current)))))))))
(when (or (not buffer)
- ;; If the same channel is joined on another
- ;; server the best-effort is to just join
- (not (string-match (car l)
- (process-name erc-server-process)))
(not (with-current-buffer buffer
(erc-server-process-alive))))
(erc-server-join-channel server chan))))))))
diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el
index 5faeabb721a..036d7733ed7 100644
--- a/lisp/erc/erc-list.el
+++ b/lisp/erc/erc-list.el
@@ -71,13 +71,13 @@
(defun erc-list-make-string (channel users topic)
(concat
channel
- (erc-propertize " "
- 'display (list 'space :align-to erc-list-nusers-column)
- 'face 'fixed-pitch)
+ (propertize " "
+ 'display (list 'space :align-to erc-list-nusers-column)
+ 'face 'fixed-pitch)
users
- (erc-propertize " "
- 'display (list 'space :align-to erc-list-topic-column)
- 'face 'fixed-pitch)
+ (propertize " "
+ 'display (list 'space :align-to erc-list-topic-column)
+ 'face 'fixed-pitch)
topic))
;; Insert a record into the list buffer.
@@ -143,19 +143,19 @@
;; Helper function that makes a buttonized column header.
(defun erc-list-button (title column)
- (erc-propertize title
- 'column-number column
- 'help-echo "mouse-1: sort by column"
- 'mouse-face 'header-line-highlight
- 'keymap erc-list-menu-sort-button-map))
+ (propertize title
+ 'column-number column
+ 'help-echo "mouse-1: sort by column"
+ 'mouse-face 'header-line-highlight
+ 'keymap erc-list-menu-sort-button-map))
(define-derived-mode erc-list-menu-mode special-mode "ERC-List"
"Major mode for editing a list of irc channels."
(setq header-line-format
(concat
- (erc-propertize " "
- 'display '(space :align-to 0)
- 'face 'fixed-pitch)
+ (propertize " "
+ 'display '(space :align-to 0)
+ 'face 'fixed-pitch)
(erc-list-make-string (erc-list-button "Channel" 1)
(erc-list-button "# Users" 2)
"Topic")))
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index 1bad6d16c87..2166123e674 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -267,7 +267,7 @@ The current buffer is given by BUFFER."
(with-current-buffer buffer
(auto-save-mode -1)
(setq buffer-file-name nil)
- (erc-set-write-file-functions '(erc-save-buffer-in-logs))
+ (set (make-local-variable 'write-file-functions) '(erc-save-buffer-in-logs))
(when erc-log-insert-log-on-open
(ignore-errors
(save-excursion
@@ -334,7 +334,7 @@ This will not work with full paths, only names.
Any unsafe characters in the name are replaced with \"!\". The
filename is downcased."
- (downcase (erc-replace-regexp-in-string
+ (downcase (replace-regexp-in-string
"[/\\]" "!" (convert-standard-filename filename))))
(defun erc-current-logfile (&optional buffer)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 3107ff2ccd1..b3145674f29 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -94,7 +94,9 @@ The following values are allowed:
`nick-or-keyword' - highlight the nick of the user who typed your nickname,
or all instances of the current nickname if there was
no sending user
- `all' - highlight the entire message where current nickname occurs
+ `message' - highlight the entire message where current nickname occurs
+ `all' - highlight the entire message (including the nick) where
+ current nickname occurs
Any other value disables highlighting of current nickname altogether."
:group 'erc-match
@@ -102,6 +104,7 @@ Any other value disables highlighting of current nickname altogether."
(const nick)
(const keyword)
(const nick-or-keyword)
+ (const message)
(const all)))
(defcustom erc-pal-highlight-type 'nick
@@ -110,14 +113,17 @@ See `erc-pals'.
The following values are allowed:
- nil - do not highlight the message at all
- `nick' - highlight pal's nickname only
- `all' - highlight the entire message from pal
+ nil - do not highlight the message at all
+ `nick' - highlight pal's nickname only
+ `message' - highlight the entire message from pal
+ `all' - highlight the entire message (including the nick)
+ from pal
Any other value disables pal highlighting altogether."
:group 'erc-match
:type '(choice (const nil)
(const nick)
+ (const message)
(const all)))
(defcustom erc-fool-highlight-type 'nick
@@ -126,14 +132,17 @@ See `erc-fools'.
The following values are allowed:
- nil - do not highlight the message at all
- `nick' - highlight fool's nickname only
- `all' - highlight the entire message from fool
+ nil - do not highlight the message at all
+ `nick' - highlight fool's nickname only
+ `message' - highlight the entire message from fool
+ `all' - highlight the entire message (including the nick)
+ from fool
Any other value disables fool highlighting altogether."
:group 'erc-match
:type '(choice (const nil)
(const nick)
+ (const message)
(const all)))
(defcustom erc-keyword-highlight-type 'keyword
@@ -143,12 +152,15 @@ See variable `erc-keywords'.
The following values are allowed:
`keyword' - highlight keyword only
- `all' - highlight the entire message containing keyword
+ `message' - highlight the entire message containing keyword
+ `all' - highlight the entire message (including the nick)
+ containing keyword
Any other value disables keyword highlighting altogether."
:group 'erc-match
:type '(choice (const nil)
(const keyword)
+ (const message)
(const all)))
(defcustom erc-dangerous-host-highlight-type 'nick
@@ -157,13 +169,16 @@ See `erc-dangerous-hosts'.
The following values are allowed:
- `nick' - highlight nick from dangerous-host only
- `all' - highlight the entire message from dangerous-host
+ `nick' - highlight nick from dangerous-host only
+ `message' - highlight the entire message from dangerous-host
+ `all' - highlight the entire message (including the nick)
+ from dangerous-host
Any other value disables dangerous-host highlighting altogether."
:group 'erc-match
:type '(choice (const nil)
(const nick)
+ (const message)
(const all)))
@@ -449,19 +464,18 @@ Use this defun with `erc-insert-modify-hook'."
(match-beginning 0)))
(nick-end (when nick-beg
(match-end 0)))
- (message (buffer-substring
- (if (and nick-end
- (<= (+ 2 nick-end) (point-max)))
- ;; Message starts 2 characters after the nick
- ;; except for CTCP ACTION messages. Nick
- ;; surrounded by angle brackets only in normal
- ;; messages.
- (+ nick-end
- (if (eq ?> (char-after nick-end))
- 2
- 1))
- (point-min))
- (point-max))))
+ (message-beg (if (and nick-end
+ (<= (+ 2 nick-end) (point-max)))
+ ;; Message starts 2 characters after the
+ ;; nick except for CTCP ACTION messages.
+ ;; Nick surrounded by angle brackets only in
+ ;; normal messages.
+ (+ nick-end
+ (if (eq ?> (char-after nick-end))
+ 2
+ 1))
+ (point-min)))
+ (message (buffer-substring message-beg (point-max))))
(when (and vector
(not (and erc-match-exclude-server-buffer
(erc-server-buffer-p))))
@@ -498,7 +512,12 @@ Use this defun with `erc-insert-modify-hook'."
(while (re-search-forward match-regex nil t)
(erc-put-text-property (match-beginning 0) (match-end 0)
'font-lock-face match-face))))
- ;; Highlight the whole message
+ ;; Highlight the whole message (not including the nick)
+ ((eq match-htype 'message)
+ (erc-put-text-property
+ message-beg (point-max)
+ 'font-lock-face match-face (current-buffer)))
+ ;; Highlight the whole message (including the nick)
((eq match-htype 'all)
(erc-put-text-property
(point-min) (point-max)
@@ -555,16 +574,15 @@ See `erc-log-match-format'."
(and (eq erc-log-matches-flag 'away)
(erc-away-time)))
match-buffer-name)
- (let ((line (format-spec erc-log-match-format
- (format-spec-make
- ?n nick
- ?t (format-time-string
- (or (and (boundp 'erc-timestamp-format)
- erc-timestamp-format)
- "[%Y-%m-%d %H:%M] "))
- ?c (or (erc-default-target) "")
- ?m message
- ?u nickuserhost))))
+ (let ((line (format-spec
+ erc-log-match-format
+ `((?n . ,nick)
+ (?t . ,(format-time-string
+ (or (bound-and-true-p erc-timestamp-format)
+ "[%Y-%m-%d %H:%M] ")))
+ (?c . ,(or (erc-default-target) ""))
+ (?m . ,message)
+ (?u . ,nickuserhost)))))
(with-current-buffer (erc-log-matches-make-buffer match-buffer-name)
(let ((inhibit-read-only t))
(goto-char (point-max))
@@ -578,9 +596,9 @@ See `erc-log-match-format'."
(with-current-buffer buffer
(unless buffer-already
(insert " == Type \"q\" to dismiss messages ==\n")
- (erc-view-mode-enter nil (lambda (buffer)
- (when (y-or-n-p "Discard messages? ")
- (kill-buffer buffer)))))
+ (view-mode-enter nil (lambda (buffer)
+ (when (y-or-n-p "Discard messages? ")
+ (kill-buffer buffer)))))
buffer)))
(defun erc-log-matches-come-back (proc parsed)
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 1234962c51c..309a78865df 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -152,7 +152,7 @@
("EFnet: EU, PL, Warszawa" EFnet "irc.efnet.pl" 6667)
("EFnet: EU, RU, Moscow" EFnet "irc.rt.ru" ((6661 6669)))
("EFnet: EU, SE, Dalarna" EFnet "irc.du.se" ((6666 6669)))
- ("EFnet: EU, SE, Gothenberg" EFnet "irc.hemmet.chalmers.se" ((6666 7000)))
+ ("EFnet: EU, SE, Gothenburg" EFnet "irc.hemmet.chalmers.se" ((6666 7000)))
("EFnet: EU, SE, Sweden" EFnet "irc.light.se" 6667)
("EFnet: EU, UK, London (carrier)" EFnet "irc.carrier1.net.uk" ((6666 6669)))
("EFnet: EU, UK, London (demon)" EFnet "efnet.demon.co.uk" ((6665 6669)))
@@ -756,8 +756,8 @@ Return the name of this server's network as a symbol."
(erc-with-server-buffer
(intern (downcase (symbol-name erc-network)))))
-(erc-make-obsolete 'erc-current-network 'erc-network
- "Obsolete since erc-networks 1.5")
+(make-obsolete 'erc-current-network 'erc-network
+ "Obsolete since erc-networks 1.5")
(defun erc-network-name ()
"Return the name of the current network as a string."
@@ -812,7 +812,7 @@ As an example:
(let* ((completion-ignore-case t)
(net (intern
(completing-read "Network: "
- (erc-delete-dups
+ (delete-dups
(mapcar (lambda (x)
(list (symbol-name (nth 1 x))))
erc-server-alist)))))
diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el
index 1b092c8a6a9..144a981f832 100644
--- a/lisp/erc/erc-notify.el
+++ b/lisp/erc/erc-notify.el
@@ -181,7 +181,7 @@ nick from `erc-last-ison' to prevent any further notifications."
(let ((nick (erc-extract-nick (erc-response.sender parsed))))
(when (and (erc-member-ignore-case nick erc-notify-list)
(erc-member-ignore-case nick erc-last-ison))
- (setq erc-last-ison (erc-delete-if
+ (setq erc-last-ison (cl-delete-if
(let ((nick-down (erc-downcase nick)))
(lambda (el)
(string= nick-down (erc-downcase el))))
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index 7643fa85b96..f8b7e13be02 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -41,7 +41,6 @@
(require 'pcomplete)
(require 'erc)
-(require 'erc-compat)
(require 'time-date)
(defgroup erc-pcomplete nil
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index 5a469aa4e4e..b64e42b7ee4 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -90,9 +90,8 @@ nil - Do not sort users"
"Additional menu-items to add to speedbar frame.")
;; Make sure our special speedbar major mode is loaded
-(if (featurep 'speedbar)
- (erc-install-speedbar-variables)
- (add-hook 'speedbar-load-hook 'erc-install-speedbar-variables))
+(with-eval-after-load 'speedbar
+ (erc-install-speedbar-variables))
;;; ERC hierarchy display method
;;;###autoload
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index cbab2f9da2b..08970f2d70e 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -35,7 +35,6 @@
;;; Code:
(require 'erc)
-(require 'erc-compat)
(defgroup erc-stamp nil
"For long conversation on IRC it is sometimes quite
diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el
new file mode 100644
index 00000000000..08dc8d6015f
--- /dev/null
+++ b/lisp/erc/erc-status-sidebar.el
@@ -0,0 +1,309 @@
+;;; erc-status-sidebar.el --- HexChat-like activity overview for ERC
+
+;; Copyright (C) 2017, 2020 Free Software Foundation, Inc.
+
+;; Author: Andrew Barbarello
+;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; URL: https://github.com/drewbarbs/erc-status-sidebar
+
+;; 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 package provides a HexChat-like sidebar for joined channels in
+;; ERC. It relies on the `erc-track' module, and displays all of the
+;; same information that `erc-track' does in the mode line, but in an
+;; alternative format in form of a sidebar.
+
+;; Shout out to sidebar.el <https://github.com/sebastiencs/sidebar.el>
+;; and outline-toc.el <https://github.com/abingham/outline-toc.el> for
+;; the sidebar window management ideas.
+
+;; Usage:
+
+;; Use M-x erc-status-sidebar-open RET to open the ERC status sidebar
+;; in the current frame. Make sure that the `erc-track' module is
+;; active (this is the default).
+
+;; Use M-x erc-status-sidebar-close RET to close the sidebar on the
+;; current frame. With a prefix argument, it closes the sidebar on
+;; all frames.
+
+;; Use M-x erc-status-sidebar-kill RET to kill the sidebar buffer and
+;; close the sidebar on all frames.
+
+;;; Code:
+
+(require 'erc)
+(require 'erc-track)
+(require 'fringe)
+(require 'seq)
+
+(defgroup erc-status-sidebar nil
+ "A sidebar for ERC channel status."
+ :group 'convenience)
+
+(defcustom erc-status-sidebar-buffer-name "*ERC Status*"
+ "Name of the sidebar buffer."
+ :type 'string
+ :group 'erc-status-sidebar)
+
+(defcustom erc-status-sidebar-mode-line-format "ERC Status"
+ "Mode line format for the status sidebar."
+ :type 'string
+ :group 'erc-status-sidebar)
+
+(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)
+
+(defcustom erc-status-sidebar-width 15
+ "Default width of the sidebar (in columns)."
+ :type 'number
+ :group 'erc-status-sidebar)
+
+(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)
+
+(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)
+
+(defun erc-status-sidebar-display-window ()
+ "Display the status buffer in a side window. Return the new window."
+ (display-buffer
+ (erc-status-sidebar-get-buffer)
+ `(display-buffer-in-side-window . ((side . left)
+ (window-width . ,erc-status-sidebar-width)))))
+
+(defun erc-status-sidebar-get-window (&optional no-creation)
+ "Return the created/existing window displaying the status buffer.
+
+If NO-CREATION is non-nil, the window is not created."
+ (let ((sidebar-window (get-buffer-window erc-status-sidebar-buffer-name)))
+ (unless (or sidebar-window no-creation)
+ (with-current-buffer (erc-status-sidebar-get-buffer)
+ (setq-local vertical-scroll-bar nil))
+ (setq sidebar-window (erc-status-sidebar-display-window))
+ (set-window-dedicated-p sidebar-window t)
+ (set-window-parameter sidebar-window 'no-delete-other-windows t)
+ ;; Don't cycle to this window with `other-window'.
+ (set-window-parameter sidebar-window 'no-other-window t)
+ (internal-show-cursor sidebar-window nil)
+ (set-window-fringes sidebar-window 0 0)
+ ;; Set a custom display table so the window doesn't show a
+ ;; truncation symbol when a channel name is too big.
+ (let ((dt (make-display-table)))
+ (set-window-display-table sidebar-window dt)
+ (set-display-table-slot dt 'truncation ?\ )))
+ sidebar-window))
+
+(defun erc-status-sidebar-buffer-exists-p ()
+ "Check if the sidebar buffer exists."
+ (get-buffer erc-status-sidebar-buffer-name))
+
+(defun erc-status-sidebar-get-buffer ()
+ "Return the sidebar buffer, creating it if it doesn't exist."
+ (get-buffer-create erc-status-sidebar-buffer-name))
+
+(defun erc-status-sidebar-close (&optional all-frames)
+ "Close the sidebar.
+
+If called with prefix argument (ALL-FRAMES non-nil), the sidebar
+will be closed on all frames.
+
+The erc-status-sidebar buffer is left alone, but the window
+containing it on the current frame is closed. See
+`erc-status-sidebar-kill'."
+ (interactive "P")
+ (mapcar #'delete-window
+ (get-buffer-window-list (erc-status-sidebar-get-buffer)
+ nil (if all-frames t))))
+
+(defmacro erc-status-sidebar-writable (&rest body)
+ "Make the status buffer writable while executing BODY."
+ `(let ((buffer-read-only nil))
+ ,@body))
+
+;;;###autoload
+(defun erc-status-sidebar-open ()
+ "Open or create a sidebar."
+ (interactive)
+ (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)))
+ (unless sidebar-exists
+ (with-current-buffer sidebar-buffer
+ (erc-status-sidebar-mode)
+ (erc-status-sidebar-refresh))))))
+
+;;;###autoload
+(defun erc-status-sidebar-toggle ()
+ "Toggle the sidebar open/closed on the current frame."
+ (interactive)
+ (if (get-buffer-window erc-status-sidebar-buffer-name nil)
+ (erc-status-sidebar-close)
+ (erc-status-sidebar-open)))
+
+(defun erc-status-sidebar-get-channame (buffer)
+ "Return name of BUFFER with all leading \"#\" characters removed."
+ (let ((s (buffer-name buffer)))
+ (if (string-match "^#\\{1,2\\}" s)
+ (setq s (replace-match "" t t s)))
+ (downcase s)))
+
+(defun erc-status-sidebar-default-chansort (chanlist)
+ "Sort CHANLIST case-insensitively for display in the sidebar."
+ (sort chanlist (lambda (x y)
+ (string< (erc-status-sidebar-get-channame x)
+ (erc-status-sidebar-get-channame y)))))
+
+(defun erc-status-sidebar-default-chan-format (channame
+ &optional num-messages erc-face)
+ "Format CHANNAME for display in the sidebar.
+
+If NUM-MESSAGES is non-nil, append it to the channel name. If
+ERC-FACE is non-nil, apply it to channel name. If it is equal to
+`erc-default-face', also apply bold property to make the channel
+name stand out."
+ (when num-messages
+ (setq channame (format "%s [%d]" channame num-messages)))
+ (when erc-face
+ (put-text-property 0 (length channame) 'face erc-face channame)
+ (when (eq erc-face 'erc-default-face)
+ (add-face-text-property 0 (length channame) 'bold t channame)))
+ channame)
+
+(defun erc-status-sidebar-refresh ()
+ "Update the content of the sidebar."
+ (interactive)
+ (let ((chanlist (apply erc-status-sidebar-channel-sort
+ (erc-channel-list nil) nil)))
+ (with-current-buffer (erc-status-sidebar-get-buffer)
+ (erc-status-sidebar-writable
+ (delete-region (point-min) (point-max))
+ (goto-char (point-min))
+ (dolist (chanbuf chanlist)
+ (let* ((tup (seq-find (lambda (tup) (eq (car tup) chanbuf))
+ erc-modified-channels-alist))
+ (count (if tup (cadr tup)))
+ (face (if tup (cddr tup)))
+ (channame (apply erc-status-sidebar-channel-format
+ (buffer-name chanbuf) count face nil))
+ (cnlen (length channame)))
+ (put-text-property 0 cnlen 'erc-buf chanbuf channame)
+ (put-text-property 0 cnlen 'mouse-face 'highlight channame)
+ (put-text-property
+ 0 cnlen 'help-echo
+ "mouse-1: switch to buffer in other window" channame)
+ (insert channame "\n")))))))
+
+(defun erc-status-sidebar-kill ()
+ "Close the ERC status sidebar and its buffer."
+ (interactive)
+ (ignore-errors (kill-buffer erc-status-sidebar-buffer-name)))
+
+(defun erc-status-sidebar-click (event)
+ "Handle click EVENT in `erc-status-sidebar-mode-map'."
+ (interactive "e")
+ (save-excursion
+ (let ((window (posn-window (event-end event)))
+ (pos (posn-point (event-end event))))
+ (set-buffer (window-buffer window))
+ (let ((buf (get-text-property pos 'erc-buf)))
+ (when buf
+ (select-window window)
+ (switch-to-buffer-other-window buf))))))
+
+(defvar erc-status-sidebar-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map special-mode-map)
+ (define-key map [mouse-1] #'erc-status-sidebar-click)
+ map))
+
+(defvar erc-status-sidebar-refresh-triggers
+ '(erc-track-list-changed-hook
+ erc-join-hook
+ erc-part-hook
+ erc-kill-buffer-hook
+ erc-kill-channel-hook
+ erc-kill-server-hook
+ erc-kick-hook
+ erc-disconnected-hook
+ erc-quit-hook))
+
+(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
+hooks that invoke it with arguments."
+ (run-at-time 0 nil #'erc-status-sidebar-refresh))
+
+(defun erc-status-sidebar-mode--unhook ()
+ "Remove hooks installed by `erc-status-sidebar-mode'."
+ (dolist (hk erc-status-sidebar-refresh-triggers)
+ (remove-hook hk #'erc-status-sidebar--post-refresh))
+ (remove-hook 'window-configuration-change-hook
+ #'erc-status-sidebar-set-window-preserve-size))
+
+(defun erc-status-sidebar-set-window-preserve-size ()
+ "Tell Emacs to preserve the current height/width of the ERC sidebar window.
+
+Note that preserve status needs to be reset when the window is
+manually resized, so `erc-status-sidebar-mode' adds this function
+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))))
+
+(define-derived-mode erc-status-sidebar-mode special-mode "ERC Sidebar"
+ "Major mode for ERC status sidebar"
+ ;; Don't scroll the buffer horizontally, if a channel name is
+ ;; obscured then the window can be resized.
+ (setq-local auto-hscroll-mode nil)
+ (setq cursor-type nil
+ buffer-read-only t
+ mode-line-format erc-status-sidebar-mode-line-format
+ header-line-format erc-status-sidebar-header-line-format)
+ (erc-status-sidebar-set-window-preserve-size)
+
+ (add-hook 'window-configuration-change-hook
+ #'erc-status-sidebar-set-window-preserve-size nil t)
+ (dolist (hk erc-status-sidebar-refresh-triggers)
+ (add-hook hk #'erc-status-sidebar--post-refresh))
+
+ ;; `change-major-mode-hook' is run *before* the
+ ;; 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)
+
+(provide 'erc-status-sidebar)
+;;; erc-status-sidebar.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
+;; End:
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 490b2937771..60f0cfa942f 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -36,7 +36,6 @@
(eval-when-compile (require 'cl-lib))
(require 'erc)
-(require 'erc-compat)
(require 'erc-match)
;;; Code:
@@ -329,9 +328,8 @@ important."
(defun erc-track-remove-from-mode-line ()
"Remove `erc-track-modified-channels' from the mode-line."
- (when (boundp 'mode-line-modes)
- (setq mode-line-modes
- (remove '(t erc-modified-channels-object) mode-line-modes)))
+ (setq mode-line-modes
+ (remove '(t erc-modified-channels-object) mode-line-modes))
(when (consp global-mode-string)
(setq global-mode-string
(delq 'erc-modified-channels-object global-mode-string))))
@@ -341,12 +339,10 @@ important."
See `erc-track-position-in-mode-line' for possible values."
;; CVS Emacs has a new format string, and global-mode-string
;; is very far to the right.
- (cond ((and (eq position 'before-modes)
- (boundp 'mode-line-modes))
+ (cond ((eq position 'before-modes)
(add-to-list 'mode-line-modes
'(t erc-modified-channels-object)))
- ((and (eq position 'after-modes)
- (boundp 'mode-line-modes))
+ ((eq position 'after-modes)
(add-to-list 'mode-line-modes
'(t erc-modified-channels-object) t))
((eq position t)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 3033122437a..1d5506e2816 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -57,12 +57,14 @@
(load "erc-loaddefs" nil t)
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
(require 'font-lock)
+(require 'format-spec)
(require 'pp)
(require 'thingatpt)
(require 'auth-source)
-(require 'erc-compat)
+(require 'time-date)
+(require 'iso8601)
(eval-when-compile (require 'subr-x))
(defvar erc-official-location
@@ -875,8 +877,8 @@ See `erc-server-flood-margin' for other flood-related parameters.")
;; Script parameters
(defcustom erc-startup-file-list
- (list (concat erc-user-emacs-directory ".ercrc.el")
- (concat erc-user-emacs-directory ".ercrc")
+ (list (concat user-emacs-directory ".ercrc.el")
+ (concat user-emacs-directory ".ercrc")
"~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc")
"List of files to try for a startup script.
The first existent and readable one will get executed.
@@ -1212,7 +1214,7 @@ which the local user typed."
:group 'erc-faces)
(defface erc-header-line
- '((t :foreground "grey20" :background "grey90"))
+ '((t :inherit header-line))
"ERC face used for the header line.
This will only be used if `erc-header-line-face-method' is non-nil."
@@ -1304,7 +1306,7 @@ Example:
(enable (intern (format "erc-%s-enable" (downcase sn))))
(disable (intern (format "erc-%s-disable" (downcase sn)))))
`(progn
- (erc-define-minor-mode
+ (define-minor-mode
,mode
,(format "Toggle ERC %S mode.
With a prefix argument ARG, enable %s if ARG is positive,
@@ -1487,8 +1489,7 @@ Defaults to the server buffer."
(define-derived-mode erc-mode fundamental-mode "ERC"
"Major mode for Emacs IRC."
(setq local-abbrev-table erc-mode-abbrev-table)
- (when (boundp 'next-line-add-newlines)
- (set (make-local-variable 'next-line-add-newlines) nil))
+ (set (make-local-variable 'next-line-add-newlines) nil)
(setq line-move-ignore-invisible t)
(set (make-local-variable 'paragraph-separate)
(concat "\C-l\\|\\(^" (regexp-quote (erc-prompt)) "\\)"))
@@ -1606,33 +1607,47 @@ symbol, it may have these values:
(defun erc-generate-new-buffer-name (server port target)
"Create a new buffer name based on the arguments."
(when (numberp port) (setq port (number-to-string port)))
- (let ((buf-name (or target
- (or (let ((name (concat server ":" port)))
- (when (> (length name) 1)
- name))
- ;; This fallback should in fact never happen
- "*erc-server-buffer*")))
- buffer-name)
+ (let* ((buf-name (or target
+ (let ((name (concat server ":" port)))
+ (when (> (length name) 1)
+ name))
+ ;; This fallback should in fact never happen.
+ "*erc-server-buffer*"))
+ (full-buf-name (concat buf-name "/" server))
+ (dup-buf-name (buffer-name (car (erc-channel-list nil))))
+ buffer-name)
;; Reuse existing buffers, but not if the buffer is a connected server
;; buffer and not if its associated with a different server than the
;; current ERC buffer.
- ;; if buf-name is taken by a different connection (or by something !erc)
- ;; then see if "buf-name/server" meets the same criteria
- (dolist (candidate (list buf-name (concat buf-name "/" server)))
- (if (and (not buffer-name)
- erc-reuse-buffers
- (or (not (get-buffer candidate))
- (or target
- (with-current-buffer (get-buffer candidate)
- (and (erc-server-buffer-p)
- (not (erc-server-process-alive)))))
- (with-current-buffer (get-buffer candidate)
- (and (string= erc-session-server server)
- (erc-port-equal erc-session-port port)))))
- (setq buffer-name candidate)))
- ;; if buffer-name is unset, neither candidate worked out for us,
+ ;; If buf-name is taken by a different connection (or by something !erc)
+ ;; then see if "buf-name/server" meets the same criteria.
+ (if (and dup-buf-name (string-match-p (concat buf-name "/") dup-buf-name))
+ (setq buffer-name full-buf-name) ; ERC buffer with full name already exists.
+ (dolist (candidate (list buf-name full-buf-name))
+ (if (and (not buffer-name)
+ erc-reuse-buffers
+ (or (not (get-buffer candidate))
+ ;; Looking for a server buffer, so there's no target.
+ (and (not target)
+ (with-current-buffer (get-buffer candidate)
+ (and (erc-server-buffer-p)
+ (not (erc-server-process-alive)))))
+ ;; Channel buffer; check that it's from the right server.
+ (and target
+ (with-current-buffer (get-buffer candidate)
+ (and (string= erc-session-server server)
+ (erc-port-equal erc-session-port port))))))
+ (setq buffer-name candidate)
+ (when (and (not buffer-name) (get-buffer buf-name) erc-reuse-buffers)
+ ;; A new buffer will be created with the name buf-name/server, rename
+ ;; the existing name-duplicated buffer with the same format as well.
+ (with-current-buffer (get-buffer buf-name)
+ (when (derived-mode-p 'erc-mode) ; ensure it's an erc buffer
+ (rename-buffer
+ (concat buf-name "/" (or erc-session-server erc-server-announced-name)))))))))
+ ;; If buffer-name is unset, neither candidate worked out for us,
;; fallback to the old <N> uniquification method:
- (or buffer-name (generate-new-buffer-name (concat buf-name "/" server)))))
+ (or buffer-name (generate-new-buffer-name full-buf-name))))
(defun erc-get-buffer-create (server port target)
"Create a new buffer based on the arguments."
@@ -1858,7 +1873,7 @@ buffer rather than a server buffer.")
;; modify `transforms' to specify what needs to be changed
;; each item is in the format '(old . new)
(let ((transforms '((pcomplete . completion))))
- (erc-delete-dups
+ (delete-dups
(mapcar (lambda (m) (or (cdr (assoc m transforms)) m))
mods))))
@@ -2311,7 +2326,7 @@ and appears in face `erc-input-face' in the buffer."
(setq result (concat result network-name
" << " line "\n")))
result)
- (erc-propertize
+ (propertize
(concat network-name " >> " string
(if (/= ?\n
(aref string
@@ -2334,7 +2349,7 @@ If ARG is non-nil, show the *erc-protocol* buffer."
(interactive "P")
(let* ((buf (get-buffer-create "*erc-protocol*")))
(with-current-buffer buf
- (erc-view-mode-enter)
+ (view-mode-enter)
(when (null (current-local-map))
(let ((inhibit-read-only t))
(insert (erc-make-notice "This buffer displays all IRC protocol traffic exchanged with each server.\n"))
@@ -2672,7 +2687,7 @@ displayed hostnames."
otherwise `erc-server-announced-name'. SERVER is matched against
`erc-common-server-suffixes'."
(when server
- (or (cdar (erc-remove-if-not
+ (or (cdar (cl-remove-if-not
(lambda (net) (string-match (car net) server))
erc-common-server-suffixes))
erc-server-announced-name)))
@@ -2768,7 +2783,7 @@ See also `erc-server-send'."
(defun erc-get-arglist (fun)
"Return the argument list of a function without the parens."
- (let ((arglist (format "%S" (erc-function-arglist fun))))
+ (let ((arglist (format "%S" (help-function-arglist fun))))
(if (string-match "\\`(\\(.*\\))\\'" arglist)
(match-string 1 arglist)
arglist)))
@@ -2903,6 +2918,44 @@ therefore has to contain the command itself as well."
(erc-server-send (substring line 1))
t)
+(defvar erc--read-time-period-history nil)
+
+(defun erc--read-time-period (prompt)
+ "Read a time period on the \"2h\" format.
+If there's no letter spec, the input is interpreted as a number of seconds.
+
+If input is blank, this function returns nil. Otherwise it
+returns the time spec converted to a number of seconds."
+ (let ((period (string-trim
+ (read-string prompt nil 'erc--read-time-period-history))))
+ (cond
+ ;; Blank input.
+ ((zerop (length period))
+ nil)
+ ;; All-number -- interpret as seconds.
+ ((string-match-p "\\`[0-9]+\\'" period)
+ (string-to-number period))
+ ;; Parse as a time spec.
+ (t
+ (let ((time (condition-case nil
+ (iso8601-parse-duration
+ (concat (cond
+ ((string-match-p "\\`P" (upcase period))
+ ;; Somebody typed in a full ISO8601 period.
+ (upcase period))
+ ((string-match-p "[YD]" (upcase period))
+ ;; If we have a year/day element,
+ ;; we have a full spec.
+ "P")
+ (t
+ ;; Otherwise it's just a sub-day spec.
+ "PT"))
+ (upcase period)))
+ (wrong-type-argument nil))))
+ (unless time
+ (user-error "%s is not a valid time period" period))
+ (decoded-time-period time))))))
+
(defun erc-cmd-IGNORE (&optional user)
"Ignore USER. This should be a regexp matching nick!user@host.
If no USER argument is specified, list the contents of `erc-ignore-list'."
@@ -2912,10 +2965,18 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
(y-or-n-p (format "Use regexp-quoted form (%s) instead? "
quoted)))
(setq user quoted))
- (erc-display-line
- (erc-make-notice (format "Now ignoring %s" user))
- 'active)
- (erc-with-server-buffer (add-to-list 'erc-ignore-list user)))
+ (let ((timeout
+ (erc--read-time-period
+ "Add a timeout? (Blank for no, or a time spec like 2h): "))
+ (buffer (current-buffer)))
+ (when timeout
+ (run-at-time timeout nil
+ (lambda ()
+ (erc--unignore-user user buffer))))
+ (erc-display-line
+ (erc-make-notice (format "Now ignoring %s" user))
+ 'active)
+ (erc-with-server-buffer (add-to-list 'erc-ignore-list user))))
(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)
@@ -2939,12 +3000,17 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
(erc-make-notice (format "%s is not currently ignored!" user))
'active)))
(when ignored-nick
+ (erc--unignore-user user (current-buffer))))
+ t)
+
+(defun erc--unignore-user (user buffer)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
(erc-display-line
(erc-make-notice (format "No longer ignoring %s" user))
'active)
(erc-with-server-buffer
- (setq erc-ignore-list (delete ignored-nick erc-ignore-list)))))
- t)
+ (setq erc-ignore-list (delete user erc-ignore-list))))))
(defun erc-cmd-CLEAR ()
"Clear the window content."
@@ -3097,16 +3163,18 @@ were most recently invited. See also `invitation'."
(setq chnl (erc-ensure-channel-name channel)))
(when chnl
;; Prevent double joining of same channel on same server.
- (let ((joined-channels
- (mapcar #'(lambda (chanbuf)
- (with-current-buffer chanbuf (erc-default-target)))
- (erc-channel-list erc-server-process))))
- (if (erc-member-ignore-case chnl joined-channels)
- (switch-to-buffer (car (erc-member-ignore-case chnl
- joined-channels)))
- (let ((server (with-current-buffer (process-buffer erc-server-process)
- (or erc-session-server erc-server-announced-name))))
- (erc-server-join-channel server chnl key))))))
+ (let* ((joined-channels
+ (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)))
+ (chnl-name (car (erc-member-ignore-case chnl joined-channels))))
+ (if chnl-name
+ (switch-to-buffer (if (get-buffer chnl-name)
+ chnl-name
+ (concat chnl-name "/" server)))
+ (erc-server-join-channel server chnl key)))))
t)
(defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN)
@@ -3502,7 +3570,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)
- (erc-replace-regexp-in-string "\n" "" (yow))
+ (replace-regexp-in-string "\n" "" (yow))
(erc-quit/part-reason-default))))
(make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4")
@@ -3529,7 +3597,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)
- (erc-replace-regexp-in-string "\n" "" (yow))
+ (replace-regexp-in-string "\n" "" (yow))
(erc-quit/part-reason-default))))
(make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4")
@@ -3656,8 +3724,9 @@ the message given by REASON."
x-toolkit-scroll-bars)))
"")
(if (featurep 'multi-tty) ", multi-tty" ""))
- (if erc-emacs-build-time
- (concat " of " erc-emacs-build-time)
+ (if emacs-build-time
+ (concat " of " (format-time-string
+ "%Y-%m-%d" emacs-build-time))
"")))
t)
@@ -3945,13 +4014,13 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
;; Do not extend the text properties when typing at the end
;; of the prompt, but stuff typed in front of the prompt
;; shall remain part of the prompt.
- (setq prompt (erc-propertize prompt
- 'start-open t ; XEmacs
- 'rear-nonsticky t ; Emacs
- 'erc-prompt t
- 'field t
- 'front-sticky t
- 'read-only t))
+ (setq prompt (propertize prompt
+ 'start-open t ; XEmacs
+ 'rear-nonsticky t ; Emacs
+ 'erc-prompt t
+ 'field t
+ 'front-sticky t
+ 'read-only t))
(erc-put-text-property 0 (1- (length prompt))
'font-lock-face (or face 'erc-prompt-face)
prompt)
@@ -4003,7 +4072,8 @@ If `point' is at the beginning of a channel name, use that as default."
(table (when (erc-server-buffer-live-p)
(set-buffer (process-buffer erc-server-process))
erc-channel-list)))
- (completing-read "Join channel: " table nil nil nil nil chnl))
+ (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))))
(erc-cmd-JOIN channel (when (>= (length key) 1) key)))
@@ -4334,15 +4404,15 @@ See also `erc-format-nick-function'."
(defun erc-get-user-mode-prefix (user)
(when user
(cond ((erc-channel-user-owner-p user)
- (erc-propertize "~" 'help-echo "owner"))
+ (propertize "~" 'help-echo "owner"))
((erc-channel-user-admin-p user)
- (erc-propertize "&" 'help-echo "admin"))
+ (propertize "&" 'help-echo "admin"))
((erc-channel-user-op-p user)
- (erc-propertize "@" 'help-echo "operator"))
+ (propertize "@" 'help-echo "operator"))
((erc-channel-user-halfop-p user)
- (erc-propertize "%" 'help-echo "half-op"))
+ (propertize "%" 'help-echo "half-op"))
((erc-channel-user-voice-p user)
- (erc-propertize "+" 'help-echo "voice"))
+ (propertize "+" 'help-echo "voice"))
(t ""))))
(defun erc-format-@nick (&optional user _channel-data)
@@ -4353,7 +4423,7 @@ prefix. Use CHANNEL-DATA to determine op and voice status. See
also `erc-format-nick-function'."
(when user
(let ((nick (erc-server-user-nickname user)))
- (concat (erc-propertize
+ (concat (propertize
(erc-get-user-mode-prefix nick)
'font-lock-face 'erc-nick-prefix-face)
nick))))
@@ -4366,12 +4436,12 @@ also `erc-format-nick-function'."
(nick (erc-current-nick))
(mode (erc-get-user-mode-prefix nick)))
(concat
- (erc-propertize open 'font-lock-face 'erc-default-face)
- (erc-propertize mode 'font-lock-face 'erc-my-nick-prefix-face)
- (erc-propertize nick 'font-lock-face 'erc-my-nick-face)
- (erc-propertize close 'font-lock-face 'erc-default-face)))
+ (propertize open 'font-lock-face 'erc-default-face)
+ (propertize mode 'font-lock-face 'erc-my-nick-prefix-face)
+ (propertize nick 'font-lock-face 'erc-my-nick-face)
+ (propertize close 'font-lock-face 'erc-default-face)))
(let ((prefix "> "))
- (erc-propertize prefix 'font-lock-face 'erc-default-face))))
+ (propertize prefix 'font-lock-face 'erc-default-face))))
(defun erc-echo-notice-in-default-buffer (s parsed buffer _sender)
"Echos a private notice in the default buffer, namely the
@@ -4504,7 +4574,7 @@ See also: `erc-echo-notice-in-user-buffers',
((string-match "^-" mode)
;; Remove the unbanned masks from the ban list
(setq erc-channel-banlist
- (erc-delete-if
+ (cl-delete-if
#'(lambda (y)
(member (upcase (cdr y))
(mapcar #'upcase
@@ -4525,7 +4595,7 @@ See also: `erc-echo-notice-in-user-buffers',
"Group LIST into sublists of length N."
(cond ((null list) nil)
((null (nthcdr n list)) (list list))
- (t (cons (erc-subseq list 0 n) (erc-group-list (nthcdr n list) n)))))
+ (t (cons (cl-subseq list 0 n) (erc-group-list (nthcdr n list) n)))))
;;; MOTD numreplies
@@ -6114,8 +6184,7 @@ non-nil value is found.
output (apply #'format format-args))
;; Change all "1 units" to "1 unit".
(while (string-match "\\([^0-9]\\|^\\)1 \\S-+\\(s\\)" output)
- (setq output (erc-replace-match-subexpression-in-string
- "" output (match-string 2 output) 2 (match-beginning 2))))
+ (setq output (replace-match "" nil nil output 2)))
output))
@@ -6391,17 +6460,16 @@ if `erc-away' is non-nil."
(defun erc-update-mode-line-buffer (buffer)
"Update the mode line in a single ERC buffer BUFFER."
(with-current-buffer buffer
- (let ((spec (format-spec-make
- ?a (erc-format-away-status)
- ?l (erc-format-lag-time)
- ?m (erc-format-channel-modes)
- ?n (or (erc-current-nick) "")
- ?N (erc-format-network)
- ?o (or (erc-controls-strip erc-channel-topic) "")
- ?p (erc-port-to-string erc-session-port)
- ?s (erc-format-target-and/or-server)
- ?S (erc-format-target-and/or-network)
- ?t (erc-format-target)))
+ (let ((spec `((?a . ,(erc-format-away-status))
+ (?l . ,(erc-format-lag-time))
+ (?m . ,(erc-format-channel-modes))
+ (?n . ,(or (erc-current-nick) ""))
+ (?N . ,(erc-format-network))
+ (?o . ,(or (erc-controls-strip erc-channel-topic) ""))
+ (?p . ,(erc-port-to-string erc-session-port))
+ (?s . ,(erc-format-target-and/or-server))
+ (?S . ,(erc-format-target-and/or-network))
+ (?t . ,(erc-format-target))))
(process-status (cond ((and (erc-server-process-alive)
(not erc-server-connected))
":connecting")
@@ -6434,16 +6502,16 @@ if `erc-away' is non-nil."
(fill-region (point-min) (point-max))
(buffer-string))))
(setq header-line-format
- (erc-replace-regexp-in-string
+ (replace-regexp-in-string
"%"
"%%"
(if face
- (erc-propertize header 'help-echo help-echo
- 'face face)
- (erc-propertize header 'help-echo help-echo))))))
+ (propertize header 'help-echo help-echo
+ 'face face)
+ (propertize header 'help-echo help-echo))))))
(t (setq header-line-format
(if face
- (erc-propertize header 'face face)
+ (propertize header 'face face)
header)))))))
(force-mode-line-update)))
@@ -6710,7 +6778,7 @@ functions."
nick user host channel
(if (not (string= reason ""))
(format ": %s"
- (erc-replace-regexp-in-string "%" "%%" reason))
+ (replace-regexp-in-string "%" "%%" reason))
"")))))
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 48c99acac33..8a444c91001 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -116,6 +116,9 @@ is non-nil."
(defcustom eshell-command-completions-alist
'(("acroread" . "\\.pdf\\'")
("xpdf" . "\\.pdf\\'")
+ ("gunzip" . "\\.t?gz\\'")
+ ("bunzip2" . "\\.t?bz2\\'")
+ ("unxz" . "\\.t?xz\\'")
("ar" . "\\.[ao]\\'")
("gcc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
("g++" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
@@ -244,6 +247,26 @@ to writing a completion function."
(let ((completion-at-point-functions '(elisp-completion-at-point)))
(completion-at-point)))
+(defvar eshell-cmpl-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?i)] #'completion-at-point)
+ ;; jww (1999-10-19): Will this work on anything but X?
+ (define-key map [backtab] #'pcomplete-reverse)
+ (define-key map [(meta ??)] #'completion-help-at-point)
+ (define-key map [(meta control ?i)] #'eshell-complete-lisp-symbol)
+ ;; C-c prefix:
+ (define-key map (kbd "C-c M-h") #'eshell-completion-help)
+ (define-key map (kbd "C-c TAB") #'pcomplete-expand-and-complete)
+ (define-key map (kbd "C-c C-i") #'pcomplete-expand-and-complete)
+ (define-key map (kbd "C-c SPC") #'pcomplete-expand)
+ map))
+
+(define-minor-mode eshell-cmpl-mode
+ "Minor mode that provides a keymap when `eshell-cmpl' active.
+
+\\{eshell-cmpl-mode-map}"
+ :keymap eshell-cmpl-mode-map)
+
(defun eshell-cmpl-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the completions module."
(set (make-local-variable 'pcomplete-command-completion-function)
@@ -291,22 +314,9 @@ to writing a completion function."
eshell-special-chars-outside-quoting)))
nil t)
(add-hook 'pcomplete-quote-arg-hook #'eshell-quote-backslash nil t)
- ;;(define-key eshell-mode-map [(meta tab)] 'eshell-complete-lisp-symbol) ; Redundant
- (define-key eshell-mode-map [(meta control ?i)] 'eshell-complete-lisp-symbol)
- (define-key eshell-command-map [(meta ?h)] 'eshell-completion-help)
- (define-key eshell-command-map [tab] 'pcomplete-expand-and-complete)
- (define-key eshell-command-map [(control ?i)]
- 'pcomplete-expand-and-complete)
- (define-key eshell-command-map [space] 'pcomplete-expand)
- (define-key eshell-command-map [? ] 'pcomplete-expand)
- ;;(define-key eshell-mode-map [tab] 'completion-at-point) ;Redundant!
- (define-key eshell-mode-map [(control ?i)] 'completion-at-point)
(add-hook 'completion-at-point-functions
#'pcomplete-completions-at-point nil t)
- ;; jww (1999-10-19): Will this work on anything but X?
- (define-key eshell-mode-map
- (if (featurep 'xemacs) [iso-left-tab] [backtab]) 'pcomplete-reverse)
- (define-key eshell-mode-map [(meta ??)] 'completion-help-at-point))
+ (eshell-cmpl-mode))
(defun eshell-completion-command-name ()
"Return the command name, possibly sans globbing."
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index 1949e5dc8fc..51df6fa1d52 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -168,6 +168,9 @@ Thus, this does not include the current directory.")
(defvar eshell-last-dir-ring nil
"The last directory that Eshell was in.")
+(defconst eshell-inside-emacs (format "%s,eshell" emacs-version)
+ "Value for the `INSIDE_EMACS' environment variable.")
+
;;; Functions:
(defun eshell-dirs-initialize () ;Called from `eshell-mode' via intern-soft!
@@ -191,6 +194,8 @@ Thus, this does not include the current directory.")
(unless (ring-empty-p eshell-last-dir-ring)
(expand-file-name
(ring-ref eshell-last-dir-ring 0))))
+ t)
+ ("INSIDE_EMACS" eshell-inside-emacs
t))))
(when eshell-cd-on-directory
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index 43483dcd50e..a32a6abe29c 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -232,8 +232,6 @@ resulting regular expression."
(regexp-quote (substring pattern matched-in-pattern))
"\\'")))
-(defvar ange-cache) ; XEmacs? See esh-util
-
(defun eshell-extended-glob (glob)
"Return a list of files generated from GLOB, perhaps looking for DIRS-ONLY.
This function almost fully supports zsh style filename generation
@@ -252,7 +250,7 @@ the form:
(INCLUDE-REGEXP EXCLUDE-REGEXP (PRED-FUNC-LIST) (MOD-FUNC-LIST))"
(let ((paths (eshell-split-path glob))
- eshell-glob-matches message-shown ange-cache)
+ eshell-glob-matches message-shown)
(unwind-protect
(if (and (cdr paths)
(file-name-absolute-p (car paths)))
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 73742a361da..5cee1bad364 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -202,6 +202,32 @@ element, regardless of any text on the command line. In that case,
map)
"Keymap used in isearch in Eshell.")
+(defvar eshell-hist-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [up] #'eshell-previous-matching-input-from-input)
+ (define-key map [down] #'eshell-next-matching-input-from-input)
+ (define-key map [(control up)] #'eshell-previous-input)
+ (define-key map [(control down)] #'eshell-next-input)
+ (define-key map [(meta ?r)] #'eshell-previous-matching-input)
+ (define-key map [(meta ?s)] #'eshell-next-matching-input)
+ (define-key map (kbd "C-c M-r") #'eshell-previous-matching-input-from-input)
+ (define-key map (kbd "C-c M-s") #'eshell-next-matching-input-from-input)
+ ;; FIXME: Relies on `eshell-hist-match-partial' being set _before_
+ ;; em-hist is loaded and won't respect changes.
+ (if eshell-hist-match-partial
+ (progn
+ (define-key map [(meta ?p)] 'eshell-previous-matching-input-from-input)
+ (define-key map [(meta ?n)] 'eshell-next-matching-input-from-input)
+ (define-key map (kbd "C-c M-p") #'eshell-previous-input)
+ (define-key map (kbd "C-c M-n") #'eshell-next-input))
+ (define-key map [(meta ?p)] #'eshell-previous-input)
+ (define-key map [(meta ?n)] #'eshell-next-input)
+ (define-key map (kbd "C-c M-p") #'eshell-previous-matching-input-from-input)
+ (define-key map (kbd "C-c M-n") #'eshell-next-matching-input-from-input))
+ (define-key map (kbd "C-c C-l") #'eshell-list-history)
+ (define-key map (kbd "C-c C-x") #'eshell-get-next-from-history)
+ map))
+
(defvar eshell-rebind-keys-alist)
;;; Functions:
@@ -216,6 +242,12 @@ Returns non-nil if INPUT is blank."
Returns nil if INPUT is prepended by blank space, otherwise non-nil."
(not (string-match-p "\\`\\s-+" input)))
+(define-minor-mode eshell-hist-mode
+ "Minor mode for the eshell-hist module.
+
+\\{eshell-hist-mode-map}"
+ :keymap eshell-hist-mode-map)
+
(defun eshell-hist-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the history management code for one Eshell buffer."
(when (eshell-using-module 'eshell-cmpl)
@@ -242,30 +274,7 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil."
(lambda ()
(setq overriding-terminal-local-map nil)))
nil t))
- (define-key eshell-mode-map [up] 'eshell-previous-matching-input-from-input)
- (define-key eshell-mode-map [down] 'eshell-next-matching-input-from-input)
- (define-key eshell-mode-map [(control up)] 'eshell-previous-input)
- (define-key eshell-mode-map [(control down)] 'eshell-next-input)
- (define-key eshell-mode-map [(meta ?r)] 'eshell-previous-matching-input)
- (define-key eshell-mode-map [(meta ?s)] 'eshell-next-matching-input)
- (define-key eshell-command-map [(meta ?r)]
- 'eshell-previous-matching-input-from-input)
- (define-key eshell-command-map [(meta ?s)]
- 'eshell-next-matching-input-from-input)
- (if eshell-hist-match-partial
- (progn
- (define-key eshell-mode-map [(meta ?p)]
- 'eshell-previous-matching-input-from-input)
- (define-key eshell-mode-map [(meta ?n)]
- 'eshell-next-matching-input-from-input)
- (define-key eshell-command-map [(meta ?p)] 'eshell-previous-input)
- (define-key eshell-command-map [(meta ?n)] 'eshell-next-input))
- (define-key eshell-mode-map [(meta ?p)] 'eshell-previous-input)
- (define-key eshell-mode-map [(meta ?n)] 'eshell-next-input)
- (define-key eshell-command-map [(meta ?p)]
- 'eshell-previous-matching-input-from-input)
- (define-key eshell-command-map [(meta ?n)]
- 'eshell-next-matching-input-from-input)))
+ (eshell-hist-mode))
(make-local-variable 'eshell-history-size)
(or eshell-history-size
@@ -300,10 +309,7 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil."
(add-hook 'kill-emacs-hook #'eshell-save-some-history)
(make-local-variable 'eshell-input-filter-functions)
- (add-hook 'eshell-input-filter-functions #'eshell-add-to-history nil t)
-
- (define-key eshell-command-map [(control ?l)] 'eshell-list-history)
- (define-key eshell-command-map [(control ?x)] 'eshell-get-next-from-history))
+ (add-hook 'eshell-input-filter-functions #'eshell-add-to-history nil t))
(defun eshell-save-some-history ()
"Save the history for any open Eshell buffers."
@@ -856,7 +862,7 @@ Moves relative to START, or `eshell-history-index'."
(setq prev n
n (mod (+ n motion) len))
;; If we haven't reached a match, step some more.
- (while (and (< n len) (not tried-each-ring-item)
+ (while (and (not tried-each-ring-item)
(not (string-match regexp (eshell-get-history n))))
(setq n (mod (+ n motion) len)
;; If we have gone all the way around in this search.
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index 70b3ad611a1..c1a022ee521 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -239,7 +239,6 @@ scope during the evaluation of TEST-SEXP."
(defvar show-recursive)
(defvar show-size)
(defvar sort-method)
-(defvar ange-cache)
(defvar dired-flag)
;;; Functions:
@@ -406,7 +405,7 @@ Sort entries alphabetically across.")
(setq listing-style 'by-columns))
(unless args
(setq args (list ".")))
- (let ((eshell-ls-exclude-regexp eshell-ls-exclude-regexp) ange-cache)
+ (let ((eshell-ls-exclude-regexp eshell-ls-exclude-regexp))
(when ignore-pattern
(unless (eshell-using-module 'eshell-glob)
(error (concat "-I option requires that `eshell-glob'"
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
index ee4b28fb3ae..c26f654e278 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -229,6 +229,12 @@ FOR LISTS OF ARGUMENTS:
EXAMPLES:
*.c(:o) sorted list of .c files")
+(defvar eshell-pred-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c M-q") #'eshell-display-predicate-help)
+ (define-key map (kbd "C-c M-m") #'eshell-display-modifier-help)
+ map))
+
;;; Functions:
(defun eshell-display-predicate-help ()
@@ -245,12 +251,17 @@ EXAMPLES:
(lambda ()
(insert eshell-modifier-help-string)))))
+(define-minor-mode eshell-pred-mode
+ "Minor mode for the eshell-pred module.
+
+\\{eshell-pred-mode-map}"
+ :keymap eshell-pred-mode-map)
+
(defun eshell-pred-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the predicate/modifier code."
(add-hook 'eshell-parse-argument-hook
#'eshell-parse-arg-modifier t t)
- (define-key eshell-command-map [(meta ?q)] 'eshell-display-predicate-help)
- (define-key eshell-command-map [(meta ?m)] 'eshell-display-modifier-help))
+ (eshell-pred-mode))
(defun eshell-apply-modifiers (lst predicates modifiers)
"Apply to LIST a series of PREDICATES and MODIFIERS."
@@ -440,11 +451,9 @@ resultant list of strings."
`(lambda (file)
(let ((attrs (file-attributes file)))
(if attrs
- (,(if (eq qual ?-)
- 'time-less-p
- (if (eq qual ?+)
- '(lambda (a b) (time-less-p b a))
- 'time-equal-p))
+ (,(cond ((eq qual ?-) #'time-less-p)
+ ((eq qual ?+) (lambda (a b) (time-less-p b a)))
+ (#'time-equal-p))
,when (nth ,attr-index attrs)))))))
(defun eshell-pred-file-type (type)
@@ -467,7 +476,7 @@ that `ls -l' will show in the first column of its display."
(defsubst eshell-pred-file-mode (mode)
"Return a test which tests that MODE pertains to the file."
`(lambda (file)
- (let ((modes (file-modes file)))
+ (let ((modes (file-modes file 'nofollow)))
(if modes
(logand ,mode modes)))))
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el
index bbf3b94ff44..9ae5ae12816 100644
--- a/lisp/eshell/em-prompt.el
+++ b/lisp/eshell/em-prompt.el
@@ -97,8 +97,20 @@ arriving, or after."
:options '(eshell-show-maximum-output)
:group 'eshell-prompt)
+(defvar eshell-prompt-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-n") #'eshell-next-prompt)
+ (define-key map (kbd "C-c C-p") #'eshell-previous-prompt)
+ map))
+
;;; Functions:
+(define-minor-mode eshell-prompt-mode
+ "Minor mode for eshell-prompt module.
+
+\\{eshell-prompt-mode-map}"
+ :keymap eshell-prompt-mode-map)
+
(defun eshell-prompt-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the prompting code."
(unless eshell-non-interactive-p
@@ -110,9 +122,7 @@ arriving, or after."
(set (make-local-variable 'eshell-skip-prompt-function)
'eshell-skip-prompt)
-
- (define-key eshell-command-map [(control ?n)] 'eshell-next-prompt)
- (define-key eshell-command-map [(control ?p)] 'eshell-previous-prompt)))
+ (eshell-prompt-mode)))
(defun eshell-emit-prompt ()
"Emit a prompt if eshell is being used interactively."
diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el
index 85593e45160..7991c631772 100644
--- a/lisp/eshell/em-rebind.el
+++ b/lisp/eshell/em-rebind.el
@@ -114,7 +114,6 @@ This is default behavior of shells like bash."
backward-list
forward-page
backward-page
- forward-point
forward-paragraph
backward-paragraph
backward-prefix-chars
@@ -137,6 +136,11 @@ This is default behavior of shells like bash."
:type '(repeat function)
:group 'eshell-rebind)
+(defvar eshell-rebind-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c M-l") #'eshell-lock-local-map)
+ map))
+
;; Internal Variables:
(defvar eshell-input-keymap)
@@ -145,6 +149,12 @@ This is default behavior of shells like bash."
;;; Functions:
+(define-minor-mode eshell-rebind-mode
+ "Minor mode for the eshell-rebind module.
+
+\\{eshell-rebind-mode-map}"
+ :keymap eshell-rebind-mode-map)
+
(defun eshell-rebind-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the inputting code."
(unless eshell-non-interactive-p
@@ -154,7 +164,7 @@ This is default behavior of shells like bash."
(make-local-variable 'overriding-local-map)
(add-hook 'post-command-hook 'eshell-rebind-input-map nil t)
(set (make-local-variable 'eshell-lock-keymap) nil)
- (define-key eshell-command-map [(meta ?l)] 'eshell-lock-local-map)))
+ (eshell-rebind-mode)))
(defun eshell-lock-local-map (&optional arg)
"Lock or unlock the current local keymap.
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index 51699a7aa46..fd4cd6716d2 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -469,8 +469,6 @@ Remove the DIRECTORY(ies), if they are empty.")
(eshell-parse-command
(format "tar %s %s" tar-args archive) args))))
-(defvar ange-cache) ; XEmacs? See esh-util
-
;; this is to avoid duplicating code...
(defmacro eshell-mvcpln-template (command action func query-var
force-var &optional preserve)
@@ -488,8 +486,7 @@ Remove the DIRECTORY(ies), if they are empty.")
(or (not no-dereference)
(not (file-symlink-p (car args)))))))
(eshell-shorthand-tar-command ,command args)
- (let ((target (car (last args)))
- ange-cache)
+ (let ((target (car (last args))))
(setcdr (last args 2) nil)
(eshell-shuffle-files
,command ,action args target ,func nil
@@ -790,9 +787,9 @@ external command."
;; completions rules for some common UNIX commands
-(defsubst eshell-complete-hostname ()
- "Complete a command that wants a hostname for an argument."
- (pcomplete-here (eshell-read-host-names)))
+(autoload 'pcmpl-unix-complete-hostname "pcmpl-unix")
+(define-obsolete-function-alias 'eshell-complete-hostname
+ #'pcmpl-unix-complete-hostname "28.1")
(defun eshell-complete-host-reference ()
"If there is a host reference, complete it."
@@ -801,26 +798,7 @@ external command."
(when (setq index (string-match "@[a-z.]*\\'" arg))
(setq pcomplete-stub (substring arg (1+ index))
pcomplete-last-completion-raw t)
- (throw 'pcomplete-completions (eshell-read-host-names)))))
-
-(defalias 'pcomplete/ftp 'eshell-complete-hostname)
-(defalias 'pcomplete/ncftp 'eshell-complete-hostname)
-(defalias 'pcomplete/ping 'eshell-complete-hostname)
-(defalias 'pcomplete/rlogin 'eshell-complete-hostname)
-
-(defun pcomplete/telnet ()
- (require 'pcmpl-unix)
- (pcomplete-opt "xl(pcmpl-unix-user-names)")
- (eshell-complete-hostname))
-
-(defun pcomplete/rsh ()
- "Complete `rsh', which, after the user and hostname, is like xargs."
- (require 'pcmpl-unix)
- (pcomplete-opt "l(pcmpl-unix-user-names)")
- (eshell-complete-hostname)
- (pcomplete-here (funcall pcomplete-command-completion-function))
- (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
- pcomplete-default-completion-function)))
+ (throw 'pcomplete-completions (pcomplete-read-host-names)))))
(defvar block-size)
(defvar by-bytes)
@@ -924,7 +902,7 @@ Summarize disk usage of each FILE, recursively for directories.")
;; filesystem support means nothing under Windows
(if (eshell-under-windows-p)
(setq only-one-filesystem nil))
- (let ((size 0.0) ange-cache)
+ (let ((size 0.0))
(while args
(if only-one-filesystem
(setq only-one-filesystem
diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el
index d55986c49b8..3c038edfd18 100644
--- a/lisp/eshell/em-xtra.el
+++ b/lisp/eshell/em-xtra.el
@@ -94,36 +94,6 @@ naturally accessible within Emacs."
(defalias 'eshell/ff 'find-name-dired)
(defalias 'eshell/gf 'find-grep-dired)
-(defun pcomplete/bcc32 ()
- "Completion function for Borland's C++ compiler."
- (let ((cur (pcomplete-arg 0)))
- (cond
- ((string-match "\\`-w\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
- (pcomplete-here
- '("ali" "amb" "amp" "asc" "asm" "aus" "bbf" "bei" "big" "ccc"
- "cln" "cod" "com" "cpt" "csu" "def" "dig" "dpu" "dsz" "dup"
- "eas" "eff" "ext" "hch" "hid" "ias" "ibc" "ifr" "ill" "nil"
- "lin" "lvc" "mcs" "mes" "mpc" "mpd" "msg" "nak" "ncf" "nci"
- "ncl" "nfd" "ngu" "nin" "nma" "nmu" "nod" "nop" "npp" "nsf"
- "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)))
- ((string-match "\\`-[LIn]\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
- (pcomplete-here (pcomplete-dirs) (match-string 2 cur)))
- ((string-match "\\`-[Ee]\\(.*\\)\\'" cur)
- (pcomplete-here (pcomplete-dirs-or-entries "\\.[Ee][Xx][Ee]\\'")
- (match-string 1 cur)))
- ((string-match "\\`-o\\(.*\\)\\'" cur)
- (pcomplete-here (pcomplete-dirs-or-entries "\\.[Oo][Bb][Jj]\\'")
- (match-string 1 cur)))
- (t
- (pcomplete-opt "3456ABCDEHIKLMNOPRSTUVXabcdefgijklnoptuvwxyz"))))
- (while (pcomplete-here
- (pcomplete-dirs-or-entries "\\.[iCc]\\([Pp][Pp]\\)?\\'"))))
-
-(defalias 'pcomplete/bcc 'pcomplete/bcc32)
-
(provide 'em-xtra)
;; Local Variables:
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index 86ceb41ffd2..e7b07b4208d 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -155,14 +155,22 @@ treated as a literal character."
:type 'hook
:group 'eshell-arg)
+(defvar eshell-arg-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c M-b") #'eshell-insert-buffer-name)
+ map))
+
;;; Functions:
+(define-minor-mode eshell-arg-mode
+ "Minor mode for the arg eshell module.
+
+\\{eshell-arg-mode-map}"
+ :keymap eshell-arg-mode-map)
+
(defun eshell-arg-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the argument parsing code."
- ;; This is supposedly run after enabling esh-mode, when eshell-mode-map
- ;; already exists.
- (defvar eshell-command-map)
- (define-key eshell-command-map [(meta ?b)] 'eshell-insert-buffer-name)
+ (eshell-arg-mode)
(set (make-local-variable 'eshell-inside-quote-regexp) nil)
(set (make-local-variable 'eshell-outside-quote-regexp) nil))
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index 0aa4ec4d16c..b4154861908 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -382,12 +382,7 @@ it defaults to `insert'."
"Set handle INDEX, using MODE, to point to TARGET."
(when target
(if (and (stringp target)
- (or (cond
- ((boundp 'null-device)
- (string= target null-device))
- ((boundp 'grep-null-device)
- (string= target grep-null-device))
- (t nil))
+ (or (string= target null-device)
(string= target "/dev/null")))
(aset eshell-current-handles index nil)
(let ((where (eshell-get-target target mode))
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index db5fddb2aaf..e0e86348bd8 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -72,51 +72,43 @@
(defcustom eshell-mode-unload-hook nil
"A hook that gets run when `eshell-mode' is unloaded."
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-mode-hook nil
"A hook that gets run when `eshell-mode' is entered."
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-first-time-mode-hook nil
"A hook that gets run the first time `eshell-mode' is entered.
That is to say, the first time during an Emacs session."
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-exit-hook nil
"A hook that is run whenever `eshell' is exited.
This hook is only run if exiting actually kills the buffer."
:version "24.1" ; removed eshell-query-kill-processes
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-kill-on-exit t
"If non-nil, kill the Eshell buffer on the `exit' command.
Otherwise, the buffer will simply be buried."
- :type 'boolean
- :group 'eshell-mode)
+ :type 'boolean)
(defcustom eshell-input-filter-functions nil
"Functions to call before input is processed.
The input is contained in the region from `eshell-last-input-start' to
`eshell-last-input-end'."
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-send-direct-to-subprocesses nil
"If t, send any input immediately to a subprocess."
- :type 'boolean
- :group 'eshell-mode)
+ :type 'boolean)
(defcustom eshell-expand-input-functions nil
"Functions to call before input is parsed.
Each function is passed two arguments, which bounds the region of the
current input text."
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-scroll-to-bottom-on-input nil
"Controls whether input to interpreter causes window to scroll.
@@ -126,8 +118,7 @@ buffer. If `this', scroll only the selected window.
See `eshell-preinput-scroll-to-bottom'."
:type '(radio (const :tag "Do not scroll Eshell windows" nil)
(const :tag "Scroll all windows showing the buffer" all)
- (const :tag "Scroll only the selected window" this))
- :group 'eshell-mode)
+ (const :tag "Scroll only the selected window" this)))
(defcustom eshell-scroll-to-bottom-on-output nil
"Controls whether interpreter output causes window to scroll.
@@ -140,8 +131,7 @@ See variable `eshell-scroll-show-maximum-output' and function
:type '(radio (const :tag "Do not scroll Eshell windows" nil)
(const :tag "Scroll all windows showing the buffer" all)
(const :tag "Scroll only the selected window" this)
- (const :tag "Scroll all windows other than selected" others))
- :group 'eshell-mode)
+ (const :tag "Scroll all windows other than selected" others)))
(defcustom eshell-scroll-show-maximum-output t
"Controls how interpreter output causes window to scroll.
@@ -149,16 +139,14 @@ If non-nil, then show the maximum output when the window is scrolled.
See variable `eshell-scroll-to-bottom-on-output' and function
`eshell-postoutput-scroll-to-bottom'."
- :type 'boolean
- :group 'eshell-mode)
+ :type 'boolean)
(defcustom eshell-buffer-maximum-lines 1024
"The maximum size in lines for eshell buffers.
Eshell buffers are truncated from the top to be no greater than this
number, if the function `eshell-truncate-buffer' is on
`eshell-output-filter-functions'."
- :type 'integer
- :group 'eshell-mode)
+ :type 'integer)
(defcustom eshell-output-filter-functions
'(eshell-postoutput-scroll-to-bottom
@@ -168,36 +156,31 @@ number, if the function `eshell-truncate-buffer' is on
"Functions to call before output is displayed.
These functions are only called for output that is displayed
interactively, and not for output which is redirected."
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-preoutput-filter-functions nil
"Functions to call before output is inserted into the buffer.
These functions get one argument, a string containing the text to be
inserted. They return the string as it should be inserted."
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-password-prompt-regexp
(format "\\(%s\\)[^::៖]*[::៖]\\s *\\'" (regexp-opt password-word-equivalents))
"Regexp matching prompts for passwords in the inferior process.
This is used by `eshell-watch-for-password-prompt'."
:type 'regexp
- :version "27.1"
- :group 'eshell-mode)
+ :version "27.1")
(defcustom eshell-skip-prompt-function nil
"A function called from beginning of line to skip the prompt."
- :type '(choice (const nil) function)
- :group 'eshell-mode)
+ :type '(choice (const nil) function))
(define-obsolete-variable-alias 'eshell-status-in-modeline
'eshell-status-in-mode-line "24.3")
(defcustom eshell-status-in-mode-line t
"If non-nil, let the user know a command is running in the mode line."
- :type 'boolean
- :group 'eshell-mode)
+ :type 'boolean)
(defcustom eshell-directory-name
(locate-user-emacs-file "eshell/" ".eshell/")
@@ -213,10 +196,7 @@ This is used by `eshell-watch-for-password-prompt'."
;; these are only set to nil initially for the sake of the
;; byte-compiler, when compiling other files which `require' this one
(defvar eshell-mode nil)
-(defvar eshell-mode-map nil)
(defvar eshell-command-running-string "--")
-(defvar eshell-command-map nil)
-(defvar eshell-command-prefix nil)
(defvar eshell-last-input-start nil)
(defvar eshell-last-input-end nil)
(defvar eshell-last-output-start nil)
@@ -280,6 +260,32 @@ This is used by `eshell-watch-for-password-prompt'."
(standard-syntax-table))
st))
+(defvar eshell-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?c)] 'eshell-command-map)
+ (define-key map "\r" #'eshell-send-input)
+ (define-key map "\M-\r" #'eshell-queue-input)
+ (define-key map [(meta control ?l)] #'eshell-show-output)
+ (define-key map [(control ?a)] #'eshell-bol)
+ map))
+
+(defvar eshell-command-map
+ (let ((map (define-prefix-command 'eshell-command-map)))
+ (define-key map [(meta ?o)] #'eshell-mark-output)
+ (define-key map [(meta ?d)] #'eshell-toggle-direct-send)
+ (define-key map [(control ?a)] #'eshell-bol)
+ (define-key map [(control ?b)] #'eshell-backward-argument)
+ (define-key map [(control ?e)] #'eshell-show-maximum-output)
+ (define-key map [(control ?f)] #'eshell-forward-argument)
+ (define-key map [(control ?m)] #'eshell-copy-old-input)
+ (define-key map [(control ?o)] #'eshell-kill-output)
+ (define-key map [(control ?r)] #'eshell-show-output)
+ (define-key map [(control ?t)] #'eshell-truncate-buffer)
+ (define-key map [(control ?u)] #'eshell-kill-input)
+ (define-key map [(control ?w)] #'backward-kill-word)
+ (define-key map [(control ?y)] #'eshell-repeat-argument)
+ map))
+
;;; User Functions:
(defun eshell-kill-buffer-function ()
@@ -298,10 +304,6 @@ and the hook `eshell-exit-hook'."
"Emacs shell interactive mode."
(setq-local eshell-mode t)
- ;; FIXME: What the hell!?
- (setq-local eshell-mode-map (make-sparse-keymap))
- (use-local-map eshell-mode-map)
-
(when eshell-status-in-mode-line
(make-local-variable 'eshell-command-running-string)
(let ((fmt (copy-sequence mode-line-format)))
@@ -310,31 +312,8 @@ and the hook `eshell-exit-hook'."
(if mode-line-elt
(setcar mode-line-elt 'eshell-command-running-string))))
- (define-key eshell-mode-map "\r" 'eshell-send-input)
- (define-key eshell-mode-map "\M-\r" 'eshell-queue-input)
- (define-key eshell-mode-map [(meta control ?l)] 'eshell-show-output)
- (define-key eshell-mode-map [(control ?a)] 'eshell-bol)
-
- (setq-local eshell-command-prefix (make-symbol "eshell-command-prefix"))
- (fset eshell-command-prefix (make-sparse-keymap))
- (setq-local eshell-command-map (symbol-function eshell-command-prefix))
- (define-key eshell-mode-map [(control ?c)] eshell-command-prefix)
-
- (define-key eshell-command-map [(meta ?o)] 'eshell-mark-output)
- (define-key eshell-command-map [(meta ?d)] 'eshell-toggle-direct-send)
-
- (define-key eshell-command-map [(control ?a)] 'eshell-bol)
- (define-key eshell-command-map [(control ?b)] 'eshell-backward-argument)
- (define-key eshell-command-map [(control ?e)] 'eshell-show-maximum-output)
- (define-key eshell-command-map [(control ?f)] 'eshell-forward-argument)
- (define-key eshell-command-map [(control ?m)] 'eshell-copy-old-input)
- (define-key eshell-command-map [(control ?o)] 'eshell-kill-output)
- (define-key eshell-command-map [(control ?r)] 'eshell-show-output)
- (define-key eshell-command-map [(control ?t)] 'eshell-truncate-buffer)
- (define-key eshell-command-map [(control ?u)] 'eshell-kill-input)
- (define-key eshell-command-map [(control ?w)] 'backward-kill-word)
- (define-key eshell-command-map [(control ?y)] 'eshell-repeat-argument)
-
+ (set (make-local-variable 'bookmark-make-record-function)
+ 'eshell-bookmark-make-record)
(setq local-abbrev-table eshell-mode-abbrev-table)
(set (make-local-variable 'list-buffers-directory)
@@ -696,46 +675,47 @@ newline."
"Send the output from PROCESS (STRING) to the interactive display.
This is done after all necessary filtering has been done."
(let ((oprocbuf (if process (process-buffer process)
- (current-buffer)))
- (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t))
- (let ((functions eshell-preoutput-filter-functions))
- (while (and functions string)
- (setq string (funcall (car functions) string))
- (setq functions (cdr functions))))
- (if (and string oprocbuf (buffer-name oprocbuf))
- (let (opoint obeg oend)
- (with-current-buffer oprocbuf
- (setq opoint (point))
- (setq obeg (point-min))
- (setq oend (point-max))
- (let ((buffer-read-only nil)
- (nchars (length string))
- (ostart nil))
- (widen)
- (goto-char eshell-last-output-end)
- (setq ostart (point))
- (if (<= (point) opoint)
- (setq opoint (+ opoint nchars)))
- (if (< (point) obeg)
- (setq obeg (+ obeg nchars)))
- (if (<= (point) oend)
- (setq oend (+ oend nchars)))
+ (current-buffer)))
+ (inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t))
+ (when (and string oprocbuf (buffer-name oprocbuf))
+ (with-current-buffer oprocbuf
+ (let ((functions eshell-preoutput-filter-functions))
+ (while (and functions string)
+ (setq string (funcall (car functions) string))
+ (setq functions (cdr functions))))
+ (when string
+ (let (opoint obeg oend)
+ (setq opoint (point))
+ (setq obeg (point-min))
+ (setq oend (point-max))
+ (let ((buffer-read-only nil)
+ (nchars (length string))
+ (ostart nil))
+ (widen)
+ (goto-char eshell-last-output-end)
+ (setq ostart (point))
+ (if (<= (point) opoint)
+ (setq opoint (+ opoint nchars)))
+ (if (< (point) obeg)
+ (setq obeg (+ obeg nchars)))
+ (if (<= (point) oend)
+ (setq oend (+ oend nchars)))
;; Let the ansi-color overlay hooks run.
(let ((inhibit-modification-hooks nil))
(insert-before-markers string))
- (if (= (window-start) (point))
- (set-window-start (selected-window)
- (- (point) nchars)))
- (if (= (point) eshell-last-input-end)
- (set-marker eshell-last-input-end
- (- eshell-last-input-end nchars)))
- (set-marker eshell-last-output-start ostart)
- (set-marker eshell-last-output-end (point))
- (force-mode-line-update))
- (narrow-to-region obeg oend)
- (goto-char opoint)
- (eshell-run-output-filters))))))
+ (if (= (window-start) (point))
+ (set-window-start (selected-window)
+ (- (point) nchars)))
+ (if (= (point) eshell-last-input-end)
+ (set-marker eshell-last-input-end
+ (- eshell-last-input-end nchars)))
+ (set-marker eshell-last-output-start ostart)
+ (set-marker eshell-last-output-end (point))
+ (force-mode-line-update))
+ (narrow-to-region obeg oend)
+ (goto-char opoint)
+ (eshell-run-output-filters)))))))
(defun eshell-run-output-filters ()
"Run the `eshell-output-filter-functions' on the current output."
@@ -1020,5 +1000,29 @@ This function could be in the list `eshell-output-filter-functions'."
(custom-add-option 'eshell-output-filter-functions
'eshell-handle-ansi-color)
+;;; Bookmark support:
+
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+
+(defun eshell-bookmark-name ()
+ (format "eshell-%s"
+ (file-name-nondirectory
+ (directory-file-name
+ (file-name-directory default-directory)))))
+
+(defun eshell-bookmark-make-record ()
+ "Create a bookmark for the current Eshell buffer."
+ `(,(eshell-bookmark-name)
+ (location . ,default-directory)
+ (handler . eshell-bookmark-jump)))
+
+;;;###autoload
+(defun eshell-bookmark-jump (bookmark)
+ "Default bookmark handler for Eshell buffers."
+ (let ((default-directory (bookmark-prop-get bookmark 'location)))
+ (eshell)))
+
(provide 'esh-mode)
;;; esh-mode.el ends here
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index c3ac3a5b71b..db1b258c8f5 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -109,6 +109,16 @@ information, for example."
(defvar eshell-process-list nil
"A list of the current status of subprocesses.")
+(defvar eshell-proc-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c M-i") #'eshell-insert-process)
+ (define-key map (kbd "C-c C-c") #'eshell-interrupt-process)
+ (define-key map (kbd "C-c C-k") #'eshell-kill-process)
+ (define-key map (kbd "C-c C-d") #'eshell-send-eof-to-process)
+ (define-key map (kbd "C-c C-s") #'list-processes)
+ (define-key map (kbd "C-c C-\\") #'eshell-quit-process)
+ map))
+
;;; Functions:
(defun eshell-kill-process-function (proc status)
@@ -121,20 +131,16 @@ PROC and STATUS to functions on the latter."
(eshell-reset-after-proc status)
(run-hook-with-args 'eshell-kill-hook proc status))
+(define-minor-mode eshell-proc-mode
+ "Minor mode for the proc eshell module.
+
+\\{eshell-proc-mode-map}"
+ :keymap eshell-proc-mode-map)
+
(defun eshell-proc-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the process handling code."
(make-local-variable 'eshell-process-list)
- ;; This is supposedly run after enabling esh-mode, when eshell-command-map
- ;; already exists.
- (defvar eshell-command-map)
- (define-key eshell-command-map [(meta ?i)] 'eshell-insert-process)
- (define-key eshell-command-map [(control ?c)] 'eshell-interrupt-process)
- (define-key eshell-command-map [(control ?k)] 'eshell-kill-process)
- (define-key eshell-command-map [(control ?d)] 'eshell-send-eof-to-process)
-; (define-key eshell-command-map [(control ?q)] 'eshell-continue-process)
- (define-key eshell-command-map [(control ?s)] 'list-processes)
-; (define-key eshell-command-map [(control ?z)] 'eshell-stop-process)
- (define-key eshell-command-map [(control ?\\)] 'eshell-quit-process))
+ (eshell-proc-mode))
(defun eshell-reset-after-proc (status)
"Reset the command input location after a process terminates.
@@ -289,7 +295,7 @@ See `eshell-needs-pipe'."
(process-environment (eshell-environment-variables))
proc decoding encoding changed)
(cond
- ((fboundp 'start-file-process)
+ ((fboundp 'make-process)
(setq proc
(let ((process-connection-type
(unless (eshell-needs-pipe-p command)
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index adf39061468..9268921fadc 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -51,9 +51,15 @@ similarly to external commands, as far as successful result output."
:group 'eshell-util)
(defcustom eshell-hosts-file "/etc/hosts"
- "The name of the /etc/hosts file."
+ "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)
+;; 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.
+(make-obsolete-variable 'eshell-hosts-file nil "28.1")
(defcustom eshell-handle-errors t
"If non-nil, Eshell will handle errors itself.
@@ -127,11 +133,14 @@ function `string-to-number'."
(defvar eshell-user-timestamp nil
"A timestamp of when the user file was read.")
-(defvar eshell-host-names nil
- "A cache the names of frequently accessed hosts.")
+;;; Obsolete variables:
-(defvar eshell-host-timestamp nil
- "A timestamp of when the hosts file was read.")
+(define-obsolete-variable-alias 'eshell-host-names
+ 'pcomplete--host-name-cache "28.1")
+(define-obsolete-variable-alias 'eshell-host-timestamp
+ 'pcomplete--host-name-cache-timestamp "28.1")
+(defvar pcomplete--host-name-cache)
+(defvar pcomplete--host-name-cache-timestamp)
;;; Functions:
@@ -479,37 +488,15 @@ list."
(defalias 'eshell-user-name 'user-login-name)
-(defun eshell-read-hosts-file (filename)
- "Read in the hosts from FILENAME, default `eshell-hosts-file'."
- (let (hosts)
- (with-temp-buffer
- (insert-file-contents (or filename eshell-hosts-file))
- (goto-char (point-min))
- (while (re-search-forward
- ;; "^ \t\\([^# \t\n]+\\)[ \t]+\\([^ \t\n]+\\)\\([ \t]*\\([^ \t\n]+\\)\\)?"
- "^[ \t]*\\([^# \t\n]+\\)[ \t]+\\([^ \t\n].+\\)" nil t)
- (push (cons (match-string 1)
- (split-string (match-string 2)))
- hosts)))
- (nreverse hosts)))
-
-(defun eshell-read-hosts (file result-var timestamp-var)
- "Read the contents of /etc/hosts for host names."
- (if (or (not (symbol-value result-var))
- (not (symbol-value timestamp-var))
- (time-less-p
- (symbol-value timestamp-var)
- (file-attribute-modification-time (file-attributes file))))
- (progn
- (set result-var (apply #'nconc (eshell-read-hosts-file file)))
- (set timestamp-var (current-time))))
- (symbol-value result-var))
-
-(defun eshell-read-host-names ()
- "Read the contents of /etc/hosts for host names."
- (if eshell-hosts-file
- (eshell-read-hosts eshell-hosts-file 'eshell-host-names
- 'eshell-host-timestamp)))
+(autoload 'pcomplete-read-hosts-file "pcomplete")
+(autoload 'pcomplete-read-hosts "pcomplete")
+(autoload 'pcomplete-read-host-names "pcomplete")
+(define-obsolete-function-alias 'eshell-read-hosts-file
+ #'pcomplete-read-hosts-file "28.1")
+(define-obsolete-function-alias 'eshell-read-hosts
+ #'pcomplete-read-hosts "28.1")
+(define-obsolete-function-alias 'eshell-read-host-names
+ #'pcomplete-read-host-names "28.1")
(defsubst eshell-copy-environment ()
"Return an unrelated copy of `process-environment'."
@@ -647,14 +634,8 @@ gid format. Valid values are `string' and `integer', defaulting to
(let ((base (file-name-nondirectory file))
(dir (file-name-directory file)))
(if (string-equal "" base) (setq base "."))
- (if (boundp 'ange-cache)
- (setq entry (cdr (assoc base (cdr (assoc dir ange-cache))))))
(unless entry
(setq entry (eshell-parse-ange-ls dir))
- (if (boundp 'ange-cache)
- (setq ange-cache
- (cons (cons dir entry)
- ange-cache)))
(if entry
(let ((fentry (assoc base (cdr entry))))
(if fentry
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 75ccf5b8353..7388279f157 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -179,26 +179,50 @@ if they are quoted with a backslash."
(eshell-apply-indices eshell-command-arguments
indices)))))
"This list provides aliasing for variable references.
-It is very similar in concept to what `eshell-user-aliases-list' does
-for commands. Each member of this defines the name of a command,
-and the Lisp value to return for that variable if it is accessed
-via the syntax `$NAME'.
-
-If the value is a function, that function will be called with two
-arguments: the list of the indices that was used in the reference, and
-whether the user is requesting the length of the ultimate element.
-For example, a reference of `$NAME[10][20]' would result in the
-function for alias `NAME' being called (assuming it were aliased to a
-function), and the arguments passed to this function would be the list
-'(10 20)', and nil."
+Each member defines the name of a variable, and a Lisp value used to
+compute the string value that will be returned when the variable is
+accessed via the syntax `$NAME'.
+
+If the value is a function, call that function with two arguments: the
+list of the indices that was used in the reference, and whether the
+user is requesting the length of the ultimate element. For example, a
+reference of `$NAME[10][20]' would result in the function for alias
+`NAME' being called (assuming it were aliased to a function), and the
+arguments passed to this function would be the list '(10 20)', and
+nil.
+
+If the value is a string, return the value for the variable with that
+name in the current environment. If no variable with that name exists
+in the environment, but if a symbol with that same name exists and has
+a value bound to it, return its value instead. You can prioritize
+symbol values over environment values by setting
+`eshell-prefer-lisp-variables' to t.
+
+If the value is a symbol, return the value bound to it.
+
+If the value has any other type, signal an error.
+
+Additionally, each member may specify if it should be copied to the
+environment of created subprocesses."
:type '(repeat (list string sexp
(choice (const :tag "Copy to environment" t)
(const :tag "Use only in Eshell" nil)))))
(put 'eshell-variable-aliases-list 'risky-local-variable t)
+(defvar eshell-var-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c M-v") #'eshell-insert-envvar)
+ map))
+
;;; Functions:
+(define-minor-mode eshell-var-mode
+ "Minor mode for the esh-var module.
+
+\\{eshell-var-mode-map}"
+ :keymap eshell-var-mode-map)
+
(defun eshell-var-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the variable handle code."
;; Break the association with our parent's environment. Otherwise,
@@ -207,11 +231,6 @@ function), and the arguments passed to this function would be the list
(set (make-local-variable 'process-environment)
(eshell-copy-environment)))
- ;; This is supposedly run after enabling esh-mode, when eshell-command-map
- ;; already exists.
- (defvar eshell-command-map)
- (define-key eshell-command-map [(meta ?v)] 'eshell-insert-envvar)
-
(set (make-local-variable 'eshell-special-chars-inside-quoting)
(append eshell-special-chars-inside-quoting '(?$)))
(set (make-local-variable 'eshell-special-chars-outside-quoting)
@@ -444,8 +463,8 @@ Possible options are:
(eshell-as-subcommand ,(eshell-parse-command cmd))
(ignore
(nconc eshell-this-command-hook
- (list (function (lambda ()
- (delete-file ,temp))))))
+ (list (lambda ()
+ (delete-file ,temp)))))
(quote ,temp)))
(goto-char (1+ end)))))))
((eq (char-after) ?\()
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
index 2a63882ff09..6698ca45de4 100644
--- a/lisp/eshell/eshell.el
+++ b/lisp/eshell/eshell.el
@@ -265,14 +265,18 @@ information on Eshell, see Info node `(eshell)Top'."
(eshell-mode))
buf))
-(defun eshell-return-exits-minibuffer ()
- ;; This is supposedly run after enabling esh-mode, when eshell-mode-map
- ;; already exists.
- (defvar eshell-mode-map)
- (define-key eshell-mode-map [(control ?g)] 'abort-recursive-edit)
- (define-key eshell-mode-map [(control ?m)] 'exit-minibuffer)
- (define-key eshell-mode-map [(control ?j)] 'exit-minibuffer)
- (define-key eshell-mode-map [(meta control ?m)] 'exit-minibuffer))
+(define-minor-mode eshell-command-mode
+ "Minor mode for `eshell-command' input.
+\\{eshell-command-mode-map}"
+ :keymap (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?g)] 'abort-recursive-edit)
+ (define-key map [(control ?m)] 'exit-minibuffer)
+ (define-key map [(control ?j)] 'exit-minibuffer)
+ (define-key map [(meta control ?m)] 'exit-minibuffer)
+ map))
+
+(define-obsolete-function-alias 'eshell-return-exits-minibuffer
+ #'eshell-command-mode "28.1")
(defvar eshell-non-interactive-p nil
"A variable which is non-nil when Eshell is not running interactively.
@@ -292,7 +296,7 @@ With prefix ARG, insert output into the current buffer at point."
;; Enable `eshell-mode' only in this minibuffer.
(minibuffer-with-setup-hook #'(lambda ()
(eshell-mode)
- (eshell-return-exits-minibuffer))
+ (eshell-command-mode +1))
(unless command
(setq command (read-from-minibuffer "Emacs shell command: "))
(if (eshell-using-module 'eshell-hist)
@@ -380,15 +384,6 @@ corresponding to a successful execution."
(set status-var eshell-last-command-status))
(cadr result))))))
-;;;_* Reporting bugs
-;;
-;; If you do encounter a bug, on any system, please report
-;; it -- in addition to any particular oddities in your configuration
-;; -- so that the problem may be corrected for the benefit of others.
-
-;;;###autoload
-(define-obsolete-function-alias 'eshell-report-bug 'report-emacs-bug "23.1")
-
;;; Code:
(defun eshell-unload-all-modules ()
diff --git a/lisp/expand.el b/lisp/expand.el
index 1417c90fdb4..77e4fc2657c 100644
--- a/lisp/expand.el
+++ b/lisp/expand.el
@@ -55,10 +55,8 @@
;;
;; you can also init some post-process hooks :
;;
-;; (add-hook 'expand-load-hook
-;; (lambda ()
-;; (add-hook 'expand-expand-hook 'indent-according-to-mode)
-;; (add-hook 'expand-jump-hook 'indent-according-to-mode)))
+;; (add-hook 'expand-expand-hook 'indent-according-to-mode)
+;; (add-hook 'expand-jump-hook 'indent-according-to-mode)
;;
;; Remarks:
;;
@@ -78,6 +76,8 @@
"Hooks run when `expand.el' is loaded."
:type 'hook
:group 'expand)
+(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."
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index b10d874b21b..3ed4b54d223 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -445,7 +445,7 @@ sets the CHARSET property of the character at point."
(interactive (list (progn
(barf-if-buffer-read-only)
(read-charset
- (format "Use charset (default %s): " (charset-after))
+ (format-prompt "Use charset" (charset-after))
(charset-after)))
(if (and mark-active (not current-prefix-arg))
(region-beginning))
@@ -621,12 +621,11 @@ color. The function should accept a single argument, the color name."
(downcase b))))))
(setq color (list color)))
(let* ((opoint (point))
- (color-values (color-values (car color)))
- (light-p (>= (apply 'max color-values)
- (* (car (color-values "white")) .5))))
+ (fg (readable-foreground-color (car color))))
(insert (car color))
(indent-to 22)
- (put-text-property opoint (point) 'face `(:background ,(car color)))
+ (put-text-property opoint (point) 'face `(:background ,(car color)
+ :foreground ,fg))
(put-text-property
(prog1 (point)
(insert " ")
@@ -639,7 +638,7 @@ color. The function should accept a single argument, the color name."
(insert (propertize
(apply 'format "#%02x%02x%02x"
(mapcar (lambda (c) (ash c -8))
- color-values))
+ (color-values (car color))))
'mouse-face 'highlight
'help-echo
(let ((hsv (apply 'color-rgb-to-hsv
@@ -651,7 +650,7 @@ color. The function should accept a single argument, the color name."
opoint (point)
'follow-link t
'mouse-face (list :background (car color)
- :foreground (if light-p "black" "white"))
+ :foreground fg)
'color-name (car color)
'action callback-fn)))
(insert "\n"))
diff --git a/lisp/faces.el b/lisp/faces.el
index 48c1776648f..5b7e0a5aee2 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1212,10 +1212,7 @@ Value is the new attribute value."
(setq name (concat (upcase (substring name 0 1)) (substring name 1)))
(let* ((completion-ignore-case t)
(value (completing-read
- (format-message (if default
- "%s for face `%s' (default %s): "
- "%s for face `%s': ")
- name face default)
+ (format-prompt "%s for face `%s'" default name face)
completion-alist nil nil nil nil default)))
(if (equal value "") default value)))
@@ -1560,7 +1557,7 @@ is given, in which case return its value instead."
;; return it to the caller. Since there will most definitely be something to
;; return in this case, there's no need to know/check if a match was found.
(if defaults
- (append result defaults)
+ (append defaults result)
(if match-found
result
no-match-retval))))
@@ -1785,16 +1782,42 @@ with the color they represent as background color."
(defined-colors frame)))
(defun readable-foreground-color (color)
- "Return a readable foreground color for background COLOR."
- (let* ((rgb (color-values color))
- (max (apply #'max rgb))
- (black (car (color-values "black")))
- (white (car (color-values "white"))))
- ;; Select black or white depending on which one is less similar to
- ;; the brightest component.
- (if (> (abs (- max black)) (abs (- max white)))
- "black"
- "white")))
+ "Return a readable foreground color for background COLOR.
+The returned value is a string representing black or white, depending
+on which one provides better contrast with COLOR."
+ ;; We use #ffffff instead of "white", because the latter is sometimes
+ ;; less than white. That way, we get the best contrast possible.
+ (if (color-dark-p (mapcar (lambda (c) (/ c 65535.0))
+ (color-values color)))
+ "#ffffff" "black"))
+
+(defconst color-luminance-dark-limit 0.325
+ "The relative luminance below which a color is considered 'dark'.
+A 'dark' color in this sense provides better contrast with white
+than with black; see `color-dark-p'.
+This value was determined experimentally.")
+
+(defun color-dark-p (rgb)
+ "Whether RGB is more readable against white than black.
+RGB is a 3-element list (R G B), each component in the range [0,1].
+This predicate can be used both for determining a suitable (black or white)
+contrast colour with RGB as background and as foreground."
+ (unless (<= 0 (apply #'min rgb) (apply #'max rgb) 1)
+ (error "RGB components %S not in [0,1]" rgb))
+ ;; Compute the relative luminance after gamma-correcting (assuming sRGB),
+ ;; and compare to a cut-off value determined experimentally.
+ ;; See https://en.wikipedia.org/wiki/Relative_luminance for details.
+ (let* ((sr (nth 0 rgb))
+ (sg (nth 1 rgb))
+ (sb (nth 2 rgb))
+ ;; Gamma-correct the RGB components to linear values.
+ ;; Use the power 2.2 as an approximation to sRGB gamma;
+ ;; it should be good enough for the purpose of this function.
+ (r (expt sr 2.2))
+ (g (expt sg 2.2))
+ (b (expt sb 2.2))
+ (y (+ (* r 0.2126) (* g 0.7152) (* b 0.0722))))
+ (< y color-luminance-dark-limit)))
(declare-function xw-color-defined-p "xfns.c" (color &optional frame))
@@ -1822,7 +1845,7 @@ COLOR should be a string naming a color (e.g. \"white\"), or a
string specifying a color's RGB components (e.g. \"#ff12ec\").
Return a list of three integers, (RED GREEN BLUE), each between 0
-and either 65280 or 65535 (the maximum depends on the system).
+and 65535 inclusive.
Use `color-name-to-rgb' if you want RGB floating-point values
normalized to 1.0.
diff --git a/lisp/ffap.el b/lisp/ffap.el
index e60478c0b26..ccba2911445 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -54,6 +54,8 @@
;; C-x 5 r ffap-read-only-other-frame
;; C-x 5 d ffap-dired-other-frame
;;
+;; C-x t f ffap-other-tab
+;;
;; S-mouse-3 ffap-at-mouse
;; C-S-mouse-3 ffap-menu
;;
@@ -108,8 +110,6 @@
(require 'url-parse)
(require 'thingatpt)
-(define-obsolete-variable-alias 'ffap-version 'emacs-version "23.2")
-
(defgroup ffap nil
"Find file or URL at point."
:group 'matching
@@ -1080,7 +1080,7 @@ If a given RFC isn't in these then `ffap-rfc-path' is offered."
;; Slightly controversial decisions:
;; * strip trailing "@", ":" and enclosing "{"/"}".
;; * no commas (good for latex)
- (file "--:\\\\${}+<>@-Z_[:alpha:]~*?" "{<@" "@>;.,!:}")
+ (file "--:\\\\${}+<>@-Z_[:alpha:]~*?#" "{<@" "@>;.,!:}")
;; An url, or maybe an email/news message-id:
(url "--:=&?$+@-Z_[:alpha:]~#,%;*()!'" "^[0-9a-zA-Z]" ":;.,!?")
;; Find a string that does *not* contain a colon:
@@ -1107,6 +1107,121 @@ The arguments CHARS, BEG and END are handled as described in
;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95.
"Last string returned by the function `ffap-string-at-point'.")
+(defcustom ffap-file-name-with-spaces nil
+ "If non-nil, enable looking for paths with spaces in `ffap-string-at-point'.
+Enabling this variable may lead to `find-file-at-point' guessing
+wrong more often when trying to find a file name intermingled
+with normal text, but can be useful when working on systems that
+normally use spaces in file names (like Microsoft Windows and the
+like)."
+ :type 'boolean
+ :version "28.1")
+
+(defun ffap-search-backward-file-end (&optional dir-separator end)
+ "Search backward position point where file would probably end.
+Optional DIR-SEPARATOR defaults to \"/\". The search maximum is
+`line-end-position' or optional END point.
+
+Suppose the cursor is somewhere that might be near end of file,
+the guessing would position point before punctuation (like comma)
+after the file extension:
+
+ C:\temp\file.log, which contain ....
+ =============================== (before)
+ ---------------- (after)
+
+
+ C:\temp\file.log on Windows or /tmp/file.log on Unix
+ =============================== (before)
+ ---------------- (after)
+
+The strategy is to search backward until DIR-SEPARATOR which defaults to
+\"/\" and then take educated guesses.
+
+Move point and return point if an adjustment was done."
+ (unless dir-separator
+ (setq dir-separator "/"))
+ (let ((opoint (point))
+ point punct end whitespace-p)
+ (when (re-search-backward
+ (regexp-quote dir-separator) (line-beginning-position) t)
+ ;; Move to the beginning of the match..
+ (forward-char 1)
+ ;; ... until typical punctuation.
+ (when (re-search-forward "\\([][<>()\"'`,.:;]\\)"
+ (or end
+ (line-end-position))
+ t)
+ (setq end (match-end 0))
+ (setq punct (match-string 1))
+ (setq whitespace-p (looking-at "[ \t\r\n]\\|$"))
+ (goto-char end)
+ (cond
+ ((and (string-equal punct ".")
+ whitespace-p) ;end of sentence
+ (setq point (1- (point))))
+ ((and (string-equal punct ".")
+ (looking-at "[a-zA-Z0-9.]+")) ;possibly file extension
+ (setq point (match-end 0)))
+ (t
+ (setq point (point)))))
+ (goto-char opoint)
+ (when point
+ (goto-char point)
+ point))))
+
+(defun ffap-search-forward-file-end (&optional dir-separator)
+ "Search DIR-SEPARATOR and position point at file's maximum ending.
+This includes spaces.
+Optional DIR-SEPARATOR defaults to \"/\".
+Call `ffap-search-backward-file-end' to refine the ending point."
+ (unless dir-separator
+ (setq dir-separator "/"))
+ (let* ((chars ;expected chars in file name
+ (concat "[^][^<>()\"'`;,#*|"
+ ;; exclude the opposite as we know the separator
+ (if (string-equal dir-separator "/")
+ "\\\\"
+ "/")
+ "\t\r\n]"))
+ (re (concat
+ chars "*"
+ (if dir-separator
+ (regexp-quote dir-separator)
+ "/")
+ chars "*")))
+ (when (looking-at re)
+ (goto-char (match-end 0)))))
+
+(defun ffap-dir-separator-near-point ()
+ "Search backward and forward for closest slash or backlash in line.
+Return string slash or backslash. Point is moved to closest position."
+ (let ((point (point))
+ str pos)
+ (when (looking-at ".*?/")
+ (setq str "/"
+ pos (match-end 0)))
+ (when (and (looking-at ".*?\\\\")
+ (or (null pos)
+ (< (match-end 0) pos)))
+ (setq str "\\"
+ pos (match-end 0)))
+ (goto-char point)
+ (when (and (re-search-backward "/" (line-beginning-position) t)
+ (or (null pos)
+ (< (- point (point)) (- pos point))))
+ (setq str "/"
+ pos (1+ (point)))) ;1+ to keep cursor at the end of char
+ (goto-char point)
+ (when (and (re-search-backward "\\\\" (line-beginning-position) t)
+ (or (null pos)
+ (< (- point (point)) (- pos point))))
+ (setq str "\\"
+ pos (1+ (point))))
+ (when pos
+ (goto-char pos))
+ str))
+
(defun ffap-string-at-point (&optional mode)
"Return a string of characters from around point.
@@ -1126,7 +1241,8 @@ Set the variables `ffap-string-at-point' and
When the region is active and larger than `ffap-max-region-length',
return an empty string, and set `ffap-string-at-point-region' to '(1 1)."
- (let* ((args
+ (let* (dir-separator
+ (args
(cdr
(or (assq (or mode major-mode) ffap-string-at-point-mode-alist)
(assq 'file ffap-string-at-point-mode-alist))))
@@ -1135,14 +1251,25 @@ return an empty string, and set `ffap-string-at-point-region' to '(1 1)."
(beg (if region-selected
(region-beginning)
(save-excursion
- (skip-chars-backward (car args))
- (skip-chars-forward (nth 1 args) pt)
+ (if (and ffap-file-name-with-spaces
+ (memq mode '(nil file)))
+ (when (setq dir-separator (ffap-dir-separator-near-point))
+ (while (re-search-backward
+ (regexp-quote dir-separator)
+ (line-beginning-position) t)
+ (goto-char (match-beginning 0))))
+ (skip-chars-backward (car args))
+ (skip-chars-forward (nth 1 args) pt))
(point))))
(end (if region-selected
(region-end)
(save-excursion
(skip-chars-forward (car args))
(skip-chars-backward (nth 2 args) pt)
+ (when (and ffap-file-name-with-spaces
+ (memq mode '(nil file)))
+ (ffap-search-forward-file-end dir-separator)
+ (ffap-search-backward-file-end dir-separator))
(point))))
(region-len (- (max beg end) (min beg end))))
@@ -1607,7 +1734,7 @@ Each ALIST entry looks like (STRING . DATA) and defines one choice.
Function CONT is applied to the entry chosen by the user."
;; Note: this function is used with a different continuation
;; by the ffap-url add-on package.
- ;; Could try rewriting to use easymenu.el or lmenu.el.
+ ;; Could try rewriting to use easymenu.el.
(let (choice)
(cond
;; Emacs mouse:
@@ -1624,7 +1751,7 @@ Function CONT is applied to the entry chosen by the user."
;; Bug: prompting may assume unique strings, no "".
(setq choice
(completing-read
- (format "%s (default %s): " title (car (car alist)))
+ (format-prompt title (car (car alist)))
alist nil t
;; (cons (car (car alist)) 0)
nil)))
@@ -1758,6 +1885,14 @@ Only intended for interactive use."
(set-window-dedicated-p win wdp))
value))
+(defun ffap-other-tab (filename)
+ "Like `ffap', but put buffer in another tab.
+Only intended for interactive use."
+ (interactive (list (ffap-prompter nil " other tab")))
+ (pcase (save-window-excursion (find-file-at-point filename))
+ ((or (and (pred bufferp) b) `(,(and (pred bufferp) b) . ,_))
+ (switch-to-buffer-other-tab b))))
+
(defun ffap--toggle-read-only (buffer-or-list)
(dolist (buffer (if (listp buffer-or-list)
buffer-or-list
@@ -1791,6 +1926,14 @@ Only intended for interactive use."
(ffap--toggle-read-only value)
value))
+(defun ffap-read-only-other-tab (filename)
+ "Like `ffap', but put buffer in another tab and mark as read-only.
+Only intended for interactive use."
+ (interactive (list (ffap-prompter nil " read only other tab")))
+ (let ((value (window-buffer (ffap-other-tab filename))))
+ (ffap--toggle-read-only value)
+ value))
+
(defun ffap-alternate-file (filename)
"Like `ffap' and `find-alternate-file'.
Only intended for interactive use."
@@ -1815,12 +1958,6 @@ Only intended for interactive use."
(defalias 'find-file-literally-at-point 'ffap-literally)
-;;; Bug Reporter:
-
-(define-obsolete-function-alias 'ffap-bug 'report-emacs-bug "23.1")
-(define-obsolete-function-alias 'ffap-submit-bug 'report-emacs-bug "23.1")
-
-
;;; Hooks for Gnus, VM, Rmail:
;;
;; If you do not like these bindings, write versions with whatever
@@ -2013,6 +2150,7 @@ This hook is intended to be put in `file-name-at-point-functions'."
(global-set-key [remap find-file-other-window] 'ffap-other-window)
(global-set-key [remap find-file-other-frame] 'ffap-other-frame)
+ (global-set-key [remap find-file-other-tab] 'ffap-other-tab)
(global-set-key [remap find-file-read-only-other-window] 'ffap-read-only-other-window)
(global-set-key [remap find-file-read-only-other-frame] 'ffap-read-only-other-frame)
diff --git a/lisp/filecache.el b/lisp/filecache.el
index b2d3bea8aaf..00c53138032 100644
--- a/lisp/filecache.el
+++ b/lisp/filecache.el
@@ -614,9 +614,6 @@ the name is considered already unique; only the second substitution
(select-window (active-minibuffer-window))
(file-cache-minibuffer-complete nil)))
-(define-obsolete-function-alias 'file-cache-mouse-choose-completion
- #'file-cache-choose-completion "23.2")
-
(defun file-cache-complete ()
"Complete the word at point, using the filecache."
(interactive)
diff --git a/lisp/fileloop.el b/lisp/fileloop.el
index 668b9d4cd16..b778eca8e9b 100644
--- a/lisp/fileloop.el
+++ b/lisp/fileloop.el
@@ -4,18 +4,20 @@
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
-;; 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:
@@ -204,30 +206,34 @@ operating on the next file and nil otherwise."
;;;###autoload
(defun fileloop-initialize-replace (from to files case-fold &optional delimited)
"Initialize a new round of query&replace on several files.
- FROM is a regexp and TO is the replacement to use.
- FILES describes the files, as in `fileloop-initialize'.
- CASE-FOLD can be t, nil, or `default':
- if it is nil, matching of FROM is case-sensitive.
- if it is t, matching of FROM is case-insensitive, except
- when `search-upper-case' is non-nil and FROM includes
- upper-case letters.
- if it is `default', the function uses the value of
- `case-fold-search' instead.
- DELIMITED if non-nil means replace only word-delimited matches."
+FROM is a regexp and TO is the replacement to use.
+FILES describes the files, as in `fileloop-initialize'.
+CASE-FOLD can be t, nil, or `default':
+ if it is nil, matching of FROM is case-sensitive.
+ if it is t, matching of FROM is case-insensitive, except
+ when `search-upper-case' is non-nil and FROM includes
+ upper-case letters.
+ if it is `default', the function uses the value of
+ `case-fold-search' instead.
+DELIMITED if non-nil means replace only word-delimited matches."
;; FIXME: Not sure how the delimited-flag interacts with the regexp-flag in
;; `perform-replace', so I just try to mimic the old code.
- (fileloop-initialize
- files
- (lambda ()
- (let ((case-fold-search (fileloop--case-fold from case-fold)))
- (if (re-search-forward from nil t)
- ;; When we find a match, move back
- ;; to the beginning of it so perform-replace
- ;; will see it.
- (goto-char (match-beginning 0)))))
- (lambda ()
- (let ((case-fold-search (fileloop--case-fold from case-fold)))
- (perform-replace from to t t delimited nil multi-query-replace-map)))))
+ (let ((mstart (make-hash-table :test 'eq)))
+ (fileloop-initialize
+ files
+ (lambda ()
+ (let ((case-fold-search (fileloop--case-fold from case-fold)))
+ (when (re-search-forward from nil t)
+ ;; When we find a match, save its beginning for
+ ;; `perform-replace' (we used to just set point, but this
+ ;; is unreliable in the face of
+ ;; `switch-to-buffer-preserve-window-point').
+ (puthash (current-buffer) (match-beginning 0) mstart))))
+ (lambda ()
+ (let ((case-fold-search (fileloop--case-fold from case-fold)))
+ (perform-replace from to t t delimited nil multi-query-replace-map
+ (gethash (current-buffer) mstart (point-min))
+ (point-max)))))))
(provide 'fileloop)
;;; fileloop.el ends here
diff --git a/lisp/files-x.el b/lisp/files-x.el
index 5d863626fa5..911e7ba9e3d 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -45,9 +45,7 @@ Intended to be used in the `interactive' spec of
(symbol-name default)))
(variable
(completing-read
- (if default
- (format "%s (default %s): " prompt default)
- (format "%s: " prompt))
+ (format-prompt prompt default)
obarray
(lambda (sym)
(or (custom-variable-p sym)
@@ -65,9 +63,7 @@ Intended to be used in the `interactive' spec of
(let* ((default (and (symbolp major-mode) (symbol-name major-mode)))
(value
(completing-read
- (if default
- (format "Add %s with value (default %s): " variable default)
- (format "Add %s with value: " variable))
+ (format-prompt "Add %s with value" default variable)
obarray
(lambda (sym)
(string-match-p "-mode\\'" (symbol-name sym)))
@@ -79,11 +75,8 @@ Intended to be used in the `interactive' spec of
((eq variable 'coding)
(let ((default (and (symbolp buffer-file-coding-system)
(symbol-name buffer-file-coding-system))))
- (read-coding-system
- (if default
- (format "Add %s with value (default %s): " variable default)
- (format "Add %s with value: " variable))
- default)))
+ (read-coding-system (format-prompt "Add %s with value" default variable)
+ default)))
(t
(let ((default (format "%S"
(cond ((eq variable 'unibyte) t)
@@ -102,9 +95,7 @@ Intended to be used in the `interactive' spec of
(let* ((default (and (symbolp major-mode) (symbol-name major-mode)))
(mode
(completing-read
- (if default
- (format "Mode or subdirectory (default %s): " default)
- (format "Mode or subdirectory: "))
+ (format-prompt "Mode or subdirectory" default)
obarray
(lambda (sym)
(and (string-match-p "-mode\\'" (symbol-name sym))
diff --git a/lisp/files.el b/lisp/files.el
index 3e4ad7c0d44..c2c58dae934 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -405,7 +405,7 @@ editing a remote file.
On MS-DOS filesystems without long names this variable is always
ignored."
:group 'auto-save
- :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")
+ :type '(repeat (list (regexp :tag "Regexp") (string :tag "Replacement")
(boolean :tag "Uniquify")))
:initialize 'custom-initialize-delay
:version "21.1")
@@ -430,7 +430,13 @@ idle for `auto-save-visited-interval' seconds."
Unlike `auto-save-mode', this mode will auto-save buffer contents
to the visited files directly and will also run all save-related
-hooks. See Info node `Saving' for details of the save process."
+hooks. See Info node `Saving' for details of the save process.
+
+You can also set the buffer-local value of the variable
+`auto-save-visited-mode' to nil. A buffer where the buffer-local
+value of this variable is nil is ignored for the purpose of
+`auto-save-visited-mode', even if `auto-save-visited-mode' is
+enabled."
:group 'auto-save
:global t
(when auto-save--timer (cancel-timer auto-save--timer))
@@ -441,6 +447,7 @@ hooks. See Info node `Saving' for details of the save process."
#'save-some-buffers :no-prompt
(lambda ()
(and buffer-file-name
+ auto-save-visited-mode
(not (and buffer-auto-save-file-name
auto-save-visited-file-name))))))))
@@ -745,10 +752,16 @@ resulting list of directory names. For an empty path element (i.e.,
a leading or trailing separator, or two adjacent separators), return
nil (meaning `default-directory') as the associated list element."
(when (stringp search-path)
- (mapcar (lambda (f)
- (if (equal "" f) nil
- (substitute-in-file-name (file-name-as-directory f))))
- (split-string search-path path-separator))))
+ (let ((spath (substitute-env-vars search-path)))
+ (mapcar (lambda (f)
+ (if (equal "" f) nil
+ (let ((dir (expand-file-name (file-name-as-directory f))))
+ ;; Previous implementation used `substitute-in-file-name'
+ ;; which collapse multiple "/" in front. Do the same for
+ ;; backward compatibility.
+ (if (string-match "\\`/+" dir)
+ (substring dir (1- (match-end 0))) dir))))
+ (split-string spath path-separator)))))
(defun cd-absolute (dir)
"Change current directory to given absolute file name DIR."
@@ -972,14 +985,6 @@ one or more of those symbols."
(completion-table-with-context
string-dir names string-file pred action)))))
-(defun locate-file-completion (string path-and-suffixes action)
- "Do completion for file names passed to `locate-file'.
-PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
- (declare (obsolete locate-file-completion-table "23.1"))
- (locate-file-completion-table (car path-and-suffixes)
- (cdr path-and-suffixes)
- string nil action))
-
(defvar locate-dominating-stop-dir-regexp
(purecopy "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'")
"Regexp of directory names that stop the search in `locate-dominating-file'.
@@ -1094,6 +1099,8 @@ REMOTE is non-nil, search on the remote host indicated by
(let ((default-directory (file-name-quote default-directory 'top)))
(locate-file command exec-path exec-suffixes 1))))
+(declare-function read-library-name "find-func" nil)
+
(defun load-library (library)
"Load the Emacs Lisp library named LIBRARY.
LIBRARY should be a string.
@@ -1103,12 +1110,7 @@ well as `load-file-rep-suffixes').
See Info node `(emacs)Lisp Libraries' for more details.
See `load-file' for a different interface to `load'."
- (interactive
- (let (completion-ignored-extensions)
- (list (completing-read "Load library: "
- (apply-partially 'locate-file-completion-table
- load-path
- (get-load-suffixes))))))
+ (interactive (list (read-library-name)))
(load library))
(defun file-remote-p (file &optional identification connected)
@@ -1390,7 +1392,7 @@ it means chase no more than that many links and then stop."
newname))
;; A handy function to display file sizes in human-readable form.
-;; See http://en.wikipedia.org/wiki/Kibibyte for the reference.
+;; See https://en.wikipedia.org/wiki/Kibibyte for the reference.
(defun file-size-human-readable (file-size &optional flavor space unit)
"Produce a string showing FILE-SIZE in human-readable form.
@@ -1561,8 +1563,8 @@ use with M-x."
(and (not (memq 'eight-bit-control charsets))
(not (memq 'eight-bit-graphic charsets)))))
(setq from-coding (read-coding-system
- (format "Recode filename %s from (default %s): "
- filename default-coding)
+ (format-prompt "Recode filename %s from"
+ filename default-coding)
default-coding))
(setq from-coding (read-coding-system
(format "Recode filename %s from: " filename))))
@@ -1574,8 +1576,8 @@ use with M-x."
(format "Recode filename %s from %s to: "
filename from-coding)))
(setq to-coding (read-coding-system
- (format "Recode filename %s from %s to (default %s): "
- filename from-coding default-coding)
+ (format-prompt "Recode filename %s from %s to"
+ default-coding filename from-coding)
default-coding)))
(list filename from-coding to-coding)))
@@ -1917,6 +1919,8 @@ killed."
(setq buffer-file-truename otrue)
(setq dired-directory odir)
(lock-buffer)
+ (if (get-buffer oname)
+ (kill-buffer oname))
(rename-buffer oname)))
(unless (eq (current-buffer) obuf)
(with-current-buffer obuf
@@ -2660,6 +2664,13 @@ since only a single case-insensitive search through the alist is made."
("\\.ltx\\'" . latex-mode)
("\\.dtx\\'" . doctex-mode)
("\\.org\\'" . org-mode)
+ ;; .dir-locals.el is not really Elisp. Could use the
+ ;; `dir-locals-file' constant if it weren't defined below.
+ ("\\.dir-locals\\(?:-2\\)?\\.el\\'" . lisp-data-mode)
+ ("eww-bookmarks\\'" . lisp-data-mode)
+ ("tramp\\'" . lisp-data-mode)
+ ("places\\'" . lisp-data-mode)
+ ("\\.emacs-places\\'" . lisp-data-mode)
("\\.el\\'" . emacs-lisp-mode)
("Project\\.ede\\'" . emacs-lisp-mode)
("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
@@ -2670,8 +2681,6 @@ since only a single case-insensitive search through the alist is made."
("\\.p\\'" . pascal-mode)
("\\.pas\\'" . pascal-mode)
("\\.\\(dpr\\|DPR\\)\\'" . delphi-mode)
- ("\\.ad[abs]\\'" . ada-mode)
- ("\\.ad[bs]\\.dg\\'" . ada-mode)
("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
("Imakefile\\'" . makefile-imake-mode)
("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk
@@ -3058,7 +3067,7 @@ If FUNCTION is nil, then it is not called. (That is a way of saying
"\\(?:!DOCTYPE[ \t\r\n]+[^>]*>[ \t\r\n]*<[ \t\r\n]*" comment-re "*\\)?"
"[Hh][Tt][Mm][Ll]"))
. mhtml-mode)
- ("<!DOCTYPE[ \t\r\n]+[Hh][Tt][Mm][Ll]" . mhtml-mode)
+ ("<![Dd][Oo][Cc][Tt][Yy][Pp][Ee][ \t\r\n]+[Hh][Tt][Mm][Ll]" . mhtml-mode)
;; These two must come after html, because they are more general:
("<\\?xml " . xml-mode)
(,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
@@ -4674,6 +4683,7 @@ BACKUPNAME is the backup file name, which is the old file renamed."
;; Create temp files with strict access rights. It's easy to
;; loosen them later, whereas it's impossible to close the
;; time-window of loose permissions otherwise.
+ (let (nofollow-flag)
(with-file-modes ?\700
(when (condition-case nil
;; Try to overwrite old backup first.
@@ -4684,6 +4694,7 @@ BACKUPNAME is the backup file name, which is the old file renamed."
(when (file-exists-p to-name)
(delete-file to-name))
(copy-file from-name to-name nil t t)
+ (setq nofollow-flag 'nofollow)
nil)
(file-already-exists t))
;; The file was somehow created by someone else between
@@ -4696,7 +4707,7 @@ BACKUPNAME is the backup file name, which is the old file renamed."
(with-demoted-errors
(set-file-extended-attributes to-name extended-attributes)))
(and modes
- (set-file-modes to-name (logand modes #o1777)))))
+ (set-file-modes to-name (logand modes #o1777) nofollow-flag)))))
(defvar file-name-version-regexp
"\\(?:~\\|\\.~[-[:alnum:]:#@^._]+\\(?:~[[:digit:]]+\\)?~\\)"
@@ -5555,10 +5566,28 @@ change the additional actions you can take on files."
t
(setq queried t)
(if (buffer-file-name buffer)
- (format "Save file %s? "
- (buffer-file-name buffer))
- (format "Save buffer %s? "
- (buffer-name buffer))))))
+ (if (or
+ (equal (buffer-name buffer)
+ (file-name-nondirectory
+ (buffer-file-name buffer)))
+ (string-match
+ (concat "\\<"
+ (regexp-quote
+ (file-name-nondirectory
+ (buffer-file-name buffer)))
+ "<[^>]*>\\'")
+ (buffer-name buffer)))
+ ;; The buffer name is similar to the
+ ;; file name.
+ (format "Save file %s? "
+ (buffer-file-name buffer))
+ ;; The buffer and file names are
+ ;; dissimilar; display both.
+ (format "Save file %s (buffer %s)? "
+ (buffer-file-name buffer)
+ (buffer-name buffer)))
+ ;; No file name
+ (format "Save buffer %s? " (buffer-name buffer))))))
(lambda (buffer)
(with-current-buffer buffer
(save-buffer)))
@@ -5644,25 +5673,28 @@ like `write-region' does."
(defun file-newest-backup (filename)
"Return most recent backup file for FILENAME or nil if no backups exist."
+ (car (file-backup-file-names filename)))
+
+(defun file-backup-file-names (filename)
+ "Return a list of backup files for FILENAME.
+The list will be sorted by modification time so that the most
+recent files are first."
;; `make-backup-file-name' will get us the right directory for
;; ordinary or numeric backups. It might create a directory for
;; backups as a side-effect, according to `backup-directory-alist'.
(let* ((filename (file-name-sans-versions
(make-backup-file-name (expand-file-name filename))))
- (file (file-name-nondirectory filename))
- (dir (file-name-directory filename))
- (comp (file-name-all-completions file dir))
- (newest nil)
- tem)
- (while comp
- (setq tem (pop comp))
- (cond ((and (backup-file-name-p tem)
- (string= (file-name-sans-versions tem) file))
- (setq tem (concat dir tem))
- (if (or (null newest)
- (file-newer-than-file-p tem newest))
- (setq newest tem)))))
- newest))
+ (dir (file-name-directory filename)))
+ (sort
+ (seq-filter
+ (lambda (candidate)
+ (and (backup-file-name-p candidate)
+ (string= (file-name-sans-versions candidate) filename)))
+ (mapcar
+ (lambda (file)
+ (concat dir file))
+ (file-name-all-completions (file-name-nondirectory filename) dir)))
+ #'file-newer-than-file-p)))
(defun rename-uniquely ()
"Rename current buffer to a similar name not already taken.
@@ -5755,7 +5787,10 @@ If called interactively, then PARENTS is non-nil."
(defconst directory-files-no-dot-files-regexp
"[^.]\\|\\.\\.\\."
- "Regexp matching any file name except \".\" and \"..\".")
+ "Regexp matching any file name except \".\" and \"..\".
+More precisely, it matches parts of any nonempty string except those two.
+It is useful as the regexp argument to `directory-files' and
+`directory-files-and-attributes'.")
(defun files--force (no-such fn &rest args)
"Use NO-SUCH to affect behavior of function FN applied to list ARGS.
@@ -5880,9 +5915,9 @@ last-modified time as the old ones. (This works on only some systems.)
A prefix arg makes KEEP-TIME non-nil.
-Noninteractively, the last argument PARENTS says whether to
-create parent directories if they don't exist. Interactively,
-this happens by default.
+Noninteractively, the PARENTS argument says whether to create
+parent directories if they don't exist. Interactively, this
+happens by default.
If NEWNAME is a directory name, copy DIRECTORY as a subdirectory
there. However, if called from Lisp with a non-nil optional
@@ -5902,7 +5937,8 @@ into NEWNAME instead."
;; If default-directory is a remote directory, make sure we find its
;; copy-directory handler.
(let ((handler (or (find-file-name-handler directory 'copy-directory)
- (find-file-name-handler newname 'copy-directory))))
+ (find-file-name-handler newname 'copy-directory)))
+ (follow parents))
(if handler
(funcall handler 'copy-directory directory
newname keep-time parents copy-contents)
@@ -5922,7 +5958,8 @@ into NEWNAME instead."
(or parents (not (file-directory-p newname)))
(setq newname (concat newname
(file-name-nondirectory directory))))
- (make-directory (directory-file-name newname) parents)))
+ (make-directory (directory-file-name newname) parents))
+ (t (setq follow t)))
;; Copy recursively.
(dolist (file
@@ -5942,9 +5979,10 @@ into NEWNAME instead."
;; Set directory attributes.
(let ((modes (file-modes directory))
(times (and keep-time (file-attribute-modification-time
- (file-attributes directory)))))
- (if modes (set-file-modes newname modes))
- (if times (set-file-times newname times))))))
+ (file-attributes directory))))
+ (follow-flag (unless follow 'nofollow)))
+ (if modes (set-file-modes newname modes follow-flag))
+ (if times (set-file-times newname times follow-flag))))))
;; At time of writing, only info uses this.
@@ -6216,6 +6254,82 @@ an auto-save file."
(insert-file-contents file-name (not auto-save-p)
nil nil t))))))
+(defvar revert-buffer-with-fine-grain-max-seconds 2.0
+ "Maximum time that `revert-buffer-with-fine-grain' should use.
+The command tries to preserve markers, properties and overlays.
+If the operation takes more than this time, a single
+delete+insert is performed. Actually, this value is passed as
+the MAX-SECS argument to the function `replace-buffer-contents',
+so it is not ensured that the whole execution won't take longer.
+See `replace-buffer-contents' for more details.")
+
+(defun revert-buffer-insert-file-contents-delicately (file-name _auto-save-p)
+ "Optional function for `revert-buffer-insert-file-contents-function'.
+The function `revert-buffer-with-fine-grain' uses this function by binding
+`revert-buffer-insert-file-contents-function' to it.
+
+As with `revert-buffer-insert-file-contents--default-function', FILE-NAME is
+the name of the file and AUTO-SAVE-P is non-nil if this is an auto-save file.
+Since calling `replace-buffer-contents' can take a long time, depending of
+the number of changes made to the buffer, it uses the value of the variable
+`revert-buffer-with-fine-grain-max-seconds' as a maximum time to try delicately
+reverting the buffer. If it fails, it does a delete+insert. For more details,
+see `replace-buffer-contents'."
+ (cond
+ ((not (file-exists-p file-name))
+ (error (if buffer-file-number
+ "File %s no longer exists"
+ "Cannot revert nonexistent file %s")
+ file-name))
+ ((not (file-readable-p file-name))
+ (error (if buffer-file-number
+ "File %s no longer readable"
+ "Cannot revert unreadable file %s")
+ file-name))
+ (t
+ (let* ((buf (current-buffer)) ; current-buffer is the buffer to revert.
+ (success
+ (save-excursion
+ (save-restriction
+ (widen)
+ (with-temp-buffer
+ (insert-file-contents file-name)
+ (let ((temp-buf (current-buffer)))
+ (set-buffer buf)
+ (let ((buffer-file-name nil))
+ (replace-buffer-contents
+ temp-buf
+ revert-buffer-with-fine-grain-max-seconds))))))))
+ ;; 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))))
+
+(defun revert-buffer-with-fine-grain (&optional ignore-auto noconfirm)
+ "Revert buffer preserving markers, overlays, etc.
+This command is an alternative to `revert-buffer' because it tries to be as
+non-destructive as possible, preserving markers, properties and overlays.
+Binds `revert-buffer-insert-file-contents-function' to the function
+`revert-buffer-insert-file-contents-delicately'.
+
+With a prefix argument, offer to revert from latest auto-save file. For more
+details on the arguments, see `revert-buffer'."
+ ;; See revert-buffer for an explanation of this.
+ (interactive (list (not current-prefix-arg)))
+ ;; Simply bind revert-buffer-insert-file-contents-function to the specialized
+ ;; function, and call revert-buffer.
+ (let ((revert-buffer-insert-file-contents-function
+ #'revert-buffer-insert-file-contents-delicately))
+ (revert-buffer ignore-auto noconfirm t)
+ ;; This closure is defined in revert-buffer-insert-file-contents-function.
+ ;; It is needed because revert-buffer--default always returns t after
+ ;; reverting, and it might be needed to report the success/failure of
+ ;; reverting delicately.
+ (when (fboundp 'revert-buffer-with-fine-grain-success-p)
+ (prog1
+ (revert-buffer-with-fine-grain-success-p)
+ (fmakunbound 'revert-buffer-with-fine-grain-success-p)))))
+
(defun recover-this-file ()
"Recover the visited file--get contents from its last auto-save file."
(interactive)
@@ -6445,7 +6559,7 @@ Also rename any existing auto save file, if it was made in this session."
(defun make-auto-save-file-name ()
"Return file name to use for auto-saves of current buffer.
Does not consider `auto-save-visited-file-name' as that variable is checked
-before calling this function. You can redefine this for customization.
+before calling this function.
See also `auto-save-file-name-p'."
(if buffer-file-name
(let ((handler (find-file-name-handler buffer-file-name
@@ -6552,7 +6666,8 @@ See also `auto-save-file-name-p'."
(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. You can redefine this for customization."
+FILENAME should lack slashes.
+See also `make-auto-save-file-name'."
(string-match "\\`#.*#\\'" filename))
(defun wildcard-to-regexp (wildcard)
@@ -6775,9 +6890,7 @@ We assume the output has the format of `df'.
The value of this variable must be just a command name or file name;
if you want to specify options, use `directory-free-space-args'.
-A value of nil disables this feature.
-
-This variable is obsolete; Emacs no longer uses it."
+A value of nil disables this feature."
:type '(choice (string :tag "Program") (const :tag "None" nil))
:group 'dired)
(make-obsolete-variable 'directory-free-space-program
@@ -7031,6 +7144,8 @@ normally equivalent short `-D' option is just passed on to
((stringp switches) (concat switches " -d"))
((member "-d" switches) switches)
(t (append switches '("-d"))))))
+ (if (string-match "\\`~" file)
+ (setq file (expand-file-name file)))
(apply 'call-process
insert-directory-program nil t nil
(append
@@ -7041,14 +7156,7 @@ normally equivalent short `-D' option is just passed on to
(split-string-and-unquote switches)))
;; Avoid lossage if FILE starts with `-'.
'("--")
- (progn
- (if (string-match "\\`~" file)
- (setq file (expand-file-name file)))
- (list
- (if full-directory-p
- ;; (concat (file-name-as-directory file) ".")
- file
- file))))))))
+ (list file))))))
;; If we got "//DIRED//" in the output, it means we got a real
;; directory listing, even if `ls' returned nonzero.
@@ -7250,10 +7358,15 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
(setq active t))
(setq processes (cdr processes)))
(or (not active)
- (with-displayed-buffer-window
+ (with-current-buffer-window
(get-buffer-create "*Process List*")
- '(display-buffer--maybe-at-bottom
- (dedicated . t))
+ `(display-buffer--maybe-at-bottom
+ (dedicated . t)
+ (window-height . fit-window-to-buffer)
+ (preserve-size . (nil . t))
+ (body-function
+ . ,#'(lambda (_window)
+ (list-processes t))))
#'(lambda (window _value)
(with-selected-window window
(unwind-protect
@@ -7261,8 +7374,7 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
(setq confirm nil)
(yes-or-no-p "Active processes exist; kill them and exit anyway? "))
(when (window-live-p window)
- (quit-restore-window window 'kill)))))
- (list-processes t)))))
+ (quit-restore-window window 'kill)))))))))
;; Query the user for other things, perhaps.
(run-hook-with-args-until-failure 'kill-emacs-query-functions)
(or (null confirm)
@@ -7536,6 +7648,27 @@ as in \"og+rX-w\"."
op char-right)))
num-rights))
+(defun file-modes-number-to-symbolic (mode)
+ (string
+ (if (zerop (logand 8192 mode))
+ (if (zerop (logand 16384 mode)) ?- ?d)
+ ?c) ; completeness
+ (if (zerop (logand 256 mode)) ?- ?r)
+ (if (zerop (logand 128 mode)) ?- ?w)
+ (if (zerop (logand 64 mode))
+ (if (zerop (logand 2048 mode)) ?- ?S)
+ (if (zerop (logand 2048 mode)) ?x ?s))
+ (if (zerop (logand 32 mode)) ?- ?r)
+ (if (zerop (logand 16 mode)) ?- ?w)
+ (if (zerop (logand 8 mode))
+ (if (zerop (logand 1024 mode)) ?- ?S)
+ (if (zerop (logand 1024 mode)) ?x ?s))
+ (if (zerop (logand 4 mode)) ?- ?r)
+ (if (zerop (logand 2 mode)) ?- ?w)
+ (if (zerop (logand 512 mode))
+ (if (zerop (logand 1 mode)) ?- ?x)
+ (if (zerop (logand 1 mode)) ?T ?t))))
+
(defun file-modes-symbolic-to-number (modes &optional from)
"Convert symbolic file modes to numeric file modes.
MODES is the string to convert, it should match
@@ -7643,7 +7776,7 @@ Otherwise, trash FILENAME using the freedesktop.org conventions,
(let (delete-by-moving-to-trash)
(rename-file fn new-fn))))
;; Otherwise, use the freedesktop.org method, as specified at
- ;; http://freedesktop.org/wiki/Specifications/trash-spec
+ ;; https://freedesktop.org/wiki/Specifications/trash-spec
(t
(let* ((xdg-data-dir
(directory-file-name
diff --git a/lisp/filesets.el b/lisp/filesets.el
index c43c468ead3..4f23faa2203 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -1645,10 +1645,10 @@ Replace <file-name> or <<file-name>> with filename."
(dolist (this args txt)
(setq txt
(concat txt
+ (if (equal txt "") "" " ")
(filesets-run-cmd--repl-fn
this
(lambda (this)
- (if (equal txt "") "" " ")
(format "%s" this))))))))
(cmd (concat fn " " args)))
(filesets-cmd-show-result
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index a96c6c9edbb..18330d821ce 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -85,8 +85,8 @@ the options \"-dilsb\".
While the option `find -ls' often produces unsorted output, the option
`find -exec ls -ld' maintains the sorting order only on short output,
-whereas `find -print | sort | xargs' produced sorted output even
-on the large number of files."
+whereas `find -print | sort | xargs' produces sorted output even
+on a large number of files."
:version "27.1" ; add choice of predefined set of options
:type `(choice
(cons :tag "find -ls"
@@ -164,7 +164,10 @@ The command run (after changing into DIR) is essentially
find . \\( ARGS \\) -ls
except that the car of the variable `find-ls-option' specifies what to
-use in place of \"-ls\" as the final argument."
+use in place of \"-ls\" as the final argument.
+
+Collect output in the \"*Find*\" buffer. To kill the job before
+it finishes, type \\[kill-find]."
(interactive (list (read-directory-name "Run find in directory: " nil "" t)
(read-string "Run find (with args): " find-args
'(find-args-history . 1))))
@@ -215,7 +218,6 @@ use in place of \"-ls\" as the final argument."
(car find-ls-option))))
;; Start the find process.
(shell-command (concat args "&") (current-buffer))
- ;; The next statement will bomb in classic dired (no optional arg allowed)
(dired-mode dir (cdr find-ls-option))
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (current-local-map))
@@ -247,8 +249,8 @@ use in place of \"-ls\" as the final argument."
(dired-insert-set-properties point (point)))
(setq buffer-read-only t)
(let ((proc (get-buffer-process (current-buffer))))
- (set-process-filter proc (function find-dired-filter))
- (set-process-sentinel proc (function find-dired-sentinel))
+ (set-process-filter proc #'find-dired-filter)
+ (set-process-sentinel proc #'find-dired-sentinel)
;; Initialize the process marker; it is used by the filter.
(move-marker (process-mark proc) (point) (current-buffer)))
(setq mode-line-process '(":%s"))))
@@ -258,7 +260,7 @@ use in place of \"-ls\" as the final argument."
(interactive)
(let ((find (get-buffer-process (current-buffer))))
(and find (eq (process-status find) 'run)
- (eq (process-filter find) (function find-dired-filter))
+ (eq (process-filter find) #'find-dired-filter)
(condition-case nil
(delete-process find)
(error nil)))))
diff --git a/lisp/finder.el b/lisp/finder.el
index 71f8ac740ee..820d6d0a3b9 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -197,7 +197,7 @@ from; the default is `load-path'."
(cons d f))
(directory-files d nil el-file-regexp))))
(progress (make-progress-reporter
- (byte-compile-info-string "Scanning files for finder")
+ (byte-compile-info "Scanning files for finder")
0 (length files)))
package-override base-name ; processed
summary keywords package version entry desc)
@@ -394,13 +394,6 @@ FILE should be in a form suitable for passing to `locate-library'."
(erase-buffer)
(insert str)
(goto-char (point-min))
- (delete-blank-lines)
- (goto-char (point-max))
- (delete-blank-lines)
- (goto-char (point-min))
- (while (re-search-forward "^;+ ?" nil t)
- (replace-match "" nil nil))
- (goto-char (point-min))
(while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t)
(if (locate-library (match-string 1))
(make-text-button (match-beginning 1) (match-end 1)
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 30edebb4e68..e708e69bd59 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -51,7 +51,7 @@
;; also the variable `font-lock-maximum-size'. Support modes for Font Lock
;; mode can be used to speed up Font Lock mode. See `font-lock-support-mode'.
-;;; How Font Lock mode fontifies:
+;;;; How Font Lock mode fontifies:
;; When Font Lock mode is turned on in a buffer, it (a) fontifies the entire
;; buffer and (b) installs one of its fontification functions on one of the
@@ -96,7 +96,7 @@
;; some syntactic parsers for common languages and a son-of-font-lock.el could
;; use them rather then relying so heavily on the keyword (regexp) pass.
-;;; How Font Lock mode supports modes or is supported by modes:
+;;;; How Font Lock mode supports modes or is supported by modes:
;; Modes that support Font Lock mode do so by defining one or more variables
;; whose values specify the fontification. Font Lock mode knows of these
@@ -112,7 +112,7 @@
;; Font Lock mode fontification behavior can be modified in a number of ways.
;; See the below comments and the comments distributed throughout this file.
-;;; Constructing patterns:
+;;;; Constructing patterns:
;; See the documentation for the variable `font-lock-keywords'.
;;
@@ -120,7 +120,7 @@
;; `font-lock-syntactic-keywords' can be generated via the function
;; `regexp-opt'.
-;;; Adding patterns for modes that already support Font Lock:
+;;;; Adding patterns for modes that already support Font Lock:
;; Though Font Lock highlighting patterns already exist for many modes, it's
;; likely there's something that you want fontified that currently isn't, even
@@ -135,7 +135,7 @@
;; other variables. For example, additional C types can be specified via the
;; variable `c-font-lock-extra-types'.
-;;; Adding patterns for modes that do not support Font Lock:
+;;;; Adding patterns for modes that do not support Font Lock:
;; Not all modes support Font Lock mode. If you (as a user of the mode) add
;; patterns for a new mode, you must define in your ~/.emacs a variable or
@@ -155,7 +155,7 @@
;; (set (make-local-variable 'font-lock-defaults)
;; '(foo-font-lock-keywords t))))
-;;; Adding Font Lock support for modes:
+;;;; Adding Font Lock support for modes:
;; Of course, it would be better that the mode already supports Font Lock mode.
;; The package author would do something similar to above. The mode must
@@ -575,6 +575,7 @@ This is normally set via `font-lock-defaults'.")
"Non-nil means use this syntax table for fontifying.
If this is nil, the major mode's syntax table is used.
This is normally set via `font-lock-defaults'.")
+(defvar-local font-lock--syntax-table-affects-ppss nil)
(defvar font-lock-mark-block-function nil
"Non-nil means use this function to mark a block of text.
@@ -985,7 +986,7 @@ The value of this variable is used when Font Lock mode is turned on."
((bound-and-true-p lazy-lock-mode)
(lazy-lock-after-unfontify-buffer))))
-;;; End of Font Lock Support mode.
+;; End of Font Lock Support mode.
;;; Fontification functions.
@@ -1120,9 +1121,10 @@ locking for a mode, and is not meant to be called from lisp functions."
"Make sure the region BEG...END has been fontified.
If the region is not specified, it defaults to the entire accessible
portion of the buffer."
- (font-lock-set-defaults)
- (funcall font-lock-ensure-function
- (or beg (point-min)) (or end (point-max))))
+ (when (font-lock-specified-p t)
+ (font-lock-set-defaults)
+ (funcall font-lock-ensure-function
+ (or beg (point-min)) (or end (point-max)))))
(defun font-lock-default-fontify-buffer ()
"Fontify the whole buffer using `font-lock-fontify-region-function'."
@@ -1391,7 +1393,7 @@ delimit the region to fontify."
(font-lock-fontify-region (point) (mark)))
((error quit) (message "Fontifying block...%s" error-data)))))))
-;;; End of Fontification functions.
+;; End of Fontification functions.
;;; Additional text property functions.
@@ -1483,7 +1485,7 @@ Optional argument OBJECT is the string or buffer containing the text."
(put-text-property start next prop new object))))))
(setq start (text-property-not-all next end prop nil object)))))
-;;; End of Additional text property functions.
+;; End of Additional text property functions.
;;; Syntactic regexp fontification functions.
@@ -1589,7 +1591,7 @@ START should be at the beginning of a line."
(setq highlights (cdr highlights))))
(setq keywords (cdr keywords)))))
-;;; End of Syntactic regexp fontification functions.
+;; End of Syntactic regexp fontification functions.
;;; Syntactic fontification functions.
@@ -1609,7 +1611,15 @@ START should be at the beginning of a line."
(regexp-quote
(replace-regexp-in-string "^ *" "" comment-end))))
;; Find the `start' state.
- (state (syntax-ppss start))
+ (state (if (or syntax-ppss-table
+ (not font-lock--syntax-table-affects-ppss))
+ (syntax-ppss start)
+ ;; If `syntax-ppss' doesn't have its own syntax-table and
+ ;; we have installed our own syntax-table which
+ ;; differs from the standard one in ways which affects PPSS,
+ ;; then we can't use `syntax-ppss' since that would pollute
+ ;; and be polluted by its cache.
+ (parse-partial-sexp (point-min) start)))
face beg)
(if loudly (message "Fontifying %s... (syntactically...)" (buffer-name)))
;;
@@ -1640,7 +1650,7 @@ START should be at the beginning of a line."
(setq state (parse-partial-sexp (point) end nil nil state
'syntax-table))))))
-;;; End of Syntactic fontification functions.
+;; End of Syntactic fontification functions.
;;; Keyword regexp fontification functions.
@@ -1774,9 +1784,9 @@ LOUDLY, if non-nil, allows progress-meter bar."
(setq keywords (cdr keywords)))
(set-marker pos nil)))
-;;; End of Keyword regexp fontification functions.
+;; End of Keyword regexp fontification functions.
-;; Various functions.
+;;; Various functions.
(defun font-lock-compile-keywords (keywords &optional syntactic-keywords)
"Compile KEYWORDS into the form (t KEYWORDS COMPILED...)
@@ -1906,6 +1916,7 @@ Sets various variables using `font-lock-defaults' and
;; Case fold during regexp fontification?
(setq-local font-lock-keywords-case-fold-search (nth 2 defaults))
;; Syntax table for regexp and syntactic fontification?
+ (kill-local-variable 'font-lock--syntax-table-affects-ppss)
(if (null (nth 3 defaults))
(setq-local font-lock-syntax-table nil)
(setq-local font-lock-syntax-table (copy-syntax-table (syntax-table)))
@@ -1915,7 +1926,14 @@ Sets various variables using `font-lock-defaults' and
(dolist (char (if (numberp (car selem))
(list (car selem))
(mapcar #'identity (car selem))))
- (modify-syntax-entry char syntax font-lock-syntax-table)))))
+ (unless (memq (car (aref font-lock-syntax-table char))
+ '(1 2 3)) ;"." "w" "_"
+ (setq font-lock--syntax-table-affects-ppss t))
+ (modify-syntax-entry char syntax font-lock-syntax-table)
+ (unless (memq (car (aref font-lock-syntax-table char))
+ '(1 2 3)) ;"." "w" "_"
+ (setq font-lock--syntax-table-affects-ppss t))
+ ))))
;; (nth 4 defaults) used to hold `font-lock-beginning-of-syntax-function',
;; but that was removed in 25.1, so if it's a cons cell, we assume that
;; it's part of the variable alist.
@@ -2084,7 +2102,7 @@ Sets various variables using `font-lock-defaults' and
"Font Lock mode face used to highlight grouping constructs in Lisp regexps."
:group 'font-lock-faces)
-;;; End of Color etc. support.
+;; End of Color etc. support.
;;; Menu support.
@@ -2186,7 +2204,7 @@ Sets various variables using `font-lock-defaults' and
;; ;; Deactivate less/more fontification entries.
;; (setq font-lock-fontify-level nil))
-;;; End of Menu support.
+;; End of Menu support.
;;; Various regexp information shared by several modes.
;; ;; Information specific to a single mode should go in its load library.
diff --git a/lisp/format-spec.el b/lisp/format-spec.el
index 9278bd74c42..6af79a44167 100644
--- a/lisp/format-spec.el
+++ b/lisp/format-spec.el
@@ -1,4 +1,4 @@
-;;; format-spec.el --- functions for formatting arbitrary formatting strings
+;;; format-spec.el --- format arbitrary formatting strings -*- lexical-binding: t -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -24,10 +24,8 @@
;;; Code:
-(eval-when-compile
- (require 'subr-x))
-
-(defun format-spec (format specification &optional only-present)
+;;;###autoload
+(defun format-spec (format specification &optional ignore-missing)
"Return a string based on FORMAT and SPECIFICATION.
FORMAT is a string containing `format'-like specs like \"su - %u %k\".
SPECIFICATION is an alist mapping format specification characters
@@ -39,22 +37,22 @@ For instance:
\\=`((?u . ,(user-login-name))
(?l . \"ls\")))
-Each %-spec may contain optional flag and width modifiers, as
-follows:
+Each %-spec may contain optional flag, width, and precision
+modifiers, as follows:
- %<flags><width>character
+ %<flags><width><precision>character
The following flags are allowed:
* 0: Pad to the width, if given, with zeros instead of spaces.
* -: Pad to the width, if given, on the right instead of the left.
-* <: Truncate to the width, if given, on the left.
-* >: Truncate to the width, if given, on the right.
+* <: Truncate to the width and precision, if given, on the left.
+* >: Truncate to the width and precision, if given, on the right.
* ^: Convert to upper case.
* _: Convert to lower case.
-The width modifier behaves like the corresponding one in `format'
-when applied to %s.
+The width and truncation modifiers behave like the corresponding
+ones in `format' when applied to %s.
For example, \"%<010b\" means \"substitute into the output the
value associated with ?b in SPECIFICATION, either padding it with
@@ -64,89 +62,108 @@ characters wide\".
Any text properties of FORMAT are copied to the result, with any
text properties of a %-spec itself copied to its substitution.
-ONLY-PRESENT indicates how to handle %-spec characters not
+IGNORE-MISSING indicates how to handle %-spec characters not
present in SPECIFICATION. If it is nil or omitted, emit an
-error; otherwise leave those %-specs and any occurrences of
-\"%%\" in FORMAT verbatim in the result, including their text
-properties, if any."
+error; if it is the symbol `ignore', leave those %-specs verbatim
+in the result, including their text properties, if any; if it is
+the symbol `delete', remove those %-specs from the result;
+otherwise do the same as for the symbol `ignore', but also leave
+any occurrences of \"%%\" in FORMAT verbatim in the result."
(with-temp-buffer
(insert format)
(goto-char (point-min))
(while (search-forward "%" nil t)
(cond
- ;; Quoted percent sign.
- ((eq (char-after) ?%)
- (unless only-present
- (delete-char 1)))
- ;; Valid format spec.
- ((looking-at "\\([-0 _^<>]*\\)\\([0-9.]*\\)\\([a-zA-Z]\\)")
- (let* ((modifiers (match-string 1))
- (num (match-string 2))
- (spec (string-to-char (match-string 3)))
- (val (assq spec specification)))
- (if (not val)
- (unless only-present
- (error "Invalid format character: `%%%c'" spec))
- (setq val (cdr val)
- modifiers (format-spec--parse-modifiers modifiers))
- ;; Pad result to desired length.
- (let ((text (format "%s" val)))
- (when num
- (setq num (string-to-number num))
- (setq text (format-spec--pad text num modifiers))
- (when (> (length text) num)
- (cond
- ((memq :chop-left modifiers)
- (setq text (substring text (- (length text) num))))
- ((memq :chop-right modifiers)
- (setq text (substring text 0 num))))))
- (when (memq :uppercase modifiers)
- (setq text (upcase text)))
- (when (memq :lowercase modifiers)
- (setq text (downcase text)))
- ;; Insert first, to preserve text properties.
- (insert-and-inherit text)
- ;; Delete the specifier body.
- (delete-region (+ (match-beginning 0) (length text))
- (+ (match-end 0) (length text)))
- ;; Delete the percent sign.
- (delete-region (1- (match-beginning 0)) (match-beginning 0))))))
- ;; Signal an error on bogus format strings.
- (t
- (unless only-present
- (error "Invalid format string")))))
+ ;; Quoted percent sign.
+ ((= (following-char) ?%)
+ (when (memq ignore-missing '(nil ignore delete))
+ (delete-char 1)))
+ ;; Valid format spec.
+ ((looking-at (rx (? (group (+ (in " 0<>^_-"))))
+ (? (group (+ digit)))
+ (? (group ?. (+ digit)))
+ (group alpha)))
+ (let* ((beg (point))
+ (end (match-end 0))
+ (flags (match-string 1))
+ (width (match-string 2))
+ (trunc (match-string 3))
+ (char (string-to-char (match-string 4)))
+ (text (assq char specification)))
+ (cond (text
+ ;; Handle flags.
+ (setq text (format-spec--do-flags
+ (format "%s" (cdr text))
+ (format-spec--parse-flags flags)
+ (and width (string-to-number width))
+ (and trunc (car (read-from-string trunc 1)))))
+ ;; Insert first, to preserve text properties.
+ (insert-and-inherit text)
+ ;; Delete the specifier body.
+ (delete-region (point) (+ end (length text)))
+ ;; Delete the percent sign.
+ (delete-region (1- beg) beg))
+ ((eq ignore-missing 'delete)
+ ;; Delete the whole format spec.
+ (delete-region (1- beg) end))
+ ((not ignore-missing)
+ (error "Invalid format character: `%%%c'" char)))))
+ ;; Signal an error on bogus format strings.
+ ((not ignore-missing)
+ (error "Invalid format string"))))
(buffer-string)))
-(defun format-spec--pad (text total-length modifiers)
- (if (> (length text) total-length)
- ;; The text is longer than the specified length; do nothing.
- text
- (let ((padding (make-string (- total-length (length text))
- (if (memq :zero-pad modifiers)
- ?0
- ?\s))))
- (if (memq :right-pad modifiers)
- (concat text padding)
- (concat padding text)))))
-
-(defun format-spec--parse-modifiers (modifiers)
+(defun format-spec--do-flags (str flags width trunc)
+ "Return STR formatted according to FLAGS, WIDTH, and TRUNC.
+FLAGS is a list of keywords as returned by
+`format-spec--parse-flags'. WIDTH and TRUNC are either nil or
+string widths corresponding to `format-spec' modifiers."
+ (let (diff str-width)
+ ;; Truncate original string first, like `format' does.
+ (when trunc
+ (setq str-width (string-width str))
+ (when (> (setq diff (- str-width trunc)) 0)
+ (setq str (if (memq :chop-left flags)
+ (truncate-string-to-width str str-width diff)
+ (format (format "%%.%ds" trunc) str))
+ ;; We know the new width so save it for later.
+ str-width trunc)))
+ ;; Pad or chop to width.
+ (when width
+ (setq str-width (or str-width (string-width str))
+ diff (- width str-width))
+ (cond ((zerop diff))
+ ((> diff 0)
+ (let ((pad (make-string diff (if (memq :pad-zero flags) ?0 ?\s))))
+ (setq str (if (memq :pad-right flags)
+ (concat str pad)
+ (concat pad str)))))
+ ((memq :chop-left flags)
+ (setq str (truncate-string-to-width str str-width (- diff))))
+ ((memq :chop-right flags)
+ (setq str (format (format "%%.%ds" width) str))))))
+ ;; Fiddle case.
+ (cond ((memq :upcase flags)
+ (upcase str))
+ ((memq :downcase flags)
+ (downcase str))
+ (str)))
+
+(defun format-spec--parse-flags (flags)
+ "Convert sequence of FLAGS to list of human-readable keywords."
(mapcan (lambda (char)
- (when-let ((modifier
- (pcase char
- (?0 :zero-pad)
- (?\s :space-pad)
- (?^ :uppercase)
- (?_ :lowercase)
- (?- :right-pad)
- (?< :chop-left)
- (?> :chop-right))))
- (list modifier)))
- modifiers))
+ (pcase char
+ (?0 (list :pad-zero))
+ (?- (list :pad-right))
+ (?< (list :chop-left))
+ (?> (list :chop-right))
+ (?^ (list :upcase))
+ (?_ (list :downcase))))
+ flags))
(defun format-spec-make (&rest pairs)
"Return an alist suitable for use in `format-spec' based on PAIRS.
-PAIRS is a list where every other element is a character and a value,
-starting with a character."
+PAIRS is a property list with characters as keys."
(let (alist)
(while pairs
(unless (cdr pairs)
diff --git a/lisp/format.el b/lisp/format.el
index f3559ba9b21..905ca2d9ec9 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -342,8 +342,8 @@ for identifying regular expressions at the beginning of the region."
FORMAT defaults to `buffer-file-format'. It is a symbol naming one of the
formats defined in `format-alist', or a list of such symbols."
(interactive
- (list (format-read (format "Translate buffer to format (default %s): "
- buffer-file-format))))
+ (list (format-read (format-prompt "Translate buffer to format"
+ buffer-file-format))))
(format-encode-region (point-min) (point-max) format))
(defun format-encode-region (beg end &optional format)
@@ -352,8 +352,8 @@ FORMAT defaults to `buffer-file-format'. It is a symbol naming
one of the formats defined in `format-alist', or a list of such symbols."
(interactive
(list (region-beginning) (region-end)
- (format-read (format "Translate region to format (default %s): "
- buffer-file-format))))
+ (format-read (format-prompt "Translate region to format"
+ buffer-file-format))))
(if (null format) (setq format buffer-file-format))
(if (symbolp format) (setq format (list format)))
(save-excursion
diff --git a/lisp/forms.el b/lisp/forms.el
index 3f9f1c9980f..e9242ce4cb8 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -504,12 +504,9 @@ Commands: Equivalent keys in read-only mode:
(setq forms-new-record-filter nil)
(setq forms-modified-record-filter nil)
- ;; If running Emacs 19 under X, setup faces to show read-only and
- ;; read-write fields.
- (if (fboundp 'make-face)
- (progn
- (make-local-variable 'forms-ro-face)
- (make-local-variable 'forms-rw-face)))
+ ;; Setup faces to show read-only and read-write fields.
+ (make-local-variable 'forms-ro-face)
+ (make-local-variable 'forms-rw-face)
;; eval the buffer, should set variables
;;(message "forms: processing control file...")
@@ -609,16 +606,14 @@ Commands: Equivalent keys in read-only mode:
(setq forms--mode-setup t)
;; Copy desired faces to the actual variables used by the forms formatter.
- (if (fboundp 'make-face)
+ (make-local-variable 'forms--ro-face)
+ (make-local-variable 'forms--rw-face)
+ (if forms-read-only
(progn
- (make-local-variable 'forms--ro-face)
- (make-local-variable 'forms--rw-face)
- (if forms-read-only
- (progn
- (setq forms--ro-face forms-ro-face)
- (setq forms--rw-face forms-ro-face))
- (setq forms--ro-face forms-ro-face)
- (setq forms--rw-face forms-rw-face))))
+ (setq forms--ro-face forms-ro-face)
+ (setq forms--rw-face forms-ro-face))
+ (setq forms--ro-face forms-ro-face)
+ (setq forms--rw-face forms-rw-face))
;; Make more local variables.
(make-local-variable 'forms--file-buffer)
diff --git a/lisp/frame.el b/lisp/frame.el
index 16ee7580f89..7751ae1303f 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -713,6 +713,18 @@ The optional argument PARAMETERS specifies additional frame parameters."
(x-display-list))))
(make-frame (cons (cons 'display display) parameters)))
+(defun make-frame-on-current-monitor (&optional parameters)
+ "Make a frame on the currently selected monitor.
+Like `make-frame-on-monitor' and with the same PARAMETERS as in `make-frame'."
+ (interactive)
+ (let* ((monitor-workarea
+ (cdr (assq 'workarea (frame-monitor-attributes))))
+ (geometry-parameters
+ (when monitor-workarea
+ `((top . ,(nth 1 monitor-workarea))
+ (left . ,(nth 0 monitor-workarea))))))
+ (make-frame (append geometry-parameters parameters))))
+
(defun make-frame-on-monitor (monitor &optional display parameters)
"Make a frame on monitor MONITOR.
The optional argument DISPLAY can be a display name, and the optional
@@ -721,7 +733,7 @@ argument PARAMETERS specifies additional frame parameters."
(list
(let* ((default (cdr (assq 'name (frame-monitor-attributes)))))
(completing-read
- (format "Make frame on monitor (default %s): " default)
+ (format-prompt "Make frame on monitor" default)
(or (delq nil (mapcar (lambda (a)
(cdr (assq 'name a)))
(display-monitor-attributes-list)))
@@ -748,7 +760,7 @@ If DISPLAY is nil, that stands for the selected frame's display."
(list
(let* ((default (frame-parameter nil 'display))
(display (completing-read
- (format "Close display (default %s): " default)
+ (format-prompt "Close display" default)
(delete-dups
(mapcar (lambda (frame)
(frame-parameter frame 'display))
@@ -1058,6 +1070,23 @@ that variable should be nil."
(setq arg (1+ arg)))
(select-frame-set-input-focus frame)))
+(defun other-frame-prefix ()
+ "Display the buffer of the next command in a new frame.
+The next buffer is the buffer displayed by the next command invoked
+immediately after this command (ignoring reading from the minibuffer).
+Creates a new frame before displaying the buffer.
+When `switch-to-buffer-obey-display-actions' is non-nil,
+`switch-to-buffer' commands are also supported."
+ (interactive)
+ (display-buffer-override-next-command
+ (lambda (buffer alist)
+ (cons (display-buffer-pop-up-frame
+ buffer (append '((inhibit-same-window . t))
+ alist))
+ 'frame))
+ nil "[other-frame]")
+ (message "Display next command buffer in a new frame..."))
+
(defun iconify-or-deiconify-frame ()
"Iconify the selected frame, or deiconify if it's currently an icon."
(interactive)
@@ -1101,7 +1130,7 @@ If there is no frame by that name, signal an error."
(let* ((frame-names-alist (make-frame-names-alist))
(default (car (car frame-names-alist)))
(input (completing-read
- (format "Select Frame (default %s): " default)
+ (format-prompt "Select Frame" default)
frame-names-alist nil t nil 'frame-name-history)))
(if (= (length input) 0)
(list default)
@@ -1383,12 +1412,12 @@ 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."
(interactive
(let* ((completion-ignore-case t)
- (font (completing-read "Font name: "
+ (default (frame-parameter nil 'font))
+ (font (completing-read (format-prompt "Font name" default)
;; x-list-fonts will fail with an error
;; if this frame doesn't support fonts.
(x-list-fonts "*" nil (selected-frame))
- nil nil nil nil
- (frame-parameter nil 'font))))
+ nil nil nil nil default)))
(list font current-prefix-arg nil)))
(when (or (stringp font) (fontp font))
(let* ((this-frame (selected-frame))
@@ -1552,8 +1581,9 @@ When called interactively, prompt for the name of the frame.
On text terminals, the frame name is displayed on the mode line.
On graphical displays, it is displayed on the frame's title bar."
(interactive
- (list (read-string "Frame name: " nil nil
- (cdr (assq 'name (frame-parameters))))))
+ (let ((default (cdr (assq 'name (frame-parameters)))))
+ (list (read-string (format-prompt "Frame name" default) nil nil
+ default))))
(modify-frame-parameters (selected-frame)
(list (cons 'name name))))
@@ -2676,11 +2706,7 @@ See also `toggle-frame-maximized'."
(set-frame-parameter frame 'fullscreen fullscreen-restore)
(set-frame-parameter frame 'fullscreen nil)))
(modify-frame-parameters
- frame `((fullscreen . fullboth) (fullscreen-restore . ,fullscreen))))
- ;; Manipulating a frame without waiting for the fullscreen
- ;; animation to complete can cause a crash, or other unexpected
- ;; behavior, on macOS (bug#28496).
- (when (featurep 'cocoa) (sleep-for 0.5))))
+ frame `((fullscreen . fullboth) (fullscreen-restore . ,fullscreen))))))
;;;; Key bindings
@@ -2689,6 +2715,7 @@ See also `toggle-frame-maximized'."
(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)
diff --git a/lisp/frameset.el b/lisp/frameset.el
index 10c6914f52d..0462d776c0e 100644
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -396,17 +396,17 @@ Properties can be set with
;; or, if you're only changing a few items,
;;
;; (defvar my-filter-alist
-;; (nconc '((my-param1 . :never)
-;; (my-param2 . my-filtering-function))
-;; frameset-filter-alist)
+;; (append '((my-param1 . :never)
+;; (my-param2 . my-filtering-function))
+;; frameset-filter-alist)
;; "My brief customized parameter filter alist.")
;;
;; and pass it to the FILTER arg of the save/restore functions,
;; ALWAYS taking care of not modifying the original lists; if you're
;; going to do any modifying of my-filter-alist, please use
;;
-;; (nconc '((my-param1 . :never) ...)
-;; (copy-sequence frameset-filter-alist))
+;; (append '((my-param1 . :never) ...)
+;; (copy-sequence frameset-filter-alist))
;;
;; One thing you shouldn't forget is that they are alists, so searching
;; in them is sequential. If you just want to change the default of
@@ -445,7 +445,7 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
;;;###autoload
(defvar frameset-persistent-filter-alist
- (nconc
+ (append
'((background-color . frameset-filter-sanitize-color)
(buffer-list . :never)
(buffer-predicate . :never)
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index cd24f497c96..48ac1232051 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -643,7 +643,7 @@ like an INI file. You can add this hook to `find-file-hook'."
("\\([^ =\n\r]+\\)=\\([^ \n\r]*\\)"
(1 font-lock-variable-name-face)
(2 font-lock-keyword-face)))
- '("inventory")
+ '("inventory\\'")
(list
(function
(lambda ()
diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el
index 82dbbab5e0d..647f643c962 100644
--- a/lisp/gnus/deuglify.el
+++ b/lisp/gnus/deuglify.el
@@ -266,21 +266,21 @@
"\\(On \\|Am \\)?\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),[^,]+, "
"Regular expression matching the beginning of an attribution line that should be cut off."
:version "22.1"
- :type 'string
+ :type 'regexp
:group 'gnus-outlook-deuglify)
(defcustom gnus-outlook-deuglify-attrib-verb-regexp
"wrote\\|writes\\|says\\|schrieb\\|schreibt\\|meinte\\|skrev\\|a écrit\\|schreef\\|escribió"
"Regular expression matching the verb used in an attribution line."
:version "22.1"
- :type 'string
+ :type 'regexp
:group 'gnus-outlook-deuglify)
(defcustom gnus-outlook-deuglify-attrib-end-regexp
": *\\|\\.\\.\\."
"Regular expression matching the end of an attribution line."
:version "22.1"
- :type 'string
+ :type 'regexp
:group 'gnus-outlook-deuglify)
(defcustom gnus-outlook-display-hook nil
@@ -403,9 +403,9 @@ NODISPLAY is non-nil, don't redisplay the article buffer."
(gnus-with-article-buffer
(article-goto-body)
(when (re-search-forward
- (concat "^[" cite-marks " \t]*--* ?[^-]+ [^-]+ ?--*\\s *\n"
+ (concat "^[" cite-marks " \t]*--*[^-]+ [^-]+--*\\s *\n"
"[^\n:]+:[ \t]*\\([^\n]+\\)\n"
- "\\([^\n:]+:[ \t]*[^\n]+\n\\)+")
+ "\\([^\n:]+:[^\n]+\n\\)+")
nil t)
(gnus-kill-all-overlays)
(replace-match "\\1 wrote:\n")
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index 2df098bc0bf..6d24b409ed0 100644
--- a/lisp/gnus/gmm-utils.el
+++ b/lisp/gnus/gmm-utils.el
@@ -168,9 +168,9 @@ ARGS are passed to `message'."
(defcustom gmm-tool-bar-style
(if (and (boundp 'tool-bar-mode)
tool-bar-mode
- (memq (display-visual-class)
- (list 'static-gray 'gray-scale
- 'static-color 'pseudo-color)))
+ (not (memq (display-visual-class)
+ (list 'static-gray 'gray-scale
+ 'static-color 'pseudo-color))))
'gnome
'retro)
"Preferred tool bar style."
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index cf705ae5dc1..f748996acc8 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -603,11 +603,22 @@ manipulated as follows:
(gnus))
;;;###autoload
+(defun gnus-child-unplugged (&optional arg)
+ "Read news as a child unplugged."
+ (interactive "P")
+ (setq gnus-plugged nil)
+ (gnus arg nil 'child))
+
+;;;###autoload
(defun gnus-slave-unplugged (&optional arg)
- "Read news as a slave unplugged."
+ "Read news as a child unplugged."
(interactive "P")
(setq gnus-plugged nil)
- (gnus arg nil 'slave))
+ (gnus arg nil 'child))
+(make-obsolete 'gnus-slave-unplugged 'gnus-child-unplugged "28.1")
+
+
+
;;;###autoload
(defun gnus-agentize ()
@@ -799,7 +810,7 @@ be a select method."
(let ((gnus-command-method method)
(gnus-agent nil))
(when (file-exists-p (gnus-agent-lib-file "flags"))
- (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*"))
+ (set-buffer (gnus-get-buffer-create " *Gnus Agent flag synchronize*"))
(erase-buffer)
(nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
(cond ((null gnus-plugged)
@@ -1293,7 +1304,7 @@ downloaded into the agent."
;; gnus doesn't waste resources trying to fetch them.
;; NOTE: I don't do this for smaller gaps (< 100) as I don't
- ;; want to modify the local file everytime someone restarts
+ ;; want to modify the local file every time someone restarts
;; gnus. The small gap will cause a tiny performance hit
;; when gnus tries, and fails, to retrieve the articles.
;; Still that should be smaller than opening a buffer,
@@ -3801,6 +3812,7 @@ has been fetched."
t))))
(defun gnus-agent-store-article (article group)
+ (declare (obsolete nil "28.1"))
(let* ((gnus-command-method (gnus-find-method-for-group group))
(file (gnus-agent-article-name (number-to-string article) group))
(file-name-coding-system nnmail-pathname-coding-system)
@@ -3923,7 +3935,7 @@ If REREAD is not nil, downloaded articles are marked as unread."
(mm-with-unibyte-buffer
(nnheader-insert-file-contents file)
(nnheader-remove-body)
- (setq header (nnheader-parse-naked-head)))
+ (setq header (nnheader-parse-head t)))
(setf (mail-header-number header) (car downloaded))
(if nov-arts
(let ((key (concat "^" (int-to-string (car nov-arts))
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 6b9610d3121..b1147924ffa 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -274,6 +274,7 @@ This can also be a list of the above values."
If it is a string, the command will be executed in a sub-shell
asynchronously. The compressed face will be piped to this command."
:type '(choice string
+ (const :tag "None" nil)
(function-item gnus-display-x-face-in-from)
function)
:version "27.1"
@@ -534,6 +535,13 @@ that the symbol of the saver function, which is specified by
:group 'gnus-article-saving
:type 'regexp)
+(defcustom gnus-global-groups nil
+ "Groups that should be considered like \"news\" groups.
+This means that images will be automatically loaded, for instance."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-article)
+
;; Note that "Rmail format" is mbox since Emacs 23, but Babyl before.
(defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
"A function to save articles in your favorite format.
@@ -2303,21 +2311,27 @@ long lines if and only if arg is positive."
"\n")
(put-text-property start (point) 'gnus-decoration 'header)))))
-(defun article-fill-long-lines ()
- "Fill lines that are wider than the window width."
- (interactive)
+(defun article-fill-long-lines (&optional width)
+ "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")
(save-excursion
- (let ((inhibit-read-only t)
- (width (window-width (get-buffer-window (current-buffer)))))
+ (let* ((inhibit-read-only t)
+ (window-width (window-width (get-buffer-window (current-buffer))))
+ (width (if width
+ (prefix-numeric-value width)
+ (min fill-column window-width))))
(save-restriction
(article-goto-body)
(let ((adaptive-fill-mode nil)) ;Why? -sm
(while (not (eobp))
(end-of-line)
- (when (>= (current-column) (min fill-column width))
+ (when (>= (current-column) width)
(narrow-to-region (min (1+ (point)) (point-max))
(point-at-bol))
- (let ((goback (point-marker)))
+ (let ((goback (point-marker))
+ (fill-column width))
(fill-paragraph nil)
(goto-char (marker-position goback)))
(widen))
@@ -4406,6 +4420,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
"e" gnus-article-read-summary-keys
"\C-d" gnus-article-read-summary-keys
+ "\C-c\C-f" gnus-summary-mail-forward
"\M-*" gnus-article-read-summary-keys
"\M-#" gnus-article-read-summary-keys
"\M-^" gnus-article-read-summary-keys
@@ -5833,6 +5848,7 @@ all parts."
"" "..."))
(gnus-tmp-length (with-current-buffer (mm-handle-buffer handle)
(buffer-size)))
+ (help-echo "mouse-2: toggle the MIME part; down-mouse-3: more options")
gnus-tmp-type-long b e)
(when (string-match ".*/" gnus-tmp-name)
(setq gnus-tmp-name (replace-match "" t t gnus-tmp-name)))
@@ -5841,6 +5857,19 @@ all parts."
(concat "; " gnus-tmp-name))))
(unless (equal gnus-tmp-description "")
(setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
+ (when (and (zerop gnus-tmp-length)
+ ;; Only nnimap supports partial fetches so far.
+ nnimap-fetch-partial-articles
+ (string-match "^nnimap\\+" gnus-newsgroup-name))
+ (setq gnus-tmp-type-long
+ (concat
+ gnus-tmp-type-long
+ (substitute-command-keys
+ (concat "\\<gnus-summary-mode-map> (not downloaded, "
+ "\\[gnus-summary-show-complete-article] to fetch.)"))))
+ (setq help-echo
+ (concat "Type \\[gnus-summary-show-complete-article] "
+ "to download complete article. " help-echo)))
(setq b (point))
(gnus-eval-format
gnus-mime-button-line-format gnus-mime-button-line-format-alist
@@ -5859,8 +5888,7 @@ all parts."
'keymap gnus-mime-button-map
'face gnus-article-button-face
'follow-link t
- 'help-echo
- "mouse-2: toggle the MIME part; down-mouse-3: more options")))
+ 'help-echo help-echo)))
(defvar gnus-displaying-mime nil)
@@ -6001,6 +6029,7 @@ If nil, don't show those extra buttons."
(defun gnus-mime-display-single (handle)
(let ((type (mm-handle-media-type handle))
(ignored gnus-ignored-mime-types)
+ (mm-inline-font-lock (gnus-visual-p 'article-highlight 'highlight))
(not-attachment t)
display text)
(catch 'ignored
@@ -6664,7 +6693,7 @@ not have a face in `gnus-article-boring-faces'."
(interactive "P")
(gnus-article-check-buffer)
(let ((nosaves
- '("q" "Q" "r" "\C-c\C-f" "m" "a" "f" "WDD" "WDW"
+ '("q" "Q" "r" "m" "a" "f" "WDD" "WDW"
"Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
"=" "^" "\M-^" "|"))
(nosave-but-article
@@ -7063,10 +7092,7 @@ If given a prefix, show the hidden text instead."
gnus-summary-buffer)
(when gnus-keep-backlog
(gnus-backlog-enter-article
- group article (current-buffer)))
- (when (and gnus-agent
- (gnus-agent-group-covered-p group))
- (gnus-agent-store-article article group)))
+ group article (current-buffer))))
(setq result 'article))
(methods
(setq gnus-override-method (pop methods)))
@@ -7120,7 +7146,8 @@ If given a prefix, show the hidden text instead."
"Allows images in newsgroups to be shown, blocks images in all
other groups."
(if (or (gnus-news-group-p group)
- (gnus-member-of-valid 'global group))
+ (gnus-member-of-valid 'global group)
+ (member group gnus-global-groups))
;; Block nothing in news groups.
nil
;; Block everything anywhere else.
@@ -7708,6 +7735,15 @@ positives are possible."
0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1)
("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>"
0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1)
+ ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)...
+ ("<URL: *\\([^\n<>]*\\)>"
+ 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
+ ;; RFC 2396 (2.4.3., delims) ...
+ ("\"URL: *\\([^\n\"]*\\)\""
+ 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
+ ;; Raw URLs.
+ (gnus-button-url-regexp
+ 0 (>= gnus-button-browse-level 0) browse-url-button-open-url 0)
;; The following entries may lead to many false positives so don't enable
;; them by default (use a high button level).
("/\\([a-z][-a-z0-9]+\\.el\\)\\>[^.?]"
@@ -7731,15 +7767,6 @@ positives are possible."
;; Unlike the other regexps we really have to require quoting
;; here to determine where it ends.
1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3)
- ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)...
- ("<URL: *\\([^\n<>]*\\)>"
- 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
- ;; RFC 2396 (2.4.3., delims) ...
- ("\"URL: *\\([^\n\"]*\\)\""
- 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
- ;; Raw URLs.
- (gnus-button-url-regexp
- 0 (>= gnus-button-browse-level 0) browse-url-button-open-url 0)
;; man pages
("\\b\\([a-z][a-z]+([1-9])\\)\\W"
0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3))
@@ -8323,6 +8350,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(and (match-end 6) (list (string-to-number (match-string 6 address))))))))
(defun gnus-url-parse-query-string (query &optional downcase)
+ (declare (obsolete message-parse-mailto-url "28.1"))
(let (retval pairs cur key val)
(setq pairs (split-string query "&"))
(while pairs
@@ -8342,31 +8370,8 @@ url is put as the `gnus-button-url' overlay property on the button."
(defun gnus-url-mailto (url)
;; Send mail to someone
- (setq url (replace-regexp-in-string "\n" " " url))
- (when (string-match "mailto:/*\\(.*\\)" url)
- (setq url (substring url (match-beginning 1) nil)))
- (let* ((args (gnus-url-parse-query-string
- (if (string-match "^\\?" url)
- (substring url 1)
- (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url)
- (concat "to=" (match-string 1 url) "&"
- (match-string 2 url))
- (concat "to=" url)))))
- (subject (cdr-safe (assoc "subject" args)))
- func)
- (gnus-msg-mail)
- (while args
- (setq func (intern-soft (concat "message-goto-" (downcase (caar args)))))
- (if (fboundp func)
- (funcall func)
- (message-position-on-field (caar args)))
- (insert (replace-regexp-in-string
- "\r\n" "\n"
- (mapconcat #'identity (reverse (cdar args)) ", ") nil t))
- (setq args (cdr args)))
- (if subject
- (message-goto-body)
- (message-goto-subject))))
+ (gnus-msg-mail)
+ (message-mailto-1 url))
(defun gnus-button-embedded-url (address)
"Activate ADDRESS with `browse-url'."
diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el
index e3e81c8bbce..9bcb6c33a64 100644
--- a/lisp/gnus/gnus-async.el
+++ b/lisp/gnus/gnus-async.el
@@ -225,12 +225,6 @@ that was fetched."
(save-excursion
(save-restriction
(narrow-to-region mark (point-max))
- ;; Put the articles into the agent, if they aren't already.
- (when (and gnus-agent
- (gnus-agent-group-covered-p group))
- (save-restriction
- (narrow-to-region mark (point-max))
- (gnus-agent-store-article article group)))
;; Prefetch images for the groups that want that.
(when (fboundp 'gnus-html-prefetch-images)
(gnus-html-prefetch-images summary))
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index ea4af2df0c4..1b00bbbc69c 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -242,7 +242,7 @@ So the cdr of each bookmark is an alist too.")
(save-window-excursion
;; Avoid warnings?
;; (message "Saving Gnus bookmarks to file %s..." gnus-bookmark-default-file)
- (set-buffer (get-buffer-create " *Gnus bookmarks*"))
+ (set-buffer (gnus-get-buffer-create " *Gnus bookmarks*"))
(erase-buffer)
(gnus-bookmark-insert-file-format-version-stamp)
(pp gnus-bookmark-alist (current-buffer))
@@ -357,8 +357,8 @@ deletion, or > if it is flagged for displaying."
(interactive)
(gnus-bookmark-maybe-load-default-file)
(if (called-interactively-p 'any)
- (switch-to-buffer (get-buffer-create "*Gnus Bookmark List*"))
- (set-buffer (get-buffer-create "*Gnus Bookmark List*")))
+ (switch-to-buffer (gnus-get-buffer-create "*Gnus Bookmark List*"))
+ (set-buffer (gnus-get-buffer-create "*Gnus Bookmark List*")))
(let ((inhibit-read-only t)
alist name start end)
(erase-buffer)
@@ -648,7 +648,7 @@ reposition and try again, else return nil."
(details gnus-bookmark-bookmark-details)
detail)
(save-excursion
- (pop-to-buffer (get-buffer-create "*Gnus Bookmark Annotation*") t)
+ (pop-to-buffer (gnus-get-buffer-create "*Gnus Bookmark Annotation*") t)
(erase-buffer)
(while details
(setq detail (pop details))
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index 02a8ea723d3..c31d97d41cd 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -93,6 +93,8 @@ it's not cached."
(autoload 'nnml-generate-nov-databases-directory "nnml")
(autoload 'nnvirtual-find-group-art "nnvirtual")
+(autoload 'nnselect-article-group "nnselect")
+(autoload 'nnselect-article-number "nnselect")
@@ -158,8 +160,12 @@ it's not cached."
(file-name-coding-system nnmail-pathname-coding-system))
;; If this is a virtual group, we find the real group.
(when (gnus-virtual-group-p group)
- (let ((result (nnvirtual-find-group-art
- (gnus-group-real-name group) article)))
+ (let ((result (if (gnus-nnselect-group-p group)
+ (with-current-buffer gnus-summary-buffer
+ (cons (nnselect-article-group article)
+ (nnselect-article-number article)))
+ (nnvirtual-find-group-art
+ (gnus-group-real-name group) article))))
(setq group (car result)
number (cdr result))))
(when (and number
@@ -186,7 +192,7 @@ it's not cached."
(gnus-cache-update-file-total-fetched-for group file))
(setq lines-chars (nnheader-get-lines-and-char))
(nnheader-remove-body)
- (setq headers (nnheader-parse-naked-head))
+ (setq headers (nnheader-parse-head t))
(setf (mail-header-number headers) number)
(setf (mail-header-lines headers) (car lines-chars))
(setf (mail-header-chars headers) (cadr lines-chars))
@@ -232,8 +238,14 @@ it's not cached."
(let ((arts gnus-cache-removable-articles)
ga)
(while arts
- (when (setq ga (nnvirtual-find-group-art
- (gnus-group-real-name gnus-newsgroup-name) (pop arts)))
+ (when (setq ga
+ (if (gnus-nnselect-group-p gnus-newsgroup-name)
+ (with-current-buffer gnus-summary-buffer
+ (let ((article (pop arts)))
+ (cons (nnselect-article-group article)
+ (nnselect-article-number article))))
+ (nnvirtual-find-group-art
+ (gnus-group-real-name gnus-newsgroup-name) (pop arts))))
(let ((gnus-cache-removable-articles (list (cdr ga)))
(gnus-newsgroup-name (car ga)))
(gnus-cache-possibly-remove-articles-1)))))
@@ -467,8 +479,12 @@ Returns the list of articles removed."
(file-name-coding-system nnmail-pathname-coding-system))
;; If this is a virtual group, we find the real group.
(when (gnus-virtual-group-p group)
- (let ((result (nnvirtual-find-group-art
- (gnus-group-real-name group) article)))
+ (let ((result (if (gnus-nnselect-group-p group)
+ (with-current-buffer gnus-summary-buffer
+ (cons (nnselect-article-group article)
+ (nnselect-article-number article)))
+ (nnvirtual-find-group-art
+ (gnus-group-real-name group) article))))
(setq group (car result)
number (cdr result))))
(setq file (gnus-cache-file-name group number))
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index cecfaef2f4f..3e23e263262 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -223,13 +223,10 @@ easy interactive way to set this from the Server buffer."
(t
(gnus-message 1 "Unknown type %s; ignoring" type))))))
-(defun gnus-cloud-update-newsrc-data (group elem &optional force-older)
- "Update the newsrc data for GROUP from ELEM.
-Use old data if FORCE-OLDER is not nil."
+(defun gnus-cloud-update-newsrc-data (group elem)
+ "Update the newsrc data for GROUP from ELEM."
(let* ((contents (plist-get elem :contents))
(date (or (plist-get elem :timestamp) "0"))
- (now (gnus-cloud-timestamp nil))
- (newer (string-lessp date now))
(group-info (gnus-get-info group)))
(if (and contents
(stringp (nth 0 contents))
@@ -238,15 +235,13 @@ Use old data if FORCE-OLDER is not nil."
(if (equal (format "%S" group-info)
(format "%S" contents))
(gnus-message 3 "Skipping cloud update of group %s, the info is the same" group)
- (if (and newer (not force-older))
- (gnus-message 3 "Skipping outdated cloud info for group %s, the info is from %s (now is %s)" group date now)
- (when (or (not gnus-cloud-interactive)
- (gnus-y-or-n-p
- (format "%s has older different info in the cloud as of %s, update it here? "
- group date))))
- (gnus-message 2 "Installing cloud update of group %s" group)
- (gnus-set-info group contents)
- (gnus-group-update-group group)))
+ (when (or (not gnus-cloud-interactive)
+ (gnus-y-or-n-p
+ (format "%s has different info in the cloud from %s, update it here? "
+ group date)))
+ (gnus-message 2 "Installing cloud update of group %s" group)
+ (gnus-set-info group contents)
+ (gnus-group-update-group group)))
(gnus-error 1 "Sorry, group %s is not subscribed" group))
(gnus-error 1 "Sorry, could not update newsrc for group %s (invalid data %S)"
group elem))))
@@ -285,8 +280,8 @@ Use old data if FORCE-OLDER is not nil."
(insert new-contents)
(when (file-exists-p file-name)
(rename-file file-name (car (find-backup-file-name file-name))))
- (write-region (point-min) (point-max) file-name)
- (set-file-times file-name (parse-iso8601-time-string date))))
+ (write-region (point-min) (point-max) file-name nil nil nil 'excl)
+ (set-file-times file-name (parse-iso8601-time-string date) 'nofollow)))
(defun gnus-cloud-file-covered-p (file-name)
(let ((matched nil))
@@ -380,8 +375,9 @@ When FULL is t, upload everything, not just a difference from the last full."
(gnus-cloud-files-to-upload full)
(gnus-cloud-collect-full-newsrc)))
(group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method)))
+ (setq gnus-cloud-sequence (1+ (or gnus-cloud-sequence 0)))
(insert (format "Subject: (sequence: %s type: %s storage-method: %s)\n"
- (or gnus-cloud-sequence "UNKNOWN")
+ gnus-cloud-sequence
(if full :full :partial)
gnus-cloud-storage-method))
(insert "From: nobody@gnus.cloud.invalid\n")
@@ -390,12 +386,13 @@ When FULL is t, upload everything, not just a difference from the last full."
(if (gnus-request-accept-article gnus-cloud-group-name gnus-cloud-method
t t)
(progn
- (setq gnus-cloud-sequence (1+ (or gnus-cloud-sequence 0)))
(gnus-cloud-add-timestamps elems)
(gnus-message 3 "Uploaded Gnus Cloud data successfully to %s" group)
(gnus-group-refresh-group group))
(gnus-error 2 "Failed to upload Gnus Cloud data to %s" group)))))
+(defvar gnus-alter-header-function)
+
(defun gnus-cloud-add-timestamps (elems)
(dolist (elem elems)
(let* ((file-name (plist-get elem :file-name))
@@ -414,8 +411,9 @@ When FULL is t, upload everything, not just a difference from the last full."
(when (gnus-retrieve-headers (gnus-uncompress-range active) group)
(with-current-buffer nntp-server-buffer
(goto-char (point-min))
- (while (and (not (eobp))
- (setq head (nnheader-parse-head)))
+ (while (setq head (nnheader-parse-head))
+ (when gnus-alter-header-function
+ (funcall gnus-alter-header-function head))
(push head headers))))
(sort (nreverse headers)
(lambda (h1 h2)
@@ -459,18 +457,21 @@ instead of `gnus-cloud-sequence'.
When UPDATE is t, returns the result of calling `gnus-cloud-update-all'.
Otherwise, returns the Gnus Cloud data chunks."
(let ((articles nil)
+ (highest-sequence-seen gnus-cloud-sequence)
chunks)
(dolist (header (gnus-cloud-available-chunks))
- (when (> (gnus-cloud-chunk-sequence (mail-header-subject header))
- (or sequence-override gnus-cloud-sequence -1))
-
- (if (string-match (format "storage-method: %s" gnus-cloud-storage-method)
- (mail-header-subject header))
- (push (mail-header-number header) articles)
- (gnus-message 1 "Skipping article %s because it didn't match the Gnus Cloud method %s: %s"
- (mail-header-number header)
- gnus-cloud-storage-method
- (mail-header-subject header)))))
+ (let ((this-sequence (gnus-cloud-chunk-sequence (mail-header-subject header))))
+ (when (> this-sequence (or sequence-override gnus-cloud-sequence -1))
+
+ (if (string-match (format "storage-method: %s" gnus-cloud-storage-method)
+ (mail-header-subject header))
+ (progn
+ (push (mail-header-number header) articles)
+ (setq highest-sequence-seen (max highest-sequence-seen this-sequence)))
+ (gnus-message 1 "Skipping article %s because it didn't match the Gnus Cloud method %s: %s"
+ (mail-header-number header)
+ gnus-cloud-storage-method
+ (mail-header-subject header))))))
(when articles
(nnimap-request-articles (nreverse articles) gnus-cloud-group-name)
(with-current-buffer nntp-server-buffer
@@ -480,7 +481,8 @@ Otherwise, returns the Gnus Cloud data chunks."
(push (gnus-cloud-parse-chunk) chunks)
(forward-line 1))))
(if update
- (mapcar #'gnus-cloud-update-all chunks)
+ (prog1 (mapcar #'gnus-cloud-update-all chunks)
+ (setq gnus-cloud-sequence highest-sequence-seen))
chunks)))
(defun gnus-cloud-server-p (server)
diff --git a/lisp/gnus/gnus-dbus.el b/lisp/gnus/gnus-dbus.el
new file mode 100644
index 00000000000..8fbeffba437
--- /dev/null
+++ b/lisp/gnus/gnus-dbus.el
@@ -0,0 +1,70 @@
+;;; gnus-dbus.el --- DBUS integration for Gnus -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library contains some Gnus integration for systems using DBUS.
+;; At present it registers a signal to close all Gnus servers before
+;; system sleep or hibernation.
+
+;;; Code:
+
+(require 'gnus)
+(require 'dbus)
+(declare-function gnus-close-all-servers "gnus-start")
+
+(defcustom gnus-dbus-close-on-sleep nil
+ "When non-nil, close Gnus servers on system sleep."
+ :group 'gnus-dbus
+ :type 'boolean)
+
+(defvar gnus-dbus-sleep-registration-object nil
+ "Object returned from `dbus-register-signal'.
+Used to unregister the signal.")
+
+(defun gnus-dbus-register-sleep-signal ()
+ "Use `dbus-register-signal' to close servers on sleep."
+ (when (featurep 'dbusbind)
+ (setq gnus-dbus-sleep-registration-object
+ (dbus-register-signal :system
+ "org.freedesktop.login1"
+ "/org/freedesktop/login1"
+ "org.freedesktop.login1.Manager"
+ "PrepareForSleep"
+ #'gnus-dbus-sleep-handler))
+ (gnus-add-shutdown #'gnus-dbus-unregister-sleep-signal 'gnus)))
+
+(defun gnus-dbus-sleep-handler (sleep-start)
+ ;; Sleep-start is t before sleeping.
+ (when (and sleep-start
+ (gnus-alive-p))
+ (condition-case nil
+ (gnus-close-all-servers)
+ (error nil))))
+
+(defun gnus-dbus-unregister-sleep-signal ()
+ (condition-case nil
+ (dbus-unregister-object
+ gnus-dbus-sleep-registration-object)
+ (wrong-type-argument nil)))
+
+(provide 'gnus-dbus)
+;;; gnus-dbus.el ends here
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el
index 8dae4ef5c17..63e938e7453 100644
--- a/lisp/gnus/gnus-delay.el
+++ b/lisp/gnus/gnus-delay.el
@@ -75,7 +75,11 @@ DELAY is a string, giving the length of the time. Possible values are:
variable `gnus-delay-default-hour', minute and second are zero.
* hh:mm for a specific time. Use 24h format. If it is later than this
- time, then the deadline is tomorrow, else today."
+ time, then the deadline is tomorrow, else today.
+
+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]): "
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index 1b25d247389..3a9bf2a7e8f 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -248,7 +248,7 @@ If DONT-POP is nil, display the buffer after setting it up."
(let ((article narticle))
(message-mail nil nil nil nil
(if dont-pop
- (lambda (buf) (set-buffer (get-buffer-create buf)))))
+ (lambda (buf) (set-buffer (gnus-get-buffer-create buf)))))
(let ((inhibit-read-only t))
(erase-buffer))
(if (not (gnus-request-restore-buffer article group))
diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el
index 54118aad1e6..1bc1261ee8f 100644
--- a/lisp/gnus/gnus-eform.el
+++ b/lisp/gnus/gnus-eform.el
@@ -50,13 +50,13 @@
(defvar gnus-edit-form-buffer "*Gnus edit form*")
(defvar gnus-edit-form-done-function nil)
-(defvar gnus-edit-form-mode-map nil)
-(unless gnus-edit-form-mode-map
- (setq gnus-edit-form-mode-map (make-sparse-keymap))
- (set-keymap-parent gnus-edit-form-mode-map emacs-lisp-mode-map)
- (gnus-define-keys gnus-edit-form-mode-map
- "\C-c\C-c" gnus-edit-form-done
- "\C-c\C-k" gnus-edit-form-exit))
+(defvar gnus-edit-form-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map emacs-lisp-mode-map)
+ (gnus-define-keys map
+ "\C-c\C-c" gnus-edit-form-done
+ "\C-c\C-k" gnus-edit-form-exit)
+ map))
(defun gnus-edit-form-make-menu-bar ()
(unless (boundp 'gnus-edit-form-menu)
@@ -67,9 +67,9 @@
["Exit" gnus-edit-form-exit t]))
(gnus-run-hooks 'gnus-edit-form-menu-hook)))
-(define-derived-mode gnus-edit-form-mode fundamental-mode "Edit Form"
+(define-derived-mode gnus-edit-form-mode lisp-data-mode "Edit Form"
"Major mode for editing forms.
-It is a slightly enhanced emacs-lisp-mode.
+It is a slightly enhanced `lisp-data-mode'.
\\{gnus-edit-form-mode-map}"
(when (gnus-visual-p 'group-menu 'menu)
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index 33cbf4a54a9..2461fd45fd5 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -40,7 +40,7 @@
"Regexp to match faces in `gnus-x-face-directory' to be omitted."
:version "25.1"
:group 'gnus-fun
- :type '(choice (const nil) string))
+ :type '(choice (const nil) regexp))
(defcustom gnus-face-directory (expand-file-name "faces" gnus-directory)
"Directory where Face PNG files are stored."
@@ -52,7 +52,7 @@
"Regexp to match faces in `gnus-face-directory' to be omitted."
:version "25.1"
:group 'gnus-fun
- :type '(choice (const nil) string))
+ :type '(choice (const nil) regexp))
(defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface"
"Command for converting a PBM to an X-Face."
@@ -205,11 +205,12 @@ 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."
- (mm-with-unibyte-buffer
- (insert face)
- (ignore-errors
- (base64-decode-region (point-min) (point-max)))
- (buffer-string)))
+ (let ((face (gnus-base64-repad face)))
+ (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)
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index e2bd4ed860c..9c24de44cd6 100644
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -109,14 +109,16 @@ callback for `gravatar-retrieve'."
;; If we're on the " quoting the name, go backward.
(when (looking-at-p "[\"<]")
(goto-char (1- (point))))
- ;; Do not do anything if there's already a gravatar. This can
- ;; happen if the buffer has been regenerated in the mean time, for
- ;; example we were fetching someaddress, and then we change to
- ;; another mail with the same someaddress.
- (unless (get-text-property (point) 'gnus-gravatar)
+ ;; Do not do anything if there's already a gravatar.
+ ;; This can happen if the buffer has been regenerated in
+ ;; the mean time, for example we were fetching
+ ;; someaddress, and then we change to another mail with
+ ;; the same someaddress.
+ (unless (get-text-property (1- (point)) 'gnus-gravatar)
(let ((pos (point)))
(setq gravatar (append gravatar gnus-gravatar-properties))
- (gnus-put-image gravatar (buffer-substring pos (1+ pos)) category)
+ (gnus-put-image gravatar (buffer-substring pos (1+ pos))
+ category)
(put-text-property pos (point) 'gnus-gravatar address)
(gnus-add-wash-type category)
(gnus-add-image category gravatar)))))
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index b89f040b435..1d614f8a8d4 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -49,8 +49,6 @@
(autoload 'gnus-agent-total-fetched-for "gnus-agent")
(autoload 'gnus-cache-total-fetched-for "gnus-cache")
-(autoload 'gnus-group-make-nnir-group "nnir")
-
(autoload 'gnus-cloud-upload-all-data "gnus-cloud")
(autoload 'gnus-cloud-download-all-data "gnus-cloud")
@@ -663,7 +661,8 @@ simple manner."
"D" gnus-group-enter-directory
"f" gnus-group-make-doc-group
"w" gnus-group-make-web-group
- "G" gnus-group-make-nnir-group
+ "G" gnus-group-read-ephemeral-search-group
+ "g" gnus-group-make-search-group
"M" gnus-group-read-ephemeral-group
"r" gnus-group-rename-group
"R" gnus-group-make-rss-group
@@ -909,7 +908,8 @@ simple manner."
["Add the help group" gnus-group-make-help-group t]
["Make a doc group..." gnus-group-make-doc-group t]
["Make a web group..." gnus-group-make-web-group t]
- ["Make a search group..." gnus-group-make-nnir-group t]
+ ["Read a search group..." gnus-group-read-ephemeral-search-group t]
+ ["Make a search group..." gnus-group-make-search-group t]
["Make a virtual group..." gnus-group-make-empty-virtual t]
["Add a group to a virtual..." gnus-group-add-to-virtual t]
["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
@@ -1129,8 +1129,8 @@ The following commands are available:
(gnus-update-group-mark-positions)
(when gnus-use-undo
(gnus-undo-mode 1))
- (when gnus-slave
- (gnus-slave-mode)))
+ (when gnus-child
+ (gnus-child-mode)))
(defun gnus-update-group-mark-positions ()
(save-excursion
@@ -1768,7 +1768,7 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated."
(get-text-property (point-at-bol) 'gnus-unread))
(defun gnus-group-new-mail (group)
- (if (nnmail-new-mail-p (gnus-group-real-name group))
+ (if (nnmail-new-mail-p group)
gnus-new-mail-mark
?\s))
@@ -2411,13 +2411,13 @@ the bug number, and browsing the URL must return mbox output."
(require 'bug-reference)
(let ((def (cond ((thing-at-point-looking-at bug-reference-bug-regexp 500)
(match-string 2))
- ((number-at-point)))))
+ ((and (number-at-point)
+ (abs (number-at-point)))))))
;; Pass DEF as the value of COLLECTION instead of DEF because:
;; a) null input should not cause DEF to be returned and
;; b) TAB and M-n still work this way.
- (or (completing-read-multiple
- (format "Bug IDs%s: " (if def (format " (default %s)" def) ""))
- (and def (list (format "%s" def))))
+ (or (completing-read-multiple (format-prompt "Bug IDs" def)
+ (and def (list (format "%s" def))))
def)))
(defun gnus-read-ephemeral-bug-group (ids mbox-url &optional window-conf)
@@ -3165,6 +3165,115 @@ mail messages or news articles in files that have numeric names."
(gnus-group-real-name group)
(list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
+
+(autoload 'nnir-read-parms "nnir")
+(autoload 'nnir-server-to-search-engine "nnir")
+(autoload 'gnus-group-topic-name "gnus-topic")
+
+;; Temporary to make group creation easier
+(defun gnus-group-make-search-group (nnir-extra-parms &optional specs)
+ "Make a group based on a search.
+Prompt for a search query and determine the groups to search as
+follows: if called from the *Server* buffer search all groups
+belonging to the server on the current line; if called from the
+*Group* buffer search any marked groups, or the group on the
+current line, or all the groups under the current topic. Calling
+with a prefix arg prompts for additional search-engine specific
+constraints. A non-nil SPECS arg must be an alist with
+`nnir-query-spec' and `nnir-group-spec' keys, and skips all
+prompting."
+ (interactive "P")
+ (let ((name (gnus-read-group "Group name: ")))
+ (with-current-buffer gnus-group-buffer
+ (let* ((group-spec
+ (or
+ (cdr (assq 'nnir-group-spec specs))
+ (if (gnus-server-server-name)
+ (list (list (gnus-server-server-name)))
+ (seq-group-by
+ (lambda (elt) (gnus-group-server elt))
+ (or gnus-group-marked
+ (if (gnus-group-group-name)
+ (list (gnus-group-group-name))
+ (cdr
+ (assoc (gnus-group-topic-name) gnus-topic-alist))))))))
+ (query-spec
+ (or
+ (cdr (assq 'nnir-query-spec specs))
+ (apply
+ 'append
+ (list (cons 'query
+ (read-string "Query: " nil 'nnir-search-history)))
+ (when nnir-extra-parms
+ (mapcar
+ (lambda (x)
+ (nnir-read-parms (nnir-server-to-search-engine (car x))))
+ group-spec))))))
+ (gnus-group-make-group
+ name
+ (list 'nnselect "nnselect")
+ nil
+ (list
+ (cons 'nnselect-specs
+ (list
+ (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-args
+ (list (cons 'nnir-query-spec query-spec)
+ (cons 'nnir-group-spec group-spec)))))
+ (cons 'nnselect-artlist nil)))))))
+
+(define-obsolete-function-alias 'gnus-group-make-nnir-group
+ 'gnus-group-read-ephemeral-search-group "28.1")
+
+(defun gnus-group-read-ephemeral-search-group (nnir-extra-parms &optional specs)
+ "Read an nnselect group based on a search.
+Prompt for a search query and determine the groups to search as
+follows: if called from the *Server* buffer search all groups
+belonging to the server on the current line; if called from the
+*Group* buffer search any marked groups, or the group on the
+current line, or all the groups under the current topic. Calling
+with a prefix arg prompts for additional search-engine specific
+constraints. A non-nil SPECS arg must be an alist with
+`nnir-query-spec' and `nnir-group-spec' keys, and skips all
+prompting."
+ (interactive "P")
+ (let* ((group-spec
+ (or (cdr (assq 'nnir-group-spec specs))
+ (if (gnus-server-server-name)
+ (list (list (gnus-server-server-name)))
+ (seq-group-by
+ (lambda (elt) (gnus-group-server elt))
+ (or gnus-group-marked
+ (if (gnus-group-group-name)
+ (list (gnus-group-group-name))
+ (cdr
+ (assoc (gnus-group-topic-name) gnus-topic-alist))))))))
+ (query-spec
+ (or (cdr (assq 'nnir-query-spec specs))
+ (apply
+ 'append
+ (list (cons 'query
+ (read-string "Query: " nil 'nnir-search-history)))
+ (when nnir-extra-parms
+ (mapcar
+ (lambda (x)
+ (nnir-read-parms (nnir-server-to-search-engine (car x))))
+ group-spec))))))
+ (gnus-group-read-ephemeral-group
+ (concat "nnselect-" (message-unique-id))
+ (list 'nnselect "nnselect")
+ nil
+ (cons (current-buffer) gnus-current-window-configuration)
+ nil nil
+ (list
+ (cons 'nnselect-specs
+ (list
+ (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-args
+ (list (cons 'nnir-query-spec query-spec)
+ (cons 'nnir-group-spec group-spec)))))
+ (cons 'nnselect-artlist nil)))))
+
(defun gnus-group-add-to-virtual (n vgroup)
"Add the current group to a virtual group."
(interactive
@@ -3600,7 +3709,7 @@ or nil if no action could be taken."
(marks (gnus-info-marks (nth 1 entry)))
(unread (gnus-sequence-of-unread-articles group)))
;; Remove entries for this group.
- (nnmail-purge-split-history (gnus-group-real-name group))
+ (nnmail-purge-split-history group)
;; Do the updating only if the newsgroup isn't killed.
(if (not (numberp (car entry)))
(gnus-message 1 "Can't catch up %s; non-active group" group)
@@ -3697,9 +3806,8 @@ Uses the process/prefix convention."
(error "No group on the current line"))
(string-to-number
(let ((s (read-string
- (format "Level (default %s): "
- (or (gnus-group-group-level)
- gnus-level-default-subscribed)))))
+ (format-prompt "Level" (or (gnus-group-group-level)
+ gnus-level-default-subscribed)))))
(if (string-match "^\\s-*$" s)
(int-to-string (or (gnus-group-group-level)
gnus-level-default-subscribed))
@@ -3761,10 +3869,10 @@ group line."
(newsrc
;; Toggle subscription flag.
(gnus-group-change-level
- newsrc (if level level (if (<= (gnus-info-level (nth 1 newsrc))
- gnus-level-subscribed)
- (1+ gnus-level-subscribed)
- gnus-level-default-subscribed)))
+ newsrc (or level (if (<= (gnus-info-level (nth 1 newsrc))
+ gnus-level-subscribed)
+ (1+ gnus-level-subscribed)
+ gnus-level-default-subscribed)))
(unless silent
(gnus-group-update-group group)))
((and (stringp group)
@@ -3773,7 +3881,7 @@ group line."
;; Add new newsgroup.
(gnus-group-change-level
group
- (if level level gnus-level-default-subscribed)
+ (or level gnus-level-default-subscribed)
(or (and (member group gnus-zombie-list)
gnus-level-zombie)
gnus-level-killed)
@@ -4024,9 +4132,9 @@ otherwise all levels below ARG will be scanned too."
(gnus-run-hooks 'gnus-get-top-new-news-hook)
(gnus-run-hooks 'gnus-get-new-news-hook)
- ;; Read any slave files.
- (unless gnus-slave
- (gnus-master-read-slave-newsrc))
+ ;; Read any child files.
+ (unless gnus-child
+ (gnus-parent-read-child-newsrc))
(gnus-get-unread-articles (gnus-group-default-level arg t)
nil one-level)
@@ -4300,8 +4408,7 @@ The hook `gnus-suspend-gnus-hook' is called before actually suspending."
;; Closing all the backends is useful (for instance) when when the
;; IP addresses have changed and you need to reconnect.
(dolist (elem gnus-opened-servers)
- (gnus-close-server (car elem))
- (setcar (cdr elem) 'closed))
+ (gnus-close-server (car elem)))
(when group-buf
(bury-buffer group-buf)
(delete-windows-on group-buf t))))
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index ee556a32080..7d4fa6c35cc 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -5,18 +5,20 @@
;; Author: Jan Tatarik <Jan.Tatarik@gmail.com>
;; Keywords: mail, icalendar, org
-;; 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:
@@ -132,11 +134,27 @@
(cl-defmethod gnus-icalendar-event:recurring-interval ((event gnus-icalendar-event))
"Return recurring interval of EVENT."
(let ((rrule (gnus-icalendar-event:recur event))
- (default-interval 1))
+ (default-interval "1"))
+
+ (if (string-match "INTERVAL=\\([[:digit:]]+\\)" rrule)
+ (match-string 1 rrule)
+ default-interval)))
- (string-match "INTERVAL=\\([[:digit:]]+\\)" rrule)
- (or (match-string 1 rrule)
- default-interval)))
+(cl-defmethod gnus-icalendar-event:recurring-days ((event gnus-icalendar-event))
+ "Return, when available, the week day numbers on which the EVENT recurs."
+ (let ((rrule (gnus-icalendar-event:recur event))
+ (weekday-map '(("SU" . 0)
+ ("MO" . 1)
+ ("TU" . 2)
+ ("WE" . 3)
+ ("TH" . 4)
+ ("FR" . 5)
+ ("SA" . 6))))
+ (when (and rrule (string-match "BYDAY=\\([^;]+\\)" rrule))
+ (let ((bydays (split-string (match-string 1 rrule) ",")))
+ (seq-map
+ (lambda (x) (cdr (assoc x weekday-map)))
+ (seq-filter (lambda (x) (string-match "^[A-Z]\\{2\\}$" x)) bydays))))))
(cl-defmethod gnus-icalendar-event:start ((event gnus-icalendar-event))
(format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event)))
@@ -312,7 +330,8 @@ status will be retrieved from the first matching attendee record."
(unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x))
reply-event-lines)
- (error "Could not find an event attendee matching given identity"))
+ (lwarn 'gnus-icalendar :warning
+ "Could not find an event attendee matching given identity"))
(mapconcat #'identity `("BEGIN:VEVENT"
,@(nreverse reply-event-lines)
@@ -400,21 +419,26 @@ Return nil for non-recurring EVENT."
(when org-freq
(format "+%s%s" (gnus-icalendar-event:recurring-interval event) org-freq)))))
-(cl-defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event))
- "Build `org-mode' timestamp from EVENT start/end dates and recurrence info."
- (let* ((start (gnus-icalendar-event:start-time event))
- (end (gnus-icalendar-event:end-time event))
- (start-date (format-time-string "%Y-%m-%d" start))
+(defun gnus-icalendar--find-day (start-date end-date day)
+ (let ((time-1-day 86400))
+ (if (= (decoded-time-weekday (decode-time start-date))
+ day)
+ (list start-date end-date)
+ (gnus-icalendar--find-day (time-add start-date time-1-day)
+ (time-add end-date time-1-day)
+ day))))
+
+(defun gnus-icalendar-event--org-timestamp (start end org-repeat)
+ (let* ((start-date (format-time-string "%Y-%m-%d" start))
(start-time (format-time-string "%H:%M" start))
(start-at-midnight (string= start-time "00:00"))
(end-date (format-time-string "%Y-%m-%d" end))
(end-time (format-time-string "%H:%M" end))
(end-at-midnight (string= end-time "00:00"))
(start-end-date-diff
- (time-to-number-of-days (time-subtract
- (org-time-string-to-time end-date)
- (org-time-string-to-time start-date))))
- (org-repeat (gnus-icalendar-event:org-repeat event))
+ (time-to-number-of-days
+ (time-subtract (org-time-string-to-time end-date)
+ (org-time-string-to-time start-date))))
(repeat (if org-repeat (concat " " org-repeat) ""))
(time-1-day 86400))
@@ -445,7 +469,31 @@ Return nil for non-recurring EVENT."
;; A .:. - A .:. -> A .:.-.:.
;; A .:. - B .:.
((zerop start-end-date-diff) (format "<%s %s-%s%s>" start-date start-time end-time repeat))
- (t (format "<%s %s>--<%s %s>" start-date start-time end-date end-time)))))
+ (t (format "<%s %s>--<%s %s>" start-date start-time end-date end-time))))
+ )
+
+(cl-defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event))
+ "Build `org-mode' timestamp from EVENT start/end dates and recurrence info."
+ ;; if org-repeat +1d or +1w and byday: generate one timestamp per
+ ;; byday, starting at start-date. Change +1d to +7d.
+ (let ((start (gnus-icalendar-event:start-time event))
+ (end (gnus-icalendar-event:end-time event))
+ (org-repeat (gnus-icalendar-event:org-repeat event))
+ (recurring-days (gnus-icalendar-event:recurring-days event)))
+ (if (and (or (string= org-repeat "+1d")
+ (string= org-repeat "+1w"))
+ recurring-days)
+ (let ((repeat "+1w")
+ (dates (seq-sort-by
+ 'car
+ 'time-less-p
+ (seq-map (lambda (x)
+ (gnus-icalendar--find-day start end x))
+ recurring-days))))
+ (mapconcat (lambda (x)
+ (gnus-icalendar-event--org-timestamp (car x) (cadr x)
+ repeat)) dates "\n"))
+ (gnus-icalendar-event--org-timestamp start end org-repeat))))
(defun gnus-icalendar--format-summary-line (summary &optional location)
(if location
@@ -756,7 +804,7 @@ These will be used to retrieve the RSVP information from ical events."
`(let ((,charset (cdr (assoc 'charset (mm-handle-type ,handle)))))
(with-temp-buffer
(mm-insert-part ,handle)
- (when (string= (downcase ,charset) "utf-8")
+ (when (and ,charset (string= (downcase ,charset) "utf-8"))
(decode-coding-region (point-min) (point-max) 'utf-8))
,@body))))
@@ -814,7 +862,7 @@ These will be used to retrieve the RSVP information from ical events."
(let ((subject (concat (capitalize (symbol-name status))
": " (gnus-icalendar-event:summary event))))
- (with-current-buffer (get-buffer-create gnus-icalendar-reply-bufname)
+ (with-current-buffer (gnus-get-buffer-create gnus-icalendar-reply-bufname)
(delete-region (point-min) (point-max))
(insert reply)
(fold-icalendar-buffer)
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index c304f575d92..b8be766c84f 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -253,7 +253,7 @@ If it is down, start it up (again)."
(defun gnus-backend-trace (type form)
(when gnus-backend-trace
- (with-current-buffer (get-buffer-create "*gnus trace*")
+ (with-current-buffer (gnus-get-buffer-create "*gnus trace*")
(buffer-disable-undo)
(goto-char (point-max))
(insert (format-time-string "%H:%M:%S")
@@ -351,9 +351,12 @@ If it is down, start it up (again)."
"Close the connection to GNUS-COMMAND-METHOD."
(when (stringp gnus-command-method)
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'close-server)
- (nth 1 gnus-command-method)
- (nthcdr 2 gnus-command-method)))
+ (prog1
+ (funcall (gnus-get-function gnus-command-method 'close-server)
+ (nth 1 gnus-command-method)
+ (nthcdr 2 gnus-command-method))
+ (when-let ((elem (assoc gnus-command-method gnus-opened-servers)))
+ (setf (nth 1 elem) 'closed))))
(defun gnus-request-list (gnus-command-method)
"Request the active file from GNUS-COMMAND-METHOD."
@@ -362,6 +365,48 @@ If it is down, start it up (again)."
(funcall (gnus-get-function gnus-command-method 'request-list)
(nth 1 gnus-command-method)))
+(defun gnus-server-get-active (server &optional ignored)
+ "Return the active list for SERVER.
+Groups matching the IGNORED regexp are excluded."
+ (let ((method (gnus-server-to-method server))
+ groups)
+ (gnus-request-list method)
+ (with-current-buffer nntp-server-buffer
+ (let ((cur (current-buffer)))
+ (goto-char (point-min))
+ (unless (or (null ignored)
+ (string= ignored ""))
+ (delete-matching-lines ignored))
+ (if (eq (car method) 'nntp)
+ (while (not (eobp))
+ (ignore-errors
+ (push (gnus-group-full-name
+ (buffer-substring
+ (point)
+ (progn
+ (skip-chars-forward "^ \t")
+ (point)))
+ method)
+ groups))
+ (forward-line))
+ (while (not (eobp))
+ (ignore-errors
+ (push (if (eq (char-after) ?\")
+ (gnus-group-full-name (read cur) method)
+ (let ((p (point)) (name ""))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ (gnus-group-full-name name method)))
+ groups))
+ (forward-line)))))
+ groups))
+
(defun gnus-finish-retrieve-group-infos (gnus-command-method infos data)
"Read and update infos from GNUS-COMMAND-METHOD."
(when (stringp gnus-command-method)
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index 5edbaaf201b..a772281d4c3 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -653,7 +653,7 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score"
gnus-options-not-subscribe)
;; Eat all arguments.
(setq command-line-args-left nil)
- (gnus-slave)
+ (gnus-child)
;; Apply kills to specified newsgroups in command line arguments.
(setq newsrc (cdr gnus-newsrc-alist))
(while (setq info (pop newsrc))
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index daaea3980b5..465871eafbd 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -393,10 +393,9 @@ only affect the Gcc copy, but not the original message."
(gnus-inews-make-draft-meta-information
,gnus-newsgroup-name ',articles)))
-(autoload 'nnir-article-number "nnir" nil nil 'macro)
-(autoload 'nnir-article-group "nnir" nil nil 'macro)
-(autoload 'gnus-nnir-group-p "nnir")
-
+(autoload 'nnselect-article-number "nnselect" nil nil 'macro)
+(autoload 'nnselect-article-group "nnselect" nil nil 'macro)
+(autoload 'gnus-nnselect-group-p "nnselect")
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
@@ -404,22 +403,24 @@ only affect the Gcc copy, but not the original message."
(winconf-name (make-symbol "gnus-setup-message-winconf-name"))
(buffer (make-symbol "gnus-setup-message-buffer"))
(article (make-symbol "gnus-setup-message-article"))
+ (oarticle (make-symbol "gnus-setup-message-oarticle"))
(yanked (make-symbol "gnus-setup-yanked-articles"))
(group (make-symbol "gnus-setup-message-group")))
`(let ((,winconf (current-window-configuration))
(,winconf-name gnus-current-window-configuration)
(,buffer (buffer-name (current-buffer)))
- (,article (if (and (gnus-nnir-group-p gnus-newsgroup-name)
- gnus-article-reply)
- (nnir-article-number (or (car-safe gnus-article-reply)
- gnus-article-reply))
- gnus-article-reply))
+ (,article (when gnus-article-reply
+ (or (nnselect-article-number
+ (or (car-safe gnus-article-reply)
+ gnus-article-reply))
+ gnus-article-reply)))
+ (,oarticle gnus-article-reply)
(,yanked gnus-article-yanked-articles)
- (,group (if (and (gnus-nnir-group-p gnus-newsgroup-name)
- gnus-article-reply)
- (nnir-article-group (or (car-safe gnus-article-reply)
- gnus-article-reply))
- gnus-newsgroup-name))
+ (,group (when gnus-article-reply
+ (or (nnselect-article-group
+ (or (car-safe gnus-article-reply)
+ gnus-article-reply))
+ gnus-newsgroup-name)))
(message-header-setup-hook
(copy-sequence message-header-setup-hook))
(mbl mml-buffer-list)
@@ -460,24 +461,23 @@ only affect the Gcc copy, but not the original message."
(unwind-protect
(progn
,@forms)
- (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
+ (gnus-inews-add-send-actions ,winconf ,buffer ,oarticle ,config
,yanked ,winconf-name)
(setq gnus-message-buffer (current-buffer))
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
- (set (make-local-variable 'gnus-newsgroup-name) ,group)
- ;; Enable highlighting of different citation levels
- (when gnus-message-highlight-citation
- (gnus-message-citation-mode 1))
- (gnus-run-hooks 'gnus-message-setup-hook)
- (if (eq major-mode 'message-mode)
- (let ((mbl1 mml-buffer-list))
- (setq mml-buffer-list mbl) ;; Global value
- (set (make-local-variable 'mml-buffer-list) mbl1);; Local value
- (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
- (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
- (mml-destroy-buffers)
- (setq mml-buffer-list mbl)))
+ ;; Enable highlighting of different citation levels
+ (when gnus-message-highlight-citation
+ (gnus-message-citation-mode 1))
+ (gnus-run-hooks 'gnus-message-setup-hook)
+ (if (eq major-mode 'message-mode)
+ (let ((mbl1 mml-buffer-list))
+ (setq mml-buffer-list mbl) ;; Global value
+ (set (make-local-variable 'mml-buffer-list) mbl1);; Local value
+ (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
+ (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
+ (mml-destroy-buffers)
+ (setq mml-buffer-list mbl)))
(message-hide-headers)
(gnus-add-buffer)
(gnus-configure-windows ,config t)
@@ -521,12 +521,10 @@ instead."
mail-buf)
(unwind-protect
(progn
- (setq gnus-newsgroup-name "")
+ (let ((gnus-newsgroup-name ""))
(gnus-setup-message 'message
(message-mail to subject other-headers continue
- nil yank-action send-actions return-action)))
- (with-current-buffer buf
- (setq gnus-newsgroup-name group-name)))
+ nil yank-action send-actions return-action)))))
(when switch-action
(setq mail-buf (current-buffer))
(switch-to-buffer buf)
@@ -617,18 +615,15 @@ If ARG is 1, prompt for a group name to find the posting style."
(buffer (current-buffer)))
(unwind-protect
(progn
- (setq gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (gnus-group-completing-read
- "Use posting style of group"
- nil (gnus-read-active-file-p))
- (gnus-group-group-name))
- ""))
- ;; #### see comment in gnus-setup-message -- drv
- (gnus-setup-message 'message (message-mail)))
- (with-current-buffer buffer
- (setq gnus-newsgroup-name group)))))
+ (let ((gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (gnus-group-completing-read
+ "Use posting style of group"
+ nil (gnus-read-active-file-p))
+ (gnus-group-group-name))
+ "")))
+ (gnus-setup-message 'message (message-mail)))))))
(defun gnus-group-news (&optional arg)
"Start composing a news.
@@ -647,19 +642,16 @@ network. The corresponding back end must have a `request-post' method."
(buffer (current-buffer)))
(unwind-protect
(progn
- (setq gnus-newsgroup-name
+ (let ((gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
(gnus-group-completing-read "Use group"
nil
(gnus-read-active-file-p))
(gnus-group-group-name))
- ""))
- ;; #### see comment in gnus-setup-message -- drv
+ "")))
(gnus-setup-message 'message
- (message-news (gnus-group-real-name gnus-newsgroup-name))))
- (with-current-buffer buffer
- (setq gnus-newsgroup-name group)))))
+ (message-news (gnus-group-real-name gnus-newsgroup-name))))))))
(defun gnus-group-post-news (&optional arg)
"Start composing a message (a news by default).
@@ -694,18 +686,15 @@ posting style."
(buffer (current-buffer)))
(unwind-protect
(progn
- (setq gnus-newsgroup-name
+ (let ((gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
(gnus-group-completing-read "Use group"
nil
(gnus-read-active-file-p))
"")
- gnus-newsgroup-name))
- ;; #### see comment in gnus-setup-message -- drv
- (gnus-setup-message 'message (message-mail)))
- (with-current-buffer buffer
- (setq gnus-newsgroup-name group)))))
+ gnus-newsgroup-name)))
+ (gnus-setup-message 'message (message-mail)))))))
(defun gnus-summary-news-other-window (&optional arg)
"Start composing a news in another window.
@@ -724,24 +713,21 @@ network. The corresponding back end must have a `request-post' method."
(buffer (current-buffer)))
(unwind-protect
(progn
- (setq gnus-newsgroup-name
+ (let ((gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
(gnus-group-completing-read "Use group"
nil
(gnus-read-active-file-p))
"")
- gnus-newsgroup-name))
- ;; #### see comment in gnus-setup-message -- drv
+ gnus-newsgroup-name)))
(gnus-setup-message 'message
(progn
(message-news (gnus-group-real-name gnus-newsgroup-name))
(set (make-local-variable 'gnus-discouraged-post-methods)
(remove
(car (gnus-find-method-for-group gnus-newsgroup-name))
- gnus-discouraged-post-methods)))))
- (with-current-buffer buffer
- (setq gnus-newsgroup-name group)))))
+ gnus-discouraged-post-methods)))))))))
(defun gnus-summary-post-news (&optional arg)
"Start composing a message. Post to the current group by default.
@@ -823,7 +809,7 @@ active, the entire article will be yanked."
(with-current-buffer gnus-article-copy
(save-restriction
(nnheader-narrow-to-headers)
- (nnheader-parse-naked-head)))))
+ (nnheader-parse-head t)))))
(message-yank-original)
(message-exchange-point-and-mark)
(setq beg (or beg (mark t))))
@@ -1366,8 +1352,10 @@ For the \"inline\" alternatives, also see the variable
gcc)))
(insert "Gcc: " (mapconcat 'identity gcc ", ") "\n")))))))
-(defun gnus-summary-resend-message (address n)
- "Resend the current article to ADDRESS."
+(defun gnus-summary-resend-message (address n &optional no-select)
+ "Resend the current article to ADDRESS.
+Uses the process/prefix convention. If NO-SELECT, don't display
+the message before resending."
(interactive
(list (message-read-from-minibuffer
"Resend message(s) to: "
@@ -1386,6 +1374,7 @@ For the \"inline\" alternatives, also see the variable
'posting-style t))
(user-full-name user-full-name)
(user-mail-address user-mail-address)
+ (group gnus-newsgroup-name)
tem)
(dolist (style styles)
(when (stringp (cadr style))
@@ -1409,11 +1398,18 @@ For the \"inline\" alternatives, also see the variable
'(gnus-agent-possibly-do-gcc)
'(gnus-inews-do-gcc)))))
(dolist (article (gnus-summary-work-articles n))
- (gnus-summary-select-article nil nil nil article)
- (with-current-buffer gnus-original-article-buffer
- (let ((gnus-gcc-externalize-attachments nil)
- (message-inhibit-body-encoding t))
- (message-resend address)))
+ (if no-select
+ (with-current-buffer " *nntpd*"
+ (erase-buffer)
+ (gnus-request-article article group)
+ (let ((gnus-gcc-externalize-attachments nil)
+ (message-inhibit-body-encoding t))
+ (message-resend address)))
+ (gnus-summary-select-article nil nil nil article)
+ (with-current-buffer gnus-original-article-buffer
+ (let ((gnus-gcc-externalize-attachments nil)
+ (message-inhibit-body-encoding t))
+ (message-resend address))))
(gnus-summary-mark-article-as-forwarded article))))
;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
@@ -1510,7 +1506,11 @@ If YANK is non-nil, include the original article."
(gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
(defun gnus-bug (subject)
- "Send a bug report to the Emacs maintainers."
+ "Send a bug report to the Emacs maintainers.
+
+Already submitted bugs can be found in the Emacs bug tracker:
+
+ https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1"
(interactive "sBug Subject: ")
(report-emacs-bug subject)
(save-excursion
@@ -1594,7 +1594,7 @@ this is a reply."
(message-remove-header "gcc")
(widen)
(setq groups (message-unquote-tokens
- (message-tokenize-header gcc " ,")))
+ (message-tokenize-header gcc " ,\n\t")))
;; Copy the article over to some group(s).
(while (setq group (pop groups))
(setq method (gnus-inews-group-method group)
@@ -1989,10 +1989,10 @@ process-mark several articles, they will all be attached."
(gnus-summary-iterate n
(gnus-summary-select-article)
(with-current-buffer destination
- ;; Attach at the end of the buffer.
- (save-excursion
- (goto-char (point-max))
- (message-forward-make-body-mime gnus-original-article-buffer))))
+ ;; Attach at the end of the buffer.
+ (save-excursion
+ (goto-char (point-max))
+ (message-forward-make-body-mime gnus-original-article-buffer))))
(gnus-configure-windows 'message t)))
(provide 'gnus-msg)
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index fd2b44f7424..65bcd0e8a36 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -1,4 +1,4 @@
-;;; gnus-registry.el --- article registry for Gnus
+;;; gnus-registry.el --- article registry for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
@@ -62,10 +62,10 @@
;; show the marks as single characters (see the :char property in
;; `gnus-registry-marks'):
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
+;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars)
;; show the marks by name (see `gnus-registry-marks'):
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
+;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-names)
;; TODO:
@@ -427,6 +427,8 @@ This is not required after changing `gnus-registry-cache-file'."
(gnus-message 4 "Removed %d ignored entries from the Gnus registry"
(- old-size (registry-size db)))))
+(declare-function gnus-nnselect-group-p "nnselect" (group))
+(declare-function nnselect-article-group "nnselect" (article))
;; article move/copy/spool/delete actions
(defun gnus-registry-action (action data-header from &optional to method)
(let* ((id (mail-header-id data-header))
@@ -437,7 +439,10 @@ This is not required after changing `gnus-registry-cache-file'."
(or (cdr-safe (assq 'To extra)) "")))
(sender (nth 0 (gnus-registry-extract-addresses
(mail-header-from data-header))))
- (from (gnus-group-guess-full-name-from-command-method from))
+ (from (gnus-group-guess-full-name-from-command-method
+ (if (gnus-nnselect-group-p from)
+ (nnselect-article-group (mail-header-number data-header))
+ from)))
(to (if to (gnus-group-guess-full-name-from-command-method to) nil)))
(gnus-message 7 "Gnus registry: article %s %s from %s to %s"
id (if method "respooling" "going") from to)
@@ -449,19 +454,21 @@ This is not required after changing `gnus-registry-cache-file'."
to subject sender recipients)))
(defun gnus-registry-spool-action (id group &optional subject sender recipients)
- (let ((to (gnus-group-guess-full-name-from-command-method group))
- (recipients (or recipients
- (gnus-registry-sort-addresses
- (or (message-fetch-field "cc") "")
- (or (message-fetch-field "to") ""))))
- (subject (or subject (message-fetch-field "subject")))
- (sender (or sender (message-fetch-field "from"))))
- (when (and (stringp id) (string-match "\r$" id))
- (setq id (substring id 0 -1)))
- (gnus-message 7 "Gnus registry: article %s spooled to %s"
- id
- to)
- (gnus-registry-handle-action id nil to subject sender recipients)))
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (let ((to (gnus-group-guess-full-name-from-command-method group))
+ (recipients (or recipients
+ (gnus-registry-sort-addresses
+ (or (message-fetch-field "cc") "")
+ (or (message-fetch-field "to") ""))))
+ (subject (or subject (message-fetch-field "subject")))
+ (sender (or sender (message-fetch-field "from"))))
+ (when (and (stringp id) (string-match "\r$" id))
+ (setq id (substring id 0 -1)))
+ (gnus-message 7 "Gnus registry: article %s spooled to %s"
+ id
+ to)
+ (gnus-registry-handle-action id nil to subject sender recipients))))
(defun gnus-registry-handle-action (id from to subject sender
&optional recipients)
@@ -485,23 +492,25 @@ This is not required after changing `gnus-registry-cache-file'."
(when from
(setq entry (cons (delete from (assoc 'group entry))
(assq-delete-all 'group entry))))
-
- (dolist (kv `((group ,to)
- (sender ,sender)
- (recipient ,@recipients)
- (subject ,subject)))
- (when (cadr kv)
- (let ((new (or (assq (car kv) entry)
- (list (car kv)))))
- (dolist (toadd (cdr kv))
- (unless (member toadd new)
- (setq new (append new (list toadd)))))
- (setq entry (cons new
- (assq-delete-all (car kv) entry))))))
- (gnus-message 10 "Gnus registry: new entry for %s is %S"
- id
- entry)
- (gnus-registry-insert db id entry)))
+ ;; Only keep the entry if the message is going to a new group, or
+ ;; it's still in some previous group.
+ (when (or to (alist-get 'group entry))
+ (dolist (kv `((group ,to)
+ (sender ,sender)
+ (recipient ,@recipients)
+ (subject ,subject)))
+ (when (cadr kv)
+ (let ((new (or (assq (car kv) entry)
+ (list (car kv)))))
+ (dolist (toadd (cdr kv))
+ (unless (member toadd new)
+ (setq new (append new (list toadd)))))
+ (setq entry (cons new
+ (assq-delete-all (car kv) entry))))))
+ (gnus-message 10 "Gnus registry: new entry for %s is %S"
+ id
+ entry)
+ (gnus-registry-insert db id entry))))
;; Function for nn{mail|imap}-split-fancy: look up all references in
;; the cache and if a match is found, return that group.
@@ -588,7 +597,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
subject
(< gnus-registry-minimum-subject-length (length subject)))
(let ((groups (apply
- 'append
+ #'append
(mapcar
(lambda (reference)
(gnus-registry-get-id-key reference 'group))
@@ -615,7 +624,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
sender
gnus-registry-unfollowed-addresses)))
(let ((groups (apply
- 'append
+ #'append
(mapcar
(lambda (reference)
(gnus-registry-get-id-key reference 'group))
@@ -644,7 +653,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(not (gnus-grep-in-list
recp
gnus-registry-unfollowed-addresses)))
- (let ((groups (apply 'append
+ (let ((groups (apply #'append
(mapcar
(lambda (reference)
(gnus-registry-get-id-key reference 'group))
@@ -663,7 +672,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
;; filter the found groups and return them
;; the found groups are NOT the full groups
(setq found (gnus-registry-post-process-groups
- "recipients" (mapconcat 'identity recipients ", ") found)))
+ "recipients" (mapconcat #'identity recipients ", ") found)))
;; after the (cond) we extract the actual value safely
(car-safe found)))
@@ -784,14 +793,15 @@ Consults `gnus-registry-unfollowed-groups' and
Consults `gnus-registry-ignored-groups' and
`nnmail-split-fancy-with-parent-ignore-groups'."
(and group
- (or (gnus-grep-in-list
+ (or (gnus-virtual-group-p group) (gnus-grep-in-list
group
(delq nil (mapcar (lambda (g)
(cond
((stringp g) g)
((and (listp g) (nth 1 g))
(nth 0 g))
- (t nil))) gnus-registry-ignored-groups)))
+ (t nil)))
+ gnus-registry-ignored-groups)))
;; only use `gnus-parameter-registry-ignore' if
;; `gnus-registry-ignored-groups' is a list of lists
;; (it can be a list of regexes)
@@ -871,7 +881,7 @@ Addresses without a name will say \"noname\"."
(defun gnus-registry-sort-addresses (&rest addresses)
"Return a normalized and sorted list of ADDRESSES."
- (sort (mapcan 'gnus-registry-extract-addresses addresses) 'string-lessp))
+ (sort (mapcan #'gnus-registry-extract-addresses addresses) 'string-lessp))
(defun gnus-registry-simplify-subject (subject)
(if (stringp subject)
@@ -961,16 +971,15 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
(intern (format function-format variant-name)))
(shortcut (format "%c" (if remove (upcase data) data))))
(defalias function-name
- ;; If it weren't for the function's docstring, we could
- ;; use a closure, with lexical-let :-(
- `(lambda (&rest articles)
- ,(format
- "%s the %s mark over process-marked ARTICLES."
- (upcase-initials variant-name)
- mark)
- (interactive
- (gnus-summary-work-articles current-prefix-arg))
- (gnus-registry--set/remove-mark ',mark ',remove articles)))
+ (lambda (&rest articles)
+ (:documentation
+ (format
+ "%s the %s mark over process-marked ARTICLES."
+ (upcase-initials variant-name)
+ mark))
+ (interactive
+ (gnus-summary-work-articles current-prefix-arg))
+ (gnus-registry--set/remove-mark mark remove articles)))
(push function-name keys-plist)
(push shortcut keys-plist)
(push (vector (format "%s %s"
@@ -990,14 +999,11 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
nil
(cons "Registry Marks" gnus-registry-misc-menus))))))
-(make-obsolete 'gnus-registry-user-format-function-M
- 'gnus-registry-article-marks-to-chars "24.1") ?
-
-(defalias 'gnus-registry-user-format-function-M
- 'gnus-registry-article-marks-to-chars)
+(define-obsolete-function-alias 'gnus-registry-user-format-function-M
+ #'gnus-registry-article-marks-to-chars "24.1")
;; use like this:
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
+;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars)
(defun gnus-registry-article-marks-to-chars (headers)
"Show the marks for an article by the :char property."
(if gnus-registry-enabled
@@ -1013,20 +1019,20 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
""))
;; use like this:
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
+;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-names)
(defun gnus-registry-article-marks-to-names (headers)
"Show the marks for an article by name."
(if gnus-registry-enabled
(let* ((id (mail-header-message-id headers))
(marks (when id (gnus-registry-get-id-key id 'mark))))
- (mapconcat (lambda (mark) (symbol-name mark)) marks ","))
+ (mapconcat #'symbol-name marks ","))
""))
(defun gnus-registry-read-mark ()
"Read a mark name from the user with completion."
(let ((mark (gnus-completing-read
"Label"
- (mapcar 'symbol-name (mapcar 'car gnus-registry-marks))
+ (mapcar #'symbol-name (mapcar #'car gnus-registry-marks))
nil nil nil
(symbol-name gnus-registry-default-mark))))
(when (stringp mark)
@@ -1050,7 +1056,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
show-message)
"Apply or remove MARK across a list of ARTICLES."
(let ((article-id-list
- (mapcar 'gnus-registry-fetch-message-id-fast articles)))
+ (mapcar #'gnus-registry-fetch-message-id-fast articles)))
(dolist (id article-id-list)
(let* ((marks (delq mark (gnus-registry-get-id-key id 'mark)))
(marks (if remove marks (cons mark marks))))
@@ -1173,34 +1179,34 @@ only the last one's marks are returned."
(gnus-registry-install-shortcuts)
(if (gnus-alive-p)
(gnus-registry-load)
- (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load)))
+ (add-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load)))
(defun gnus-registry-install-hooks ()
"Install the registry hooks."
(setq gnus-registry-enabled t)
- (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
- (add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
- (add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
- (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
+ (add-hook 'gnus-summary-article-move-hook #'gnus-registry-action)
+ (add-hook 'gnus-summary-article-delete-hook #'gnus-registry-action)
+ (add-hook 'gnus-summary-article-expire-hook #'gnus-registry-action)
+ (add-hook 'nnmail-spool-hook #'gnus-registry-spool-action)
- (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
+ (add-hook 'gnus-save-newsrc-hook #'gnus-registry-save)
- (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
+ (add-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids))
(defun gnus-registry-unload-hook ()
"Uninstall the registry hooks."
- (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
- (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
- (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
- (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
+ (remove-hook 'gnus-summary-article-move-hook #'gnus-registry-action)
+ (remove-hook 'gnus-summary-article-delete-hook #'gnus-registry-action)
+ (remove-hook 'gnus-summary-article-expire-hook #'gnus-registry-action)
+ (remove-hook 'nnmail-spool-hook #'gnus-registry-spool-action)
- (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
- (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load)
+ (remove-hook 'gnus-save-newsrc-hook #'gnus-registry-save)
+ (remove-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load)
- (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)
+ (remove-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids)
(setq gnus-registry-enabled nil))
-(add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook)
+(add-hook 'gnus-registry-unload-hook #'gnus-registry-unload-hook)
(defun gnus-registry-install-p ()
"Return non-nil if the registry is enabled (and maybe enable it first).
@@ -1217,7 +1223,7 @@ is `ask', ask the user; or if `gnus-registry-install' is non-nil, enable it."
(gnus-registry-initialize)))
gnus-registry-enabled)
-;; largely based on nnir-warp-to-article
+;; largely based on nnselect-warp-to-article
(defun gnus-try-warping-via-registry ()
"Try to warp via the registry.
This will be done via the current article's source group based on
@@ -1234,14 +1240,14 @@ data stored in the registry."
(seen-groups (list (gnus-group-group-name))))
(catch 'found
- (dolist (group (mapcar 'gnus-simplify-group-name groups))
+ (dolist (group (mapcar #'gnus-simplify-group-name groups))
;; skip over any groups we really don't want to warp to.
(unless (or (member group seen-groups)
(gnus-ephemeral-group-p group) ;; any ephemeral group
(memq (car (gnus-find-method-for-group group))
;; Specific methods; this list may need to expand.
- '(nnir)))
+ '(nnselect)))
;; remember that we've seen this group already
(push group seen-groups)
@@ -1270,7 +1276,7 @@ EXTRA is a list of symbols. Valid symbols are those contained in
the docs of `gnus-registry-track-extra'. This command is useful
when you stop tracking some extra data and now want to purge it
from your existing entries."
- (interactive (list (mapcar 'intern
+ (interactive (list (mapcar #'intern
(completing-read-multiple
"Extra data: "
'("subject" "sender" "recipient")))))
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 46b70eaf275..2e3abe7832d 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -25,8 +25,6 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
-
(require 'gnus)
(require 'gnus-sum)
(require 'gnus-art)
@@ -35,6 +33,7 @@
(require 'message)
(require 'score-mode)
(require 'gmm-utils)
+(require 'cl-lib)
(defcustom gnus-global-score-files nil
"List of global score files and directories.
@@ -497,6 +496,7 @@ of the last successful match.")
("head" -1 gnus-score-body)
("body" -1 gnus-score-body)
("all" -1 gnus-score-body)
+ (score-fn -1 nil)
("followup" 2 gnus-score-followup)
("thread" 5 gnus-score-thread)))
@@ -862,6 +862,18 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header."
(setq match (string-to-number match)))
(set-text-properties 0 (length match) nil match))
+ ;; Modify match and type for article age scoring.
+ (if (string= "date" (nth 0 (assoc header gnus-header-index)))
+ (let ((age (string-to-number match)))
+ (if (or (< age 0)
+ (string= "0" match))
+ (user-error "Article age must be a positive number"))
+ (setq match age
+ type (cond ((eq type 'after)
+ '<)
+ ((eq type 'before)
+ '>)))))
+
(unless (eq date 'now)
;; Add the score entry to the score file.
(when (= score gnus-score-interactive-default-score)
@@ -1163,14 +1175,19 @@ If FORMAT, also format the current score file."
(when format
(gnus-score-pretty-print))
(when (consp rule) ;; the rule exists
- (setq rule (mapconcat #'(lambda (obj)
- (regexp-quote (format "%S" obj)))
- rule
- sep))
+ (setq rule (if (symbolp (car rule))
+ (format "(%S)" (car rule))
+ (mapconcat #'(lambda (obj)
+ (regexp-quote (format "%S" obj)))
+ rule
+ sep)))
(goto-char (point-min))
- (re-search-forward rule nil t)
- ;; make it easy to use `kill-sexp':
- (goto-char (1- (match-beginning 0)))))))
+ (let ((move (if (string-match "(.*)" rule)
+ 0
+ -1)))
+ (re-search-forward rule nil t)
+ ;; make it easy to use `kill-sexp':
+ (goto-char (+ move (match-beginning 0))))))))
(defun gnus-score-load-file (file)
;; Load score file FILE. Returns a list a retrieved score-alists.
@@ -1220,6 +1237,7 @@ If FORMAT, also format the current score file."
(let ((mark (car (gnus-score-get 'mark alist)))
(expunge (car (gnus-score-get 'expunge alist)))
(mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
+ (score-fn (car (gnus-score-get 'score-fn alist)))
(files (gnus-score-get 'files alist))
(exclude-files (gnus-score-get 'exclude-files alist))
(orphan (car (gnus-score-get 'orphan alist)))
@@ -1370,9 +1388,12 @@ If FORMAT, also format the current score file."
(setq
err
(cond
- ((if (member (downcase type) '("lines" "chars"))
- (not (numberp (car s)))
- (not (stringp (car s))))
+ ((cond ((member (downcase type) '("lines" "chars"))
+ (not (numberp (car s))))
+ ((string= (downcase type) "date")
+ (not (or (numberp (car s))
+ (stringp (car s)))))
+ (t (not (stringp (car s)))))
(format "Invalid match %s in %s" (car s) file))
((and (cadr s) (not (integerp (cadr s))))
(format "Non-integer score %s in %s" (cadr s) file))
@@ -1552,10 +1573,14 @@ If FORMAT, also format the current score file."
(gnus-message
7 "Scoring on headers or body skipped.")
nil)
+ ;; Run score-fn
+ (if (eq header 'score-fn)
+ (setq new (gnus-score-func scores trace))
;; Call the scoring function for this type of "header".
(setq new (funcall (nth 2 entry) scores header
- now expire trace)))
+ now expire trace))))
(push new news))))
+
(when (gnus-buffer-live-p gnus-summary-buffer)
(let ((scored gnus-newsgroup-scored))
(with-current-buffer gnus-summary-buffer
@@ -1621,6 +1646,30 @@ score in `gnus-newsgroup-scored' by SCORE."
(not (string= id "")))
(gnus-score-lower-thread thread score)))))
+(defun gnus-score-func (scores &optional trace)
+ (dolist (alist scores)
+ (let ((articles gnus-scores-articles)
+ (entries (assoc 'score-fn alist)))
+ (dolist (score-fn (cdr entries))
+ (let ((score-fn (car score-fn))
+ article-alist score fn-score)
+ (dolist (art articles)
+ (setq article-alist
+ (cl-pairlis
+ '(number subject from date id
+ refs chars lines xref extra)
+ (car art))
+ score (cdr art))
+ (when (integerp (setq fn-score (funcall score-fn
+ article-alist score)))
+ (setcdr art (+ score fn-score)))
+ (setq score (cdr art))
+ (when (and trace
+ (integerp fn-score))
+ (push (cons (car-safe (rassq alist gnus-score-cache))
+ (list score-fn fn-score))
+ gnus-score-trace))))))))
+
(defun gnus-score-integer (scores header now expire &optional trace)
(let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
entries alist)
@@ -1690,9 +1739,21 @@ score in `gnus-newsgroup-scored' by SCORE."
((eq type 'after)
(setq match-func 'string<
match (gnus-date-iso8601 (nth 0 kill))))
+ ((eq type '<)
+ (setq type 'after
+ match-func 'string<
+ match (gnus-time-iso8601
+ (time-subtract (current-time)
+ (* 86400 (nth 0 kill))))))
((eq type 'before)
(setq match-func 'gnus-string>
match (gnus-date-iso8601 (nth 0 kill))))
+ ((eq type '>)
+ (setq type 'before
+ match-func 'gnus-string>
+ match (gnus-time-iso8601
+ (time-subtract (current-time)
+ (* 86400 (nth 0 kill))))))
((eq type 'at)
(setq match-func 'string=
match (gnus-date-iso8601 (nth 0 kill))))
diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el
index 278e3a5d6f3..5d8f9b55deb 100644
--- a/lisp/gnus/gnus-sieve.el
+++ b/lisp/gnus/gnus-sieve.el
@@ -29,8 +29,6 @@
(require 'gnus)
(require 'gnus-sum)
-(require 'format-spec)
-(autoload 'sieve-mode "sieve-mode")
(eval-when-compile
(require 'sieve))
@@ -88,10 +86,10 @@ See the documentation for these variables and functions for details."
(save-buffer)
(shell-command
(format-spec gnus-sieve-update-shell-command
- (format-spec-make ?f gnus-sieve-file
- ?s (or (cadr (gnus-server-get-method
- nil gnus-sieve-select-method))
- "")))))
+ `((?f . ,gnus-sieve-file)
+ (?s . ,(or (cadr (gnus-server-get-method
+ nil gnus-sieve-select-method))
+ ""))))))
;;;###autoload
(defun gnus-sieve-generate ()
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index d58bd7a73b5..6beb543e5a1 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -34,7 +34,7 @@
(require 'gnus-range)
(require 'gnus-cloud)
-(autoload 'gnus-group-make-nnir-group "nnir")
+(autoload 'gnus-group-read-ephemeral-search-group "nnselect")
(defcustom gnus-server-exit-hook nil
"Hook run when exiting the server buffer."
@@ -176,7 +176,7 @@ If nil, a faster, but more primitive, buffer is used instead."
"g" gnus-server-regenerate-server
- "G" gnus-group-make-nnir-group
+ "G" gnus-group-read-ephemeral-search-group
"z" gnus-server-compact-server
@@ -309,7 +309,7 @@ The following commands are available:
;; `gnus-server-buffer' selected as the current buffer, but not always (I
;; bumped into it when starting from a dedicated *Group* frame, and
;; gnus-configure-windows opened *Server* into its own dedicated frame).
- (with-current-buffer (get-buffer-create gnus-server-buffer)
+ (with-current-buffer (gnus-get-buffer-create gnus-server-buffer)
(gnus-server-mode)
(gnus-server-prepare)))
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index dbe92a164d0..615f8dfa877 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -31,6 +31,7 @@
(require 'gnus-range)
(require 'gnus-util)
(require 'gnus-cloud)
+(require 'gnus-dbus)
(autoload 'message-make-date "message")
(autoload 'gnus-agent-read-servers-validate "gnus-agent")
(autoload 'gnus-agent-save-local "gnus-agent")
@@ -730,7 +731,7 @@ the first newsgroup."
;; Remove Gnus frames.
(gnus-kill-gnus-frames))
-(defun gnus-no-server-1 (&optional arg slave)
+(defun gnus-no-server-1 (&optional arg child)
"Read network news.
If ARG is a positive number, Gnus will use that as the startup
level. If ARG is nil, Gnus will be started at level 2
@@ -739,11 +740,11 @@ and not a positive number, Gnus will prompt the user for the name
of an NNTP server to use. As opposed to \\[gnus], this command
will not connect to the local server."
(let ((val (or arg (1- gnus-level-default-subscribed))))
- (gnus val t slave)
+ (gnus val t child)
(make-local-variable 'gnus-group-use-permanent-levels)
(setq gnus-group-use-permanent-levels val)))
-(defun gnus-1 (&optional arg dont-connect slave)
+(defun gnus-1 (&optional arg dont-connect child)
"Read network news.
If ARG is non-nil and a positive number, Gnus will use that as the
startup level. If ARG is non-nil and not a positive number, Gnus will
@@ -761,7 +762,7 @@ prompt the user for the name of an NNTP server to use."
(gnus-splash)
(gnus-run-hooks 'gnus-before-startup-hook)
(nnheader-init-server-buffer)
- (setq gnus-slave slave)
+ (setq gnus-child child)
(gnus-read-init-file)
;; Add "native" to gnus-predefined-server-alist just to have a
@@ -790,7 +791,7 @@ prompt the user for the name of an NNTP server to use."
(gnus-make-newsrc-file gnus-startup-file))
;; Read the dribble file.
- (when (or gnus-slave gnus-use-dribble-file)
+ (when (or gnus-child gnus-use-dribble-file)
(gnus-dribble-read-file))
;; Do the actual startup.
@@ -798,6 +799,8 @@ prompt the user for the name of an NNTP server to use."
(gnus-run-hooks 'gnus-setup-news-hook)
(when gnus-agent
(gnus-request-create-group "queue" '(nndraft "")))
+ (when gnus-dbus-close-on-sleep
+ (gnus-dbus-register-sleep-signal))
(gnus-start-draft-setup)
;; Generate the group buffer.
(gnus-group-list-groups level)
@@ -1008,11 +1011,11 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
;; Possibly eval the dribble file.
(and init
- (or gnus-use-dribble-file gnus-slave)
+ (or gnus-use-dribble-file gnus-child)
(gnus-dribble-eval-file))
- ;; Slave Gnusii should then clear the dribble buffer.
- (when (and init gnus-slave)
+ ;; Child Gnusii should then clear the dribble buffer.
+ (when (and init gnus-child)
(gnus-dribble-clear))
(gnus-update-format-specifications)
@@ -1030,7 +1033,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
;; Find new newsgroups and treat them.
(when (and init gnus-check-new-newsgroups (not level)
(gnus-check-server gnus-select-method)
- (not gnus-slave)
+ (not gnus-child)
gnus-plugged)
(gnus-find-new-newsgroups))
@@ -1040,8 +1043,8 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
(gnus-server-opened gnus-select-method))
(gnus-check-bogus-newsgroups))
- ;; Read any slave files.
- (gnus-master-read-slave-newsrc)
+ ;; Read any child files.
+ (gnus-parent-read-child-newsrc)
;; Find the number of unread articles in each non-dead group.
(let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
@@ -1256,19 +1259,19 @@ INFO-LIST), otherwise it's a list in the format of the
`gnus-newsrc-hashtb' entries. LEVEL is the new level of the
group, OLDLEVEL is the old level and PREVIOUS is the group (a
string name) to insert this group before."
- (let (group info active num)
- ;; Glean what info we can from the arguments.
- (if (consp entry)
- (setq group (if fromkilled (nth 1 entry) (car (nth 1 entry))))
- (setq group entry))
+ ;; Glean what info we can from the arguments.
+ (let ((group (if (consp entry)
+ (if fromkilled (nth 1 entry) (car (nth 1 entry)))
+ entry))
+ info active num)
(when (and (stringp entry)
oldlevel
(< oldlevel gnus-level-zombie))
(setq entry (gnus-group-entry entry)))
- (if (and (not oldlevel)
- (consp entry))
- (setq oldlevel (gnus-info-level (nth 1 entry)))
- (setq oldlevel (or oldlevel gnus-level-killed)))
+ (setq oldlevel (if (and (not oldlevel)
+ (consp entry))
+ (gnus-info-level (nth 1 entry))
+ (or oldlevel gnus-level-killed)))
;; This table is used for completion, so put a dummy entry there.
(unless (gethash group gnus-active-hashtb)
@@ -1799,7 +1802,7 @@ backend check whether the group actually exists."
;; by one.
(t
(dolist (info infos)
- (gnus-activate-group (gnus-info-group info) nil nil method t))))))
+ (gnus-activate-group (gnus-info-group info) t nil method t))))))
(defun gnus-make-hashtable-from-newsrc-alist ()
"Create a hash table from `gnus-newsrc-alist'.
@@ -2111,6 +2114,7 @@ The info element is shared with the same element of
((string= gnus-ignored-newsgroups "")
(delete-matching-lines "^to\\."))
(t
+ ;; relint suppression: Duplicated alternative branch
(delete-matching-lines (concat "^to\\.\\|" gnus-ignored-newsgroups))))
(goto-char (point-min))
@@ -2737,15 +2741,15 @@ values from `gnus-newsrc-hashtb', and write a new value of
(gnus-agent-save-local force))
(save-excursion
- (if (and (or gnus-use-dribble-file gnus-slave)
+ (if (and (or gnus-use-dribble-file gnus-child)
(not force)
(or (not (buffer-live-p gnus-dribble-buffer))
(zerop (with-current-buffer gnus-dribble-buffer
(buffer-size)))))
(gnus-message 4 "(No changes need to be saved)")
(gnus-run-hooks 'gnus-save-newsrc-hook)
- (if gnus-slave
- (gnus-slave-save-newsrc)
+ (if gnus-child
+ (gnus-child-save-newsrc)
;; Save .newsrc only if the select method is an NNTP method.
;; The .newsrc file is for interoperability with other
;; newsreaders, so saving non-NNTP groups there doesn't make
@@ -2812,7 +2816,7 @@ values from `gnus-newsrc-hashtb', and write a new value of
(file-exists-p working-file)))
(unwind-protect
- (progn
+ (with-file-modes (file-modes startup-file)
(gnus-with-output-to-file working-file
(gnus-gnus-to-quick-newsrc-format)
(gnus-run-hooks 'gnus-save-quick-newsrc-hook))
@@ -2822,14 +2826,12 @@ values from `gnus-newsrc-hashtb', and write a new value of
;; file.
(let ((buffer-backed-up nil)
(buffer-file-name startup-file)
- (file-precious-flag t)
- (setmodes (file-modes startup-file)))
+ (file-precious-flag t))
;; Backup the current version of the startup file.
(backup-buffer)
;; Replace the existing startup file with the temp file.
(rename-file working-file startup-file t)
- (gnus-set-file-modes startup-file setmodes)
(setq gnus-save-newsrc-file-last-timestamp
(file-attribute-modification-time
(file-attributes startup-file)))))
@@ -2990,55 +2992,61 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
;;;
-;;; Slave functions.
+;;; Child functions.
;;;
-(defvar gnus-slave-mode nil)
+(defvar gnus-child-mode nil)
-(defun gnus-slave-mode ()
- "Minor mode for slave Gnusae."
- ;; FIXME: gnus-slave-mode appears to never be set (i.e. it'll always be nil):
+(defun gnus-child-mode ()
+ "Minor mode for child Gnusae."
+ ;; FIXME: gnus-child-mode appears to never be set (i.e. it'll always be nil):
;; Remove, or fix and use define-minor-mode.
- (add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap))
- (gnus-run-hooks 'gnus-slave-mode-hook))
+ (add-minor-mode 'gnus-child-mode " Child" (make-sparse-keymap))
+ (gnus-run-hooks 'gnus-child-mode-hook))
-(defun gnus-slave-save-newsrc ()
+(define-obsolete-function-alias 'gnus-slave-mode #'gnus-child-mode "28.1")
+(define-obsolete-variable-alias 'gnus-slave-mode-hook 'gnus-child-mode-hook
+ "28.1")
+
+(defun gnus-child-save-newsrc ()
(with-current-buffer gnus-dribble-buffer
- (let ((slave-name
- (make-temp-file (concat gnus-current-startup-file "-slave-")))
- (modes (ignore-errors
- (file-modes (concat gnus-current-startup-file ".eld")))))
- (let ((coding-system-for-write gnus-ding-file-coding-system))
- (gnus-write-buffer slave-name))
- (when modes
- (gnus-set-file-modes slave-name modes)))))
-
-(defun gnus-master-read-slave-newsrc ()
- (let ((slave-files
+ (with-file-modes (or (ignore-errors
+ (file-modes
+ (concat gnus-current-startup-file ".eld")))
+ (default-file-modes))
+ (let ((child-name
+ (make-temp-file (concat gnus-current-startup-file "-child-"))))
+ (let ((coding-system-for-write gnus-ding-file-coding-system))
+ (gnus-write-buffer child-name))))))
+
+(defun gnus-parent-read-child-newsrc ()
+ (let ((child-files
(directory-files
(file-name-directory gnus-current-startup-file)
t (concat
"^" (regexp-quote
- (concat
- (file-name-nondirectory gnus-current-startup-file)
- "-slave-")))
+ (file-name-nondirectory gnus-current-startup-file))
+ ;; When the obsolete variables like
+ ;; `gnus-slave-mode-hook' etc are removed, the "slave"
+ ;; bit of this regexp should also be removed.
+ "\\(-child-\\|-slave-\\)")
t))
file)
- (if (not slave-files)
- () ; There are no slave files to read.
- (gnus-message 7 "Reading slave newsrcs...")
- (with-current-buffer (gnus-get-buffer-create " *gnus slave*")
- (setq slave-files
+ (if (not child-files)
+ () ; There are no child files to read.
+ (gnus-message 7 "Reading child newsrcs...")
+ (with-current-buffer (gnus-get-buffer-create " *gnus child*")
+ (setq child-files
(sort (mapcar (lambda (file)
(list (file-attribute-modification-time
(file-attributes file))
file))
- slave-files)
+ child-files)
(lambda (f1 f2)
(time-less-p (car f1) (car f2)))))
- (while slave-files
+ (while child-files
(erase-buffer)
- (setq file (nth 1 (car slave-files)))
+ (setq file (nth 1 (car child-files)))
(nnheader-insert-file-contents file)
(when (condition-case ()
(progn
@@ -3047,12 +3055,12 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
(error
(gnus-error 3.2 "Possible error in %s" file)
nil))
- (unless gnus-slave ; Slaves shouldn't delete these files.
+ (unless gnus-child ; Children shouldn't delete these files.
(ignore-errors
(delete-file file))))
- (setq slave-files (cdr slave-files))))
+ (setq child-files (cdr child-files))))
(gnus-dribble-touch)
- (gnus-message 7 "Reading slave newsrcs...done"))))
+ (gnus-message 7 "Reading child newsrcs...done"))))
;;;
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 9b11d5878d9..b3ed5cb6647 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -85,8 +85,9 @@
(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 'nnir-article-rsv "nnir" nil nil 'macro)
-(autoload 'nnir-article-group "nnir" nil nil 'macro)
+(autoload 'nnselect-article-rsv "nnselect" nil nil)
+(autoload 'nnselect-article-group "nnselect" nil nil)
+(autoload 'gnus-nnselect-group-p "nnselect" nil nil)
(defcustom gnus-kill-summary-on-exit t
"If non-nil, kill the summary buffer when you exit from it.
@@ -144,11 +145,14 @@ If t, fetch all the available old headers."
:type '(choice number
(sexp :menu-tag "other" t)))
-(defcustom gnus-refer-thread-use-nnir nil
- "Use nnir to search an entire server when referring threads.
+(define-obsolete-variable-alias 'gnus-refer-thread-use-nnir
+ 'gnus-refer-thread-use-search "28.1")
+
+(defcustom gnus-refer-thread-use-search nil
+ "Search an entire server when referring threads.
A nil value will only search for thread-related articles in the
current group."
- :version "24.1"
+ :version "28.1"
:group 'gnus-thread
:type 'boolean)
@@ -884,6 +888,7 @@ controls how articles are sorted."
(function-item gnus-article-sort-by-subject)
(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-random)
(function :tag "other"))
(boolean :tag "Reverse order"))))
@@ -927,6 +932,7 @@ subthreads, customize `gnus-subthread-sort-functions'."
(function-item gnus-thread-sort-by-subject)
(function-item gnus-thread-sort-by-date)
(function-item gnus-thread-sort-by-score)
+ (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-random)
@@ -1433,16 +1439,13 @@ the normal Gnus MIME machinery."
(?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
(?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
(?L gnus-tmp-lines ?s)
- (?Z (or (nnir-article-rsv (mail-header-number gnus-tmp-header))
- 0)
- ?d)
- (?G (or (nnir-article-group (mail-header-number gnus-tmp-header))
- "")
- ?s)
+ (?Z (or (nnselect-article-rsv (mail-header-number gnus-tmp-header))
+ 0) ?d)
+ (?G (or (nnselect-article-group (mail-header-number gnus-tmp-header))
+ "") ?s)
(?g (or (gnus-group-short-name
- (nnir-article-group (mail-header-number gnus-tmp-header)))
- "")
- ?s)
+ (nnselect-article-group (mail-header-number gnus-tmp-header)))
+ "") ?s)
(?O gnus-tmp-downloaded ?c)
(?I gnus-tmp-indentation ?s)
(?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
@@ -1501,9 +1504,9 @@ the type of the variable (string, integer, character, etc).")
;; This is here rather than in gnus-art for compilation reasons.
(defvar gnus-article-mode-line-format-alist
- (nconc '((?w (gnus-article-wash-status) ?s)
- (?m (gnus-article-mime-part-status) ?s))
- gnus-summary-mode-line-format-alist))
+ (append '((?w (gnus-article-wash-status) ?s)
+ (?m (gnus-article-mime-part-status) ?s))
+ gnus-summary-mode-line-format-alist))
(defvar gnus-last-search-regexp nil
"Default regexp for article search command.")
@@ -1619,6 +1622,8 @@ This list will always be a subset of gnus-newsgroup-undownloaded.")
(defvar gnus-newsgroup-sparse nil)
+(defvar gnus-newsgroup-selection nil)
+
(defvar gnus-current-article nil)
(defvar gnus-article-current nil)
(defvar gnus-current-headers nil)
@@ -1653,6 +1658,8 @@ This list will always be a subset of gnus-newsgroup-undownloaded.")
gnus-newsgroup-undownloaded
gnus-newsgroup-unsendable
+ gnus-newsgroup-selection
+
gnus-newsgroup-begin gnus-newsgroup-end
gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
gnus-newsgroup-last-folder gnus-newsgroup-last-file
@@ -1913,7 +1920,8 @@ increase the score of each group you read."
"," gnus-summary-best-unread-article
"[" gnus-summary-prev-unseen-article
"]" gnus-summary-next-unseen-article
- "\M-s" gnus-summary-search-article-forward
+ "\M-s\M-s" gnus-summary-search-article-forward
+ "\M-s\M-r" gnus-summary-search-article-backward
"\M-r" gnus-summary-search-article-backward
"\M-S" gnus-summary-repeat-search-article-forward
"\M-R" gnus-summary-repeat-search-article-backward
@@ -1982,6 +1990,7 @@ increase the score of each group you read."
"\M-K" gnus-summary-edit-global-kill
;; "V" gnus-version
"\C-c\C-d" gnus-summary-describe-group
+ "\C-c\C-p" gnus-summary-make-group-from-search
"q" gnus-summary-exit
"Q" gnus-summary-exit-no-update
"\C-c\C-i" gnus-info-find-node
@@ -4531,48 +4540,14 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
;; This function has to be called with point after the article number
;; on the beginning of the line.
(defsubst gnus-nov-parse-line (number dependencies &optional force-new)
- (let ((eol (point-at-eol))
- header references in-reply-to)
-
+ (let (header)
;; overview: [num subject from date id refs chars lines misc]
(unwind-protect
- (let (x)
- (narrow-to-region (point) eol)
- (unless (eobp)
- (forward-char))
-
- (setq header
- (make-full-mail-header
- number ; number
- (condition-case () ; subject
- (gnus-remove-odd-characters
- (funcall gnus-decode-encoded-word-function
- (setq x (nnheader-nov-field))))
- (error x))
- (condition-case () ; from
- (gnus-remove-odd-characters
- (funcall gnus-decode-encoded-address-function
- (setq x (nnheader-nov-field))))
- (error x))
- (nnheader-nov-field) ; date
- (nnheader-nov-read-message-id number) ; id
- (setq references (nnheader-nov-field)) ; refs
- (nnheader-nov-read-integer) ; chars
- (nnheader-nov-read-integer) ; lines
- (unless (eobp)
- (if (looking-at "Xref: ")
- (goto-char (match-end 0)))
- (nnheader-nov-field)) ; Xref
- (nnheader-nov-parse-extra)))) ; extra
-
+ (narrow-to-region (point) (point-at-eol))
+ (unless (eobp)
+ (forward-char))
+ (setq header (nnheader-parse-nov number))
(widen))
-
- (when (and (string= references "")
- (setq in-reply-to (mail-header-extra header))
- (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to))))
- (setf (mail-header-references header)
- (gnus-extract-message-id-from-in-reply-to in-reply-to)))
-
(when gnus-alter-header-function
(funcall gnus-alter-header-function header))
(gnus-dependencies-add-header header dependencies force-new)))
@@ -5103,6 +5078,17 @@ using some other form will lead to serious barfage."
(gnus-article-sort-by-date
(gnus-thread-header h1) (gnus-thread-header h2)))
+(defsubst gnus-article-sort-by-rsv (h1 h2)
+ "Sort articles by rsv."
+ (when gnus-newsgroup-selection
+ (< (nnselect-article-rsv (mail-header-number h1))
+ (nnselect-article-rsv (mail-header-number h2)))))
+
+(defun gnus-thread-sort-by-rsv (h1 h2)
+ "Sort threads by root article rsv."
+ (gnus-article-sort-by-rsv
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
(defsubst gnus-article-sort-by-score (h1 h2)
"Sort articles by root article score.
Unscored articles will be counted as having a score of zero."
@@ -5352,7 +5338,8 @@ or a straight list of headers."
;; We remember that we probably want to output a dummy
;; root.
(setq gnus-tmp-dummy-line gnus-tmp-header)
- (setq gnus-tmp-prev-subject gnus-tmp-header))
+ (setq gnus-tmp-prev-subject
+ (gnus-simplify-subject-fully gnus-tmp-header)))
(t
;; We do not make a root for the gathered
;; sub-threads at all.
@@ -5632,22 +5619,32 @@ or a straight list of headers."
"Fetch headers of ARTICLES."
(gnus-message 7 "Fetching headers for %s..." gnus-newsgroup-name)
(prog1
- (if (eq 'nov
- (setq gnus-headers-retrieved-by
- (gnus-retrieve-headers
- articles gnus-newsgroup-name
- (or limit
- ;; We might want to fetch old headers, but
- ;; not if there is only 1 article.
- (and (or (and
- (not (eq gnus-fetch-old-headers 'some))
- (not (numberp gnus-fetch-old-headers)))
- (> (length articles) 1))
- gnus-fetch-old-headers)))))
- (gnus-get-newsgroup-headers-xover
- articles force-new dependencies gnus-newsgroup-name t)
- (gnus-get-newsgroup-headers dependencies force-new))
- (gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name)))
+ (pcase (setq gnus-headers-retrieved-by
+ (gnus-retrieve-headers
+ articles gnus-newsgroup-name
+ (or limit
+ ;; We might want to fetch old headers, but
+ ;; not if there is only 1 article.
+ (and (or (and
+ (not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers)))
+ (> (length articles) 1))
+ gnus-fetch-old-headers))))
+ ('nov
+ (gnus-get-newsgroup-headers-xover
+ articles force-new dependencies gnus-newsgroup-name t))
+ ('headers
+ (gnus-get-newsgroup-headers dependencies force-new))
+ ((pred listp)
+ (let ((dependencies
+ (or dependencies
+ (with-current-buffer gnus-summary-buffer
+ gnus-newsgroup-dependencies))))
+ (delq nil (mapcar #'(lambda (header)
+ (gnus-dependencies-add-header
+ header dependencies force-new))
+ gnus-headers-retrieved-by)))))
+ (gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name)))
(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
@@ -5937,7 +5934,9 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(initial (gnus-parameter-large-newsgroup-initial
gnus-newsgroup-name))
(default (if only-read-p
- (or initial gnus-large-newsgroup)
+ (if (eq initial 'all)
+ nil
+ (or initial gnus-large-newsgroup))
number))
(input
(read-string
@@ -6401,12 +6400,11 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(gnus-group-update-group group t))))))
(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
- (let ((cur nntp-server-buffer)
- (dependencies
+ (let ((dependencies
(or dependencies
(with-current-buffer gnus-summary-buffer
gnus-newsgroup-dependencies)))
- headers id end ref number
+ headers
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(save-current-buffer (condition-case nil
@@ -6414,146 +6412,15 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(error))
gnus-newsgroup-ignored-charsets)))
(with-current-buffer nntp-server-buffer
- ;; Translate all TAB characters into SPACE characters.
- (subst-char-in-region (point-min) (point-max) ?\t ? t)
- (subst-char-in-region (point-min) (point-max) ?\r ? t)
- (ietf-drums-unfold-fws)
(gnus-run-hooks 'gnus-parse-headers-hook)
- (let ((case-fold-search t)
- in-reply-to header p lines chars)
+ (let ((nnmail-extra-headers gnus-extra-headers)
+ header)
(goto-char (point-min))
- ;; Search to the beginning of the next header. Error messages
- ;; do not begin with 2 or 3.
- (while (re-search-forward "^[23][0-9]+ " nil t)
- (setq id nil
- ref nil)
- ;; This implementation of this function, with nine
- ;; search-forwards instead of the one re-search-forward and
- ;; a case (which basically was the old function) is actually
- ;; about twice as fast, even though it looks messier. You
- ;; can't have everything, I guess. Speed and elegance
- ;; doesn't always go hand in hand.
- (setq
- header
- (make-full-mail-header
- ;; Number.
- (prog1
- (setq number (read cur))
- (end-of-line)
- (setq p (point))
- (narrow-to-region (point)
- (or (and (search-forward "\n.\n" nil t)
- (- (point) 2))
- (point))))
- ;; Subject.
- (progn
- (goto-char p)
- (if (search-forward "\nsubject:" nil t)
- (funcall gnus-decode-encoded-word-function
- (nnheader-header-value))
- "(none)"))
- ;; From.
- (progn
- (goto-char p)
- (if (search-forward "\nfrom:" nil t)
- (funcall gnus-decode-encoded-address-function
- (nnheader-header-value))
- "(nobody)"))
- ;; Date.
- (progn
- (goto-char p)
- (if (search-forward "\ndate:" nil t)
- (nnheader-header-value) ""))
- ;; Message-ID.
- (progn
- (goto-char p)
- (setq id (if (re-search-forward
- "^message-id: *\\(<[^\n\t> ]+>\\)" nil t)
- ;; We do it this way to make sure the Message-ID
- ;; is (somewhat) syntactically valid.
- (buffer-substring (match-beginning 1)
- (match-end 1))
- ;; If there was no message-id, we just fake one
- ;; to make subsequent routines simpler.
- (nnheader-generate-fake-message-id number))))
- ;; References.
- (progn
- (goto-char p)
- (if (search-forward "\nreferences:" nil t)
- (progn
- (setq end (point))
- (prog1
- (nnheader-header-value)
- (setq ref
- (buffer-substring
- (progn
- (end-of-line)
- (search-backward ">" end t)
- (1+ (point)))
- (progn
- (search-backward "<" end t)
- (point))))))
- ;; Get the references from the in-reply-to header if there
- ;; were no references and the in-reply-to header looks
- ;; promising.
- (if (and (search-forward "\nin-reply-to:" nil t)
- (setq in-reply-to (nnheader-header-value))
- (string-match "<[^>]+>" in-reply-to))
- (let (ref2)
- (setq ref (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (while (string-match "<[^>]+>" in-reply-to (match-end 0))
- (setq ref2 (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (when (> (length ref2) (length ref))
- (setq ref ref2)))
- ref)
- (setq ref nil))))
- ;; Chars.
- (progn
- (goto-char p)
- (if (search-forward "\nchars: " nil t)
- (if (numberp (setq chars (ignore-errors (read cur))))
- chars -1)
- -1))
- ;; Lines.
- (progn
- (goto-char p)
- (if (search-forward "\nlines: " nil t)
- (if (numberp (setq lines (ignore-errors (read cur))))
- lines -1)
- -1))
- ;; Xref.
- (progn
- (goto-char p)
- (and (search-forward "\nxref:" nil t)
- (nnheader-header-value)))
- ;; Extra.
- (when gnus-extra-headers
- (let ((extra gnus-extra-headers)
- out)
- (while extra
- (goto-char p)
- (when (search-forward
- (concat "\n" (symbol-name (car extra)) ":") nil t)
- (push (cons (car extra) (nnheader-header-value))
- out))
- (pop extra))
- out))))
- (when (equal id ref)
- (setq ref nil))
-
- (when gnus-alter-header-function
- (funcall gnus-alter-header-function header)
- (setq id (mail-header-id header)
- ref (gnus-parent-id (mail-header-references header))))
-
+ (while (setq header (nnheader-parse-head))
(when (setq header
(gnus-dependencies-add-header
header dependencies force-new))
- (push header headers))
- (goto-char (point-max))
- (widen))
+ (push header headers)))
(nreverse headers)))))
;; Goes through the xover lines and returns a list of vectors
@@ -7255,6 +7122,21 @@ The prefix argument ALL means to select all articles."
(setq info (copy-sequence (gnus-get-info group))
info (delq (gnus-info-params info) info))))))))))
+(defun gnus-summary-make-group-from-search ()
+ "Make a persistent group from the current ephemeral search group."
+ (interactive)
+ (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: ")))
+ (with-current-buffer gnus-group-buffer
+ (gnus-group-make-group
+ name
+ (list 'nnselect "nnselect")
+ nil
+ (list (cons 'nnselect-specs
+ (gnus-group-get-parameter gnus-newsgroup-name
+ 'nnselect-specs t))))))))
+
(defun gnus-summary-save-newsrc (&optional force)
"Save the current number of read/marked articles in the dribble buffer.
The dribble buffer will then be saved.
@@ -7310,7 +7192,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(when gnus-use-cache
(gnus-cache-write-active))
;; Remove entries for this group.
- (nnmail-purge-split-history (gnus-group-real-name group))
+ (nnmail-purge-split-history group)
;; Make all changes in this group permanent.
(unless quit-config
(gnus-run-hooks 'gnus-exit-group-hook)
@@ -7331,6 +7213,8 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-group-next-unread-group 1))
(setq group-point (point))
(gnus-article-stop-animations)
+ (unless leave-hidden
+ (gnus-configure-windows 'group 'force))
(if temporary
nil ;Nothing to do.
(set-buffer buf)
@@ -7350,8 +7234,6 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(if quit-config
(gnus-handle-ephemeral-exit quit-config)
(goto-char group-point)
- (unless leave-hidden
- (gnus-configure-windows 'group 'force))
;; If gnus-group-buffer is already displayed, make sure we also move
;; the cursor in the window that displays it.
(let ((win (get-buffer-window (current-buffer) 0)))
@@ -8698,7 +8580,8 @@ 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))))
+ (interactive (list (mail-header-id (gnus-summary-article-header))
+ current-prefix-arg))
(let ((articles (gnus-articles-in-thread
(gnus-id-to-thread (gnus-root-id id))))
;;we REALLY want the whole thread---this prevents cut-threads
@@ -9121,25 +9004,24 @@ Return the number of articles fetched."
result))
(defun gnus-summary-refer-thread (&optional limit)
- "Fetch all articles in the current thread. For backends
-that know how to search for threads (currently only 'nnimap)
-a non-numeric prefix arg will use nnir to search the entire
-server; without a prefix arg only the current group is
-searched. If the variable `gnus-refer-thread-use-nnir' is
-non-nil the prefix arg 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."
+ "Fetch all articles in the current thread.
+For backends that know how to search for threads (currently only
+`nnimap') a non-numeric prefix arg will search the entire server;
+without a prefix arg only the current group is searched. If the
+variable `gnus-refer-thread-use-search' is non-nil the prefix arg
+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")
(let* ((header (gnus-summary-article-header))
(id (mail-header-id header))
(gnus-inhibit-demon t)
(gnus-summary-ignore-duplicates t)
(gnus-read-all-available-headers t)
- (gnus-refer-thread-use-nnir
+ (gnus-refer-thread-use-search
(if (and (not (null limit)) (listp limit))
- (not gnus-refer-thread-use-nnir) gnus-refer-thread-use-nnir))
+ (not gnus-refer-thread-use-search) gnus-refer-thread-use-search))
(new-headers
(if (gnus-check-backend-function
'request-thread gnus-newsgroup-name)
@@ -9280,9 +9162,9 @@ non-numeric or nil fetch the number specified by the
(dolist (method gnus-refer-article-method)
(push (if (eq 'current method)
gnus-current-select-method
- (if (eq 'nnir (car method))
+ (if (eq 'nnselect (car method))
(list
- 'nnir
+ 'nnselect
(or (cadr method)
(gnus-method-to-server gnus-current-select-method)))
method))
@@ -9493,16 +9375,6 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'."
(push primary urls))
(delete-dups urls)))
-;; cf. `ediff-truncate-string-left', to become `string-truncate-left'
-;; in Emacs 28
-(defun gnus--string-truncate-left (string length)
- "Truncate STRING to LENGTH, replacing initial surplus with \"...\"."
- (let ((strlen (length string)))
- (if (<= strlen length)
- string
- (setq length (max 0 (- length 3)))
- (concat "..." (substring string (max 0 (- strlen 1 length)))))))
-
(defun gnus-shorten-url (url max)
"Return an excerpt from URL not exceeding MAX characters."
(if (<= (length url) max)
@@ -9512,7 +9384,7 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'."
(rest (concat (url-filename parsed)
(when-let ((target (url-target parsed)))
(concat "#" target)))))
- (concat host (gnus--string-truncate-left rest (- max (length host)))))))
+ (concat host (string-truncate-left rest (- max (length host)))))))
(defun gnus-summary-browse-url (&optional external)
"Scan the current article body for links, and offer to browse them.
@@ -9536,10 +9408,10 @@ default."
(cond ((= (length urls) 1)
(car urls))
((> (length urls) 1)
- (completing-read (format "URL to browse (default %s): "
- (gnus-shorten-url (car urls) 40))
- urls nil t nil nil
- (car urls)))))
+ (completing-read
+ (format-prompt "URL to browse"
+ (gnus-shorten-url (car urls) 40))
+ urls nil t nil nil (car urls)))))
(if target
(if external
(funcall browse-url-secondary-browser-function target)
@@ -10836,6 +10708,7 @@ groups."
;; We only have to update this line.
(save-excursion
(save-restriction
+ (nnheader-ms-strip-cr)
(message-narrow-to-head)
(let ((head (buffer-substring-no-properties
(point-min) (point-max)))
@@ -11664,7 +11537,7 @@ If ALL is non-nil, also mark ticked and dormant articles as read."
(gnus-save-hidden-threads
(let ((beg (point)))
;; We check that there are unread articles.
- (when (or all (gnus-summary-find-next))
+ (when (or all (gnus-summary-last-article-p) (gnus-summary-find-next))
(gnus-summary-catchup all t beg nil t)))))
(gnus-summary-position-point))
@@ -11933,8 +11806,6 @@ will not be hidden."
(defun gnus-summary-hide-thread ()
"Hide thread subtrees.
-If PREDICATE is supplied, threads that satisfy this predicate
-will not be hidden.
Returns nil if no threads were there to be hidden."
(interactive)
(beginning-of-line)
@@ -11955,9 +11826,9 @@ Returns nil if no threads were there to be hidden."
(overlay-put ol 'invisible 'gnus-sum)
(overlay-put ol 'evaporate t)))
(gnus-summary-goto-subject article)
+ ;; We moved backward past the start point (invisible thread?)
(when (> start (point))
- (message "Hiding the thread moved us backwards, aborting!")
- (goto-char (point-max))))
+ (goto-char starteol)))
(goto-char start)
nil))))
@@ -12291,7 +12162,7 @@ no matter what the properties `:decode' and `:headers' are."
(interactive (gnus-interactive "P\ny"))
(require 'gnus-art)
(let* ((articles (gnus-summary-work-articles n))
- (result-buffer "*Shell Command Output*")
+ (result-buffer shell-command-buffer-name)
(all-headers (not (memq sym '(nil r))))
(gnus-save-all-headers (or all-headers gnus-save-all-headers))
(raw (eq sym 'r))
@@ -12320,7 +12191,7 @@ no matter what the properties `:decode' and `:headers' are."
(buffer-string))))))
(put 'gnus-summary-save-in-pipe :headers headers))
(unless (zerop (length result))
- (if (with-current-buffer (get-buffer-create result-buffer)
+ (if (with-current-buffer (gnus-get-buffer-create result-buffer)
(erase-buffer)
(insert result)
(prog1
@@ -12508,7 +12379,7 @@ save those articles instead."
(gnus-activate-group to-newsgroup nil nil to-method)
(gnus-subscribe-group to-newsgroup))
(error "Couldn't create group %s" to-newsgroup)))
- (error "No such group: %s" to-newsgroup))
+ (user-error "No such group: %s" to-newsgroup))
to-newsgroup)))
(defvar gnus-summary-save-parts-counter)
@@ -12518,10 +12389,15 @@ save those articles instead."
"Save parts matching TYPE to DIR.
If REVERSE, save parts that do not match TYPE."
(interactive
- (list (read-string "Save parts of type: "
- (or (car gnus-summary-save-parts-type-history)
- gnus-summary-save-parts-default-mime)
- 'gnus-summary-save-parts-type-history)
+ (list (completing-read "Save parts of type: "
+ (progn
+ (gnus-summary-select-article nil t)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (delete-dups
+ (mapcar (lambda (h)
+ (mm-handle-media-type (cdr h)))
+ gnus-article-mime-handle-alist))))
+ nil nil nil 'gnus-summary-save-parts-type-history)
(setq gnus-summary-save-parts-last-directory
(read-directory-name "Save to directory: "
gnus-summary-save-parts-last-directory
@@ -13169,10 +13045,13 @@ If ALL is a number, fetch this number of articles."
(t
(when (and (numberp gnus-large-newsgroup)
(> len gnus-large-newsgroup))
- (let* ((cursor-in-echo-area nil)
- (initial (gnus-parameter-large-newsgroup-initial
- gnus-newsgroup-name))
- (input
+ (let ((cursor-in-echo-area nil)
+ (initial (gnus-parameter-large-newsgroup-initial
+ gnus-newsgroup-name))
+ input)
+ (when (eq initial 'all)
+ (setq initial len))
+ (setq input
(read-string
(format
"How many articles from %s (%s %d): "
@@ -13181,7 +13060,7 @@ If ALL is a number, fetch this number of articles."
len)
nil nil
(and initial
- (number-to-string initial)))))
+ (number-to-string initial))))
(unless (string-match "^[ \t]*$" input)
(setq all (string-to-number input))
(if (< all len)
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index ffd26bb30f4..c913002f70b 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -897,9 +897,7 @@ articles in the topic and its subtopics."
(let ((inhibit-read-only t))
(unless gnus-topic-inhibit-change-level
(gnus-group-goto-group (or (car (nth 1 previous)) group))
- (when (and gnus-topic-mode
- gnus-topic-alist
- (not gnus-topic-inhibit-change-level))
+ (when (and gnus-topic-mode gnus-topic-alist (gnus-current-topic))
;; Remove the group from the topics.
(if (and (< oldlevel gnus-level-zombie)
(>= level gnus-level-zombie))
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index f255cfc74a0..684c535f143 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -455,9 +455,7 @@ displayed in the echo area."
(> message-log-max 0)
(/= (length str) 0))
(setq time (current-time))
- (with-current-buffer (if (fboundp 'messages-buffer)
- (messages-buffer)
- (get-buffer-create "*Messages*"))
+ (with-current-buffer (messages-buffer)
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert ,timestamp str "\n")
@@ -768,7 +766,7 @@ nil. See also `gnus-bind-print-variables'."
If there's no subdirectory, delete DIRECTORY as well."
(when (file-directory-p directory)
(let ((files (directory-files
- directory t (rx (or (not ".") "..."))))
+ directory t directory-files-no-dot-files-regexp))
file dir)
(while files
(setq file (pop files))
@@ -950,7 +948,7 @@ FILENAME exists and is Babyl format."
(setq rmail-default-rmail-file filename) ; 22
(setq rmail-default-file filename)) ; 23
(let ((artbuf (current-buffer))
- (tmpbuf (get-buffer-create " *Gnus-output*"))
+ (tmpbuf (gnus-get-buffer-create " *Gnus-output*"))
;; Babyl rmail.el defines this, mbox does not.
(babyl (fboundp 'rmail-insert-rmail-file-header)))
(save-excursion
@@ -1036,7 +1034,7 @@ FILENAME exists and is Babyl format."
(require 'nnmail)
(setq filename (expand-file-name filename))
(let ((artbuf (current-buffer))
- (tmpbuf (get-buffer-create " *Gnus-output*")))
+ (tmpbuf (gnus-get-buffer-create " *Gnus-output*")))
(save-excursion
;; Create the file, if it doesn't exist.
(when (and (not (get-file-buffer filename))
@@ -1179,7 +1177,7 @@ ARG is passed to the first function."
(maphash
(lambda (group active)
(when active
- (insert (format "%s %d %d y\n"
+ (insert (format "%S %d %d y\n"
(if full-names
group
(gnus-group-real-name group))
@@ -1345,6 +1343,57 @@ forbidden in URL encoding."
(setq tmp (concat tmp str))
tmp))
+(defun gnus-base64-repad (str &optional reject-newlines line-length)
+ "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)."
+ ;; 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.
+ (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',
@@ -1457,7 +1506,7 @@ CHOICE is a list of the choice char and help message at IDX."
(setq tchar (read-char))
(when (not (assq tchar choice))
(setq tchar nil)
- (setq buf (get-buffer-create "*Gnus Help*"))
+ (setq buf (gnus-get-buffer-create "*Gnus Help*"))
(pop-to-buffer buf)
(fundamental-mode)
(buffer-disable-undo)
@@ -1601,10 +1650,10 @@ empty directories from OLD-PATH."
(file-truename
(concat old-dir "..")))))))))
-(defun gnus-set-file-modes (filename mode)
+(defun gnus-set-file-modes (filename mode &optional flag)
"Wrapper for set-file-modes."
(ignore-errors
- (set-file-modes filename mode)))
+ (set-file-modes filename mode flag)))
(defun gnus-rescale-image (image size)
"Rescale IMAGE to SIZE if possible.
@@ -1654,6 +1703,7 @@ The first found will be returned if a file has hard or symbolic links."
"To each element of LIST apply PREDICATE.
Return nil if LIST is no list or is empty or some test returns nil;
otherwise, return t."
+ (declare (obsolete nil "28.1"))
(when (and list (listp list))
(let ((result (mapcar predicate list)))
(not (memq nil result)))))
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index 5902f2b37a7..70aeac00d7f 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -1674,7 +1674,7 @@ Gnus might fail to display all of it.")
did-unpack))
(defun gnus-uu-dir-files (dir)
- (let ((dirs (directory-files dir t (rx (or (not ".") "..."))))
+ (let ((dirs (directory-files dir t directory-files-no-dot-files-regexp))
files file)
(while dirs
(if (file-directory-p (setq file (car dirs)))
@@ -1781,8 +1781,8 @@ Gnus might fail to display all of it.")
gnus-uu-tmp-dir)))
(setq gnus-uu-work-dir
- (make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir))
- (gnus-set-file-modes gnus-uu-work-dir 448)
+ (with-file-modes #o700
+ (make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir)))
(setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir))
(push (cons gnus-newsgroup-name gnus-uu-work-dir)
gnus-uu-tmp-alist))))
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index 36b28350362..baa3146e64e 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -142,7 +142,7 @@ used to display Gnus windows."
(pipe
(vertical 1.0
(summary 0.25 point)
- ("*Shell Command Output*" 1.0)))
+ (shell-command-buffer-name 1.0)))
(bug
(vertical 1.0
(if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 6df26b4af8c..cb534260a65 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -292,6 +292,10 @@ is restarted, and sometimes reloaded."
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
+(defgroup gnus-dbus nil
+ "D-Bus integration for Gnus."
+ :group 'gnus)
+
(defconst gnus-version-number "5.13"
"Version number for this version of Gnus.")
@@ -660,7 +664,7 @@ be used directly.")
(defun gnus-add-buffer ()
"Add the current buffer to the list of Gnus buffers."
(gnus-prune-buffers)
- (push (current-buffer) gnus-buffers))
+ (cl-pushnew (current-buffer) gnus-buffers))
(defmacro gnus-kill-buffer (buffer)
"Kill BUFFER and remove from the list of Gnus buffers."
@@ -849,12 +853,6 @@ be used directly.")
(cons (car list) (list :type type :data data)))
list)))
-(let ((command (format "%s" this-command)))
- (when (string-match "gnus" command)
- (if (eq 'gnus-other-frame this-command)
- (gnus-get-buffer-create gnus-group-buffer)
- (gnus-splash))))
-
;;; Do the rest.
(require 'gnus-util)
@@ -1029,8 +1027,7 @@ Check the NNTPSERVER environment variable and the
;; `M-x customize-variable RET gnus-select-method RET' should work without
;; starting or even loading Gnus.
-;;;###autoload(when (fboundp 'custom-autoload)
-;;;###autoload (custom-autoload 'gnus-select-method "gnus"))
+;;;###autoload(custom-autoload 'gnus-select-method "gnus")
(defcustom gnus-select-method
(list 'nntp (or (gnus-getenv-nntpserver)
@@ -1591,7 +1588,7 @@ posting an article."
"Alist of group regexps and its initial input of the number of articles."
:variable-group gnus-group-parameter
:parameter-type '(choice :tag "Initial Input for Large Newsgroup"
- (const :tag "All" nil)
+ (const :tag "All" 'all)
(integer))
:parameter-document "\
@@ -1610,7 +1607,7 @@ total number of articles in the group.")
:variable-default (mapcar
(lambda (g) (list g t))
'("delayed$" "drafts$" "queue$" "INBOX$"
- "^nnmairix:" "^nnir:" "archive"))
+ "^nnmairix:" "^nnselect:" "archive"))
:variable-document
"Groups in which the registry should be turned off."
:variable-group gnus-registry
@@ -2226,8 +2223,8 @@ Disabling the agent may result in noticeable loss of performance."
:group 'gnus-start
:type '(choice (function-item gnus)
(function-item gnus-no-server)
- (function-item gnus-slave)
- (function-item gnus-slave-no-server)))
+ (function-item gnus-child)
+ (function-item gnus-child-no-server)))
(declare-function gnus-group-get-new-news "gnus-group")
@@ -2238,8 +2235,8 @@ Disabling the agent may result in noticeable loss of performance."
:type '(choice (function-item gnus)
(function-item gnus-group-get-new-news)
(function-item gnus-no-server)
- (function-item gnus-slave)
- (function-item gnus-slave-no-server)))
+ (function-item gnus-child)
+ (function-item gnus-child-no-server)))
(defcustom gnus-other-frame-parameters nil
"Frame parameters used by `gnus-other-frame' to create a Gnus frame."
@@ -2417,8 +2414,8 @@ such as a mark that says whether an article is stored in the cache
(defvar gnus-article-buffer "*Article*")
(defvar gnus-server-buffer "*Server*")
-(defvar gnus-slave nil
- "Whether this Gnus is a slave or not.")
+(defvar gnus-child nil
+ "Whether this Gnus is a child or not.")
(defvar gnus-batch-mode nil
"Whether this Gnus is running in batch mode or not.")
@@ -2708,6 +2705,11 @@ with some simple extensions.
%k Pretty-printed version of the above (string)
For example, \"1.2k\" or \"0.4M\".
%L Number of lines in the article (integer)
+%Z RSV of the article; nil if not in an nnselect group (integer)
+%G Originating group name for the article; nil if not
+ in an nnselect group (string)
+%g Short from of the originating group name for the article;
+ nil if not in an nnselect group (string)
%I Indentation based on thread level (a string of
spaces)
%B A complex trn-style thread tree (string)
@@ -3156,7 +3158,10 @@ that that variable is buffer-local to the summary buffers."
(defun gnus-kill-ephemeral-group (group)
"Remove ephemeral GROUP from relevant structures."
- (remhash group gnus-newsrc-hashtb))
+ (remhash group gnus-newsrc-hashtb)
+ (setq gnus-newsrc-alist
+ (delq (assoc group gnus-newsrc-alist)
+ gnus-newsrc-alist)))
(defun gnus-simplify-mode-line ()
"Make mode lines a bit simpler."
@@ -3623,11 +3628,12 @@ If you call this function inside a loop, consider using the faster
(defun gnus-group-get-parameter (group &optional symbol allow-list)
"Return the group parameters for GROUP.
-If SYMBOL, return the value of that symbol in the group parameters.
-If ALLOW-LIST, also allow list as a result.
-Most functions should use `gnus-group-find-parameter', which
-also examines the topic parameters."
- (let ((params (gnus-info-params (gnus-get-info group))))
+If SYMBOL, return the value of that symbol in the group
+parameters. If ALLOW-LIST, also allow list as a result. Most
+functions should use `gnus-group-find-parameter', which also
+examines the topic parameters. GROUP can also be an info structure."
+ (let ((params (gnus-info-params (if (listp group) group
+ (gnus-get-info group)))))
(if symbol
(gnus-group-parameter-value params symbol allow-list)
params)))
@@ -4034,13 +4040,20 @@ Allow completion over sensible values."
;;; User-level commands.
;;;###autoload
+(defun gnus-child-no-server (&optional arg)
+ "Read network news as a child, without connecting to the local server."
+ (interactive "P")
+ (gnus-no-server arg t))
+
+;;;###autoload
(defun gnus-slave-no-server (&optional arg)
- "Read network news as a slave, without connecting to the local server."
+ "Read network news as a child, without connecting to the local server."
(interactive "P")
(gnus-no-server arg t))
+(make-obsolete 'gnus-slave-no-server 'gnus-child-no-server "28.1")
;;;###autoload
-(defun gnus-no-server (&optional arg slave)
+(defun gnus-no-server (&optional arg child)
"Read network news.
If ARG is a positive number, Gnus will use that as the startup level.
If ARG is nil, Gnus will be started at level 2. If ARG is non-nil
@@ -4049,13 +4062,20 @@ an NNTP server to use.
As opposed to `gnus', this command will not connect to the local
server."
(interactive "P")
- (gnus-no-server-1 arg slave))
+ (gnus-no-server-1 arg child))
+
+;;;###autoload
+(defun gnus-child (&optional arg)
+ "Read news as a child."
+ (interactive "P")
+ (gnus arg nil 'child))
;;;###autoload
(defun gnus-slave (&optional arg)
- "Read news as a slave."
+ "Read news as a child."
(interactive "P")
- (gnus arg nil 'slave))
+ (gnus arg nil 'child))
+(make-obsolete 'gnus-slave 'gnus-child "28.1")
(defun gnus-delete-gnus-frame ()
"Delete gnus frame unless it is the only one.
@@ -4116,7 +4136,7 @@ current display is used."
(add-hook 'gnus-suspend-gnus-hook #'gnus-delete-gnus-frame)))))
;;;###autoload
-(defun gnus (&optional arg dont-connect slave)
+(defun gnus (&optional arg dont-connect child)
"Read network news.
If ARG is non-nil and a positive number, Gnus will use that as the
startup level. If ARG is non-nil and not a positive number, Gnus will
@@ -4130,7 +4150,7 @@ prompt the user for the name of an NNTP server to use."
(message "You should byte-compile Gnus")
(sit-for 2))
(let ((gnus-action-message-log (list nil)))
- (gnus-1 arg dont-connect slave)
+ (gnus-1 arg dont-connect child)
(gnus-final-warning)))
(declare-function debbugs-gnu "ext:debbugs-gnu"
diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el
index 218a1542e3a..485d58ad94e 100644
--- a/lisp/gnus/gssapi.el
+++ b/lisp/gnus/gssapi.el
@@ -25,8 +25,6 @@
;;; Code:
-(require 'format-spec)
-
(defcustom gssapi-program (list
(concat "gsasl %s %p "
"--mechanism GSSAPI "
@@ -53,12 +51,9 @@ tried until a successful connection is made."
(coding-system-for-write 'binary)
(process (start-process
name buffer shell-file-name shell-command-switch
- (format-spec
- cmd
- (format-spec-make
- ?s server
- ?p (number-to-string port)
- ?l user))))
+ (format-spec cmd `((?s . ,server)
+ (?p . ,(number-to-string port))
+ (?l . ,user)))))
response)
(when process
(while (and (memq (process-status process) '(open run))
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 52343d4fa37..43180726c45 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -24,7 +24,6 @@
;;; Code:
-(require 'format-spec)
(eval-when-compile
(require 'cl-lib)
(require 'imap))
@@ -695,7 +694,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
mail-source-movemail-program
nil errors nil from to)))))
(when (file-exists-p to)
- (set-file-modes to mail-source-default-file-modes))
+ (set-file-modes to mail-source-default-file-modes 'nofollow))
(if (and (or (not (buffer-modified-p errors))
(zerop (buffer-size errors)))
(and (numberp result)
@@ -740,9 +739,11 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
(when delay
(sleep-for delay)))
+(declare-function gnus-get-buffer-create "gnus" (name))
(defun mail-source-call-script (script)
+ (require 'gnus)
(let ((background nil)
- (stderr (get-buffer-create " *mail-source-stderr*"))
+ (stderr (gnus-get-buffer-create " *mail-source-stderr*"))
result)
(when (string-match "& *$" script)
(setq script (substring script 0 (match-beginning 0))
@@ -767,14 +768,14 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
"Fetcher for single-file sources."
(mail-source-bind (file source)
(mail-source-run-script
- prescript (format-spec-make ?t mail-source-crash-box)
+ prescript `((?t . ,mail-source-crash-box))
prescript-delay)
(let ((mail-source-string (format "file:%s" path)))
(if (mail-source-movemail path mail-source-crash-box)
(prog1
(mail-source-callback callback path)
(mail-source-run-script
- postscript (format-spec-make ?t mail-source-crash-box))
+ postscript `((?t . ,mail-source-crash-box)))
(mail-source-delete-crash-box))
0))))
@@ -782,7 +783,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
"Fetcher for directory sources."
(mail-source-bind (directory source)
(mail-source-run-script
- prescript (format-spec-make ?t path) prescript-delay)
+ prescript `((?t . ,path)) prescript-delay)
(let ((found 0)
(mail-source-string (format "directory:%s" path)))
(dolist (file (directory-files
@@ -791,7 +792,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
(funcall predicate file)
(mail-source-movemail file mail-source-crash-box))
(cl-incf found (mail-source-callback callback file))
- (mail-source-run-script postscript (format-spec-make ?t path))
+ (mail-source-run-script postscript `((?t . ,path)))
(mail-source-delete-crash-box)))
found)))
@@ -801,8 +802,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
;; fixme: deal with stream type in format specs
(mail-source-run-script
prescript
- (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user)
+ `((?p . ,password) (?t . ,mail-source-crash-box)
+ (?s . ,server) (?P . ,port) (?u . ,user))
prescript-delay)
(let ((from (format "%s:%s:%s" server user port))
(mail-source-string (format "pop:%s@%s" user server))
@@ -823,8 +824,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
(mail-source-fetch-with-program
(format-spec
program
- (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user))))
+ `((?p . ,password) (?t . ,mail-source-crash-box)
+ (?s . ,server) (?P . ,port) (?u . ,user)))))
(function
(funcall function mail-source-crash-box))
;; The default is to use pop3.el.
@@ -861,8 +862,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
(setq mail-source-new-mail-available nil))
(mail-source-run-script
postscript
- (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user))
+ `((?p . ,password) (?t . ,mail-source-crash-box)
+ (?s . ,server) (?P . ,port) (?u . ,user)))
(mail-source-delete-crash-box)))
;; We nix out the password in case the error
;; was because of a wrong password being given.
@@ -1075,8 +1076,9 @@ This only works when `display-time' is enabled."
"Fetcher for imap sources."
(mail-source-bind (imap source)
(mail-source-run-script
- prescript (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user)
+ prescript
+ `((?p . ,password) (?t . ,mail-source-crash-box)
+ (?s . ,server) (?P . ,port) (?u . ,user))
prescript-delay)
(let ((from (format "%s:%s:%s" server user port))
(found 0)
@@ -1141,8 +1143,8 @@ This only works when `display-time' is enabled."
(kill-buffer buf)
(mail-source-run-script
postscript
- (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user))
+ `((?p . ,password) (?t . ,mail-source-crash-box)
+ (?s . ,server) (?P . ,port) (?u . ,user)))
found)))
(provide 'mail-source)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 6c425b0ea16..77856aeddec 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -42,13 +42,12 @@
(require 'mail-parse)
(require 'mml)
(require 'rfc822)
-(require 'format-spec)
(require 'dired)
(require 'mm-util)
(require 'rfc2047)
(require 'puny)
-(require 'rmc) ; read-multiple-choice
-(eval-when-compile (require 'subr-x)) ; when-let*
+(require 'rmc) ; read-multiple-choice
+(eval-when-compile (require 'subr-x))
(autoload 'mailclient-send-it "mailclient")
@@ -215,9 +214,9 @@ Also see `message-required-news-headers' and
:link '(custom-manual "(message)Message Headers")
:type '(repeat sexp))
-(defcustom message-draft-headers '(References From Date)
+(defcustom message-draft-headers '(References From)
"Headers to be generated when saving a draft message."
- :version "22.1"
+ :version "28.1"
:group 'message-news
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
@@ -304,6 +303,13 @@ any confusion."
:link '(custom-manual "(message)Message Headers")
:type 'regexp)
+(defcustom message-screenshot-command '("import" "png:-")
+ "Command to take a screenshot.
+The command should insert a PNG in the current buffer."
+ :group 'message-various
+ :type '(repeat string)
+ :version "28.1")
+
;;; Start of variables adopted from `message-utils.el'.
(defcustom message-subject-trailing-was-query t
@@ -322,7 +328,7 @@ used."
:group 'message-various)
(defcustom message-subject-trailing-was-ask-regexp
- "[ \t]*\\([[(]+[Ww][Aa][Ss]:?[ \t]*.*[])]+\\)"
+ "[ \t]*\\([[(]+[Ww][Aa][Ss].*[])]+\\)"
"Regexp matching \"(was: <old subject>)\" in the subject line.
The function `message-strip-subject-trailing-was' uses this regexp if
@@ -337,7 +343,7 @@ It is okay to create some false positives here, as the user is asked."
:type 'regexp)
(defcustom message-subject-trailing-was-regexp
- "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)"
+ "[ \t]*\\((*[Ww][Aa][Ss]:.*)\\)"
"Regexp matching \"(was: <old subject>)\" in the subject line.
If `message-subject-trailing-was-query' is set to t, the subject is
@@ -440,8 +446,8 @@ whitespace)."
(defcustom message-elide-ellipsis "\n[...]\n\n"
"The string which is inserted for elided text.
-This is a format-spec string, and you can use %l to say how many
-lines were removed, and %c to say how many characters were
+This is a `format-spec' string, and you can use %l to say how
+many lines were removed, and %c to say how many characters were
removed."
:type 'string
:link '(custom-manual "(message)Various Commands")
@@ -848,7 +854,8 @@ symbol `never', the posting is not allowed. If it is the symbol
;; differently (bug#36937).
nil
"Non-nil means don't add \"-f username\" to the sendmail command line.
-Doing so would be even more evil than leaving it out."
+See `feedmail-sendmail-f-doesnt-sell-me-out' for an explanation
+of what the \"-f\" parameter does."
:group 'message-sending
:link '(custom-manual "(message)Mail Variables")
:type 'boolean)
@@ -1986,6 +1993,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
(autoload 'gnus-delay-article "gnus-delay")
(autoload 'gnus-extract-address-components "gnus-util")
(autoload 'gnus-find-method-for-group "gnus")
+(autoload 'gnus-get-buffer-create "gnus")
(autoload 'gnus-group-name-charset "gnus-group")
(autoload 'gnus-group-name-decode "gnus-group")
(autoload 'gnus-groups-from-server "gnus")
@@ -2730,6 +2738,67 @@ systematically send encrypted emails when possible."
(when (message-all-epg-keys-available-p)
(mml-secure-message-sign-encrypt)))
+(defcustom message-openpgp-header nil
+ "Specification for the \"OpenPGP\" header of outgoing messages.
+
+The value must be a list of three elements, all strings:
+- Key ID, in hexadecimal form;
+- Key URL or ASCII armoured key; and
+- Protection preference, one of: \"unprotected\", \"sign\",
+ \"encrypt\" or \"signencrypt\".
+
+Each of the elements may be nil, in which case its part in the
+OpenPGP header will be left out. If all the values are nil,
+or `message-openpgp-header' is itself nil, the OpenPGP header
+will not be inserted."
+ :type '(choice
+ (const :tag "Don't add OpenPGP header" nil)
+ (list :tag "Use OpenPGP header"
+ (choice (string :tag "ID")
+ (const :tag "No ID" nil))
+ (choice (string :tag "Key")
+ (const :tag "No Key" nil))
+ (choice (other :tag "None" nil)
+ (const :tag "Unprotected" "unprotected")
+ (const :tag "Sign" "sign")
+ (const :tag "Encrypt" "encrypt")
+ (const :tag "Sign and Encrypt" "signencrypt"))))
+ :version "28.1")
+
+(defun message-add-openpgp-header ()
+ "Add OpenPGP header to point to public key.
+
+Header will be constructed as specified in `message-openpgp-header'.
+
+Consider adding this function to `message-header-setup-hook'"
+ ;; See https://tools.ietf.org/html/draft-josefsson-openpgp-mailnews-header
+ (when (and message-openpgp-header
+ (or (nth 0 message-openpgp-header)
+ (nth 1 message-openpgp-header)
+ (nth 2 message-openpgp-header)))
+ (message-add-header
+ (with-temp-buffer
+ (insert "OpenPGP: ")
+ ;; add ID
+ (let (need-sep)
+ (when (nth 0 message-openpgp-header)
+ (insert "id=" (nth 0 message-openpgp-header))
+ (setq need-sep t))
+ ;; add URL
+ (when (nth 1 message-openpgp-header)
+ (when need-sep (insert "; "))
+ (if (string-match-p ";")
+ (insert "url=\"" (nth 1 message-openpgp-header) "\"")
+ (insert "url=\"" (nth 1 message-openpgp-header) "\""))
+ (setq need-sep t))
+ ;; add preference
+ (when (nth 2 message-openpgp-header)
+ (when need-sep (insert "; "))
+ (insert "preference=" (nth 2 message-openpgp-header))))
+ ;; insert header
+ (buffer-string)))
+ (message-sort-headers)))
+
;;;
@@ -2810,6 +2879,7 @@ systematically send encrypted emails when possible."
(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)
@@ -2839,6 +2909,8 @@ systematically send encrypted emails when possible."
:active (message-mark-active-p) :help "Mark region with enclosing tags"]
["Insert File Marked..." message-mark-insert-file
:help "Insert file at point marked with enclosing tags"]
+ ["Attach File..." mml-attach-file t]
+ ["Insert Screenshot" message-insert-screenshot t]
"----"
["Send Message" message-send-and-exit :help "Send this message"]
["Postpone Message" message-dont-send
@@ -3464,8 +3536,8 @@ Prefix arg means justify as well."
(equal quoted (match-string 0)))
(goto-char (match-end 0))
(looking-at "[ \t]*")
- (if (> (length leading-space) (length (match-string 0)))
- (setq leading-space (match-string 0)))
+ (when (< (length leading-space) (length (match-string 0)))
+ (setq leading-space (match-string 0)))
(forward-line 1))
(setq end (point))
(goto-char beg)
@@ -3976,7 +4048,6 @@ This function uses `mail-citation-hook' if that is non-nil."
"Cite function in the standard Message manner."
(message-cite-original-1 nil))
-(autoload 'format-spec "format-spec")
(autoload 'gnus-date-get-time "gnus-util")
(defun message-insert-formatted-citation-line (&optional from date tz)
@@ -4001,20 +4072,18 @@ See `message-citation-line-format'."
(when (or message-reply-headers (and from date))
(unless from
(setq from (mail-header-from message-reply-headers)))
- (let* ((data (condition-case ()
- (funcall (if (boundp 'gnus-extract-address-components)
- gnus-extract-address-components
- 'mail-extract-address-components)
- from)
- (error nil)))
+ (let* ((data (ignore-errors
+ (funcall (or (bound-and-true-p
+ gnus-extract-address-components)
+ #'mail-extract-address-components)
+ from)))
(name (car data))
(fname name)
(lname name)
- (net (car (cdr data)))
- (name-or-net (or (car data)
- (car (cdr data)) from))
+ (net (cadr data))
+ (name-or-net (or name net from))
(time
- (when (string-match "%[^fnNFL]" message-citation-line-format)
+ (when (string-match-p "%[^FLNfn]" message-citation-line-format)
(cond ((numberp (car-safe date)) date) ;; backward compatibility
(date (gnus-date-get-time date))
(t
@@ -4023,68 +4092,53 @@ See `message-citation-line-format'."
(tz (or tz
(when (stringp date)
(nth 8 (parse-time-string date)))))
- (flist
- (let ((i ?A) lst)
- (when (stringp name)
- ;; Guess first name and last name:
- (let* ((names (delq
- nil
- (mapcar
- (lambda (x)
- (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'"
- x)
- x
- nil))
- (split-string name "[ \t]+"))))
- (count (length names)))
- (cond ((= count 1)
- (setq fname (car names)
- lname ""))
- ((or (= count 2) (= count 3))
- (setq fname (car names)
- lname (mapconcat 'identity (cdr names) " ")))
- ((> count 3)
- (setq fname (mapconcat 'identity
- (butlast names (- count 2))
- " ")
- lname (mapconcat 'identity
- (nthcdr 2 names)
- " "))))
- (when (string-match "\\(.*\\),\\'" fname)
- (let ((newlname (match-string 1 fname)))
- (setq fname lname lname newlname)))))
- ;; The following letters are not used in `format-time-string':
- (push ?E lst) (push "<E>" lst)
- (push ?F lst) (push (or fname name-or-net) lst)
- ;; We might want to use "" instead of "<X>" later.
- (push ?J lst) (push "<J>" lst)
- (push ?K lst) (push "<K>" lst)
- (push ?L lst) (push lname lst)
- (push ?N lst) (push name-or-net lst)
- (push ?O lst) (push "<O>" lst)
- (push ?P lst) (push "<P>" lst)
- (push ?Q lst) (push "<Q>" lst)
- (push ?f lst) (push from lst)
- (push ?i lst) (push "<i>" lst)
- (push ?n lst) (push net lst)
- (push ?o lst) (push "<o>" lst)
- (push ?q lst) (push "<q>" lst)
- (push ?t lst) (push "<t>" lst)
- (push ?v lst) (push "<v>" lst)
- ;; Delegate the rest to `format-time-string':
- (while (<= i ?z)
- (when (and (not (memq i lst))
- ;; Skip (Z,a)
- (or (<= i ?Z)
- (>= i ?a)))
- (push i lst)
- (push (condition-case nil
- (format-time-string (format "%%%c" i) time tz)
- (error (format ">%c<" i)))
- lst))
- (setq i (1+ i)))
- (reverse lst)))
- (spec (apply 'format-spec-make flist)))
+ spec)
+ (when (stringp name)
+ ;; Guess first name and last name:
+ (let* ((names (seq-filter
+ (lambda (s)
+ (string-match-p (rx bos (+ (in word ?. ?-)) eos) s))
+ (split-string name "[ \t]+")))
+ (count (length names)))
+ (cond ((= count 1)
+ (setq fname (car names)
+ lname ""))
+ ((or (= count 2) (= count 3))
+ (setq fname (car names)
+ lname (string-join (cdr names) " ")))
+ ((> count 3)
+ (setq fname (string-join (butlast names (- count 2))
+ " ")
+ lname (string-join (nthcdr 2 names) " "))))
+ (when (string-match "\\(.*\\),\\'" fname)
+ (let ((newlname (match-string 1 fname)))
+ (setq fname lname lname newlname)))))
+ ;; The following letters are not used in `format-time-string':
+ (push (cons ?E "<E>") spec)
+ (push (cons ?F (or fname name-or-net)) spec)
+ ;; We might want to use "" instead of "<X>" later.
+ (push (cons ?J "<J>") spec)
+ (push (cons ?K "<K>") spec)
+ (push (cons ?L lname) spec)
+ (push (cons ?N name-or-net) spec)
+ (push (cons ?O "<O>") spec)
+ (push (cons ?P "<P>") spec)
+ (push (cons ?Q "<Q>") spec)
+ (push (cons ?f from) spec)
+ (push (cons ?i "<i>") spec)
+ (push (cons ?n net) spec)
+ (push (cons ?o "<o>") spec)
+ (push (cons ?q "<q>") spec)
+ (push (cons ?t "<t>") spec)
+ (push (cons ?v "<v>") spec)
+ ;; Delegate the rest to `format-time-string':
+ (dolist (c (nconc (number-sequence ?A ?Z)
+ (number-sequence ?a ?z)))
+ (unless (assq c spec)
+ (push (cons c (condition-case nil
+ (format-time-string (format "%%%c" c) time tz)
+ (error (format ">%c<" c))))
+ spec)))
(insert (format-spec message-citation-line-format spec)))
(newline)))
@@ -4376,7 +4430,7 @@ conformance."
(error "Invisible text found and made visible")))))
(message-check 'illegible-text
(let (char found choice nul-chars)
- (message-goto-body)
+ (goto-char (point-min))
(setq nul-chars (save-excursion
(search-forward "\000" nil t)))
(while (progn
@@ -4412,11 +4466,12 @@ conformance."
,(format
"Replace non-printable characters with \"%s\" and send"
message-replacement-char))
+ (?u "url-encode" "Use URL %hex encoding")
(?s "send" "Send as is without removing anything")
(?e "edit" "Continue editing")))))
(if (eq choice ?e)
(error "Non-printable characters"))
- (message-goto-body)
+ (goto-char (point-min))
(skip-chars-forward mm-7bit-chars)
(while (not (eobp))
(when (let ((char (char-after)))
@@ -4433,11 +4488,17 @@ conformance."
control-1))
(not (get-text-property
(point) 'untranslated-utf-8)))))
- (if (eq choice ?i)
- (message-kill-all-overlays)
+ (cond
+ ((eq choice ?i)
+ (message-kill-all-overlays))
+ ((eq choice ?u)
+ (let ((char (get-byte (point))))
+ (delete-char 1)
+ (insert (format "%%%x" char))))
+ (t
(delete-char 1)
(when (eq choice ?r)
- (insert message-replacement-char))))
+ (insert message-replacement-char)))))
(forward-char)
(skip-chars-forward mm-7bit-chars)))))
(message-check 'bogus-recipient
@@ -4507,7 +4568,8 @@ This function could be useful in `message-setup-hook'."
(custom-add-option 'message-setup-hook 'message-check-recipients)
(defun message-add-action (action &rest types)
- "Add ACTION to be performed when doing an exit of type TYPES."
+ "Add ACTION to be performed when doing an exit of type TYPES.
+Valid types are `send', `return', `exit', `kill' and `postpone'."
(while types
(add-to-list (intern (format "message-%s-actions" (pop types)))
action)))
@@ -4757,7 +4819,7 @@ If you always want Gnus to send messages in one piece, set
message-courtesy-message)))
;; If this was set, `sendmail-program' takes care of encoding.
(unless message-inhibit-body-encoding
- ;; Let's make sure we encoded all the body.
+ ;; Let's make sure we encoded everything in the buffer.
(cl-assert (save-excursion
(goto-char (point-min))
(not (re-search-forward "[^\000-\377]" nil t)))))
@@ -4782,15 +4844,16 @@ If you always want Gnus to send messages in one piece, set
Each line should be no more than 79 characters long."
(goto-char (point-min))
(while (not (eobp))
- (when (and (looking-at "[^:]+:")
- (> (- (line-end-position) (point)) 79))
- (mail-header-fold-field))
- (forward-line 1)))
+ (if (and (looking-at "[^:]+:")
+ (> (- (line-end-position) (point)) 79))
+ (goto-char (mail-header-fold-field))
+ (forward-line 1))))
(defvar sendmail-program)
(defvar smtpmail-smtp-server)
(defvar smtpmail-smtp-service)
(defvar smtpmail-smtp-user)
+(defvar smtpmail-stream-type)
(defun message-multi-smtp-send-mail ()
"Send the current buffer to `message-send-mail-function'.
@@ -4809,6 +4872,11 @@ that instead."
(let* ((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
+ ;; TLS connection.
+ (smtpmail-stream-type (if (= port 465)
+ 'tls
+ smtpmail-stream-type))
(smtpmail-smtp-service (if (> port 0) port service))
(smtpmail-smtp-user (or (nth 3 method) smtpmail-smtp-user)))
(message-smtpmail-send-it)))
@@ -5591,7 +5659,7 @@ The result is a fixnum."
(mail-file-babyl-p filename))
;; gnus-output-to-mail does the wrong thing with live, mbox
;; Rmail buffers in Emacs 23.
- ;; http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=597255
+ ;; https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=597255
(let ((buff (find-buffer-visiting filename)))
(and buff (with-current-buffer buff
(eq major-mode 'rmail-mode)))))
@@ -6443,7 +6511,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")
(cond
;; Go to beginning of header or beginning of line.
((and message-beginning-of-line (message-point-in-header-p))
@@ -7006,15 +7074,28 @@ want to get rid of this query permanently.")))
;; Build the header alist. Allow the user to be asked whether
;; or not to reply to all recipients in a wide reply.
- (setq follow-to (list (cons 'To (cdr (pop recipients)))))
- (when (and recipients
- (or (not message-wide-reply-confirm-recipients)
- (y-or-n-p "Reply to all recipients? ")))
- (setq recipients (mapconcat
- (lambda (addr) (cdr addr)) recipients ", "))
- (if (string-match "^ +" recipients)
- (setq recipients (substring recipients (match-end 0))))
- (push (cons 'Cc recipients) follow-to)))
+ (when (or (< (length recipients) 2)
+ (not message-wide-reply-confirm-recipients)
+ (y-or-n-p "Reply to all recipients? "))
+ (if never-mct
+ ;; The author has requested never to get a (wide)
+ ;; response, so put everybody else into the To header.
+ ;; This avoids looking as if we're To-in somebody else in
+ ;; specific, and just Cc-in the rest.
+ (setq follow-to (list
+ (cons 'To
+ (mapconcat
+ (lambda (addr)
+ (cdr addr)) 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 ", "))
+ (if (string-match "^ +" recipients)
+ (setq recipients (substring recipients (match-end 0))))
+ (push (cons 'Cc recipients) follow-to)))))
follow-to))
(defun message-prune-recipients (recipients)
@@ -7310,7 +7391,7 @@ If ARG, allow editing of the cancellation message."
;; Make control message.
(if arg
(message-news)
- (setq buf (set-buffer (get-buffer-create " *message cancel*"))))
+ (setq buf (set-buffer (gnus-get-buffer-create " *message cancel*"))))
(erase-buffer)
(insert "Newsgroups: " newsgroups "\n"
"From: " from "\n"
@@ -7731,7 +7812,7 @@ is for the internal use."
gcc beg)
;; We first set up a normal mail buffer.
(unless (message-mail-user-agent)
- (set-buffer (get-buffer-create " *message resend*"))
+ (set-buffer (gnus-get-buffer-create " *message resend*"))
(let ((inhibit-read-only t))
(erase-buffer)))
(let ((message-this-is-mail t)
@@ -7983,7 +8064,7 @@ See `gmm-tool-bar-from-list' for details on the format of the list."
(defcustom message-tool-bar-retro
'(;; Old Emacs 21 icon for consistency.
- (message-send-and-exit "gnus/mail-send")
+ (message-send-and-exit "mail/send")
(message-kill-buffer "close")
(message-dont-send "cancel")
(mml-attach-file "attach" mml-mode-map)
@@ -8510,7 +8591,7 @@ Meant for use on `completion-at-point-functions'."
;; FIXME: What is the most common term (circular letter, form letter, serial
;; letter, standard letter) for such kind of letter? See also
-;; <http://en.wikipedia.org/wiki/Form_letter>
+;; <https://en.wikipedia.org/wiki/Form_letter>
;; FIXME: Maybe extent message-mode's font-lock support to recognize
;; `message-form-letter-separator', i.e. highlight each message like a single
@@ -8670,6 +8751,108 @@ Used in `message-simplify-recipients'."
(* 0.5 (- (nth 3 edges) (nth 1 edges)))))
string)))))))
+(defun message-insert-screenshot (delay)
+ "Take a screenshot and insert in the current buffer.
+DELAY (the numeric prefix) says how many seconds to wait before
+starting the screenshotting process.
+
+The `message-screenshot-command' variable says what command is
+used to take the screenshot."
+ (interactive "p")
+ (unless (executable-find (car message-screenshot-command))
+ (error "Can't find %s to take the screenshot"
+ (car message-screenshot-command)))
+ (cl-decf delay)
+ (unless (zerop delay)
+ (dotimes (i delay)
+ (message "Sleeping %d second%s..."
+ (- delay i)
+ (if (= (- delay i) 1)
+ ""
+ "s"))
+ (sleep-for 1)))
+ (message "Take screenshot")
+ (let ((image
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (apply #'call-process
+ (car message-screenshot-command) nil (current-buffer) nil
+ (cdr message-screenshot-command))
+ (buffer-string))))
+ (set-mark (point))
+ (insert-image
+ (create-image image 'png t
+ :max-width (truncate (* (frame-pixel-width) 0.8))
+ :max-height (truncate (* (frame-pixel-height) 0.8))
+ :scale 1)
+ (format "<#part type=\"image/png\" disposition=inline data-encoding=base64 raw=t>\n%s\n<#/part>"
+ ;; Get a base64 version of the image -- this avoids later
+ ;; complications if we're auto-saving the buffer and
+ ;; restoring from a file.
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert image)
+ (base64-encode-region (point-min) (point-max) t)
+ (buffer-string))))
+ (insert "\n\n")
+ (message "")))
+
+(declare-function gnus-url-unhex-string "gnus-util")
+
+(defun message-parse-mailto-url (url)
+ "Parse a mailto: url."
+ (setq url (replace-regexp-in-string "\n" " " url))
+ (when (string-match "mailto:/*\\(.*\\)" url)
+ (setq url (substring url (match-beginning 1) nil)))
+ (setq url (if (string-match "^\\?" url)
+ (substring url 1)
+ (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url)
+ (concat "to=" (match-string 1 url) "&"
+ (match-string 2 url))
+ (concat "to=" url))))
+ (let (retval pairs cur key val)
+ (setq pairs (split-string url "&"))
+ (while pairs
+ (setq cur (car pairs)
+ pairs (cdr pairs))
+ (if (not (string-match "=" cur))
+ nil ; Grace
+ (setq key (downcase (gnus-url-unhex-string
+ (substring cur 0 (match-beginning 0))))
+ val (gnus-url-unhex-string (substring cur (match-end 0) nil) t))
+ (setq cur (assoc key retval))
+ (if cur
+ (setcdr cur (cons val (cdr cur)))
+ (setq retval (cons (list key val) retval)))))
+ retval))
+
+;;;###autoload
+(defun message-mailto ()
+ "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."
+ (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)))
+
+(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
+ "\r\n" "\n"
+ (mapconcat #'identity (reverse (cdr arg)) ", ") nil t))))
+ (when (assoc "body" args)
+ (message-goto-body)
+ (dolist (body (cdr (assoc "body" args)))
+ (insert body "\n")))
+ (if (assoc "subject" args)
+ (message-goto-body)
+ (message-goto-subject))))
+
(provide 'message)
(run-hooks 'message-load-hook)
diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el
index 6b4308e9790..56253afa193 100644
--- a/lisp/gnus/mm-archive.el
+++ b/lisp/gnus/mm-archive.el
@@ -24,6 +24,7 @@
(require 'mm-decode)
(autoload 'gnus-recursive-directory-files "gnus-util")
+(autoload 'gnus-get-buffer-create "gnus")
(autoload 'mailcap-extension-to-mime "mailcap")
(defvar mm-archive-decoders
@@ -41,8 +42,9 @@
dir)
(unless decoder
(error "No decoder found for %s" type))
- (setq dir (make-temp-file (expand-file-name "emm." mm-tmp-directory) 'dir))
- (set-file-modes dir #o700)
+ (with-file-modes #o700
+ (setq dir (make-temp-file (expand-file-name "emm." mm-tmp-directory)
+ 'dir)))
(unwind-protect
(progn
(mm-with-unibyte-buffer
@@ -56,7 +58,7 @@
(append (cdr decoder) (list dir)))
(delete-file file))
(apply 'call-process-region (point-min) (point-max) (car decoder)
- nil (get-buffer-create "*tnef*")
+ nil (gnus-get-buffer-create "*tnef*")
nil (append (cdr decoder) (list dir)))))
`("multipart/mixed"
,handle
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index a340418507f..1bce6ca020e 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -602,11 +602,10 @@ files left at the next time."
(push temp fails)))
(if fails
;; Schedule the deletion of the files left at the next time.
- (progn
+ (with-file-modes #o600
(write-region (concat (mapconcat 'identity (nreverse fails) "\n")
"\n")
- nil cache-file nil 'silent)
- (set-file-modes cache-file #o600))
+ nil cache-file nil 'silent))
(when (file-exists-p cache-file)
(ignore-errors (delete-file cache-file))))
(setq mm-temp-files-to-be-deleted nil)))
@@ -911,8 +910,10 @@ external if displayed external."
;; The function is a string to be executed.
(mm-insert-part handle)
(mm-add-meta-html-tag handle)
- (let* ((dir (make-temp-file
- (expand-file-name "emm." mm-tmp-directory) 'dir))
+ ;; We create a private sub-directory where we store our files.
+ (let* ((dir (with-file-modes #o700
+ (make-temp-file
+ (expand-file-name "emm." mm-tmp-directory) 'dir)))
(filename (or
(mail-content-type-get
(mm-handle-disposition handle) 'filename)
@@ -924,8 +925,6 @@ external if displayed external."
(assoc "needsterminal" mime-info)))
(copiousoutput (assoc "copiousoutput" mime-info))
file buffer)
- ;; We create a private sub-directory where we store our files.
- (set-file-modes dir #o700)
(if filename
(setq file (expand-file-name
(gnus-map-function mm-file-name-rewrite-functions
@@ -941,14 +940,15 @@ external if displayed external."
;; `mailcap-mime-extensions'.
(setq suffix (car (rassoc (mm-handle-media-type handle)
mailcap-mime-extensions))))
- (setq file (make-temp-file (expand-file-name "mm." dir)
- nil suffix))))
+ (setq file (with-file-modes #o600
+ (make-temp-file (expand-file-name "mm." dir)
+ nil suffix)))))
(let ((coding-system-for-write mm-binary-coding-system))
(write-region (point-min) (point-max) file nil 'nomesg))
;; The file is deleted after the viewer exists. If the users edits
;; the file, changes will be lost. Set file to read-only to make it
;; clear.
- (set-file-modes file #o400)
+ (set-file-modes file #o400 'nofollow)
(message "Viewing with %s" method)
(cond
(needsterm
@@ -1364,10 +1364,7 @@ PROMPT overrides the default one used to ask user for a file name."
(setq file
(read-file-name
(or prompt
- (format "Save MIME part to%s: "
- (if filename
- (format " (default %s)" filename)
- "")))
+ (format-prompt "Save MIME part to" filename))
(or directory mm-default-directory default-directory)
(expand-file-name
(or filename "")
@@ -1668,18 +1665,26 @@ If RECURSIVE, search recursively."
(let ((type (car ctl))
(subtype (cadr (split-string (car ctl) "/")))
(mm-security-handle ctl) ;; (car CTL) is the type.
+ (smime-type (cdr (assq 'smime-type (mm-handle-type parts))))
protocol func functest)
(cond
((or (equal type "application/x-pkcs7-mime")
(equal type "application/pkcs7-mime"))
(with-temp-buffer
(when (and (cond
+ ((equal smime-type "signed-data") t)
((eq mm-decrypt-option 'never) nil)
((eq mm-decrypt-option 'always) t)
((eq mm-decrypt-option 'known) t)
(t (y-or-n-p
(format "Decrypt (S/MIME) part? "))))
(mm-view-pkcs7 parts from))
+ (goto-char (point-min))
+ ;; The encrypted document is a MIME part, and may use either
+ ;; CRLF (Outlook and the like) or newlines for end-of-line
+ ;; markers. Translate from CRLF.
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n"))
;; Normally there will be a Content-type header here, but
;; some mailers don't add that to the encrypted part, which
;; makes the subsequent re-dissection fail here.
@@ -1688,7 +1693,21 @@ If RECURSIVE, search recursively."
(unless (mail-fetch-field "content-type")
(goto-char (point-max))
(insert "Content-type: text/plain\n\n")))
- (setq parts (mm-dissect-buffer t)))))
+ (setq parts
+ (if (equal smime-type "signed-data")
+ (list (propertize
+ "multipart/signed"
+ 'protocol "application/pkcs7-signature"
+ 'gnus-info
+ (format
+ "%s:%s"
+ (get-text-property 0 'gnus-info
+ (car mm-security-handle))
+ (get-text-property 0 'gnus-details
+ (car mm-security-handle))))
+ (mm-dissect-buffer t)
+ parts)
+ (mm-dissect-buffer t))))))
((equal subtype "signed")
(unless (and (setq protocol
(mm-handle-multipart-ctl-parameter ctl 'protocol))
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 7629d5cb151..958e24c39f5 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -70,7 +70,7 @@
(mm-coding-system-p 'cp932))
'((windows-31j . cp932)))
;; Charset name: GBK, Charset aliases: CP936, MS936, windows-936
- ;; http://www.iana.org/assignments/charset-reg/GBK
+ ;; https://www.iana.org/assignments/charset-reg/GBK
;; Emacs 22.1 has cp936, but not gbk, so we alias it:
,@(when (and (not (mm-coding-system-p 'gbk))
(mm-coding-system-p 'cp936))
@@ -131,10 +131,6 @@ is not available."
(cond
((null charset)
charset)
- ;; Running in a non-MULE environment.
- ((or (null (mm-get-coding-system-list))
- (not (fboundp 'coding-system-get)))
- charset)
;; Check override list quite early. Should only used for decoding, not for
;; encoding!
((and allow-override
@@ -295,77 +291,16 @@ superset of iso-8859-1."
(defvar mm-universal-coding-system mm-auto-save-coding-system
"The universal coding system.")
-;; Fixme: some of the cars here aren't valid MIME charsets. That
-;; should only matter with XEmacs, though.
(defvar mm-mime-mule-charset-alist
- '((us-ascii ascii)
- (iso-8859-1 latin-iso8859-1)
- (iso-8859-2 latin-iso8859-2)
- (iso-8859-3 latin-iso8859-3)
- (iso-8859-4 latin-iso8859-4)
- (iso-8859-5 cyrillic-iso8859-5)
- ;; Non-mule (X)Emacs uses the last mule-charset for 8bit characters.
- ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default
- ;; charset is koi8-r, not iso-8859-5.
- (koi8-r cyrillic-iso8859-5 gnus-koi8-r)
- (iso-8859-6 arabic-iso8859-6)
- (iso-8859-7 greek-iso8859-7)
- (iso-8859-8 hebrew-iso8859-8)
- (iso-8859-9 latin-iso8859-9)
- (iso-8859-14 latin-iso8859-14)
- (iso-8859-15 latin-iso8859-15)
- (viscii vietnamese-viscii-lower)
- (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978)
- (euc-kr korean-ksc5601)
- (gb2312 chinese-gb2312)
- (gbk chinese-gbk)
- (gb18030 gb18030-2-byte
- gb18030-4-byte-bmp gb18030-4-byte-smp
- gb18030-4-byte-ext-1 gb18030-4-byte-ext-2)
- (big5 chinese-big5-1 chinese-big5-2)
- (tibetan tibetan)
- (thai-tis620 thai-tis620)
- (windows-1251 cyrillic-iso8859-5)
- (iso-2022-7bit ethiopic arabic-1-column arabic-2-column)
- (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212)
- (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2)
- (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2
- cyrillic-iso8859-5 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2
- chinese-cns11643-3 chinese-cns11643-4
- chinese-cns11643-5 chinese-cns11643-6
- chinese-cns11643-7)
- (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208
- japanese-jisx0213-1 japanese-jisx0213-2)
- (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208)
- (utf-8))
- "Alist of MIME-charset/MULE-charsets.")
-
-;; Correct by construction, but should be unnecessary for Emacs:
-(when (and (fboundp 'coding-system-list)
- (fboundp 'sort-coding-systems))
- (let ((css (sort-coding-systems (coding-system-list 'base-only)))
- cs mime mule alist)
- (while css
- (setq cs (pop css)
- mime (or (coding-system-get cs :mime-charset) ; Emacs 23 (unicode)
- (coding-system-get cs 'mime-charset)))
+ (let (mime mule alist)
+ (dolist (cs (sort-coding-systems (coding-system-list 'base-only)))
+ (setq mime (coding-system-get cs 'mime-charset))
(when (and mime
- (not (eq t (setq mule
- (coding-system-get cs 'safe-charsets))))
+ (not (eq t (setq mule (coding-system-get cs 'safe-charsets))))
(not (assq mime alist)))
(push (cons mime (delq 'ascii mule)) alist)))
- (setq mm-mime-mule-charset-alist (nreverse alist))))
+ (nreverse alist))
+ "Alist of MIME-charset/MULE-charsets.")
(defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2)
"A list of special charsets.
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index e6fdc93da24..aedd6c948c2 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -192,7 +192,7 @@ This can be either \"inline\" or \"attachment\".")
,(lambda () (mm-uu-verbatim-marks-extract 0 0))
nil)
(LaTeX
- "^\\([\\\\%][^\n]+\n\\)*\\\\documentclass.*[[{%]"
+ "^\\([\\%][^\n]+\n\\)*\\\\documentclass.*[[{%]"
"^\\\\end{document}"
,#'mm-uu-latex-extract
nil
@@ -251,19 +251,23 @@ The value should be nil on displays where the face
(((type tty)
(class color)
(background dark))
- (:background "dark blue"))
+ (:background "dark blue"
+ :extend t))
(((class color)
(background dark))
(:foreground "light yellow"
- :background "dark green"))
+ :background "dark green"
+ :extend t))
(((type tty)
(class color)
(background light))
- (:foreground "dark blue"))
+ (:foreground "dark blue"
+ :extend t))
(((class color)
(background light))
(:foreground "dark green"
- :background "light yellow"))
+ :background "light yellow"
+ :extend t))
(t
()))
"Face for extracted buffers."
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 828ac633dc5..ca610010917 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -59,11 +59,16 @@
"The attributes of renderer types for text/html.")
(defcustom mm-fill-flowed t
- "If non-nil a format=flowed article will be displayed flowed."
+ "If non-nil, format=flowed articles will be displayed flowed."
:type 'boolean
:version "22.1"
:group 'mime-display)
+;; Not a defcustom, since it's usually overridden by the callers of
+;; the mm functions.
+(defvar mm-inline-font-lock t
+ "If non-nil, do font locking of inline media types that support it.")
+
(defcustom mm-inline-large-images-proportion 0.9
"Maximum proportion large images can occupy in the buffer.
This is only used if `mm-inline-large-images' is set to
@@ -502,7 +507,8 @@ If MODE is not set, try to find mode automatically."
(delay-mode-hooks (set-auto-mode))
(setq mode major-mode)))
;; Do not fontify if the guess mode is fundamental.
- (unless (eq major-mode 'fundamental-mode)
+ (when (and (not (eq major-mode 'fundamental-mode))
+ mm-inline-font-lock)
(font-lock-ensure))))
(setq text (buffer-string))
(when (eq mode 'diff-mode)
@@ -540,7 +546,7 @@ If MODE is not set, try to find mode automatically."
(mm-display-inline-fontify handle 'shell-script-mode))
(defun mm-display-javascript-inline (handle)
- "Show JavsScript code from HANDLE inline."
+ "Show JavaScript code from HANDLE inline."
(mm-display-inline-fontify handle 'javascript-mode))
;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
@@ -591,8 +597,16 @@ If MODE is not set, try to find mode automatically."
(with-temp-buffer
(insert-buffer-substring (mm-handle-buffer handle))
(goto-char (point-min))
- (let ((part (base64-decode-string (buffer-string))))
- (epg-verify-string (epg-make-context 'CMS) part))))
+ (let ((part (base64-decode-string (buffer-string)))
+ (context (epg-make-context 'CMS)))
+ (prog1
+ (epg-verify-string context part)
+ (let ((result (car (epg-context-result-for context 'verify))))
+ (mm-sec-status
+ 'gnus-info (epg-signature-status result)
+ 'gnus-details
+ (format "%s:%s" (epg-signature-validity result)
+ (epg-signature-key-id result))))))))
(with-temp-buffer
(insert "MIME-Version: 1.0\n")
(mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index 8d77916e997..74af99da7e3 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -665,8 +665,9 @@ The passphrase is read and cached."
(epg-user-id-string uid))))
(equal (downcase (car (mail-header-parse-address
(epg-user-id-string uid))))
- (downcase (car (mail-header-parse-address
- recipient))))
+ (downcase (or (car (mail-header-parse-address
+ recipient))
+ recipient)))
(not (memq (epg-user-id-validity uid)
'(revoked expired))))
(throw 'break t))))))
@@ -937,6 +938,48 @@ If no one is selected, symmetric encryption will be performed. "
(signal (car error) (cdr error))))
cipher))
+(defun mml-secure-sender-sign-query (protocol sender)
+ "Query whether to use SENDER to sign when using PROTOCOL.
+PROTOCOL will be `OpenPGP' or `CMS' (smime).
+This can also save the resulting value of
+`mml-secure-smime-sign-with-sender' or
+`mml-secure-openpgp-sign-with-sender' via Customize.
+Returns non-nil if the user has chosen to use SENDER."
+ (let ((buffer (get-buffer-create "*MML sender signing options*"))
+ (options '((?a "always" "Sign using this sender now and sign with message sender in future.")
+ (?s "session only" "Sign using this sender now, and sign with message sender for this session only.")
+ (?n "no" "Do not sign this message (and error out)")))
+ answer done val)
+ (save-window-excursion
+ (pop-to-buffer buffer)
+ (erase-buffer)
+ (insert (format "No %s signing key was found for this message.\nThe sender of this message is \"%s\".\nWould you like to attempt looking up a signing key based on it?"
+ (if (eq protocol 'OpenPGP)
+ "openpgp" "smime")
+ sender))
+ (while (not done)
+ (setq answer (read-multiple-choice "Sign this message using the sender?" options))
+ (cl-case (car answer)
+ (?a
+ (if (eq protocol 'OpenPGP)
+ (progn
+ (setq mml-secure-openpgp-sign-with-sender t)
+ (customize-save-variable
+ 'mml-secure-openpgp-sign-with-sender t))
+ (setq mml-secure-smime-sign-with-sender t)
+ (customize-save-variable 'mml-secure-smime-sign-with-sender t))
+ (setq done t
+ val t))
+ (?s
+ (if (eq protocol 'OpenPGP)
+ (setq mml-secure-openpgp-sign-with-sender t)
+ (setq mml-secure-smime-sign-with-sender t))
+ (setq done t
+ val t))
+ (?n
+ (setq done t)))))
+ val))
+
(defun mml-secure-epg-sign (protocol mode)
;; Based on code appearing inside mml2015-epg-sign.
(let* ((context (epg-make-context protocol))
@@ -944,6 +987,23 @@ If no one is selected, symmetric encryption will be performed. "
(signer-names (mml-secure-signer-names protocol sender))
(signers (mml-secure-signers context signer-names))
signature micalg)
+ (unless signers
+ (if (and (not noninteractive)
+ (mml-secure-sender-sign-query protocol sender))
+ (setq signer-names (mml-secure-signer-names protocol sender)
+ signers (mml-secure-signers context signer-names)))
+ (unless signers
+ (let ((maybe-msg
+ (if (or mml-secure-smime-sign-with-sender
+ mml-secure-openpgp-sign-with-sender)
+ "."
+ "; try setting `mml-secure-smime-sign-with-sender' or 'mml-secure-openpgp-sign-with-sender'.")))
+ ;; If `mml-secure-smime-sign-with-sender' or
+ ;; `mml-secure-openpgp-sign-with-sender' are already non-nil
+ ;; then there's no point advising the user to examine them.
+ ;; If there are any other variables worth examining, please
+ ;; improve this error message by having it mention them.
+ (error "Couldn't find any signer names%s" maybe-msg))))
(when (eq 'OpenPGP protocol)
(setf (epg-context-armor context) t)
(setf (epg-context-textmode context) t)
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index 3cc463d5d4c..acddb300339 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -154,14 +154,9 @@ Whether the passphrase is cached at all is controlled by
(write-region (point-min) (point-max) file))
(push file certfiles)
(push file tmpfiles)))
- (if (smime-encrypt-buffer certfiles)
- (progn
- (while (setq tmp (pop tmpfiles))
- (delete-file tmp))
- t)
- (while (setq tmp (pop tmpfiles))
- (delete-file tmp))
- nil))
+ (smime-encrypt-buffer certfiles)
+ (while (setq tmp (pop tmpfiles))
+ (delete-file tmp)))
(goto-char (point-max)))
(defvar gnus-extract-address-components)
@@ -334,7 +329,6 @@ Whether the passphrase is cached at all is controlled by
(autoload 'epg-verify-string "epg")
(autoload 'epg-sign-string "epg")
(autoload 'epg-encrypt-string "epg")
- (autoload 'epg-passphrase-callback-function "epg")
(autoload 'epg-context-set-passphrase-callback "epg")
(autoload 'epg-sub-key-fingerprint "epg")
(autoload 'epg-configuration "epg-config")
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 556cf0804a5..067396fc2a6 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -295,6 +295,17 @@ part. This is for the internal use, you should never modify the value.")
(t
(mm-find-mime-charset-region point (point)
mm-hack-charsets))))
+ ;; We have a part that already has a transfer encoding. Undo
+ ;; that so that we don't double-encode later.
+ (when (and raw
+ (cdr (assq 'data-encoding tag)))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert contents)
+ (mm-decode-content-transfer-encoding
+ (intern (cdr (assq 'data-encoding tag)))
+ (cdr (assq 'type tag)))
+ (setq contents (buffer-string))))
(when (and (not raw) (memq nil charsets))
(if (or (memq 'unknown-encoding mml-confirmation-set)
(message-options-get 'unknown-encoding)
@@ -313,8 +324,8 @@ Message contains characters with unknown encoding. Really send? ")
(eq 'mml (car tag))
(< (length charsets) 2))
(if (or (not no-markup-p)
+ ;; Don't create blank parts.
(string-match "[^ \t\r\n]" contents))
- ;; Don't create blank parts.
(push (nconc tag (list (cons 'contents contents)))
struct))
(let ((nstruct (mml-parse-singlepart-with-multiple-charsets
@@ -487,11 +498,8 @@ type detected."
(= (length cont) 1)
content-type)
(setcdr (assq 'type (cdr (car cont))) content-type))
- (when (and (consp (car cont))
- (= (length cont) 1)
- (fboundp 'libxml-parse-html-region)
- (equal (cdr (assq 'type (car cont))) "text/html"))
- (setq cont (mml-expand-html-into-multipart-related (car cont))))
+ (when (fboundp 'libxml-parse-html-region)
+ (setq cont (mapcar 'mml-expand-all-html-into-multipart-related cont)))
(prog1
(with-temp-buffer
(set-buffer-multibyte nil)
@@ -510,6 +518,18 @@ type detected."
(buffer-string))
(setq message-options options)))))
+(defun mml-expand-all-html-into-multipart-related (cont)
+ (cond ((and (eq (car cont) 'part)
+ (equal (cdr (assq 'type cont)) "text/html"))
+ (mml-expand-html-into-multipart-related cont))
+ ((eq (car cont) 'multipart)
+ (let ((cur (cdr cont)))
+ (while (consp cur)
+ (setcar cur (mml-expand-all-html-into-multipart-related (car cur)))
+ (setf cur (cdr cur))))
+ cont)
+ (t cont)))
+
(defun mml-expand-html-into-multipart-related (cont)
(let ((new-parts nil)
(cid 1))
@@ -538,8 +558,7 @@ type detected."
new-parts))
(setq cid (1+ cid)))))))
;; We have local images that we want to include.
- (if (not new-parts)
- (list cont)
+ (when new-parts
(setcdr (assq 'contents cont) (buffer-string))
(setq cont
(nconc (list 'multipart (cons 'type "related"))
@@ -552,8 +571,8 @@ type detected."
(nth 1 new-part)
(nth 2 new-part))
(id . ,(concat "<" (nth 0 new-part)
- ">")))))))
- cont))))
+ ">"))))))))
+ cont)))
(autoload 'image-property "image")
@@ -1341,7 +1360,7 @@ If not set, `default-directory' will be used."
(value (pop plist)))
(when value
;; Quote VALUE if it contains suspicious characters.
- (when (string-match "[\"'\\~/*;() \t\n[:multibyte:]]" value)
+ (when (string-match "[][\"'\\~/*;()<>= \t\n[:multibyte:]]" value)
(setq value (with-output-to-string
(let (print-escape-nonascii)
(prin1 value)))))
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index 8be1b84e52f..88864ea3579 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -242,7 +242,6 @@ Whether the passphrase is cached at all is controlled by
(defvar epg-user-id-alist)
(autoload 'epg-make-context "epg")
-(autoload 'epg-passphrase-callback-function "epg")
(autoload 'epa-select-keys "epa")
(autoload 'epg-list-keys "epg")
(autoload 'epg-context-set-armor "epg")
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 1e72f681797..45c9bbfe905 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -293,6 +293,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(substring alg (match-end 0))
alg))))
+(autoload 'gnus-get-buffer-create "gnus")
+
(defun mml2015-mailcrypt-verify (handle ctl)
(catch 'error
(let (part)
@@ -330,7 +332,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(replace-match "-----BEGIN PGP SIGNATURE-----" t t))
(if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t)
(replace-match "-----END PGP SIGNATURE-----" t t)))
- (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
+ (let ((mc-gpg-debug-buffer (gnus-get-buffer-create " *gnus gpg debug*")))
(unless (condition-case err
(prog1
(funcall mml2015-verify-function)
@@ -359,7 +361,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
handle)))
(defun mml2015-mailcrypt-clear-verify ()
- (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
+ (let ((mc-gpg-debug-buffer (gnus-get-buffer-create " *gnus gpg debug*")))
(if (condition-case err
(prog1
(funcall mml2015-verify-function)
@@ -710,7 +712,6 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(autoload 'epg-verify-string "epg")
(autoload 'epg-sign-string "epg")
(autoload 'epg-encrypt-string "epg")
-(autoload 'epg-passphrase-callback-function "epg")
(autoload 'epg-context-set-passphrase-callback "epg")
(autoload 'epg-key-sub-key-list "epg")
(autoload 'epg-sub-key-capability "epg")
@@ -725,6 +726,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(autoload 'epg-expand-group "epg-config")
(autoload 'epa-select-keys "epa")
+(autoload 'gnus-create-image "gnus-util")
+
(defun mml2015-epg-key-image (key-id)
"Return the image of a key, if any."
(with-temp-buffer
@@ -949,7 +952,6 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
;;; General wrapper
(autoload 'gnus-buffer-live-p "gnus-util")
-(autoload 'gnus-get-buffer-create "gnus")
(defun mml2015-clean-buffer ()
(if (gnus-buffer-live-p mml2015-result-buffer)
diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el
index 6890f1dceeb..480d794b9ac 100644
--- a/lisp/gnus/nnbabyl.el
+++ b/lisp/gnus/nnbabyl.el
@@ -293,7 +293,7 @@
(deffoo nnbabyl-request-move-article
(article group server accept-form &optional last move-is-internal)
- (let ((buf (get-buffer-create " *nnbabyl move*"))
+ (let ((buf (gnus-get-buffer-create " *nnbabyl move*"))
result)
(and
(nnbabyl-request-article article group server)
@@ -544,7 +544,7 @@
(setq buffer-file-name nnbabyl-mbox-file)
(insert "BABYL OPTIONS:\n\n\^_")
(nnmail-write-region
- (point-min) (point-max) nnbabyl-mbox-file t 'nomesg))))
+ (point-min) (point-max) nnbabyl-mbox-file t 'nomesg nil 'excl))))
(defun nnbabyl-read-mbox ()
(nnmail-activate 'nnbabyl)
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index a7657c68556..ccd17744993 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -597,7 +597,7 @@ all. This may very well take some time.")
(deffoo nndiary-request-move-article
(article group server accept-form &optional last move-is-internal)
- (let ((buf (get-buffer-create " *nndiary move*"))
+ (let ((buf (gnus-get-buffer-create " *nndiary move*"))
result)
(nndiary-possibly-change-directory group server)
(nndiary-update-file-alist)
@@ -831,7 +831,7 @@ all. This may very well take some time.")
;; Find an article number in the current group given the Message-ID.
(defun nndiary-find-group-number (id)
- (with-current-buffer (get-buffer-create " *nndiary id*")
+ (with-current-buffer (gnus-get-buffer-create " *nndiary id*")
(let ((alist nndiary-group-alist)
number)
;; We want to look through all .overview files, but we want to
@@ -992,15 +992,15 @@ all. This may very well take some time.")
(narrow-to-region
(goto-char (point-min))
(if (search-forward "\n\n" nil t) (1- (point)) (point-max))))
- (let ((headers (nnheader-parse-naked-head)))
+ (let ((headers (nnheader-parse-head t)))
(setf (mail-header-chars headers) chars)
(setf (mail-header-number headers) number)
headers))))
(defun nndiary-open-nov (group)
(or (cdr (assoc group nndiary-nov-buffer-alist))
- (let ((buffer (get-buffer-create (format " *nndiary overview %s*"
- group))))
+ (let ((buffer (gnus-get-buffer-create
+ (format " *nndiary overview %s*" group))))
(with-current-buffer buffer
(set (make-local-variable 'nndiary-nov-buffer-file-name)
(expand-file-name
@@ -1086,7 +1086,7 @@ all. This may very well take some time.")
(defun nndiary-generate-nov-file (dir files)
(let* ((dir (file-name-as-directory dir))
(nov (concat dir nndiary-nov-file-name))
- (nov-buffer (get-buffer-create " *nov*"))
+ (nov-buffer (gnus-get-buffer-create " *nov*"))
chars file headers)
;; Init the nov buffer.
(with-current-buffer nov-buffer
@@ -1115,7 +1115,7 @@ all. This may very well take some time.")
(widen))
(setq files (cdr files)))
(with-current-buffer nov-buffer
- (nnmail-write-region 1 (point-max) nov nil 'nomesg)
+ (nnmail-write-region 1 (point-max) nov nil 'nomesg nil 'excl)
(kill-buffer (current-buffer))))))
(defun nndiary-nov-delete-article (group article)
@@ -1425,7 +1425,7 @@ all. This may very well take some time.")
(pop years)))
(if years
;; Because we might not be limited in years, we must guard against
- ;; infinite loops. Appart from cases like Feb 31, there are probably
+ ;; infinite loops. Apart from cases like Feb 31, there are probably
;; other ones, (no monday XXX 2nd etc). I don't know any algorithm to
;; decide this, so I assume that if we reach 10 years later, the
;; schedule is undecidable.
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index 0ba63915c94..81431270d7c 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -347,12 +347,13 @@ from the document.")
(file-exists-p nndoc-address)
(not (file-directory-p nndoc-address))))
(push (cons group (setq nndoc-current-buffer
- (get-buffer-create
+ (gnus-get-buffer-create
(concat " *nndoc " group "*"))))
nndoc-group-alist)
(setq nndoc-dissection-alist nil)
(with-current-buffer nndoc-current-buffer
(erase-buffer)
+ (set-buffer-multibyte nil)
(condition-case error
(if (and (stringp nndoc-address)
(string-match nndoc-binary-file-names nndoc-address))
diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el
index a1337e8d7fa..a3c26ea4ac0 100644
--- a/lisp/gnus/nndraft.el
+++ b/lisp/gnus/nndraft.el
@@ -231,7 +231,7 @@ are generated if and only if they are also in `message-draft-headers'."
(deffoo nndraft-request-move-article (article group server accept-form
&optional last move-is-internal)
(nndraft-possibly-change-group group)
- (let ((buf (get-buffer-create " *nndraft move*"))
+ (let ((buf (gnus-get-buffer-create " *nndraft move*"))
result)
(and
(nndraft-request-article article group server)
@@ -325,7 +325,7 @@ are generated if and only if they are also in `message-draft-headers'."
(save-excursion
(prog1
(progn
- (set-buffer (get-buffer-create " *draft tmp*"))
+ (set-buffer (gnus-get-buffer-create " *draft tmp*"))
(setq buffer-file-name file)
(make-auto-save-file-name))
(kill-buffer (current-buffer)))))
diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el
index 9e190515f18..9f1fdbae5ae 100644
--- a/lisp/gnus/nneething.el
+++ b/lisp/gnus/nneething.el
@@ -381,7 +381,7 @@ included.")
(defun nneething-get-head (file)
"Either find the head in FILE or make a head for FILE."
- (with-current-buffer (get-buffer-create nneething-work-buffer)
+ (with-current-buffer (gnus-get-buffer-create nneething-work-buffer)
(setq case-fold-search nil)
(buffer-disable-undo)
(erase-buffer)
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index 342ac48ba85..6ff99056d84 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -465,7 +465,7 @@ all. This may very well take some time.")
(deffoo nnfolder-request-move-article (article group server accept-form
&optional last move-is-internal)
(save-excursion
- (let ((buf (get-buffer-create " *nnfolder move*"))
+ (let ((buf (gnus-get-buffer-create " *nnfolder move*"))
result)
(and
(nnfolder-request-article article group server)
@@ -735,7 +735,7 @@ deleted. Point is left where the deleted region was."
(or nnfolder-file-coding-system-for-write
nnfolder-file-coding-system-for-write)))
(nnmail-write-region (point-min) (point-min)
- file t 'nomesg)))
+ file t 'nomesg nil 'excl)))
(when (setq nnfolder-current-buffer (nnfolder-read-folder group))
(set-buffer nnfolder-current-buffer)
(push (list group nnfolder-current-buffer)
@@ -1096,7 +1096,7 @@ This command does not work if you use short group names."
(defun nnfolder-open-nov (group)
(or (cdr (assoc group nnfolder-nov-buffer-alist))
- (let ((buffer (get-buffer-create (format " *nnfolder overview %s*" group))))
+ (let ((buffer (gnus-get-buffer-create (format " *nnfolder overview %s*" group))))
(with-current-buffer buffer
(set (make-local-variable 'nnfolder-nov-buffer-file-name)
(nnfolder-group-nov-pathname group))
@@ -1160,7 +1160,7 @@ This command does not work if you use short group names."
(if (search-forward "\n\n" e t) (setq e (1- (point)))))
(with-temp-buffer
(insert-buffer-substring buf b e)
- (let ((headers (nnheader-parse-naked-head)))
+ (let ((headers (nnheader-parse-head t)))
(setf (mail-header-chars headers) chars)
(setf (mail-header-number headers) number)
headers)))))
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 03b08854b11..67dc379ef81 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -28,6 +28,10 @@
(eval-when-compile (require 'cl-lib))
+(defvar gnus-decode-encoded-word-function)
+(defvar gnus-decode-encoded-address-function)
+(defvar gnus-alter-header-function)
+
(defvar nnmail-extra-headers)
(defvar gnus-newsgroup-name)
(defvar jka-compr-compression-info-list)
@@ -39,6 +43,7 @@
(require 'mail-utils)
(require 'mm-util)
(require 'gnus-util)
+(autoload 'gnus-remove-odd-characters "gnus-sum")
(autoload 'gnus-range-add "gnus-range")
(autoload 'gnus-remove-from-range "gnus-range")
;; FIXME none of these are used explicitly in this file.
@@ -188,124 +193,166 @@ on your system, you could say something like:
(autoload 'ietf-drums-unfold-fws "ietf-drums")
-(defun nnheader-parse-naked-head (&optional number)
- ;; This function unfolds continuation lines in this buffer
- ;; destructively. When this side effect is unwanted, use
- ;; `nnheader-parse-head' instead of this function.
- (let ((case-fold-search t)
- (buffer-read-only nil)
+
+(defsubst nnheader-head-make-header (number)
+ "Return a full mail header with article NUMBER.
+Do this using data of type `head' in the current buffer."
+ (let ((p (point-min))
(cur (current-buffer))
- (p (point-min))
- in-reply-to lines ref)
- (nnheader-remove-cr-followed-by-lf)
- (ietf-drums-unfold-fws)
- (subst-char-in-region (point-min) (point-max) ?\t ? )
- (goto-char p)
- (insert "\n")
- (prog1
- ;; This implementation of this function, with nine
- ;; search-forwards instead of the one re-search-forward and a
- ;; case (which basically was the old function) is actually
- ;; about twice as fast, even though it looks messier. You
- ;; can't have everything, I guess. Speed and elegance don't
- ;; always go hand in hand.
- (vector
- ;; Number.
- (or number 0)
- ;; Subject.
- (progn
- (goto-char p)
- (if (search-forward "\nsubject:" nil t)
- (nnheader-header-value) "(none)"))
- ;; From.
- (progn
- (goto-char p)
- (if (search-forward "\nfrom:" nil t)
- (nnheader-header-value) "(nobody)"))
- ;; Date.
- (progn
- (goto-char p)
- (if (search-forward "\ndate:" nil t)
- (nnheader-header-value) ""))
- ;; Message-ID.
- (progn
- (goto-char p)
- (if (search-forward "\nmessage-id:" nil t)
- (buffer-substring
- (1- (or (search-forward "<" (point-at-eol) t)
- (point)))
- (or (search-forward ">" (point-at-eol) t) (point)))
- ;; If there was no message-id, we just fake one to make
- ;; subsequent routines simpler.
- (nnheader-generate-fake-message-id number)))
- ;; References.
- (progn
+ in-reply-to chars lines end ref)
+ ;; This implementation of this function, with nine
+ ;; search-forwards instead of the one re-search-forward and a
+ ;; case (which basically was the old function) is actually
+ ;; about twice as fast, even though it looks messier. You
+ ;; can't have everything, I guess. Speed and elegance don't
+ ;; always go hand in hand.
+ (make-full-mail-header
+ ;; Number.
+ number
+ ;; Subject.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nsubject:" nil t)
+ (funcall gnus-decode-encoded-word-function
+ (nnheader-header-value))
+ "(none)"))
+ ;; From.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nfrom:" nil t)
+ (funcall gnus-decode-encoded-address-function
+ (nnheader-header-value))
+ "(nobody)"))
+ ;; Date.
+ (progn
+ (goto-char p)
+ (if (search-forward "\ndate:" nil t)
+ (nnheader-header-value) ""))
+ ;; Message-ID.
+ (progn
+ (goto-char p)
+ (if (re-search-forward
+ "^message-id: *\\(<[^\n\t> ]+>\\)" nil t)
+ ;; We do it this way to make sure the Message-ID
+ ;; is (somewhat) syntactically valid.
+ (buffer-substring (match-beginning 1)
+ (match-end 1))
+ ;; If there was no message-id, we just fake one to make
+ ;; subsequent routines simpler.
+ (nnheader-generate-fake-message-id number)))
+ ;; References.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nreferences:" nil t)
+ (progn
+ (setq end (point))
+ (prog1
+ (nnheader-header-value)
+ (setq ref
+ (buffer-substring
+ (progn
+ (end-of-line)
+ (search-backward ">" end t)
+ (1+ (point)))
+ (progn
+ (search-backward "<" end t)
+ (point))))))
+ ;; Get the references from the in-reply-to header if there
+ ;; were no references and the in-reply-to header looks
+ ;; promising.
+ (if (and (search-forward "\nin-reply-to:" nil t)
+ (setq in-reply-to (nnheader-header-value))
+ (string-match "<[^>]+>" in-reply-to))
+ (let (ref2)
+ (setq ref (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (while (string-match "<[^>]+>" in-reply-to (match-end 0))
+ (setq ref2 (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (when (> (length ref2) (length ref))
+ (setq ref ref2)))
+ ref)
+ nil)))
+ ;; Chars.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nchars: " nil t)
+ (if (numberp (setq chars (ignore-errors (read cur))))
+ chars -1)
+ -1))
+ ;; Lines.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nlines: " nil t)
+ (if (numberp (setq lines (ignore-errors (read cur))))
+ lines -1)
+ -1))
+ ;; Xref.
+ (progn
+ (goto-char p)
+ (and (search-forward "\nxref:" nil t)
+ (nnheader-header-value)))
+ ;; Extra.
+ (when nnmail-extra-headers
+ (let ((extra nnmail-extra-headers)
+ out)
+ (while extra
(goto-char p)
- (if (search-forward "\nreferences:" nil t)
- (nnheader-header-value)
- ;; Get the references from the in-reply-to header if
- ;; there were no references and the in-reply-to header
- ;; looks promising.
- (if (and (search-forward "\nin-reply-to:" nil t)
- (setq in-reply-to (nnheader-header-value))
- (string-match "<[^\n>]+>" in-reply-to))
- (let (ref2)
- (setq ref (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (while (string-match "<[^\n>]+>"
- in-reply-to (match-end 0))
- (setq ref2 (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (when (> (length ref2) (length ref))
- (setq ref ref2)))
- ref)
- nil)))
- ;; Chars.
- 0
- ;; Lines.
- (progn
- (goto-char p)
- (if (search-forward "\nlines: " nil t)
- (if (numberp (setq lines (read cur)))
- lines 0)
- 0))
- ;; Xref.
- (progn
- (goto-char p)
- (and (search-forward "\nxref:" nil t)
- (nnheader-header-value)))
- ;; Extra.
- (when nnmail-extra-headers
- (let ((extra nnmail-extra-headers)
- out)
- (while extra
- (goto-char p)
- (when (search-forward
- (concat "\n" (symbol-name (car extra)) ":") nil t)
- (push (cons (car extra) (nnheader-header-value))
- out))
- (pop extra))
- out)))
- (goto-char p)
- (delete-char 1))))
-
-(defun nnheader-parse-head (&optional naked)
- (let ((cur (current-buffer)) num beg end)
- (when (if naked
- (setq num 0
- beg (point-min)
- end (point-max))
- ;; Search to the beginning of the next header. Error
- ;; messages do not begin with 2 or 3.
- (when (re-search-forward "^[23][0-9]+ " nil t)
- (setq num (read cur)
- beg (point)
- end (if (search-forward "\n.\n" nil t)
- (goto-char (- (point) 2))
- (point)))))
- (with-temp-buffer
- (insert-buffer-substring cur beg end)
- (nnheader-parse-naked-head num)))))
+ (when (search-forward
+ (concat "\n" (symbol-name (car extra)) ":") nil t)
+ (push (cons (car extra) (nnheader-header-value))
+ out))
+ (pop extra))
+ out)))))
+
+(defun nnheader-parse-head (&optional naked temp)
+ "Parse data of type `header' in the current buffer and return a mail header.
+Modify the buffer contents in the process. The buffer is assumed
+to begin each header with an \"Article retrieved\" line with an
+article number; if NAKED is non-nil this line is assumed absent,
+and the buffer should contain a single header's worth of data.
+If TEMP is non-nil the data is first copied to a temporary buffer
+leaving the original buffer untouched."
+ (let ((cur (current-buffer))
+ (num 0)
+ (beg (point-min))
+ (end (point-max))
+ buf)
+ (when (or naked
+ ;; Search to the beginning of the next header. Error
+ ;; messages do not begin with 2 or 3.
+ (when (re-search-forward "^[23][0-9]+ " nil t)
+ (setq num (read cur)
+ beg (point)
+ end (if (search-forward "\n.\n" nil t)
+ (goto-char (- (point) 2))
+ (point)))))
+ ;; When TEMP copy the data to a temporary buffer.
+ (if temp
+ (progn
+ (set-buffer (setq buf (generate-new-buffer " *nnheader-temp*")))
+ (insert-buffer-substring cur beg end))
+ ;; Otherwise just narrow to the data.
+ (narrow-to-region beg end))
+ (let ((case-fold-search t)
+ (buffer-read-only nil)
+ header)
+ (nnheader-remove-cr-followed-by-lf)
+ (ietf-drums-unfold-fws)
+ (subst-char-in-region (point-min) (point-max) ?\t ?\s t)
+ (subst-char-in-region (point-min) (point-max) ?\r ?\s t)
+ (goto-char (point-min))
+ (insert "\n")
+ (setq header (nnheader-head-make-header num))
+ (goto-char (point-min))
+ (delete-char 1)
+ (if temp
+ (kill-buffer buf)
+ (goto-char (point-max))
+ (widen))
+ (when gnus-alter-header-function
+ (funcall gnus-alter-header-function header))
+ header))))
(defmacro nnheader-nov-skip-field ()
'(search-forward "\t" eol 'move))
@@ -347,24 +394,43 @@ on your system, you could say something like:
'id)
(nnheader-generate-fake-message-id ,number))))
-(defun nnheader-parse-nov ()
+(defalias 'nnheader-nov-make-header 'nnheader-parse-nov)
+(autoload 'gnus-extract-message-id-from-in-reply-to "gnus-sum")
+
+(defun nnheader-parse-nov (&optional number)
(let ((eol (point-at-eol))
- (number (nnheader-nov-read-integer)))
- (vector
- number ; number
- (nnheader-nov-field) ; subject
- (nnheader-nov-field) ; from
- (nnheader-nov-field) ; date
- (nnheader-nov-read-message-id number) ; id
- (nnheader-nov-field) ; refs
- (nnheader-nov-read-integer) ; chars
- (nnheader-nov-read-integer) ; lines
- (if (eq (char-after) ?\n)
- nil
- (if (looking-at "Xref: ")
- (goto-char (match-end 0)))
- (nnheader-nov-field)) ; Xref
- (nnheader-nov-parse-extra)))) ; extra
+ references in-reply-to x header)
+ (setq header
+ (make-full-mail-header
+ (or number (nnheader-nov-read-integer)) ; number
+ (condition-case () ; subject
+ (gnus-remove-odd-characters
+ (funcall gnus-decode-encoded-word-function
+ (setq x (nnheader-nov-field))))
+ (error x))
+ (condition-case () ; from
+ (gnus-remove-odd-characters
+ (funcall gnus-decode-encoded-address-function
+ (setq x (nnheader-nov-field))))
+ (error x))
+ (nnheader-nov-field) ; date
+ (nnheader-nov-read-message-id number) ; id
+ (setq references (nnheader-nov-field)) ; refs
+ (nnheader-nov-read-integer) ; chars
+ (nnheader-nov-read-integer) ; lines
+ (unless (eobp)
+ (if (looking-at "Xref: ")
+ (goto-char (match-end 0)))
+ (nnheader-nov-field)) ; Xref
+ (nnheader-nov-parse-extra))) ; extra
+
+ (when (and (string= references "")
+ (setq in-reply-to (mail-header-extra header))
+ (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to))))
+ (setf (mail-header-references header)
+ (gnus-extract-message-id-from-in-reply-to in-reply-to)))
+ header))
+
(defun nnheader-insert-nov (header)
(princ (mail-header-number header) (current-buffer))
@@ -399,17 +465,6 @@ on your system, you could say something like:
(delete-char 1))
(forward-line 1)))
-(defun nnheader-parse-overview-file (file)
- "Parse FILE and return a list of headers."
- (mm-with-unibyte-buffer
- (nnheader-insert-file-contents file)
- (goto-char (point-min))
- (let (headers)
- (while (not (eobp))
- (push (nnheader-parse-nov) headers)
- (forward-line 1))
- (nreverse headers))))
-
(defun nnheader-write-overview-file (file headers)
"Write HEADERS to FILE."
(with-temp-file file
@@ -487,8 +542,8 @@ the line could be found."
(< num article)))
(forward-line 1)
(setq found (point))
- (or (eobp)
- (= (setq num (read cur)) article)))
+ (unless (eobp)
+ (setq num (read cur))))
(unless (eq num article)
(goto-char found)))
(beginning-of-line)
@@ -502,10 +557,12 @@ the line could be found."
"Coding system used in file backends of Gnus.")
(defvar nnheader-callback-function nil)
+(autoload 'gnus-get-buffer-create "gnus")
+
(defun nnheader-init-server-buffer ()
"Initialize the Gnus-backend communication buffer."
(unless (gnus-buffer-live-p nntp-server-buffer)
- (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
+ (setq nntp-server-buffer (gnus-get-buffer-create " *nntpd*")))
(with-current-buffer nntp-server-buffer
(erase-buffer)
(mm-enable-multibyte)
@@ -630,7 +687,7 @@ the line could be found."
(defun nnheader-set-temp-buffer (name &optional noerase)
"Set-buffer to an empty (possibly new) buffer called NAME with undo disabled."
- (set-buffer (get-buffer-create name))
+ (set-buffer (gnus-get-buffer-create name))
(buffer-disable-undo)
(unless noerase
(erase-buffer))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index c383e0146f3..d797e893f51 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -986,7 +986,10 @@ textual parts.")
(when (and (car result) (not can-move))
(nnimap-delete-article article))
(cons internal-move-group
- (or (nnimap-find-uid-response "COPYUID" (caddr result))
+ (or (nnimap-find-uid-response
+ "COPYUID"
+ ;; Server gives different responses for MOVE and COPY.
+ (if can-move (caddr result) (cadr result)))
(nnimap-find-article-by-message-id
internal-move-group server message-id
nnimap-request-articles-find-limit)))))
@@ -1670,8 +1673,7 @@ If LIMIT, first try to limit the search to the N last articles."
(when (and active
recent
(> (car (last recent)) (cdr active)))
- (push (list (cons (gnus-group-real-name group) 0))
- nnmail-split-history)))
+ (push (list (cons group 0)) nnmail-split-history)))
;; Note the active level for the next run-through.
(gnus-group-set-parameter info 'active (gnus-active group))
(gnus-group-set-parameter info 'uidvalidity uidvalidity)
@@ -1684,7 +1686,7 @@ If LIMIT, first try to limit the search to the N last articles."
(gnus-add-to-range
(gnus-add-to-range
(gnus-range-add (gnus-info-read info)
- vanished)
+ vanished)
(cdr (assq '%Flagged flags)))
(cdr (assq '%Seen flags))))
(let ((marks (gnus-info-marks info)))
@@ -1849,15 +1851,15 @@ If LIMIT, first try to limit the search to the N last articles."
(setq nnimap-status-string "Read-only server")
nil)
-(defvar gnus-refer-thread-use-nnir) ;; gnus-sum.el
+(defvar gnus-refer-thread-use-search) ;; gnus-sum.el
(declare-function gnus-fetch-headers "gnus-sum"
(articles &optional limit force-new dependencies))
-(autoload 'nnir-search-thread "nnir")
+(autoload 'nnselect-search-thread "nnselect")
(deffoo nnimap-request-thread (header &optional group server)
- (if gnus-refer-thread-use-nnir
- (nnir-search-thread header)
+ (if gnus-refer-thread-use-search
+ (nnselect-search-thread header)
(when (nnimap-change-group group server)
(let* ((cmd (nnimap-make-thread-query header))
(result (with-current-buffer (nnimap-buffer)
@@ -1937,7 +1939,7 @@ Return the server's response to the SELECT or EXAMINE command."
(defun nnimap-log-buffer ()
(let ((name "*imap log*"))
(or (get-buffer name)
- (with-current-buffer (get-buffer-create name)
+ (with-current-buffer (gnus-get-buffer-create name)
(setq-local window-point-insertion-type t)
(current-buffer)))))
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index f1e31a0cd10..20f82e5cbdf 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -10,6 +10,7 @@
;; IMAP search improved by Daniel Pittman <daniel@rimspace.net>.
;; nnmaildir support for Swish++ and Namazu backends by:
;; Justus Piater <Justus <at> Piater.name>
+;; Mostly rewritten by Andrew Cohen <cohen@bu.edu> from 2010
;; Keywords: news mail searching ir
;; This file is part of GNU Emacs.
@@ -29,20 +30,11 @@
;;; Commentary:
-;; What does it do? Well, it allows you to search your mail using
-;; some search engine (imap, namazu, swish-e and others -- see
-;; later) by typing `G G' in the Group buffer. You will then get a
-;; buffer which shows all articles matching the query, sorted by
-;; Retrieval Status Value (score).
-
-;; When looking at the retrieval result (in the Summary buffer) you
-;; can type `A W' (aka M-x gnus-warp-to-article RET) on an article. You
-;; will be warped into the group this article came from. Typing `A T'
-;; (aka M-x gnus-summary-refer-thread RET) will warp to the group and
-;; also show the thread this article is part of.
+;; What does it do? Well, it searches your mail using some search
+;; engine (imap, namazu, swish-e, gmane and others -- see later).
;; The Lisp setup may involve setting a few variables and setting up the
-;; search engine. You can define the variables in the server definition
+;; search engine. You can define the variables in the server definition
;; like this :
;; (setq gnus-secondary-select-methods '(
;; (nnimap "" (nnimap-address "localhost")
@@ -53,6 +45,45 @@
;; an alist, type `C-h v nnir-engines RET' for more information; this
;; includes examples for setting `nnir-search-engine', too.)
+;; The entry to searching is the single function `nnir-run-query',
+;; which dispatches the search to the proper search function. The
+;; argument of `nnir-run-query' is an alist with two keys:
+;; 'nnir-query-spec and 'nnir-group-spec. The value for
+;; 'nnir-query-spec is an alist. The only required key/value pair is
+;; (query . "query") specifying the search string to pass to the query
+;; engine. Individual engines may have other elements. The value of
+;; 'nnir-group-spec is a list with the specification of the
+;; groups/servers to search. The format of the 'nnir-group-spec is
+;; (("server1" ("group11" "group12")) ("server2" ("group21"
+;; "group22"))). If any of the group lists is absent then all groups
+;; on that server are searched.
+
+;; The output of `nnir-run-query' is a vector, each element of which
+;; should in turn be a three-element vector with the form: [fully
+;; prefixed group-name of the article; the article number; the
+;; Retrieval Status Value (RSV)] as returned from the search engine.
+;; An RSV is the score assigned to the document by the search engine.
+;; For Boolean search engines, the RSV is always 1000 (or 1 or 100, or
+;; whatever you like).
+
+;; A vector of this form is used by the nnselect backend to create
+;; virtual groups. So nnir-run-query is a suitable function to use in
+;; nnselect groups.
+
+;; The default sorting order of articles in an nnselect summary buffer
+;; is based on the order of the articles in the above mentioned
+;; vector, so that's where you can do the sorting you'd like. Maybe
+;; it would be nice to have a way of displaying the search result
+;; sorted differently?
+
+;; So what do you need to do when you want to add another search
+;; engine? You write a function that executes the query. Temporary
+;; data from the search engine can be put in `nnir-tmp-buffer'. This
+;; function should return the list of articles as a vector, as
+;; described above. Then, you need to register this backend in
+;; `nnir-engines'. Then, users can choose the backend by setting
+;; `nnir-search-engine' as a server variable.
+
;; If you use one of the local indices (namazu, find-grep, swish) you
;; must also set up a search engine backend.
@@ -75,13 +106,13 @@
;; ,----
;; | package conf; # Don't remove this line!
;; |
-;; | # Paths which will not be indexed. Don't use `^' or `$' anchors.
+;; | # Paths which will not be indexed. Don't use `^' or `$' anchors.
;; | $EXCLUDE_PATH = "spam|sent";
;; |
-;; | # Header fields which should be searchable. case-insensitive
+;; | # Header fields which should be searchable. case-insensitive
;; | $REMAIN_HEADER = "from|date|message-id|subject";
;; |
-;; | # Searchable fields. case-insensitive
+;; | # Searchable fields. case-insensitive
;; | $SEARCH_FIELD = "from|date|message-id|subject";
;; |
;; | # The max length of a word.
@@ -121,72 +152,17 @@
;; | (nnml-active-file "~/News/cache/active"))
;; `----
-;; Developer information:
-
-;; I have tried to make the code expandable. Basically, it is divided
-;; into two layers. The upper layer is somewhat like the `nnvirtual'
-;; backend: given a specification of what articles to show from
-;; another backend, it creates a group containing exactly those
-;; articles. The lower layer issues a query to a search engine and
-;; produces such a specification of what articles to show from the
-;; other backend.
-
-;; The interface between the two layers consists of the single
-;; function `nnir-run-query', which dispatches the search to the
-;; proper search function. The argument of `nnir-run-query' is an
-;; alist with two keys: 'nnir-query-spec and 'nnir-group-spec. The
-;; value for 'nnir-query-spec is an alist. The only required key/value
-;; pair is (query . "query") specifying the search string to pass to
-;; the query engine. Individual engines may have other elements. The
-;; value of 'nnir-group-spec is a list with the specification of the
-;; groups/servers to search. The format of the 'nnir-group-spec is
-;; (("server1" ("group11" "group12")) ("server2" ("group21"
-;; "group22"))). If any of the group lists is absent then all groups
-;; on that server are searched.
-
-;; The output of `nnir-run-query' is supposed to be a vector, each
-;; element of which should in turn be a three-element vector. The
-;; first element should be full group name of the article, the second
-;; element should be the article number, and the third element should
-;; be the Retrieval Status Value (RSV) as returned from the search
-;; engine. An RSV is the score assigned to the document by the search
-;; engine. For Boolean search engines, the RSV is always 1000 (or 1
-;; or 100, or whatever you like).
-
-;; The sorting order of the articles in the summary buffer created by
-;; nnir is based on the order of the articles in the above mentioned
-;; vector, so that's where you can do the sorting you'd like. Maybe
-;; it would be nice to have a way of displaying the search result
-;; sorted differently?
-
-;; So what do you need to do when you want to add another search
-;; engine? You write a function that executes the query. Temporary
-;; data from the search engine can be put in `nnir-tmp-buffer'. This
-;; function should return the list of articles as a vector, as
-;; described above. Then, you need to register this backend in
-;; `nnir-engines'. Then, users can choose the backend by setting
-;; `nnir-search-engine' as a server variable.
;;; Code:
;;; Setup:
-(require 'nnoo)
-(require 'gnus-group)
-(require 'message)
-(require 'gnus-util)
(eval-when-compile (require 'cl-lib))
+(require 'gnus)
;;; Internal Variables:
-(defvar nnir-memo-query nil
- "Internal: stores current query.")
-
-(defvar nnir-memo-server nil
- "Internal: stores current server.")
-
-(defvar nnir-artlist nil
- "Internal: stores search result.")
+(defvar gnus-inhibit-demon)
(defvar nnir-search-history ()
"Internal: the history for querying search options in nnir.")
@@ -203,30 +179,19 @@
("to" . "TO")
("from" . "FROM")
("body" . "BODY")
- ("imap" . ""))
+ ("imap" . "")
+ ("gmail" . "X-GM-RAW"))
"Mapping from user readable keys to IMAP search items for use in nnir.")
(defvar nnir-imap-search-other "HEADER %S"
- "The IMAP search item to use for anything other than
-`nnir-imap-search-arguments'. By default this is the name of an
-email header field.")
+ "The IMAP search item for anything other than `nnir-imap-search-arguments'.
+By default this is the name of an email header field.")
(defvar nnir-imap-search-argument-history ()
"The history for querying search options in nnir.")
;;; Helper macros
-;; Data type article list.
-
-(defmacro nnir-artlist-length (artlist)
- "Return number of articles in artlist."
- `(length ,artlist))
-
-(defmacro nnir-artlist-article (artlist n)
- "Return from ARTLIST the Nth artitem (counting starting at 1)."
- `(when (> ,n 0)
- (elt ,artlist (1- ,n))))
-
(defmacro nnir-artitem-group (artitem)
"Return the group from the ARTITEM."
`(elt ,artitem 0))
@@ -239,52 +204,6 @@ email header field.")
"Return the Retrieval Status Value (RSV, score) from the ARTITEM."
`(elt ,artitem 2))
-(defmacro nnir-article-group (article)
- "Return the group for ARTICLE."
- `(nnir-artitem-group (nnir-artlist-article nnir-artlist ,article)))
-
-(defmacro nnir-article-number (article)
- "Return the number for ARTICLE."
- `(nnir-artitem-number (nnir-artlist-article nnir-artlist ,article)))
-
-(defmacro nnir-article-rsv (article)
- "Return the rsv for ARTICLE."
- `(nnir-artitem-rsv (nnir-artlist-article nnir-artlist ,article)))
-
-(defsubst nnir-article-ids (article)
- "Return the pair `(nnir id . real id)' of ARTICLE."
- (cons article (nnir-article-number article)))
-
-(defmacro nnir-categorize (sequence keyfunc &optional valuefunc)
- "Sort a SEQUENCE into categories and returns a list of the form
-`((key1 (element11 element12)) (key2 (element21 element22))'.
-The category key for a member of the sequence is obtained
-as `(KEYFUNC member)' and the corresponding element is just
-`member'. If VALUEFUNC is non-nil, the element of the list
-is `(VALUEFUNC member)'."
- `(unless (null ,sequence)
- (let (value)
- (mapc
- (lambda (member)
- (let ((y (,keyfunc member))
- (x ,(if valuefunc
- `(,valuefunc member)
- 'member)))
- (if (assoc y value)
- (push x (cadr (assoc y value)))
- (push (list y (list x)) value))))
- ,sequence)
- value)))
-
-;;; Finish setup:
-
-(require 'gnus-sum)
-
-(nnoo-declare nnir)
-(nnoo-define-basics nnir)
-
-(gnus-declare-backend "nnir" 'mail 'virtual)
-
;;; User Customizable Variables:
@@ -292,12 +211,9 @@ is `(VALUEFUNC member)'."
"Search groups in Gnus with assorted search engines."
:group 'gnus)
-(defcustom nnir-ignored-newsgroups ""
- "A regexp to match newsgroups in the active file that should
-be skipped when searching."
- :version "24.1"
- :type '(regexp)
- :group 'nnir)
+(make-obsolete-variable 'nnir-summary-line-format "The formatting
+specs previously unique to this variable may now be set in
+'gnus-summary-line-format." "28.1")
(defcustom nnir-summary-line-format nil
"The format specification of the lines in an nnir summary buffer.
@@ -314,22 +230,19 @@ If nil this will use `gnus-summary-line-format'."
:type '(choice (const :tag "gnus-summary-line-format" nil) string)
:group 'nnir)
-(defcustom nnir-retrieve-headers-override-function nil
- "If non-nil, a function that accepts an article list and group
-and populates the `nntp-server-buffer' with the retrieved
-headers. Must return either `nov' or `headers' indicating the
-retrieved header format.
-If this variable is nil, or if the provided function returns nil for
-a search result, `gnus-retrieve-headers' will be called instead."
+(defcustom nnir-ignored-newsgroups ""
+ "Newsgroups to skip when searching.
+Any newsgroup in the active file matching this regexp will be
+skipped when searching."
:version "24.1"
- :type '(choice (const :tag "gnus-retrieve-headers" nil) function)
+ :type '(regexp)
:group 'nnir)
(defcustom nnir-imap-default-search-key "whole message"
- "The default IMAP search key for an nnir search. Must be one of
-the keys in `nnir-imap-search-arguments'. To use raw imap queries
-by default set this to \"imap\"."
+ "The default IMAP search key for an nnir search.
+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))
@@ -357,9 +270,9 @@ Instead, use this:
:group 'nnir)
(defcustom nnir-swish++-remove-prefix (concat (getenv "HOME") "/Mail/")
- "The prefix to remove from each file name returned by swish++
-in order to get a group name (albeit with / instead of .). This is a
-regular expression.
+ "The prefix to remove from swish++ file names to get group names.
+Resulting names have '/' in place of '.'. This is a regular
+expression.
This variable is very similar to `nnir-namazu-remove-prefix', except
that it is for swish++, not Namazu."
@@ -408,9 +321,9 @@ This could be a server parameter."
:group 'nnir)
(defcustom nnir-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/")
- "The prefix to remove from each file name returned by swish-e
-in order to get a group name (albeit with / instead of .). This is a
-regular expression.
+ "The prefix to remove from swish-e file names to get group names.
+Resulting names have '/' in place of '.'. This is a regular
+expression.
This variable is very similar to `nnir-namazu-remove-prefix', except
that it is for swish-e, not Namazu.
@@ -441,8 +354,8 @@ Instead, use this:
:group 'nnir)
(defcustom nnir-hyrex-remove-prefix (concat (getenv "HOME") "/Mail/")
- "The prefix to remove from each file name returned by HyREX
-in order to get a group name (albeit with / instead of .).
+ "The prefix to remove from HyREX file names to get group names.
+Resulting names have '/' in place of '.'.
For example, suppose that HyREX returns file names such as
\"/home/john/Mail/mail/misc/42\". For this example, use the following
@@ -478,8 +391,8 @@ Instead, use this:
:group 'nnir)
(defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
- "The prefix to remove from each file name returned by Namazu
-in order to get a group name (albeit with / instead of .).
+ "The prefix to remove from Namazu file names to get group names.
+Resulting names have '/' in place of '.'.
For example, suppose that Namazu returns file names such as
\"/home/john/Mail/mail/misc/42\". For this example, use the following
@@ -509,9 +422,9 @@ Instead, use this:
(defcustom nnir-notmuch-remove-prefix
(regexp-quote (or (getenv "MAILDIR") (expand-file-name "~/Mail")))
- "The prefix to remove from each file name returned by notmuch
-in order to get a group name (albeit with / instead of .). This is a
-regular expression.
+ "The prefix to remove from notmuch file names to get group names.
+Resulting names have '/' in place of '.'. This is a regular
+expression.
This variable is very similar to `nnir-namazu-remove-prefix', except
that it is for notmuch, not Namazu."
@@ -590,346 +503,12 @@ Add an entry here when adding a new search engine.")
,@(mapcar (lambda (elem) (list 'const (car elem)))
nnir-engines)))))
-;; Gnus glue.
-
-(declare-function gnus-group-topic-name "gnus-topic" ())
-(declare-function gnus-topic-find-groups "gnus-topic"
- (topic &optional level all lowest recursive))
-
-(defun gnus-group-make-nnir-group (nnir-extra-parms &optional specs)
- "Create an nnir group.
-Prompt for a search query and determine the groups to search as
-follows: if called from the *Server* buffer search all groups
-belonging to the server on the current line; if called from the
-*Group* buffer search any marked groups, or the group on the current
-line, or all the groups under the current topic. Calling with a
-prefix-arg prompts for additional search-engine specific constraints.
-A non-nil `specs' arg must be an alist with `nnir-query-spec' and
-`nnir-group-spec' keys, and skips all prompting."
- (interactive "P")
- (let* ((group-spec
- (or (cdr (assq 'nnir-group-spec specs))
- (if (gnus-server-server-name)
- (list (list (gnus-server-server-name)))
- (nnir-categorize
- (or gnus-group-marked
- (if (gnus-group-group-name)
- (list (gnus-group-group-name))
- (mapcar (lambda (entry)
- (gnus-info-group (cadr entry)))
- (gnus-topic-find-groups (gnus-group-topic-name)))))
- gnus-group-server))))
- (query-spec
- (or (cdr (assq 'nnir-query-spec specs))
- (apply
- 'append
- (list (cons 'query
- (read-string "Query: " nil 'nnir-search-history)))
- (when nnir-extra-parms
- (mapcar
- (lambda (x)
- (nnir-read-parms (nnir-server-to-search-engine (car x))))
- group-spec))))))
- (gnus-group-read-ephemeral-group
- (concat "nnir-" (message-unique-id))
- (list 'nnir "nnir")
- nil
-; (cons (current-buffer) gnus-current-window-configuration)
- nil
- nil nil
- (list
- (cons 'nnir-specs (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec)))
- (cons 'nnir-artlist nil)))))
-
-(defun gnus-summary-make-nnir-group (nnir-extra-parms)
- "Search a group from the summary buffer."
- (interactive "P")
- (gnus-warp-to-article)
- (let ((spec
- (list
- (cons 'nnir-group-spec
- (list (list
- (gnus-group-server gnus-newsgroup-name)
- (list gnus-newsgroup-name)))))))
- (gnus-group-make-nnir-group nnir-extra-parms spec)))
-
-
-;; Gnus backend interface functions.
-
-(deffoo nnir-open-server (server &optional definitions)
- ;; Just set the server variables appropriately.
- (let ((backend (car (gnus-server-to-method server))))
- (if backend
- (nnoo-change-server backend server definitions)
- (add-hook 'gnus-summary-generate-hook 'nnir-mode)
- (nnoo-change-server 'nnir server definitions))))
-
-(deffoo nnir-request-group (group &optional server dont-check _info)
- (nnir-possibly-change-group group server)
- (let ((pgroup (gnus-group-guess-full-name-from-command-method group))
- length)
- ;; Check for cached search result or run the query and cache the
- ;; result.
- (unless (and nnir-artlist dont-check)
- (gnus-group-set-parameter
- pgroup 'nnir-artlist
- (setq nnir-artlist
- (nnir-run-query
- (gnus-group-get-parameter pgroup 'nnir-specs t))))
- (nnir-request-update-info pgroup (gnus-get-info pgroup)))
- (with-current-buffer nntp-server-buffer
- (if (zerop (setq length (nnir-artlist-length nnir-artlist)))
- (progn
- (nnir-close-group group)
- (nnheader-report 'nnir "Search produced empty results."))
- (nnheader-insert "211 %d %d %d %s\n"
- length ; total #
- 1 ; first #
- length ; last #
- group)))) ; group name
- nnir-artlist)
-
-(defvar gnus-inhibit-demon)
-
-(deffoo nnir-retrieve-headers (articles &optional _group _server _fetch-old)
- (with-current-buffer nntp-server-buffer
- (let ((gnus-inhibit-demon t)
- (articles-by-group (nnir-categorize
- articles nnir-article-group nnir-article-ids))
- headers)
- (while (not (null articles-by-group))
- (let* ((group-articles (pop articles-by-group))
- (artgroup (car group-articles))
- (articleids (cadr group-articles))
- (artlist (sort (mapcar 'cdr articleids) '<))
- (server (gnus-group-server artgroup))
- (gnus-override-method (gnus-server-to-method server))
- parsefunc)
- ;; (nnir-possibly-change-group nil server)
- (erase-buffer)
- (pcase (setq gnus-headers-retrieved-by
- (or
- (and
- nnir-retrieve-headers-override-function
- (funcall nnir-retrieve-headers-override-function
- artlist artgroup))
- (gnus-retrieve-headers artlist artgroup nil)))
- ('nov
- (setq parsefunc 'nnheader-parse-nov))
- ('headers
- (setq parsefunc 'nnheader-parse-head))
- (_ (error "Unknown header type %s while requesting articles \
- of group %s" gnus-headers-retrieved-by artgroup)))
- (goto-char (point-min))
- (while (not (eobp))
- (let* ((novitem (funcall parsefunc))
- (artno (and novitem
- (mail-header-number novitem)))
- (art (car (rassq artno articleids))))
- (when art
- (setf (mail-header-number novitem) art)
- (push novitem headers))
- (forward-line 1)))))
- (setq headers
- (sort headers
- (lambda (x y)
- (< (mail-header-number x) (mail-header-number y)))))
- (erase-buffer)
- (mapc 'nnheader-insert-nov headers)
- 'nov)))
-
-(defvar gnus-article-decode-hook)
-
-(deffoo nnir-request-article (article &optional group server to-buffer)
- (nnir-possibly-change-group group server)
- (if (and (stringp article)
- (not (eq 'nnimap (car (gnus-server-to-method server)))))
- (nnheader-report
- 'nnir
- "nnir-request-article only groks message ids for nnimap servers: %s"
- server)
- (save-excursion
- (let ((article article)
- query)
- (when (stringp article)
- (setq gnus-override-method (gnus-server-to-method server))
- (setq query
- (list
- (cons 'query (format "HEADER Message-ID %s" article))
- (cons 'criteria "")
- (cons 'shortcut t)))
- (unless (and nnir-artlist (equal query nnir-memo-query)
- (equal server nnir-memo-server))
- (setq nnir-artlist (nnir-run-imap query server)
- nnir-memo-query query
- nnir-memo-server server))
- (setq article 1))
- (unless (zerop (nnir-artlist-length nnir-artlist))
- (let ((artfullgroup (nnir-article-group article))
- (artno (nnir-article-number article)))
- (message "Requesting article %d from group %s"
- artno artfullgroup)
- (if to-buffer
- (with-current-buffer to-buffer
- (let ((gnus-article-decode-hook nil))
- (gnus-request-article-this-buffer artno artfullgroup)))
- (gnus-request-article artno artfullgroup))
- (cons artfullgroup artno)))))))
-
-(deffoo nnir-request-move-article (article group server accept-form
- &optional last _internal-move-group)
- (nnir-possibly-change-group group server)
- (let* ((artfullgroup (nnir-article-group article))
- (artno (nnir-article-number article))
- (to-newsgroup (nth 1 accept-form))
- (to-method (gnus-find-method-for-group to-newsgroup))
- (from-method (gnus-find-method-for-group artfullgroup))
- (move-is-internal (gnus-server-equal from-method to-method)))
- (unless (gnus-check-backend-function
- 'request-move-article artfullgroup)
- (error "The group %s does not support article moving" artfullgroup))
- (gnus-request-move-article
- artno
- artfullgroup
- (nth 1 from-method)
- accept-form
- last
- (and move-is-internal
- to-newsgroup ; Not respooling
- (gnus-group-real-name to-newsgroup)))))
-
-(deffoo nnir-request-expire-articles (articles group &optional server force)
- (nnir-possibly-change-group group server)
- (if force
- (let ((articles-by-group (nnir-categorize
- articles nnir-article-group nnir-article-ids))
- not-deleted)
- (while (not (null articles-by-group))
- (let* ((group-articles (pop articles-by-group))
- (artgroup (car group-articles))
- (articleids (cadr group-articles))
- (artlist (sort (mapcar 'cdr articleids) '<)))
- (unless (gnus-check-backend-function 'request-expire-articles
- artgroup)
- (error "The group %s does not support article deletion" artgroup))
- (unless (gnus-check-server (gnus-find-method-for-group artgroup))
- (error "Couldn't open server for group %s" artgroup))
- (push (gnus-request-expire-articles
- artlist artgroup force)
- not-deleted)))
- (sort (delq nil not-deleted) '<))
- articles))
-
-(deffoo nnir-warp-to-article ()
- (nnir-possibly-change-group gnus-newsgroup-name)
- (let* ((cur (if (> (gnus-summary-article-number) 0)
- (gnus-summary-article-number)
- (error "Can't warp to a pseudo-article")))
- (backend-article-group (nnir-article-group cur))
- (backend-article-number (nnir-article-number cur))
-; (quit-config (gnus-ephemeral-group-p gnus-newsgroup-name))
- )
-
- ;; what should we do here? we could leave all the buffers around
- ;; and assume that we have to exit from them one by one. or we can
- ;; try to clean up directly
-
- ;;first exit from the nnir summary buffer.
-; (gnus-summary-exit)
- ;; and if the nnir summary buffer in turn came from another
- ;; summary buffer we have to clean that summary up too.
- ; (when (not (eq (cdr quit-config) 'group))
-; (gnus-summary-exit))
- (gnus-summary-read-group-1 backend-article-group t t nil
- nil (list backend-article-number))))
-
-(deffoo nnir-request-update-mark (_group article mark)
- (let ((artgroup (nnir-article-group article))
- (artnumber (nnir-article-number article)))
- (or (and artgroup
- artnumber
- (gnus-request-update-mark artgroup artnumber mark))
- mark)))
-
-(deffoo nnir-request-set-mark (group actions &optional server)
- (nnir-possibly-change-group group server)
- (let (mlist)
- (dolist (action actions)
- (cl-destructuring-bind (range action marks) action
- (let ((articles-by-group (nnir-categorize
- (gnus-uncompress-range range)
- nnir-article-group nnir-article-number)))
- (dolist (artgroup articles-by-group)
- (push (list
- (car artgroup)
- (list (gnus-compress-sequence
- (sort (cadr artgroup) '<))
- action marks))
- mlist)))))
- (dolist (request (nnir-categorize mlist car cadr))
- (gnus-request-set-mark (car request) (cadr request)))))
-
-
-(deffoo nnir-request-update-info (group info &optional server)
- (nnir-possibly-change-group group server)
- ;; clear out all existing marks.
- (setf (gnus-info-marks info) nil)
- (setf (gnus-info-read info) nil)
- (let ((group (gnus-group-guess-full-name-from-command-method group))
- (articles-by-group
- (nnir-categorize
- (gnus-uncompress-range (cons 1 (nnir-artlist-length nnir-artlist)))
- nnir-article-group nnir-article-ids)))
- (gnus-set-active group
- (cons 1 (nnir-artlist-length nnir-artlist)))
- (while (not (null articles-by-group))
- (let* ((group-articles (pop articles-by-group))
- (articleids (reverse (cadr group-articles)))
- (group-info (gnus-get-info (car group-articles)))
- (marks (gnus-info-marks group-info))
- (read (gnus-info-read group-info)))
- (setf (gnus-info-read info)
- (gnus-add-to-range
- (gnus-info-read info)
- (delq nil
- (mapcar
- #'(lambda (art)
- (when (gnus-member-of-range (cdr art) read)
- (car art)))
- articleids))))
- (dolist (mark marks)
- (cl-destructuring-bind (type . range) mark
- (gnus-add-marked-articles
- group type
- (delq nil
- (mapcar
- #'(lambda (art)
- (when (gnus-member-of-range (cdr art) range) (car art)))
- articleids)))))))))
-
-
-(deffoo nnir-close-group (group &optional server)
- (nnir-possibly-change-group group server)
- (let ((pgroup (gnus-group-guess-full-name-from-command-method group)))
- (when (and nnir-artlist (not (gnus-ephemeral-group-p pgroup)))
- (gnus-group-set-parameter pgroup 'nnir-artlist nnir-artlist))
- (setq nnir-artlist nil)
- (when (gnus-ephemeral-group-p pgroup)
- (gnus-kill-ephemeral-group pgroup)
- (setq gnus-ephemeral-servers
- (delq (assq 'nnir gnus-ephemeral-servers)
- gnus-ephemeral-servers)))))
-;; (gnus-opened-servers-remove
-;; (car (assoc '(nnir "nnir-ephemeral" (nnir-address "nnir"))
-;; gnus-opened-servers))))
-
-
-
(defmacro nnir-add-result (dirnam artno score prefix server artlist)
- "Ask `nnir-compose-result' to construct a result vector,
-and if it is non-nil, add it to ARTLIST."
+ "Construct a result vector and add it to ARTLIST.
+DIRNAM, ARTNO, SCORE, PREFIX and SERVER are passed to
+`nnir-compose-result' to make the vector. Only add the result if
+non-nil."
`(let ((result (nnir-compose-result ,dirnam ,artno ,score ,prefix ,server)))
(when (not (null result))
(push result ,artlist))))
@@ -939,9 +518,9 @@ and if it is non-nil, add it to ARTLIST."
;; Helper function currently used by the Swish++ and Namazu backends;
;; perhaps useful for other backends as well
(defun nnir-compose-result (dirnam article score prefix server)
- "Extract the group from DIRNAM, and create a result vector
-ready to be added to the list of search results."
-
+ "Construct a result vector.
+The DIRNAM, ARTICLE, SCORE, PREFIX, and SERVER are used to
+construct the vector entries."
;; remove nnir-*-remove-prefix from beginning of dirnam filename
(when (string-match (concat "^" prefix) dirnam)
(setq dirnam (replace-match "" t t dirnam)))
@@ -970,62 +549,64 @@ ready to be added to the list of search results."
;;; Search Engine Interfaces:
+(autoload 'gnus-server-get-active "gnus-int")
(autoload 'nnimap-change-group "nnimap")
(declare-function nnimap-buffer "nnimap" ())
(declare-function nnimap-command "nnimap" (&rest args))
;; imap interface
(defun nnir-run-imap (query srv &optional groups)
- "Run a search against an IMAP back-end server.
-This uses a custom query language parser; see `nnir-imap-make-query'
-for details on the language and supported extensions."
+ "Run the QUERY search against an IMAP back-end server SRV.
+Search GROUPS, or all active groups on SRV if GROUPS is nil.
+This uses a custom query language parser; see
+`nnir-imap-make-query' for details on the language and supported
+extensions."
(save-excursion
(let ((qstring (cdr (assq 'query query)))
(server (cadr (gnus-server-to-method srv)))
-;; (defs (nth 2 (gnus-server-to-method srv)))
(criteria (or (cdr (assq 'criteria query))
(cdr (assoc nnir-imap-default-search-key
nnir-imap-search-arguments))))
(gnus-inhibit-demon t)
- (groups (or groups (nnir-get-active srv))))
+ (groups
+ (or groups (gnus-server-get-active srv nnir-ignored-newsgroups))))
(message "Opening server %s" server)
(apply
'vconcat
(catch 'found
(mapcar
#'(lambda (group)
- (let (artlist)
- (condition-case ()
- (when (nnimap-change-group
- (gnus-group-short-name group) server)
- (with-current-buffer (nnimap-buffer)
- (message "Searching %s..." group)
- (let ((arts 0)
- (result (nnimap-command "UID SEARCH %s"
- (if (string= criteria "")
- qstring
- (nnir-imap-make-query
- criteria qstring)))))
- (mapc
- (lambda (artnum)
- (let ((artn (string-to-number artnum)))
- (when (> artn 0)
- (push (vector group artn 100)
- artlist)
- (when (assq 'shortcut query)
- (throw 'found (list artlist)))
- (setq arts (1+ arts)))))
- (and (car result)
- (cdr (assoc "SEARCH" (cdr result)))))
- (message "Searching %s... %d matches" group arts)))
- (message "Searching %s...done" group))
- (quit nil))
- (nreverse artlist)))
+ (let (artlist)
+ (condition-case ()
+ (when (nnimap-change-group
+ (gnus-group-short-name group) server)
+ (with-current-buffer (nnimap-buffer)
+ (message "Searching %s..." group)
+ (let ((arts 0)
+ (result (nnimap-command "UID SEARCH %s"
+ (if (string= criteria "")
+ qstring
+ (nnir-imap-make-query
+ criteria qstring)))))
+ (mapc
+ (lambda (artnum)
+ (let ((artn (string-to-number artnum)))
+ (when (> artn 0)
+ (push (vector group artn 100)
+ artlist)
+ (when (assq 'shortcut query)
+ (throw 'found (list artlist)))
+ (setq arts (1+ arts)))))
+ (and (car result)
+ (cdr (assoc "SEARCH" (cdr result)))))
+ (message "Searching %s... %d matches" group arts)))
+ (message "Searching %s...done" group))
+ (quit nil))
+ (nreverse artlist)))
groups))))))
(defun nnir-imap-make-query (criteria qstring)
- "Parse the query string and criteria into an appropriate IMAP search
-expression, returning the string query to make.
+ "Make an IMAP search expression from QSTRING and CRITERIA.
This implements a little language designed to return the expected
results to an arbitrary query string to the end user.
@@ -1062,7 +643,7 @@ In the future the following will be added to the language:
(defun nnir-imap-query-to-imap (criteria query)
- "Turn an s-expression format QUERY into IMAP."
+ "Turn an s-expression format QUERY with CRITERIA into IMAP."
(mapconcat
;; Turn the expressions into IMAP text
(lambda (item)
@@ -1098,8 +679,9 @@ In the future the following will be added to the language:
(defun nnir-imap-parse-query (string)
- "Turn STRING into an s-expression based query based on the IMAP
-query language as defined in `nnir-imap-make-query'.
+ "Turn STRING into an s-expression query.
+STRING is based on the IMAP query language as defined in
+`nnir-imap-make-query'.
This involves turning individual tokens into higher level terms
that the search language can then understand and use."
@@ -1115,7 +697,7 @@ that the search language can then understand and use."
(defun nnir-imap-next-expr (&optional count)
- "Return the next expression from the current buffer."
+ "Return the next (COUNT) expression from the current buffer."
(let ((term (nnir-imap-next-term count))
(next (nnir-imap-peek-symbol)))
;; Are we looking at an 'or' expression?
@@ -1128,7 +710,7 @@ that the search language can then understand and use."
(defun nnir-imap-next-term (&optional count)
- "Return the next term from the current buffer."
+ "Return the next (COUNT) term from the current buffer."
(let ((term (nnir-imap-next-symbol count)))
;; What sort of term is this?
(cond
@@ -1146,9 +728,10 @@ that the search language can then understand and use."
(nnir-imap-next-symbol)))
(defun nnir-imap-next-symbol (&optional count)
- "Return the next symbol from the current buffer, or nil if we are
-at the end of the buffer. If supplied COUNT skips some symbols before
-returning the one at the supplied position."
+ "Return the next (COUNT) symbol from the current buffer.
+Return nil if we are at the end of the buffer. If supplied COUNT
+skips some symbols before returning the one at the supplied
+position."
(when (and (numberp count) (> count 1))
(nnir-imap-next-symbol (1- count)))
(let ((case-fold-search t))
@@ -1179,7 +762,7 @@ returning the one at the supplied position."
(buffer-substring start end)))))))
(defun nnir-imap-delimited-string (delimiter)
- "Return a delimited string from the current buffer."
+ "Return a string delimited by DELIMITER from the current buffer."
(let ((start (point)) end)
(forward-char 1) ; skip the first delimiter.
(while (not end)
@@ -1206,7 +789,7 @@ returning the one at the supplied position."
;; - file size
;; - group
(defun nnir-run-swish++ (query server &optional _group)
- "Run QUERY against swish++.
+ "Run QUERY on SERVER against swish++.
Returns a vector of (group name, file name) pairs (also vectors,
actually).
@@ -1234,7 +817,7 @@ Windows NT 4.0."
(when (equal "" qstring)
(error "swish++: You didn't enter anything"))
- (set-buffer (get-buffer-create nnir-tmp-buffer))
+ (set-buffer (gnus-get-buffer-create nnir-tmp-buffer))
(erase-buffer)
(if groupspec
@@ -1296,7 +879,7 @@ Windows NT 4.0."
;; Swish-E interface.
(defun nnir-run-swish-e (query server &optional _group)
- "Run given QUERY against swish-e.
+ "Run given QUERY on SERVER against swish-e.
Returns a vector of (group name, file name) pairs (also vectors,
actually).
@@ -1316,7 +899,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
(when (equal "" qstring)
(error "swish-e: You didn't enter anything"))
- (set-buffer (get-buffer-create nnir-tmp-buffer))
+ (set-buffer (gnus-get-buffer-create nnir-tmp-buffer))
(erase-buffer)
(message "Doing swish-e query %s..." query)
@@ -1391,6 +974,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
;; HyREX interface
(defun nnir-run-hyrex (query server &optional group)
+ "Run given QUERY with GROUP on SERVER against hyrex."
(save-excursion
(let ((artlist nil)
(groupspec (cdr (assq 'hyrex-group query)))
@@ -1401,7 +985,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
(setq groupspec
(regexp-opt
(mapcar (lambda (x) (gnus-group-real-name x)) group))))
- (set-buffer (get-buffer-create nnir-tmp-buffer))
+ (set-buffer (gnus-get-buffer-create nnir-tmp-buffer))
(erase-buffer)
(message "Doing hyrex-search query %s..." query)
(let* ((cp-list
@@ -1462,7 +1046,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
;; Namazu interface
(defun nnir-run-namazu (query server &optional _group)
- "Run given QUERY against Namazu.
+ "Run QUERY on SERVER against Namazu.
Returns a vector of (group name, file name) pairs (also vectors,
actually).
@@ -1480,7 +1064,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
score group article
(process-environment (copy-sequence process-environment)))
(setenv "LC_MESSAGES" "C")
- (set-buffer (get-buffer-create nnir-tmp-buffer))
+ (set-buffer (gnus-get-buffer-create nnir-tmp-buffer))
(erase-buffer)
(let* ((cp-list
`( ,nnir-namazu-program
@@ -1532,7 +1116,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
(nnir-artitem-rsv y)))))))))
(defun nnir-run-notmuch (query server &optional groups)
- "Run QUERY against notmuch.
+ "Run QUERY with GROUPS from SERVER against notmuch.
Returns a vector of (group name, file name) pairs (also vectors,
actually). If GROUPS is a list of group names, use them to
construct path: search terms (see the variable
@@ -1561,7 +1145,7 @@ construct path: search terms (see the variable
(when (equal "" qstring)
(error "notmuch: You didn't enter anything"))
- (set-buffer (get-buffer-create nnir-tmp-buffer))
+ (set-buffer (gnus-get-buffer-create nnir-tmp-buffer))
(erase-buffer)
(if groups
@@ -1616,14 +1200,15 @@ construct path: search terms (see the variable
artlist)))
(defun nnir-run-find-grep (query server &optional grouplist)
- "Run find and grep to obtain matching articles."
+ "Run find and grep to QUERY GROUPLIST on SERVER for matching articles."
(let* ((method (gnus-server-to-method server))
(sym (intern
(concat (symbol-name (car method)) "-directory")))
(directory (cadr (assoc sym (cddr method))))
(regexp (cdr (assoc 'query query)))
(grep-options (cdr (assoc 'grep-options query)))
- (grouplist (or grouplist (nnir-get-active server))))
+ (grouplist
+ (or grouplist (gnus-server-get-active server nnir-ignored-newsgroups))))
(unless directory
(error "No directory found in method specification of server %s"
server))
@@ -1635,7 +1220,7 @@ construct path: search terms (see the variable
(message "Searching %s using find-grep..."
(or group server))
(save-window-excursion
- (set-buffer (get-buffer-create nnir-tmp-buffer))
+ (set-buffer (gnus-get-buffer-create nnir-tmp-buffer))
(if (> gnus-verbose 6)
(pop-to-buffer (current-buffer)))
(cd directory) ; Using relative paths simplifies
@@ -1702,14 +1287,10 @@ construct path: search terms (see the variable
;;; Util Code:
-(defun gnus-nnir-group-p (group)
- "Say whether GROUP is nnir or not."
- (if (gnus-group-prefixed-p group)
- (eq 'nnir (car (gnus-find-method-for-group group)))
- (and group (string-match "^nnir" group))))
(defun nnir-read-parms (nnir-search-engine)
- "Read additional search parameters according to `nnir-engines'."
+ "Read additional search parameters for NNIR-SEARCH-ENGINE.
+Parameters are according to `nnir-engines'."
(let ((parmspec (nth 2 (assoc nnir-search-engine nnir-engines))))
(mapcar #'nnir-read-parm parmspec)))
@@ -1726,7 +1307,7 @@ PARMSPEC is a cons cell, the car is a symbol, the cdr is a prompt."
(cons sym (read-string prompt)))))
(defun nnir-run-query (specs)
- "Invoke appropriate search engine function (see `nnir-engines')."
+ "Invoke search engine appropriate for SPECS (see `nnir-engines')."
(apply #'vconcat
(mapcar
(lambda (x)
@@ -1735,10 +1316,11 @@ PARMSPEC is a cons cell, the car is a symbol, the cdr is a prompt."
(search-func (cadr (assoc search-engine nnir-engines))))
(and search-func
(funcall search-func (cdr (assq 'nnir-query-spec specs))
- server (cadr x)))))
+ server (cdr x)))))
(cdr (assq 'nnir-group-spec specs)))))
(defun nnir-server-to-search-engine (server)
+ "Find search engine for SERVER."
(or (nnir-read-server-parm 'nnir-search-engine server t)
(cdr (assoc (car (gnus-server-to-method server))
nnir-method-default-engines))))
@@ -1753,163 +1335,41 @@ environment unless NOT-GLOBAL is non-nil."
((and (not not-global) (boundp key)) (symbol-value key))
(t nil))))
-(defun nnir-possibly-change-group (group &optional server)
- (or (not server) (nnir-server-opened server) (nnir-open-server server))
- (when (gnus-nnir-group-p group)
- (setq nnir-artlist (gnus-group-get-parameter
- (gnus-group-prefixed-name
- (gnus-group-short-name group) '(nnir "nnir"))
- 'nnir-artlist t))))
-
-(defun nnir-server-opened (&optional server)
- (let ((backend (car (gnus-server-to-method server))))
- (nnoo-current-server-p (or backend 'nnir) server)))
-
-(autoload 'nnimap-make-thread-query "nnimap")
-(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
-
-(defun nnir-search-thread (header)
- "Make an nnir group based on the thread containing the article HEADER.
-The current server will be searched. If the registry is installed,
-the server that the registry reports the current article came from
-is also searched."
- (let* ((query
- (list (cons 'query (nnimap-make-thread-query header))
- (cons 'criteria "")))
- (server
- (list (list (gnus-method-to-server
- (gnus-find-method-for-group gnus-newsgroup-name)))))
- (registry-group (and
- (bound-and-true-p gnus-registry-enabled)
- (car (gnus-registry-get-id-key
- (mail-header-id header) 'group))))
- (registry-server
- (and registry-group
- (gnus-method-to-server
- (gnus-find-method-for-group registry-group)))))
- (when registry-server
- (cl-pushnew (list registry-server) server :test #'equal))
- (gnus-group-make-nnir-group nil (list
- (cons 'nnir-query-spec query)
- (cons 'nnir-group-spec server)))
- (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
-
-(defun nnir-get-active (srv)
- (let ((method (gnus-server-to-method srv))
- groups)
- (gnus-request-list method)
- (with-current-buffer nntp-server-buffer
- (let ((cur (current-buffer)))
- (goto-char (point-min))
- (unless (or (null nnir-ignored-newsgroups)
- (string= nnir-ignored-newsgroups ""))
- (delete-matching-lines nnir-ignored-newsgroups))
- (if (eq (car method) 'nntp)
- (while (not (eobp))
- (ignore-errors
- (push (gnus-group-full-name
- (buffer-substring
- (point)
- (progn
- (skip-chars-forward "^ \t")
- (point)))
- method)
- groups))
- (forward-line))
- (while (not (eobp))
- (ignore-errors
- (push (if (eq (char-after) ?\")
- (gnus-group-full-name (read cur) method)
- (let ((p (point)) (name ""))
- (skip-chars-forward "^ \t\\\\")
- (setq name (buffer-substring p (point)))
- (while (eq (char-after) ?\\)
- (setq p (1+ (point)))
- (forward-char 2)
- (skip-chars-forward "^ \t\\\\")
- (setq name (concat name (buffer-substring
- p (point)))))
- (gnus-group-full-name name method)))
- groups))
- (forward-line)))))
- groups))
-
-;; Behind gnus-registry-enabled test.
-(declare-function gnus-registry-action "gnus-registry"
- (action data-header from &optional to method))
-
-(defun nnir-registry-action (action data-header _from &optional to method)
- "Call `gnus-registry-action' with the original article group."
- (gnus-registry-action
- action
- data-header
- (nnir-article-group (mail-header-number data-header))
- to
- method))
-
-(defun nnir-mode ()
- (when (eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnir)
- (when (and nnir-summary-line-format
- (not (string= nnir-summary-line-format
- gnus-summary-line-format)))
- (setq gnus-summary-line-format nnir-summary-line-format)
- (gnus-update-format-specifications nil 'summary))
- (when (bound-and-true-p gnus-registry-enabled)
- (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action t)
- (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action t)
- (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action t)
- (add-hook 'gnus-summary-article-delete-hook 'nnir-registry-action t t)
- (add-hook 'gnus-summary-article-move-hook 'nnir-registry-action t t)
- (add-hook 'gnus-summary-article-expire-hook 'nnir-registry-action t t))))
-
-
-(defun gnus-summary-create-nnir-group ()
- (interactive)
- (or (nnir-server-opened "") (nnir-open-server "nnir"))
- (let ((name (gnus-read-group "Group name: "))
- (method '(nnir ""))
- (pgroup
- (gnus-group-guess-full-name-from-command-method gnus-newsgroup-name)))
- (with-current-buffer gnus-group-buffer
- (gnus-group-make-group
- name method nil
- (gnus-group-find-parameter pgroup)))))
-
-
-(deffoo nnir-request-create-group (group &optional _server args)
- (message "Creating nnir group %s" group)
- (let* ((group (gnus-group-prefixed-name group '(nnir "nnir")))
- (specs (assq 'nnir-specs args))
- (query-spec
- (or (cdr (assq 'nnir-query-spec specs))
- (list (cons 'query
- (read-string "Query: " nil 'nnir-search-history)))))
- (group-spec
- (or (cdr (assq 'nnir-group-spec specs))
- (list (list (read-string "Server: " nil nil)))))
- (nnir-specs (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec))))
- (gnus-group-set-parameter group 'nnir-specs nnir-specs)
- (gnus-group-set-parameter
- group 'nnir-artlist
- (or (cdr (assq 'nnir-artlist args))
- (nnir-run-query nnir-specs)))
- (nnir-request-update-info group (gnus-get-info group)))
- t)
-
-(deffoo nnir-request-delete-group (_group &optional _force _server)
- t)
-
-(deffoo nnir-request-list (&optional _server)
- t)
-
-(deffoo nnir-request-scan (_group _method)
- t)
-
-(deffoo nnir-request-close ()
- t)
-
-(nnoo-define-skeleton nnir)
+(autoload 'gnus-group-topic-name "gnus-topic" nil nil)
+(defvar gnus-group-marked)
+(defvar gnus-topic-alist)
+
+(make-obsolete 'nnir-make-specs "This function should no longer
+be used." "28.1")
+
+(defun nnir-make-specs (nnir-extra-parms &optional specs)
+ "Make the query-spec and group-spec for a search with NNIR-EXTRA-PARMS.
+Query for the specs, or use SPECS."
+ (let* ((group-spec
+ (or (cdr (assq 'nnir-group-spec specs))
+ (if (gnus-server-server-name)
+ (list (list (gnus-server-server-name)))
+ (seq-group-by
+ (lambda (elt) (gnus-group-server elt))
+ (or gnus-group-marked
+ (if (gnus-group-group-name)
+ (list (gnus-group-group-name))
+ (cdr (assoc (gnus-group-topic-name) gnus-topic-alist))))))))
+ (query-spec
+ (or (cdr (assq 'nnir-query-spec specs))
+ (apply
+ 'append
+ (list (cons 'query
+ (read-string "Query: " nil 'nnir-search-history)))
+ (when nnir-extra-parms
+ (mapcar
+ (lambda (x)
+ (nnir-read-parms (nnir-server-to-search-engine (car x))))
+ group-spec))))))
+ (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")
;; The end.
(provide 'nnir)
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index d64d0ed0006..b6308140fc9 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1047,7 +1047,7 @@ will be copied over from that buffer."
(list (list group ""))
nnmail-split-methods)))
;; Insert the incoming file.
- (with-current-buffer (get-buffer-create nnmail-article-buffer)
+ (with-current-buffer (gnus-get-buffer-create nnmail-article-buffer)
(erase-buffer)
(if (bufferp incoming)
(insert-buffer-substring incoming)
@@ -1574,7 +1574,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
() ; The buffer is open.
(with-current-buffer
(setq nnmail-cache-buffer
- (get-buffer-create " *nnmail message-id cache*"))
+ (gnus-get-buffer-create " *nnmail message-id cache*"))
(gnus-add-buffer)
(when (file-exists-p nnmail-message-id-cache-file)
(nnheader-insert-file-contents nnmail-message-id-cache-file))
@@ -1749,7 +1749,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(nreverse (nnmail-article-group artnum-func))))))
;; Add the group-art list to the history list.
(if group-art
- (push group-art nnmail-split-history)
+ ;; We need to get the unique Gnus group name for this article
+ ;; -- there may be identically named groups from several
+ ;; backends.
+ (push (mapcar
+ (lambda (ga)
+ (cons (gnus-group-prefixed-name (car ga) gnus-command-method)
+ (cdr ga)))
+ group-art)
+ nnmail-split-history)
(delete-region (point-min) (point-max)))))
;;; Get new mail.
@@ -1953,12 +1961,14 @@ If TIME is nil, then return the cutoff time for oldness instead."
(unless (re-search-forward "^Message-ID[ \t]*:" nil t)
(insert "Message-ID: " (nnmail-message-id) "\n")))))
-(defun nnmail-write-region (start end filename &optional append visit lockname)
+(defun nnmail-write-region (start end filename
+ &optional append visit lockname mustbenew)
"Do a `write-region', and then set the file modes."
(let ((coding-system-for-write nnmail-file-coding-system)
(file-name-coding-system nnmail-pathname-coding-system))
- (write-region start end filename append visit lockname)
- (set-file-modes filename nnmail-default-file-modes)))
+ (write-region start end filename append visit lockname mustbenew)
+ (set-file-modes filename nnmail-default-file-modes
+ (when (eq mustbenew 'excl) 'nofollow))))
;;;
;;; Status functions
@@ -2065,7 +2075,7 @@ Doesn't change point."
(when nnmail-split-tracing
(push split nnmail-split-trace))
(when nnmail-debug-splitting
- (with-current-buffer (get-buffer-create "*nnmail split*")
+ (with-current-buffer (gnus-get-buffer-create "*nnmail split*")
(goto-char (point-max))
(insert (format-time-string "%FT%T")
" "
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 9cf766ee465..68c31dc4510 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -1,4 +1,4 @@
-;;; nnmaildir.el --- maildir backend for Gnus
+;;; nnmaildir.el --- maildir backend for Gnus -*- lexical-binding:t -*-
;; This file is in the public domain.
@@ -261,7 +261,7 @@ This variable is set by `nnmaildir-request-article'.")
(defun nnmaildir--param (pgname param)
(setq param (gnus-group-find-parameter pgname param 'allow-list))
(if (vectorp param) (setq param (aref param 0)))
- (eval param))
+ (eval param t))
(defmacro nnmaildir--with-nntp-buffer (&rest body)
(declare (debug (body)))
@@ -269,15 +269,15 @@ This variable is set by `nnmaildir-request-article'.")
,@body))
(defmacro nnmaildir--with-work-buffer (&rest body)
(declare (debug (body)))
- `(with-current-buffer (get-buffer-create " *nnmaildir work*")
+ `(with-current-buffer (gnus-get-buffer-create " *nnmaildir work*")
,@body))
(defmacro nnmaildir--with-nov-buffer (&rest body)
(declare (debug (body)))
- `(with-current-buffer (get-buffer-create " *nnmaildir nov*")
+ `(with-current-buffer (gnus-get-buffer-create " *nnmaildir nov*")
,@body))
(defmacro nnmaildir--with-move-buffer (&rest body)
(declare (debug (body)))
- `(with-current-buffer (get-buffer-create " *nnmaildir move*")
+ `(with-current-buffer (gnus-get-buffer-create " *nnmaildir move*")
,@body))
(defsubst nnmaildir--subdir (dir subdir)
@@ -492,7 +492,7 @@ This variable is set by `nnmaildir-request-article'.")
(setq nov-mid 0))
(goto-char (point-min))
(delete-char 1)
- (setq nov (nnheader-parse-naked-head)
+ (setq nov (nnheader-parse-head t)
field (or (mail-header-lines nov) 0)))
(unless (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:))
(setq nov-mid field))
@@ -690,7 +690,7 @@ This variable is set by `nnmaildir-request-article'.")
"You must set \"directory\" in the select method")
(throw 'return nil))
(setq dir (cadr dir)
- dir (eval dir)
+ dir (eval dir t) ;FIXME: Why `eval'?
dir (expand-file-name dir)
dir (file-name-as-directory dir))
(unless (file-exists-p dir)
@@ -717,13 +717,13 @@ This variable is set by `nnmaildir-request-article'.")
(if x
(progn
(setq x (cadr x)
- x (eval x))
+ x (eval x t)) ;FIXME: Why `eval'?
(setf (nnmaildir--srv-target-prefix server) x))
(setq x (assq 'create-directory defs))
(if x
(progn
(setq x (cadr x)
- x (eval x)
+ x (eval x t) ;FIXME: Why `eval'?
x (file-name-as-directory x))
(setf (nnmaildir--srv-target-prefix server) x))
(setf (nnmaildir--srv-target-prefix server) "")))
@@ -1428,7 +1428,7 @@ This variable is set by `nnmaildir-request-article'.")
(nnmaildir--with-move-buffer
(erase-buffer)
(nnheader-insert-file-contents nnmaildir--file)
- (setq result (eval accept-form)))
+ (setq result (eval accept-form t)))
(unless (or (null result) (nnmaildir--param pgname 'read-only))
(nnmaildir--unlink nnmaildir--file)
(nnmaildir--expired-article group article))
@@ -1544,7 +1544,7 @@ This variable is set by `nnmaildir-request-article'.")
(defun nnmaildir-request-expire-articles (ranges &optional gname server force)
(let ((no-force (not force))
(group (nnmaildir--prepare server gname))
- pgname time boundary high low target dir nlist
+ pgname time boundary target dir nlist
didnt nnmaildir--file nnmaildir-article-file-name
deactivate-mark)
(catch 'return
@@ -1720,18 +1720,23 @@ This variable is set by `nnmaildir-request-article'.")
(defun nnmaildir-close-group (gname &optional server)
(let ((group (nnmaildir--prepare server gname))
- pgname ls dir msgdir files flist dirs)
+ pgname ls dir msgdir files dirs
+ (fset (make-hash-table :test #'equal)))
(if (null group)
(progn
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "No such group: " gname))
nil)
+ ;; Delete the now obsolete NOV files.
+ ;; FIXME: This can take a somewhat long time, so maybe it's better
+ ;; to do it asynchronously (i.e. in an idle timer).
(setq pgname (nnmaildir--pgname nnmaildir--cur-server gname)
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--srvgrp-dir dir gname)
msgdir (if (nnmaildir--param pgname 'read-only)
(nnmaildir--new dir) (nnmaildir--cur dir))
+ ;; The dir with the NOV files.
dir (nnmaildir--nndir dir)
dirs (cons (nnmaildir--nov-dir dir)
(funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]"
@@ -1744,14 +1749,15 @@ This variable is set by `nnmaildir-request-article'.")
(save-match-data
(dolist (file files)
(string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file)
- (push (match-string 1 file) flist)))
+ (puthash (match-string 1 file) t fset)))
+ ;; Not sure why, but we specifically avoid deleting the `:' file.
+ (puthash ":" t fset)
(dolist (dir dirs)
(setq files (cdr dir)
dir (file-name-as-directory (car dir)))
(dolist (file files)
- (unless (or (member file flist) (string= file ":"))
- (setq file (concat dir file))
- (delete-file file))))
+ (unless (gethash file fset)
+ (delete-file (concat dir file)))))
t)))
(defun nnmaildir-close-server (&optional server _defs)
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index b3329212f84..dcecfcf6519 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -1249,7 +1249,7 @@ Marks propagation has to be enabled for this to work."
If THREADS is non-nil, enable full threads."
(let ((args (cons (car command) '(nil t nil))))
(with-current-buffer
- (get-buffer-create nnmairix-mairix-output-buffer)
+ (gnus-get-buffer-create nnmairix-mairix-output-buffer)
(erase-buffer)
(when (> (length command) 1)
(setq args (append args (cdr command))))
@@ -1267,7 +1267,7 @@ If THREADS is non-nil, enable full threads."
"Call mairix binary with COMMAND and QUERY in raw mode."
(let ((args (cons (car command) '(nil t nil))))
(with-current-buffer
- (get-buffer-create nnmairix-mairix-output-buffer)
+ (gnus-get-buffer-create nnmairix-mairix-output-buffer)
(erase-buffer)
(when (> (length command) 1)
(setq args (append args (cdr command))))
@@ -1404,7 +1404,7 @@ TYPE is either `nov' or `headers'."
(nnheader-message 7 "nnmairix: Rewriting headers...")
(cond
((eq type 'nov)
- (let ((buf (get-buffer-create " *nnmairix buffer*"))
+ (let ((buf (gnus-get-buffer-create " *nnmairix buffer*"))
(corr (not (zerop numc)))
(name (buffer-name nntp-server-buffer))
header cur xref)
diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el
index eb8fcf37a25..8b3d80266e7 100644
--- a/lisp/gnus/nnmbox.el
+++ b/lisp/gnus/nnmbox.el
@@ -280,7 +280,7 @@
(deffoo nnmbox-request-move-article
(article group server accept-form &optional last move-is-internal)
- (let ((buf (get-buffer-create " *nnmbox move*"))
+ (let ((buf (gnus-get-buffer-create " *nnmbox move*"))
result)
(and
(nnmbox-request-article article group server)
@@ -613,7 +613,7 @@
(dir (file-name-directory nnmbox-mbox-file)))
(and dir (gnus-make-directory dir))
(nnmail-write-region (point-min) (point-min)
- nnmbox-mbox-file t 'nomesg))))
+ nnmbox-mbox-file t 'nomesg nil 'excl))))
(defun nnmbox-read-mbox ()
(nnmail-activate 'nnmbox)
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index 8e7f0565e67..581a408009d 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -296,7 +296,7 @@ as unread by Gnus.")
(deffoo nnmh-request-move-article (article group server accept-form
&optional last move-is-internal)
- (let ((buf (get-buffer-create " *nnmh move*"))
+ (let ((buf (gnus-get-buffer-create " *nnmh move*"))
result)
(and
(nnmh-deletable-article-p group article)
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 6c7b25b5e76..ad608b6575e 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -361,7 +361,7 @@ non-nil.")
(deffoo nnml-request-move-article
(article group server accept-form &optional last move-is-internal)
- (let ((buf (get-buffer-create " *nnml move*"))
+ (let ((buf (gnus-get-buffer-create " *nnml move*"))
(file-name-coding-system nnmail-pathname-coding-system)
result)
(nnml-possibly-change-directory group server)
@@ -572,7 +572,7 @@ non-nil.")
;; Find an article number in the current group given the Message-ID.
(defun nnml-find-group-number (id server)
- (with-current-buffer (get-buffer-create " *nnml id*")
+ (with-current-buffer (gnus-get-buffer-create " *nnml id*")
(let ((alist nnml-group-alist)
number)
;; We want to look through all .overview files, but we want to
@@ -766,17 +766,16 @@ article number. This function is called narrowed to an article."
(if (re-search-forward "\n\r?\n" nil t)
(1- (point))
(point-max))))
- (let ((headers (nnheader-parse-naked-head)))
+ (let ((headers (nnheader-parse-head t)))
(setf (mail-header-chars headers) chars)
(setf (mail-header-number headers) number)
headers))))
(defun nnml-get-nov-buffer (group &optional incrementalp)
- (let ((buffer (get-buffer-create (format " *nnml %soverview %s*"
- (if incrementalp
- "incremental "
- "")
- group)))
+ (let ((buffer (gnus-get-buffer-create
+ (format " *nnml %soverview %s*"
+ (if incrementalp "incremental " "")
+ group)))
(file-name-coding-system nnmail-pathname-coding-system))
(with-current-buffer buffer
(set (make-local-variable 'nnml-nov-buffer-file-name)
@@ -873,7 +872,7 @@ Unless no-active is non-nil, update the active file too."
(defun nnml-generate-nov-file (dir files)
(let* ((dir (file-name-as-directory dir))
(nov (concat dir nnml-nov-file-name))
- (nov-buffer (get-buffer-create " *nov*"))
+ (nov-buffer (gnus-get-buffer-create " *nov*"))
chars file headers)
(with-current-buffer nov-buffer
;; Init the nov buffer.
@@ -902,7 +901,7 @@ Unless no-active is non-nil, update the active file too."
(nnheader-insert-nov headers)))
(widen))))
(with-current-buffer nov-buffer
- (nnmail-write-region (point-min) (point-max) nov nil 'nomesg)
+ (nnmail-write-region (point-min) (point-max) nov nil 'nomesg nil 'excl)
(kill-buffer (current-buffer))))))
(defun nnml-nov-delete-article (group article)
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index fa4d22fb1cc..48c07da1cc8 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -450,7 +450,7 @@ nnrss: %s: Not valid XML %s and libxml-parse-html-region doesn't work %s"
(defun nnrss-normalize-date (date)
"Return a date string of DATE in the style of RFC 822 and its successors.
This function handles the ISO 8601 date format described in
-URL `http://www.w3.org/TR/NOTE-datetime', and also the RFC 822 style
+URL `https://www.w3.org/TR/NOTE-datetime', and also the RFC 822 style
which RSS 2.0 allows."
(let (case-fold-search vector year month day time zone cts given)
(cond ((null date)) ; do nothing for this case
@@ -739,7 +739,7 @@ Read the file and attempt to subscribe to each Feed in the file."
"OPML subscription export.
Export subscriptions to a buffer in OPML Format."
(interactive)
- (with-current-buffer (get-buffer-create "*OPML Export*")
+ (with-current-buffer (gnus-get-buffer-create "*OPML Export*")
(set-buffer-file-coding-system 'utf-8)
(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
"<!-- OPML generated by Emacs Gnus' nnrss.el -->\n"
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
new file mode 100644
index 00000000000..21206b683cf
--- /dev/null
+++ b/lisp/gnus/nnselect.el
@@ -0,0 +1,949 @@
+;;; nnselect.el --- a virtual group backend -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Andrew Cohen <cohen@andy.bu.edu>
+;; Keywords: news mail
+
+;; 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 is a "virtual" backend that allows an arbitrary list of
+;; articles to be treated as a Gnus group. An nnselect group uses an
+;; `nnselect-spec' group parameter to specify this list of
+;; articles. `nnselect-spec' is an alist with two keys:
+;; `nnselect-function', whose value should be a function that returns
+;; the list of articles, and `nnselect-args'. The function will be
+;; applied to the arguments to generate the list of articles. The
+;; return value should be a vector, each element of which should in
+;; 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
+;; 100, for this score.
+
+;; For example the search function `nnir-run-query' applied to
+;; arguments specifying a search query (see "nnir.el") can be used to
+;; return a list of articles from a search. Or the function can be the
+;; identity and the args a vector of articles.
+
+
+;;; Code:
+
+;;; Setup:
+
+(require 'gnus-art)
+(require 'nnir)
+
+(eval-when-compile (require 'cl-lib))
+
+;; Set up the backend
+
+(nnoo-declare nnselect)
+
+(nnoo-define-basics nnselect)
+
+(gnus-declare-backend "nnselect" 'post-mail 'virtual)
+
+;;; Internal Variables:
+
+(defvar gnus-inhibit-demon)
+(defvar gnus-message-group-art)
+
+;; For future use
+(defvoo nnselect-directory gnus-directory
+ "Directory for the nnselect backend.")
+
+(defvoo nnselect-active-file
+ (expand-file-name "nnselect-active" nnselect-directory)
+ "nnselect active file.")
+
+(defvoo nnselect-groups-file
+ (expand-file-name "nnselect-newsgroups" nnselect-directory)
+ "nnselect groups description file.")
+
+;;; Helper routines.
+(defun nnselect-compress-artlist (artlist)
+ "Compress ARTLIST."
+ (let (selection)
+ (pcase-dolist (`(,artgroup . ,arts)
+ (nnselect-categorize artlist 'nnselect-artitem-group))
+ (let (list)
+ (pcase-dolist (`(,rsv . ,articles)
+ (nnselect-categorize
+ arts 'nnselect-artitem-rsv 'nnselect-artitem-number))
+ (push (cons rsv (gnus-compress-sequence (sort articles '<)))
+ list))
+ (push (cons artgroup list) selection)))
+ selection))
+
+(defun nnselect-uncompress-artlist (artlist)
+ "Uncompress ARTLIST."
+ (if (vectorp artlist)
+ artlist
+ (let (selection)
+ (pcase-dolist (`(,artgroup (,artrsv . ,artseq)) artlist)
+ (setq selection
+ (vconcat
+ (cl-map 'vector
+ #'(lambda (art)
+ (vector artgroup art artrsv))
+ (gnus-uncompress-sequence artseq)) selection)))
+ selection)))
+
+(make-obsolete 'nnselect-group-server 'gnus-group-server "28.1")
+
+;; Data type article list.
+
+(define-inline nnselect-artlist-length (artlist)
+ (inline-quote (length ,artlist)))
+
+(define-inline nnselect-artlist-article (artlist n)
+ "Return from ARTLIST the Nth artitem (counting starting at 1)."
+ (inline-quote (when (> ,n 0)
+ (elt ,artlist (1- ,n)))))
+
+(define-inline nnselect-artitem-group (artitem)
+ "Return the group from the ARTITEM."
+ (inline-quote (elt ,artitem 0)))
+
+(define-inline nnselect-artitem-number (artitem)
+ "Return the number from the ARTITEM."
+ (inline-quote (elt ,artitem 1)))
+
+(define-inline nnselect-artitem-rsv (artitem)
+ "Return the Retrieval Status Value (RSV, score) from the ARTITEM."
+ (inline-quote (elt ,artitem 2)))
+
+(define-inline nnselect-article-group (article)
+ "Return the group for ARTICLE."
+ (inline-quote
+ (nnselect-artitem-group (nnselect-artlist-article
+ gnus-newsgroup-selection ,article))))
+
+(define-inline nnselect-article-number (article)
+ "Return the number for ARTICLE."
+ (inline-quote (nnselect-artitem-number
+ (nnselect-artlist-article
+ gnus-newsgroup-selection ,article))))
+
+(define-inline nnselect-article-rsv (article)
+ "Return the rsv for ARTICLE."
+ (inline-quote (nnselect-artitem-rsv
+ (nnselect-artlist-article
+ gnus-newsgroup-selection ,article))))
+
+(define-inline nnselect-article-id (article)
+ "Return the pair `(nnselect id . real id)' of ARTICLE."
+ (inline-quote (cons ,article (nnselect-article-number ,article))))
+
+(define-inline nnselect-categorize (sequence keyfunc &optional valuefunc)
+ "Sorts a sequence into categories.
+Returns a list of the form
+`((key1 (element11 element12)) (key2 (element21 element22))'.
+The category key for a member of the sequence is obtained
+as `(keyfunc member)' and the corresponding element is just
+`member' (or `(valuefunc member)' if `valuefunc' is non-nil)."
+ (inline-letevals (sequence keyfunc valuefunc)
+ (inline-quote (let ((valuefunc (or ,valuefunc 'identity))
+ result)
+ (unless (null ,sequence)
+ (mapc
+ (lambda (member)
+ (let* ((key (funcall ,keyfunc member))
+ (value (funcall valuefunc member))
+ (kr (assoc key result)))
+ (if kr
+ (push value (cdr kr))
+ (push (list key value) result))))
+ (reverse ,sequence))
+ result)))))
+
+
+;; Unclear whether a macro or an inline function is best.
+;; (defmacro nnselect-categorize (sequence keyfunc &optional valuefunc)
+;; "Sorts a sequence into categories and returns a list of the form
+;; `((key1 (element11 element12)) (key2 (element21 element22))'.
+;; The category key for a member of the sequence is obtained
+;; as `(keyfunc member)' and the corresponding element is just
+;; `member' (or `(valuefunc member)' if `valuefunc' is non-nil)."
+;; (let ((key (make-symbol "key"))
+;; (value (make-symbol "value"))
+;; (result (make-symbol "result"))
+;; (valuefunc (or valuefunc 'identity)))
+;; `(unless (null ,sequence)
+;; (let (,result)
+;; (mapc
+;; (lambda (member)
+;; (let* ((,key (,keyfunc member))
+;; (,value (,valuefunc member))
+;; (kr (assoc ,key ,result)))
+;; (if kr
+;; (push ,value (cdr kr))
+;; (push (list ,key ,value) ,result))))
+;; (reverse ,sequence))
+;; ,result))))
+
+(define-inline ids-by-group (articles)
+ (inline-quote
+ (nnselect-categorize ,articles 'nnselect-article-group
+ 'nnselect-article-id)))
+
+(define-inline numbers-by-group (articles &optional type)
+ (inline-quote
+ (cond
+ ((eq ,type 'range)
+ (nnselect-categorize (gnus-uncompress-range ,articles)
+ 'nnselect-article-group 'nnselect-article-number))
+ ((eq ,type 'tuple)
+ (nnselect-categorize ,articles
+ #'(lambda (elem)
+ (nnselect-article-group (car elem)))
+ #'(lambda (elem)
+ (cons (nnselect-article-number
+ (car elem)) (cdr elem)))))
+ (t
+ (nnselect-categorize ,articles
+ 'nnselect-article-group 'nnselect-article-number)))))
+
+(defmacro nnselect-add-prefix (group)
+ "Ensures that the GROUP has an nnselect prefix."
+ `(gnus-group-prefixed-name
+ (gnus-group-short-name ,group) '(nnselect "nnselect")))
+
+(defmacro nnselect-get-artlist (group)
+ "Retrieve the list of articles for GROUP."
+ `(when (gnus-nnselect-group-p ,group)
+ (nnselect-uncompress-artlist
+ (gnus-group-get-parameter ,group 'nnselect-artlist t))))
+
+(defmacro nnselect-add-novitem (novitem)
+ "Add NOVITEM to the list of headers."
+ `(let* ((novitem ,novitem)
+ (artno (and novitem
+ (mail-header-number novitem)))
+ (art (car-safe (rassq artno artids))))
+ (when art
+ (setf (mail-header-number novitem) art)
+ (push novitem headers))))
+
+;;; User Customizable Variables:
+
+(defgroup nnselect nil
+ "Virtual groups in Gnus with arbitrary selection methods."
+ :group 'gnus)
+
+(define-obsolete-variable-alias 'nnir-retrieve-headers-override-function
+ 'nnselect-retrieve-headers-override-function "28.1")
+
+(defcustom nnselect-retrieve-headers-override-function nil
+ "A function that retrieves article headers for ARTICLES from GROUP.
+The retrieved headers should populate the `nntp-server-buffer'.
+Returns either the retrieved header format 'nov or 'headers.
+
+If this variable is nil, or if the provided function returns nil,
+ `gnus-retrieve-headers' will be called instead."
+ :version "28.1"
+ :type '(repeat function))
+
+;; Gnus backend interface functions.
+
+(deffoo nnselect-open-server (server &optional definitions)
+ ;; Just set the server variables appropriately.
+ (let ((backend (or (car (gnus-server-to-method server)) 'nnselect)))
+ (nnoo-change-server backend server definitions)))
+
+;; (deffoo nnselect-server-opened (&optional server)
+;; "Is SERVER the current virtual server?"
+;; (if (string-empty-p server)
+;; t
+;; (let ((backend (car (gnus-server-to-method server))))
+;; (nnoo-current-server-p (or backend 'nnselect) server))))
+
+(deffoo nnselect-server-opened (&optional _server)
+ t)
+
+
+(deffoo nnselect-request-group (group &optional _server _dont-check info)
+ (let* ((group (nnselect-add-prefix group))
+ (nnselect-artlist (nnselect-get-artlist group))
+ length)
+ ;; Check for cached select result or run the selection and cache
+ ;; the result.
+ (unless nnselect-artlist
+ (gnus-group-set-parameter
+ group 'nnselect-artlist
+ (nnselect-compress-artlist (setq nnselect-artlist
+ (nnselect-run
+ (gnus-group-get-parameter group 'nnselect-specs t)))))
+ (nnselect-request-update-info
+ group (or info (gnus-get-info group))))
+ (if (zerop (setq length (nnselect-artlist-length nnselect-artlist)))
+ (progn
+ (nnheader-report 'nnselect "Selection produced empty results.")
+ (nnheader-insert ""))
+ (with-current-buffer nntp-server-buffer
+ (nnheader-insert "211 %d %d %d %s\n"
+ length ; total #
+ 1 ; first #
+ length ; last #
+ group))) ; group name
+ nnselect-artlist))
+
+
+(deffoo nnselect-retrieve-headers (articles group &optional _server fetch-old)
+ (let ((group (nnselect-add-prefix group)))
+ (with-current-buffer (gnus-summary-buffer-name group)
+ (setq gnus-newsgroup-selection (or gnus-newsgroup-selection
+ (nnselect-get-artlist group)))
+ (let ((gnus-inhibit-demon t)
+ (gartids (ids-by-group articles))
+ headers)
+ (with-current-buffer nntp-server-buffer
+ (pcase-dolist (`(,artgroup . ,artids) gartids)
+ (let ((artlist (sort (mapcar 'cdr artids) '<))
+ (gnus-override-method (gnus-find-method-for-group artgroup))
+ (fetch-old
+ (or
+ (car-safe
+ (gnus-group-find-parameter artgroup
+ 'gnus-fetch-old-headers t))
+ fetch-old)))
+ (erase-buffer)
+ (pcase (setq gnus-headers-retrieved-by
+ (or
+ (and
+ nnselect-retrieve-headers-override-function
+ (funcall
+ nnselect-retrieve-headers-override-function
+ artlist artgroup))
+ (gnus-retrieve-headers
+ artlist artgroup fetch-old)))
+ ('nov
+ (goto-char (point-min))
+ (while (not (eobp))
+ (nnselect-add-novitem
+ (nnheader-parse-nov))
+ (forward-line 1)))
+ ('headers
+ (gnus-run-hooks 'gnus-parse-headers-hook)
+ (let ((nnmail-extra-headers gnus-extra-headers))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (nnselect-add-novitem
+ (nnheader-parse-head))
+ (forward-line 1))))
+ ((pred listp)
+ (dolist (novitem gnus-headers-retrieved-by)
+ (nnselect-add-novitem novitem)))
+ (_ (error "Unknown header type %s while requesting articles \
+ of group %s" gnus-headers-retrieved-by artgroup)))))
+ (setq headers
+ (sort
+ headers
+ (lambda (x y)
+ (< (mail-header-number x) (mail-header-number y))))))))))
+
+
+(deffoo nnselect-request-article (article &optional _group server to-buffer)
+ (let* ((gnus-override-method nil)
+ servers group-art artlist)
+ (if (numberp article)
+ (with-current-buffer gnus-summary-buffer
+ (unless (zerop (nnselect-artlist-length
+ gnus-newsgroup-selection))
+ (setq group-art (cons (nnselect-article-group article)
+ (nnselect-article-number article)))))
+ ;; message-id: either coming from a referral or a pseudo-article
+ ;; find the servers for a pseudo-article
+ (if (eq 'nnselect (car (gnus-server-to-method server)))
+ (with-current-buffer gnus-summary-buffer
+ (let ((thread (gnus-id-to-thread article)))
+ (when thread
+ (mapc
+ #'(lambda (x)
+ (when (and x (> x 0))
+ (cl-pushnew
+ (list
+ (gnus-method-to-server
+ (gnus-find-method-for-group
+ (nnselect-article-group x)))) servers :test 'equal)))
+ (gnus-articles-in-thread thread)))))
+ (setq servers (list (list server))))
+ (setq artlist
+ (nnir-run-query
+ (list
+ (cons 'nnir-query-spec
+ (list (cons 'query (format "HEADER Message-ID %s" article))
+ (cons 'criteria "") (cons 'shortcut t)))
+ (cons 'nnir-group-spec servers))))
+ (unless (zerop (nnselect-artlist-length artlist))
+ (setq
+ group-art
+ (cons
+ (nnselect-artitem-group (nnselect-artlist-article artlist 1))
+ (nnselect-artitem-number (nnselect-artlist-article artlist 1))))))
+ (when (numberp (cdr group-art))
+ (message "Requesting article %d from group %s"
+ (cdr group-art) (car group-art))
+ (if to-buffer
+ (with-current-buffer to-buffer
+ (let ((gnus-article-decode-hook nil))
+ (gnus-request-article-this-buffer
+ (cdr group-art) (car group-art))))
+ (gnus-request-article (cdr group-art) (car group-art)))
+ group-art)))
+
+
+(deffoo nnselect-request-move-article
+ (article _group _server accept-form &optional last _internal-move-group)
+ (let* ((artgroup (nnselect-article-group article))
+ (artnumber (nnselect-article-number article))
+ (to-newsgroup (nth 1 accept-form))
+ (to-method (gnus-find-method-for-group to-newsgroup))
+ (from-method (gnus-find-method-for-group artgroup))
+ (move-is-internal (gnus-server-equal from-method to-method)))
+ (unless (gnus-check-backend-function
+ 'request-move-article artgroup)
+ (error "The group %s does not support article moving" artgroup))
+ (gnus-request-move-article
+ artnumber
+ artgroup
+ (nth 1 from-method)
+ accept-form
+ last
+ (and move-is-internal
+ to-newsgroup ; Not respooling
+ (gnus-group-real-name to-newsgroup)))))
+
+(deffoo nnselect-request-replace-article
+ (article _group buffer &optional no-encode)
+ (pcase-let ((`[,artgroup ,artnumber ,artrsv]
+ (with-current-buffer gnus-summary-buffer
+ (nnselect-artlist-article gnus-newsgroup-selection article))))
+ (unless (gnus-check-backend-function
+ 'request-replace-article artgroup)
+ (user-error "The group %s does not support article editing" artgroup))
+ (let ((newart
+ (gnus-request-replace-article artnumber artgroup buffer no-encode)))
+ (with-current-buffer gnus-summary-buffer
+ (cl-nsubstitute `[,artgroup ,newart ,artrsv]
+ `[,artgroup ,artnumber ,artrsv]
+ gnus-newsgroup-selection
+ :test #'equal :count 1)))))
+
+(deffoo nnselect-request-expire-articles
+ (articles _group &optional _server force)
+ (if force
+ (let (not-expired)
+ (pcase-dolist (`(,artgroup . ,artids) (ids-by-group articles))
+ (let ((artlist (sort (mapcar 'cdr artids) '<)))
+ (unless (gnus-check-backend-function 'request-expire-articles
+ artgroup)
+ (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)))
+ (let ((nnimap-expunge 'immediately))
+ (gnus-request-expire-articles
+ artlist artgroup force)))
+ not-expired)))
+ (sort (delq nil not-expired) '<))
+ articles))
+
+
+(deffoo nnselect-warp-to-article ()
+ (let* ((cur (if (> (gnus-summary-article-number) 0)
+ (gnus-summary-article-number)
+ (error "Can't warp to a pseudo-article")))
+ (artgroup (nnselect-article-group cur))
+ (artnumber (nnselect-article-number cur))
+ (_quit-config (gnus-ephemeral-group-p gnus-newsgroup-name)))
+
+ ;; what should we do here? we could leave all the buffers around
+ ;; and assume that we have to exit from them one by one. or we can
+ ;; try to clean up directly
+
+ ;;first exit from the nnselect summary buffer.
+ ;;(gnus-summary-exit)
+ ;; and if the nnselect summary buffer in turn came from another
+ ;; summary buffer we have to clean that summary up too.
+ ;;(when (not (eq (cdr quit-config) 'group))
+ ;; (gnus-summary-exit))
+ (gnus-summary-read-group-1 artgroup t t nil
+ nil (list artnumber))))
+
+
+;; we pass this through to the real group in case it wants to adjust
+;; the mark. We also use this to mark an article expirable iff it is
+;; expirable in the real group.
+(deffoo nnselect-request-update-mark (_group article mark)
+ (let* ((artgroup (nnselect-article-group article))
+ (artnumber (nnselect-article-number article))
+ (gmark (gnus-request-update-mark artgroup artnumber mark)))
+ (when (and artnumber
+ (memq mark gnus-auto-expirable-marks)
+ (= mark gmark)
+ (gnus-group-auto-expirable-p artgroup))
+ (setq gmark gnus-expirable-mark))
+ gmark))
+
+
+(deffoo nnselect-request-set-mark (_group actions &optional _server)
+ (mapc
+ (lambda (request) (gnus-request-set-mark (car request) (cdr request)))
+ (nnselect-categorize
+ (cl-mapcan
+ (lambda (act)
+ (cl-destructuring-bind (range action marks) act
+ (mapcar
+ (lambda (artgroup)
+ (list (car artgroup)
+ (gnus-compress-sequence (sort (cdr artgroup) '<))
+ action marks))
+ (numbers-by-group range 'range))))
+ actions)
+ 'car 'cdr)))
+
+(deffoo nnselect-request-update-info (group info &optional _server)
+ (let* ((group (nnselect-add-prefix group))
+ (gnus-newsgroup-selection
+ (or gnus-newsgroup-selection (nnselect-get-artlist group)))
+ newmarks)
+ (gnus-info-set-marks info nil)
+ (setf (gnus-info-read info) nil)
+ (pcase-dolist (`(,artgroup . ,nartids)
+ (ids-by-group
+ (number-sequence 1 (nnselect-artlist-length
+ gnus-newsgroup-selection))))
+ (let* ((gnus-newsgroup-active nil)
+ (artids (cl-sort nartids #'< :key 'car))
+ (group-info (gnus-get-info artgroup))
+ (marks (gnus-info-marks group-info))
+ (unread (gnus-uncompress-sequence
+ (gnus-range-difference (gnus-active artgroup)
+ (gnus-info-read group-info)))))
+ (setf (gnus-info-read info)
+ (gnus-add-to-range
+ (gnus-info-read info)
+ (delq nil (mapcar
+ #'(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)
+ (when
+ (setq new
+ (delq nil
+ (cond
+ ((eq mark-type 'tuple)
+ (mapcar
+ #'(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)))))
+ (let ((previous (alist-get type newmarks)))
+ (if previous
+ (nconc previous new)
+ (push (cons type new) newmarks))))))))
+
+ ;; Clean up the marks: compress lists;
+ (pcase-dolist (`(,type . ,mark-list) newmarks)
+ (let ((mark-type (gnus-article-mark-to-type type)))
+ (unless (eq mark-type 'tuple)
+ (setf (alist-get type newmarks)
+ (gnus-compress-sequence mark-list)))))
+ ;; and ensure an unexist key.
+ (unless (assq 'unexist newmarks)
+ (push (cons 'unexist nil) newmarks))
+
+ (gnus-info-set-marks info newmarks)
+ (gnus-set-active group (cons 1 (nnselect-artlist-length
+ gnus-newsgroup-selection)))))
+
+
+(deffoo nnselect-request-thread (header &optional group server)
+ (with-current-buffer gnus-summary-buffer
+ (let ((group (nnselect-add-prefix group))
+ ;; find the best group for the originating article. if its a
+ ;; pseudo-article look for real articles in the same thread
+ ;; and see where they come from.
+ (artgroup (nnselect-article-group
+ (if (> (mail-header-number header) 0)
+ (mail-header-number header)
+ (if (> (gnus-summary-article-number) 0)
+ (gnus-summary-article-number)
+ (let ((thread
+ (gnus-id-to-thread (mail-header-id header))))
+ (when thread
+ (cl-some #'(lambda (x)
+ (when (and x (> x 0)) x))
+ (gnus-articles-in-thread thread)))))))))
+ ;; Check if we are dealing with an imap backend.
+ (if (eq 'nnimap
+ (car (gnus-find-method-for-group artgroup)))
+ ;; If so we perform the query, massage the result, and return
+ ;; the new headers back to the caller to incorporate into the
+ ;; current summary buffer.
+ (let* ((group-spec
+ (list (delq nil (list
+ (or server (gnus-group-server artgroup))
+ (unless gnus-refer-thread-use-search
+ artgroup)))))
+ (query-spec
+ (list (cons 'query (nnimap-make-thread-query header))
+ (cons 'criteria "")))
+ (last (nnselect-artlist-length gnus-newsgroup-selection))
+ (first (1+ last))
+ (new-nnselect-artlist
+ (nnir-run-query
+ (list (cons 'nnir-query-spec query-spec)
+ (cons 'nnir-group-spec group-spec))))
+ 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)))
+ new-nnselect-artlist)
+ (setq headers
+ (gnus-fetch-headers
+ (append (sort old-arts '<)
+ (number-sequence first last)) nil t))
+ (gnus-group-set-parameter
+ group
+ 'nnselect-artlist
+ (nnselect-compress-artlist gnus-newsgroup-selection))
+ (when (>= last first)
+ (let (new-marks)
+ (pcase-dolist (`(,artgroup . ,artids)
+ (ids-by-group (number-sequence first last)))
+ (pcase-dolist (`(,type . ,marked)
+ (gnus-info-marks (gnus-get-info artgroup)))
+ (setq marked (gnus-uncompress-sequence marked))
+ (when (setq new-marks
+ (delq nil
+ (mapcar
+ #'(lambda (art)
+ (when (memq (cdr art) marked)
+ (car art)))
+ artids)))
+ (nconc
+ (symbol-value
+ (intern
+ (format "gnus-newsgroup-%s"
+ (car (rassq type gnus-article-mark-lists)))))
+ new-marks)))))
+ (setq gnus-newsgroup-active
+ (cons 1 (nnselect-artlist-length gnus-newsgroup-selection)))
+ (gnus-set-active
+ group
+ (cons 1 (nnselect-artlist-length gnus-newsgroup-selection))))
+ headers)
+ ;; If not an imap backend just warp to the original article
+ ;; group and punt back to gnus-summary-refer-thread.
+ (and (gnus-warp-to-article) (gnus-summary-refer-thread))))))
+
+
+(deffoo nnselect-close-group (group &optional _server)
+ (let ((group (nnselect-add-prefix group)))
+ (unless gnus-group-is-exiting-without-update-p
+ (nnselect-push-info group))
+ (setq gnus-newsgroup-selection nil)
+ (when (gnus-ephemeral-group-p group)
+ (gnus-kill-ephemeral-group group)
+ (setq gnus-ephemeral-servers
+ (assq-delete-all 'nnselect gnus-ephemeral-servers)))))
+
+
+(deffoo nnselect-request-create-group (group &optional _server args)
+ (message "Creating nnselect group %s" group)
+ (let* ((group (gnus-group-prefixed-name group '(nnselect "nnselect")))
+ (specs (assq 'nnselect-specs args))
+ (function-spec
+ (or (alist-get 'nnselect-function specs)
+ (intern (completing-read "Function: " obarray #'functionp))))
+ (args-spec
+ (or (alist-get 'nnselect-args specs)
+ (read-from-minibuffer "Args: " nil nil t nil "nil")))
+ (nnselect-specs (list (cons 'nnselect-function function-spec)
+ (cons 'nnselect-args args-spec))))
+ (gnus-group-set-parameter group 'nnselect-specs nnselect-specs)
+ (gnus-group-set-parameter
+ group 'nnselect-artlist
+ (nnselect-compress-artlist (or (alist-get 'nnselect-artlist args)
+ (nnselect-run nnselect-specs))))
+ (nnselect-request-update-info group (gnus-get-info group)))
+ t)
+
+
+(deffoo nnselect-request-type (_group &optional article)
+ (if (and (numberp article) (> article 0))
+ (gnus-request-type
+ (nnselect-article-group article) (nnselect-article-number article))
+ 'unknown))
+
+(deffoo nnselect-request-post (&optional _server)
+ (if (not gnus-message-group-art)
+ (nnheader-report 'nnselect "Can't post to an nnselect group")
+ (gnus-request-post
+ (gnus-find-method-for-group
+ (nnselect-article-group (cdr gnus-message-group-art))))))
+
+
+(deffoo nnselect-request-rename-group (_group _new-name &optional _server)
+ t)
+
+
+(deffoo nnselect-request-scan (group _method)
+ (when (and group
+ (gnus-group-get-parameter (nnselect-add-prefix group)
+ 'nnselect-rescan t))
+ (nnselect-request-group-scan group)))
+
+
+(deffoo nnselect-request-group-scan (group &optional _server _info)
+ (let* ((group (nnselect-add-prefix group))
+ (artlist (nnselect-run
+ (gnus-group-get-parameter group 'nnselect-specs t))))
+ (gnus-set-active group (cons 1 (nnselect-artlist-length
+ artlist)))
+ (gnus-group-set-parameter
+ group 'nnselect-artlist
+ (nnselect-compress-artlist artlist))))
+
+;; Add any undefined required backend functions
+
+;; (nnoo-define-skeleton nnselect)
+
+;;; Util Code:
+
+(defun gnus-nnselect-group-p (group)
+ "Say whether GROUP is nnselect or not."
+ (or (and (gnus-group-prefixed-p group)
+ (eq 'nnselect (car (gnus-find-method-for-group group))))
+ (eq 'nnselect (car gnus-command-method))))
+
+
+(defun nnselect-run (specs)
+ "Apply nnselect-function to nnselect-args from SPECS.
+Return an article list."
+ (let ((func (alist-get 'nnselect-function specs))
+ (args (alist-get 'nnselect-args specs)))
+ (funcall func args)))
+
+
+(defun nnselect-search-thread (header)
+ "Make an nnselect group containing the thread with article HEADER.
+The current server will be searched. If the registry is
+installed, the server that the registry reports the current
+article came from is also searched."
+ (let* ((query
+ (list (cons 'query (nnimap-make-thread-query header))
+ (cons 'criteria "")))
+ (server
+ (list (list (gnus-method-to-server
+ (gnus-find-method-for-group gnus-newsgroup-name)))))
+ (registry-group (and
+ (bound-and-true-p gnus-registry-enabled)
+ (car (gnus-registry-get-id-key
+ (mail-header-id header) 'group))))
+ (registry-server
+ (and registry-group
+ (gnus-method-to-server
+ (gnus-find-method-for-group registry-group)))))
+ (when registry-server (cl-pushnew (list registry-server) server
+ :test 'equal))
+ (gnus-group-read-ephemeral-group
+ (concat "nnselect-" (message-unique-id))
+ (list 'nnselect "nnselect")
+ nil
+ (cons (current-buffer) gnus-current-window-configuration)
+ ; nil
+ nil nil
+ (list
+ (cons 'nnselect-specs
+ (list
+ (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-args
+ (list (cons 'nnir-query-spec query)
+ (cons 'nnir-group-spec server)))))
+ (cons 'nnselect-artlist nil)))
+ (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
+
+
+
+(defun nnselect-push-info (group)
+ "Copy mark-lists from GROUP to the originating groups."
+ (let ((select-unreads (numbers-by-group gnus-newsgroup-unreads))
+ (select-reads (numbers-by-group
+ (gnus-info-read (gnus-get-info group)) 'range))
+ (select-unseen (numbers-by-group gnus-newsgroup-unseen))
+ (gnus-newsgroup-active nil) mark-list)
+ ;; collect the set of marked article lists categorized by
+ ;; originating groups
+ (pcase-dolist (`(,mark . ,type) gnus-article-mark-lists)
+ (let (type-list)
+ (when (setq type-list
+ (symbol-value (intern (format "gnus-newsgroup-%s" mark))))
+ (push (cons
+ type
+ (numbers-by-group type-list (gnus-article-mark-to-type type)))
+ mark-list))))
+ ;; now work on each originating group one at a time
+ (pcase-dolist (`(,artgroup . ,artlist)
+ (numbers-by-group gnus-newsgroup-articles))
+ (let* ((group-info (gnus-get-info artgroup))
+ (old-unread (gnus-list-of-unread-articles artgroup))
+ newmarked delta-marks)
+ (when group-info
+ ;; iterate over mark lists for this group
+ (pcase-dolist (`(,_mark . ,type) gnus-article-mark-lists)
+ (let ((list (cdr (assoc artgroup (alist-get type mark-list))))
+ (mark-type (gnus-article-mark-to-type type)))
+
+ ;; When the backend can store marks we collect any
+ ;; changes. Unlike a normal group the mark lists only
+ ;; include marks for articles we retrieved.
+ (when (and (gnus-check-backend-function
+ 'request-set-mark artgroup)
+ (not (gnus-article-unpropagatable-p type)))
+ (let* ((old (gnus-list-range-intersection
+ artlist
+ (alist-get type (gnus-info-marks group-info))))
+ (del (gnus-remove-from-range (copy-tree old) list))
+ (add (gnus-remove-from-range (copy-tree list) old)))
+ (when add (push (list add 'add (list type)) delta-marks))
+ (when del
+ ;; Don't delete marks from outside the active range.
+ ;; This shouldn't happen, but is a sanity check.
+ (setq del (gnus-sorted-range-intersection
+ (gnus-active artgroup) del))
+ (push (list del 'del (list type)) delta-marks))))
+
+ ;; Marked sets are of mark-type 'tuple, 'list, or
+ ;; 'range. We merge the lists with what is already in
+ ;; the original info to get full list of new marks. We
+ ;; do this by removing all the articles we retrieved
+ ;; from the full list, and then add back in the newly
+ ;; marked ones.
+ (cond
+ ((eq mark-type 'tuple)
+ ;; Get rid of the entries that have the default
+ ;; score.
+ (when (and list (eq type 'score) gnus-save-score)
+ (let* ((arts list)
+ (prev (cons nil list))
+ (all prev))
+ (while arts
+ (if (or (not (consp (car arts)))
+ (= (cdar arts) gnus-summary-default-score))
+ (setcdr prev (cdr arts))
+ (setq prev arts))
+ (setq arts (cdr arts)))
+ (setq list (cdr all))))
+ ;; now merge with the original list and sort just to
+ ;; make sure
+ (setq list
+ (sort (map-merge
+ 'list list
+ (alist-get type (gnus-info-marks group-info)))
+ (lambda (elt1 elt2)
+ (< (car elt1) (car elt2))))))
+ (t
+ (setq list
+ (gnus-compress-sequence
+ (gnus-sorted-union
+ (gnus-sorted-difference
+ (gnus-uncompress-sequence
+ (alist-get type (gnus-info-marks group-info)))
+ artlist)
+ (sort list #'<)) t)))
+
+ ;; When exiting the group, everything that's previously been
+ ;; unseen is now seen.
+ (when (eq type 'seen)
+ (setq list (gnus-range-add
+ list (cdr (assoc artgroup select-unseen))))))
+
+ (when (or list (eq type 'unexist))
+ (push (cons type list) newmarked)))) ;; end of mark-type loop
+
+ (when delta-marks
+ (unless (gnus-check-group artgroup)
+ (error "Can't open server for %s" artgroup))
+ (gnus-request-set-mark artgroup delta-marks))
+
+ (gnus-atomic-progn
+ (gnus-info-set-marks group-info newmarked)
+ ;; Cut off the end of the info if there's nothing else there.
+ (let ((i 5))
+ (while (and (> i 2)
+ (not (nth i group-info)))
+ (when (nthcdr (cl-decf i) group-info)
+ (setcdr (nthcdr i group-info) nil))))
+
+ ;; update read and unread
+ (gnus-update-read-articles
+ artgroup
+ (gnus-uncompress-range
+ (gnus-add-to-range
+ (gnus-remove-from-range
+ old-unread
+ (cdr (assoc artgroup select-reads)))
+ (sort (cdr (assoc artgroup select-unreads)) '<))))
+ (gnus-get-unread-articles-in-group
+ group-info (gnus-active artgroup) t)
+ (gnus-group-update-group artgroup t t)))))))
+
+
+(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
+
+(defun gnus-summary-make-search-group (nnir-extra-parms)
+ "Search a group from the summary buffer.
+Pass NNIR-EXTRA-PARMS on to the search engine."
+ (interactive "P")
+ (gnus-warp-to-article)
+ (let ((spec
+ (list
+ (cons 'nnir-group-spec
+ (list (list
+ (gnus-group-server gnus-newsgroup-name)
+ gnus-newsgroup-name))))))
+ (gnus-group-make-search-group nnir-extra-parms spec)))
+
+
+;; The end.
+(provide 'nnselect)
+
+;;; nnselect.el ends here
diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el
index 33b68fa989e..0b6bba5fea7 100644
--- a/lisp/gnus/nnspool.el
+++ b/lisp/gnus/nnspool.el
@@ -422,7 +422,7 @@ there.")
(nnspool-article-pathname nnspool-current-group article))
(nnheader-insert-article-line article)
(goto-char (point-min))
- (let ((headers (nnheader-parse-head)))
+ (let ((headers (nnheader-parse-head nil t)))
(set-buffer cur)
(goto-char (point-max))
(nnheader-insert-nov headers)))
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 6ce8724cbbb..a5c82447926 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -309,7 +309,7 @@ backend doesn't catch this error.")
(defun nntp-record-command (string)
"Record the command STRING."
- (with-current-buffer (get-buffer-create "*nntp-log*")
+ (with-current-buffer (gnus-get-buffer-create "*nntp-log*")
(goto-char (point-max))
(insert (format-time-string "%Y%m%dT%H%M%S.%3N")
" " nntp-address " " string "\n")))
@@ -1247,8 +1247,8 @@ If SEND-IF-FORCE, only send authinfo to the server if the
(and nntp-connection-timeout
(run-at-time
nntp-connection-timeout nil
- `(lambda ()
- (nntp-kill-buffer ,pbuffer)))))
+ (lambda ()
+ (nntp-kill-buffer pbuffer)))))
(process
(condition-case err
(let ((coding-system-for-read 'binary)
@@ -1263,7 +1263,17 @@ If SEND-IF-FORCE, only send authinfo to the server if the
"nntpd" pbuffer nntp-address nntp-port-number
:type (cadr (assoc nntp-open-connection-function map))
:end-of-command "^\\([2345]\\|[.]\\).*\n"
- :capability-command "HELP\r\n"
+ :capability-command
+ (lambda (greeting)
+ (if (and greeting
+ (string-match "Typhoon" greeting))
+ ;; Certain versions of the Typhoon server
+ ;; doesn't understand the CAPABILITIES
+ ;; command, but includes the capability
+ ;; data in the HELP command instead.
+ "HELP\r\n"
+ ;; Use the correct command for everything else.
+ "CAPABILITIES\r\n"))
:success "^3"
:starttls-function
(lambda (capabilities)
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index e1290a9c774..54c2f7be820 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -97,7 +97,7 @@ component group will show up when you enter the virtual group.")
(if (stringp (car articles))
'headers
(let ((vbuf (nnheader-set-temp-buffer
- (get-buffer-create " *virtual headers*")))
+ (gnus-get-buffer-create " *virtual headers*")))
(carticles (nnvirtual-partition-sequence articles))
(sysname (system-name))
cgroup carticle article result prefix)
diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el
index d41f32801ee..5504a520783 100644
--- a/lisp/gnus/smiley.el
+++ b/lisp/gnus/smiley.el
@@ -56,14 +56,11 @@
(defvar smiley-data-directory)
-(defcustom smiley-style
- (if (and (fboundp 'face-attribute)
- ;; In batch mode, attributes can be unspecified.
- (condition-case nil
- (>= (face-attribute 'default :height) 160)
- (error nil)))
- 'medium
- 'low-color)
+;; In batch mode, attributes can be unspecified.
+(defcustom smiley-style (if (ignore-errors
+ (>= (face-attribute 'default :height) 160))
+ 'medium
+ 'low-color)
"Smiley style."
:type '(choice (const :tag "small, 3 colors" low-color) ;; 13x14
(const :tag "medium, ~10 colors" medium) ;; 16x16
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index fe6daf6b037..eb27fee88ce 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -174,8 +174,9 @@ and the files themselves should be in PEM format."
(eq 0 (call-process "openssl" nil nil nil "version"))
(error nil))
"openssl")
- "Name of OpenSSL binary."
- :type 'string
+ "Name of OpenSSL binary or nil if none."
+ :type '(choice string
+ (const :tag "none" nil))
:group 'smime)
;; OpenSSL option to select the encryption cipher
@@ -185,6 +186,9 @@ and the files themselves should be in PEM format."
:version "22.1"
:type '(choice (const :tag "Triple DES" "-des3")
(const :tag "DES" "-des")
+ (const :tag "AES 256 bits" "-aes256")
+ (const :tag "AES 192 bits" "-aes192")
+ (const :tag "AES 128 bits" "-aes128")
(const :tag "RC2 40 bits" "-rc2-40")
(const :tag "RC2 64 bits" "-rc2-64")
(const :tag "RC2 128 bits" "-rc2-128"))
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index 3da45a2b623..bf593865d72 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -4,7 +4,7 @@
;; Author: Alex Schroeder <alex@gnu.org>
;; Keywords: network
-;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SpamStat
+;; URL: https://www.emacswiki.org/cgi-bin/wiki.pl?SpamStat
;; This file is part of GNU Emacs.
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index 5632bdaf250..96a7da2313c 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -579,7 +579,7 @@ This must be a list. For example, `(\"-C\" \"configfile\")'."
(defcustom spam-spamassassin-positive-spam-flag-header "YES"
"The regex on `spam-spamassassin-spam-flag-header' for positive spam
identification."
- :type 'string
+ :type 'regexp
:group 'spam-spamassassin)
(defcustom spam-spamassassin-spam-status-header "X-Spam-Status"
diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el
index dead1f6bf77..1d9e051a8cf 100644
--- a/lisp/help-at-pt.el
+++ b/lisp/help-at-pt.el
@@ -92,13 +92,16 @@ the `kbd-help' property at point. If `kbd-help' does not produce
a string, but the `help-echo' property does, then that string is
printed instead.
+The string is passed through `substitute-command-keys' before it
+is displayed.
+
A numeric argument ARG prevents display of a message in case
there is no help. While ARG can be used interactively, it is
mainly meant for use from Lisp."
(interactive "P")
(let ((help (help-at-pt-kbd-string)))
(if help
- (message "%s" help)
+ (message "%s" (substitute-command-keys help))
(if (not arg) (message "No local help at point")))))
(defvar help-at-pt-timer nil
@@ -162,6 +165,10 @@ included in this list. Suggested properties are `keymap',
`local-map', `button' and `kbd-help'. Any value other than t or
a non-empty list disables the feature.
+The text printed from the `help-echo' property is often only
+relevant when using the mouse. The presence of a `kbd-help'
+property guarantees that non mouse specific help is available.
+
This variable only takes effect after a call to
`help-at-pt-set-timer'. The help gets printed after Emacs has
been idle for `help-at-pt-timer-delay' seconds. You can call
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index c7d0112cb61..24fb09137c2 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -151,9 +151,7 @@ When called from lisp, FUNCTION may also be a function object."
(let* ((fn (function-called-at-point))
(enable-recursive-minibuffers t)
(val (completing-read
- (if fn
- (format "Describe function (default %s): " fn)
- "Describe function: ")
+ (format-prompt "Describe function" fn)
#'help--symbol-completion-table
(lambda (f) (or (fboundp f) (get f 'function-documentation)))
t nil nil
@@ -364,6 +362,7 @@ suitable file is found, return nil."
(help-C-file-name type 'subr)
'C-source))
((and (not file-name) (symbolp object)
+ (eq type 'defvar)
(integerp (get object 'variable-documentation)))
;; A variable defined in C. The form is from `describe-variable'.
(if (get-buffer " *DOC*")
@@ -623,7 +622,7 @@ FILE is the file where FUNCTION was probably defined."
;; of the *packages* in which the function is defined.
(let* ((name (symbol-name symbol))
(re (concat "\\_<" (regexp-quote name) "\\_>"))
- (news (directory-files data-directory t "\\`NEWS\\.[1-9]"))
+ (news (directory-files data-directory t "\\`NEWS\\($\\|\\.\\)"))
(place nil)
(first nil))
(with-temp-buffer
@@ -647,8 +646,7 @@ FILE is the file where FUNCTION was probably defined."
(setq place (list f pos))
(setq first version)))))))))
(when first
- (make-text-button first nil 'type 'help-news 'help-args place))
- first))
+ (make-text-button first nil 'type 'help-news 'help-args place))))
(add-hook 'help-fns-describe-function-functions
#'help-fns--mention-first-release)
@@ -893,7 +891,7 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound."
(output nil))
(if custom-version
(setq output
- (format "This %s was introduced, or its default value was changed, in\nversion %s of Emacs.\n"
+ (format " This %s was introduced, or its default value was changed, in\n version %s of Emacs.\n"
type custom-version))
(when cpv
(let* ((package (car-safe cpv))
@@ -904,7 +902,7 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound."
(emacsv (cdr (assoc version pkg-versions))))
(if (and package version)
(setq output
- (format (concat "This %s was introduced, or its default value was changed, in\nversion %s of the %s package"
+ (format (concat " This %s was introduced, or its default value was changed, in\n version %s of the %s package"
(if emacsv
(format " that is part of Emacs %s" emacsv))
".\n")
@@ -924,10 +922,7 @@ it is displayed along with the global value."
(orig-buffer (current-buffer))
val)
(setq val (completing-read
- (if (symbolp v)
- (format
- "Describe variable (default %s): " v)
- "Describe variable: ")
+ (format-prompt "Describe variable" (and (symbolp v) v))
#'help--symbol-completion-table
(lambda (vv)
;; In case the variable only exists in the buffer
@@ -944,7 +939,7 @@ it is displayed along with the global value."
(unless (buffer-live-p buffer) (setq buffer (current-buffer)))
(unless (frame-live-p frame) (setq frame (selected-frame)))
(if (not (symbolp variable))
- (message "You did not specify a variable")
+ (user-error "You didn't specify a variable")
(save-excursion
(let ((valvoid (not (with-current-buffer buffer (boundp variable))))
val val-start-pos locus)
@@ -968,7 +963,7 @@ it is displayed along with the global value."
" is a variable defined in `%s'.\n"
(if (eq file-name 'C-source)
"C source code"
- (file-name-nondirectory file-name))))
+ (help-fns-short-filename file-name))))
(with-current-buffer standard-output
(save-excursion
(re-search-backward (substitute-command-keys
@@ -1125,8 +1120,8 @@ it is displayed along with the global value."
;; Note variable's version or package version.
(let ((output (describe-variable-custom-version-info variable)))
(when output
- (terpri)
- (terpri)
+ ;; (terpri)
+ ;; (terpri)
(princ output)))))
(add-hook 'help-fns-describe-variable-functions #'help-fns--var-safe-local)
@@ -1352,7 +1347,7 @@ If FRAME is omitted or nil, use the selected frame."
(setq file-name (find-lisp-object-file-name f 'defface))
(when file-name
(princ (substitute-command-keys "Defined in `"))
- (princ (file-name-nondirectory file-name))
+ (princ (help-fns-short-filename file-name))
(princ (substitute-command-keys "'"))
;; Make a hyperlink to the library.
(save-excursion
@@ -1424,10 +1419,8 @@ current buffer and the selected frame, respectively."
(v-or-f (if found v-or-f (function-called-at-point)))
(found (or found v-or-f))
(enable-recursive-minibuffers t)
- (val (completing-read (if found
- (format
- "Describe symbol (default %s): " v-or-f)
- "Describe symbol: ")
+ (val (completing-read (format-prompt "Describe symbol"
+ (and found v-or-f))
#'help--symbol-completion-table
(lambda (vv)
(cl-some (lambda (x) (funcall (nth 1 x) vv))
@@ -1435,7 +1428,7 @@ current buffer and the selected frame, respectively."
t nil nil
(if found (symbol-name v-or-f)))))
(list (if (equal val "")
- v-or-f (intern val)))))
+ (or v-or-f "") (intern val)))))
(if (not (symbolp symbol))
(user-error "You didn't specify a function or variable"))
(unless (buffer-live-p buffer) (setq buffer (current-buffer)))
@@ -1564,7 +1557,256 @@ BUFFER should be a buffer or a buffer name."
(insert "\nThe parent category table is:")
(describe-vector table 'help-describe-category-set))))))
+(defun help-fns-find-keymap-name (keymap)
+ "Find the name of the variable with value KEYMAP.
+Return nil if KEYMAP is not a valid keymap, or if there is no
+variable with value KEYMAP."
+ (when (keymapp keymap)
+ (let ((name (catch 'found-keymap
+ (mapatoms (lambda (symb)
+ (when (and (boundp symb)
+ (eq (symbol-value symb) keymap)
+ (not (eq symb 'keymap))
+ (throw 'found-keymap symb)))))
+ nil)))
+ ;; Follow aliasing.
+ (or (ignore-errors (indirect-variable name)) name))))
+
+(defun help-fns--most-relevant-active-keymap ()
+ "Return the name of the most relevant active keymap.
+The heuristic to determine which keymap is most likely to be
+relevant to a user follows this order:
+
+1. 'keymap' text property at point
+2. 'local-map' text property at point
+3. the `current-local-map'
+
+This is used to set the default value for the interactive prompt
+in `describe-keymap'. See also `Searching the Active Keymaps'."
+ (help-fns-find-keymap-name (or (get-char-property (point) 'keymap)
+ (if (get-text-property (point) 'local-map)
+ (get-char-property (point) 'local-map)
+ (current-local-map)))))
+
+;;;###autoload
+(defun describe-keymap (keymap)
+ "Describe key bindings in KEYMAP.
+When called interactively, prompt for a variable that has a
+keymap value."
+ (interactive
+ (let* ((km (help-fns--most-relevant-active-keymap))
+ (val (completing-read
+ (format-prompt "Keymap" km)
+ obarray
+ (lambda (m) (and (boundp m) (keymapp (symbol-value m))))
+ t nil 'keymap-name-history
+ (symbol-name km))))
+ (unless (equal val "")
+ (setq km (intern val)))
+ (unless (and km (keymapp (symbol-value km)))
+ (user-error "Not a keymap: %s" km))
+ (list km)))
+ (let (used-gentemp)
+ (unless (and (symbolp keymap)
+ (boundp keymap)
+ (keymapp (symbol-value keymap)))
+ (when (not (keymapp keymap))
+ (if (symbolp keymap)
+ (error "Not a keymap variable: %S" keymap)
+ (error "Not a keymap")))
+ (let ((sym nil))
+ (unless sym
+ (setq sym (cl-gentemp "KEYMAP OBJECT (no variable) "))
+ (setq used-gentemp t)
+ (set sym keymap))
+ (setq keymap sym)))
+ ;; Follow aliasing.
+ (setq keymap (or (ignore-errors (indirect-variable keymap)) keymap))
+ (help-setup-xref (list #'describe-keymap keymap)
+ (called-interactively-p 'interactive))
+ (let* ((name (symbol-name keymap))
+ (doc (documentation-property keymap 'variable-documentation))
+ (file-name (find-lisp-object-file-name keymap 'defvar)))
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (unless used-gentemp
+ (princ (format-message "%S is a keymap variable" keymap))
+ (if (not file-name)
+ (princ ".\n\n")
+ (princ (format-message
+ " defined in `%s'.\n\n"
+ (if (eq file-name 'C-source)
+ "C source code"
+ (help-fns-short-filename file-name))))
+ (save-excursion
+ (re-search-backward (substitute-command-keys
+ "`\\([^`']+\\)'")
+ nil t)
+ (help-xref-button 1 'help-variable-def
+ keymap file-name))))
+ (when (and (not (equal "" doc)) doc)
+ (princ "Documentation:\n")
+ (princ (format-message "%s\n\n" doc)))
+ ;; Use `insert' instead of `princ', so control chars (e.g. \377)
+ ;; insert correctly.
+ (insert (substitute-command-keys (concat "\\{" name "}"))))))
+ ;; Cleanup.
+ (when used-gentemp
+ (makunbound keymap))))
+;;;###autoload
+(defun describe-mode (&optional buffer)
+ "Display documentation of current major mode and minor modes.
+A brief summary of the minor modes comes first, followed by the
+major mode description. This is followed by detailed
+descriptions of the minor modes, each on a separate page.
+
+For this to work correctly for a minor mode, the mode's indicator
+variable \(listed in `minor-mode-alist') must also be a function
+whose documentation describes the minor mode.
+
+If called from Lisp with a non-nil BUFFER argument, display
+documentation for the major and minor modes of that buffer."
+ (interactive "@")
+ (unless buffer (setq buffer (current-buffer)))
+ (help-setup-xref (list #'describe-mode buffer)
+ (called-interactively-p 'interactive))
+ ;; For the sake of help-do-xref and help-xref-go-back,
+ ;; don't switch buffers before calling `help-buffer'.
+ (with-help-window (help-buffer)
+ (with-current-buffer buffer
+ (let (minor-modes)
+ ;; Older packages do not register in minor-mode-list but only in
+ ;; minor-mode-alist.
+ (dolist (x minor-mode-alist)
+ (setq x (car x))
+ (unless (memq x minor-mode-list)
+ (push x minor-mode-list)))
+ ;; Find enabled minor mode we will want to mention.
+ (dolist (mode minor-mode-list)
+ ;; Document a minor mode if it is listed in minor-mode-alist,
+ ;; non-nil, and has a function definition.
+ (let ((fmode (or (get mode :minor-mode-function) mode)))
+ (and (boundp mode) (symbol-value mode)
+ (fboundp fmode)
+ (let ((pretty-minor-mode
+ (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
+ (symbol-name fmode))
+ (capitalize
+ (substring (symbol-name fmode)
+ 0 (match-beginning 0)))
+ fmode)))
+ (push (list fmode pretty-minor-mode
+ (format-mode-line (assq mode minor-mode-alist)))
+ minor-modes)))))
+ ;; 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
+ (lambda (a b) (string-lessp (cadr a) (cadr b)))))
+ (when minor-modes
+ (princ "Enabled minor modes:\n")
+ (make-local-variable 'help-button-cache)
+ (with-current-buffer standard-output
+ (dolist (mode minor-modes)
+ (let ((mode-function (nth 0 mode))
+ (pretty-minor-mode (nth 1 mode))
+ (indicator (nth 2 mode)))
+ (save-excursion
+ (goto-char (point-max))
+ (princ "\n\f\n")
+ (push (point-marker) help-button-cache)
+ ;; Document the minor modes fully.
+ (insert-text-button
+ pretty-minor-mode 'type 'help-function
+ 'help-args (list mode-function)
+ 'button '(t))
+ (princ (format " minor mode (%s):\n"
+ (if (zerop (length indicator))
+ "no indicator"
+ (format "indicator%s"
+ indicator))))
+ (princ (help-split-fundoc (documentation mode-function)
+ nil 'doc)))
+ (insert-button pretty-minor-mode
+ 'action (car help-button-cache)
+ 'follow-link t
+ 'help-echo "mouse-2, RET: show full information")
+ (newline)))
+ (forward-line -1)
+ (fill-paragraph nil)
+ (forward-line 1))
+
+ (princ "\n(Information about these minor modes follows the major mode info.)\n\n"))
+ ;; Document the major mode.
+ (let ((mode mode-name))
+ (with-current-buffer standard-output
+ (let ((start (point)))
+ (insert (format-mode-line mode nil nil buffer))
+ (add-text-properties start (point) '(face bold)))))
+ (princ " mode")
+ (let* ((mode major-mode)
+ (file-name (find-lisp-object-file-name mode nil)))
+ (when file-name
+ (princ (format-message " defined in `%s'"
+ (help-fns-short-filename file-name)))
+ ;; Make a hyperlink to the library.
+ (with-current-buffer standard-output
+ (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)))))
+ ;; For the sake of IELM and maybe others
+ nil)
+
+;; Widgets.
+
+(defvar describe-widget-functions
+ '(button-describe widget-describe)
+ "A list of functions for `describe-widget' to call.
+Each function should take one argument, a buffer position, and return
+non-nil if it described a widget at that position.")
+
+;;;###autoload
+(defun describe-widget (&optional pos)
+ "Display a buffer with information about a widget.
+You can use this command to describe buttons (e.g., the links in a *Help*
+buffer), editable fields of the customization buffers, etc.
+
+Interactively, click on a widget to describe it, or hit RET to describe the
+widget at point.
+
+When called from Lisp, POS may be a buffer position or a mouse position list.
+
+Calls each function of the list `describe-widget-functions' in turn, until
+one of them returns non-nil."
+ (interactive
+ (list
+ (let ((key
+ (read-key
+ "Click on a widget, or hit RET to describe the widget at point")))
+ (cond ((eq key ?\C-m) (point))
+ ((and (mouse-event-p key)
+ (eq (event-basic-type key) 'mouse-1)
+ (equal (event-modifiers key) '(click)))
+ (event-end key))
+ ((eq key ?\C-g) (signal 'quit nil))
+ (t (user-error "You didn't specify a widget"))))))
+ (let (buf)
+ ;; Allow describing a widget in a different window.
+ (when (posnp pos)
+ (setq buf (window-buffer (posn-window pos))
+ pos (posn-point pos)))
+ (with-current-buffer (or buf (current-buffer))
+ (unless (cl-some (lambda (fun) (when (fboundp fun) (funcall fun pos)))
+ describe-widget-functions)
+ (message "No widget found at that position")))))
+
+
;;; Replacements for old lib-src/ programs. Don't seem especially useful.
;; Replaces lib-src/digest-doc.c.
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index bae8281147a..0dc6c9ffae0 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -1,4 +1,4 @@
-;;; help-mode.el --- `help-mode' used by *Help* buffers
+;;; help-mode.el --- `help-mode' used by *Help* buffers -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1986, 1993-1994, 1998-2020 Free Software
;; Foundation, Inc.
@@ -47,10 +47,10 @@
(define-key map "\C-c\C-c" 'help-follow-symbol)
(define-key map "\r" 'help-follow)
map)
- "Keymap for help mode.")
+ "Keymap for Help mode.")
(easy-menu-define help-mode-menu help-mode-map
- "Menu for Help Mode."
+ "Menu for Help mode."
'("Help-Mode"
["Show Help for Symbol" help-follow-symbol
:help "Show the docs for the symbol at point"]
@@ -308,7 +308,7 @@ The format is (FUNCTION ARGS...).")
:supertype 'help-xref
'help-function
(lambda (file pos)
- (pop-to-buffer (find-file-noselect file))
+ (view-buffer-other-window (find-file-noselect file))
(goto-char pos))
'help-echo (purecopy "mouse-2, RET: show corresponding NEWS announcement"))
@@ -327,13 +327,13 @@ Commands:
;;;###autoload
(defun help-mode-setup ()
- "Enter Help Mode in the current buffer."
+ "Enter Help mode in the current buffer."
(help-mode)
(setq buffer-read-only nil))
;;;###autoload
(defun help-mode-finish ()
- "Finalize Help Mode setup in current buffer."
+ "Finalize Help mode setup in current buffer."
(when (derived-mode-p 'help-mode)
(setq buffer-read-only t)
(help-make-xrefs (current-buffer))))
@@ -719,7 +719,8 @@ a proper [back] button."
;; There is a reference at point. Follow it.
(let ((help-xref-following t))
(apply function (if (eq function 'info)
- (append args (list (generate-new-buffer-name "*info*"))) args))))
+ (append args (list (generate-new-buffer-name "*info*")))
+ args))))
;; The doc string is meant to explain what buttons do.
(defun help-follow-mouse ()
diff --git a/lisp/help.el b/lisp/help.el
index c276c1dc280..edef78d2075 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -131,7 +131,6 @@ This is a list
(WINDOW . quit-window) do quit-window, then select WINDOW.
(WINDOW BUF START POINT) display BUF at START, POINT, then select WINDOW.")
-(define-obsolete-function-alias 'print-help-return-message 'help-print-return-message "23.2")
(defun help-print-return-message (&optional function)
"Display or return message saying how to restore windows after help command.
This function assumes that `standard-output' is the help buffer.
@@ -365,7 +364,7 @@ With argument, display info only for the selected version."
(sort (delete-dups res) #'string>)))
(current (car all-versions)))
(setq version (completing-read
- (format "Read NEWS for the version (default %s): " current)
+ (format-prompt "Read NEWS for the version" current)
all-versions nil nil nil nil current))
(if (integerp (string-to-number version))
(setq version (string-to-number version))
@@ -459,6 +458,7 @@ the variable `message-log-max'."
"Display last few input keystrokes and the commands run.
For convenience this uses the same format as
`edit-last-kbd-macro'.
+See `lossage-size' to update the number of recorded keystrokes.
To record all your input, use `open-dribble-file'."
(interactive)
@@ -534,12 +534,9 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
(let ((fn (function-called-at-point))
(enable-recursive-minibuffers t)
val)
- (setq val (completing-read
- (if fn
- (format "Where is command (default %s): " fn)
- "Where is command: ")
- obarray 'commandp t nil nil
- (and fn (symbol-name fn))))
+ (setq val (completing-read (format-prompt "Where is command" fn)
+ obarray 'commandp t nil nil
+ (and fn (symbol-name fn))))
(list (unless (equal val "") (intern val))
current-prefix-arg)))
(unless definition (error "No command"))
@@ -879,114 +876,6 @@ current buffer."
(princ ", which is ")
(describe-function-1 defn)))))))
-(defun describe-mode (&optional buffer)
- "Display documentation of current major mode and minor modes.
-A brief summary of the minor modes comes first, followed by the
-major mode description. This is followed by detailed
-descriptions of the minor modes, each on a separate page.
-
-For this to work correctly for a minor mode, the mode's indicator
-variable \(listed in `minor-mode-alist') must also be a function
-whose documentation describes the minor mode.
-
-If called from Lisp with a non-nil BUFFER argument, display
-documentation for the major and minor modes of that buffer."
- (interactive "@")
- (unless buffer (setq buffer (current-buffer)))
- (help-setup-xref (list #'describe-mode buffer)
- (called-interactively-p 'interactive))
- ;; For the sake of help-do-xref and help-xref-go-back,
- ;; don't switch buffers before calling `help-buffer'.
- (with-help-window (help-buffer)
- (with-current-buffer buffer
- (let (minor-modes)
- ;; Older packages do not register in minor-mode-list but only in
- ;; minor-mode-alist.
- (dolist (x minor-mode-alist)
- (setq x (car x))
- (unless (memq x minor-mode-list)
- (push x minor-mode-list)))
- ;; Find enabled minor mode we will want to mention.
- (dolist (mode minor-mode-list)
- ;; Document a minor mode if it is listed in minor-mode-alist,
- ;; non-nil, and has a function definition.
- (let ((fmode (or (get mode :minor-mode-function) mode)))
- (and (boundp mode) (symbol-value mode)
- (fboundp fmode)
- (let ((pretty-minor-mode
- (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
- (symbol-name fmode))
- (capitalize
- (substring (symbol-name fmode)
- 0 (match-beginning 0)))
- fmode)))
- (push (list fmode pretty-minor-mode
- (format-mode-line (assq mode minor-mode-alist)))
- minor-modes)))))
- ;; 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
- (lambda (a b) (string-lessp (cadr a) (cadr b)))))
- (when minor-modes
- (princ "Enabled minor modes:\n")
- (make-local-variable 'help-button-cache)
- (with-current-buffer standard-output
- (dolist (mode minor-modes)
- (let ((mode-function (nth 0 mode))
- (pretty-minor-mode (nth 1 mode))
- (indicator (nth 2 mode)))
- (save-excursion
- (goto-char (point-max))
- (princ "\n\f\n")
- (push (point-marker) help-button-cache)
- ;; Document the minor modes fully.
- (insert-text-button
- pretty-minor-mode 'type 'help-function
- 'help-args (list mode-function)
- 'button '(t))
- (princ (format " minor mode (%s):\n"
- (if (zerop (length indicator))
- "no indicator"
- (format "indicator%s"
- indicator))))
- (princ (help-split-fundoc (documentation mode-function)
- nil 'doc)))
- (insert-button pretty-minor-mode
- 'action (car help-button-cache)
- 'follow-link t
- 'help-echo "mouse-2, RET: show full information")
- (newline)))
- (forward-line -1)
- (fill-paragraph nil)
- (forward-line 1))
-
- (princ "\n(Information about these minor modes follows the major mode info.)\n\n"))
- ;; Document the major mode.
- (let ((mode mode-name))
- (with-current-buffer standard-output
- (let ((start (point)))
- (insert (format-mode-line mode nil nil buffer))
- (add-text-properties start (point) '(face bold)))))
- (princ " mode")
- (let* ((mode major-mode)
- (file-name (find-lisp-object-file-name mode nil)))
- (when file-name
- (princ (format-message " defined in `%s'"
- (file-name-nondirectory file-name)))
- ;; Make a hyperlink to the library.
- (with-current-buffer standard-output
- (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)))))
- ;; For the sake of IELM and maybe others
- nil)
-
(defun search-forward-help-for-help ()
"Search forward \"help window\"."
(interactive)
diff --git a/lisp/hexl.el b/lisp/hexl.el
index 2535d581db4..0c31d964577 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -367,8 +367,8 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
(add-hook 'change-major-mode-hook #'hexl-maybe-dehexlify-buffer nil t)
;; Set a callback function for eldoc.
- (add-function :before-until (local 'eldoc-documentation-function)
- #'hexl-print-current-point-info)
+ (add-hook 'eldoc-documentation-functions
+ #'hexl-print-current-point-info nil t)
(eldoc-add-command-completions "hexl-")
(eldoc-remove-command "hexl-save-buffer"
"hexl-current-address")
@@ -455,6 +455,8 @@ and edit the file in `hexl-mode'."
;; 2. reset change-major-mode-hook in case that `hexl-mode'
;; previously added hexl-maybe-dehexlify-buffer to it.
(remove-hook 'change-major-mode-hook #'hexl-maybe-dehexlify-buffer t)
+ (remove-hook 'eldoc-documentation-functions
+ #'hexl-print-current-point-info t)
(setq major-mode 'fundamental-mode)
(hexl-mode)))
@@ -513,7 +515,7 @@ Ask the user for confirmation."
(message "Current address is %d/0x%08x" hexl-address hexl-address))
hexl-address))
-(defun hexl-print-current-point-info ()
+(defun hexl-print-current-point-info (&rest _ignored)
"Return current hexl-address in string.
This function is intended to be used as eldoc callback."
(let ((addr (hexl-current-address)))
@@ -701,10 +703,7 @@ With prefix arg N, puts point N bytes of the way from the true beginning."
(defun hexl-end-of-line ()
"Goto end of line in Hexl mode."
(interactive)
- (hexl-goto-address (let ((address (logior (hexl-current-address) 15)))
- (if (> address hexl-max-address)
- (setq address hexl-max-address))
- address)))
+ (hexl-goto-address (min hexl-max-address (logior (hexl-current-address) 15))))
(defun hexl-scroll-down (arg)
"Scroll hexl buffer window upward ARG lines; or near full window if no ARG."
@@ -749,7 +748,7 @@ If there's no byte at the target address, move to the first or last line."
"Go to end of 1KB boundary."
(interactive)
(hexl-goto-address
- (max hexl-max-address (logior (hexl-current-address) 1023))))
+ (min hexl-max-address (logior (hexl-current-address) 1023))))
(defun hexl-beginning-of-512b-page ()
"Go to beginning of 512 byte boundary."
@@ -760,7 +759,7 @@ If there's no byte at the target address, move to the first or last line."
"Go to end of 512 byte boundary."
(interactive)
(hexl-goto-address
- (max hexl-max-address (logior (hexl-current-address) 511))))
+ (min hexl-max-address (logior (hexl-current-address) 511))))
(defun hexl-quoted-insert (arg)
"Read next input character and insert it.
@@ -887,7 +886,7 @@ and their encoded form is inserted byte by byte."
(when (null encoded)
(setq internal (encode-coding-string internal 'utf-8-emacs)
internal-hex
- (mapconcat (function (lambda (c) (format "%x" c)))
+ (mapconcat (lambda (c) (format "%x" c))
internal " "))
(if (yes-or-no-p
(format-message
@@ -900,7 +899,7 @@ and their encoded form is inserted byte by byte."
(substitute-command-keys "try \\[hexl-insert-hex-string]"))))
(while (> num 0)
(mapc
- (function (lambda (c) (hexl-insert-char c 1))) encoded)
+ (lambda (c) (hexl-insert-char c 1)) encoded)
(setq num (1- num))))))))
(defun hexl-self-insert-command (arg)
@@ -935,7 +934,7 @@ CH must be a unibyte character whose value is between 0 and 255."
(goto-char ascii-position)
(delete-char 1)
(insert (hexl-printable-character ch))
- (or (eq address hexl-max-address)
+ (or (= address hexl-max-address)
(setq address (1+ address)))
(hexl-goto-address address)
(if at-ascii-position
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 3e7a960bf23..a81cefacb03 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -102,7 +102,7 @@ of functions `hi-lock-mode' and `hi-lock-find-patterns'."
:type 'integer
:group 'hi-lock)
-(defcustom hi-lock-highlight-range 200000
+(defcustom hi-lock-highlight-range 2000000
"Size of area highlighted by hi-lock when font-lock not active.
Font-lock is not active in buffers that do their own highlighting,
such as the buffer created by `list-colors-display'. In those buffers
@@ -233,17 +233,15 @@ by cycling through the faces in `hi-lock-face-defaults'."
"Patterns provided to hi-lock by user. Should not be changed.")
(put 'hi-lock-interactive-patterns 'permanent-local t)
-(define-obsolete-variable-alias 'hi-lock-face-history
- 'hi-lock-face-defaults "23.1")
+(defvar-local hi-lock-interactive-lighters nil
+ "Human-readable lighters for `hi-lock-interactive-patterns'.")
+(put 'hi-lock-interactive-lighters 'permanent-local t)
+
(defvar hi-lock-face-defaults
'("hi-yellow" "hi-pink" "hi-green" "hi-blue" "hi-salmon" "hi-aquamarine"
"hi-black-b" "hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb")
"Default faces for hi-lock interactive functions.")
-(define-obsolete-variable-alias 'hi-lock-regexp-history
- 'regexp-history
- "23.1")
-
(defvar hi-lock-file-patterns-prefix "Hi-lock"
"String used to identify hi-lock patterns at the start of files.")
@@ -406,7 +404,8 @@ versions before 22 use the following in your init file:
hi-lock-file-patterns)
(when hi-lock-interactive-patterns
(font-lock-remove-keywords nil hi-lock-interactive-patterns)
- (setq hi-lock-interactive-patterns nil))
+ (setq hi-lock-interactive-patterns nil
+ hi-lock-interactive-lighters nil))
(when hi-lock-file-patterns
(font-lock-remove-keywords nil hi-lock-file-patterns)
(setq hi-lock-file-patterns nil))
@@ -437,6 +436,9 @@ of text in those lines.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type."
@@ -450,19 +452,29 @@ highlighting will not update as you type."
(hi-lock-set-pattern
;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ?
;; or a trailing $ in REGEXP will be interpreted correctly.
- (concat "^.*\\(?:" regexp "\\).*\\(?:$\\)\n?") face))
+ (concat "^.*\\(?:" regexp "\\).*\\(?:$\\)\n?") face nil nil
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)))
;;;###autoload
(defalias 'highlight-regexp 'hi-lock-face-buffer)
;;;###autoload
-(defun hi-lock-face-buffer (regexp &optional face subexp)
+(defun hi-lock-face-buffer (regexp &optional face subexp lighter)
"Set face of each match of REGEXP to FACE.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE. Limit face setting to the
corresponding SUBEXP (interactively, the prefix argument) of REGEXP.
If SUBEXP is omitted or nil, the entire REGEXP is highlighted.
+LIGHTER is a human-readable string that can be used to select
+a regexp to unhighlight by its name instead of selecting a possibly
+complex regexp or closure.
+
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type. The Font Lock mode
@@ -472,12 +484,23 @@ the major mode specifies support for Font Lock."
(interactive
(list
(hi-lock-regexp-okay
- (read-regexp "Regexp to highlight" 'regexp-history-last))
+ (read-regexp "Regexp to highlight"
+ (if (use-region-p)
+ (prog1
+ (buffer-substring (region-beginning)
+ (region-end))
+ (deactivate-mark))
+ 'regexp-history-last)))
(hi-lock-read-face-name)
current-prefix-arg))
(or (facep face) (setq face 'hi-yellow))
(unless hi-lock-mode (hi-lock-mode 1))
- (hi-lock-set-pattern regexp face subexp))
+ (hi-lock-set-pattern
+ regexp face subexp lighter
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)
+ search-spaces-regexp))
;;;###autoload
(defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
@@ -487,9 +510,9 @@ the major mode specifies support for Font Lock."
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
-When called interactively, replace whitespace in user-provided
-regexp with arbitrary whitespace, and make initial lower-case
-letters case-insensitive, before highlighting with `hi-lock-set-pattern'.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+Also set `search-spaces-regexp' to the value of `search-whitespace-regexp'.
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
@@ -500,12 +523,16 @@ the major mode specifies support for Font Lock."
(interactive
(list
(hi-lock-regexp-okay
- (hi-lock-process-phrase
- (read-regexp "Phrase to highlight" 'regexp-history-last)))
+ (read-regexp "Phrase to highlight" 'regexp-history-last))
(hi-lock-read-face-name)))
(or (facep face) (setq face 'hi-yellow))
(unless hi-lock-mode (hi-lock-mode 1))
- (hi-lock-set-pattern regexp face))
+ (hi-lock-set-pattern
+ regexp face nil nil
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)
+ search-whitespace-regexp))
;;;###autoload
(defalias 'highlight-symbol-at-point 'hi-lock-face-symbol-at-point)
@@ -516,6 +543,9 @@ Uses the next face from `hi-lock-face-defaults' without prompting,
unless you use a prefix argument.
Uses `find-tag-default-as-symbol-regexp' to retrieve the symbol at point.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
This uses Font lock mode if it is enabled; otherwise it uses overlays,
in which case the highlighting will not update as you type. The Font
Lock mode is considered \"enabled\" in a buffer if its `major-mode'
@@ -528,7 +558,11 @@ the major mode specifies support for Font Lock."
(face (hi-lock-read-face-name)))
(or (facep face) (setq face 'hi-yellow))
(unless hi-lock-mode (hi-lock-mode 1))
- (hi-lock-set-pattern regexp face)))
+ (hi-lock-set-pattern
+ regexp face nil nil
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search))))
(defun hi-lock-keyword->face (keyword)
(cadr (cadr (cadr keyword)))) ; Keyword looks like (REGEXP (0 'FACE) ...).
@@ -542,13 +576,16 @@ the major mode specifies support for Font Lock."
(let ((regexp (get-char-property (point) 'hi-lock-overlay-regexp)))
(when regexp (push regexp regexps)))
;; With font-locking on, check if the cursor is on a highlighted text.
- (let ((face-after (get-text-property (point) 'face))
- (face-before
- (unless (bobp) (get-text-property (1- (point)) 'face)))
- (faces (mapcar #'hi-lock-keyword->face
- hi-lock-interactive-patterns)))
- (unless (memq face-before faces) (setq face-before nil))
- (unless (memq face-after faces) (setq face-after nil))
+ (let* ((faces-after (get-text-property (point) 'face))
+ (faces-before
+ (unless (bobp) (get-text-property (1- (point)) 'face)))
+ ;; Use proper-list-p to handle faces like (foreground-color . "red3")
+ (faces-after (if (proper-list-p faces-after) faces-after (list faces-after)))
+ (faces-before (if (proper-list-p faces-before) faces-before (list faces-before)))
+ (faces (mapcar #'hi-lock-keyword->face
+ hi-lock-interactive-patterns))
+ (face-after (seq-some (lambda (face) (car (memq face faces))) faces-after))
+ (face-before (seq-some (lambda (face) (car (memq face faces))) faces-before)))
(when (and face-before face-after (not (eq face-before face-after)))
(setq face-before nil))
(when (or face-after face-before)
@@ -566,7 +603,8 @@ the major mode specifies support for Font Lock."
;; highlighted text at point. Use this later in
;; during completing-read.
(dolist (hi-lock-pattern hi-lock-interactive-patterns)
- (let ((regexp (car hi-lock-pattern)))
+ (let ((regexp (or (car (rassq hi-lock-pattern hi-lock-interactive-lighters))
+ (car hi-lock-pattern))))
(if (string-match regexp hi-text)
(push regexp regexps)))))))
regexps))
@@ -598,12 +636,15 @@ then remove all hi-lock highlighting."
'keymap
(cons "Select Pattern to Unhighlight"
(mapcar (lambda (pattern)
- (list (car pattern)
- (format
- "%s (%s)" (car pattern)
- (hi-lock-keyword->face pattern))
- (cons nil nil)
- (car pattern)))
+ (let ((lighter
+ (or (car (rassq pattern hi-lock-interactive-lighters))
+ (car pattern))))
+ (list lighter
+ (format
+ "%s (%s)" lighter
+ (hi-lock-keyword->face pattern))
+ (cons nil nil)
+ lighter)))
hi-lock-interactive-patterns))))
;; If the user clicks outside the menu, meaning that they
;; change their mind, x-popup-menu returns nil, and
@@ -614,17 +655,25 @@ then remove all hi-lock highlighting."
(t
;; Un-highlighting triggered via keyboard action.
(unless hi-lock-interactive-patterns
- (error "No highlighting to remove"))
+ (user-error "No highlighting to remove"))
;; Infer the regexp to un-highlight based on cursor position.
(let* ((defaults (or (hi-lock--regexps-at-point)
- (mapcar #'car hi-lock-interactive-patterns))))
+ (mapcar (lambda (pattern)
+ (or (car (rassq pattern hi-lock-interactive-lighters))
+ (car pattern)))
+ hi-lock-interactive-patterns))))
(list
- (completing-read (if (null defaults)
- "Regexp to unhighlight: "
- (format "Regexp to unhighlight (default %s): "
- (car defaults)))
- hi-lock-interactive-patterns
+ (completing-read (format-prompt "Regexp to unhighlight" (car defaults))
+ (mapcar (lambda (pattern)
+ (cons (or (car (rassq pattern hi-lock-interactive-lighters))
+ (car pattern))
+ (cdr pattern)))
+ hi-lock-interactive-patterns)
nil t nil nil defaults))))))
+
+ (when (assoc regexp hi-lock-interactive-lighters)
+ (setq regexp (cadr (assoc regexp hi-lock-interactive-lighters))))
+
(dolist (keyword (if (eq regexp t) hi-lock-interactive-patterns
(list (assoc regexp hi-lock-interactive-patterns))))
(when keyword
@@ -641,7 +690,11 @@ then remove all hi-lock highlighting."
(setq hi-lock-interactive-patterns
(delq keyword hi-lock-interactive-patterns))
(remove-overlays
- nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons (car keyword)))
+ nil nil 'hi-lock-overlay-regexp
+ (or (car (rassq keyword hi-lock-interactive-lighters))
+ (hi-lock--hashcons (car keyword))))
+ (setq hi-lock-interactive-lighters
+ (rassq-delete-all keyword hi-lock-interactive-lighters))
(font-lock-flush))))
;;;###autoload
@@ -653,7 +706,7 @@ Interactively added patterns are those normally specified using
be found in variable `hi-lock-interactive-patterns'."
(interactive)
(if (null hi-lock-interactive-patterns)
- (error "There are no interactive patterns"))
+ (user-error "There are no interactive patterns"))
(let ((beg (point)))
(mapc
(lambda (pattern)
@@ -667,25 +720,6 @@ be found in variable `hi-lock-interactive-patterns'."
;; Implementation Functions
-(defun hi-lock-process-phrase (phrase)
- "Convert regexp PHRASE to a regexp that matches phrases.
-
-Blanks in PHRASE replaced by regexp that matches arbitrary whitespace
-and initial lower-case letters made case insensitive."
- (let ((mod-phrase nil))
- ;; FIXME fragile; better to just bind case-fold-search? (Bug#7161)
- (setq mod-phrase
- (replace-regexp-in-string
- "\\(^\\|\\s-\\)\\([a-z]\\)"
- (lambda (m) (format "%s[%s%s]"
- (match-string 1 m)
- (upcase (match-string 2 m))
- (match-string 2 m))) phrase))
- ;; FIXME fragile; better to use search-spaces-regexp?
- (setq mod-phrase
- (replace-regexp-in-string
- "\\s-+" "[ \t\n]+" mod-phrase nil t))))
-
(defun hi-lock-regexp-okay (regexp)
"Return REGEXP if it appears suitable for a font-lock pattern.
@@ -716,8 +750,7 @@ with completion and history."
(if (and hi-lock-auto-select-face (not current-prefix-arg))
(setq face (or (pop hi-lock--unused-faces) (car defaults)))
(setq face (completing-read
- (format "Highlight using face (default %s): "
- (car defaults))
+ (format-prompt "Highlight using face" (car defaults))
obarray 'facep t nil 'face-name-history defaults))
;; Update list of un-used faces.
(setq hi-lock--unused-faces (remove face hi-lock--unused-faces))
@@ -725,19 +758,27 @@ with completion and history."
(add-to-list 'hi-lock-face-defaults face t))
(intern face)))
-(defun hi-lock-set-pattern (regexp face &optional subexp)
+(defun hi-lock-set-pattern (regexp face &optional subexp lighter case-fold spaces-regexp)
"Highlight SUBEXP of REGEXP with face FACE.
If omitted or nil, SUBEXP defaults to zero, i.e. the entire
-REGEXP is highlighted."
+REGEXP is highlighted. LIGHTER is a human-readable string to
+display instead of a regexp. Non-nil CASE-FOLD ignores case.
+SPACES-REGEXP is a regexp to substitute spaces in font-lock search."
;; Hashcons the regexp, so it can be passed to remove-overlays later.
(setq regexp (hi-lock--hashcons regexp))
(setq subexp (or subexp 0))
- (let ((pattern (list regexp (list subexp (list 'quote face) 'prepend)))
+ (let ((pattern (list (lambda (limit)
+ (let ((case-fold-search case-fold)
+ (search-spaces-regexp spaces-regexp))
+ (re-search-forward regexp limit t)))
+ (list subexp (list 'quote face) 'prepend)))
(no-matches t))
;; Refuse to highlight a text that is already highlighted.
- (if (assoc regexp hi-lock-interactive-patterns)
+ (if (or (assoc regexp hi-lock-interactive-patterns)
+ (assoc (or lighter regexp) hi-lock-interactive-lighters))
(add-to-list 'hi-lock--unused-faces (face-name face))
(push pattern hi-lock-interactive-patterns)
+ (push (cons (or lighter regexp) pattern) hi-lock-interactive-lighters)
(if (and font-lock-mode (font-lock-specified-p major-mode))
(progn
(font-lock-add-keywords nil (list pattern) t)
@@ -749,7 +790,9 @@ REGEXP is highlighted."
(- range-min (max 0 (- range-max (point-max))))))
(search-end
(min (point-max)
- (+ range-max (max 0 (- (point-min) range-min))))))
+ (+ range-max (max 0 (- (point-min) range-min)))))
+ (case-fold-search case-fold)
+ (search-spaces-regexp spaces-regexp))
(save-excursion
(goto-char search-start)
(while (re-search-forward regexp search-end t)
@@ -757,13 +800,17 @@ REGEXP is highlighted."
(let ((overlay (make-overlay (match-beginning subexp)
(match-end subexp))))
(overlay-put overlay 'hi-lock-overlay t)
- (overlay-put overlay 'hi-lock-overlay-regexp regexp)
+ (overlay-put overlay 'hi-lock-overlay-regexp (or lighter regexp))
(overlay-put overlay 'face face))
(goto-char (match-end 0)))
(when no-matches
(add-to-list 'hi-lock--unused-faces (face-name face))
(setq hi-lock-interactive-patterns
- (cdr hi-lock-interactive-patterns)))))))))
+ (cdr hi-lock-interactive-patterns)
+ hi-lock-interactive-lighters
+ (cdr hi-lock-interactive-lighters))))
+ (when (or (> search-start (point-min)) (< search-end (point-max)))
+ (message "Hi-lock added only in range %d-%d" search-start search-end)))))))
(defun hi-lock-set-file-patterns (patterns)
"Replace file patterns list with PATTERNS and refontify."
diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
index 04a5ccd8d59..ae97bb008af 100644
--- a/lisp/hilit-chg.el
+++ b/lisp/hilit-chg.el
@@ -224,9 +224,6 @@ colors then use this, if you want fancier faces then set
;; When you invoke highlight-changes-mode, should highlight-changes-visible-mode
;; be on or off?
-(define-obsolete-variable-alias 'highlight-changes-initial-state
- 'highlight-changes-visibility-initial-state "23.1")
-
(defcustom highlight-changes-visibility-initial-state t
"Controls whether changes are initially visible in Highlight Changes mode.
@@ -236,13 +233,7 @@ When a buffer is in Highlight Changes mode the function
:type 'boolean
:group 'highlight-changes)
-;; highlight-changes-global-initial-state has been removed
-
-
-
;; These are the strings displayed in the mode-line for the minor mode:
-(define-obsolete-variable-alias 'highlight-changes-active-string
- 'highlight-changes-visible-string "23.1")
(defcustom highlight-changes-visible-string " +Chg"
"The string used when in Highlight Changes mode and changes are visible.
@@ -252,9 +243,6 @@ a string with a leading space."
(const :tag "None" nil))
:group 'highlight-changes)
-(define-obsolete-variable-alias 'highlight-changes-passive-string
- 'highlight-changes-invisible-string "23.1")
-
(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
@@ -957,10 +945,6 @@ changes are made, so \\[highlight-changes-next-change] and
(define-globalized-minor-mode global-highlight-changes-mode
highlight-changes-mode highlight-changes-mode-turn-on)
-(define-obsolete-function-alias
- 'global-highlight-changes
- 'global-highlight-changes-mode "23.1")
-
(defun highlight-changes-mode-turn-on ()
"See if Highlight Changes mode should be turned on for this buffer.
This is called when `global-highlight-changes-mode' is turned on."
diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el
index 98edacd6ec0..ce5fc585c81 100644
--- a/lisp/hippie-exp.el
+++ b/lisp/hippie-exp.el
@@ -4,7 +4,7 @@
;; Author: Anders Holst <aho@sans.kth.se>
;; Maintainer: emacs-devel@gnu.org
-;; Version: 1.6
+;; Old-Version: 1.6
;; Keywords: abbrev convenience
;; This file is part of GNU Emacs.
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 08e52d63a26..ed2cd26f0de 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -11,9 +11,6 @@
;; Created: 2002-01-05
;; Description: htmlize a buffer/source tree with optional hyperlinks
;; URL: http://rtfm.etla.org/emacs/htmlfontify/
-;; Compatibility: Emacs23, Emacs22
-;; Incompatibility: Emacs19, Emacs20, Emacs21
-;; Last Updated: Thu 2009-11-19 01:31:21 +0000
;; This file is part of GNU Emacs.
@@ -136,8 +133,8 @@ main-content <=MAIN_CONTENT;\\n\" rtfm-section file style rtfm-section file))
\"s section[eg- emacs / p4-blame]:\\nD source-dir: \\nD output-dir: \")
(require \\='htmlfontify)
(hfy-load-tags-cache srcdir)
- (let ((hfy-page-header \\='rtfm-build-page-header)
- (hfy-page-footer \\='rtfm-build-page-footer)
+ (let ((hfy-page-header #\\='rtfm-build-page-header)
+ (hfy-page-footer #\\='rtfm-build-page-footer)
(rtfm-section section)
(hfy-index-file \"index\"))
(htmlfontify-run-etags srcdir)
@@ -151,7 +148,7 @@ main-content <=MAIN_CONTENT;\\n\" rtfm-section file style rtfm-section file))
:link '(info-link "(htmlfontify) Customization")
:prefix "hfy-")
-(defcustom hfy-page-header 'hfy-default-header
+(defcustom hfy-page-header #'hfy-default-header
"Function called to build the header of the HTML source.
This is called with two arguments (the filename relative to the top
level source directory being etag'd and fontified), and a string containing
@@ -159,7 +156,6 @@ the <style>...</style> text to embed in the document.
It should return a string that will be used as the header for the
htmlfontified version of the source file.\n
See also `hfy-page-footer'."
- :group 'htmlfontify
;; FIXME: Why place such a :tag everywhere? Isn't it imposing your
;; own Custom preference on your users? --Stef
:tag "page-header"
@@ -170,66 +166,57 @@ See also `hfy-page-footer'."
If non-nil, the index is split on the first letter of each tag.
Useful when the index would otherwise be large and take
a long time to render or be difficult to navigate."
- :group 'htmlfontify
:tag "split-index"
:type '(boolean))
-(defcustom hfy-page-footer 'hfy-default-footer
+(defcustom hfy-page-footer #'hfy-default-footer
"As `hfy-page-header', but generates the output footer.
It takes only one argument, the filename."
- :group 'htmlfontify
:tag "page-footer"
:type '(function))
(defcustom hfy-extn ".html"
"File extension used for output files."
- :group 'htmlfontify
:tag "extension"
:type '(string))
(defcustom hfy-src-doc-link-style "text-decoration: underline;"
"String to add to the `<style> a' variant of an htmlfontify CSS class."
- :group 'htmlfontify
:tag "src-doc-link-style"
:type '(string))
(defcustom hfy-src-doc-link-unstyle " text-decoration: none;"
"Regex to remove from the `<style> a' variant of an htmlfontify CSS class."
- :group 'htmlfontify
:tag "src-doc-link-unstyle"
- :type '(string))
+ :type '(regexp))
(defcustom hfy-link-extn nil
"File extension used for href links.
Useful where the htmlfontify output files are going to be processed
again, with a resulting change in file extension. If nil, then any
code using this should fall back to `hfy-extn'."
- :group 'htmlfontify
:tag "link-extension"
:type '(choice string (const nil)))
-(defcustom hfy-link-style-fun 'hfy-link-style-string
+(defcustom hfy-link-style-fun #'hfy-link-style-string
"Function to customize the appearance of hyperlinks.
Set this to a function, which will be called with one argument
\(a \"{ foo: bar; ...}\" CSS style-string) - it should return a copy of
its argument, altered so as to make any changes you want made for text which
is a hyperlink, in addition to being in the class to which that style would
normally be applied."
- :group 'htmlfontify
:tag "link-style-function"
:type '(function))
(defcustom hfy-index-file "hfy-index"
"Name (sans extension) of the tag definition index file produced during
fontification-and-hyperlinking."
- :group 'htmlfontify
:tag "index-file"
:type '(string))
(defcustom hfy-instance-file "hfy-instance"
"Name (sans extension) of the tag usage index file produced during
fontification-and-hyperlinking."
- :group 'htmlfontify
:tag "instance-file"
:type '(string))
@@ -237,25 +224,13 @@ fontification-and-hyperlinking."
"Regex to match (with a single back-reference per match) strings in HTML
which should be quoted with `hfy-html-quote' (and `hfy-html-quote-map')
to make them safe."
- :group 'htmlfontify
:tag "html-quote-regex"
:type '(regexp))
-(define-obsolete-variable-alias 'hfy-init-kludge-hooks 'hfy-init-kludge-hook
- "23.2")
-(defcustom hfy-init-kludge-hook '(hfy-kludge-cperl-mode)
- "List of functions to call when starting `htmlfontify-buffer' to do any
-kludging necessary to get highlighting modes to behave as you want, even
-when not running under a window system."
- :group 'htmlfontify
- :tag "init-kludge-hooks"
- :type '(hook))
-
(define-obsolete-variable-alias 'hfy-post-html-hooks 'hfy-post-html-hook "24.3")
(defcustom hfy-post-html-hook nil
"List of functions to call after creating and filling the HTML buffer.
These functions will be called with the HTML buffer as the current buffer."
- :group 'htmlfontify
:tag "post-html-hooks"
:options '(set-auto-mode)
:type '(hook))
@@ -267,7 +242,6 @@ potentially non-current face information doesn't necessarily work for
`default').\n
Example: I customize this to:\n
\((t :background \"black\" :foreground \"white\" :family \"misc-fixed\"))"
- :group 'htmlfontify
:tag "default-face-definition"
:type '(alist))
@@ -281,7 +255,6 @@ in order, to:\n
1 - The tag
2 - The line
3 - The char (point) at which the tag occurs."
- :group 'htmlfontify
:tag "etag-regex"
:type '(regexp))
@@ -290,7 +263,6 @@ in order, to:\n
("&" "&amp;" )
(">" "&gt;" ))
"Alist of char -> entity mappings used to make the text HTML-safe."
- :group 'htmlfontify
:tag "html-quote-map"
:type '(alist :key-type (string)))
(defconst hfy-e2x-etags-cmd "for src in `find . -type f`;
@@ -332,7 +304,6 @@ done;")
hfy-etags-cmd-alist-default
"Alist of possible shell commands that will generate etags output that
`htmlfontify' can use. `%s' will be replaced by `hfy-etags-bin'."
- :group 'htmlfontify
:tag "etags-cmd-alist"
:type '(alist :key-type (string) :value-type (string)))
@@ -340,13 +311,11 @@ done;")
"Location of etags binary (we begin by assuming it's in your path).\n
Note that if etags is not in your path, you will need to alter the shell
commands in `hfy-etags-cmd-alist'."
- :group 'htmlfontify
:tag "etags-bin"
:type '(file))
(defcustom hfy-shell-file-name "/bin/sh"
"Shell (Bourne or compatible) to invoke for complex shell operations."
- :group 'htmlfontify
:tag "shell-file-name"
:type '(file))
@@ -358,7 +327,6 @@ commands in `hfy-etags-cmd-alist'."
point-entered
point-left)
"Properties to omit when copying a fontified buffer for HTML transformation."
- :group 'htmlfontify
:tag "ignored-properties"
:type '(repeat symbol))
@@ -387,7 +355,6 @@ file for the whole source tree from there on down. The command should emit
the etags output on stdout.\n
Two canned commands are provided - they drive Emacs's etags and
exuberant-ctags' etags respectively."
- :group 'htmlfontify
:tag "etags-command"
:type (let ((clist (list '(string))))
(dolist (C hfy-etags-cmd-alist)
@@ -398,14 +365,12 @@ exuberant-ctags' etags respectively."
"Command to run with the name of a file, to see whether it is a text file
or not. The command should emit a string containing the word `text' if
the file is a text file, and a string not containing `text' otherwise."
- :group 'htmlfontify
:tag "istext-command"
:type '(string))
(defcustom hfy-find-cmd
"find . -type f \\! -name \\*~ \\! -name \\*.flc \\! -path \\*/CVS/\\*"
"Find command used to harvest a list of files to attempt to fontify."
- :group 'htmlfontify
:tag "find-command"
:type '(string))
@@ -434,7 +399,6 @@ of these values in the specification key constitutes a match, eg:\n
((type tty) (class color))\n
and so on."
:type '(alist :key-type (symbol) :value-type (symbol))
- :group 'htmlfontify
:tag "display-class"
:options '((type (choice (const :tag "X11" x-toolkit)
(const :tag "Terminal" tty )
@@ -481,7 +445,6 @@ which can never slow you down, but may result in incomplete fontification."
(const :tag "div-wrapper" div-wrapper )
(const :tag "keep-overlays" keep-overlays )
(const :tag "body-text-only" body-text-only ))
- :group 'htmlfontify
:tag "optimizations")
(defvar hfy-tags-cache nil
@@ -593,19 +556,17 @@ If a window system is unavailable, calls `hfy-fallback-color-values'."
'(1 2 3))
;;(message ">> %s" color)
(if window-system
- (if (fboundp 'color-values)
- (color-values color)
- ;;(message "[%S]" window-system)
- (x-color-values color))
+ (color-values color)
;; blarg - tty colors are no good - go fetch some X colors:
(hfy-fallback-color-values color))))
-(define-obsolete-function-alias 'hfy-colour-vals 'hfy-color-vals "27.1")
+(define-obsolete-function-alias 'hfy-colour-vals #'hfy-color-vals "27.1")
(defvar hfy-cperl-mode-kludged-p nil)
(defun hfy-kludge-cperl-mode ()
"CPerl mode does its damnedest not to do some of its fontification when not
in a windowing system - try to trick it..."
+ (declare (obsolete nil "28.1"))
(if (not hfy-cperl-mode-kludged-p)
(progn (if (not window-system)
(let ((window-system 'htmlfontify))
@@ -728,7 +689,7 @@ STYLE is the inline CSS stylesheet (or tag referring to an external sheet)."
--> </script>
</head>
<body onload=\"stripe('index'); return true;\">\n"
- (mapconcat 'hfy-html-quote (mapcar 'char-to-string file) "") style))
+ (mapconcat #'hfy-html-quote (mapcar #'char-to-string file) "") style))
(defun hfy-default-footer (_file)
"Default value for `hfy-page-footer'.
@@ -766,24 +727,24 @@ may happen."
(let ((white (mapcar (lambda (I) (float (1+ I))) (hfy-color-vals "white")))
(rgb16 (mapcar (lambda (I) (float (1+ I))) (hfy-color-vals color))))
(if rgb16
- ;;(apply 'format "rgb(%d, %d, %d)"
+ ;;(apply #'format "rgb(%d, %d, %d)"
;; Use #rrggbb instead, it is smaller
- (apply 'format "#%02x%02x%02x"
+ (apply #'format "#%02x%02x%02x"
(mapcar (lambda (X)
(* (/ (nth X rgb16)
- (nth X white)) 255))
+ (nth X white))
+ 255))
'(0 1 2))))))
(defun hfy-family (family) (list (cons "font-family" family)))
(defun hfy-bgcol (color) (list (cons "background" (hfy-triplet color))))
(defun hfy-color (color) (list (cons "color" (hfy-triplet color))))
-(define-obsolete-function-alias 'hfy-colour 'hfy-color "27.1")
+(define-obsolete-function-alias 'hfy-colour #'hfy-color "27.1")
(defun hfy-width (width) (list (cons "font-stretch" (symbol-name width))))
(defcustom hfy-font-zoom 1.05
"Font scaling from Emacs to HTML."
- :type 'float
- :group 'htmlfontify)
+ :type 'float)
(defun hfy-size (height)
"Derive a CSS font-size specifier from an Emacs font :height attribute HEIGHT.
@@ -1062,7 +1023,7 @@ haven't encountered them yet. Returns a `hfy-style-assoc'."
(when (string-match "pt" (cdr css)) (setq x t)))
(setq r (nconc r (list css)))))
;;(message "r: %S" r)
- (setq n (apply '* m))
+ (setq n (apply #'* m))
(nconc r (hfy-size (if x (round n) (* n 1.0)))) ))
(defun hfy-face-resolve-face (fn)
@@ -1073,7 +1034,7 @@ then the specification is returned unchanged."
((facep fn)
(hfy-face-attr-for-class fn hfy-display-class))
;; FIXME: is this necessary? Faces can be symbols, but
- ;; not symbols refering to other symbols?
+ ;; not symbols referring to other symbols?
((and (symbolp fn)
(facep (symbol-value fn)))
(hfy-face-attr-for-class
@@ -1152,9 +1113,9 @@ See also `hfy-face-to-css'."
(push (car E) seen)
(format " %s: %s; " (car E) (cdr E)))))
css-list)))
- (cons (hfy-css-name fn) (format "{%s}" (apply 'concat css-text)))) )
+ (cons (hfy-css-name fn) (format "{%s}" (apply #'concat css-text)))) )
-(defvar hfy-face-to-css 'hfy-face-to-css-default
+(defvar hfy-face-to-css #'hfy-face-to-css-default
"Handler for mapping faces to styles.
The signature of the handler is of the form \(lambda (FN) ...).
FN is a font or `defface' specification (cf
@@ -1510,7 +1471,7 @@ Uses `hfy-link-style-fun' to do this."
;; Fix-me: Add handling of page breaks here + scan for ^L
;; where appropriate.
(format "body, pre %s\n" (cddr (assq 'default css)))
- (apply 'concat
+ (apply #'concat
(mapcar
(lambda (style)
(format
@@ -1611,7 +1572,7 @@ Insert \"</span>\". See `hfy-end-span-handler' for more
information."
(insert "</span>"))
-(defvar hfy-begin-span-handler 'hfy-begin-span
+(defvar hfy-begin-span-handler #'hfy-begin-span
"Handler to begin a span of text.
The signature of the handler is \(lambda (STYLE TEXT-BLOCK
TEXT-ID TEXT-BEGINS-BLOCK-P) ...). The handler must insert
@@ -1640,7 +1601,7 @@ behavior.
The default handler is `hfy-begin-span'.")
-(defvar hfy-end-span-handler 'hfy-end-span
+(defvar hfy-end-span-handler #'hfy-end-span
"Handler to end a span of text.
The signature of the handler is \(lambda () ...). The handler
must insert appropriate tags to end a span of text.
@@ -1821,33 +1782,7 @@ fontified. This is a simple convenience wrapper around
(htmlfontify-buffer)
(buffer-string))))
-(defun hfy-force-fontification ()
- "Try to force font-locking even when it is optimized away."
- (run-hooks 'hfy-init-kludge-hook)
- (eval-and-compile (require 'font-lock))
- (if (boundp 'font-lock-cache-position)
- (or font-lock-cache-position
- (setq font-lock-cache-position (make-marker))))
- (cond
- (noninteractive
- (message "hfy batch mode (%s:%S)"
- (or (buffer-file-name) (buffer-name)) major-mode)
- (if (fboundp 'font-lock-ensure) ; Emacs >= 25.1
- (font-lock-ensure)
- (when font-lock-defaults
- ; Silence "interactive use only" warning on Emacs >= 25.1.
- (with-no-warnings (font-lock-fontify-buffer)))))
- ((and (fboundp #'jit-lock-fontify-now)
- (bound-and-true-p jit-lock-mode))
- (message "hfy jit-lock mode (%S %S)" window-system major-mode)
- (jit-lock-fontify-now))
- (t
- (message "hfy interactive mode (%S %S)" window-system major-mode)
- ;; If jit-lock is not in use, then the buffer is already fontified!
- ;; (when (and font-lock-defaults
- ;; font-lock-mode)
- ;; (font-lock-fontify-region (point-min) (point-max) nil))
- )))
+(define-obsolete-function-alias 'hfy-force-fontification #'font-lock-ensure "28.1")
;;;###autoload
(defun htmlfontify-buffer (&optional srcdir file)
@@ -1875,8 +1810,7 @@ hyperlinks as appropriate."
(setq file (match-string 1 file)))) )
(if (not (hfy-opt 'skip-refontification))
- (save-excursion ;; Keep region
- (hfy-force-fontification)))
+ (font-lock-ensure))
(if (called-interactively-p 'any) ;; display the buffer in interactive mode:
(switch-to-buffer (hfy-fontify-buffer srcdir file))
(hfy-fontify-buffer srcdir file)))
@@ -1934,7 +1868,7 @@ adding an extension of `hfy-extn'. Fontification is actually done by
;; FIXME: Shouldn't this use expand-file-name? --Stef
(setq target (concat dstdir "/" file))
(hfy-make-directory (hfy-dirname target))
- (if (not (hfy-opt 'skip-refontification)) (hfy-force-fontification))
+ (if (not (hfy-opt 'skip-refontification)) (font-lock-ensure))
(if (or (hfy-fontified-p) (hfy-text-p srcdir file))
(progn (setq html (hfy-fontify-buffer srcdir file))
(set-buffer html)
@@ -2392,7 +2326,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'."
;; (custom-save-delete 'hfy-set-hooks)
;; (let ((standard-output (current-buffer)))
;; (princ "(hfy-set-hooks\n;;auto-generated, only one copy allowed\n")
-;; (mapatoms 'hfy-pp-hook)
+;; (mapatoms #'hfy-pp-hook)
;; (insert "\n)")
;; )
;; )
@@ -2419,7 +2353,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'."
;; FIXME: This saving&restoring of global customization
;; variables can interfere with other customization settings for
;; those vars (in .emacs or in Customize).
- (mapc 'hfy-save-initvar
+ (mapc #'hfy-save-initvar
'(auto-mode-alist interpreter-mode-alist))
(princ ")\n")
(indent-region start-pos (point) nil))
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index bfb9787a96d..80c5b073985 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -504,7 +504,7 @@ format. See `ibuffer-update-saved-filters-format' and
(ibuffer-forward-line 0))
(defun ibuffer--maybe-erase-shell-cmd-output ()
- (let ((buf (get-buffer "*Shell Command Output*")))
+ (let ((buf (get-buffer shell-command-buffer-name)))
(when (and (buffer-live-p buf)
(not shell-command-dont-erase-buffer)
(not (zerop (buffer-size buf))))
@@ -517,7 +517,7 @@ format. See `ibuffer-update-saved-filters-format' and
:opstring "Shell command executed on"
:before (ibuffer--maybe-erase-shell-cmd-output)
:modifier-p nil)
- (let ((out-buf (get-buffer-create "*Shell Command Output*")))
+ (let ((out-buf (get-buffer-create shell-command-buffer-name)))
(with-current-buffer out-buf (goto-char (point-max)))
(call-shell-region (point-min) (point-max)
command nil out-buf)))
@@ -542,7 +542,7 @@ format. See `ibuffer-update-saved-filters-format' and
:modifier-p nil)
(let ((file (and (not (buffer-modified-p))
buffer-file-name))
- (out-buf (get-buffer-create "*Shell Command Output*")))
+ (out-buf (get-buffer-create shell-command-buffer-name)))
(unless (and file (file-exists-p file))
(setq file
(make-temp-file
@@ -1234,14 +1234,12 @@ Called interactively, accept a comma separated list of mode names."
(symbol-name (buffer-local-value
'major-mode buf)))))
(mapcar #'intern
- (completing-read-multiple
- (if default
- (format "Filter by major mode (default %s): " default)
- "Filter by major mode: ")
- obarray
- (lambda (e)
- (string-match "-mode\\'" (if (symbolp e) (symbol-name e) e)))
- t nil nil default)))
+ (completing-read-multiple
+ (format-prompt "Filter by major mode" default)
+ obarray
+ (lambda (e)
+ (string-match "-mode\\'" (if (symbolp e) (symbol-name e) e)))
+ t nil nil default)))
:accept-list t)
(eq qualifier (buffer-local-value 'major-mode buf)))
@@ -1259,11 +1257,9 @@ currently used by buffers."
(symbol-name (buffer-local-value
'major-mode buf)))))
(mapcar #'intern
- (completing-read-multiple
- (if default
- (format "Filter by major mode (default %s): " default)
- "Filter by major mode: ")
- (ibuffer-list-buffer-modes) nil t nil nil default)))
+ (completing-read-multiple
+ (format-prompt "Filter by major mode" default)
+ (ibuffer-list-buffer-modes) nil t nil nil default)))
:accept-list t)
(eq qualifier (buffer-local-value 'major-mode buf)))
@@ -1881,9 +1877,7 @@ Otherwise buffers whose name matches an element of
'major-mode buf)))))
(list (intern
(completing-read
- (if default
- (format "Mark by major mode (default %s): " default)
- "Mark by major mode: ")
+ (format-prompt "Mark by major mode" default)
(ibuffer-list-buffer-modes) nil t nil nil default)))))
(ibuffer-mark-on-buffer
#'(lambda (buf)
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 851b25f9ec0..c9a748830c1 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -339,6 +339,8 @@ directory, like `default-directory'."
(defcustom ibuffer-load-hook nil
"Hook run when Ibuffer is loaded."
:type 'hook)
+(make-obsolete-variable 'ibuffer-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom ibuffer-marked-face 'warning
"Face used for displaying marked buffers."
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 3747ae3d281..4e546807b7f 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -75,7 +75,11 @@ everything preceding the ~/ is discarded so the interactive
selection process starts again from the user's $HOME.")
(defcustom icomplete-show-matches-on-no-input nil
- "When non-nil, show completions when first prompting for input."
+ "When non-nil, show completions when first prompting for input.
+This also means that if you traverse the list of completions with
+commands like `C-.' and just hit RET without typing any
+characters, the match under point will be chosen instead of the
+default."
:type 'boolean
:version "24.4")
@@ -153,12 +157,22 @@ icompletion is occurring."
(defvar icomplete-minibuffer-map
(let ((map (make-sparse-keymap)))
(define-key map [?\M-\t] 'icomplete-force-complete)
+ (define-key map [remap minibuffer-complete-and-exit] 'icomplete-ret)
(define-key map [?\C-j] 'icomplete-force-complete-and-exit)
(define-key map [?\C-.] 'icomplete-forward-completions)
(define-key map [?\C-,] 'icomplete-backward-completions)
map)
"Keymap used by `icomplete-mode' in the minibuffer.")
+(defun icomplete-ret ()
+ "Exit minibuffer for icomplete."
+ (interactive)
+ (if (and icomplete-show-matches-on-no-input
+ (car completion-all-sorted-completions)
+ (eql (icomplete--field-end) (icomplete--field-beg)))
+ (icomplete-force-complete-and-exit)
+ (minibuffer-complete-and-exit)))
+
(defun icomplete-force-complete-and-exit ()
"Complete the minibuffer with the longest possible match and exit.
Use the first of the matches if there are any displayed, and use
@@ -465,38 +479,80 @@ Usually run by inclusion in `minibuffer-setup-hook'."
with beg = (icomplete--field-beg)
with end = (icomplete--field-end)
with all = (completion-all-sorted-completions beg end)
+ ;; Icomplete mode re-sorts candidates, bubbling the default to
+ ;; top if it's found somewhere down the list. This loop's
+ ;; iteration variable, `fn' iterates through these "bubble up
+ ;; predicates" which may vary depending on specific
+ ;; `completing-read' invocations, described below:
for fn in (cond ((and minibuffer-default
(stringp minibuffer-default) ; bug#38992
(= (icomplete--field-end) (icomplete--field-beg)))
- ;; When we have a non-nil string default and
- ;; no input whatsoever: we want to make sure
- ;; that default is bubbled to the top so that
- ;; `icomplete-force-complete-and-exit' will
- ;; select it (do that even if the match
- ;; doesn't match the completion perfectly.
- `(,(lambda (comp)
+ ;; Here, we have a non-nil string default and
+ ;; no input whatsoever. We want to make sure
+ ;; that the default is bubbled to the top so
+ ;; that `icomplete-force-complete-and-exit'
+ ;; will select it. We want to do that even if
+ ;; the match doesn't match the completion
+ ;; perfectly.
+ ;;
+ `(;; The first predicate ensures that:
+ ;;
+ ;; (completing-read "thing? " '("foo" "bar")
+ ;; nil nil nil nil "bar")
+ ;;
+ ;; Has "bar" at the top, so RET will select
+ ;; it, as desired.
+ ,(lambda (comp)
(equal minibuffer-default comp))
+ ;; Why do we need this second predicate?
+ ;; Because that'll make things like M-x man
+ ;; RET RET, when invoked with point on the
+ ;; "bar" word, behave correctly. There, the
+ ;; default doesn't quite match any
+ ;; candidate. So:
+ ;;
+ ;; (completing-read "Man entry? " '("foo(1)" "bar(1)")
+ ;; nil nil nil nil "bar")
+ ;;
+ ;; Will place "bar(1)" on top, and RET will
+ ;; select it -- again, as desired.
+ ;;
+ ;; FIXME: it's arguable that this second
+ ;; behaviour should be a property of the
+ ;; completion table and not the completion
+ ;; frontend such as we have done
+ ;; here. However, it seems generically
+ ;; useful for a very broad spectrum of
+ ;; cases.
,(lambda (comp)
(string-prefix-p minibuffer-default comp))))
((and fido-mode
(not minibuffer-default)
(eq (icomplete--category) 'file))
- ;; `fido-mode' has some extra file-sorting
- ;; semantics even if there isn't a default,
- ;; which is to bubble "./" to the top if it
- ;; exists. This makes M-x dired RET RET go to
- ;; the directory of current file, which is
- ;; what vanilla Emacs and `ido-mode' both do.
+ ;; When there isn't a default, `fido-mode'
+ ;; specifically also has some extra
+ ;; file-sorting semantics inherited from Ido.
+ ;; Those make the directory "./" bubble to the
+ ;; top (if it exists). This makes M-x dired
+ ;; RET RET go to the directory of current
+ ;; file, which is non-Icomplete vanilla Emacs
+ ;; and `ido-mode' both do.
`(,(lambda (comp)
(string= "./" comp)))))
- thereis (cl-loop
- for l on all
- while (consp (cdr l))
- for comp = (cadr l)
- when (funcall fn comp)
- do (setf (cdr l) (cddr l))
- and return
- (completion--cache-all-sorted-completions beg end (cons comp all)))
+ ;; After we have setup the predicates, look for a completion
+ ;; matching one of them and bubble up it, destructively on
+ ;; `completion-all-sorted-completions' (unless that completion
+ ;; happens to be already on top).
+ thereis (or
+ (and (funcall fn (car all)) all)
+ (cl-loop
+ for l on all
+ while (consp (cdr l))
+ for comp = (cadr l)
+ when (funcall fn comp)
+ do (setf (cdr l) (cddr l))
+ and return
+ (completion--cache-all-sorted-completions beg end (cons comp all))))
finally return all)))
diff --git a/lisp/ido.el b/lisp/ido.el
index 7198649e5a5..c83b700e656 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -243,7 +243,7 @@
;; current frame are put at the end of the list. A hook exists to
;; allow other functions to order the list. For example, if you add:
;;
-;; (add-hook 'ido-make-buffer-list-hook 'ido-summary-buffers-to-end)
+;; (add-hook 'ido-make-buffer-list-hook #'ido-summary-buffers-to-end)
;;
;; then all files matching "Summary" are moved to the end of the
;; list. (I find this handy for keeping the INBOX Summary and so on
@@ -355,8 +355,8 @@ The following values are possible:
Setting this variable directly does not take effect;
use either \\[customize] or the function `ido-mode'."
:set #'(lambda (_symbol value)
- (ido-mode value))
- :initialize 'custom-initialize-default
+ (ido-mode (or value 0)))
+ :initialize #'custom-initialize-default
:require 'ido
:link '(emacs-commentary-link "ido.el")
:set-after '(ido-save-directory-list-file
@@ -366,13 +366,11 @@ use either \\[customize] or the function `ido-mode'."
:type '(choice (const :tag "Turn on only buffer" buffer)
(const :tag "Turn on only file" file)
(const :tag "Turn on both buffer and file" both)
- (const :tag "Switch off all" nil))
- :group 'ido)
+ (const :tag "Switch off all" nil)))
(defcustom ido-case-fold case-fold-search
"Non-nil if searching of buffer and file names should ignore case."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-ignore-buffers
'("\\` ")
@@ -380,8 +378,7 @@ use either \\[customize] or the function `ido-mode'."
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 'ido)
+ :type '(repeat (choice regexp function)))
(defcustom ido-ignore-files
'("\\`CVS/" "\\`#" "\\`.#" "\\`\\.\\./" "\\`\\./")
@@ -389,19 +386,16 @@ example functions that filter buffer names."
For example, traditional behavior is not to list files whose names begin
with a #, for which the regexp is `\\\\=`#'. See the source file for
example functions that filter filenames."
- :type '(repeat (choice regexp function))
- :group 'ido)
+ :type '(repeat (choice regexp function)))
(defcustom ido-ignore-extensions t
"Non-nil means ignore files in `completion-ignored-extensions' list."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-show-dot-for-dired nil
"Non-nil means to always put . as the first item in file name lists.
This allows the current directory to be opened immediately with `dired'."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-file-extensions-order nil
"List of file extensions specifying preferred order of file selections.
@@ -409,21 +403,18 @@ Each element is either a string with `.' as the first char, an empty
string matching files without extension, or t which is the default order
for files with an unlisted file extension."
:type '(repeat (choice string
- (const :tag "Default order" t)))
- :group 'ido)
+ (const :tag "Default order" t))))
(defcustom ido-ignore-directories
'("\\`CVS/" "\\`\\.\\./" "\\`\\./")
"List of regexps or functions matching sub-directory names to ignore."
- :type '(repeat (choice regexp function))
- :group 'ido)
+ :type '(repeat (choice regexp function)))
(defcustom ido-ignore-directories-merge nil
"List of regexps or functions matching directory names to ignore during merge.
Directory names matched by one of the regexps in this list are not inserted
in merged file and directory lists."
- :type '(repeat (choice regexp function))
- :group 'ido)
+ :type '(repeat (choice regexp function)))
;; Examples for setting the value of ido-ignore-buffers
;;(defun ido-ignore-c-mode (name)
@@ -453,8 +444,7 @@ Possible values:
(const :tag "Display (no select) in other window" display)
(const :tag "Visit in other frame" other-frame)
(const :tag "Ask to visit in other frame" maybe-frame)
- (const :tag "Raise frame if already visited" raise-frame))
- :group 'ido)
+ (const :tag "Raise frame if already visited" raise-frame)))
(defcustom ido-default-buffer-method 'raise-frame
"How to switch to new buffer when using `ido-switch-buffer'.
@@ -464,38 +454,33 @@ See `ido-default-file-method' for details."
(const :tag "Display (no select) in other window" display)
(const :tag "Show in other frame" other-frame)
(const :tag "Ask to show in other frame" maybe-frame)
- (const :tag "Raise frame if already shown" raise-frame))
- :group 'ido)
+ (const :tag "Raise frame if already shown" raise-frame)))
(defcustom ido-enable-flex-matching nil
"Non-nil means that Ido will do flexible string matching.
Flexible matching means that if the entered string does not
match any item, any item containing the entered characters
in the given sequence will match."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-enable-regexp nil
"Non-nil means that Ido will do regexp matching.
Value can be toggled within Ido using `ido-toggle-regexp'."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-enable-prefix nil
"Non-nil means only match if the entered text is a prefix of file name.
This behavior is like the standard Emacs completion.
If nil, match if the entered text is an arbitrary substring.
Value can be toggled within Ido using `ido-toggle-prefix'."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-enable-dot-prefix nil
"Non-nil means to match leading dot as prefix.
I.e. hidden files and buffers will match only if you type a dot
as first char even if `ido-enable-prefix' is nil."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
;; See https://debbugs.gnu.org/2042 for more info.
(defcustom ido-buffer-disable-smart-matches t
@@ -506,30 +491,29 @@ By default, Ido arranges matches in the following order:
which can get in the way for buffer switching."
:version "24.3"
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-confirm-unique-completion nil
"Non-nil means that even a unique completion must be confirmed.
This means that \\[ido-complete] must always be followed by \\[ido-exit-minibuffer]
even when there is only one unique completion."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
-(defcustom ido-cannot-complete-command 'ido-completion-help
+(defcustom ido-cannot-complete-command #'ido-completion-auto-help
"Command run when `ido-complete' can't complete any more.
The most useful values are `ido-completion-help', which pops up a
-window with completion alternatives, or `ido-next-match' or
-`ido-prev-match', which cycle the buffer list."
- :type 'function
- :group 'ido)
+window with completion alternatives; `ido-completion-auto-help',
+which does the same but respects the value of
+`completion-auto-help'; and `ido-next-match' or `ido-prev-match',
+which cycle the buffer list."
+ :version "28.1"
+ :type 'function)
(defcustom ido-record-commands t
"Non-nil means that Ido will record commands in command history.
Note that the non-Ido equivalent command is recorded."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-max-prospects 12
"Upper limit of the prospect list if non-zero.
@@ -537,8 +521,7 @@ Zero means no limit for the prospect list.
For a long list of prospects, building the full list for the
minibuffer can take a non-negligible amount of time; setting this
variable reduces that time."
- :type 'integer
- :group 'ido)
+ :type 'integer)
(defcustom ido-max-file-prompt-width 0.35
"Upper limit of the prompt string.
@@ -550,8 +533,7 @@ the frame width."
(integer :tag "Characters" :value 20)
(restricted-sexp :tag "Fraction of frame width"
:value 0.35
- :match-alternatives (ido-fractionp)))
- :group 'ido)
+ :match-alternatives (ido-fractionp))))
(defcustom ido-max-window-height nil
"Non-nil specifies a value to override `max-mini-window-height'."
@@ -561,28 +543,24 @@ the frame width."
(restricted-sexp
:tag "Fraction of window height"
:value 0.25
- :match-alternatives (ido-fractionp)))
- :group 'ido)
+ :match-alternatives (ido-fractionp))))
(defcustom ido-enable-last-directory-history t
"Non-nil means that Ido will remember latest selected directory names.
See `ido-last-directory-list' and `ido-save-directory-list-file'."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-max-work-directory-list 50
"Maximum number of working directories to record.
This is the list of directories where files have most recently been opened.
See `ido-work-directory-list' and `ido-save-directory-list-file'."
- :type 'integer
- :group 'ido)
+ :type 'integer)
(defcustom ido-work-directory-list-ignore-regexps nil
"List of regexps matching directories which should not be recorded.
Directory names matched by one of the regexps in this list are not inserted in
the `ido-work-directory-list' list."
- :type '(repeat regexp)
- :group 'ido)
+ :type '(repeat regexp))
(defcustom ido-use-filename-at-point nil
@@ -592,52 +570,44 @@ If found, use that as the starting point for filename selection."
:type '(choice
(const :tag "Disabled" nil)
(const :tag "Guess filename" guess)
- (other :tag "Use literal filename" t))
- :group 'ido)
+ (other :tag "Use literal filename" t)))
(defcustom ido-use-url-at-point nil
"Non-nil means that ido shall look for a URL at point.
If found, call `find-file-at-point' to visit it."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-enable-tramp-completion t
"Non-nil means that Ido shall perform tramp method and server name completion.
A tramp file name uses the following syntax: /method:user@host:filename."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-record-ftp-work-directories t
"Non-nil means record FTP file names in the work directory list."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-merge-ftp-work-directories nil
"If nil, merging ignores FTP file names in the work directory list."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-cache-ftp-work-directory-time 1.0
"Maximum time to cache contents of an FTP directory (in hours).
\\<ido-file-completion-map>
Use \\[ido-reread-directory] in prompt to refresh list.
If zero, FTP directories are not cached."
- :type 'number
- :group 'ido)
+ :type 'number)
(defcustom ido-slow-ftp-hosts nil
"List of slow FTP hosts where Ido prompting should not be used.
If an FTP host is on this list, Ido automatically switches to the non-Ido
equivalent function, e.g. `find-file' rather than `ido-find-file'."
- :type '(repeat string)
- :group 'ido)
+ :type '(repeat string))
(defcustom ido-slow-ftp-host-regexps nil
"List of regexps matching slow FTP hosts (see `ido-slow-ftp-hosts')."
- :type '(repeat regexp)
- :group 'ido)
+ :type '(repeat regexp))
(defvar ido-unc-hosts-cache t
"Cached value from the function `ido-unc-hosts'.")
@@ -652,66 +622,56 @@ hosts on first use of UNC path."
(function :tag "Your own function"))
:set #'(lambda (symbol value)
(set symbol value)
- (setq ido-unc-hosts-cache t))
- :group 'ido)
+ (setq ido-unc-hosts-cache t)))
(defcustom ido-downcase-unc-hosts t
"Non-nil if UNC host names should be downcased."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-ignore-unc-host-regexps nil
"List of regexps matching UNC hosts to ignore.
Case is ignored if `ido-downcase-unc-hosts' is set."
- :type '(repeat regexp)
- :group 'ido)
+ :type '(repeat regexp))
(defcustom ido-cache-unc-host-shares-time 8.0
"Maximum time to cache shares of an UNC host (in hours).
\\<ido-file-completion-map>
Use \\[ido-reread-directory] in prompt to refresh list.
If zero, UNC host shares are not cached."
- :type 'number
- :group 'ido)
+ :type 'number)
(defcustom ido-max-work-file-list 10
"Maximum number of names of recently opened files to record.
This is the list of the file names (sans directory) which have most recently
been opened. See `ido-work-file-list' and `ido-save-directory-list-file'."
- :type 'integer
- :group 'ido)
+ :type 'integer)
(defcustom ido-work-directory-match-only t
"Non-nil means to skip non-matching directories in the directory history.
When some text is already entered at the `ido-find-file' prompt, using
\\[ido-prev-work-directory] or \\[ido-next-work-directory] will skip directories
without any matching entries."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-auto-merge-work-directories-length 0
"Automatically switch to merged work directories during file name input.
The value is number of characters to type before switching to merged mode.
If zero, the switch happens when no matches are found in the current directory.
Automatic merging is disabled if the value is negative."
- :type 'integer
- :group 'ido)
+ :type 'integer)
(defcustom ido-auto-merge-delay-time 0.70
"Delay in seconds to wait for more input before doing auto merge."
- :type 'number
- :group 'ido)
+ :type 'number)
(defcustom ido-auto-merge-inhibit-characters-regexp "[][*?~]"
"Regexp matching characters which should inhibit automatic merging.
When a (partial) file name matches this regexp, merging is inhibited."
- :type 'regexp
- :group 'ido)
+ :type 'regexp)
(defcustom ido-merged-indicator "^"
"The string appended to first choice if it has multiple directory choices."
- :type 'string
- :group 'ido)
+ :type 'string)
(defcustom ido-max-dir-file-cache 100
"Maximum number of working directories to be cached.
@@ -723,8 +683,7 @@ modification times, so you may choose to disable caching on such
systems, or explicitly refresh the cache contents using the command
`ido-reread-directory' command (\\[ido-reread-directory]) in the minibuffer.
See also `ido-dir-file-cache' and `ido-save-directory-list-file'."
- :type 'integer
- :group 'ido)
+ :type 'integer)
(defcustom ido-max-directory-size nil
"Maximum size (in bytes) for directories to use Ido completion.
@@ -732,21 +691,18 @@ See also `ido-dir-file-cache' and `ido-save-directory-list-file'."
If you enter a directory with a size larger than this size, Ido will
not provide the normal completion. To show the completions, use \\[ido-toggle-ignore]."
:type '(choice (const :tag "No limit" nil)
- (integer :tag "Size in bytes" 30000))
- :group 'ido)
+ (integer :tag "Size in bytes" 30000)))
(defcustom ido-big-directories nil
"List of directory pattern strings that should be considered big.
Ido won't attempt to list the contents of directories matching
any of these regular expressions when completing file names."
:type '(repeat regexp)
- :group 'ido
:version "27.1")
(defcustom ido-rotate-file-list-default nil
"Non-nil means that Ido will always rotate file list to get default in front."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-enter-matching-directory 'only
"Additional methods to enter sub-directory of first/only matching item.
@@ -758,8 +714,7 @@ matching item, even without typing a slash."
:type '(choice (const :tag "Never" nil)
(const :tag "Slash enters first directory" first)
(const :tag "Slash enters first and only directory" only)
- (other :tag "Always enter unique directory" t))
- :group 'ido)
+ (other :tag "Always enter unique directory" t)))
(defcustom ido-create-new-buffer 'prompt
"Specify whether a new buffer is created if no buffer matches substring.
@@ -767,21 +722,18 @@ Choices are `always' to create new buffers unconditionally, `prompt' to
ask user whether to create buffer, or `never' to never create new buffer."
:type '(choice (const always)
(const prompt)
- (const never))
- :group 'ido)
+ (const never)))
(defcustom ido-setup-hook nil
"Hook run after the Ido variables and keymap have been setup.
The dynamic variable `ido-cur-item' contains the current type of item that
is read by Ido; possible values are file, dir, buffer, and list.
Additional keys can be defined in `ido-completion-map'."
- :type 'hook
- :group 'ido)
+ :type 'hook)
(defcustom ido-separator nil
"String used by Ido to separate the alternatives in the minibuffer."
- :type '(choice string (const nil))
- :group 'ido)
+ :type '(choice string (const nil)))
(make-obsolete-variable 'ido-separator
"set 3rd element of `ido-decorations' instead." nil)
@@ -802,8 +754,7 @@ can be completed using TAB,
11th element is displayed to confirm creating new file or buffer.
12th and 13th elements (if present) are used as brackets around the sole
remaining completion. If absent, elements 5 and 6 are used instead."
- :type '(repeat string)
- :group 'ido)
+ :type '(repeat string))
(defcustom ido-use-virtual-buffers nil
"If non-nil, refer to past (\"virtual\") buffers as well as existing ones.
@@ -827,71 +778,60 @@ enabled if this variable is configured to a non-nil value."
:version "24.1"
:type '(choice (const :tag "Always" t)
(const :tag "Automatic" auto)
- (const :tag "Never" nil))
- :group 'ido)
+ (const :tag "Never" nil)))
(defcustom ido-use-faces t
"Non-nil means use Ido faces to highlighting first match, only match and
subdirs in the alternatives."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defface ido-first-match '((t :weight bold))
- "Face used by Ido for highlighting first match."
- :group 'ido)
+ "Face used by Ido for highlighting first match.")
(defface ido-only-match '((((class color))
:foreground "ForestGreen")
(t :slant italic))
- "Face used by Ido for highlighting only match."
- :group 'ido)
+ "Face used by Ido for highlighting only match.")
(defface ido-subdir '((((min-colors 88) (class color))
:foreground "red1")
(((class color))
:foreground "red")
(t :underline t))
- "Face used by Ido for highlighting subdirs in the alternatives."
- :group 'ido)
+ "Face used by Ido for highlighting subdirs in the alternatives.")
(defface ido-virtual '((t :inherit font-lock-builtin-face))
"Face used by Ido for matching virtual buffer names."
- :version "24.1"
- :group 'ido)
+ :version "24.1")
(defface ido-indicator '((((min-colors 88) (class color))
:foreground "yellow1" :background "red1" :width condensed)
(((class color))
:foreground "yellow" :background "red" :width condensed)
(t :inverse-video t))
- "Face used by Ido for highlighting its indicators."
- :group 'ido)
+ "Face used by Ido for highlighting its indicators.")
(defface ido-incomplete-regexp
'((t :inherit font-lock-warning-face))
- "Ido face for indicating incomplete regexps."
- :group 'ido)
+ "Ido face for indicating incomplete regexps.")
(defcustom ido-make-file-list-hook nil
"List of functions to run when the list of matching files is created.
Each function on the list may modify the dynamically bound variable
`ido-temp-list' which contains the current list of matching files."
- :type 'hook
- :group 'ido)
+ :type 'hook)
(defcustom ido-make-dir-list-hook nil
"List of functions to run when the list of matching directories is created.
Each function on the list may modify the dynamically bound variable
`ido-temp-list' which contains the current list of matching directories."
- :type 'hook
- :group 'ido)
+ :type 'hook)
(defcustom ido-make-buffer-list-hook nil
"List of functions to run when the list of matching buffers is created.
Each function on the list may modify the dynamically bound variable
`ido-temp-list' which contains the current list of matching buffer names."
- :type 'hook
- :group 'ido)
+ :type 'hook)
(defcustom ido-rewrite-file-prompt-functions nil
"List of functions to run when the find-file prompt is created.
@@ -908,8 +848,7 @@ variables:
The following variables are available, but should not be changed:
`ido-current-directory' - the unabbreviated directory name
item - equals `file' or `dir' depending on the current mode."
- :type 'hook
- :group 'ido)
+ :type 'hook)
(defvar ido-rewrite-file-prompt-rules nil
"Alist of rewriting rules for directory names in Ido prompts.
@@ -924,14 +863,12 @@ also modify the dynamic variables described for the variable
(defcustom ido-completion-buffer "*Ido Completions*"
"Name of completion buffer used by Ido.
Set to nil to disable completion buffers popping up."
- :type 'string
- :group 'ido)
+ :type 'string)
(defcustom ido-completion-buffer-all-completions nil
"Non-nil means to show all completions in completion buffer.
Otherwise, only the current list of matches is shown."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-all-frames 'visible
"Argument to pass to `walk-windows' when Ido is finding buffers.
@@ -939,8 +876,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 'ido)
+ (const :tag "All frames on this terminal" 0)))
(defcustom ido-minibuffer-setup-hook nil
"Ido-specific customization of minibuffer setup.
@@ -954,8 +890,7 @@ with other packages. For instance:
will constrain Emacs to a maximum minibuffer height of 3 lines when
Ido is running. Copied from `icomplete-minibuffer-setup-hook'."
- :type 'hook
- :group 'ido)
+ :type 'hook)
(defcustom ido-save-directory-list-file
(locate-user-emacs-file "ido.last" ".ido.last")
@@ -964,28 +899,24 @@ Variables stored are: `ido-last-directory-list', `ido-work-directory-list',
`ido-work-file-list', and `ido-dir-file-cache'.
Must be set before enabling Ido mode."
:version "24.4" ; added locate-user-emacs-file
- :type 'string
- :group 'ido)
+ :type 'string)
(defcustom ido-read-file-name-as-directory-commands '()
"List of commands which use `read-file-name' to read a directory name.
When `ido-everywhere' is non-nil, the commands in this list will read
the directory using `ido-read-directory-name'."
- :type '(repeat symbol)
- :group 'ido)
+ :type '(repeat symbol))
(defcustom ido-read-file-name-non-ido '()
"List of commands which shall not read file names the Ido way.
When `ido-everywhere' is non-nil, the commands in this list will read
the file name using normal `read-file-name' style."
- :type '(repeat symbol)
- :group 'ido)
+ :type '(repeat symbol))
(defcustom ido-before-fallback-functions '()
"List of functions to call before calling a fallback command.
The fallback command is passed as an argument to the functions."
- :type 'hook
- :group 'ido)
+ :type 'hook)
;;;; Keymaps
@@ -1071,10 +1002,10 @@ The fallback command is passed as an argument to the functions."
;;;; Persistent variables
-(defvar ido-file-history nil
+(defvar ido-file-history nil
"History of files selected using `ido-find-file'.")
-(defvar ido-buffer-history nil
+(defvar ido-buffer-history nil
"History of buffers selected using `ido-switch-buffer'.")
(defvar ido-last-directory-list nil
@@ -1583,18 +1514,19 @@ Removes badly formatted data and ignored directories."
(ido-save-history))
(defun ido-common-initialization ()
- (add-hook 'minibuffer-setup-hook 'ido-minibuffer-setup)
- (add-hook 'choose-completion-string-functions 'ido-choose-completion-string))
+ (add-hook 'minibuffer-setup-hook #'ido-minibuffer-setup)
+ (add-hook 'choose-completion-string-functions #'ido-choose-completion-string))
(define-minor-mode ido-everywhere
"Toggle use of Ido for all buffer/file reading."
:global t
- :group 'ido
(remove-function read-file-name-function #'ido-read-file-name)
(remove-function read-buffer-function #'ido-read-buffer)
(when ido-everywhere
- (add-function :override read-file-name-function #'ido-read-file-name)
- (add-function :override read-buffer-function #'ido-read-buffer)))
+ (if (not ido-mode)
+ (ido-mode 'both)
+ (add-function :override read-file-name-function #'ido-read-file-name)
+ (add-function :override read-buffer-function #'ido-read-buffer))))
(defvar ido-minor-mode-map-entry nil)
@@ -1619,13 +1551,13 @@ This function also adds a hook to the minibuffer."
((> (prefix-numeric-value arg) 0) 'both)
(t nil)))
- (ido-everywhere (if ido-everywhere 1 -1))
+ (ido-everywhere (if (and ido-mode ido-everywhere) 1 -1))
(when ido-mode
(ido-common-initialization)
(ido-load-history)
- (add-hook 'kill-emacs-hook 'ido-kill-emacs-hook)
+ (add-hook 'kill-emacs-hook #'ido-kill-emacs-hook)
(let ((map (make-sparse-keymap)))
(when (memq ido-mode '(file both))
@@ -2286,7 +2218,10 @@ If cursor is not at the end of the user input, move to end of input."
((and ido-enable-virtual-buffers
ido-virtual-buffers
(setq filename (assoc buf ido-virtual-buffers)))
- (ido-visit-buffer (find-file-noselect (cdr filename)) method t))
+ (if (eq method 'kill)
+ (setq recentf-list
+ (delete (cdr filename) recentf-list))
+ (ido-visit-buffer (find-file-noselect (cdr filename)) method t)))
((and (eq ido-create-new-buffer 'prompt)
(null require-match)
@@ -2445,9 +2380,9 @@ If cursor is not at the end of the user input, move to end of input."
nil ido-text 'ido-enter-insert-file))
((eq ido-exit 'dired)
- (funcall (cond ((eq method 'other-window) 'dired-other-window)
- ((eq method 'other-frame) 'dired-other-frame)
- (t 'dired))
+ (funcall (cond ((eq method 'other-window) #'dired-other-window)
+ ((eq method 'other-frame) #'dired-other-frame)
+ (t #'dired))
(concat ido-current-directory (or ido-text ""))))
((eq ido-exit 'ffap)
@@ -3480,13 +3415,18 @@ instead removed from the current item list."
(defun ido-make-buffer-list-1 (&optional frame visible)
"Return list of non-ignored buffer names."
- (delq nil
- (mapcar
- (lambda (x)
- (let ((name (buffer-name x)))
- (if (not (or (ido-ignore-item-p name ido-ignore-buffers) (member name visible)))
- name)))
- (buffer-list frame))))
+ (with-temp-buffer
+ ;; Each call to ido-ignore-item-p LET-binds case-fold-search.
+ ;; That is slow if there's no buffer-local binding available,
+ ;; roughly O(number of buffers). This hack avoids it.
+ (setq-local case-fold-search nil)
+ (delq nil
+ (mapcar
+ (lambda (x)
+ (let ((name (buffer-name x)))
+ (if (not (or (ido-ignore-item-p name ido-ignore-buffers) (member name visible)))
+ name)))
+ (buffer-list frame)))))
(defun ido-make-buffer-list (default)
"Return the current list of buffers.
@@ -3598,7 +3538,7 @@ it is put to the start of the list."
;; tramp-ftp-file-name-p is available only when tramp
;; has been loaded.
(fboundp 'tramp-ftp-file-name-p)
- (funcall 'tramp-ftp-file-name-p dir)
+ (tramp-ftp-file-name-p dir)
(string-match ":\\'" dir)
(file-name-all-completions "" (concat dir "./"))))))
(if (and compl
@@ -3698,7 +3638,8 @@ in this list."
(not (ido-local-file-exists-p x)))
(and (not (ido-final-slash x))
(let (file-name-handler-alist)
- (get-file-buffer x)))) x))
+ (get-file-buffer x))))
+ x))
ido-temp-list)))))
(ido-to-end ;; move . files to end
(delq nil (mapcar
@@ -3731,7 +3672,8 @@ If MERGED is non-nil, each subdir is cons'ed with DIR."
(delq nil
(mapcar
(lambda (name)
- (and (ido-final-slash name) (not (ido-ignore-item-p name ido-ignore-directories))
+ (and (ido-final-slash name)
+ (not (ido-ignore-item-p name ido-ignore-directories))
(if merged (cons name dir) name)))
(ido-file-name-all-completions dir)))))
@@ -3997,6 +3939,14 @@ If `ido-change-word-sub' cannot be found in WORD, return nil."
(when (bobp)
(next-completion 1)))))
+(defun ido-completion-auto-help ()
+ "Call `ido-completion-help' if `completion-auto-help' is non-nil."
+ (interactive)
+ ;; Note: `completion-auto-help' could also be `lazy', but this value
+ ;; is irrelevant to ido, which is fundamentally eager, so it is
+ ;; treated the same as t.
+ (when completion-auto-help
+ (ido-completion-help)))
(defun ido-completion-help ()
"Show possible completions in the `ido-completion-buffer'."
@@ -4041,7 +3991,7 @@ If `ido-change-word-sub' cannot be found in WORD, return nil."
(t
(copy-sequence (or ido-matches ido-cur-list))))
#'ido-file-lessp)))
- ;;(add-hook 'completion-setup-hook 'completion-setup-function)
+ ;;(add-hook 'completion-setup-hook #'completion-setup-function)
(display-completion-list completion-list))))))
;;; KILL CURRENT BUFFER
@@ -4128,6 +4078,7 @@ Record command in `command-history' if optional RECORD is non-nil."
(setq buffer (buffer-name buffer)))
(let (win newframe)
(cond
+ ;; "Killing" of virtual buffers is handled in `ido-buffer-internal'.
((eq method 'kill)
(if record
(ido-record-command 'kill-buffer buffer))
@@ -4707,7 +4658,9 @@ For details of keybindings, see `ido-find-file'."
(not (input-pending-p)))
(ido-trace "\n*start timer*")
(setq ido-auto-merge-timer
- (run-with-timer ido-auto-merge-delay-time nil 'ido-initiate-auto-merge (current-buffer))))))
+ (run-with-timer ido-auto-merge-delay-time nil
+ #'ido-initiate-auto-merge
+ (current-buffer))))))
(setq ido-rescan t)
@@ -4830,8 +4783,8 @@ Modified from `icomplete-completions'."
"Minibuffer setup hook for Ido."
;; Copied from `icomplete-minibuffer-setup-hook'.
(when (ido-active)
- (add-hook 'pre-command-hook 'ido-tidy nil t)
- (add-hook 'post-command-hook 'ido-exhibit nil t)
+ (add-hook 'pre-command-hook #'ido-tidy nil t)
+ (add-hook 'post-command-hook #'ido-exhibit nil t)
(run-hooks 'ido-minibuffer-setup-hook)
(when ido-initial-position
(goto-char (+ (minibuffer-prompt-end) ido-initial-position))
diff --git a/lisp/ielm.el b/lisp/ielm.el
index 41675c011d8..b3654b91d37 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -44,8 +44,7 @@
(defcustom ielm-noisy t
"If non-nil, IELM will beep on error."
- :type 'boolean
- :group 'ielm)
+ :type 'boolean)
(defcustom ielm-prompt-read-only t
"If non-nil, the IELM prompt is read only.
@@ -74,7 +73,6 @@ buffers, including IELM buffers. If you sometimes use IELM on
text-only terminals or with `emacs -nw', you might wish to use
another binding for `comint-kill-whole-line'."
:type 'boolean
- :group 'ielm
:version "22.1")
(defcustom ielm-prompt "ELISP> "
@@ -90,8 +88,7 @@ does not update the prompt of an *ielm* buffer with a running process.
For IELM buffers that are not called `*ielm*', you can execute
\\[inferior-emacs-lisp-mode] in that IELM buffer to update the value,
for new prompts. This works even if the buffer has a running process."
- :type 'string
- :group 'ielm)
+ :type 'string)
(defvar ielm-prompt-internal "ELISP> "
"Stored value of `ielm-prompt' in the current IELM buffer.
@@ -103,8 +100,7 @@ customizes `ielm-prompt'.")
"Controls whether \\<ielm-map>\\[ielm-return] has intelligent behavior in IELM.
If non-nil, \\[ielm-return] evaluates input for complete sexps, or inserts a newline
and indents for incomplete sexps. If nil, always inserts newlines."
- :type 'boolean
- :group 'ielm)
+ :type 'boolean)
(defcustom ielm-dynamic-multiline-inputs t
"Force multiline inputs to start from column zero?
@@ -112,15 +108,13 @@ If non-nil, after entering the first line of an incomplete sexp, a newline
will be inserted after the prompt, moving the input to the next line.
This gives more frame width for large indented sexps, and allows functions
such as `edebug-defun' to work with such inputs."
- :type 'boolean
- :group 'ielm)
+ :type 'boolean)
(defvaralias 'inferior-emacs-lisp-mode-hook 'ielm-mode-hook)
(defcustom ielm-mode-hook nil
"Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started."
:options '(eldoc-mode)
- :type 'hook
- :group 'ielm)
+ :type 'hook)
;; We define these symbols (that are only used buffer-locally in ielm
;; buffers) this way to avoid having them be defined in the global
@@ -366,9 +360,9 @@ nonempty, then flushes the buffer."
;; that same let. To avoid problems, neither of
;; these buffers should be alive during the
;; evaluation of form.
- (let* ((*1 *)
- (*2 **)
- (*3 ***)
+ (let* ((*1 (bound-and-true-p *))
+ (*2 (bound-and-true-p **))
+ (*3 (bound-and-true-p ***))
(active-process (ielm-process))
(old-standard-output standard-output)
new-standard-output
@@ -453,11 +447,12 @@ nonempty, then flushes the buffer."
(if error-type
(progn
(when ielm-noisy (ding))
- (setq output (concat output "*** " error-type " *** "))
- (setq output (concat output result)))
+ (setq output (concat output
+ "*** " error-type " *** "
+ result)))
;; There was no error, so shift the *** values
- (setq *** **)
- (setq ** *)
+ (setq *** (bound-and-true-p **))
+ (setq ** (bound-and-true-p *))
(setq * result))
(when (or (not for-effect) (not (equal output "")))
(setq output (concat output "\n"))))
@@ -541,8 +536,10 @@ Customized bindings may be defined in `ielm-map', which currently contains:
(set (make-local-variable 'completion-at-point-functions)
'(comint-replace-by-expanded-history
ielm-complete-filename elisp-completion-at-point))
- (add-function :before-until (local 'eldoc-documentation-function)
- #'elisp-eldoc-documentation-function)
+ (add-hook 'eldoc-documentation-functions
+ #'elisp-eldoc-var-docstring nil t)
+ (add-hook 'eldoc-documentation-functions
+ #'elisp-eldoc-funcall nil t)
(set (make-local-variable 'ielm-prompt-internal) ielm-prompt)
(set (make-local-variable 'comint-prompt-read-only) ielm-prompt-read-only)
(setq comint-get-old-input 'ielm-get-old-input)
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index 8025060b0ea..a29adde8325 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -60,7 +60,7 @@
;; =============
;;
;; * The ImageMagick package. Currently, `convert' and `mogrify' are
-;; used. Find it here: http://www.imagemagick.org.
+;; used. Find it here: https://www.imagemagick.org.
;;
;; * For non-lossy rotation of JPEG images, the JpegTRAN program is
;; needed.
@@ -149,7 +149,6 @@
;;; Code:
(require 'dired)
-(require 'format-spec)
(require 'image-mode)
(require 'widget)
@@ -206,7 +205,7 @@ the index.html page that image-dired creates."
:group 'image-dired)
(defcustom image-dired-gallery-image-root-url
-"http://your.own.server/image-diredpics"
+"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."
@@ -214,7 +213,7 @@ expects to find pictures in this directory."
:group 'image-dired)
(defcustom image-dired-gallery-thumb-image-root-url
-"http://your.own.server/image-diredthumbs"
+"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."
@@ -771,8 +770,8 @@ Increase at own risk.")
process)
(when (not (file-exists-p thumbnail-dir))
(message "Creating thumbnail directory")
- (make-directory thumbnail-dir t)
- (set-file-modes thumbnail-dir #o700))
+ (with-file-modes #o700
+ (make-directory thumbnail-dir t)))
;; Thumbnail file creation processes begin here and are marshaled
;; in a queue by `image-dired-create-thumb'.
diff --git a/lisp/image-file.el b/lisp/image-file.el
index 89cd75d50dd..22366c89e6a 100644
--- a/lisp/image-file.el
+++ b/lisp/image-file.el
@@ -32,6 +32,7 @@
;;; Code:
(require 'image)
+(require 'image-converter)
;;;###autoload
@@ -80,10 +81,13 @@ the variable is set using \\[customize]."
(let ((exts-regexp
(and image-file-name-extensions
(concat "\\."
- (regexp-opt (nconc (mapcar #'upcase
- image-file-name-extensions)
- image-file-name-extensions)
- t)
+ (regexp-opt
+ (append (mapcar #'upcase image-file-name-extensions)
+ image-file-name-extensions
+ (mapcar #'upcase
+ image-converter-file-name-extensions)
+ image-converter-file-name-extensions)
+ t)
"\\'"))))
(mapconcat
'identity
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 1bb213c2489..032ebf38733 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -40,6 +40,7 @@
(require 'image)
(require 'exif)
+(require 'dired)
(eval-when-compile (require 'cl-lib))
;;; Image mode window-info management.
@@ -611,24 +612,35 @@ Key bindings:
(setq major-mode 'image-mode)
(setq image-transform-resize image-auto-resize)
+ ;; Bail out early if we have no image data.
+ (if (zerop (buffer-size))
+ (funcall (if (called-interactively-p 'any) 'error 'message)
+ (if (file-exists-p buffer-file-name)
+ "Empty file"
+ "(New file)"))
+ (image-mode--display)))
+
+(defun image-mode--display ()
(if (not (image-get-display-property))
(progn
(when (condition-case err
- (progn
- (image-toggle-display-image)
- t)
- (unknown-image-type
- (image-mode-as-text)
- (funcall
- (if (called-interactively-p 'any) 'error 'message)
- "Unknown image type; consider switching `image-use-external-converter' on")
- nil)
- (error
- (image-mode-as-text)
- (funcall
- (if (called-interactively-p 'any) 'error 'message)
- "Cannot display image: %s" (cdr err))
- nil))
+ (progn
+ (image-toggle-display-image)
+ t)
+ (unknown-image-type
+ (image-mode-as-text)
+ (funcall
+ (if (called-interactively-p 'any) 'error 'message)
+ (if image-use-external-converter
+ "Unknown image type"
+ "Unknown image type; consider switching `image-use-external-converter' on"))
+ nil)
+ (error
+ (image-mode-as-text)
+ (funcall
+ (if (called-interactively-p 'any) 'error 'message)
+ "Cannot display image: %s" (cdr err))
+ nil))
;; If attempt to display the image fails.
(if (not (image-get-display-property))
(error "Invalid image"))
@@ -706,7 +718,7 @@ A non-mage major mode found from `auto-mode-alist' or fundamental mode
displays an image file as text."
;; image-mode-as-text = normal-mode + image-minor-mode
(let ((previous-image-type image-type)) ; preserve `image-type'
- (major-mode-restore '(image-mode image-mode-maybe image-mode-as-text))
+ (major-mode-restore '(image-mode image-mode-as-text))
;; Restore `image-type' after `kill-all-local-variables' in `normal-mode'.
(setq image-type previous-image-type)
;; Enable image minor mode with `C-c C-c'.
@@ -756,8 +768,6 @@ on these modes."
(if (image-get-display-property)
"text" "an image or hex") ".")))
-(define-obsolete-function-alias 'image-mode-maybe 'image-mode "23.2")
-
(defun image-toggle-display-text ()
"Show the image file as text.
Remove text properties that display the image."
@@ -816,13 +826,21 @@ was inserted."
(- (nth 2 edges) (nth 0 edges))))
(max-height (when edges
(- (nth 3 edges) (nth 1 edges))))
- (type (if (image--imagemagick-wanted-p filename)
- 'imagemagick
- (image-type file-or-data nil data-p)))
(inhibit-read-only t)
(buffer-undo-list t)
(modified (buffer-modified-p))
- props image)
+ props image type)
+
+ ;; If the data in the current buffer isn't from an existing file,
+ ;; but we have a file name (this happens when visiting images from
+ ;; a zip file, for instance), provide a type hint based on the
+ ;; suffix.
+ (when (and data-p filename)
+ (setq data-p (intern (format "image/%s"
+ (file-name-extension filename)))))
+ (setq type (if (image--imagemagick-wanted-p filename)
+ 'imagemagick
+ (image-type file-or-data nil data-p)))
;; Get the rotation data from the file, if any.
(when (zerop image-transform-rotation) ; don't reset modified value
@@ -839,10 +857,13 @@ was inserted."
;; :scale 1: If we do not set this, create-image will apply
;; default scaling based on font size.
(setq image (if (not edges)
- (create-image file-or-data type data-p :scale 1)
+ (create-image file-or-data type data-p :scale 1
+ :format (and filename data-p))
(create-image file-or-data type data-p :scale 1
:max-width max-width
- :max-height max-height)))
+ :max-height max-height
+ ;; Type hint.
+ :format (and filename data-p))))
;; Discard any stale image data before looking it up again.
(image-flush image)
@@ -1072,28 +1093,87 @@ replacing the current Image mode buffer."
(error "The buffer is not in Image mode"))
(unless buffer-file-name
(error "The current image is not associated with a file"))
- (let* ((file (file-name-nondirectory buffer-file-name))
- (images (image-mode--images-in-directory file))
- (idx 0))
- (catch 'image-visit-next-file
- (dolist (f images)
- (if (string= f file)
- (throw 'image-visit-next-file (1+ idx)))
- (setq idx (1+ idx))))
- (setq idx (mod (+ idx (or n 1)) (length images)))
- (let ((image (nth idx images))
- (dir (file-name-directory buffer-file-name)))
- (find-alternate-file image)
- ;; If we have dired buffer(s) open to where this image is, then
- ;; place point on it.
+ (let ((next (image-mode--next-file buffer-file-name n)))
+ (unless next
+ (user-error "No %s file in this directory"
+ (if (> n 0)
+ "next"
+ "prev")))
+ (if (stringp next)
+ (find-alternate-file next)
+ (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
+tar mode buffers."
+ (let ((buffers nil)
+ (dir (file-name-directory file)))
+ (cond
+ ((and (boundp 'tar-superior-buffer)
+ tar-superior-buffer)
+ (when (buffer-live-p tar-superior-buffer)
+ (push (cons 'tar tar-superior-buffer) buffers)))
+ ((and (boundp 'archive-superior-buffer)
+ archive-superior-buffer)
+ (when (buffer-live-p archive-superior-buffer)
+ (push (cons 'archive archive-superior-buffer) buffers)))
+ (t
+ ;; Find a dired buffer.
(dolist (buffer (buffer-list))
- (with-current-buffer buffer
- (when (and (derived-mode-p 'dired-mode)
+ (with-current-buffer buffer
+ (when (and (derived-mode-p 'dired-mode)
(equal (file-truename dir)
(file-truename default-directory)))
- (save-window-excursion
- (switch-to-buffer (current-buffer) t t)
- (dired-goto-file (expand-file-name image dir)))))))))
+ (push (cons 'dired (current-buffer)) buffers))))
+ ;; If we can't find any buffers to navigate in, we open a dired
+ ;; buffer.
+ (unless buffers
+ (push (cons 'dired (find-file-noselect dir)) buffers)
+ (message "Opened a dired buffer on %s" dir))))
+ buffers))
+
+(declare-function archive-next-file-displayer "arc-mode")
+(declare-function tar-next-file-displayer "tar-mode")
+
+(defun image-mode--next-file (file n)
+ "Go to the next image file in the parent buffer of FILE.
+This is typically a dired buffer, but may also be a tar/archive buffer.
+Return the next image file from that buffer.
+If N is negative, go to the previous file."
+ (let ((regexp (image-file-name-regexp))
+ (buffers (image-mode--directory-buffers file))
+ next)
+ (dolist (buffer buffers)
+ ;; We do this traversal for all the dired buffers open on this
+ ;; directory. There probably is just one, but we want to move
+ ;; point in all of them.
+ (save-window-excursion
+ (switch-to-buffer (cdr buffer) t t)
+ (cl-case (car buffer)
+ ('dired
+ (dired-goto-file file)
+ (let (found)
+ (while (and (not found)
+ ;; Stop if we reach the end/start of the buffer.
+ (if (> n 0)
+ (not (eobp))
+ (not (bobp))))
+ (dired-next-line n)
+ (let ((candidate (dired-get-filename nil t)))
+ (when (and candidate
+ (string-match-p regexp candidate))
+ (setq found candidate))))
+ (if found
+ (setq next found)
+ ;; If we didn't find a next/prev file, then restore
+ ;; point.
+ (dired-goto-file file))))
+ ('archive
+ (setq next (archive-next-file-displayer file regexp n)))
+ ('tar
+ (setq next (tar-next-file-displayer file regexp n))))))
+ next))
(defun image-previous-file (&optional n)
"Visit the preceding image in the same directory as the current file.
diff --git a/lisp/image.el b/lisp/image.el
index 963991d6418..9ebb603086e 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -784,6 +784,7 @@ number, play until that number of seconds has elapsed."
(if (setq timer (image-animate-timer image))
(cancel-timer timer))
(plist-put (cdr image) :animate-buffer (current-buffer))
+ (plist-put (cdr image) :animate-tardiness 0)
(run-with-timer 0.2 nil #'image-animate-timeout
image (or index 0) (car animation)
0 limit (+ (float-time) 0.2)))))
@@ -848,9 +849,14 @@ The minimum delay between successive frames is `image-minimum-frame-delay'.
If the image has a non-nil :speed property, it acts as a multiplier
for the animation speed. A negative value means to animate in reverse."
+ ;; We keep track of "how late" image frames arrive. We decay the
+ ;; previous cumulative value by 10% and then add the current delay.
+ (plist-put (cdr image) :animate-tardiness
+ (+ (* (plist-get (cdr image) :animate-tardiness) 0.9)
+ (float-time (time-since target-time))))
(when (and (buffer-live-p (plist-get (cdr image) :animate-buffer))
- ;; Delayed more than two seconds more than expected.
- (or (time-less-p (time-since target-time) 2)
+ ;; Cumulatively delayed two seconds more than expected.
+ (or (< (plist-get (cdr image) :animate-tardiness) 2)
(progn
(message "Stopping animation; animation possibly too big")
nil)))
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index b8542bc3c35..3543be6de91 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -26,6 +26,7 @@
(require 'url)
(require 'url-cache)
+(require 'dns)
(eval-when-compile
(require 'subr-x))
@@ -38,6 +39,7 @@
"Whether to cache retrieved gravatars."
:type 'boolean
:group 'gravatar)
+(make-obsolete-variable 'gravatar-automatic-caching nil "28.1")
(defcustom gravatar-cache-ttl 2592000
"Time to live in seconds for gravatar cache entries.
@@ -47,6 +49,7 @@ is retrieved anew. The default value is 30 days."
;; Restricted :type to number of seconds.
:version "27.1"
:group 'gravatar)
+(make-obsolete-variable 'gravatar-cache-ttl nil "28.1")
(defcustom gravatar-rating "g"
"Most explicit Gravatar rating level to allow.
@@ -118,9 +121,95 @@ a gravatar for a given email address."
:version "27.1"
:group 'gravatar)
-(defconst gravatar-base-url
- "https://www.gravatar.com/avatar"
- "Base URL for getting gravatars.")
+(defconst gravatar-service-alist
+ `((gravatar . ,(lambda (_addr callback)
+ (funcall callback "https://www.gravatar.com/avatar")))
+ (unicornify . ,(lambda (_addr callback)
+ (funcall callback "https://unicornify.pictures/avatar/")))
+ (libravatar . ,#'gravatar--service-libravatar))
+ "Alist of supported gravatar services.")
+
+(defcustom gravatar-service 'gravatar
+ "Symbol denoting gravatar-like service to use.
+Note that certain services might ignore other options, such as
+`gravatar-default-image' or certain values as with
+`gravatar-rating'.
+
+Note that `'libravatar' has security implications: It can be used
+to track whether you're reading a specific mail."
+ :type `(choice ,@(mapcar (lambda (s) `(const ,(car s)))
+ gravatar-service-alist))
+ :version "28.1"
+ :link '(url-link "https://www.libravatar.org/")
+ :link '(url-link "https://unicornify.pictures/")
+ :link '(url-link "https://gravatar.com/")
+ :group 'gravatar)
+
+(defun gravatar--service-libravatar (addr callback)
+ "Find domain that hosts avatars for email address ADDR."
+ ;; implements https://wiki.libravatar.org/api/
+ (save-match-data
+ (if (not (string-match ".+@\\(.+\\)" addr))
+ (funcall callback "https://seccdn.libravatar.org/avatar")
+ (let ((domain (match-string 1 addr))
+ (records '(("_avatars-sec" . "https")
+ ("_avatars" . "http")))
+ func)
+ (setq func
+ (lambda (result)
+ (cond
+ ((and
+ result ;there is a result
+ (let* ((data (mapcar (lambda (record)
+ (dns-get 'data (cdr record)))
+ (dns-get 'answers result)))
+ (priorities (mapcar (lambda (r)
+ (dns-get 'priority r))
+ data))
+ (max-priority (if priorities
+ (apply #'max priorities)
+ 0))
+ (sum 0) top)
+ ;; Attempt to find all records with the same maximal
+ ;; priority, and calculate the sum of their weights.
+ (dolist (ent data)
+ (when (= max-priority (dns-get 'priority ent))
+ (setq sum (+ sum (dns-get 'weight ent)))
+ (push ent top)))
+ ;; In case there is more than one maximal priority
+ ;; record, choose one at random, while taking the
+ ;; individual record weights into consideration.
+ (catch 'done
+ (dolist (ent top)
+ (when (and (or (= 0 sum)
+ (<= 0 (random sum)
+ (dns-get 'weight ent)))
+ ;; Ensure that port and domain data are
+ ;; valid. In case non of the results
+ ;; were valid, `catch' will evaluate to
+ ;; nil, and the next cond clause will be
+ ;; tested.
+ (<= 1 (dns-get 'port ent) 65535)
+ (string-match-p "\\`[-.0-9A-Za-z]+\\'"
+ (dns-get 'target ent)))
+ (funcall callback
+ (url-normalize-url
+ (format "%s://%s:%s/avatar"
+ (cdar records)
+ (dns-get 'target ent)
+ (dns-get 'port ent))))
+ (throw 'done t))
+ (setq sum (- sum (dns-get 'weight ent))))))))
+ ((setq records (cdr records))
+ ;; In case there are at least two methods.
+ (dns-query-asynchronous
+ (concat (caar records) "._tcp." domain)
+ func 'SRV))
+ (t ;fallback
+ (funcall callback "https://seccdn.libravatar.org/avatar")))))
+ (dns-query-asynchronous
+ (concat (caar records) "._tcp." domain)
+ func 'SRV t)))))
(defun gravatar-hash (mail-address)
"Return the Gravatar hash for MAIL-ADDRESS."
@@ -138,13 +227,18 @@ a gravatar for a given email address."
,@(and gravatar-size
`((s ,gravatar-size))))))
-(defun gravatar-build-url (mail-address)
- "Return the URL of a gravatar for MAIL-ADDRESS."
+(defun gravatar-build-url (mail-address callback)
+ "Find the URL of a gravatar for MAIL-ADDRESS and call CALLBACK with it."
;; https://gravatar.com/site/implement/images/
- (format "%s/%s?%s"
- gravatar-base-url
- (gravatar-hash mail-address)
- (gravatar--query-string)))
+ (let ((query-string (gravatar--query-string)))
+ (funcall (alist-get gravatar-service gravatar-service-alist)
+ mail-address
+ (lambda (url)
+ (funcall callback
+ (format "%s/%s?%s"
+ url
+ (gravatar-hash mail-address)
+ query-string))))))
(defun gravatar-get-data ()
"Return body of current URL buffer, or nil on failure."
@@ -154,28 +248,62 @@ a gravatar for a given email address."
(search-forward "\n\n" nil t)
(buffer-substring (point) (point-max)))))
+(defvar gravatar--cache (make-hash-table :test 'equal)
+ "Cache for gravatars.")
+
;;;###autoload
(defun gravatar-retrieve (mail-address callback &optional cbargs)
"Asynchronously retrieve a gravatar for MAIL-ADDRESS.
When finished, call CALLBACK as (apply CALLBACK GRAVATAR CBARGS),
where GRAVATAR is either an image descriptor, or the symbol
`error' if the retrieval failed."
- (let ((url (gravatar-build-url mail-address)))
- (if (url-cache-expired url gravatar-cache-ttl)
- (url-retrieve url #'gravatar-retrieved (list callback cbargs) t)
- (with-current-buffer (url-fetch-from-cache url)
- (gravatar-retrieved () callback cbargs)))))
+ (let ((cached (gethash mail-address gravatar--cache)))
+ (gravatar--prune-cache)
+ (if cached
+ (apply callback (cdr cached) cbargs)
+ ;; Nothing in the cache, fetch it.
+ (gravatar-build-url
+ mail-address
+ (lambda (url)
+ (url-retrieve
+ url
+ (lambda (status)
+ (let* ((data (and (not (plist-get status :error))
+ (gravatar-get-data)))
+ (image (and data (create-image data nil t))))
+ ;; Store the image in the cache.
+ (when image
+ (setf (gethash mail-address gravatar--cache)
+ (cons (time-convert (current-time) 'integer)
+ image)))
+ (prog1
+ (apply callback (if data image 'error) cbargs)
+ (kill-buffer))))
+ nil t))))))
+
+(defun gravatar--prune-cache ()
+ (let ((expired nil)
+ (time (- (time-convert (current-time) 'integer)
+ ;; Twelve hours.
+ (* 12 60 60))))
+ (maphash (lambda (key val)
+ (when (< (car val) time)
+ (push key expired)))
+ gravatar--cache)
+ (dolist (key expired)
+ (remhash key gravatar--cache))))
;;;###autoload
(defun gravatar-retrieve-synchronously (mail-address)
"Synchronously retrieve a gravatar for MAIL-ADDRESS.
Value is either an image descriptor, or the symbol `error' if the
retrieval failed."
- (let ((url (gravatar-build-url mail-address)))
- (with-current-buffer (if (url-cache-expired url gravatar-cache-ttl)
- (url-retrieve-synchronously url t)
- (url-fetch-from-cache url))
- (gravatar-retrieved () #'identity))))
+ (let ((url nil))
+ (gravatar-build-url mail-address (lambda (u) (setq url u)))
+ (while (not url)
+ (sleep-for 0.01))
+ (with-current-buffer (url-retrieve-synchronously url t)
+ (gravatar-retrieved nil #'identity))))
(defun gravatar-retrieved (status cb &optional cbargs)
"Handle Gravatar response data in current buffer.
@@ -184,10 +312,6 @@ an image descriptor, or the symbol `error' on failure.
This function is intended as a callback for `url-retrieve'."
(let ((data (unless (plist-get status :error)
(gravatar-get-data))))
- (and data ; Only cache on success.
- url-current-object ; Only cache if not already cached.
- gravatar-automatic-caching
- (url-store-in-cache))
(prog1 (apply cb (if data (create-image data nil t) 'error) cbargs)
(kill-buffer))))
diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el
index b694052f5b9..c31a3b8d3cf 100644
--- a/lisp/image/image-converter.el
+++ b/lisp/image/image-converter.el
@@ -33,8 +33,15 @@
"Type of the external image converter to use.
The value should a symbol, either `imagemagick', `graphicsmagick',
or `ffmpeg'.
+
If nil, Emacs will try to find one of the supported converters
-installed on the system."
+installed on the system.
+
+The actual range of image formats that will be converted depends
+on what image formats the chosen converter reports being able to
+handle. `auto-mode-alist' is then used to further filter what
+formats that are to be supported: Only the suffixes that map to
+`image-mode' will be handled."
:group 'image
:type 'symbol
:version "27.1")
@@ -42,6 +49,9 @@ installed on the system."
(defvar image-converter-regexp nil
"A regexp that matches the file name suffixes that can be converted.")
+(defvar image-converter-file-name-extensions nil
+ "A list of file name suffixes that can be converted.")
+
(defvar image-converter--converters
'((graphicsmagick :command ("gm" "convert") :probe ("-list" "format"))
(ffmpeg :command "ffmpeg" :probe "-decoders")
@@ -58,9 +68,11 @@ is a string, it should be a MIME format string like
(unless image-converter
(image-converter--find-converter))
;; When image-converter was customized
- (if (and image-converter (not image-converter-regexp))
- (when-let ((formats (image-converter--probe image-converter)))
- (setq image-converter-regexp (concat "\\." (regexp-opt formats) "\\'"))))
+ (when (and image-converter (not image-converter-regexp))
+ (when-let ((formats (image-converter--probe image-converter)))
+ (setq image-converter-regexp
+ (concat "\\." (regexp-opt formats) "\\'"))
+ (setq image-converter-file-name-extensions formats)))
(and image-converter
(or (and (not data-p)
(string-match image-converter-regexp source))
@@ -181,11 +193,25 @@ data is returned as a string."
"Find an installed image converter."
(catch 'done
(dolist (elem image-converter--converters)
- (when-let ((formats (image-converter--probe (car elem))))
+ (when-let ((formats (image-converter--filter-formats
+ (image-converter--probe (car elem)))))
(setq image-converter (car elem)
- image-converter-regexp (concat "\\." (regexp-opt formats) "\\'"))
+ image-converter-regexp (concat "\\." (regexp-opt formats) "\\'")
+ image-converter-file-name-extensions formats)
(throw 'done image-converter)))))
+(defun image-converter--filter-formats (suffixes)
+ "Filter SUFFIXES based on `auto-mode-alist'.
+Only suffixes that map to `image-mode' are returned."
+ (cl-loop with case-fold-search = (if (not auto-mode-case-fold)
+ nil
+ t)
+ for suffix in suffixes
+ when (eq (cdr (assoc (concat "foo." suffix) auto-mode-alist
+ #'string-match))
+ 'image-mode)
+ collect suffix))
+
(cl-defmethod image-converter--convert ((type (eql graphicsmagick)) source
image-format)
"Convert using GraphicsMagick."
diff --git a/lisp/imenu.el b/lisp/imenu.el
index 1949f2f48f7..8fdacb0214d 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -316,28 +316,6 @@ PREVPOS is the variable in which we store the last position displayed."
)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; Some examples of functions utilizing the framework of this
-;;;; package.
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; FIXME: This was the only imenu-example-* definition actually used,
-;; by cperl-mode.el. Now cperl-mode has its own copy, so these can
-;; all be removed.
-(defun imenu-example--name-and-position ()
- "Return the current/previous sexp and its (beginning) location.
-Don't move point."
- (declare (obsolete "use your own function instead." "23.2"))
- (save-excursion
- (forward-sexp -1)
- ;; [ydi] modified for imenu-use-markers
- (let ((beg (if imenu-use-markers (point-marker) (point)))
- (end (progn (forward-sexp) (point))))
- (cons (buffer-substring beg end)
- beg))))
-
;;;
;;; Lisp
;;;
@@ -787,10 +765,13 @@ Return one of the entries in index-alist or nil."
index-alist))))
(when (stringp name)
(setq name (or (imenu-find-default name prepared-index-alist) name)))
- (cond (prompt)
- ((and name (imenu--in-alist name prepared-index-alist))
- (setq prompt (format "Index item (default %s): " name)))
- (t (setq prompt "Index item: ")))
+ (unless prompt
+ (setq prompt (format-prompt
+ "Index item"
+ (and name
+ (imenu--in-alist name prepared-index-alist)
+ ;; Default to `name' if it's in the alist.
+ name))))
(let ((minibuffer-setup-hook minibuffer-setup-hook))
;; Display the completion buffer.
(if (not imenu-eager-completion-buffer)
diff --git a/lisp/info-look.el b/lisp/info-look.el
index fb3237efbb1..bcc2930ffc0 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -75,7 +75,7 @@ List elements are cons cells of the form
If a file name matches REGEXP, then use help mode MODE instead of the
buffer's major mode."
- :group 'info-lookup :type '(repeat (cons (string :tag "Regexp")
+ :group 'info-lookup :type '(repeat (cons (regexp :tag "Regexp")
(symbol :tag "Mode"))))
(defvar info-lookup-history nil
@@ -297,9 +297,7 @@ If optional argument QUERY is non-nil, query for the help mode."
(completion-ignore-case (info-lookup->ignore-case topic mode))
(enable-recursive-minibuffers t)
(value (completing-read
- (if default
- (format "Describe %s (default %s): " topic default)
- (format "Describe %s: " topic))
+ (format-prompt "Describe %s" default topic)
completions nil nil nil 'info-lookup-history default)))
(list (if (equal value "") default value) mode)))
@@ -557,7 +555,7 @@ Return nil if there is nothing appropriate in the buffer near point."
(info-lookup->regexp topic mode)))
(start (point)) end regexp subexp result)
(save-excursion
- (if (symbolp rule)
+ (if (functionp rule)
(setq result (funcall rule))
(if (consp rule)
(setq regexp (car rule)
@@ -610,6 +608,7 @@ Return nil if there is nothing appropriate in the buffer near point."
(defun info-lookup-guess-custom-symbol ()
"Get symbol at point in custom buffers."
+ (declare (obsolete nil "28.1"))
(condition-case nil
(save-excursion
(let ((case-fold-search t)
@@ -1065,7 +1064,9 @@ Return nil if there is nothing appropriate in the buffer near point."
:mode 'Custom-mode
:ignore-case t
:regexp "[^][()`'‘’,:\" \t\n]+"
- :parse-rule 'info-lookup-guess-custom-symbol
+ :parse-rule (lambda ()
+ (when-let ((symbol (get-text-property (point) 'custom-data)))
+ (symbol-name symbol)))
:other-modes '(emacs-lisp-mode))
(info-lookup-maybe-add-help
diff --git a/lisp/info.el b/lisp/info.el
index 033a7a5cbb5..20633fd0598 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -956,6 +956,7 @@ This function first looks for a case-sensitive match for NODENAME;
if none is found it then tries a case-insensitive match (unless
STRICT-CASE is non-nil)."
(info-initialize)
+ (setq nodename (info--node-canonicalize-whitespace nodename))
(setq filename (Info-find-file filename))
;; Go into Info buffer.
(or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
@@ -1995,12 +1996,9 @@ the Top node in FILENAME."
"Search for REGEXP, starting from point, and select node it's found in.
If DIRECTION is `backward', search in the reverse direction."
(interactive (list (read-string
- (if Info-search-history
- (format "Regexp search%s (default %s): "
- (if case-fold-search "" " case-sensitively")
- (car Info-search-history))
- (format "Regexp search%s: "
- (if case-fold-search "" " case-sensitively")))
+ (format-prompt
+ "Regexp search%s" (car Info-search-history)
+ (if case-fold-search "" " case-sensitively"))
nil 'Info-search-history)))
(deactivate-mark)
(when (equal regexp "")
@@ -2124,12 +2122,9 @@ If DIRECTION is `backward', search in the reverse direction."
(defun Info-search-backward (regexp &optional bound noerror count)
"Search for REGEXP in the reverse direction."
(interactive (list (read-string
- (if Info-search-history
- (format "Regexp search%s backward (default %s): "
- (if case-fold-search "" " case-sensitively")
- (car Info-search-history))
- (format "Regexp search%s backward: "
- (if case-fold-search "" " case-sensitively")))
+ (format-prompt
+ "Regexp search%s backward" (car Info-search-history)
+ (if case-fold-search "" " case-sensitively"))
nil 'Info-search-history)))
(Info-search regexp bound noerror count 'backward))
@@ -2308,7 +2303,11 @@ If SAME-FILE is non-nil, do not move to a different Info file."
nil t))
(progn (beginning-of-line) (if (looking-at "^\\* ") (forward-char 2)))
(goto-char p)
- (Info-restore-point Info-history)))))
+ (Info-restore-point Info-history))))
+ ;; If scroll-conservatively is non-zero and less than 101, display
+ ;; as much of the superior node above the target line as possible.
+ (when (< 0 scroll-conservatively 101)
+ (recenter)))
(defun Info-history-back ()
"Go back in the history to the last node visited."
@@ -2686,14 +2685,16 @@ Because of ambiguities, this should be concatenated with something like
;;; (setq Info-point-loc
;;; (buffer-substring (match-beginning 0) (1- (match-beginning 1))))
)
- (replace-regexp-in-string
- "[ \n]+" " "
+ (info--node-canonicalize-whitespace
(or (and (not (equal (match-string-no-properties 2) ""))
(match-string-no-properties 2))
;; If the node name is the menu entry name (using `entry::').
(buffer-substring-no-properties
(match-beginning 0) (1- (match-beginning 1)))))))
+(defun info--node-canonicalize-whitespace (string)
+ (replace-regexp-in-string "[ \t\n]+" " " string))
+
;; No one calls this.
;;(defun Info-menu-item-sequence (list)
;; (while list
@@ -2771,6 +2772,8 @@ Because of ambiguities, this should be concatenated with something like
;; Go back to the start node (for the next completion).
(unless (equal Info-current-node orignode)
(Info-goto-node orignode))
+ ;; Arrange list to be in order found in node.
+ (setq completions (nreverse completions))
;; Update the cache.
(setq Info-complete-cache
(list Info-current-file Info-current-node
@@ -2810,10 +2813,7 @@ new buffer."
(while (null item)
(setq item (let ((completion-ignore-case t)
(Info-complete-menu-buffer (current-buffer)))
- (completing-read (if default
- (format "Menu item (default %s): "
- default)
- "Menu item: ")
+ (completing-read (format-prompt "Menu item" default)
#'Info-complete-menu-item nil t nil nil
default))))
(list item current-prefix-arg))))
@@ -3790,20 +3790,8 @@ Build a menu of the possible matches."
;; there is no "nxml.el" (it's nxml-mode.el).
;; But package.el makes the same assumption.
;; I think nxml is the only exception - maybe it should be just be renamed.
- (let ((str (ignore-errors (lm-commentary (find-library-name nodename)))))
- (if (null str)
- (insert "Can’t find package description.\n\n")
- (insert
- (with-temp-buffer
- (insert str)
- (goto-char (point-min))
- (delete-blank-lines)
- (goto-char (point-max))
- (delete-blank-lines)
- (goto-char (point-min))
- (while (re-search-forward "^;+ ?" nil t)
- (replace-match "" nil nil))
- (buffer-string))))))))
+ (insert (or (ignore-errors (lm-commentary (find-library-name nodename)))
+ (insert "Can’t find package description.\n\n"))))))
;;;###autoload
(defun info-finder (&optional keywords)
@@ -4065,6 +4053,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(define-key map "^" 'Info-up)
(define-key map "," 'Info-index-next)
(define-key map "\177" 'Info-scroll-down)
+ (define-key map [remap goto-line] 'goto-line-relative)
(define-key map [mouse-2] 'Info-mouse-follow-nearest-node)
(define-key map [follow-link] 'mouse-face)
(define-key map [XF86Back] 'Info-history-back)
@@ -4101,22 +4090,28 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
:help "Go to top node of file"]
["Final Node" Info-final-node
:help "Go to final node in this file"]
+ "---"
("Menu Item" ["You should never see this" report-emacs-bug t])
("Reference" ["You should never see this" report-emacs-bug t])
["Search..." Info-search
:help "Search for regular expression in this Info file"]
["Search Next" Info-search-next
:help "Search for another occurrence of regular expression"]
- ["Go to Node..." Info-goto-node
+ "---"
+ ("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
+ :help "Go forward in history"]
+ ["Show History" Info-history :active Info-history-list
+ :help "Go to menu of visited nodes"])
+ ("Go to"
+ ["Go to Node..." Info-goto-node
:help "Go to a named node"]
- ["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
- :help "Go forward in history"]
- ["History" Info-history :active Info-history-list
- :help "Go to menu of visited nodes"]
- ["Table of Contents" Info-toc
- :help "Go to table of contents"]
+ ["Table of Contents" Info-toc
+ :help "Go to table of contents"]
+ ["Go to Directory" Info-directory
+ :help "Go to the Info directory node."])
("Index"
["Lookup a String..." Info-index
:help "Look for a string in the index items"]
@@ -4130,6 +4125,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
:help "Copy the name of the current node into the kill ring"]
["Clone Info buffer" clone-buffer
:help "Create a twin copy of the current Info buffer."]
+ "---"
["Exit" quit-window :help "Stop reading Info"]))
@@ -4380,6 +4376,7 @@ Moving within a node:
already visible, try to go to the previous menu entry, or up
if there is none.
\\[beginning-of-buffer] Go to beginning of node.
+\\[end-of-buffer] Go to end of node.
Advanced commands:
\\[Info-search] Search through this Info file for specified regexp,
@@ -5145,9 +5142,8 @@ first line or header line, and for breadcrumb links.")
"Additional menu-items to add to speedbar frame.")
;; Make sure our special speedbar major mode is loaded
-(if (featurep 'speedbar)
- (Info-install-speedbar-variables)
- (add-hook 'speedbar-load-hook 'Info-install-speedbar-variables))
+(with-eval-after-load 'speedbar
+ (Info-install-speedbar-variables))
;;; Info hierarchy display method
;;;###autoload
diff --git a/lisp/informat.el b/lisp/informat.el
index 9873f66f215..7750ab00898 100644
--- a/lisp/informat.el
+++ b/lisp/informat.el
@@ -337,7 +337,7 @@ Check that every node pointer points to an existing node."
(point))))
(Info-extract-menu-node-name))))
(goto-char (point-min))
- (while (re-search-forward "\\*note[ \n]*[^:\t]*:" nil t)
+ (while (re-search-forward "\\*note\\>[^:\t]*:" nil t)
(goto-char (+ (match-beginning 0) 5))
(skip-chars-forward " \n")
(Info-validate-node-name
diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el
index d3ae23c2f70..3b3fcf4c041 100644
--- a/lisp/international/ccl.el
+++ b/lisp/international/ccl.el
@@ -196,7 +196,9 @@
"Embed integer DATA in `ccl-program-vector' at `ccl-current-ic' and
increment it. If IC is specified, embed DATA at IC."
(if ic
- (aset ccl-program-vector ic (ccl-fixnum data))
+ (aset ccl-program-vector ic (if (numberp data)
+ (ccl-fixnum data)
+ data))
(let ((len (length ccl-program-vector)))
(if (>= ccl-current-ic len)
(let ((new (make-vector (* len 2) nil)))
@@ -204,7 +206,9 @@ increment it. If IC is specified, embed DATA at IC."
(setq len (1- len))
(aset new len (aref ccl-program-vector len)))
(setq ccl-program-vector new))))
- (aset ccl-program-vector ccl-current-ic (ccl-fixnum data))
+ (aset ccl-program-vector ccl-current-ic (if (numberp data)
+ (ccl-fixnum data)
+ data))
(setq ccl-current-ic (1+ ccl-current-ic))))
(defun ccl-embed-symbol (symbol prop)
diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el
index 45e13462656..f5e70ce7021 100644
--- a/lisp/international/ja-dic-cnv.el
+++ b/lisp/international/ja-dic-cnv.el
@@ -48,7 +48,7 @@
(defvar ja-dic-filename "ja-dic.el")
(defun skkdic-convert-okuri-ari (skkbuf buf)
- (byte-compile-info-message "Processing OKURI-ARI entries")
+ (byte-compile-info "Processing OKURI-ARI entries" t)
(goto-char (point-min))
(with-current-buffer buf
(insert ";; Setting okuri-ari entries.\n"
@@ -97,7 +97,7 @@
("ゆき" "行")))
(defun skkdic-convert-postfix (skkbuf buf)
- (byte-compile-info-message "Processing POSTFIX entries")
+ (byte-compile-info "Processing POSTFIX entries" t)
(goto-char (point-min))
(with-current-buffer buf
(insert ";; Setting postfix entries.\n"
@@ -151,7 +151,7 @@
(defconst skkdic-prefix-list '(skkdic-prefix-list))
(defun skkdic-convert-prefix (skkbuf buf)
- (byte-compile-info-message "Processing PREFIX entries")
+ (byte-compile-info "Processing PREFIX entries" t)
(goto-char (point-min))
(with-current-buffer buf
(insert ";; Setting prefix entries.\n"
@@ -273,7 +273,7 @@
(defun skkdic-collect-okuri-nasi ()
(save-excursion
(let ((progress (make-progress-reporter
- (byte-compile-info-message "Collecting OKURI-NASI entries")
+ (byte-compile-info "Collecting OKURI-NASI entries" t)
(point) (point-max)
nil 10)))
(while (re-search-forward "^\\(\\cH+\\) \\(/\\cj.*\\)/$"
@@ -301,7 +301,7 @@
"(skkdic-set-okuri-nasi\n")
(let ((l (nreverse skkdic-okuri-nasi-entries))
(progress (make-progress-reporter
- (byte-compile-info-message "Processing OKURI-NASI entries")
+ (byte-compile-info "Processing OKURI-NASI entries" t)
0 skkdic-okuri-nasi-entries-count
nil 10))
(count 0))
@@ -531,8 +531,7 @@ To get complete usage, invoke:
',(let ((l entries)
(map '(skdic-okuri-nasi))
(progress (make-progress-reporter
- (byte-compile-info-message
- "Extracting OKURI-NASI entries")
+ (byte-compile-info "Extracting OKURI-NASI entries")
0 (length entries)))
(count 0)
entry)
diff --git a/lisp/international/kinsoku.el b/lisp/international/kinsoku.el
index 54bf0e95313..4e9b6b015a5 100644
--- a/lisp/international/kinsoku.el
+++ b/lisp/international/kinsoku.el
@@ -182,4 +182,6 @@ the context of text formatting."
(aref (char-category-set (preceding-char)) ?<))
(kinsoku-shorter linebeg))))
+(provide 'kinsoku)
+
;;; kinsoku.el ends here
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 9644b0effd6..e3155dfc52c 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -283,53 +283,57 @@ wrong, use this command again to toggle back to the right mode."
(interactive)
(view-file (expand-file-name "HELLO" data-directory)))
+(defvar mule-cmds--prefixed-command-next-coding-system nil)
+(defvar mule-cmds--prefixed-command-last-coding-system nil)
+
+(defun mule-cmds--prefixed-command-pch ()
+ (if (not mule-cmds--prefixed-command-next-coding-system)
+ (progn
+ (remove-hook 'pre-command-hook #'mule-cmds--prefixed-command-pch)
+ (remove-hook 'prefix-command-echo-keystrokes-functions
+ #'mule-cmds--prefixed-command-echo)
+ (remove-hook 'prefix-command-preserve-state-hook
+ #'mule-cmds--prefixed-command-preserve))
+ (setq this-command
+ (let ((cmd this-command)
+ (coding-system mule-cmds--prefixed-command-next-coding-system))
+ (lambda ()
+ (interactive)
+ (setq this-command cmd)
+ (let ((coding-system-for-read coding-system)
+ (coding-system-for-write coding-system)
+ (coding-system-require-warning t))
+ (call-interactively cmd)))))
+ (setq mule-cmds--prefixed-command-last-coding-system
+ mule-cmds--prefixed-command-next-coding-system)
+ (setq mule-cmds--prefixed-command-next-coding-system nil)))
+
+(defun mule-cmds--prefixed-command-echo ()
+ (when mule-cmds--prefixed-command-next-coding-system
+ (format "With coding-system %S"
+ mule-cmds--prefixed-command-next-coding-system)))
+
+(defun mule-cmds--prefixed-command-preserve ()
+ (setq mule-cmds--prefixed-command-next-coding-system
+ mule-cmds--prefixed-command-last-coding-system))
+
(defun universal-coding-system-argument (coding-system)
- "Execute an I/O command using the specified coding system."
+ "Execute an I/O command using the specified CODING-SYSTEM."
(interactive
(let ((default (and buffer-file-coding-system
(not (eq (coding-system-type buffer-file-coding-system)
'undecided))
buffer-file-coding-system)))
(list (read-coding-system
- (if default
- (format "Coding system for following command (default %s): " default)
- "Coding system for following command: ")
+ (format-prompt "Coding system for following command" default)
default))))
- ;; FIXME: This "read-key-sequence + call-interactively" loop is trying to
- ;; reproduce the normal command loop, but this "can't" be done faithfully so
- ;; it necessarily suffers from breakage in corner cases (e.g. it fails to run
- ;; pre/post-command-hook, doesn't properly set this-command/last-command, it
- ;; doesn't handle keyboard macros, ...).
- (let* ((keyseq (read-key-sequence
- (format "Command to execute with %s:" coding-system)))
- (cmd (key-binding keyseq)))
- ;; read-key-sequence ignores quit, so make an explicit check.
- (if (equal last-input-event (nth 3 (current-input-mode)))
- (keyboard-quit))
- (when (memq cmd '(universal-argument digit-argument))
- (call-interactively cmd)
-
- ;; Process keys bound in `universal-argument-map'.
- (while (progn
- (setq keyseq (read-key-sequence nil t)
- cmd (key-binding keyseq t))
- (memq cmd '(negative-argument digit-argument
- universal-argument-more)))
- (setq current-prefix-arg prefix-arg prefix-arg nil)
- ;; Have to bind `last-command-event' here so that
- ;; `digit-argument', for instance, can compute the
- ;; `prefix-arg'.
- (setq last-command-event (aref keyseq 0))
- (call-interactively cmd)))
-
- (let ((coding-system-for-read coding-system)
- (coding-system-for-write coding-system)
- (coding-system-require-warning t))
- (setq current-prefix-arg prefix-arg prefix-arg nil)
- ;; Have to bind `last-command-event' e.g. for `self-insert-command'.
- (setq last-command-event (aref keyseq 0))
- (message "")
- (call-interactively cmd))))
+ (prefix-command-preserve-state)
+ (setq mule-cmds--prefixed-command-next-coding-system coding-system)
+ (add-hook 'pre-command-hook #'mule-cmds--prefixed-command-pch)
+ (add-hook 'prefix-command-echo-keystrokes-functions
+ #'mule-cmds--prefixed-command-echo)
+ (add-hook 'prefix-command-preserve-state-hook
+ #'mule-cmds--prefixed-command-preserve))
(defun set-default-coding-systems (coding-system)
"Set default value of various coding systems to CODING-SYSTEM.
@@ -607,9 +611,8 @@ When called from a program, the value is the position of the unencodable
character found, or nil if all characters are encodable."
(interactive
(list (let ((default (or buffer-file-coding-system 'us-ascii)))
- (read-coding-system
- (format "Coding-system (default %s): " default)
- default))))
+ (read-coding-system (format-prompt "Coding-system" default)
+ default))))
(let ((pos (unencodable-char-position (point) (point-max) coding-system)))
(if pos
(goto-char (1+ pos))
@@ -700,8 +703,8 @@ DEFAULT is the coding system to use by default in the query."
;; buffer is displayed.
(when (and unsafe (not (stringp from)))
(pop-to-buffer bufname)
- (goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x)))
- unsafe))))
+ (goto-char (apply #'min (mapcar (lambda (x) (or (car (cadr x)) (point-max)))
+ unsafe))))
;; Then ask users to select one from CODINGS while showing
;; the reason why none of the defaults are not used.
(with-output-to-temp-buffer "*Warning*"
@@ -798,9 +801,8 @@ or specify any other coding system (and risk losing\n\
;; Read a coding system.
(setq coding-system
- (read-coding-system
- (format "Select coding system (default %s): " default)
- default))
+ (read-coding-system (format-prompt "Select coding system" default)
+ default))
(setq last-coding-system-specified coding-system))
(kill-buffer "*Warning*")
@@ -1402,13 +1404,13 @@ The commands `describe-input-method' and `list-input-methods' need
these duplicated values to show some information about input methods
without loading the relevant Quail packages.
\n(fn INPUT-METHOD LANG-ENV ACTIVATE-FUNC TITLE DESCRIPTION &rest ARGS)"
- (if (symbolp lang-env)
- (setq lang-env (symbol-name lang-env))
- (setq lang-env (purecopy lang-env)))
- (if (symbolp input-method)
- (setq input-method (symbol-name input-method))
- (setq input-method (purecopy input-method)))
- (setq args (mapcar 'purecopy args))
+ (setq lang-env (if (symbolp lang-env)
+ (symbol-name lang-env)
+ (purecopy lang-env)))
+ (setq input-method (if (symbolp input-method)
+ (symbol-name input-method)
+ (purecopy input-method)))
+ (setq args (mapcar #'purecopy args))
(let ((info (cons lang-env args))
(slot (assoc input-method input-method-alist)))
(if slot
@@ -1797,13 +1799,11 @@ The default status is as follows:
'raw-text)
(set-default-coding-systems nil)
- (setq default-sendmail-coding-system 'iso-latin-1)
- ;; On Darwin systems, this should be utf-8-unix, but when this file is loaded
- ;; that is not yet defined, so we set it in set-locale-environment instead.
- ;; [Actually, it seems to work fine to use utf-8-unix here, and not just
- ;; on Darwin. The previous comment seems to be outdated?
- ;; See patch at https://debbugs.gnu.org/15803 ]
- (setq default-file-name-coding-system 'iso-latin-1-unix)
+ (setq default-sendmail-coding-system 'utf-8)
+ (setq default-file-name-coding-system (if (memq system-type
+ '(window-nt ms-dos))
+ 'iso-latin-1-unix
+ 'utf-8-unix))
;; Preserve eol-type from existing default-process-coding-systems.
;; On non-unix-like systems in particular, these may have been set
;; carefully by the user, or by the startup code, to deal with the
@@ -1819,8 +1819,10 @@ The default status is as follows:
(input-coding
(condition-case nil
(coding-system-change-text-conversion
- (cdr default-process-coding-system) 'iso-latin-1)
- (coding-system-error 'iso-latin-1))))
+ (cdr default-process-coding-system)
+ (if (memq system-type '(window-nt ms-dos)) 'iso-latin-1 'utf-8))
+ (coding-system-error
+ (if (memq system-type '(window-nt ms-dos)) 'iso-latin-1 'utf-8)))))
(setq default-process-coding-system
(cons output-coding input-coding)))
@@ -2064,12 +2066,6 @@ See `set-language-info-alist' for use in programs."
"Do various unibyte-mode setups for language environment LANGUAGE-NAME."
(set-display-table-and-terminal-coding-system language-name))
-(defun princ-list (&rest args)
- "Print all arguments with `princ', then print \"\\n\"."
- (declare (obsolete "use mapc and princ instead." "23.3"))
- (mapc #'princ args)
- (princ "\n"))
-
(put 'describe-specified-language-support 'apropos-inhibit t)
;; Print language-specific information such as input methods,
@@ -2962,11 +2958,6 @@ on encoding."
;; Doc said "obsolete" in 23.1, this statement only added in 24.1.
(make-obsolete 'unify-8859-on-decoding-mode "don't use it." "23.1")
-(defvar nonascii-insert-offset 0)
-(make-obsolete-variable 'nonascii-insert-offset "do not use it." "23.1")
-(defvar nonascii-translation-table nil)
-(make-obsolete-variable 'nonascii-translation-table "do not use it." "23.1")
-
(defvar ucs-names nil
"Hash table of cached CHAR-NAME keys to CHAR-CODE values.")
@@ -3015,6 +3006,15 @@ on encoding."
;; higher code, so it gets pushed later!
(if new-name (puthash new-name c names))
(if old-name (puthash old-name c names))
+ ;; Unicode uses the spelling "lamda" in character
+ ;; names, instead of "lambda", due to "preferences
+ ;; expressed by the Greek National Body" (Bug#30513).
+ ;; Some characters have an old-name with the "lambda"
+ ;; spelling, but others don't. Add the traditional
+ ;; spelling for more convenient completion.
+ (when (and (not old-name) new-name
+ (string-match "\\<LAMDA\\>" new-name))
+ (puthash (replace-match "LAMBDA" t t new-name) c names))
(setq c (1+ c))))))
;; Special case for "BELL" which is apparently the only char which
;; doesn't have a new name and whose old-name is shadowed by a newer
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index e6e6135243f..c84f0a49901 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -1508,6 +1508,7 @@ for decoding and encoding files, process I/O, etc."
:mime-charset 'us-ascii)
(define-coding-system-alias 'iso-safe 'us-ascii)
+(define-coding-system-alias 'ascii 'us-ascii)
(define-coding-system 'utf-7
"UTF-7 encoding of Unicode (RFC 2152)."
@@ -1517,6 +1518,10 @@ for decoding and encoding files, process I/O, etc."
:charset-list '(unicode)
:pre-write-conversion 'utf-7-pre-write-conversion
:post-read-conversion 'utf-7-post-read-conversion)
+;; FIXME: 'define-coding-system' automatically sets :ascii-compatible-p,
+;; to any encoding whose :coding-type is 'utf-8', but UTF-7 is not ASCII
+;; compatible, so we override that here (bug#40407).
+(coding-system-put 'utf-7 :ascii-compatible-p nil)
(define-coding-system 'utf-7-imap
"UTF-7 encoding of Unicode, IMAP version (RFC 2060)"
@@ -1525,6 +1530,8 @@ for decoding and encoding files, process I/O, etc."
:charset-list '(unicode)
:pre-write-conversion 'utf-7-imap-pre-write-conversion
:post-read-conversion 'utf-7-imap-post-read-conversion)
+;; See comment for utf-7 above.
+(coding-system-put 'utf-7-imap :ascii-compatible-p nil)
;; Use us-ascii for terminal output if some other coding system is not
;; specified explicitly.
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 80e78ef7877..b13bde58ca1 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -200,10 +200,6 @@ Character sets for defining other charsets, or for backward compatibility
;;; (charset-iso-graphic-plane charset)
(charset-description charset)))))
-(defvar non-iso-charset-alist nil
- "Obsolete.")
-(make-obsolete-variable 'non-iso-charset-alist "no longer relevant." "23.1")
-
;; A variable to hold charset input history.
(defvar charset-history nil)
diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el
index 5cc10b1315a..660ac58e022 100644
--- a/lisp/international/mule-util.el
+++ b/lisp/international/mule-util.el
@@ -275,15 +275,6 @@ operations such as `find-coding-systems-region'."
(put 'with-coding-priority 'edebug-form-spec t)
;;;###autoload
-(defmacro detect-coding-with-priority (from to priority-list)
- "Detect a coding system of the text between FROM and TO with PRIORITY-LIST.
-PRIORITY-LIST is an alist of coding categories vs the corresponding
-coding systems ordered by priority."
- (declare (obsolete with-coding-priority "23.1"))
- `(with-coding-priority (mapcar #'cdr ,priority-list)
- (detect-coding-region ,from ,to)))
-
-;;;###autoload
(defun detect-coding-with-language-environment (from to lang-env)
"Detect a coding system for the text between FROM and TO with LANG-ENV.
The detection takes into account the coding system priorities for the
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 86f3d2a34bf..c4febb26d4f 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -30,12 +30,13 @@
;;; Code:
-;; FIXME? Are these still relevant? Nothing uses them AFAICS.
(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")
(defconst mule-version-date "2003.9.1" "\
Distribution date of this version of MULE (multilingual environment).")
+(make-obsolete-variable 'mule-version-date nil "28.1")
;;; CHARSET
@@ -407,16 +408,6 @@ PLIST (property list) may contain any type of information a user
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
-(defun charset-id (_charset)
- "Always return 0. This is provided for backward compatibility."
- (declare (obsolete nil "23.1"))
- 0)
-
-(defmacro charset-bytes (_charset)
- "Always return 0. This is provided for backward compatibility."
- (declare (obsolete nil "23.1"))
- 0)
-
(defun get-charset-property (charset propname)
"Return the value of CHARSET's PROPNAME property.
This is the last value stored with
@@ -462,19 +453,8 @@ Return -1 if charset isn't an ISO 2022 one."
"Return long name of CHARSET."
(plist-get (charset-plist charset) :long-name))
-(defun charset-list ()
- "Return list of all charsets ever defined."
- (declare (obsolete charset-list "23.1"))
- charset-list)
-
;;; CHARACTER
-(define-obsolete-function-alias 'char-valid-p 'characterp "23.1")
-
-(defun generic-char-p (_char)
- "Always return nil. This is provided for backward compatibility."
- (declare (obsolete nil "23.1"))
- nil)
(defun make-char-internal (charset-id &optional code1 code2)
(let ((charset (aref emacs-mule-charset-table charset-id)))
@@ -768,11 +748,12 @@ decoded by the coding system itself and before any functions in
`after-insert-functions' are called. This function is passed one
argument: the number of characters in the text to convert, with
point at the start of the text. The function should leave point
-unchanged, and should return the new character count. Note that
-this function should avoid reading from files or receiving text
-from subprocesses -- anything that could invoke decoding; if it
-must do so, it should bind `coding-system-for-read' to a value
-other than the current coding-system, to avoid infinite recursion.
+and the match data unchanged, and should return the new character
+count. Note that this function should avoid reading from files
+or receiving text from subprocesses -- anything that could invoke
+decoding; if it must do so, it should bind
+`coding-system-for-read' to a value other than the current
+coding-system, to avoid infinite recursion.
`:pre-write-conversion'
@@ -780,13 +761,13 @@ VALUE must be a function to call after all functions in
`write-region-annotate-functions' and `buffer-file-format' are
called, and before the text is encoded by the coding system
itself. This function should convert the whole text in the
-current buffer. For backward compatibility, this function is
-passed two arguments which can be ignored. Note that this
-function should avoid writing to files or sending text to
-subprocesses -- anything that could invoke encoding; if it
-must do so, it should bind `coding-system-for-write' to a
-value other than the current coding-system, to avoid infinite
-recursion.
+current buffer, and leave the match data unchanged. For backward
+compatibility, this function is passed two arguments which can be
+ignored. Note that this function should avoid writing to files
+or sending text to subprocesses -- anything that could invoke
+encoding; if it must do so, it should bind
+`coding-system-for-write' to a value other than the current
+coding-system, to avoid infinite recursion.
`:default-char'
@@ -1083,14 +1064,11 @@ formats (e.g. iso-latin-1-unix, koi8-r-dos)."
(setq codings (cons alias codings))))))
codings))
-(defconst char-coding-system-table nil
- "It exists just for backward compatibility, and the value is always nil.")
-(make-obsolete-variable 'char-coding-system-table nil "23.1")
-
(defun transform-make-coding-system-args (name type &optional doc-string props)
"For internal use only.
Transform XEmacs style args for `make-coding-system' to Emacs style.
Value is a list of transformed arguments."
+ (declare (obsolete nil "28.1"))
(let ((mnemonic (string-to-char (or (plist-get props 'mnemonic) "?")))
(eol-type (plist-get props 'eol-type))
properties tmp)
@@ -1168,106 +1146,6 @@ Value is a list of transformed arguments."
(error "unsupported XEmacs style make-coding-style arguments: %S"
`(,name ,type ,doc-string ,props))))))
-(defun make-coding-system (coding-system type mnemonic doc-string
- &optional
- flags
- properties
- eol-type)
- "Define a new coding system CODING-SYSTEM (symbol).
-This function is provided for backward compatibility."
- (declare (obsolete define-coding-system "23.1"))
- ;; For compatibility with XEmacs, we check the type of TYPE. If it
- ;; is a symbol, perhaps, this function is called with XEmacs-style
- ;; arguments. Here, try to transform that kind of arguments to
- ;; Emacs style.
- (if (symbolp type)
- (let ((args (transform-make-coding-system-args coding-system type
- mnemonic doc-string)))
- (setq coding-system (car args)
- type (nth 1 args)
- mnemonic (nth 2 args)
- doc-string (nth 3 args)
- flags (nth 4 args)
- properties (nth 5 args)
- eol-type (nth 6 args))))
-
- (setq type
- (cond ((eq type 0) 'emacs-mule)
- ((eq type 1) 'shift-jis)
- ((eq type 2) 'iso2022)
- ((eq type 3) 'big5)
- ((eq type 4) 'ccl)
- ((eq type 5) 'raw-text)
- (t
- (error "Invalid coding system type: %s" type))))
-
- (setq properties
- (let ((plist nil) key)
- (dolist (elt properties)
- (setq key (car elt))
- (cond ((eq key 'post-read-conversion)
- (setq key :post-read-conversion))
- ((eq key 'pre-write-conversion)
- (setq key :pre-write-conversion))
- ((eq key 'translation-table-for-decode)
- (setq key :decode-translation-table))
- ((eq key 'translation-table-for-encode)
- (setq key :encode-translation-table))
- ((eq key 'safe-charsets)
- (setq key :charset-list))
- ((eq key 'mime-charset)
- (setq key :mime-charset))
- ((eq key 'valid-codes)
- (setq key :valids)))
- (setq plist (plist-put plist key (cdr elt))))
- plist))
- (setq properties (plist-put properties :mnemonic mnemonic))
- (plist-put properties :coding-type type)
- (cond ((eq eol-type 0) (setq eol-type 'unix))
- ((eq eol-type 1) (setq eol-type 'dos))
- ((eq eol-type 2) (setq eol-type 'mac))
- ((vectorp eol-type) (setq eol-type nil)))
- (plist-put properties :eol-type eol-type)
-
- (cond
- ((eq type 'iso2022)
- (plist-put properties :flags
- (list (and (or (consp (nth 0 flags))
- (consp (nth 1 flags))
- (consp (nth 2 flags))
- (consp (nth 3 flags))) 'designation)
- (or (nth 4 flags) 'long-form)
- (and (nth 5 flags) 'ascii-at-eol)
- (and (nth 6 flags) 'ascii-at-cntl)
- (and (nth 7 flags) '7-bit)
- (and (nth 8 flags) 'locking-shift)
- (and (nth 9 flags) 'single-shift)
- (and (nth 10 flags) 'use-roman)
- (and (nth 11 flags) 'use-oldjis)
- (or (nth 12 flags) 'direction)
- (and (nth 13 flags) 'init-at-bol)
- (and (nth 14 flags) 'designate-at-bol)
- (and (nth 15 flags) 'safe)
- (and (nth 16 flags) 'latin-extra)))
- (plist-put properties :designation
- (let ((vec (make-vector 4 nil)))
- (dotimes (i 4)
- (let ((spec (nth i flags)))
- (if (eq spec t)
- (aset vec i '(94 96))
- (if (consp spec)
- (progn
- (if (memq t spec)
- (setq spec (append (delq t spec) '(94 96))))
- (aset vec i spec))))))
- vec)))
-
- ((eq type 'ccl)
- (plist-put properties :ccl-decoder (car flags))
- (plist-put properties :ccl-encoder (cdr flags))))
-
- (apply 'define-coding-system coding-system doc-string properties))
-
(defun merge-coding-systems (first second)
"Fill in any unspecified aspects of coding system FIRST from SECOND.
Return the resulting coding system."
@@ -1369,7 +1247,7 @@ Internal use only.")
(concat "\\(?:" completion-pcm--delim-wild-regex
"\\|\\([[:alpha:]]\\)[[:digit:]]\\)"))
(cs (completing-read
- (format "Coding system for saving file (default %s): " default)
+ (format-prompt "Coding system for saving file" default)
combined-table
nil t nil 'coding-system-history
(if default (symbol-name default)))))
@@ -1472,8 +1350,7 @@ graphical terminals."
default-terminal-coding-system)
default-terminal-coding-system)))
(read-coding-system
- (format "Coding system for terminal display (default %s): "
- default)
+ (format-prompt "Coding system for terminal display" default)
default))))
(if (and (not coding-system)
(not (terminal-coding-system)))
@@ -1506,8 +1383,7 @@ graphical terminals."
(default (if (eq (coding-system-type coding) 'raw-text)
default-keyboard-coding-system)))
(read-coding-system
- (format "Coding system for keyboard input (default %s): "
- default)
+ (format-prompt "Coding system for keyboard input" default)
default))))
(let ((coding-type (coding-system-type coding-system))
(saved-meta-mode
@@ -1602,10 +1478,8 @@ the text is encoded or decoded by CODING-SYSTEM."
This setting is effective for the next communication only."
(interactive
(list (read-coding-system
- (if last-next-selection-coding-system
- (format "Coding system for the next selection (default %S): "
- last-next-selection-coding-system)
- "Coding system for the next selection: ")
+ (format-prompt "Coding system for the next selection"
+ last-next-selection-coding-system)
last-next-selection-coding-system)))
(if coding-system
(setq last-next-selection-coding-system coding-system)
@@ -1614,15 +1488,6 @@ This setting is effective for the next communication only."
(setq next-selection-coding-system coding-system))
-(defun set-coding-priority (arg)
- "Set priority of coding categories according to ARG.
-ARG is a list of coding categories ordered by priority.
-
-This function is provided for backward compatibility."
- (declare (obsolete set-coding-system-priority "23.1"))
- (apply 'set-coding-system-priority
- (mapcar #'(lambda (x) (symbol-value x)) arg)))
-
;;; X selections
(defvar ctext-non-standard-encodings-alist
@@ -2301,8 +2166,7 @@ Part of the job of this function is setting `buffer-undo-list' appropriately."
(read-coding-system "Text was really in: ")
(let ((coding (or buffer-file-coding-system last-coding-system-used)))
(read-coding-system
- (concat "But was interpreted as"
- (if coding (format " (default %S): " coding) ": "))
+ (format-prompt "But was interpreted as" coding)
coding))))
(or (and new-coding coding)
(error "Coding system not specified"))
diff --git a/lisp/international/ogonek.el b/lisp/international/ogonek.el
index 9ab9e3b0f65..37fcda70b37 100644
--- a/lisp/international/ogonek.el
+++ b/lisp/international/ogonek.el
@@ -300,9 +300,8 @@ The functions come in the following groups.
Store the name in the parameter-variable DEFAULT-NAME-VAR.
PROMPT is a string to be shown when the user is asked for a name."
(let ((encoding
- (completing-read
- (format "%s (default %s): " prompt (symbol-value default-name-var))
- ogonek-name-encoding-alist nil t)))
+ (completing-read (format-prompt prompt (symbol-value default-name-var))
+ ogonek-name-encoding-alist nil t)))
;; change the default name to the one just read, and
;; return the new default as the name you read
(set default-name-var
@@ -314,8 +313,7 @@ The result is stored in the variable DEFAULT-PREFIX-VAR.
PROMPT is a string to be shown when the user is asked for a new prefix."
(let ((prefix-string
(read-string
- (format "%s (default %s): " prompt
- (char-to-string (eval default-prefix-var))))))
+ (format-prompt prompt (char-to-string (eval default-prefix-var))))))
(if (> (length prefix-string) 1)
(error "! Only one character expected")
;; set the default prefix character to the one just read
diff --git a/lisp/international/rfc1843.el b/lisp/international/rfc1843.el
index 7f09eb41d17..c59538f5469 100644
--- a/lisp/international/rfc1843.el
+++ b/lisp/international/rfc1843.el
@@ -60,7 +60,7 @@ e-mail transmission, news posting, etc."
(defcustom rfc1843-newsgroups-regexp "chinese\\|hz"
"Regexp of newsgroups in which might be HZ encoded."
- :type 'string
+ :type 'regexp
:group 'mime)
(defun rfc1843-decode-region (from to)
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index 4f1bcf2f94e..2da8635f80b 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -1,4 +1,4 @@
-;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding: utf-8-emacs; lexical-binding:t -*-
+;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding:iso-2022-7bit; lexical-binding:t -*-
;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -83,9 +83,9 @@
;; how to select a translation from a list of candidates.
(defvar quail-cxterm-package-ext-info
- '(("chinese-4corner" "四角")
- ("chinese-array30" "30")
- ("chinese-ccdospy" "缩拼"
+ '(("chinese-4corner" "$(0(?-F(B")
+ ("chinese-array30" "$(0#R#O(B")
+ ("chinese-ccdospy" "$AKuF4(B"
"Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
Pinyin is the standard Roman transliteration method for Chinese.
@@ -94,10 +94,10 @@ method `chinese-py'.
This input method works almost the same way as `chinese-py'. The
difference is that you type a single key for these Pinyin spelling.
- Pinyin: zh en eng ang ch an ao ai ong sh ing yu(ü)
+ Pinyin: zh en eng ang ch an ao ai ong sh ing yu($A(9(B)
keyseq: a f g h i j k l s u y v
For example:
- Chinese: 啊 果 中 文 光 玉 全
+ Chinese: $A0!(B $A9{(B $AVP(B $AND(B $A9b(B $ASq(B $AH+(B
Pinyin: a guo zhong wen guang yu quan
Keyseq: a1 guo4 as1 wf4 guh1 yu..6 qvj6
@@ -106,14 +106,14 @@ For example:
For double-width GB2312 characters corresponding to ASCII, use the
input method `chinese-qj'.")
- ("chinese-ecdict" "英漢"
+ ("chinese-ecdict" "$(05CKH(B"
"In this input method, you enter a Chinese (Big5) character or word
by typing the corresponding English word. For example, if you type
-\"computer\", \"電腦\" is input.
+\"computer\", \"$(0IZH+(B\" is input.
\\<quail-translation-docstring>")
- ("chinese-etzy" "倚注"
+ ("chinese-etzy" "$(06/0D(B"
"Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1',
`chinese-big5-2').
@@ -122,20 +122,20 @@ compose one Chinese character.
In this input method, you enter a Chinese character by first typing
keys corresponding to Zhuyin symbols (see the above table) followed by
-SPC, 1, 2, 3, or 4 specifying a tone (SPC:陰平, 1:輕聲, 2:陽平, 3: 上聲,
-4:去聲).
+SPC, 1, 2, 3, or 4 specifying a tone (SPC:$(0?v(N(B, 1:$(0M=Vy(B, 2:$(0Dm(N(B, 3: $(0&9Vy(B,
+4:$(0(+Vy(B).
\\<quail-translation-docstring>")
- ("chinese-punct-b5" "標B"
+ ("chinese-punct-b5" "$(0O:(BB"
"Input method for Chinese punctuation and symbols of Big5
\(`chinese-big5-1' and `chinese-big5-2').")
- ("chinese-punct" "标G"
+ ("chinese-punct" "$A1j(BG"
"Input method for Chinese punctuation and symbols of GB2312
\(`chinese-gb2312').")
- ("chinese-py-b5" "拼B"
+ ("chinese-py-b5" "$(03<(BB"
"Pinyin base input method for Chinese Big5 characters
\(`chinese-big5-1', `chinese-big5-2').
@@ -153,28 +153,28 @@ method `chinese-qj-b5'.
The input method `chinese-py' and `chinese-tonepy' are also Pinyin
based, but for the character set GB2312 (`chinese-gb2312').")
- ("chinese-qj-b5" "全B")
+ ("chinese-qj-b5" "$(0)A(BB")
- ("chinese-qj" "全G")
+ ("chinese-qj" "$AH+(BG")
- ("chinese-sw" "首尾"
+ ("chinese-sw" "$AJWN2(B"
"Radical base input method for Chinese charset GB2312 (`chinese-gb2312').
In this input method, you enter a Chinese character by typing two
-keys. The first key corresponds to the first (首) radical, the second
-key corresponds to the last (尾) radical. The correspondence of keys
+keys. The first key corresponds to the first ($AJW(B) radical, the second
+key corresponds to the last ($AN2(B) radical. The correspondence of keys
and radicals is as below:
first radical:
a b c d e f g h i j k l m n o p q r s t u v w x y z
- 心 冖 尸 丶 火 口 扌 氵 讠 艹 亻 木 礻 饣 月 纟 石 王 八 丿 日 辶 犭 竹 一 人
+ $APD(B $AZ"(B $AJ,(B $AX<(B $A;p(B $A?Z(B $A^P(B $Ac_(B $AZ%(B $A\3(B $AXi(B $AD>(B $Alj(B $Ab;(B $ATB(B $Afy(B $AJ/(B $AMu(B $A0K(B $AX/(B $AHU(B $AeA(B $Aak(B $AVq(B $AR;(B $AHK(B
last radical:
a b c d e f g h i j k l m n o p q r s t u v w x y z
- 又 山 土 刀 阝 口 衣 疋 大 丁 厶 灬 十 歹 冂 门 今 丨 女 乙 囗 小 厂 虫 弋 卜
+ $ASV(B $AI=(B $AMA(B $A56(B $AZb(B $A?Z(B $ARB(B $Aqb(B $A4s(B $A6!(B $A[L(B $Ala(B $AJ.(B $A4u(B $AXg(B $ACE(B $A=q(B $AX-(B $AE.(B $ARR(B $A`m(B $AP!(B $A3'(B $A3f(B $A_.(B $A27(B
\\<quail-translation-docstring>")
- ("chinese-tonepy" "调拼"
+ ("chinese-tonepy" "$A5wF4(B"
"Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
Pinyin is the standard roman transliteration method for Chinese.
@@ -183,18 +183,18 @@ method `chinese-py'.
This input method works almost the same way as `chinese-py'. The
difference is that you must type 1..5 after each Pinyin spelling to
-specify a tone (1:阴平, 2:阳平, 3:上声, 4下声, 5:轻声).
+specify a tone (1:$ARuF=(B, 2:$AQtF=(B, 3:$AIOIy(B, 4$AOBIy(B, 5:$AGaIy(B).
\\<quail-translation-docstring>
-For instance, to input 你, you type \"n i 3 3\", the first \"n i\" is
+For instance, to input $ADc(B, you type \"n i 3 3\", the first \"n i\" is
a Pinyin, the next \"3\" specifies tone, and the last \"3\" selects
the third character from the candidate list.
For double-width GB2312 characters corresponding to ASCII, use the
input method `chinese-qj'.")
- ("chinese-zozy" "零注"
+ ("chinese-zozy" "$(0I\0D(B"
"Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1',
`chinese-big5-2').
@@ -203,8 +203,8 @@ compose a Chinese character.
In this input method, you enter a Chinese character by first typing
keys corresponding to Zhuyin symbols (see the above table) followed by
-SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲,
-7:輕聲).
+SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B, 6:$(0Dm(N(B, 3:$(0&9Vy(B, 4:$(0(+Vy(B,
+7:$(0M=Vy(B).
\\<quail-translation-docstring>")))
@@ -354,7 +354,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲,
(princ (nth 2 (assoc tit-encode tit-encode-list)))
(princ "\" \"")
(princ (or title
- (if (string-match "[:∷:【]+\\([^:∷:】]+\\)" tit-prompt)
+ (if (string-match "[:$A!K$(0!(!J(B]+\\([^:$A!K$(0!(!K(B]+\\)" tit-prompt)
(substring tit-prompt (match-beginning 1) (match-end 1))
tit-prompt)))
(princ "\"\n"))
@@ -580,7 +580,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; )
(defvar quail-misc-package-ext-info
- '(("chinese-b5-tsangchi" "倉B"
+ '(("chinese-b5-tsangchi" "$(06A(BB"
"cangjie-table.b5" big5 "tsang-b5.el"
tsang-b5-converter
"\
@@ -590,7 +590,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-b5-quick" "簡B"
+ ("chinese-b5-quick" "$(0X|(BB"
"cangjie-table.b5" big5 "quick-b5.el"
quick-b5-converter
"\
@@ -600,7 +600,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-cns-tsangchi" "倉C"
+ ("chinese-cns-tsangchi" "$(GT?(BC"
"cangjie-table.cns" iso-2022-cn-ext "tsang-cns.el"
tsang-cns-converter
"\
@@ -610,7 +610,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-cns-quick" "簡C"
+ ("chinese-cns-quick" "$(Gv|(BC"
"cangjie-table.cns" iso-2022-cn-ext "quick-cns.el"
quick-cns-converter
"\
@@ -620,7 +620,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-py" "拼G"
+ ("chinese-py" "$AF4(BG"
"pinyin.map" cn-gb-2312 "PY.el"
py-converter
"\
@@ -648,7 +648,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; You should have received a copy of the GNU General Public License along with
;; CCE. If not, see <https://www.gnu.org/licenses/>.")
- ("chinese-ziranma" "自然"
+ ("chinese-ziranma" "$AWTH;(B"
"ziranma.cin" cn-gb-2312 "ZIRANMA.el"
ziranma-converter
"\
@@ -676,7 +676,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; You should have received a copy of the GNU General Public License along with
;; CCE. If not, see <https://www.gnu.org/licenses/>.")
- ("chinese-ctlau" "刘粤"
+ ("chinese-ctlau" "$AAuTA(B"
"CTLau.html" cn-gb-2312 "CTLau.el"
ctlau-gb-converter
"\
@@ -701,7 +701,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # You should have received a copy of the GNU General Public License
;; # along with this program. If not, see <https://www.gnu.org/licenses/>.")
- ("chinese-ctlaub" "劉粵"
+ ("chinese-ctlaub" "$(0N,Gn(B"
"CTLau-b5.html" big5 "CTLau-b5.el"
ctlau-b5-converter
"\
@@ -731,38 +731,38 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; dictionary in the buffer DICBUF. The input method name of the
;; Quail package is NAME, and the title string is TITLE.
-;; TSANG-P is non-nil, generate 倉頡 input method. Otherwise
-;; generate 簡易 (simple version of 倉頡). If BIG5-P is non-nil, the
+;; TSANG-P is non-nil, generate $(06AQo(B input method. Otherwise
+;; generate $(0X|/y(B (simple version of $(06AQo(B). If BIG5-P is non-nil, the
;; input method is for inputting Big5 characters. Otherwise the input
;; method is for inputting CNS characters.
(defun tsang-quick-converter (dicbuf tsang-p big5-p)
- (let ((fulltitle (if tsang-p (if big5-p "倉頡" "倉頡")
- (if big5-p "簡易" "簡易")))
+ (let ((fulltitle (if tsang-p (if big5-p "$(06AQo(B" "$(GT?on(B")
+ (if big5-p "$(0X|/y(B" "$(Gv|Mx(B")))
dic)
(goto-char (point-max))
(if big5-p
- (insert (format "\"中文輸入【%s】BIG5
+ (insert (format "\"$(0&d'GTT&,!J(B%s$(0!K(BBIG5
- 漢語%s輸入鍵盤
+ $(0KHM$(B%s$(0TT&,WoOu(B
- [Q 手] [W 田] [E 水] [R 口] [T 廿] [Y 卜] [U 山] [I 戈] [O 人] [P 心]
+ [Q $(0'D(B] [W $(0(q(B] [E $(0'V(B] [R $(0&H(B] [T $(0'>(B] [Y $(0&4(B] [U $(0&U(B] [I $(0'B(B] [O $(0&*(B] [P $(0'A(B]
- [A 日] [S 尸] [D 木] [F 火] [G 土] [H 竹] [J 十] [L 中]
+ [A $(0'K(B] [S $(0&T(B] [D $(0'N(B] [F $(0'W(B] [G $(0&I(B] [H $(0*M(B] [J $(0&3(B] [L $(0&d(B]
- [Z ] [X 難] [C 金] [V 女] [B 月] [N 弓] [M 一]
+ [Z ] [X $(0[E(B] [C $(01[(B] [V $(0&M(B] [B $(0'M(B] [N $(0&_(B] [M $(0&"(B]
\\\\<quail-translation-docstring>\"\n"
fulltitle fulltitle))
- (insert (format "\"中文輸入【%s】CNS
+ (insert (format "\"$(GDcEFrSD+!J(B%s$(G!K(BCNS
- 漢語%s輸入鍵盤
+ $(GiGk#(B%s$(GrSD+uomu(B
- [Q 手] [W 田] [E 水] [R 口] [T 廿] [Y 卜] [U 山] [I 戈] [O 人] [P 心]
+ [Q $(GEC(B] [W $(GFp(B] [E $(GEU(B] [R $(GDG(B] [T $(GE=(B] [Y $(GD3(B] [U $(GDT(B] [I $(GEA(B] [O $(GD)(B] [P $(GE@(B]
- [A 日] [S 尸] [D 木] [F 火] [G 土] [H 竹] [J 十] [L 中]
+ [A $(GEJ(B] [S $(GDS(B] [D $(GEM(B] [F $(GEV(B] [G $(GDH(B] [H $(GHL(B] [J $(GD2(B] [L $(GDc(B]
- [Z ] [X 難] [C 金] [V 女] [B 月] [N 弓] [M 一]
+ [Z ] [X $(GyE(B] [C $(GOZ(B] [V $(GDL(B] [B $(GEL(B] [N $(GD^(B] [M $(GD!(B]
\\\\<quail-translation-docstring>\"\n"
fulltitle fulltitle)))
@@ -795,38 +795,38 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
(forward-line 1)))
(maphash #'(lambda (key val) (setq dic (cons (cons key val) dic)))
table)))
- (setq dic (sort dic (function (lambda (x y) (string< (car x ) (car y))))))
+ (setq dic (sort dic (lambda (x y) (string< (car x ) (car y)))))
(dolist (elt dic)
(insert (format "(%S\t%S)\n" (car elt) (cdr elt))))
- (let ((punctuation '((";" ";﹔,、﹐﹑" ";﹔,、﹐﹑")
- (":" ":︰﹕.。‧﹒·" ":︰﹕.。・﹒·")
- ("'" "’‘" "’‘")
- ("\"" "”“〝〞〃" "”“〝〞〃")
- ("\\" "\﹨╲" "\﹨╲")
- ("|" "|︱︳∣" "︱︲|")
- ("/" "/∕╱" "/∕╱")
- ("?" "?﹖" "?﹖")
- ("<" "〈<﹤︿∠" "〈<﹤︿∠")
- (">" "〉>﹥﹀" "〉>﹦﹀")
- ("[" "〔【﹝︹︻「『﹁﹃" "〔【﹝︹︻「『﹁﹃")
- ("]" "〕】﹞︺︼」』﹂﹄" "〕】﹞︺︼」』﹂﹄")
- ("{" "{﹛︷ " "{﹛︷ ")
- ("}" "}﹜︸" "}﹜︸")
- ("`" "‵′" "′‵")
- ("~" "~﹋﹌︴﹏" "∼﹋﹌")
- ("!" "!﹗" "!﹗")
- ("@" "@﹫" "@﹫")
- ("#" "#﹟" "#﹟")
- ("$" "$﹩" "$﹩")
- ("%" "%﹪" "%﹪")
- ("&" "&﹠" "&﹠")
- ("*" "*﹡※☆★" "*﹡※☆★")
- ("(" "(﹙︵" "(﹙︵")
- (")" ")﹚︶" ")﹚︶")
- ("-" "–—¯ ̄-﹣" "—–‾-﹣")
- ("_" "_ˍ" "_")
- ("=" "=﹦" "=﹥")
- ("+" "+﹢" "+﹢"))))
+ (let ((punctuation '((";" "$(0!'!2!"!#!.!/(B" "$(G!'!2!"!#!.!/(B")
+ (":" "$(0!(!+!3!%!$!&!0!1(B" "$(G!(!+!3!%!$!&!0!1(B")
+ ("'" "$(0!e!d(B" "$(G!e!d(B")
+ ("\"" "$(0!g!f!h!i!q(B" "$(G!g!f!h!i!q(B")
+ ("\\" "$(0"`"b#M(B" "$(G"`"b#M(B")
+ ("|" "$(0!6!8!:"^(B" "$(G!6!8!:"^(B")
+ ("/" "$(0"_"a#L(B" "$(G"_"a#L(B")
+ ("?" "$(0!)!4(B" "$(G!)!4(B")
+ ("<" "$(0!R"6"A!T"H(B" "$(G!R"6"A!T"H(B")
+ (">" "$(0!S"7"B!U(B" "$(G!S"7"B!U(B")
+ ("[" "$(0!F!J!b!H!L!V!Z!X!\(B" "$(G!F!J!b!H!L!V!Z!X!\(B")
+ ("]" "$(0!G!K!c!I!M!W![!Y!](B" "$(G!G!K!c!I!M!W![!Y!](B")
+ ("{" "$(0!B!`!D(B " "$(G!B!`!D(B ")
+ ("}" "$(0!C!a!E(B" "$(G!C!a!E(B")
+ ("`" "$(0!j!k(B" "$(G!j!k(B")
+ ("~" "$(0"D"+",!<!=(B" "$(G"D"+",!<!=(B")
+ ("!" "$(0!*!5(B" "$(G!*!5(B")
+ ("@" "$(0"i"n(B" "$(G"i"n(B")
+ ("#" "$(0!l"-(B" "$(G!l"-(B")
+ ("$" "$(0"c"l(B" "$(G"c"l(B")
+ ("%" "$(0"h"m(B" "$(G"h"m(B")
+ ("&" "$(0!m".(B" "$(G!m".(B")
+ ("*" "$(0!n"/!o!w!x(B" "$(G!n"/!o!w!x(B")
+ ("(" "$(0!>!^!@(B" "$(G!>!^!@(B")
+ (")" "$(0!?!_!A(B" "$(G!?!_!A(B")
+ ("-" "$(0!7!9"#"$"1"@(B" "$(G!7!9"#"$"1"@(B")
+ ("_" "$(0"%"&(B" "$(G"%"&(B")
+ ("=" "$(0"8"C(B" "$(G"8"C(B")
+ ("+" "$(0"0"?(B" "$(G"0"?(B"))))
(dolist (elt punctuation)
(insert (format "(%S %S)\n" (concat "z" (car elt))
(if big5-p (nth 1 elt) (nth 2 elt))))))
@@ -850,11 +850,11 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
(defun py-converter (dicbuf)
(goto-char (point-max))
- (insert (format "%S\n" "汉字输入∷拼音∷
+ (insert (format "%S\n" "$A::WVJdHk!KF4Rt!K(B
- 拼音方案
+ $AF4Rt7=08(B
- 小写英文字母代表「拼音」符号, \"u(yu) 则用 u: 表示∶
+ $AP!P4S"NDWVD84z1m!8F4Rt!97{:E#,(B \"u(yu) $ATrSC(B u: $A1mJ>!C(B
Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
@@ -868,14 +868,14 @@ character. The sequence is made by the combination of the initials
iang ing iong u ua uo uai ui uan un uan ueng yu yue yuan yun
(Note: In the correct Pinyin writing, the sequence \"yu\" in the last
- four finals should be written by the character u-umlaut `ü'.)
+ four finals should be written by the character u-umlaut `$A(9(B'.)
With this input method, you enter a Chinese character by first
entering its pinyin spelling.
\\<quail-translation-docstring>
-For instance, to input 你, you type \"n i C-n 3\". The first \"n i\"
+For instance, to input $ADc(B, you type \"n i C-n 3\". The first \"n i\"
is a Pinyin, \"C-n\" selects the next group of candidates (each group
contains at most 10 characters), \"3\" select the third character in
that group.
@@ -956,24 +956,24 @@ method `chinese-tonepy' with which you must specify tones by digits
(setq trans (mapconcat 'identity trans "")))))
(setq dic (cons (cons key trans) dic)))
table)))
- (setq dic (sort dic (function (lambda (x y) (string< (car x) (car y))))))
+ (setq dic (sort dic (lambda (x y) (string< (car x) (car y)))))
(goto-char (point-max))
- (insert (format "%S\n" "汉字输入∷【自然】∷
-
- 键盘对照表:
- ┏━━┳━━┳━━┳━━┳━━┳━━┳━━┳━━┳━━┳━━┓
- ┃Q ┃W ┃E ┃R ┃T ┃Y ┃Ush┃Ich┃O ┃P ┃
- ┃ iu┃ ua┃ e┃ uan┃ ue┃ uai┃ u┃ i┃ o┃ un┃
- ┃ ┃ ia┃ ┃ van┃ ve┃ ing┃ ┃ ┃ uo┃ vn┃
- ┗┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┛
- ┃A ┃S ┃D ┃F ┃G ┃H ┃J ┃K ┃L ┃
- ┃ a┃iong┃uang┃ en┃ eng┃ ang┃ an┃ ao┃ ai┃
- ┃ ┃ ong┃iang┃ ┃ ng┃ ┃ ┃ ┃ ┃
- ┗┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━━┓
- ┃Z ┃X ┃C ┃Vzh┃B ┃N ┃M ┃, ┃. ┃ / ┃
- ┃ ei┃ ie┃ iao┃ ui┃ ou┃ in┃ ian┃前页┃后页┃符号┃
- ┃ ┃ ┃ ┃ v┃ ┃ ┃ ┃ ┃ ┃ ┃
- ┗━━┻━━┻━━┻━━┻━━┻━━┻━━┻━━┻━━┻━━┛
+ (insert (format "%S\n" "$A::WVJdHk!K!>WTH;!?!K(B
+
+ $A<|EL6TUU1m(B:
+ $A)3)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)7(B
+ $A)'#Q(B $A)'#W(B $A)'#E(B $A)'#R(B $A)'#T(B $A)'#Y(B $A)'#U(Bsh$A)'#I(Bch$A)'#O(B $A)'#P(B $A)'(B
+ $A)'(B iu$A)'(B ua$A)'(B e$A)'(B uan$A)'(B ue$A)'(B uai$A)'(B u$A)'(B i$A)'(B o$A)'(B un$A)'(B
+ $A)'(B $A)'(B ia$A)'(B $A)'(B van$A)'(B ve$A)'(B ing$A)'(B $A)'(B $A)'(B uo$A)'(B vn$A)'(B
+ $A);)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)?(B
+ $A)'#A(B $A)'#S(B $A)'#D(B $A)'#F(B $A)'#G(B $A)'#H(B $A)'#J(B $A)'#K(B $A)'#L(B $A)'(B
+ $A)'(B a$A)'(Biong$A)'(Buang$A)'(B en$A)'(B eng$A)'(B ang$A)'(B an$A)'(B ao$A)'(B ai$A)'(B
+ $A)'(B $A)'(B ong$A)'(Biang$A)'(B $A)'(B ng$A)'(B $A)'(B $A)'(B $A)'(B $A)'(B
+ $A);)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)%)7(B
+ $A)'#Z(B $A)'#X(B $A)'#C(B $A)'#V(Bzh$A)'#B(B $A)'#N(B $A)'#M(B $A)'#,(B $A)'#.(B $A)'(B $A#/(B $A)'(B
+ $A)'(B ei$A)'(B ie$A)'(B iao$A)'(B ui$A)'(B ou$A)'(B in$A)'(B ian$A)'G0R3)':sR3)'7{:E)'(B
+ $A)'(B $A)'(B $A)'(B $A)'(B v$A)'(B $A)'(B $A)'(B $A)'(B $A)'(B $A)'(B $A)'(B
+ $A);)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)?(B
Pinyin base input method for Chinese GB2312 characters (`chinese-gb2312').
@@ -985,34 +985,34 @@ method `chinese-py'.
Unlike the standard spelling of Pinyin, in this input method all
initials and finals are assigned to single keys (see the above table).
For instance, the initial \"ch\" is assigned to the key `i', the final
-\"iu\" is assigned to the key `q', and tones 1, 2, 3, 4, and 轻声 are
+\"iu\" is assigned to the key `q', and tones 1, 2, 3, 4, and $AGaIy(B are
assigned to the keys `q', `w', `e', `r', `t' respectively.
\\<quail-translation-docstring>
To input one-letter words, you type 4 keys, the first two for the
Pinyin of the letter, next one for tone, and the last one is always a
-quote ('). For instance, \"vsq'\" input 中. Exceptions are these
+quote ('). For instance, \"vsq'\" input $AVP(B. Exceptions are these
letters. You can input them just by typing a single key.
- Character: 按 不 次 的 二 发 个 和 出 及 可 了 没
+ Character: $A04(B $A2;(B $A4N(B $A5D(B $A6~(B $A7"(B $A8v(B $A:M(B $A3v(B $A<0(B $A?I(B $AAK(B $AC;(B
Key: a b c d e f g h i j k l m
- Character: 你 欧 片 七 人 三 他 是 着 我 小 一 在
+ Character: $ADc(B $AE7(B $AF,(B $AF_(B $AHK(B $AH}(B $AK{(B $AJG(B $AWE(B $ANR(B $AP!(B $AR;(B $ATZ(B
Key: n o p q r s t u v w x y z
To input two-letter words, you have two ways. One way is to type 4
keys, two for the first Pinyin, two for the second Pinyin. For
-instance, \"vsgo\" inputs 中国. Another way is to type 3 keys: 2
+instance, \"vsgo\" inputs $AVP9z(B. Another way is to type 3 keys: 2
initials of two letters, and quote ('). For instance, \"vg'\" also
-inputs 中国.
+inputs $AVP9z(B.
To input three-letter words, you type 4 keys: initials of three
-letters, and the last is quote ('). For instance, \"bjy'2\" inputs 北
-京鸭 (the last `2' is to select one of the candidates).
+letters, and the last is quote ('). For instance, \"bjy'2\" inputs $A11(B
+$A>)Q<(B (the last `2' is to select one of the candidates).
To input words of more than three letters, you type 4 keys, initials
of the first three letters and the last letter. For instance,
-\"bjdt\" inputs 北京电视台.
+\"bjdt\" inputs $A11>)5gJSL((B.
To input symbols and punctuation, type `/' followed by one of `a' to
`z', then select one of the candidates."))
@@ -1059,7 +1059,7 @@ To input symbols and punctuation, type `/' followed by one of `a' to
;; which the file is converted have no Big5 equivalent. Go
;; through and delete them.
(goto-char pos)
- (while (search-forward "□" nil t)
+ (while (search-forward "$(0!{(B" nil t)
(delete-char -1))
;; Uppercase keys in dictionary need to be downcased. Backslashes
;; at the beginning of keys need to be turned into double
@@ -1083,31 +1083,31 @@ To input symbols and punctuation, type `/' followed by one of `a' to
(defun ctlau-gb-converter (dicbuf)
(ctlau-converter dicbuf
-"汉字输入∷刘锡祥式粤音∷
+"$A::WVJdHk!KAuN}OiJ=TARt!K(B
- 刘锡祥式粤语注音方案
+ $AAuN}OiJ=TASoW"Rt7=08(B
Sidney Lau's Cantonese transcription scheme as described in his book
\"Elementary Cantonese\", The Government Printer, Hong Kong, 1972.
- This file was prepared by Fung Fung Lee (李枫峰).
+ This file was prepared by Fung Fung Lee ($A@n7c7e(B).
Originally converted from CTCPS3.tit
Last modified: June 2, 1993.
Some infrequent GB characters are accessed by typing \\, followed by
- the Cantonese romanization of the respective radical (部首)."))
+ the Cantonese romanization of the respective radical ($A2?JW(B)."))
(defun ctlau-b5-converter (dicbuf)
(ctlau-converter dicbuf
-"漢字輸入:劉錫祥式粵音:
+"$(0KH)tTT&,!(N,Tg>A*#Gn5x!((B
- 劉錫祥式粵語注音方案
+ $(0N,Tg>A*#GnM$0D5x'J7{(B
Sidney Lau's Cantonese transcription scheme as described in his book
\"Elementary Cantonese\", The Government Printer, Hong Kong, 1972.
- This file was prepared by Fung Fung Lee (李楓峰).
+ This file was prepared by Fung Fung Lee ($(0,XFS76(B).
Originally converted from CTCPS3.tit
Last modified: June 2, 1993.
Some infrequent characters are accessed by typing \\, followed by
- the Cantonese romanization of the respective radical (部首)."))
+ the Cantonese romanization of the respective radical ($(0?f5}(B)."))
(declare-function dos-8+3-filename "dos-fns.el" (filename))
diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el
index 201ff6b9b17..33d0f0dda29 100644
--- a/lisp/international/ucs-normalize.el
+++ b/lisp/international/ucs-normalize.el
@@ -25,8 +25,8 @@
;; This program has passed the NormalizationTest-5.2.0.txt.
;;
;; References:
-;; http://www.unicode.org/reports/tr15/
-;; http://www.unicode.org/review/pr-29.html
+;; https://www.unicode.org/reports/tr15/
+;; https://www.unicode.org/review/pr-29.html
;;
;; HFS-Normalization:
;; Reference:
@@ -98,7 +98,7 @@
;;
;; D. Sorting and Composition of Smaller Blocks (`ucs-normalize-block-compose-chars')
;;
-;; The block will be split to multiple samller blocks by starter
+;; The block will be split to multiple smaller blocks by starter
;; characters. Each block is sorted, and composed if necessary.
;;
;; E. Composition of Entire Block (`ucs-normalize-compose-chars')
@@ -131,7 +131,7 @@
#x1D1BF #x1D1C0)
"Composition Exclusion List.
This list is taken from
- http://www.unicode.org/Public/UNIDATA/5.2/CompositionExclusions.txt")
+ https://www.unicode.org/Public/UNIDATA/5.2/CompositionExclusions.txt")
;; Unicode ranges that decompositions & combining characters are defined.
(defvar check-range nil)
@@ -612,14 +612,16 @@ COMPOSITION-PREDICATE will be used to compose region."
(defun ucs-normalize-hfs-nfd-post-read-conversion (len)
(save-excursion
(save-restriction
- (narrow-to-region (point) (+ (point) len))
- (ucs-normalize-HFS-NFC-region (point-min) (point-max))
- (- (point-max) (point-min)))))
+ (save-match-data
+ (narrow-to-region (point) (+ (point) len))
+ (ucs-normalize-HFS-NFC-region (point-min) (point-max))
+ (- (point-max) (point-min))))))
;; Pre-write conversion for `utf-8-hfs'.
;; _from and _to are legacy arguments (see `define-coding-system').
(defun ucs-normalize-hfs-nfd-pre-write-conversion (_from _to)
- (ucs-normalize-HFS-NFD-region (point-min) (point-max)))
+ (save-match-data
+ (ucs-normalize-HFS-NFD-region (point-min) (point-max))))
;;; coding-system definition
(define-coding-system 'utf-8-hfs
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 57b13a38d67..781a8c5a93a 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -269,6 +269,13 @@ are `word-search-regexp' \(`\\[isearch-toggle-word]'), `isearch-symbol-regexp'
"Non-nil means incremental search highlights the current match."
:type 'boolean)
+(defcustom search-highlight-submatches t
+ "Whether to highlight regexp subexpressions of the current regexp match.
+The faces used to do the highlights are named `isearch-group-odd' and
+`isearch-group-even'."
+ :type 'boolean
+ :version "28.1")
+
(defface isearch
'((((class color) (min-colors 88) (background light))
;; The background must not be too dark, for that means
@@ -2011,15 +2018,16 @@ Turning on character-folding turns off regexp mode.")
(defvar isearch-message-properties minibuffer-prompt-properties
"Text properties that are added to the isearch prompt.")
-(defun isearch--momentary-message (string)
- "Print STRING at the end of the isearch prompt for 1 second."
+(defun isearch--momentary-message (string &optional seconds)
+ "Print STRING at the end of the isearch prompt for 1 second.
+The optional argument SECONDS overrides the number of seconds."
(let ((message-log-max nil))
(message "%s%s%s"
(isearch-message-prefix nil isearch-nonincremental)
isearch-message
(apply #'propertize (format " [%s]" string)
isearch-message-properties)))
- (sit-for 1))
+ (sit-for (or seconds 1)))
(isearch-define-mode-toggle lax-whitespace " " nil
"In ordinary search, toggles the value of the variable
@@ -2336,7 +2344,7 @@ characters in that string."
(with-isearch-suspended
(setq regexp-collect
(read-regexp
- (format "Regexp to collect (default %s): " default)
+ (format-prompt "Regexp to collect" default)
default 'occur-collect-regexp-history)))
regexp-collect))
;; Otherwise normal occur takes numerical prefix argument.
@@ -2381,22 +2389,17 @@ respectively)."
(funcall isearch-regexp-function isearch-string))
(isearch-regexp-function (word-search-regexp isearch-string))
(isearch-regexp isearch-string)
- ((if (and (eq isearch-case-fold-search t)
- search-upper-case)
- (isearch-no-upper-case-p
- isearch-string isearch-regexp)
- isearch-case-fold-search)
- ;; Turn isearch-string into a case-insensitive
- ;; regexp.
- (mapconcat
- (lambda (c)
- (let ((s (string c)))
- (if (string-match "[[:alpha:]]" s)
- (format "[%s%s]" (upcase s) (downcase s))
- (regexp-quote s))))
- isearch-string ""))
(t (regexp-quote isearch-string)))))
- (funcall hi-lock-func regexp (hi-lock-read-face-name)))
+ (let ((case-fold-search isearch-case-fold-search)
+ ;; Set `search-upper-case' to nil to not call
+ ;; `isearch-no-upper-case-p' in `hi-lock'.
+ (search-upper-case nil)
+ (search-spaces-regexp
+ (if (if isearch-regexp
+ isearch-regexp-lax-whitespace
+ isearch-lax-whitespace)
+ search-whitespace-regexp)))
+ (funcall hi-lock-func regexp (hi-lock-read-face-name) isearch-string)))
(and isearch-recursive-edit (exit-recursive-edit)))
(defun isearch-highlight-regexp ()
@@ -2404,14 +2407,18 @@ respectively)."
The arguments passed to `highlight-regexp' are the regexp from
the last search and the face from `hi-lock-read-face-name'."
(interactive)
- (isearch--highlight-regexp-or-lines 'highlight-regexp))
+ (isearch--highlight-regexp-or-lines
+ #'(lambda (regexp face lighter)
+ (highlight-regexp regexp face nil lighter))))
(defun isearch-highlight-lines-matching-regexp ()
"Exit Isearch mode and call `highlight-lines-matching-regexp'.
The arguments passed to `highlight-lines-matching-regexp' are the
regexp from the last search and the face from `hi-lock-read-face-name'."
(interactive)
- (isearch--highlight-regexp-or-lines 'highlight-lines-matching-regexp))
+ (isearch--highlight-regexp-or-lines
+ #'(lambda (regexp face _lighter)
+ (highlight-lines-matching-regexp regexp face))))
(defun isearch-delete-char ()
@@ -3443,7 +3450,10 @@ Optional third argument, if t, means if fail just return nil (no error).
(string-match "\\`Regular expression too big" isearch-error))
(cond
(isearch-regexp-function
- (setq isearch-error "Too many words"))
+ (setq isearch-error nil)
+ (setq isearch-regexp-function nil)
+ (isearch-search-and-update)
+ (isearch--momentary-message "Too many words; switched to literal mode" 2))
((and isearch-lax-whitespace search-whitespace-regexp)
(setq isearch-error "Too many spaces for whitespace matching"))))))
@@ -3651,6 +3661,27 @@ since they have special meaning in a regexp."
;; Highlighting
(defvar isearch-overlay nil)
+(defvar isearch-submatches-overlays nil)
+
+(defface isearch-group-odd
+ '((((class color) (min-colors 88) (background light))
+ (:background "#ff00ff" :foreground "lightskyblue1"))
+ (((class color) (min-colors 88) (background dark))
+ (:background "palevioletred3" :foreground "brown4"))
+ (t (:inherit isearch)))
+ "Face for highlighting Isearch the odd group matches."
+ :group 'isearch
+ :version "28.1")
+
+(defface isearch-group-even
+ '((((class color) (min-colors 88) (background light))
+ (:background "#800080" :foreground "lightskyblue1"))
+ (((class color) (min-colors 88) (background dark))
+ (:background "#905070" :foreground "brown4"))
+ (t (:inherit isearch)))
+ "Face for highlighting Isearch the even group matches."
+ :group 'isearch
+ :version "28.1")
(defun isearch-highlight (beg end)
(if search-highlight
@@ -3661,11 +3692,27 @@ since they have special meaning in a regexp."
(setq isearch-overlay (make-overlay beg end))
;; 1001 is higher than lazy's 1000 and ediff's 100+
(overlay-put isearch-overlay 'priority 1001)
- (overlay-put isearch-overlay 'face isearch-face))))
+ (overlay-put isearch-overlay 'face isearch-face)))
+ (when (and search-highlight-submatches
+ isearch-regexp)
+ (mapc 'delete-overlay isearch-submatches-overlays)
+ (setq isearch-submatches-overlays nil)
+ (dotimes (i (/ (length (match-data)) 2))
+ (unless (zerop i)
+ (let ((ov (make-overlay (match-beginning i) (match-end i))))
+ (overlay-put ov 'face (if (zerop (mod i 2))
+ 'isearch-group-even
+ 'isearch-group-odd))
+ (overlay-put ov 'priority 1002)
+ (push ov isearch-submatches-overlays))))))
(defun isearch-dehighlight ()
(when isearch-overlay
- (delete-overlay isearch-overlay)))
+ (delete-overlay isearch-overlay))
+ (when search-highlight-submatches
+ (mapc 'delete-overlay isearch-submatches-overlays)
+ (setq isearch-submatches-overlays nil)))
+
;; isearch-lazy-highlight feature
;; by Bob Glickstein <http://www.zanshin.com/~bobg/>
@@ -3866,9 +3913,10 @@ Attempt to do the search exactly the way the pending Isearch would."
(isearch-regexp-lax-whitespace
isearch-lazy-highlight-regexp-lax-whitespace)
(isearch-forward isearch-lazy-highlight-forward)
- ;; Match invisible text only when counting matches
- ;; and user can visit invisible matches
- (search-invisible (and isearch-lazy-count search-invisible t))
+ ;; Don't match invisible text unless it can be opened
+ ;; or when counting matches and user can visit hidden matches
+ (search-invisible (or (eq search-invisible 'open)
+ (and isearch-lazy-count search-invisible)))
(retry t)
(success nil))
;; Use a loop like in `isearch-search'.
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index 95cc02197c1..8b3384ae827 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -48,8 +48,7 @@ Preserves the `buffer-modified-p' state of the current buffer."
"Jit-lock fontifies chunks of at most this many characters at a time.
This variable controls both display-time and stealth fontification."
- :type 'integer
- :group 'jit-lock)
+ :type 'integer)
(defcustom jit-lock-stealth-time nil
@@ -59,8 +58,7 @@ If nil, stealth fontification is never performed.
The value of this variable is used when JIT Lock mode is turned on."
:type '(choice (const :tag "never" nil)
- (number :tag "seconds" :value 16))
- :group 'jit-lock)
+ (number :tag "seconds" :value 16)))
(defcustom jit-lock-stealth-nice 0.5
@@ -72,8 +70,7 @@ 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 `jit-lock-stealth-load'."
:type '(choice (const :tag "never" nil)
- (number :tag "seconds"))
- :group 'jit-lock)
+ (number :tag "seconds")))
(defcustom jit-lock-stealth-load
@@ -89,14 +86,12 @@ See also `jit-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 'jit-lock)
+ '(const :format "%t: unsupported\n" nil)))
(defcustom jit-lock-stealth-verbose nil
"If non-nil, means stealth fontification should show status messages."
- :type 'boolean
- :group 'jit-lock)
+ :type 'boolean)
(defvaralias 'jit-lock-defer-contextually 'jit-lock-contextually)
@@ -121,13 +116,11 @@ and sets the buffer-local value of `jit-lock-contextually' to t).
The value of this variable is used when JIT Lock mode is turned on."
:type '(choice (const :tag "never" nil)
(const :tag "always" t)
- (other :tag "syntax-driven" syntax-driven))
- :group 'jit-lock)
+ (other :tag "syntax-driven" syntax-driven)))
(defcustom jit-lock-context-time 0.5
"Idle time after which text is contextually refontified, if applicable."
- :type '(number :tag "seconds")
- :group 'jit-lock)
+ :type '(number :tag "seconds"))
(defcustom jit-lock-antiblink-grace 2
"Delay after which to refontify unterminated strings and comments.
@@ -140,14 +133,12 @@ and comments, the delay helps avoid unpleasant \"blinking\", between
string/comment and non-string/non-comment fontification."
:type '(choice (const :tag "never" nil)
(number :tag "seconds"))
- :group 'jit-lock
:version "27.1")
(defcustom jit-lock-defer-time nil ;; 0.25
"Idle time after which deferred fontification should take place.
If nil, fontification is not deferred.
If 0, then fontification is only deferred while there is input pending."
- :group 'jit-lock
:type '(choice (const :tag "never" nil)
(number :tag "seconds")))
@@ -156,9 +147,10 @@ If 0, then fontification is only deferred while there is input pending."
(defvar-local jit-lock-mode nil
"Non-nil means Just-in-time Lock mode is active.")
-(defvar-local jit-lock-functions nil
- "Functions to do the actual fontification.
-They are called with two arguments: the START and END of the region to fontify.")
+(defvar jit-lock-functions nil
+ "Special hook run to do the actual fontification.
+The functions are called with two arguments:
+the START and END of the region to fontify.")
(defvar-local jit-lock-context-unfontify-pos nil
"Consider text after this position as contextually unfontified.
@@ -268,7 +260,7 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
;; Setup our hooks.
(add-hook 'after-change-functions 'jit-lock-after-change nil t)
- (add-hook 'fontification-functions 'jit-lock-function))
+ (add-hook 'fontification-functions 'jit-lock-function nil t))
;; Turn Just-in-time Lock mode off.
(t
@@ -300,7 +292,7 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
When this minor mode is enabled, jit-lock runs as little code as possible
during redisplay and moves the rest to a timer, where things
like `debug-on-error' and Edebug can be used."
- :global t :group 'jit-lock
+ :global t
(when jit-lock-defer-timer
(cancel-timer jit-lock-defer-timer)
(setq jit-lock-defer-timer nil))
@@ -350,7 +342,8 @@ If non-nil, CONTEXTUAL means that a contextual fontification would be useful."
"Unregister FUN as a fontification function.
Only applies to the current buffer."
(remove-hook 'jit-lock-functions fun t)
- (unless jit-lock-functions (jit-lock-mode nil)))
+ (when (member jit-lock-functions '(nil '(t)))
+ (jit-lock-mode nil)))
(defun jit-lock-refontify (&optional beg end)
"Force refontification of the region BEG..END (default whole buffer)."
@@ -444,8 +437,8 @@ Defaults to the whole buffer. END can be out of bounds."
(quit (put-text-property start next 'fontified nil)
(signal (car err) (cdr err))))))
- ;; In case we fontified more than requested, take advantage of the
- ;; good news.
+ ;; In case we fontified more than requested, take
+ ;; advantage of the good news.
(when (or (< tight-beg start) (> tight-end next))
(put-text-property tight-beg tight-end 'fontified t))
diff --git a/lisp/json.el b/lisp/json.el
index ac323dac295..c2fc1574faa 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Theresa O'Connor <ted@oconnor.cx>
-;; Version: 1.4
+;; Version: 1.5
;; Keywords: convenience
;; This file is part of GNU Emacs.
@@ -29,11 +29,11 @@
;; Learn all about JSON here: <URL:http://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
+;; `json-read' and `json-read-from-string'. The encoder has a single
;; entry point, `json-encode'.
;; Since there are several natural representations of key-value pair
-;; mappings in elisp (alist, plist, hash-table), `json-read' allows you
+;; mappings in Elisp (alist, plist, hash-table), `json-read' allows you
;; to specify which you'd prefer (see `json-object-type' and
;; `json-array-type').
@@ -55,6 +55,7 @@
;;; Code:
(require 'map)
+(require 'seq)
(require 'subr-x)
;; Parameters
@@ -113,8 +114,10 @@ Used only when `json-encoding-pretty-print' is non-nil.")
"If non-nil, then the output of `json-encode' will be pretty-printed.")
(defvar json-encoding-lisp-style-closings nil
- "If non-nil, ] and } closings will be formatted lisp-style,
-without indentation.")
+ "If non-nil, delimiters ] and } will be formatted Lisp-style.
+This means they will be placed on the same line as the last
+element of the respective array or object, without indentation.
+Used only when `json-encoding-pretty-print' is non-nil.")
(defvar json-encoding-object-sort-predicate nil
"Sorting predicate for JSON object keys during encoding.
@@ -124,88 +127,81 @@ instance, setting this to `string<' will have JSON object keys
ordered alphabetically.")
(defvar json-pre-element-read-function nil
- "Function called (if non-nil) by `json-read-array' and
-`json-read-object' right before reading a JSON array or object,
-respectively. The function is called with one argument, which is
-the current JSON key.")
+ "If non-nil, a function to call before reading a JSON array or object.
+It is called by `json-read-array' and `json-read-object',
+respectively, with one argument, which is the current JSON key.")
(defvar json-post-element-read-function nil
- "Function called (if non-nil) by `json-read-array' and
-`json-read-object' right after reading a JSON array or object,
-respectively.")
+ "If non-nil, a function to call after reading a JSON array or object.
+It is called by `json-read-array' and `json-read-object',
+respectively, with no arguments.")
;;; Utilities
-(defun json-join (strings separator)
- "Join STRINGS with SEPARATOR."
- (mapconcat 'identity strings separator))
+(define-obsolete-function-alias 'json-join #'string-join "28.1")
(defun json-alist-p (list)
- "Non-null if and only if LIST is an alist with simple keys."
- (while (consp list)
- (setq list (if (and (consp (car list))
- (atom (caar list)))
- (cdr list)
- 'not-alist)))
+ "Non-nil if and only if LIST is an alist with simple keys."
+ (declare (pure t) (side-effect-free error-free))
+ (while (and (consp (car-safe list))
+ (atom (caar list))
+ (setq list (cdr list))))
(null list))
(defun json-plist-p (list)
- "Non-null if and only if LIST is a plist with keyword keys."
- (while (consp list)
- (setq list (if (and (keywordp (car list))
- (consp (cdr list)))
- (cddr list)
- 'not-plist)))
+ "Non-nil if and only if LIST is a plist with keyword keys."
+ (declare (pure t) (side-effect-free error-free))
+ (while (and (keywordp (car-safe list))
+ (consp (cdr list))
+ (setq list (cddr list))))
(null list))
-(defun json--plist-reverse (plist)
- "Return a copy of PLIST in reverse order.
-Unlike `reverse', this keeps the property-value pairs intact."
- (let (res)
- (while plist
- (let ((prop (pop plist))
- (val (pop plist)))
- (push val res)
- (push prop res)))
- res))
-
-(defun json--plist-to-alist (plist)
- "Return an alist of the property-value pairs in PLIST."
- (let (res)
- (while plist
- (let ((prop (pop plist))
- (val (pop plist)))
- (push (cons prop val) res)))
- (nreverse res)))
-
-(defmacro json--with-indentation (body)
+(defun json--plist-nreverse (plist)
+ "Return PLIST in reverse order.
+Unlike `nreverse', this keeps the ordering of each property
+relative to its value intact. Like `nreverse', this function may
+destructively modify PLIST to produce the result."
+ (let (prev (next (cddr plist)))
+ (while next
+ (setcdr (cdr plist) prev)
+ (setq prev plist plist next next (cddr next))
+ (setcdr (cdr plist) prev)))
+ plist)
+
+(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."
+ (declare (debug t) (indent 0))
`(let ((json--encoding-current-indentation
(if json-encoding-pretty-print
(concat json--encoding-current-indentation
json-encoding-default-indentation)
"")))
- ,body))
+ ,@body))
;; Reader utilities
(define-inline json-advance (&optional n)
- "Advance N characters forward."
+ "Advance N characters forward, or 1 character if N is nil.
+On reaching the end of the accessible region of the buffer, stop
+and signal an error."
(inline-quote (forward-char ,n)))
(define-inline json-peek ()
- "Return the character at point."
+ "Return the character at point.
+At the end of the accessible region of the buffer, return 0."
(inline-quote (following-char)))
(define-inline json-pop ()
- "Advance past the character at point, returning it."
+ "Advance past the character at point, returning it.
+Signal `json-end-of-file' if called at the end of the buffer."
(inline-quote
- (let ((char (json-peek)))
- (if (zerop char)
- (signal 'json-end-of-file nil)
- (json-advance)
- char))))
+ (prog1 (or (char-after)
+ (signal 'json-end-of-file ()))
+ (json-advance))))
(define-inline json-skip-whitespace ()
"Skip past the whitespace at point."
@@ -213,7 +209,7 @@ Unlike `reverse', this keeps the property-value pairs intact."
;; https://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf
;; or https://tools.ietf.org/html/rfc7159#section-2 for the
;; definition of whitespace in JSON.
- (inline-quote (skip-chars-forward "\t\r\n ")))
+ (inline-quote (skip-chars-forward "\t\n\r ")))
@@ -227,6 +223,7 @@ Unlike `reverse', this keeps the property-value pairs intact."
(define-error 'json-string-format "Bad string format" 'json-error)
(define-error 'json-key-format "Bad JSON object key" 'json-error)
(define-error 'json-object-format "Bad JSON object" 'json-error)
+(define-error 'json-array-format "Bad JSON array" 'json-error)
(define-error 'json-end-of-file "End of file while parsing JSON"
'(end-of-file json-error))
@@ -235,8 +232,8 @@ Unlike `reverse', this keeps the property-value pairs intact."
;;; Paths
(defvar json--path '()
- "Used internally by `json-path-to-position' to keep track of
-the path during recursive calls to `json-read'.")
+ "Keeps track of the path during recursive calls to `json-read'.
+Used internally by `json-path-to-position'.")
(defun json--record-path (key)
"Record the KEY to the current JSON path.
@@ -247,7 +244,7 @@ Used internally by `json-path-to-position'."
"Check if the last parsed JSON structure passed POSITION.
Used internally by `json-path-to-position'."
(let ((start (caar json--path)))
- (when (< start position (+ (point) 1))
+ (when (< start position (1+ (point)))
(throw :json-path (list :path (nreverse (mapcar #'cdr json--path))
:match-start start
:match-end (point)))))
@@ -265,13 +262,13 @@ properties:
:path -- A list of strings and numbers forming the path to
the JSON element at the given position. Strings
denote object names, while numbers denote array
- indexes.
+ indices.
:match-start -- Position where the matched JSON element begins.
:match-end -- Position where the matched JSON element ends.
-This can for instance be useful to determine the path to a JSON
+This can, for instance, be useful to determine the path to a JSON
element in a deeply nested structure."
(save-excursion
(unless string
@@ -279,7 +276,7 @@ element in a deeply nested structure."
(let* ((json--path '())
(json-pre-element-read-function #'json--record-path)
(json-post-element-read-function
- (apply-partially #'json--check-position position))
+ (lambda () (json--check-position position)))
(path (catch :json-path
(if string
(json-read-from-string string)
@@ -289,38 +286,33 @@ element in a deeply nested structure."
;;; Keywords
-(defvar json-keywords '("true" "false" "null")
+(defconst json-keywords '("true" "false" "null")
"List of JSON keywords.")
+(make-obsolete-variable 'json-keywords "it is no longer used." "28.1")
;; Keyword parsing
+;; Characters that can follow a JSON value.
+(rx-define json--post-value (| (in "\t\n\r ,]}") eos))
+
(defun json-read-keyword (keyword)
- "Read a JSON keyword at point.
-KEYWORD is the keyword expected."
- (unless (member keyword json-keywords)
- (signal 'json-unknown-keyword (list keyword)))
- (mapc (lambda (char)
- (when (/= char (json-peek))
- (signal 'json-unknown-keyword
- (list (save-excursion
- (backward-word-strictly 1)
- (thing-at-point 'word)))))
- (json-advance))
- keyword)
- (json-skip-whitespace)
- (unless (looking-at "\\([],}]\\|$\\)")
- (signal 'json-unknown-keyword
- (list (save-excursion
- (backward-word-strictly 1)
- (thing-at-point 'word)))))
- (cond ((string-equal keyword "true") t)
- ((string-equal keyword "false") json-false)
- ((string-equal keyword "null") json-null)))
+ "Read the expected JSON KEYWORD at point."
+ (prog1 (cond ((equal keyword "true") t)
+ ((equal keyword "false") json-false)
+ ((equal keyword "null") json-null)
+ (t (signal 'json-unknown-keyword (list keyword))))
+ (or (looking-at-p keyword)
+ (signal 'json-unknown-keyword (list (thing-at-point 'word))))
+ (json-advance (length keyword))
+ (or (looking-at-p (rx json--post-value))
+ (signal 'json-unknown-keyword (list (thing-at-point 'word))))
+ (json-skip-whitespace)))
;; Keyword encoding
(defun json-encode-keyword (keyword)
"Encode KEYWORD as a JSON value."
+ (declare (side-effect-free t))
(cond ((eq keyword t) "true")
((eq keyword json-false) "false")
((eq keyword json-null) "null")))
@@ -329,37 +321,31 @@ KEYWORD is the keyword expected."
;; Number parsing
-(defun json-read-number (&optional sign)
- "Read the JSON number following point.
-The optional SIGN argument is for internal use.
-
-N.B.: Only numbers which can fit in Emacs Lisp's native number
-representation will be parsed correctly."
- ;; If SIGN is non-nil, the number is explicitly signed.
- (let ((number-regexp
- "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
- (cond ((and (null sign) (= (json-peek) ?-))
- (json-advance)
- (- (json-read-number t)))
- ((and (null sign) (= (json-peek) ?+))
- (json-advance)
- (json-read-number t))
- ((and (looking-at number-regexp)
- (or (match-beginning 1)
- (match-beginning 2)))
- (goto-char (match-end 0))
- (string-to-number (match-string 0)))
- (t (signal 'json-number-format (list (point)))))))
+(rx-define json--number
+ (: (? ?-) ; Sign.
+ (| (: (in "1-9") (* digit)) ?0) ; Integer.
+ (? ?. (+ digit)) ; Fraction.
+ (? (in "Ee") (? (in ?+ ?-)) (+ digit)))) ; Exponent.
+
+(defun json-read-number (&optional _sign)
+ "Read the JSON number following point."
+ (declare (advertised-calling-convention () "28.1"))
+ (or (looking-at (rx json--number))
+ (signal 'json-number-format (list (point))))
+ (goto-char (match-end 0))
+ (prog1 (string-to-number (match-string 0))
+ (or (looking-at-p (rx json--post-value))
+ (signal 'json-number-format (list (point))))
+ (json-skip-whitespace)))
;; Number encoding
-(defun json-encode-number (number)
- "Return a JSON representation of NUMBER."
- (format "%s" number))
+(defalias 'json-encode-number #'number-to-string
+ "Return a JSON representation of NUMBER.")
;;; Strings
-(defvar json-special-chars
+(defconst json-special-chars
'((?\" . ?\")
(?\\ . ?\\)
(?b . ?\b)
@@ -367,7 +353,7 @@ representation will be parsed correctly."
(?n . ?\n)
(?r . ?\r)
(?t . ?\t))
- "Characters which are escaped in JSON, with their elisp counterparts.")
+ "Characters which are escaped in JSON, with their Elisp counterparts.")
;; String parsing
@@ -377,48 +363,47 @@ representation will be parsed correctly."
(defun json-read-escaped-char ()
"Read the JSON string escaped character at point."
- ;; Skip over the '\'
+ ;; Skip over the '\'.
(json-advance)
- (let* ((char (json-pop))
- (special (assq char json-special-chars)))
+ (let ((char (json-pop)))
(cond
- (special (cdr special))
- ((not (eq char ?u)) char)
+ ((cdr (assq char json-special-chars)))
+ ((/= char ?u) char)
;; Special-case UTF-16 surrogate pairs,
;; cf. <https://tools.ietf.org/html/rfc7159#section-7>. Note that
;; this clause overlaps with the next one and therefore has to
;; come first.
((looking-at
- (rx (group (any "Dd") (any "89ABab") (= 2 (any xdigit)))
- "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 (any xdigit)))))
+ (rx (group (any "Dd") (any "89ABab") (= 2 xdigit))
+ "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 xdigit))))
(json-advance 10)
(json--decode-utf-16-surrogates
(string-to-number (match-string 1) 16)
(string-to-number (match-string 2) 16)))
((looking-at (rx (= 4 xdigit)))
- (let ((hex (match-string 0)))
- (json-advance 4)
- (string-to-number hex 16)))
+ (json-advance 4)
+ (string-to-number (match-string 0) 16))
(t
(signal 'json-string-escape (list (point)))))))
(defun json-read-string ()
"Read the JSON string at point."
- (unless (= (json-peek) ?\")
- (signal 'json-string-format (list "doesn't start with `\"'!")))
- ;; Skip over the '"'
+ ;; Skip over the '"'.
(json-advance)
(let ((characters '())
(char (json-peek)))
- (while (not (= char ?\"))
+ (while (/= char ?\")
(when (< char 32)
- (signal 'json-string-format (list (prin1-char char))))
+ (if (zerop char)
+ (signal 'json-end-of-file ())
+ (signal 'json-string-format (list char))))
(push (if (= char ?\\)
(json-read-escaped-char)
- (json-pop))
+ (json-advance)
+ char)
characters)
(setq char (json-peek)))
- ;; Skip over the '"'
+ ;; Skip over the '"'.
(json-advance)
(if characters
(concat (nreverse characters))
@@ -426,29 +411,47 @@ representation will be parsed correctly."
;; 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-encode-string (string)
"Return a JSON representation of STRING."
- ;; Reimplement the meat of `replace-regexp-in-string', for
- ;; performance (bug#20154).
- (let ((l (length string))
- (start 0)
- res mb)
- ;; Only escape quotation mark, backslash and the control
- ;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
- (while (setq mb (string-match "[\"\\[:cntrl:]]" string start))
- (let* ((c (aref string mb))
- (special (rassq c json-special-chars)))
- (push (substring string start mb) res)
- (push (if special
- ;; Special JSON character (\n, \r, etc.).
- (string ?\\ (car special))
- ;; Fallback: UCS code point in \uNNNN form.
- (format "\\u%04x" c))
- res)
- (setq start (1+ mb))))
- (push (substring string start l) res)
- (push "\"" res)
- (apply #'concat "\"" (nreverse res))))
+ ;; 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*")
+ ;; 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)))))
(defun json-encode-key (object)
"Return a JSON representation of OBJECT.
@@ -459,15 +462,13 @@ this signals `json-key-format'."
(signal 'json-key-format (list object)))
encoded))
-;;; JSON Objects
+;;; Objects
(defun json-new-object ()
- "Create a new Elisp object corresponding to a JSON object.
+ "Create a new Elisp object corresponding to an empty JSON object.
Please see the documentation of `json-object-type'."
- (cond ((eq json-object-type 'hash-table)
- (make-hash-table :test 'equal))
- (t
- ())))
+ (and (eq json-object-type 'hash-table)
+ (make-hash-table :test #'equal)))
(defun json-add-to-object (object key value)
"Add a new KEY -> VALUE association to OBJECT.
@@ -475,10 +476,10 @@ Returns the updated object, which you should save, e.g.:
(setq obj (json-add-to-object obj \"foo\" \"bar\"))
Please see the documentation of `json-object-type' and `json-key-type'."
(let ((json-key-type
- (or json-key-type
- (cdr (assq json-object-type '((hash-table . string)
- (alist . symbol)
- (plist . keyword)))))))
+ (cond (json-key-type)
+ ((eq json-object-type 'hash-table) 'string)
+ ((eq json-object-type 'alist) 'symbol)
+ ((eq json-object-type 'plist) 'keyword))))
(setq key
(cond ((eq json-key-type 'string)
key)
@@ -498,13 +499,13 @@ Please see the documentation of `json-object-type' and `json-key-type'."
(defun json-read-object ()
"Read the JSON object at point."
- ;; Skip over the "{"
+ ;; Skip over the '{'.
(json-advance)
(json-skip-whitespace)
- ;; read key/value pairs until "}"
+ ;; Read key/value pairs until '}'.
(let ((elements (json-new-object))
key value)
- (while (not (= (json-peek) ?}))
+ (while (/= (json-peek) ?\})
(json-skip-whitespace)
(setq key (json-read-string))
(json-skip-whitespace)
@@ -519,94 +520,94 @@ Please see the documentation of `json-object-type' and `json-key-type'."
(funcall json-post-element-read-function))
(setq elements (json-add-to-object elements key value))
(json-skip-whitespace)
- (when (/= (json-peek) ?})
+ (when (/= (json-peek) ?\})
(if (= (json-peek) ?,)
(json-advance)
(signal 'json-object-format (list "," (json-peek))))))
- ;; Skip over the "}"
+ ;; Skip over the '}'.
(json-advance)
(pcase json-object-type
('alist (nreverse elements))
- ('plist (json--plist-reverse elements))
+ ('plist (json--plist-nreverse elements))
(_ elements))))
;; Hash table encoding
(defun json-encode-hash-table (hash-table)
"Return a JSON representation of HASH-TABLE."
- (if json-encoding-object-sort-predicate
- (json-encode-alist (map-into hash-table 'list))
- (format "{%s%s}"
- (json-join
- (let (r)
- (json--with-indentation
- (maphash
- (lambda (k v)
- (push (format
- (if json-encoding-pretty-print
- "%s%s: %s"
- "%s%s:%s")
- json--encoding-current-indentation
- (json-encode-key k)
- (json-encode v))
- r))
- hash-table))
- r)
- json-encoding-separator)
- (if (or (not json-encoding-pretty-print)
- json-encoding-lisp-style-closings)
- ""
- json--encoding-current-indentation))))
+ (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)
+ "}")))))
;; List encoding (including alists and plists)
-(defun json-encode-alist (alist)
- "Return a JSON representation of ALIST."
+(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 alist (lambda (a b)
+ (setq alist (sort (if destructive alist (copy-sequence alist))
+ (lambda (a b)
(funcall json-encoding-object-sort-predicate
(car a) (car b))))))
- (format "{%s%s}"
- (json-join
- (json--with-indentation
- (mapcar (lambda (cons)
- (format (if json-encoding-pretty-print
- "%s%s: %s"
- "%s%s:%s")
- json--encoding-current-indentation
- (json-encode-key (car cons))
- (json-encode (cdr cons))))
- alist))
- json-encoding-separator)
- (if (or (not json-encoding-pretty-print)
- json-encoding-lisp-style-closings)
- ""
- json--encoding-current-indentation)))
+ (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-encode-alist (alist)
+ "Return a JSON representation of ALIST."
+ (if alist (json--encode-alist alist) "{}"))
(defun json-encode-plist (plist)
"Return a JSON representation of PLIST."
- (if json-encoding-object-sort-predicate
- (json-encode-alist (json--plist-to-alist plist))
- (let (result)
- (json--with-indentation
- (while plist
- (push (concat
- json--encoding-current-indentation
- (json-encode-key (car plist))
- (if json-encoding-pretty-print
- ": "
- ":")
- (json-encode (cadr 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)
- (setq plist (cddr plist))))
- (concat "{"
- (json-join (nreverse result) json-encoding-separator)
- (if (and json-encoding-pretty-print
- (not json-encoding-lisp-style-closings))
- json--encoding-current-indentation
- "")
- "}"))))
+ (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)
+ "}")))))
(defun json-encode-list (list)
"Return a JSON representation of LIST.
@@ -624,15 +625,17 @@ become JSON objects."
(defun json-read-array ()
"Read the JSON array at point."
- ;; Skip over the "["
+ ;; Skip over the '['.
(json-advance)
(json-skip-whitespace)
- ;; read values until "]"
- (let (elements)
- (while (not (= (json-peek) ?\]))
+ ;; Read values until ']'.
+ (let (elements
+ (len 0))
+ (while (/= (json-peek) ?\])
(json-skip-whitespace)
(when json-pre-element-read-function
- (funcall json-pre-element-read-function (length elements)))
+ (funcall json-pre-element-read-function len)
+ (setq len (1+ len)))
(push (json-read) elements)
(when json-post-element-read-function
(funcall json-post-element-read-function))
@@ -640,8 +643,8 @@ become JSON objects."
(when (/= (json-peek) ?\])
(if (= (json-peek) ?,)
(json-advance)
- (signal 'json-error (list 'bleah)))))
- ;; Skip over the "]"
+ (signal 'json-array-format (list "," (json-peek))))))
+ ;; Skip over the ']'.
(json-advance)
(pcase json-array-type
('vector (nreverse (vconcat elements)))
@@ -652,42 +655,43 @@ become JSON objects."
(defun json-encode-array (array)
"Return a JSON representation of ARRAY."
(if (and json-encoding-pretty-print
- (> (length array) 0))
+ (not (seq-empty-p array)))
(concat
+ "["
(json--with-indentation
- (concat (format "[%s" json--encoding-current-indentation)
- (json-join (mapcar 'json-encode array)
- (format "%s%s"
- json-encoding-separator
+ (concat json--encoding-current-indentation
+ (mapconcat #'json-encode array
+ (concat json-encoding-separator
json--encoding-current-indentation))))
- (format "%s]"
- (if json-encoding-lisp-style-closings
- ""
- json--encoding-current-indentation)))
+ (unless json-encoding-lisp-style-closings
+ json--encoding-current-indentation)
+ "]")
(concat "["
- (mapconcat 'json-encode array json-encoding-separator)
+ (mapconcat #'json-encode array json-encoding-separator)
"]")))
-;;; JSON reader.
+;;; Reader
(defmacro json-readtable-dispatch (char)
- "Dispatch reader function for CHAR."
- (declare (debug (symbolp)))
- (let ((table
- '((?t json-read-keyword "true")
- (?f json-read-keyword "false")
- (?n json-read-keyword "null")
- (?{ json-read-object)
- (?\[ json-read-array)
- (?\" json-read-string)))
- res)
- (dolist (c '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
- (push (list c 'json-read-number) table))
- (pcase-dolist (`(,c . ,rest) table)
- (push `((eq ,char ,c) (,@rest)) res))
- `(cond ,@res (t (signal 'json-readtable-error (list ,char))))))
+ "Dispatch reader function for CHAR at point.
+If CHAR is nil, signal `json-end-of-file'."
+ (declare (debug t))
+ (macroexp-let2 nil char char
+ `(cond ,@(map-apply
+ (lambda (key expr)
+ `((eq ,char ,key) ,expr))
+ `((?\" ,#'json-read-string)
+ (?\[ ,#'json-read-array)
+ (?\{ ,#'json-read-object)
+ (?n ,#'json-read-keyword "null")
+ (?f ,#'json-read-keyword "false")
+ (?t ,#'json-read-keyword "true")
+ ,@(mapcar (lambda (c) (list c #'json-read-number))
+ '(?- ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))))
+ (,char (signal 'json-readtable-error (list ,char)))
+ (t (signal 'json-end-of-file ())))))
(defun json-read ()
"Parse and return the JSON object following point.
@@ -705,10 +709,7 @@ you will get the following structure returned:
((c . :json-false))])
(b . \"foo\"))"
(json-skip-whitespace)
- (let ((char (json-peek)))
- (if (zerop char)
- (signal 'json-end-of-file nil)
- (json-readtable-dispatch char))))
+ (json-readtable-dispatch (char-after)))
;; Syntactic sugar for the reader
@@ -723,12 +724,11 @@ you will get the following structure returned:
"Read the first JSON object contained in FILE and return it."
(with-temp-buffer
(insert-file-contents file)
- (goto-char (point-min))
(json-read)))
-;;; JSON encoder
+;;; Encoder
(defun json-encode (object)
"Return a JSON representation of OBJECT as a string.
@@ -736,20 +736,21 @@ 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 ((memq object (list t json-null 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
+ (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
(defun json-pretty-print-buffer (&optional minimize)
"Pretty-print current buffer.
@@ -768,9 +769,9 @@ MAX-SECS.")
With prefix argument MINIMIZE, minimize it instead."
(interactive "r\nP")
(let ((json-encoding-pretty-print (null minimize))
- ;; Distinguish an empty objects from 'null'
+ ;; Distinguish an empty object from 'null'.
(json-null :json-null)
- ;; Ensure that ordering is maintained
+ ;; Ensure that ordering is maintained.
(json-object-type 'alist)
(orig-buf (current-buffer))
error)
@@ -799,9 +800,7 @@ With prefix argument MINIMIZE, minimize it instead."
;; them.
(let ((space (buffer-substring
(point)
- (+ (point)
- (skip-chars-forward
- " \t\n" (point-max)))))
+ (+ (point) (skip-chars-forward " \t\n"))))
(json (json-read)))
(setq pos (point)) ; End of last good json-read.
(set-buffer tmp-buf)
@@ -831,14 +830,14 @@ With prefix argument MINIMIZE, minimize it instead."
"Pretty-print current buffer with object keys ordered.
With prefix argument MINIMIZE, minimize it instead."
(interactive "P")
- (let ((json-encoding-object-sort-predicate 'string<))
+ (let ((json-encoding-object-sort-predicate #'string<))
(json-pretty-print-buffer minimize)))
(defun json-pretty-print-ordered (begin end &optional minimize)
"Pretty-print the region with object keys ordered.
With prefix argument MINIMIZE, minimize it instead."
(interactive "r\nP")
- (let ((json-encoding-object-sort-predicate 'string<))
+ (let ((json-encoding-object-sort-predicate #'string<))
(json-pretty-print begin end minimize)))
(provide 'json)
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 4567b14da11..ffbc253a976 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -4,11 +4,11 @@
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: processes, languages, extensions
+;; Version: 1.0.12
;; Package-Requires: ((emacs "25.2"))
-;; Version: 1.0.9
-;; This is an Elpa :core package. Don't use functionality that is not
-;; compatible with Emacs 25.2.
+;; 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
;; it under the terms of the GNU General Public License as published by
@@ -37,7 +37,6 @@
;;; Code:
(require 'cl-lib)
-(require 'json)
(require 'eieio)
(eval-when-compile (require 'subr-x))
(require 'warnings)
@@ -275,7 +274,7 @@ error of type `jsonrpc-error'.
DEFERRED is passed to `jsonrpc-async-request', which see.
If CANCEL-ON-INPUT is non-nil and the user inputs something while
-the functino is waiting, then it exits immediately, returning
+the function is waiting, then it exits immediately, returning
CANCEL-ON-INPUT-RETVAL. Any future replies (normal or error) are
ignored."
(let* ((tag (cl-gensym "jsonrpc-request-catch-tag")) id-and-timer
@@ -330,11 +329,14 @@ ignored."
:method method
:params params))
-(defconst jrpc-default-request-timeout 10
+(define-obsolete-variable-alias 'jrpc-default-request-timeout
+ 'jsonrpc-default-request-timeout "28.1")
+
+(defconst jsonrpc-default-request-timeout 10
"Time in seconds before timing out a JSONRPC request.")
-;;; Specfic to `jsonrpc-process-connection'
+;;; Specific to `jsonrpc-process-connection'
;;;
(defclass jsonrpc-process-connection (jsonrpc-connection)
@@ -364,21 +366,53 @@ connection object, called when the process dies .")
(cl-defmethod initialize-instance ((conn jsonrpc-process-connection) slots)
(cl-call-next-method)
- (let* ((proc (plist-get slots :process))
- (proc (if (functionp proc) (funcall proc) proc))
- (buffer (get-buffer-create (format "*%s output*" (process-name proc))))
- (stderr (get-buffer-create (format "*%s stderr*" (process-name proc)))))
+ (cl-destructuring-bind (&key ((:process proc)) name &allow-other-keys) slots
+ ;; FIXME: notice the undocumented bad coupling in the stderr
+ ;; buffer name, it must be named exactly like this we expect when
+ ;; calling `make-process'. If there were a `set-process-stderr'
+ ;; like there is `set-process-buffer' we wouldn't need this and
+ ;; could use a pipe with a process filter instead of
+ ;; `after-change-functions'. Alternatively, we need a new initarg
+ ;; (but maybe not a slot).
+ (let ((calling-buffer (current-buffer)))
+ (with-current-buffer (get-buffer-create (format "*%s stderr*" name))
+ (let ((inhibit-read-only t)
+ (hidden-name (concat " " (buffer-name))))
+ (erase-buffer)
+ (buffer-disable-undo)
+ (add-hook
+ 'after-change-functions
+ (lambda (beg _end _pre-change-len)
+ (cl-loop initially (goto-char beg)
+ do (forward-line)
+ when (bolp)
+ for line = (buffer-substring
+ (line-beginning-position 0)
+ (line-end-position 0))
+ do (with-current-buffer (jsonrpc-events-buffer conn)
+ (goto-char (point-max))
+ (let ((inhibit-read-only t))
+ (insert (format "[stderr] %s\n" line))))
+ until (eobp)))
+ nil t)
+ ;; If we are correctly coupled to the client, the process
+ ;; now created should pick up the current stderr buffer,
+ ;; which we immediately rename
+ (setq proc (if (functionp proc)
+ (with-current-buffer calling-buffer (funcall proc))
+ proc))
+ (ignore-errors (kill-buffer hidden-name))
+ (rename-buffer hidden-name)
+ (process-put proc 'jsonrpc-stderr (current-buffer))
+ (read-only-mode t))))
(setf (jsonrpc--process conn) proc)
- (set-process-buffer proc buffer)
- (process-put proc 'jsonrpc-stderr stderr)
+ (set-process-buffer proc (get-buffer-create (format " *%s output*" name)))
(set-process-filter proc #'jsonrpc--process-filter)
(set-process-sentinel proc #'jsonrpc--process-sentinel)
(with-current-buffer (process-buffer proc)
(buffer-disable-undo)
(set-marker (process-mark proc) (point-min))
- (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t) proc))
- (with-current-buffer stderr
- (buffer-disable-undo))
+ (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t)))
(process-put proc 'jsonrpc-connection conn)))
(cl-defmethod jsonrpc-connection-send ((connection jsonrpc-process-connection)
@@ -442,26 +476,35 @@ With optional CLEANUP, kill any associated buffers."
;;;
(define-error 'jsonrpc-error "jsonrpc-error")
-(defun jsonrpc--json-read ()
- "Read JSON object in buffer, move point to end of buffer."
- ;; TODO: I guess we can make these macros if/when jsonrpc.el
- ;; goes into Emacs core.
- (cond ((fboundp 'json-parse-buffer) (json-parse-buffer
- :object-type 'plist
- :null-object nil
- :false-object :json-false))
- (t (let ((json-object-type 'plist))
- (json-read)))))
-
-(defun jsonrpc--json-encode (object)
- "Encode OBJECT into a JSON string."
- (cond ((fboundp 'json-serialize) (json-serialize
- object
- :false-object :json-false
- :null-object nil))
- (t (let ((json-false :json-false)
- (json-null nil))
- (json-encode object)))))
+(defalias 'jsonrpc--json-read
+ (if (fboundp 'json-parse-buffer)
+ (lambda ()
+ (json-parse-buffer :object-type 'plist
+ :null-object nil
+ :false-object :json-false))
+ (require 'json)
+ (defvar json-object-type)
+ (declare-function json-read "json" ())
+ (lambda ()
+ (let ((json-object-type 'plist))
+ (json-read))))
+ "Read JSON object in buffer, move point to end of buffer.")
+
+(defalias 'jsonrpc--json-encode
+ (if (fboundp 'json-serialize)
+ (lambda (object)
+ (json-serialize object
+ :false-object :json-false
+ :null-object nil))
+ (require 'json)
+ (defvar json-false)
+ (defvar json-null)
+ (declare-function json-encode "json" (object))
+ (lambda (object)
+ (let ((json-false :json-false)
+ (json-null nil))
+ (json-encode object))))
+ "Encode OBJECT into a JSON string.")
(cl-defun jsonrpc--reply
(connection id &key (result nil result-supplied-p) (error nil error-supplied-p))
@@ -577,7 +620,7 @@ With optional CLEANUP, kill any associated buffers."
params
&rest args
&key success-fn error-fn timeout-fn
- (timeout jrpc-default-request-timeout)
+ (timeout jsonrpc-default-request-timeout)
(deferred nil))
"Does actual work for `jsonrpc-async-request'.
@@ -682,7 +725,7 @@ originated."
(format "-%s" subtype)))))
(goto-char (point-max))
(prog1
- (let ((msg (format "%s%s%s %s:\n%s\n"
+ (let ((msg (format "[%s]%s%s %s:\n%s"
type
(if id (format " (id:%s)" id) "")
(if error " ERROR" "")
diff --git a/lisp/kermit.el b/lisp/kermit.el
index b0a4d90932e..f2607bfcf4c 100644
--- a/lisp/kermit.el
+++ b/lisp/kermit.el
@@ -1,4 +1,4 @@
-;;; kermit.el --- additions to shell mode for use with kermit
+;;; kermit.el --- additions to shell mode for use with kermit -*- lexical-binding: t -*-
;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 3a59708d837..3437dba5e6a 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -924,7 +924,7 @@ The ARG parameter is unused."
nil
(if kmacro-view-last-item
(concat (cond ((= kmacro-view-item-no 2) "2nd")
- ((= kmacro-view-item-no 3) "3nd")
+ ((= kmacro-view-item-no 3) "3rd")
(t (format "%dth" kmacro-view-item-no)))
" previous macro")
"Last macro")))
diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el
index 7f2a99a41a2..1888c8f86a2 100644
--- a/lisp/language/burmese.el
+++ b/lisp/language/burmese.el
@@ -23,7 +23,6 @@
;;; Commentary:
-;; Aung San Suu Kyi says to call her country "Burma".
;; The murderous generals say to call it "Myanmar".
;; We will call it "Burma". -- rms, Chief GNUisance.
diff --git a/lisp/language/chinese.el b/lisp/language/chinese.el
index bc6969c1398..4389db961d8 100644
--- a/lisp/language/chinese.el
+++ b/lisp/language/chinese.el
@@ -103,6 +103,11 @@
(define-coding-system-alias 'hz-gb-2312 'chinese-hz)
(define-coding-system-alias 'hz 'chinese-hz)
+;; FIXME: 'define-coding-system' automatically sets :ascii-compatible-p,
+;; to any encoding whose :coding-type is 'utf-8', but UTF-7 is not ASCII
+;; compatible, so we override that here (bug#40407).
+(coding-system-put 'chinese-hz :ascii-compatible-p nil)
+
(set-language-info-alist
"Chinese-GB" '((charset chinese-gb2312 chinese-sisheng)
(iso639-language . zh)
diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el
index a3a6f3fdd94..ce60d1a3ad4 100644
--- a/lisp/language/cyril-util.el
+++ b/lisp/language/cyril-util.el
@@ -47,7 +47,7 @@
;;;###autoload
(defun standard-display-cyrillic-translit (&optional cyrillic-language)
- "Display a cyrillic buffer using a transliteration.
+ "Display a Cyrillic buffer using a transliteration.
For readability, the table is slightly
different from the one used for the input method `cyrillic-translit'.
diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el
index 9847ab66e60..c19637010a2 100644
--- a/lisp/language/cyrillic.el
+++ b/lisp/language/cyrillic.el
@@ -169,13 +169,6 @@ Support for Russian using koi8-r and the russian-computer input method.")
:charset-list '(ibm866)
:mime-charset 'cp866)
-(define-coding-system 'koi8-u
- "KOI8-U 8-bit encoding for Cyrillic (MIME: KOI8-U)"
- :coding-type 'charset
- :mnemonic ?U
- :charset-list '(koi8-u)
- :mime-charset 'koi8-u)
-
(define-coding-system 'koi8-t
"KOI8-T 8-bit encoding for Cyrillic"
:coding-type 'charset
diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el
index 19cba91556b..f38dead5a23 100644
--- a/lisp/language/hanja-util.el
+++ b/lisp/language/hanja-util.el
@@ -22,7 +22,7 @@
;;; Commentary:
-;; This file defines korean hanja table and symbol table.
+;; This file defines the Korean Hanja table and symbol table.
;;; Code:
@@ -31,7 +31,7 @@
(defvar hanja-table nil
"A char table for Hanja characters.
-It maps a hangul character to a list of the corresponding Hanja characters.
+It maps a Hangul character to a list of the corresponding Hanja characters.
Each element of the list has the form CHAR or (CHAR . STRING)
where CHAR is a Hanja character and STRING is the meaning of that
character. This variable is initialized by `hanja-init-load'.")
diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el
index 573541aec16..08b70abfc29 100644
--- a/lisp/language/hebrew.el
+++ b/lisp/language/hebrew.el
@@ -240,7 +240,7 @@ Bidirectional editing is supported.")))
(let* ((base "[\u05D0-\u05F2\uFB1D\uFB1F-\uFB28\uFB2A-\uFB4F]")
(combining
- "[\u0591-\u05BD\u05BF\u05C1-\u05C2\u05C4-\u05C5\u05C7\uFB1E]+")
+ "[\u034F\u0591-\u05BD\u05BF\u05C1-\u05C2\u05C4-\u05C5\u05C7\uFB1E]+")
(pattern1 (concat base combining))
(pattern2 (concat base "\u200D" combining)))
(set-char-table-range
diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el
index 4319e5537e7..62885227f10 100644
--- a/lisp/language/ind-util.el
+++ b/lisp/language/ind-util.el
@@ -232,8 +232,8 @@
'(
(;; VOWELS
(?അ nil) (?ആ ?ാ) (?ഇ ?ി) (?ഈ ?ീ) (?ഉ ?ു) (?ഊ ?ൂ)
- (?ഋ ?ൃ) (?ഌ nil) nil (?ഏ ?േ) (?എ ?െ) (?ഐ ?ൈ)
- nil (?ഓ ?ോ) (?ഒ ?ൊ) (?ഔ ?ൌ) nil nil)
+ (?ഋ ?ൃ) (?ഌ ?ൢ) (?ൡ ?ൣ) (?ഏ ?േ) (?എ ?െ) (?ഐ ?ൈ)
+ nil (?ഒ ?ൊ) (?ഓ ?ോ) (?ഔ ?ൗ) (?് ?്) (?ൠ ?ൄ))
(;; CONSONANTS
?ക ?ഖ ?ഗ ?ഘ ?ങ ;; GUTTRULS
?ച ?ഛ ?ജ ?ഝ ?ഞ ;; PALATALS
@@ -243,13 +243,16 @@
?യ ?ര ?റ ?ല ?ള ?ഴ ?വ ;; SEMIVOWELS
?ശ ?ഷ ?സ ?ഹ ;; SIBILANTS
nil nil nil nil nil nil nil nil ;; NUKTAS
- "ജ്ഞ" "ക്ഷ")
+ "ജ്ഞ" "ക്ഷ"
+ "റ്റ" "ന്റ" "ത്ത" "ത്ഥ" "ഞ്ഞ" "ങ്ങ" "ന്ന"
+ "ഞ്ച" "ന്ക" "ങ്ക" "ച്ച" "ച്ഛ" "ക്ക"
+ "ബ്ബ" "ക്ക" "ഗ്ഗ" "ജ്ജ" "മ്മ" "പ്പ" "വ്വ" "ക്സ" "ശ്ശ")
(;; Misc Symbols
nil ?ം ?ഃ nil ?് nil nil)
(;; Digits
?൦ ?൧ ?൨ ?൩ ?൪ ?൫ ?൬ ?൭ ?൮ ?൯)
- (;; Inscript-extra (4) (#, $, ^, *, ])
- "്ര" "ര്" "ത്ര" "ശ്ര" nil)))
+ (;; Chillus
+ "ണ്" ?ൺ "ന്" ?ൻ "ര്" ?ർ "ല്" ?ൽ "ള്" ?ൾ)))
(defvar indian-tml-base-table
'(
@@ -323,6 +326,29 @@
(;; misc -- 7
".N" (".n" "M") "H" ".a" ".h" ("AUM" "OM") "..")))
+(defvar indian-mlm-mozhi-table
+ '(;; for encode/decode
+ (;; vowels -- 18
+ "a" ("aa" "A") "i" ("ii" "I") "u" ("uu" "U")
+ "R" "Ll" "Lll" ("E" "ae") "e" "ai"
+ nil "o" "O" "au" "~" "RR")
+ (;; consonants -- 40
+ ("k" "c") "kh" "g" "gh" "ng"
+ "ch" ("Ch" "chh") "j" "jh" "nj"
+ "T" "Th" "D" "Dh" "N"
+ "th" "thh" "d" "dh" "n" nil
+ "p" ("ph" "f") "b" "bh" "m"
+ "y" "r" "rr" "l" "L" "zh" ("v" "w")
+ ("S" "z") "sh" "s" "h"
+ nil nil nil nil nil nil nil nil
+ nil "X"
+ ;; some of these are extra to Mozhi
+ ("t" "tt") "nt" "tth" "tthh" "nnj" "nng" "nn"
+ "nch" "nc" "nk" "cch" "cchh" "cc"
+ "B" ("C" "K" "q") "G" "J" "M" "P" "V" "x" "Z")
+ (;; misc -- 7
+ nil nil "H")))
+
(defvar indian-kyoto-harvard-table
'(;; for encode/decode
(;; vowel
@@ -524,6 +550,10 @@
(indian-make-hash indian-mlm-base-table
indian-itrans-v5-table))
+(defvar indian-mlm-mozhi-hash
+ (indian-make-hash indian-mlm-base-table
+ indian-mlm-mozhi-table))
+
(defvar indian-tml-itrans-v5-hash
(indian-make-hash indian-tml-base-table
indian-itrans-v5-table-for-tamil))
diff --git a/lisp/language/indian.el b/lisp/language/indian.el
index eb882c810e1..657ad6915eb 100644
--- a/lisp/language/indian.el
+++ b/lisp/language/indian.el
@@ -25,7 +25,7 @@
;;; Commentary:
;; This file contains definitions of Indian language environments, and
-;; setups for displaying the scrtipts used there.
+;; setups for displaying the scripts used there.
;;; Code:
diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el
index d77efa48c9b..9a99245dfde 100644
--- a/lisp/language/japanese.el
+++ b/lisp/language/japanese.el
@@ -82,9 +82,7 @@
(#x00A6 . #xFFE4) ; BROKEN LINE FULLWIDTH BROKEN LINE
)))
(define-translation-table 'japanese-ucs-jis-to-cp932-map map)
- (mapc #'(lambda (x) (let ((tmp (car x)))
- (setcar x (cdr x)) (setcdr x tmp)))
- map)
+ (setq map (mapcar (lambda (x) (cons (cdr x) (car x))) map))
(define-translation-table 'japanese-ucs-cp932-to-jis-map map))
;; U+2014 (EM DASH) vs U+2015 (HORIZONTAL BAR)
@@ -241,8 +239,10 @@ eucJP-ms is defined in <http://www.opengroup.or.jp/jvc/cde/appendix.html>."
(#x2b65 . [#x02E9 #x02E5])
(#x2b66 . [#x02E5 #x02E9])))
table)
- (dolist (elt map)
- (setcar elt (decode-char 'japanese-jisx0213-1 (car elt))))
+ (setq map
+ (mapcar (lambda (x) (cons (decode-char 'japanese-jisx0213-1 (car x))
+ (cdr x)))
+ map))
(setq table (make-translation-table-from-alist map))
(define-translation-table 'jisx0213-to-unicode table)
(define-translation-table 'unicode-to-jisx0213
diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el
index 296dbd78970..3821785da73 100644
--- a/lisp/language/korea-util.el
+++ b/lisp/language/korea-util.el
@@ -46,7 +46,7 @@
(concat "korean-hangul" default-korean-keyboard))))
(defun quail-hangul-switch-symbol-ksc (&rest ignore)
- "Swith to/from Korean symbol package."
+ "Switch to/from Korean symbol package."
(interactive "i")
(and current-input-method
(if (string-equal current-input-method "korean-symbol")
@@ -55,7 +55,7 @@
(activate-input-method "korean-symbol"))))
(defun quail-hangul-switch-hanja (&rest ignore)
- "Swith to/from Korean hanja package."
+ "Switch to/from Korean hanja package."
(interactive "i")
(and current-input-method
(if (string-match "korean-hanja" current-input-method)
diff --git a/lisp/language/korean.el b/lisp/language/korean.el
index 210d0fabaf7..7e758159a48 100644
--- a/lisp/language/korean.el
+++ b/lisp/language/korean.el
@@ -84,6 +84,18 @@ and the following key bindings are available within Korean input methods:
F9, Hangul_Hanja: hangul-to-hanja-conversion")
))
+;; For auto-composing conjoining jamo.
+(let* ((choseong "[\u1100-\u115F\uA960-\uA97C]")
+ (jungseong "[\u1160-\u11A7\uD7B0-\uD7C6]")
+ (jongseong "[\u11A8-\u11FF\uD7CB-\uD7FB]?")
+ (pattern (concat choseong jungseong jongseong)))
+ (set-char-table-range composition-function-table
+ '(#x1100 . #x115F)
+ (list (vector pattern 0 'font-shape-gstring)))
+ (set-char-table-range composition-function-table
+ '(#xA960 . #xA97C)
+ (list (vector pattern 0 'font-shape-gstring))))
+
(provide 'korean)
;;; korean.el ends here
diff --git a/lisp/language/lao-util.el b/lisp/language/lao-util.el
index a20aecee421..fa4c2f7f891 100644
--- a/lisp/language/lao-util.el
+++ b/lisp/language/lao-util.el
@@ -183,7 +183,9 @@
;; Semi-vowel-sign-lo and lower vowels are put under the letter.
(defconst lao-transcription-consonant-alist
- (sort '(;; single consonants
+ (sort
+ (copy-sequence
+ '(;; single consonants
("k" . "ກ")
("kh" . "ຂ")
("qh" . "ຄ")
@@ -223,14 +225,16 @@
("hy" . ["ຫຍ"])
("hn" . ["ຫນ"])
("hm" . ["ຫມ"])
- )
- (function (lambda (x y) (> (length (car x)) (length (car y)))))))
+ ))
+ (lambda (x y) (> (length (car x)) (length (car y))))))
(defconst lao-transcription-semi-vowel-alist
'(("r" . "ຼ")))
(defconst lao-transcription-vowel-alist
- (sort '(("a" . "ະ")
+ (sort
+ (copy-sequence
+ '(("a" . "ະ")
("ar" . "າ")
("i" . "ິ")
("ii" . "ີ")
@@ -257,8 +261,8 @@
("ai" . "ໄ")
("ei" . "ໃ")
("ao" . ["ເົາ"])
- ("aM" . "ຳ"))
- (function (lambda (x y) (> (length (car x)) (length (car y)))))))
+ ("aM" . "ຳ")))
+ (lambda (x y) (> (length (car x)) (length (car y))))))
;; Maa-sakod is put at the tail.
(defconst lao-transcription-maa-sakod-alist
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index e25e63b4c5c..e3a24c41536 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -136,10 +136,10 @@ thin (i.e. 1-dot width) space."
(set-char-table-range
composition-function-table
'(#x600 . #x74F)
- (list (vector "[\u0600-\u074F\u200C\u200D]+" 0
- 'arabic-shape-gstring)
- (vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+" 1
- 'arabic-shape-gstring)))
+ (list (vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+"
+ 1 'arabic-shape-gstring)
+ (vector "[\u0600-\u074F\u200C\u200D]+"
+ 0 'arabic-shape-gstring)))
(provide 'misc-lang)
diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el
index 29fff9175b7..04369f6af87 100644
--- a/lisp/language/tibet-util.el
+++ b/lisp/language/tibet-util.el
@@ -43,13 +43,17 @@
("་" . "་")
("༔" . "༔")
;; Yes these are dirty. But ...
- ("༎ ༎" . ,(compose-string "༎ ༎" 0 3 [?༎ (Br . Bl) ? (Br . Bl) ?༎]))
+ ("༎ ༎" . ,(compose-string (copy-sequence "༎ ༎")
+ 0 3 [?༎ (Br . Bl) ? (Br . Bl) ?༎]))
("༄༅༅" . ,(compose-string
- "࿁࿂࿂࿂" 0 4
+ (copy-sequence "࿁࿂࿂࿂") 0 4
[?࿁ (Br . Bl) ?࿂ (Br . Bl) ?࿂ (Br . Bl) ?࿂]))
- ("༄༅" . ,(compose-string "࿁࿂࿂" 0 3 [?࿁ (Br . Bl) ?࿂ (Br . Bl) ?࿂]))
- ("༆" . ,(compose-string "࿁࿂༙" 0 3 [?࿁ (Br . Bl) ?࿂ (br . tr) ?༙]))
- ("༄" . ,(compose-string "࿁࿂" 0 2 [?࿁ (Br . Bl) ?࿂]))))
+ ("༄༅" . ,(compose-string (copy-sequence "࿁࿂࿂")
+ 0 3 [?࿁ (Br . Bl) ?࿂ (Br . Bl) ?࿂]))
+ ("༆" . ,(compose-string (copy-sequence "࿁࿂༙")
+ 0 3 [?࿁ (Br . Bl) ?࿂ (br . tr) ?༙]))
+ ("༄" . ,(compose-string (copy-sequence "࿁࿂")
+ 0 2 [?࿁ (Br . Bl) ?࿂]))))
;;;###autoload
(defun tibetan-char-p (ch)
@@ -271,7 +275,7 @@ The returned string has no composition information."
(compose-region from to components)))))))
(defvar tibetan-decompose-precomposition-alist
- (mapcar (function (lambda (x) (cons (string-to-char (cdr x)) (car x))))
+ (mapcar (lambda (x) (cons (string-to-char (cdr x)) (car x)))
tibetan-precomposition-rule-alist))
;;;###autoload
diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el
index d31cd5cd528..bbd4729f6c5 100644
--- a/lisp/language/tibetan.el
+++ b/lisp/language/tibetan.el
@@ -326,7 +326,9 @@
(defconst tibetan-subjoined-transcription-alist
- (sort '(("+k" . "ྐ")
+ (sort
+ (copy-sequence
+ '(("+k" . "ྐ")
("+kh" . "ྑ")
("+g" . "ྒ")
("+gh" . "ྒྷ")
@@ -371,8 +373,8 @@
("+W" . "ྺ") ;; fixed form subscribed WA
("+Y" . "ྻ") ;; fixed form subscribed YA
("+R" . "ྼ") ;; fixed form subscribed RA
- )
- (lambda (x y) (> (length (car x)) (length (car y))))))
+ ))
+ (lambda (x y) (> (length (car x)) (length (car y))))))
;;;
;;; alist for Tibetan base consonant <-> subjoined consonant conversion.
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index ccb419031db..3260b67a993 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -55,7 +55,7 @@ should return a grid vector array that is the new solution.
\(fn BREEDER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "5x5" '("5x5-")))
+(register-definition-prefixes "5x5" '("5x5-"))
;;;***
@@ -192,7 +192,7 @@ old-style time formats for entries are supported.
\(fn OTHER-LOG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "add-log" '("add-log-" "change-log-")))
+(register-definition-prefixes "add-log" '("add-log-" "change-log-"))
;;;***
@@ -329,7 +329,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
(function-put 'defadvice 'lisp-indent-function '2)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "advice" '("ad-")))
+(register-definition-prefixes "advice" '("ad-"))
;;;***
@@ -432,7 +432,7 @@ A replacement function for `newline-and-indent', aligning as it goes.
The alignment is done by calling `align' on the region that was
indented." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "align" '("align-")))
+(register-definition-prefixes "align" '("align-"))
;;;***
@@ -477,11 +477,11 @@ With value nil, inhibit any automatic allout-mode activation.")
(custom-autoload 'allout-auto-activation "allout" nil)
-(put 'allout-use-hanging-indents 'safe-local-variable (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(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 (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-show-bodies 'safe-local-variable 'booleanp)
(put 'allout-header-prefix 'safe-local-variable 'stringp)
@@ -493,13 +493,13 @@ With value nil, inhibit any automatic allout-mode activation.")
(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 (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-old-style-prefixes 'safe-local-variable 'booleanp)
-(put 'allout-stylish-prefixes 'safe-local-variable (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-stylish-prefixes 'safe-local-variable 'booleanp)
-(put 'allout-numbered-bullet 'safe-local-variable (if (fboundp 'string-or-null-p) 'string-or-null-p (lambda (x) (or (stringp x) (null x)))))
+(put 'allout-numbered-bullet 'safe-local-variable 'string-or-null-p)
-(put 'allout-file-xref-bullet 'safe-local-variable (if (fboundp 'string-or-null-p) 'string-or-null-p (lambda (x) (or (stringp x) (null x)))))
+(put 'allout-file-xref-bullet 'safe-local-variable 'string-or-null-p)
(put 'allout-presentation-padding 'safe-local-variable 'integerp)
@@ -516,6 +516,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\\<allout-mode-map-value>
Allout outline mode is a minor mode that provides extensive
outline oriented formatting and manipulation. It enables
@@ -788,7 +791,7 @@ for details on preparing Emacs for automatic allout activation.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "allout" '("allout-")))
+(register-definition-prefixes "allout" '("allout-"))
;;;***
@@ -821,7 +824,7 @@ 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 (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-widgets-mode-inhibit 'safe-local-variable 'booleanp)
(autoload 'allout-widgets-mode "allout-widgets" "\
Toggle Allout Widgets mode.
@@ -831,6 +834,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Allout Widgets mode is an extension of Allout mode that provides
graphical decoration of outline structure. It is meant to
operate along with `allout-mode', via `allout-mode-hook'.
@@ -851,7 +857,7 @@ outline hot-spot navigation (see `allout-mode').
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "allout-widgets" '("allout-")))
+(register-definition-prefixes "allout-widgets" '("allout-"))
;;;***
@@ -874,7 +880,7 @@ directory, so that Emacs will know its current contents.
\(fn OPERATION &rest ARGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ange-ftp" '("ange-ftp-" "ftp-error" "internal-ange-ftp-mode")))
+(register-definition-prefixes "ange-ftp" '("ange-ftp-" "ftp-error" "internal-ange-ftp-mode"))
;;;***
@@ -908,7 +914,7 @@ the buffer *Birthday-Present-for-Name*.
\(fn &optional NAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "animate" '("animat")))
+(register-definition-prefixes "animate" '("animat"))
;;;***
@@ -934,7 +940,7 @@ This is a good function to put in `comint-output-filter-functions'.
\(fn IGNORED)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ansi-color" '("ansi-color-")))
+(register-definition-prefixes "ansi-color" '("ansi-color-"))
;;;***
@@ -969,7 +975,7 @@ Major mode for editing ANTLR grammar files.
Use ANTLR's convention for TABs according to `antlr-tab-offset-alist'.
Used in `antlr-mode'. Also a useful function in `java-mode-hook'." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "antlr-mode" '("antlr-")))
+(register-definition-prefixes "antlr-mode" '("antlr-"))
;;;***
@@ -992,7 +998,7 @@ ARG is positive, otherwise off.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "appt" '("appt-")))
+(register-definition-prefixes "appt" '("appt-"))
;;;***
@@ -1038,6 +1044,19 @@ will be buffer-local when set.
\(fn PATTERN &optional BUFFER)" t nil)
+(autoload 'apropos-function "apropos" "\
+Show functions that match PATTERN.
+
+PATTERN can be a word, a list of words (separated by spaces),
+or a regexp (using some regexp special characters). If it is a word,
+search for matches for that word as a substring. If it is a list of words,
+search for matches for any two (or more) of those words.
+
+This is the same as running `apropos-command' with a \\[universal-argument] prefix,
+or a non-nil `apropos-do-all' argument.
+
+\(fn PATTERN)" t nil)
+
(defalias 'command-apropos 'apropos-command)
(autoload 'apropos-command "apropos" "\
@@ -1076,7 +1095,7 @@ search for matches for any two (or more) of those words.
With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil,
consider all symbols (if they match PATTERN).
-Returns list of symbols and documentation found.
+Return list of symbols and documentation found.
\(fn PATTERN &optional DO-ALL)" t nil)
@@ -1126,7 +1145,7 @@ Returns list of symbols and documentation found.
\(fn PATTERN &optional DO-ALL)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "apropos" '("apropos-")))
+(register-definition-prefixes "apropos" '("apropos-"))
;;;***
@@ -1148,7 +1167,7 @@ archive.
\(fn &optional FORCE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "arc-mode" '("arc")))
+(register-definition-prefixes "arc-mode" '("arc"))
;;;***
@@ -1221,7 +1240,7 @@ Entering array mode calls the function `array-mode-hook'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "array" '("array-" "current-line" "limit-index" "move-to-column-untabify" "untabify-backward")))
+(register-definition-prefixes "array" '("array-" "current-line" "limit-index" "move-to-column-untabify" "untabify-backward"))
;;;***
@@ -1237,6 +1256,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Artist lets you draw lines, squares, rectangles and poly-lines,
ellipses and circles with your mouse and/or keyboard.
@@ -1434,7 +1456,7 @@ Keymap summary
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "artist" '("artist-")))
+(register-definition-prefixes "artist" '("artist-"))
;;;***
@@ -1463,7 +1485,7 @@ Special commands:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "asm-mode" '("asm-")))
+(register-definition-prefixes "asm-mode" '("asm-"))
;;;***
@@ -1487,7 +1509,7 @@ passwords are revealed when point moved into the password.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "auth-source" '("auth")))
+(register-definition-prefixes "auth-source" '("auth"))
;;;***
@@ -1506,7 +1528,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 https://www.passwordstore.org/#organization):
secret
key1: value1
@@ -1514,7 +1536,7 @@ key2: value2
\(fn KEY ENTRY)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "auth-source-pass" '("auth-source-pass-")))
+(register-definition-prefixes "auth-source-pass" '("auth-source-pass-"))
;;;***
@@ -1569,6 +1591,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\\<autoarg-kp-mode-map>
This is similar to `autoarg-mode' but rebinds the keypad keys
`kp-1' etc. to supply digit arguments.
@@ -1577,7 +1602,7 @@ This is similar to `autoarg-mode' but rebinds the keypad keys
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "autoarg" '("autoarg-")))
+(register-definition-prefixes "autoarg" '("autoarg-"))
;;;***
@@ -1589,7 +1614,7 @@ Major mode for editing Autoconf configure.ac files.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "autoconf" '("autoconf-")))
+(register-definition-prefixes "autoconf" '("autoconf-"))
;;;***
@@ -1625,12 +1650,15 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When Auto-insert mode is enabled, when new files are created you can
insert a template for the file depending on the mode of the buffer.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "autoinsert" '("auto-insert")))
+(register-definition-prefixes "autoinsert" '("auto-insert"))
;;;***
@@ -1682,7 +1710,7 @@ Calls `update-directory-autoloads' on the command line arguments.
Definitions are written to `generated-autoload-file' (which
should be non-nil)." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "autoload" '("autoload-" "generate" "make-autoload" "no-update-autoloads")))
+(register-definition-prefixes "autoload" '("autoload-" "batch-update-autoloads--summary" "generate" "make-autoload" "no-update-autoloads"))
;;;***
@@ -1697,6 +1725,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Auto-Revert Mode is a minor mode that affects only the current
buffer. When enabled, it reverts the buffer when the file on
disk changes.
@@ -1724,6 +1755,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When Auto-Revert Tail Mode is enabled, the tail of the file is
constantly followed, as with the shell command `tail -f'. This
means that whenever the file grows on disk (presumably because
@@ -1765,6 +1799,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Global Auto-Revert Mode is a global minor mode that reverts any
buffer associated with a file when the file changes on disk. Use
`auto-revert-mode' to revert a particular buffer.
@@ -1784,7 +1821,7 @@ specifies in the mode line.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "autorevert" '("auto-revert-" "global-auto-revert-")))
+(register-definition-prefixes "autorevert" '("auto-revert-" "global-auto-revert-"))
;;;***
@@ -1792,7 +1829,7 @@ specifies in the mode line.
;;;;;; 0))
;;; Generated autoloads from emacs-lisp/avl-tree.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "avl-tree" '("avl-tree-")))
+(register-definition-prefixes "avl-tree" '("avl-tree-"))
;;;***
@@ -1832,7 +1869,7 @@ definition of \"random distance\".)
\(fn &optional MODE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "avoid" '("mouse-avoidance-")))
+(register-definition-prefixes "avoid" '("mouse-avoidance-"))
;;;***
@@ -1845,7 +1882,7 @@ definition of \"random distance\".)
Print a trace of Lisp function calls currently active.
Output stream used is value of `standard-output'." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "backtrace" '("backtrace-")))
+(register-definition-prefixes "backtrace" '("backtrace-"))
;;;***
@@ -1865,7 +1902,7 @@ Run script using `bat-run' and `bat-run-args'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bat-mode" '("bat-")))
+(register-definition-prefixes "bat-mode" '("bat-"))
;;;***
@@ -1896,6 +1933,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
The text displayed in the mode line is controlled by
`battery-mode-line-format' and `battery-status-function'.
The mode line is be updated every `battery-update-interval'
@@ -1903,7 +1943,7 @@ seconds.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "battery" '("battery-")))
+(register-definition-prefixes "battery" '("battery-"))
;;;***
@@ -1951,14 +1991,14 @@ The return value is the value of the final form in BODY.
(function-put 'benchmark-progn 'lisp-indent-function '0)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "benchmark" '("benchmark-elapse")))
+(register-definition-prefixes "benchmark" '("benchmark-elapse"))
;;;***
;;;### (autoloads nil "bib-mode" "textmodes/bib-mode.el" (0 0 0 0))
;;; Generated autoloads from textmodes/bib-mode.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bib-mode" '("addbib" "bib-" "mark-bib" "return-key-bib" "unread-bib")))
+(register-definition-prefixes "bib-mode" '("addbib" "bib-" "mark-bib" "return-key-bib" "unread-bib"))
;;;***
@@ -2051,7 +2091,7 @@ A prefix arg negates the value of `bibtex-search-entry-globally'.
\(fn KEY &optional GLOBAL START DISPLAY)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bibtex" '("bibtex-")))
+(register-definition-prefixes "bibtex" '("bibtex-"))
;;;***
@@ -2064,14 +2104,14 @@ Major mode for editing BibTeX style files.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bibtex-style" '("bibtex-style-")))
+(register-definition-prefixes "bibtex-style" '("bibtex-style-"))
;;;***
;;;### (autoloads nil "bindat" "emacs-lisp/bindat.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/bindat.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bindat" '("bindat-")))
+(register-definition-prefixes "bindat" '("bindat-"))
;;;***
@@ -2097,7 +2137,7 @@ Binhex decode region between START and END.
\(fn START END)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "binhex" '("binhex-")))
+(register-definition-prefixes "binhex" '("binhex-"))
;;;***
@@ -2218,7 +2258,7 @@ a reflection.
\(fn NUM)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "blackbox" '("bb-" "blackbox-")))
+(register-definition-prefixes "blackbox" '("bb-" "blackbox-"))
;;;***
@@ -2229,7 +2269,7 @@ a reflection.
(define-key ctl-x-r-map "M" 'bookmark-set-no-overwrite)
(define-key ctl-x-r-map "l" 'bookmark-bmenu-list)
-(defvar bookmark-map (let ((map (make-sparse-keymap))) (define-key map "x" 'bookmark-set) (define-key map "m" 'bookmark-set) (define-key map "M" 'bookmark-set-no-overwrite) (define-key map "j" 'bookmark-jump) (define-key map "g" 'bookmark-jump) (define-key map "o" 'bookmark-jump-other-window) (define-key map "5" 'bookmark-jump-other-frame) (define-key map "i" 'bookmark-insert) (define-key map "e" 'edit-bookmarks) (define-key map "f" 'bookmark-insert-location) (define-key map "r" 'bookmark-rename) (define-key map "d" 'bookmark-delete) (define-key map "l" 'bookmark-load) (define-key map "w" 'bookmark-write) (define-key map "s" 'bookmark-save) map) "\
+(defvar bookmark-map (let ((map (make-sparse-keymap))) (define-key map "x" 'bookmark-set) (define-key map "m" 'bookmark-set) (define-key map "M" 'bookmark-set-no-overwrite) (define-key map "j" 'bookmark-jump) (define-key map "g" 'bookmark-jump) (define-key map "o" 'bookmark-jump-other-window) (define-key map "5" 'bookmark-jump-other-frame) (define-key map "i" 'bookmark-insert) (define-key map "e" 'edit-bookmarks) (define-key map "f" 'bookmark-insert-location) (define-key map "r" 'bookmark-rename) (define-key map "d" 'bookmark-delete) (define-key map "D" 'bookmark-delete-all) (define-key map "l" 'bookmark-load) (define-key map "w" 'bookmark-write) (define-key map "s" 'bookmark-save) map) "\
Keymap containing bindings to bookmark functions.
It is not bound to any key by default: to bind it
so that you have a bookmark prefix, just use `global-set-key' and bind a
@@ -2382,6 +2422,13 @@ probably because we were called from there.
\(fn BOOKMARK-NAME &optional BATCH)" t nil)
+(autoload 'bookmark-delete-all "bookmark" "\
+Permanently delete all bookmarks.
+If optional argument NO-CONFIRM is non-nil, don't ask for
+confirmation.
+
+\(fn &optional NO-CONFIRM)" t nil)
+
(autoload 'bookmark-write "bookmark" "\
Write bookmarks to a file (reading the file name with the minibuffer)." t nil)
@@ -2423,6 +2470,10 @@ unique numeric suffixes \"<2>\", \"<3>\", etc.
\(fn FILE &optional OVERWRITE NO-MSG DEFAULT)" t nil)
+(autoload 'bookmark-bmenu-get-buffer "bookmark" "\
+Return the Bookmark List, building it if it doesn't exists.
+Don't affect the buffer ring order." nil nil)
+
(autoload 'bookmark-bmenu-list "bookmark" "\
Display a list of existing bookmarks.
The list is displayed in a buffer named `*Bookmark List*'.
@@ -2436,11 +2487,11 @@ deletion, or > if it is flagged for displaying." t nil)
(autoload 'bookmark-bmenu-search "bookmark" "\
Incremental search of bookmarks, hiding the non-matches as we go." t 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 [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))
+(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))
(defalias 'menu-bar-bookmark-map menu-bar-bookmark-map)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bookmark" '("bookmark-" "with-buffer-modified-unmodified")))
+(register-definition-prefixes "bookmark" '("bookmark-" "with-buffer-modified-unmodified"))
;;;***
@@ -2452,16 +2503,34 @@ Function to display the current buffer in a WWW browser.
This is used by the `browse-url-at-point', `browse-url-at-mouse', and
`browse-url-of-file' commands.
-If the value is not a function it should be a list of pairs
-\(REGEXP . FUNCTION). In this case the function called will be the one
-associated with the first REGEXP which matches the current URL. The
-function is passed the URL and any other args of `browse-url'. The last
-regexp should probably be \".\" to specify a default browser.
-
-Also see `browse-url-secondary-browser-function'.")
+Also see `browse-url-secondary-browser-function' and
+`browse-url-handlers'.")
(custom-autoload 'browse-url-browser-function "browse-url" t)
+(defvar browse-url-default-handlers '(("\\`mailto:" . browse-url--mailto) ("\\`man:" . browse-url--man) (browse-url--non-html-file-url-p . browse-url-emacs)) "\
+Like `browse-url-handlers' but populated by Emacs and packages.
+
+Emacs and external packages capable of browsing certain URLs
+should place their entries in this alist rather than
+`browse-url-handlers' which is reserved for the user.")
+
+(autoload 'browse-url-select-handler "browse-url" "\
+Return a handler of suitable for browsing URL.
+This searches `browse-url-handlers', and
+`browse-url-default-handlers' for a matching handler. Return nil
+if no handler is found.
+
+If KIND is given, the search is restricted to handlers whose
+function symbol has the symbol-property `browse-url-browser-kind'
+set to KIND.
+
+Currently, it also consults `browse-url-browser-function' first
+if it is set to an alist, although this usage is deprecated since
+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.
Display the current buffer's file if FILE is nil or if called
@@ -2491,16 +2560,18 @@ Ask a WWW browser to display the current region.
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.
-The variable `browse-url-browser-function' says which browser function to
-use. If the URL is a mailto: URL, consult `browse-url-mailto-function'
-first, if that exists.
-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 significance of ARGS (most of the functions
-ignore it).
-If ARGS are omitted, the default is to pass `browse-url-new-window-flag'
-as ARGS.
+The variables `browse-url-browser-function',
+`browse-url-handlers', and `browse-url-default-handlers'
+determine which browser function to use.
+
+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
+significance of ARGS (most of the functions ignore it).
+
+If ARGS are omitted, the default is to pass
+`browse-url-new-window-flag' as ARGS.
\(fn URL &rest ARGS)" t nil)
@@ -2512,6 +2583,15 @@ Optional prefix argument ARG non-nil inverts the value of the option
\(fn &optional ARG)" t nil)
+(autoload 'browse-url-with-browser-kind "browse-url" "\
+Browse URL with a browser of the given browser KIND.
+KIND is either `internal' or `external'.
+
+When called interactively, the default browser kind is the
+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
@@ -2639,46 +2719,6 @@ used instead of `browse-url-new-window-flag'.
(make-obsolete 'browse-url-gnome-moz 'nil '"25.1")
-(autoload 'browse-url-mosaic "browse-url" "\
-Ask the XMosaic WWW browser to load URL.
-
-Default to the URL around or before point. The strings in variable
-`browse-url-mosaic-arguments' are also passed to Mosaic and the
-program is invoked according to the variable
-`browse-url-mosaic-program'.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Mosaic window, otherwise use a
-random existing one. A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'.
-
-\(fn URL &optional NEW-WINDOW)" t nil)
-
-(make-obsolete 'browse-url-mosaic 'nil '"25.1")
-
-(autoload 'browse-url-cci "browse-url" "\
-Ask the XMosaic WWW browser to load URL.
-Default to the URL around or before point.
-
-This function only works for XMosaic version 2.5 or later. You must
-select `CCI' from XMosaic's File menu, set the CCI Port Address to the
-value of variable `browse-url-CCI-port', and enable `Accept requests'.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new browser window, otherwise use a
-random existing one. A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'.
-
-\(fn URL &optional NEW-WINDOW)" t nil)
-
-(make-obsolete 'browse-url-cci 'nil '"25.1")
-
(autoload 'browse-url-conkeror "browse-url" "\
Ask the Conkeror WWW browser to load URL.
Default to the URL around or before point. Also pass the strings
@@ -2699,6 +2739,8 @@ NEW-WINDOW instead of `browse-url-new-window-flag'.
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-conkeror 'nil '"28.1")
+
(autoload 'browse-url-w3 "browse-url" "\
Ask the w3 WWW browser to load URL.
Default to the URL around or before point.
@@ -2792,7 +2834,7 @@ from `browse-url-elinks-wrapper'.
\(fn URL &optional NEW-WINDOW)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "browse-url" '("browse-url-")))
+(register-definition-prefixes "browse-url" '("browse-url-"))
;;;***
@@ -2829,7 +2871,7 @@ name of buffer configuration.
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bs" '("bs-")))
+(register-definition-prefixes "bs" '("bs-"))
;;;***
@@ -2850,7 +2892,7 @@ columns on its right towards the left.
\\[bubbles-set-game-difficult] sets the difficulty to difficult.
\\[bubbles-set-game-hard] sets the difficulty to hard." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bubbles" '("bubbles-")))
+(register-definition-prefixes "bubbles" '("bubbles-"))
;;;***
@@ -2870,6 +2912,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
(autoload 'bug-reference-prog-mode "bug-reference" "\
@@ -2880,9 +2925,12 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bug-reference" '("bug-reference-")))
+(register-definition-prefixes "bug-reference" '("bug-reference-"))
;;;***
@@ -2890,7 +2938,7 @@ ARG is `toggle'; disable the mode otherwise.
;;;;;; 0))
;;; Generated autoloads from emacs-lisp/byte-opt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "byte-opt" '("byte-" "disassemble-offset")))
+(register-definition-prefixes "byte-opt" '("byte-" "disassemble-offset"))
;;;***
@@ -3019,7 +3067,7 @@ and corresponding effects.
\(fn &optional ARG)" nil nil)
-(if (fboundp 'register-definition-prefixes) (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"))
;;;***
@@ -3027,7 +3075,7 @@ and corresponding effects.
;;;;;; 0))
;;; Generated autoloads from calendar/cal-bahai.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-bahai" '("calendar-bahai-" "diary-bahai-" "holiday-bahai")))
+(register-definition-prefixes "cal-bahai" '("calendar-bahai-" "diary-bahai-" "holiday-bahai"))
;;;***
@@ -3037,7 +3085,7 @@ and corresponding effects.
(put 'calendar-chinese-time-zone 'risky-local-variable t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-china" '("calendar-chinese-" "diary-chinese-" "holiday-chinese")))
+(register-definition-prefixes "cal-china" '("calendar-chinese-" "diary-chinese-" "holiday-chinese"))
;;;***
@@ -3045,7 +3093,7 @@ and corresponding effects.
;;;;;; 0 0))
;;; Generated autoloads from calendar/cal-coptic.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-coptic" '("calendar-" "diary-")))
+(register-definition-prefixes "cal-coptic" '("calendar-" "diary-"))
;;;***
@@ -3058,7 +3106,7 @@ and corresponding effects.
(put 'calendar-current-time-zone-cache 'risky-local-variable t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-dst" '("calendar-" "dst-")))
+(register-definition-prefixes "cal-dst" '("calendar-" "dst-"))
;;;***
@@ -3066,7 +3114,7 @@ and corresponding effects.
;;;;;; 0 0))
;;; Generated autoloads from calendar/cal-french.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-french" '("calendar-french-" "diary-french-date")))
+(register-definition-prefixes "cal-french" '("calendar-french-" "diary-french-date"))
;;;***
@@ -3081,14 +3129,14 @@ from the cursor position.
\(fn DEATH-DATE START-YEAR END-YEAR)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-hebrew" '("calendar-hebrew-" "diary-hebrew-" "holiday-hebrew")))
+(register-definition-prefixes "cal-hebrew" '("calendar-hebrew-" "diary-hebrew-" "holiday-hebrew"))
;;;***
;;;### (autoloads nil "cal-html" "calendar/cal-html.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-html.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-html" '("cal-html-")))
+(register-definition-prefixes "cal-html" '("cal-html-"))
;;;***
@@ -3096,14 +3144,14 @@ from the cursor position.
;;;;;; 0))
;;; Generated autoloads from calendar/cal-islam.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-islam" '("calendar-islamic-" "diary-islamic-" "holiday-islamic")))
+(register-definition-prefixes "cal-islam" '("calendar-islamic-" "diary-islamic-" "holiday-islamic"))
;;;***
;;;### (autoloads nil "cal-iso" "calendar/cal-iso.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-iso.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-iso" '("calendar-iso-" "diary-iso-date")))
+(register-definition-prefixes "cal-iso" '("calendar-iso-" "diary-iso-date"))
;;;***
@@ -3111,7 +3159,7 @@ from the cursor position.
;;;;;; 0 0))
;;; Generated autoloads from calendar/cal-julian.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-julian" '("calendar-" "diary-" "holiday-julian")))
+(register-definition-prefixes "cal-julian" '("calendar-" "diary-" "holiday-julian"))
;;;***
@@ -3119,21 +3167,21 @@ from the cursor position.
;;;;;; 0))
;;; Generated autoloads from calendar/cal-mayan.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-mayan" '("calendar-mayan-" "diary-mayan-date")))
+(register-definition-prefixes "cal-mayan" '("calendar-mayan-" "diary-mayan-date"))
;;;***
;;;### (autoloads nil "cal-menu" "calendar/cal-menu.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-menu.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-menu" '("cal")))
+(register-definition-prefixes "cal-menu" '("cal"))
;;;***
;;;### (autoloads nil "cal-move" "calendar/cal-move.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-move.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-move" '("calendar-")))
+(register-definition-prefixes "cal-move" '("calendar-"))
;;;***
@@ -3141,21 +3189,21 @@ from the cursor position.
;;;;;; 0 0))
;;; Generated autoloads from calendar/cal-persia.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-persia" '("calendar-persian-" "diary-persian-date")))
+(register-definition-prefixes "cal-persia" '("calendar-persian-" "diary-persian-date"))
;;;***
;;;### (autoloads nil "cal-tex" "calendar/cal-tex.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-tex.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-tex" '("cal-tex-")))
+(register-definition-prefixes "cal-tex" '("cal-tex-"))
;;;***
;;;### (autoloads nil "cal-x" "calendar/cal-x.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-x.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-x" '("calendar-" "diary-frame")))
+(register-definition-prefixes "cal-x" '("calendar-" "diary-frame"))
;;;***
@@ -3243,7 +3291,7 @@ See Info node `(calc)Defining Functions'.
(function-put 'defmath 'doc-string-elt '3)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc" '("calc" "defcalcmodevar" "inexact-result" "math-" "var-")))
+(register-definition-prefixes "calc" '("calc" "defcalcmodevar" "inexact-result" "math-" "var-"))
;;;***
@@ -3251,42 +3299,42 @@ See Info node `(calc)Defining Functions'.
;;;;;; (0 0 0 0))
;;; Generated autoloads from calc/calc-aent.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-aent" '("calc" "math-")))
+(register-definition-prefixes "calc-aent" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-alg" "calc/calc-alg.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-alg.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-alg" '("calc" "math-")))
+(register-definition-prefixes "calc-alg" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-arith" "calc/calc-arith.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-arith.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-arith" '("calc" "math-")))
+(register-definition-prefixes "calc-arith" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-bin" "calc/calc-bin.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-bin.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-bin" '("calc" "math-")))
+(register-definition-prefixes "calc-bin" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-comb" "calc/calc-comb.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-comb.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-comb" '("calc" "math-")))
+(register-definition-prefixes "calc-comb" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-cplx" "calc/calc-cplx.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-cplx.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-cplx" '("calc" "math-")))
+(register-definition-prefixes "calc-cplx" '("calc" "math-"))
;;;***
@@ -3294,105 +3342,105 @@ See Info node `(calc)Defining Functions'.
;;;;;; (0 0 0 0))
;;; Generated autoloads from calc/calc-embed.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-embed" '("calc-")))
+(register-definition-prefixes "calc-embed" '("calc-"))
;;;***
;;;### (autoloads nil "calc-ext" "calc/calc-ext.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-ext.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-ext" '("calc" "math-" "var-")))
+(register-definition-prefixes "calc-ext" '("calc" "math-" "var-"))
;;;***
;;;### (autoloads nil "calc-fin" "calc/calc-fin.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-fin.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-fin" '("calc" "math-c")))
+(register-definition-prefixes "calc-fin" '("calc" "math-c"))
;;;***
;;;### (autoloads nil "calc-forms" "calc/calc-forms.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-forms.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-forms" '("calc" "math-" "var-TimeZone")))
+(register-definition-prefixes "calc-forms" '("calc" "math-" "var-TimeZone"))
;;;***
;;;### (autoloads nil "calc-frac" "calc/calc-frac.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-frac.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-frac" '("calc" "math-")))
+(register-definition-prefixes "calc-frac" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-funcs" "calc/calc-funcs.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-funcs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-funcs" '("calc" "math-")))
+(register-definition-prefixes "calc-funcs" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-graph" "calc/calc-graph.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-graph.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-graph" '("calc-")))
+(register-definition-prefixes "calc-graph" '("calc-"))
;;;***
;;;### (autoloads nil "calc-help" "calc/calc-help.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-help.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-help" '("calc-")))
+(register-definition-prefixes "calc-help" '("calc-"))
;;;***
;;;### (autoloads nil "calc-incom" "calc/calc-incom.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-incom.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-incom" '("calc-")))
+(register-definition-prefixes "calc-incom" '("calc-"))
;;;***
;;;### (autoloads nil "calc-keypd" "calc/calc-keypd.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-keypd.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-keypd" '("calc-")))
+(register-definition-prefixes "calc-keypd" '("calc-"))
;;;***
;;;### (autoloads nil "calc-lang" "calc/calc-lang.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-lang.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-lang" '("calc-" "math-")))
+(register-definition-prefixes "calc-lang" '("calc-" "math-"))
;;;***
;;;### (autoloads nil "calc-macs" "calc/calc-macs.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-macs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-macs" '("Math-" "calc-" "math-")))
+(register-definition-prefixes "calc-macs" '("Math-" "calc-" "math-"))
;;;***
;;;### (autoloads nil "calc-map" "calc/calc-map.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-map.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-map" '("calc" "math-")))
+(register-definition-prefixes "calc-map" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-math" "calc/calc-math.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-math.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-math" '("calc" "math-")))
+(register-definition-prefixes "calc-math" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-menu" "calc/calc-menu.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-menu.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-menu" '("calc-")))
+(register-definition-prefixes "calc-menu" '("calc-"))
;;;***
@@ -3400,91 +3448,91 @@ See Info node `(calc)Defining Functions'.
;;;;;; (0 0 0 0))
;;; Generated autoloads from calc/calc-misc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-misc" '("math-iipow")))
+(register-definition-prefixes "calc-misc" '("math-iipow"))
;;;***
;;;### (autoloads nil "calc-mode" "calc/calc-mode.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-mode.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-mode" '("calc-" "math-get-modes-vec")))
+(register-definition-prefixes "calc-mode" '("calc-" "math-get-modes-vec"))
;;;***
;;;### (autoloads nil "calc-mtx" "calc/calc-mtx.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-mtx.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-mtx" '("calc" "math-")))
+(register-definition-prefixes "calc-mtx" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-nlfit" "calc/calc-nlfit.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-nlfit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-nlfit" '("calc-fit-" "math-nlfit-")))
+(register-definition-prefixes "calc-nlfit" '("calc-fit-" "math-nlfit-"))
;;;***
;;;### (autoloads nil "calc-poly" "calc/calc-poly.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-poly.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-poly" '("calcFunc-" "math-")))
+(register-definition-prefixes "calc-poly" '("calcFunc-" "math-"))
;;;***
;;;### (autoloads nil "calc-prog" "calc/calc-prog.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-prog.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-prog" '("calc" "math-" "var-q")))
+(register-definition-prefixes "calc-prog" '("calc" "math-" "var-q"))
;;;***
;;;### (autoloads nil "calc-rewr" "calc/calc-rewr.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-rewr.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-rewr" '("calc" "math-")))
+(register-definition-prefixes "calc-rewr" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-rules" "calc/calc-rules.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-rules.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-rules" '("calc-")))
+(register-definition-prefixes "calc-rules" '("calc-"))
;;;***
;;;### (autoloads nil "calc-sel" "calc/calc-sel.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-sel.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-sel" '("calc-")))
+(register-definition-prefixes "calc-sel" '("calc-"))
;;;***
;;;### (autoloads nil "calc-stat" "calc/calc-stat.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-stat.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-stat" '("calc" "math-")))
+(register-definition-prefixes "calc-stat" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-store" "calc/calc-store.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-store.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-store" '("calc")))
+(register-definition-prefixes "calc-store" '("calc"))
;;;***
;;;### (autoloads nil "calc-stuff" "calc/calc-stuff.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-stuff.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-stuff" '("calc" "math-")))
+(register-definition-prefixes "calc-stuff" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-trail" "calc/calc-trail.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-trail.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-trail" '("calc-trail-")))
+(register-definition-prefixes "calc-trail" '("calc-trail-"))
;;;***
@@ -3496,21 +3544,21 @@ See Info node `(calc)Defining Functions'.
\(fn N)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-undo" '("calc-")))
+(register-definition-prefixes "calc-undo" '("calc-"))
;;;***
;;;### (autoloads nil "calc-units" "calc/calc-units.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-units.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-units" '("calc" "math-")))
+(register-definition-prefixes "calc-units" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-vec" "calc/calc-vec.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-vec.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-vec" '("calc" "math-")))
+(register-definition-prefixes "calc-vec" '("calc" "math-"))
;;;***
@@ -3518,35 +3566,35 @@ See Info node `(calc)Defining Functions'.
;;;;;; (0 0 0 0))
;;; Generated autoloads from calc/calc-yank.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-yank" '("calc-" "math-number-regexp")))
+(register-definition-prefixes "calc-yank" '("calc-" "math-number-regexp"))
;;;***
;;;### (autoloads nil "calcalg2" "calc/calcalg2.el" (0 0 0 0))
;;; Generated autoloads from calc/calcalg2.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calcalg2" '("calc" "math-" "var-IntegLimit")))
+(register-definition-prefixes "calcalg2" '("calc" "math-" "var-IntegLimit"))
;;;***
;;;### (autoloads nil "calcalg3" "calc/calcalg3.el" (0 0 0 0))
;;; Generated autoloads from calc/calcalg3.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calcalg3" '("calc" "math-")))
+(register-definition-prefixes "calcalg3" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calccomp" "calc/calccomp.el" (0 0 0 0))
;;; Generated autoloads from calc/calccomp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calccomp" '("calcFunc-c" "math-")))
+(register-definition-prefixes "calccomp" '("calcFunc-c" "math-"))
;;;***
;;;### (autoloads nil "calcsel2" "calc/calcsel2.el" (0 0 0 0))
;;; Generated autoloads from calc/calcsel2.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calcsel2" '("calc-")))
+(register-definition-prefixes "calcsel2" '("calc-"))
;;;***
@@ -3557,7 +3605,7 @@ See Info node `(calc)Defining Functions'.
Run the Emacs calculator.
See the documentation for `calculator-mode' for more information." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calculator" '("calculator-")))
+(register-definition-prefixes "calculator" '("calculator-"))
;;;***
@@ -3601,7 +3649,7 @@ This function is suitable for execution in an init file.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calendar" '("calendar-" "diary-" "holiday-buffer" "lunar-phases-buffer" "solar-sunrises-buffer")))
+(register-definition-prefixes "calendar" '("calendar-" "diary-" "holiday-buffer" "lunar-phases-buffer" "solar-sunrises-buffer"))
;;;***
@@ -3620,21 +3668,21 @@ it fails.
\(fn &optional BUFFER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "canlock" '("canlock-")))
+(register-definition-prefixes "canlock" '("canlock-"))
;;;***
;;;### (autoloads nil "cc-align" "progmodes/cc-align.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-align.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-align" '("c-")))
+(register-definition-prefixes "cc-align" '("c-"))
;;;***
;;;### (autoloads nil "cc-awk" "progmodes/cc-awk.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-awk.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-awk" '("awk-" "c-awk-")))
+(register-definition-prefixes "cc-awk" '("awk-" "c-awk-"))
;;;***
@@ -3642,21 +3690,21 @@ it fails.
;;;;;; 0 0 0))
;;; Generated autoloads from progmodes/cc-bytecomp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-bytecomp" '("cc-")))
+(register-definition-prefixes "cc-bytecomp" '("cc-"))
;;;***
;;;### (autoloads nil "cc-cmds" "progmodes/cc-cmds.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-cmds.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-cmds" '("c-")))
+(register-definition-prefixes "cc-cmds" '("c-"))
;;;***
;;;### (autoloads nil "cc-defs" "progmodes/cc-defs.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-defs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-defs" '("c-" "cc-bytecomp-compiling-or-loading")))
+(register-definition-prefixes "cc-defs" '("c-" "cc-bytecomp-compiling-or-loading"))
;;;***
@@ -3667,14 +3715,14 @@ it fails.
(autoload 'c-guess-basic-syntax "cc-engine" "\
Return the syntactic context of the current line." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-engine" '("c-")))
+(register-definition-prefixes "cc-engine" '("c-"))
;;;***
;;;### (autoloads nil "cc-fonts" "progmodes/cc-fonts.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-fonts.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-fonts" '("autodoc-" "c++-font-lock-keywords" "c-" "gtkdoc-font-lock-" "idl-font-lock-keywords" "java" "objc-font-lock-keywords" "pike-font-lock-keywords")))
+(register-definition-prefixes "cc-fonts" '("autodoc-" "c++-font-lock-keywords" "c-" "doxygen-font-lock-" "gtkdoc-font-lock-" "idl-font-lock-keywords" "java" "objc-font-lock-keywords" "pike-font-lock-keywords"))
;;;***
@@ -3774,21 +3822,21 @@ the absolute file name of the file if STYLE-NAME is nil.
\(fn &optional STYLE-NAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-guess" '("c-guess-")))
+(register-definition-prefixes "cc-guess" '("c-guess-"))
;;;***
;;;### (autoloads nil "cc-langs" "progmodes/cc-langs.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-langs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-langs" '("c-")))
+(register-definition-prefixes "cc-langs" '("c-"))
;;;***
;;;### (autoloads nil "cc-menus" "progmodes/cc-menus.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-menus.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-menus" '("cc-imenu-")))
+(register-definition-prefixes "cc-menus" '("cc-imenu-"))
;;;***
@@ -3843,7 +3891,7 @@ should be used.
This function attempts to use file contents to determine whether
the code is C or C++ and based on that chooses whether to enable
-`c-mode' or `c++-mode'." nil nil)
+`c-mode' or `c++-mode'." t nil)
(autoload 'c++-mode "cc-mode" "\
Major mode for editing C++ code.
@@ -3962,7 +4010,7 @@ Key bindings:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-mode" '("awk-mode-map" "c++-mode-" "c-" "idl-mode-" "java-mode-" "objc-mode-" "pike-mode-")))
+(register-definition-prefixes "cc-mode" '("awk-mode-map" "c++-mode-" "c-" "idl-mode-" "java-mode-" "objc-mode-" "pike-mode-"))
;;;***
@@ -4016,7 +4064,7 @@ and exists only for compatibility reasons.
\(fn SYMBOL OFFSET &optional IGNORED)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-styles" '("c-" "cc-choose-style-for-mode")))
+(register-definition-prefixes "cc-styles" '("c-" "cc-choose-style-for-mode"))
;;;***
@@ -4026,7 +4074,7 @@ and exists only for compatibility reasons.
(put 'c-backslash-column 'safe-local-variable 'integerp)
(put 'c-file-style 'safe-local-variable 'string-or-null-p)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-vars" '("awk-mode-hook" "c++-" "c-" "defcustom-c-stylevar" "idl-" "java-" "objc-" "pike-")))
+(register-definition-prefixes "cc-vars" '("awk-mode-hook" "c++-" "c-" "defcustom-c-stylevar" "idl-" "java-" "objc-" "pike-"))
;;;***
@@ -4321,7 +4369,7 @@ See the documentation of `define-ccl-program' for the detail of CCL program.
\(fn CCL-PROG &rest ARGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ccl" '("ccl-")))
+(register-definition-prefixes "ccl" '("ccl-"))
;;;***
@@ -4342,14 +4390,14 @@ Add the warnings that closure conversion would encounter.
\(fn FORM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cconv" '("cconv-")))
+(register-definition-prefixes "cconv" '("cconv-"))
;;;***
;;;### (autoloads nil "cdl" "cdl.el" (0 0 0 0))
;;; Generated autoloads from cdl.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cdl" '("cdl-")))
+(register-definition-prefixes "cdl" '("cdl-"))
;;;***
@@ -4357,7 +4405,7 @@ Add the warnings that closure conversion would encounter.
;;; Generated autoloads from cedet/cedet.el
(push (purecopy '(cedet 2 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cedet" '("cedet-")))
+(register-definition-prefixes "cedet" '("cedet-"))
;;;***
@@ -4365,7 +4413,7 @@ Add the warnings that closure conversion would encounter.
;;;;;; 0 0))
;;; Generated autoloads from cedet/cedet-cscope.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cedet-cscope" '("cedet-cscope-")))
+(register-definition-prefixes "cedet-cscope" '("cedet-cscope-"))
;;;***
@@ -4373,7 +4421,7 @@ Add the warnings that closure conversion would encounter.
;;;;;; 0))
;;; Generated autoloads from cedet/cedet-files.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cedet-files" '("cedet-")))
+(register-definition-prefixes "cedet-files" '("cedet-"))
;;;***
@@ -4381,7 +4429,7 @@ Add the warnings that closure conversion would encounter.
;;;;;; 0 0))
;;; Generated autoloads from cedet/cedet-global.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cedet-global" '("cedet-g")))
+(register-definition-prefixes "cedet-global" '("cedet-g"))
;;;***
@@ -4389,7 +4437,7 @@ Add the warnings that closure conversion would encounter.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/cedet-idutils.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cedet-idutils" '("cedet-idutils-")))
+(register-definition-prefixes "cedet-idutils" '("cedet-idutils-"))
;;;***
@@ -4418,7 +4466,7 @@ to the action header.
(autoload 'cfengine-auto-mode "cfengine" "\
Choose `cfengine2-mode' or `cfengine3-mode' by buffer contents." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cfengine" '("cfengine")))
+(register-definition-prefixes "cfengine" '("cfengine"))
;;;***
@@ -4445,7 +4493,7 @@ from which to start.
\(fn STRING &optional LAX FROM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "char-fold" '("char-fold-")))
+(register-definition-prefixes "char-fold" '("char-fold-"))
;;;***
@@ -4453,7 +4501,7 @@ from which to start.
;;; Generated autoloads from emacs-lisp/chart.el
(push (purecopy '(chart 0 2)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "chart" '("chart")))
+(register-definition-prefixes "chart" '("chart"))
;;;***
@@ -4473,14 +4521,13 @@ Returns non-nil if any false statements are found.
\(fn ROOT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "check-declare" '("check-declare-")))
+(register-definition-prefixes "check-declare" '("check-declare-"))
;;;***
;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (0 0 0
;;;;;; 0))
;;; Generated autoloads from emacs-lisp/checkdoc.el
-(push (purecopy '(checkdoc 0 6 2)) package--builtin-versions)
(put 'checkdoc-force-docstrings-flag 'safe-local-variable #'booleanp)
(put 'checkdoc-force-history-flag 'safe-local-variable #'booleanp)
(put 'checkdoc-permit-comma-termination-flag 'safe-local-variable #'booleanp)
@@ -4650,6 +4697,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
In Checkdoc minor mode, the usual bindings for `eval-defun' which is
bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
checking of documentation strings.
@@ -4661,7 +4711,7 @@ checking of documentation strings.
(autoload 'checkdoc-package-keywords "checkdoc" "\
Find package keywords that aren't in `finder-known-keywords'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "checkdoc" '("checkdoc-")))
+(register-definition-prefixes "checkdoc" '("checkdoc-"))
;;;***
@@ -4697,7 +4747,7 @@ Encode the text in the current buffer to HZ." t nil)
\(fn FROM TO)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "china-util" '("decode-hz-line-continuation" "hz-" "hz/zw-start-gb" "iso2022-" "zw-start-gb")))
+(register-definition-prefixes "china-util" '("decode-hz-line-continuation" "hz-" "hz/zw-start-gb" "iso2022-" "zw-start-gb"))
;;;***
@@ -4734,7 +4784,7 @@ and digits provide prefix arguments. Tab does not indent.
This command always recompiles the Command History listing
and runs the normal hook `command-history-hook'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "chistory" '("command-history-" "default-command-history-filter" "list-command-history-")))
+(register-definition-prefixes "chistory" '("command-history-" "default-command-history-filter" "list-command-history-"))
;;;***
@@ -4742,7 +4792,38 @@ and runs the normal hook `command-history-hook'." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from emacs-lisp/cl-extra.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-extra" '("cl-")))
+(register-definition-prefixes "cl-extra" '("cl-"))
+
+;;;***
+
+;;;### (autoloads nil "cl-font-lock" "progmodes/cl-font-lock.el"
+;;;;;; (0 0 0 0))
+;;; Generated autoloads from progmodes/cl-font-lock.el
+
+(defvar cl-font-lock-built-in-mode nil "\
+Non-nil if Cl-Font-Lock-Built-In mode is enabled.
+See the `cl-font-lock-built-in-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 `cl-font-lock-built-in-mode'.")
+
+(custom-autoload 'cl-font-lock-built-in-mode "cl-font-lock" nil)
+
+(autoload 'cl-font-lock-built-in-mode "cl-font-lock" "\
+Highlight built-in functions, variables, and types in `lisp-mode'.
+
+If called interactively, enable Cl-Font-Lock-Built-In mode if ARG is
+positive, and disable it if ARG is zero or negative. If called from
+Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
+ARG is `toggle'; disable the mode otherwise.
+
+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 "cl-font-lock" '("cl-font-lock-"))
;;;***
@@ -4818,7 +4899,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
\(fn GENERIC QUALIFIERS SPECIALIZERS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-generic" '("cl-")))
+(register-definition-prefixes "cl-generic" '("cl-"))
;;;***
@@ -4904,7 +4985,7 @@ instead.
\(fn INDENT-POINT STATE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-indent" '("common-lisp-" "lisp-")))
+(register-definition-prefixes "cl-indent" '("common-lisp-" "lisp-"))
;;;***
@@ -4952,9 +5033,12 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-lib" '("cl-")))
+(register-definition-prefixes "cl-lib" '("cl-"))
;;;***
@@ -4962,7 +5046,7 @@ ARG is `toggle'; disable the mode otherwise.
;;;;;; (0 0 0 0))
;;; Generated autoloads from emacs-lisp/cl-macs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-macs" '("cl-")))
+(register-definition-prefixes "cl-macs" '("cl-"))
;;;***
@@ -5018,7 +5102,7 @@ limit.
\(fn PRINT-FUNCTION VALUE LIMIT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-print" '("cl-print-" "help-byte-code")))
+(register-definition-prefixes "cl-print" '("cl-print-" "help-byte-code"))
;;;***
@@ -5026,7 +5110,7 @@ limit.
;;;;;; (0 0 0 0))
;;; Generated autoloads from emacs-lisp/cl-seq.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-seq" '("cl--")))
+(register-definition-prefixes "cl-seq" '("cl--"))
;;;***
@@ -5048,7 +5132,7 @@ For use inside Lisp programs, see also `c-macro-expansion'.
\(fn START END SUBST)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cmacexp" '("c-macro-")))
+(register-definition-prefixes "cmacexp" '("c-macro-"))
;;;***
@@ -5070,7 +5154,7 @@ is run).
\(fn CMD)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cmuscheme" '("cmuscheme-load-hook" "inferior-scheme-" "scheme-" "switch-to-scheme")))
+(register-definition-prefixes "cmuscheme" '("cmuscheme-load-hook" "inferior-scheme-" "scheme-" "switch-to-scheme"))
;;;***
@@ -5091,7 +5175,7 @@ If FRAME cannot display COLOR, return nil.
\(fn COLOR &optional FRAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "color" '("color-")))
+(register-definition-prefixes "color" '("color-"))
;;;***
@@ -5199,7 +5283,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use.
\(fn PROCESS COMMAND REGEXP REGEXP-GROUP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "comint" '("comint-")))
+(register-definition-prefixes "comint" '("comint-"))
;;;***
@@ -5237,14 +5321,14 @@ on third call it again advances points to the next difference and so on.
\(fn IGNORE-WHITESPACE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "compare-w" '("compare-")))
+(register-definition-prefixes "compare-w" '("compare-"))
;;;***
;;;### (autoloads nil "compface" "image/compface.el" (0 0 0 0))
;;; Generated autoloads from image/compface.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "compface" '("uncompface")))
+(register-definition-prefixes "compface" '("uncompface"))
;;;***
@@ -5401,6 +5485,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When Compilation Shell minor mode is enabled, all the
error-parsing commands of the Compilation major mode are
available but bound to keys that don't collide with Shell mode.
@@ -5416,6 +5503,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When Compilation minor mode is enabled, all the error-parsing
commands of Compilation major mode are available. See
`compilation-mode'.
@@ -5428,7 +5518,7 @@ This is the value of `next-error-function' in Compilation buffers.
\(fn N &optional RESET)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "compile" '("compil" "define-compilation-mode" "kill-compilation" "recompile")))
+(register-definition-prefixes "compile" '("compil" "define-compilation-mode" "kill-compilation" "recompile"))
;;;***
@@ -5453,9 +5543,12 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "completion" '("*c-def-regexp*" "*lisp-def-regexp*" "accept-completion" "add-" "cdabbrev-" "check-completion-length" "clear-all-completions" "cmpl-" "complet" "current-completion-source" "delete-completion" "enable-completion" "find-" "initialize-completions" "inside-locate-completion-entry" "interactive-completion-string-reader" "kill-" "list-all-completions" "load-completions-from-file" "make-c" "next-cdabbrev" "num-cmpl-sources" "reset-cdabbrev" "save" "set-c" "symbol-" "use-completion-")))
+(register-definition-prefixes "completion" '("*c-def-regexp*" "*lisp-def-regexp*" "accept-completion" "add-" "cdabbrev-" "check-completion-length" "clear-all-completions" "cmpl-" "complet" "current-completion-source" "delete-completion" "enable-completion" "find-" "initialize-completions" "inside-locate-completion-entry" "interactive-completion-string-reader" "kill-" "list-all-completions" "load-completions-from-file" "make-c" "next-cdabbrev" "num-cmpl-sources" "reset-cdabbrev" "save" "set-c" "symbol-" "use-completion-"))
;;;***
@@ -5492,7 +5585,9 @@ doesn't have enough contents to decide, this is identical to
See also `conf-space-mode', `conf-colon-mode', `conf-javaprop-mode',
`conf-ppd-mode' and `conf-xdefaults-mode'.
-\\{conf-mode-map}" t nil)
+\\{conf-mode-map}
+
+\(fn)" t nil)
(autoload 'conf-unix-mode "conf-mode" "\
Conf Mode starter for Unix style Conf files.
@@ -5628,7 +5723,7 @@ For details see `conf-mode'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "conf-mode" '("conf-")))
+(register-definition-prefixes "conf-mode" '("conf-"))
;;;***
@@ -5658,7 +5753,7 @@ and subsequent calls on the same file won't go to disk.
\(fn PHRASE-FILE &optional STARTMSG ENDMSG)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cookie1" '("cookie")))
+(register-definition-prefixes "cookie1" '("cookie"))
;;;***
@@ -5697,7 +5792,7 @@ If FIX is non-nil, run `copyright-fix-years' instead.
\(fn DIRECTORY MATCH &optional FIX)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "copyright" '("copyright-")))
+(register-definition-prefixes "copyright" '("copyright-"))
;;;***
@@ -5855,12 +5950,12 @@ Variables controlling indentation style:
`cperl-min-label-indent'
Minimal indentation for line that is a label.
-Settings for classic indent-styles: K&R BSD=C++ GNU PerlStyle=Whitesmith
- `cperl-indent-level' 5 4 2 4
- `cperl-brace-offset' 0 0 0 0
- `cperl-continued-brace-offset' -5 -4 0 0
- `cperl-label-offset' -5 -4 -2 -4
- `cperl-continued-statement-offset' 5 4 2 4
+Settings for classic indent-styles: K&R BSD=C++ GNU PBP PerlStyle=Whitesmith
+ `cperl-indent-level' 5 4 2 4 4
+ `cperl-brace-offset' 0 0 0 0 0
+ `cperl-continued-brace-offset' -5 -4 0 0 0
+ `cperl-label-offset' -5 -4 -2 -2 -4
+ `cperl-continued-statement-offset' 5 4 2 4 4
CPerl knows several indentation styles, and may bulk set the
corresponding variables. Use \\[cperl-set-style] to do this. Use
@@ -5896,7 +5991,7 @@ Run `perldoc' on WORD.
(autoload 'cperl-perldoc-at-point "cperl-mode" "\
Run a `perldoc' on the word around point." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cperl-mode" '("cperl-" "pod2man-program")))
+(register-definition-prefixes "cperl-mode" '("cperl-" "pod2man-program"))
;;;***
@@ -5914,7 +6009,7 @@ A prefix arg suppresses display of that buffer.
(autoload 'cpp-parse-edit "cpp" "\
Edit display information for cpp conditionals." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cpp" '("cpp-")))
+(register-definition-prefixes "cpp" '("cpp-"))
;;;***
@@ -5942,7 +6037,7 @@ with empty strings removed.
\(fn PROMPT TABLE &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF INHERIT-INPUT-METHOD)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "crm" '("crm-")))
+(register-definition-prefixes "crm" '("crm-"))
;;;***
@@ -5987,7 +6082,7 @@ on what is seen near point.
\(fn SYMBOL)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "css-mode" '("css-" "scss-")))
+(register-definition-prefixes "css-mode" '("css-" "scss-"))
;;;***
@@ -6012,6 +6107,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
CUA mode is a global minor mode. When enabled, typed text
replaces the active selection, and you can use C-z, C-x, C-c, and
C-v to undo, cut, copy, and paste in addition to the normal Emacs
@@ -6037,14 +6135,14 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings.
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cua-base" '("cua-")))
+(register-definition-prefixes "cua-base" '("cua-"))
;;;***
;;;### (autoloads nil "cua-gmrk" "emulation/cua-gmrk.el" (0 0 0 0))
;;; Generated autoloads from emulation/cua-gmrk.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cua-gmrk" '("cua-")))
+(register-definition-prefixes "cua-gmrk" '("cua-"))
;;;***
@@ -6060,9 +6158,12 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cua-rect" '("cua-")))
+(register-definition-prefixes "cua-rect" '("cua-"))
;;;***
@@ -6083,6 +6184,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
(autoload 'cursor-sensor-mode "cursor-sensor" "\
@@ -6098,16 +6202,19 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cursor-sensor" '("cursor-sensor-")))
+(register-definition-prefixes "cursor-sensor" '("cursor-sensor-"))
;;;***
;;;### (autoloads nil "cus-dep" "cus-dep.el" (0 0 0 0))
;;; Generated autoloads from cus-dep.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cus-dep" '("custom-" "generated-custom-dependencies-file")))
+(register-definition-prefixes "cus-dep" '("custom-" "generated-custom-dependencies-file"))
;;;***
@@ -6416,7 +6523,7 @@ The format is suitable for use with `easy-menu-define'.
\(fn SYMBOL &optional NAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cus-edit" '("Custom-" "custom" "widget-")))
+(register-definition-prefixes "cus-edit" '("Custom-" "custom" "widget-"))
;;;***
@@ -6451,7 +6558,7 @@ omitted, a buffer named *Custom Themes* is used.
\(fn &optional BUFFER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cus-theme" '("custom-" "describe-theme-1")))
+(register-definition-prefixes "cus-theme" '("custom-" "describe-theme-1"))
;;;***
@@ -6463,13 +6570,12 @@ Mode used for cvs status output.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cvs-status" '("cvs-")))
+(register-definition-prefixes "cvs-status" '("cvs-"))
;;;***
;;;### (autoloads nil "cwarn" "progmodes/cwarn.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cwarn.el
-(push (purecopy '(cwarn 1 3 1)) package--builtin-versions)
(autoload 'cwarn-mode "cwarn" "\
Minor mode that highlights suspicious C and C++ constructions.
@@ -6479,6 +6585,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Suspicious constructs are highlighted using `font-lock-warning-face'.
Note, in addition to enabling this minor mode, the major mode must
@@ -6513,7 +6622,7 @@ See `cwarn-mode' for more information on Cwarn mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cwarn" '("cwarn-" "turn-on-cwarn-mode-if-enabled")))
+(register-definition-prefixes "cwarn" '("cwarn-" "turn-on-cwarn-mode-if-enabled"))
;;;***
@@ -6532,7 +6641,7 @@ Return ALTERNATIVNYJ external character code of CHAR if appropriate.
\(fn CHAR)" nil nil)
(autoload 'standard-display-cyrillic-translit "cyril-util" "\
-Display a cyrillic buffer using a transliteration.
+Display a Cyrillic buffer using a transliteration.
For readability, the table is slightly
different from the one used for the input method `cyrillic-translit'.
@@ -6544,7 +6653,7 @@ If the argument is nil, we return the display table to its standard state.
\(fn &optional CYRILLIC-LANGUAGE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cyril-util" '("cyrillic-language-alist")))
+(register-definition-prefixes "cyril-util" '("cyrillic-language-alist"))
;;;***
@@ -6595,7 +6704,7 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion].
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dabbrev" '("dabbrev-")))
+(register-definition-prefixes "dabbrev" '("dabbrev-"))
;;;***
@@ -6607,7 +6716,7 @@ Create a new data-debug buffer with NAME.
\(fn NAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "data-debug" '("data-debug-" "dd-propertize")))
+(register-definition-prefixes "data-debug" '("data-debug-"))
;;;***
@@ -6617,12 +6726,12 @@ Create a new data-debug buffer with NAME.
(autoload 'dbus-handle-event "dbus" "\
Handle events from the D-Bus.
EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being
-part of the event, is called with arguments ARGS.
+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.
\(fn EVENT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dbus" '("dbus-")))
+(register-definition-prefixes "dbus" '("dbus-"))
;;;***
@@ -6750,7 +6859,7 @@ There is some minimal font-lock support (see vars
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dcl-mode" '("dcl-")))
+(register-definition-prefixes "dcl-mode" '("dcl-"))
;;;***
@@ -6830,7 +6939,7 @@ To specify a nil argument interactively, exit with an empty minibuffer.
(defalias 'cancel-debug-watch #'cancel-debug-on-variable-change)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "debug" '("debug" "inhibit-debug-on-entry")))
+(register-definition-prefixes "debug" '("debug" "inhibit-debug-on-entry"))
;;;***
@@ -6856,7 +6965,7 @@ The most useful commands are:
\\[decipher-make-checkpoint] Save the current cipher alphabet (checkpoint)
\\[decipher-restore-checkpoint] Restore a saved cipher alphabet (checkpoint)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "decipher" '("decipher-")))
+(register-definition-prefixes "decipher" '("decipher-"))
;;;***
@@ -6901,7 +7010,7 @@ START and END delimit the corners of the text rectangle.
\(fn START END)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "delim-col" '("delimit-columns-")))
+(register-definition-prefixes "delim-col" '("delimit-columns-"))
;;;***
@@ -6928,6 +7037,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When Delete Selection mode is enabled, typed text replaces the selection
if the selection is active. Otherwise, typed text is just inserted at
point regardless of any selection.
@@ -6937,7 +7049,7 @@ information on adapting behavior of commands in Delete Selection mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "delsel" '("del" "minibuffer-keyboard-quit")))
+(register-definition-prefixes "delsel" '("del" "minibuffer-keyboard-quit"))
;;;***
@@ -7012,7 +7124,7 @@ the first time the mode is used.
\(fn MODE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "derived" '("derived-mode-")))
+(register-definition-prefixes "derived" '("derived-mode-"))
;;;***
@@ -7067,10 +7179,12 @@ Otherwise return a description formatted by
of `eldoc-echo-area-use-multiline-p' variable and width of
minibuffer window for width limit.
-This function is meant to be used as a value of
-`eldoc-documentation-function' variable." nil nil)
+This function can be used as a value of
+`eldoc-documentation-functions' variable.
+
+\(fn CALLBACK &rest _)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "descr-text" '("describe-")))
+(register-definition-prefixes "descr-text" '("describe-"))
;;;***
@@ -7095,6 +7209,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When Desktop Save mode is enabled, the state of Emacs is saved from
one session to another. In particular, Emacs will save the desktop when
it exits (this may prompt you; see the option `desktop-save'). The next
@@ -7296,7 +7413,7 @@ Save the desktop in directory `desktop-dirname'." t nil)
(autoload 'desktop-revert "desktop" "\
Revert to the last loaded desktop." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "desktop" '("desktop-")))
+(register-definition-prefixes "desktop" '("desktop-"))
;;;***
@@ -7329,14 +7446,14 @@ article buffer.
(autoload 'gnus-article-outlook-deuglify-article "deuglify" "\
Deuglify broken Outlook (Express) articles and redisplay." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "deuglify" '("gnus-")))
+(register-definition-prefixes "deuglify" '("gnus-"))
;;;***
;;;### (autoloads nil "dframe" "dframe.el" (0 0 0 0))
;;; Generated autoloads from dframe.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dframe" '("dframe-")))
+(register-definition-prefixes "dframe" '("dframe-"))
;;;***
@@ -7381,7 +7498,7 @@ Major mode for editing the diary file.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "diary-lib" '("calendar-mark-" "diary-")))
+(register-definition-prefixes "diary-lib" '("calendar-mark-" "diary-"))
;;;***
@@ -7456,7 +7573,7 @@ OLD and NEW may each be a buffer or a buffer name.
\(fn OLD NEW &optional SWITCHES NO-ASYNC)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "diff" '("diff-")))
+(register-definition-prefixes "diff" '("diff-"))
;;;***
@@ -7488,11 +7605,14 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\\{diff-minor-mode-map}
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "diff-mode" '("diff-")))
+(register-definition-prefixes "diff-mode" '("diff-"))
;;;***
@@ -7505,7 +7625,7 @@ Optional arguments are passed to `dig-invoke'.
\(fn DOMAIN &optional QUERY-TYPE QUERY-CLASS QUERY-OPTION DIG-OPTION SERVER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dig" '("dig-" "query-dig")))
+(register-definition-prefixes "dig" '("dig-" "query-dig"))
;;;***
@@ -7635,7 +7755,6 @@ Hooks (use \\[describe-variable] to see their documentation):
`dired-before-readin-hook'
`dired-after-readin-hook'
`dired-mode-hook'
- `dired-load-hook'
Keybindings:
\\{dired-mode-map}
@@ -7643,7 +7762,24 @@ Keybindings:
\(fn &optional DIRNAME SWITCHES)" nil nil)
(put 'dired-find-alternate-file 'disabled t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dired" '("dired-")))
+(autoload 'dired-jump "dired" "\
+Jump to Dired buffer corresponding to current buffer.
+If in a file, Dired the current directory and move to file's line.
+If in Dired already, pop up a level and goto old directory's line.
+In case the proper Dired file line cannot be found, refresh the dired
+buffer and try again.
+When OTHER-WINDOW is non-nil, jump to Dired buffer in other window.
+When FILE-NAME is non-nil, jump to its line in Dired.
+Interactively with prefix argument, read FILE-NAME.
+
+\(fn &optional OTHER-WINDOW FILE-NAME)" t nil)
+
+(autoload 'dired-jump-other-window "dired" "\
+Like \\[dired-jump] (`dired-jump') but in other window.
+
+\(fn &optional FILE-NAME)" t nil)
+
+(register-definition-prefixes "dired" '("dired-"))
;;;***
@@ -7651,7 +7787,7 @@ Keybindings:
;;;;;; (0 0 0 0))
;;; Generated autoloads from dired-aux.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dired-aux" '("dired-" "minibuffer-default-add-dired-shell-commands")))
+(register-definition-prefixes "dired-aux" '("dired-" "minibuffer-default-add-dired-shell-commands"))
;;;***
@@ -7659,7 +7795,7 @@ Keybindings:
;;;;;; (0 0 0 0))
;;; Generated autoloads from dired-x.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dired-x" '("dired-" "virtual-dired")))
+(register-definition-prefixes "dired-x" '("dired-" "virtual-dired"))
;;;***
@@ -7674,6 +7810,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
This method requires that your shell prompt contain the current
working directory at all times, and that you set the variable
`dirtrack-list' to match the prompt.
@@ -7693,7 +7832,7 @@ from `default-directory'.
\(fn INPUT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dirtrack" '("dirtrack-")))
+(register-definition-prefixes "dirtrack" '("dirtrack-"))
;;;***
@@ -7709,7 +7848,7 @@ redefine OBJECT if it is a symbol.
\(fn OBJECT &optional BUFFER INDENT INTERACTIVE-P)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "disass" '("disassemble-")))
+(register-definition-prefixes "disass" '("disassemble-"))
;;;***
@@ -7828,7 +7967,7 @@ in `.emacs'.
\(fn ARG)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "disp-table" '("display-table-print-array")))
+(register-definition-prefixes "disp-table" '("display-table-print-array"))
;;;***
@@ -7845,6 +7984,9 @@ ARG is positive, and disable it if ARG is zero or negative. If called
from Lisp, also enable the mode if ARG is omitted or nil, and toggle
it if ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
To change the position of the column displayed by default
customize `display-fill-column-indicator-column'. You can change the
character for the indicator setting `display-fill-column-indicator-character'.
@@ -7876,7 +8018,7 @@ See `display-fill-column-indicator-mode' for more information on Display-Fill-Co
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "display-fill-column-indicator" '("display-fill-column-indicator--turn-on")))
+(register-definition-prefixes "display-fill-column-indicator" '("display-fill-column-indicator--turn-on"))
;;;***
@@ -7893,6 +8035,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
To change the type of line numbers displayed by default,
customize `display-line-numbers-type'. To change the type while
the mode is on, set `display-line-numbers' directly.
@@ -7923,7 +8068,7 @@ See `display-line-numbers-mode' for more information on Display-Line-Numbers mod
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "display-line-numbers" '("display-line-numbers-")))
+(register-definition-prefixes "display-line-numbers" '("display-line-numbers-"))
;;;***
@@ -7961,14 +8106,14 @@ if some action was made, or nil if the URL is ignored.")
(custom-autoload 'dnd-protocol-alist "dnd" t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dnd" '("dnd-")))
+(register-definition-prefixes "dnd" '("dnd-"))
;;;***
;;;### (autoloads nil "dns" "net/dns.el" (0 0 0 0))
;;; Generated autoloads from net/dns.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dns" '("dns-")))
+(register-definition-prefixes "dns" '("dns-"))
;;;***
@@ -7991,7 +8136,7 @@ Turning on DNS mode runs `dns-mode-hook'.
(autoload 'dns-mode-soa-increment-serial "dns-mode" "\
Locate SOA record and increment the serial field." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dns-mode" '("dns-mode-")))
+(register-definition-prefixes "dns-mode" '("dns-mode-"))
;;;***
@@ -8028,6 +8173,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
See the command `doc-view-mode' for more information on this mode.
\(fn &optional ARG)" t nil)
@@ -8037,7 +8185,7 @@ See the command `doc-view-mode' for more information on this mode.
\(fn BMK)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "doc-view" '("doc-view-")))
+(register-definition-prefixes "doc-view" '("doc-view-"))
;;;***
@@ -8047,35 +8195,35 @@ See the command `doc-view-mode' for more information on this mode.
(autoload 'doctor "doctor" "\
Switch to *doctor* buffer and start giving psychotherapy." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "doctor" '("doc" "make-doctor-variables")))
+(register-definition-prefixes "doctor" '("doc" "make-doctor-variables"))
;;;***
;;;### (autoloads nil "dom" "dom.el" (0 0 0 0))
;;; Generated autoloads from dom.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dom" '("dom-")))
+(register-definition-prefixes "dom" '("dom-"))
;;;***
;;;### (autoloads nil "dos-fns" "dos-fns.el" (0 0 0 0))
;;; Generated autoloads from dos-fns.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dos-fns" '("dos")))
+(register-definition-prefixes "dos-fns" '("dos"))
;;;***
;;;### (autoloads nil "dos-vars" "dos-vars.el" (0 0 0 0))
;;; Generated autoloads from dos-vars.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dos-vars" '("dos-codepage-setup-hook" "msdos-shells")))
+(register-definition-prefixes "dos-vars" '("dos-codepage-setup-hook" "msdos-shells"))
;;;***
;;;### (autoloads nil "dos-w32" "dos-w32.el" (0 0 0 0))
;;; Generated autoloads from dos-w32.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dos-w32" '("file-name-buffer-file-type-alist" "find-" "w32-")))
+(register-definition-prefixes "dos-w32" '("file-name-buffer-file-type-alist" "find-" "w32-"))
;;;***
@@ -8090,12 +8238,15 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When Double mode is enabled, some keys will insert different
strings when pressed twice. See `double-map' for details.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "double" '("double-")))
+(register-definition-prefixes "double" '("double-"))
;;;***
@@ -8106,7 +8257,7 @@ strings when pressed twice. See `double-map' for details.
(autoload 'dunnet "dunnet" "\
Switch to *dungeon* buffer and start game." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dunnet" '("dun" "obj-special")))
+(register-definition-prefixes "dunnet" '("dun" "obj-special"))
;;;***
@@ -8114,7 +8265,7 @@ Switch to *dungeon* buffer and start game." t nil)
;;;;;; 0 0))
;;; Generated autoloads from dynamic-setting.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dynamic-setting" '("dynamic-setting-handle-config-changed-event" "font-setting-change-default-font")))
+(register-definition-prefixes "dynamic-setting" '("dynamic-setting-handle-config-changed-event" "font-setting-change-default-font"))
;;;***
@@ -8166,9 +8317,6 @@ BODY contains code to execute each time the mode is enabled or disabled.
the minor mode is global):
:group GROUP Custom group name to use in all generated `defcustom' forms.
- Defaults to MODE without the possible trailing \"-mode\".
- Don't use this default group name unless you have written a
- `defgroup' to define that group properly.
: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.
@@ -8269,7 +8417,7 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX).
(function-put 'easy-mmode-defsyntax 'lisp-indent-function '1)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "easy-mmode" '("easy-mmode-")))
+(register-definition-prefixes "easy-mmode" '("easy-mmode-"))
;;;***
@@ -8421,56 +8569,56 @@ To implement dynamic menus, either call this from
\(fn PATH NAME ITEMS &optional BEFORE MAP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "easymenu" '("add-submenu" "easy-menu-")))
+(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
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-abn" '("ebnf-abn-")))
+(register-definition-prefixes "ebnf-abn" '("ebnf-abn-"))
;;;***
;;;### (autoloads nil "ebnf-bnf" "progmodes/ebnf-bnf.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-bnf.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-bnf" '("ebnf-")))
+(register-definition-prefixes "ebnf-bnf" '("ebnf-"))
;;;***
;;;### (autoloads nil "ebnf-dtd" "progmodes/ebnf-dtd.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-dtd.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-dtd" '("ebnf-dtd-")))
+(register-definition-prefixes "ebnf-dtd" '("ebnf-dtd-"))
;;;***
;;;### (autoloads nil "ebnf-ebx" "progmodes/ebnf-ebx.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-ebx.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-ebx" '("ebnf-ebx-")))
+(register-definition-prefixes "ebnf-ebx" '("ebnf-ebx-"))
;;;***
;;;### (autoloads nil "ebnf-iso" "progmodes/ebnf-iso.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-iso.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-iso" '("ebnf-")))
+(register-definition-prefixes "ebnf-iso" '("ebnf-"))
;;;***
;;;### (autoloads nil "ebnf-otz" "progmodes/ebnf-otz.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-otz.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-otz" '("ebnf-")))
+(register-definition-prefixes "ebnf-otz" '("ebnf-"))
;;;***
;;;### (autoloads nil "ebnf-yac" "progmodes/ebnf-yac.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-yac.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-yac" '("ebnf-yac-")))
+(register-definition-prefixes "ebnf-yac" '("ebnf-yac-"))
;;;***
@@ -8725,7 +8873,7 @@ See also `ebnf-push-style'.
See `ebnf-style-database' documentation." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf2ps" '("ebnf-")))
+(register-definition-prefixes "ebnf2ps" '("ebnf-"))
;;;***
@@ -8847,7 +8995,7 @@ Otherwise, FILE-NAME specifies the file to save the tree in.
(autoload 'ebrowse-statistics "ebrowse" "\
Display statistics for a class tree." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebrowse" '("ebrowse-" "electric-buffer-menu-mode-hook")))
+(register-definition-prefixes "ebrowse" '("ebrowse-" "electric-buffer-menu-mode-hook"))
;;;***
@@ -8882,7 +9030,7 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry.
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebuff-menu" '("Electric-buffer-menu-" "electric-buffer-")))
+(register-definition-prefixes "ebuff-menu" '("Electric-buffer-menu-" "electric-buffer-"))
;;;***
@@ -8895,7 +9043,7 @@ With prefix arg NOCONFIRM, execute current line as-is without editing.
\(fn &optional NOCONFIRM)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "echistory" '("Electric-history-" "electric-")))
+(register-definition-prefixes "echistory" '("Electric-history-" "electric-"))
;;;***
@@ -8905,7 +9053,7 @@ With prefix arg NOCONFIRM, execute current line as-is without editing.
(autoload 'ecomplete-setup "ecomplete" "\
Read the .ecompleterc file." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ecomplete" '("ecomplete-")))
+(register-definition-prefixes "ecomplete" '("ecomplete-"))
;;;***
@@ -8931,19 +9079,22 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
This global minor mode enables `ede-minor-mode' in all buffers in
an EDE controlled project.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede" '("ede" "global-ede-mode-map" "project-try-ede")))
+(register-definition-prefixes "ede" '("ede" "global-ede-mode-map" "project-try-ede"))
;;;***
;;;### (autoloads nil "ede/auto" "cedet/ede/auto.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/auto.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/auto" '("ede-")))
+(register-definition-prefixes "ede/auto" '("ede-"))
;;;***
@@ -8951,7 +9102,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/autoconf-edit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/autoconf-edit" '("autoconf-")))
+(register-definition-prefixes "ede/autoconf-edit" '("autoconf-"))
;;;***
@@ -8959,7 +9110,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/base.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/base" '("ede-")))
+(register-definition-prefixes "ede/base" '("ede-"))
;;;***
@@ -8967,7 +9118,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/config.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/config" '("ede-")))
+(register-definition-prefixes "ede/config" '("ede-"))
;;;***
@@ -8975,7 +9126,7 @@ an EDE controlled project.
;;;;;; "cedet/ede/cpp-root.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/cpp-root.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/cpp-root" '("ede-c")))
+(register-definition-prefixes "ede/cpp-root" '("ede-cpp-root-"))
;;;***
@@ -8983,14 +9134,14 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/custom.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/custom" '("ede-" "eieio-ede-old-variables")))
+(register-definition-prefixes "ede/custom" '("ede-" "eieio-ede-old-variables"))
;;;***
;;;### (autoloads nil "ede/detect" "cedet/ede/detect.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/detect.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/detect" '("ede-")))
+(register-definition-prefixes "ede/detect" '("ede-"))
;;;***
@@ -8998,7 +9149,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/dired.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/dired" '("ede-dired-")))
+(register-definition-prefixes "ede/dired" '("ede-dired-"))
;;;***
@@ -9006,7 +9157,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/emacs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/emacs" '("ede-emacs-")))
+(register-definition-prefixes "ede/emacs" '("ede-emacs-"))
;;;***
@@ -9014,7 +9165,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/files.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/files" '("ede-")))
+(register-definition-prefixes "ede/files" '("ede-"))
;;;***
@@ -9022,7 +9173,7 @@ an EDE controlled project.
;;;;;; "cedet/ede/generic.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/generic.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/generic" '("ede-generic-")))
+(register-definition-prefixes "ede/generic" '("ede-generic-"))
;;;***
@@ -9030,7 +9181,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/linux.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/linux" '("ede-linux-" "project-linux-")))
+(register-definition-prefixes "ede/linux" '("ede-linux-" "project-linux-"))
;;;***
@@ -9038,7 +9189,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/locate.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/locate" '("ede-locate-")))
+(register-definition-prefixes "ede/locate" '("ede-locate-"))
;;;***
@@ -9046,7 +9197,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/make.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/make" '("ede-make-")))
+(register-definition-prefixes "ede/make" '("ede-"))
;;;***
@@ -9054,28 +9205,28 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/makefile-edit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/makefile-edit" '("makefile-")))
+(register-definition-prefixes "ede/makefile-edit" '("makefile-"))
;;;***
;;;### (autoloads nil "ede/pconf" "cedet/ede/pconf.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/pconf.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/pconf" '("ede-pconf-create-file-query")))
+(register-definition-prefixes "ede/pconf" '("ede-pconf-create-file-query"))
;;;***
;;;### (autoloads nil "ede/pmake" "cedet/ede/pmake.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/pmake.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/pmake" '("ede-pmake-")))
+(register-definition-prefixes "ede/pmake" '("ede-pmake-"))
;;;***
;;;### (autoloads nil "ede/proj" "cedet/ede/proj.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/proj.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj" '("ede-proj-")))
+(register-definition-prefixes "ede/proj" '("ede-proj-"))
;;;***
@@ -9083,7 +9234,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/proj-archive.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-archive" '("ede-")))
+(register-definition-prefixes "ede/proj-archive" '("ede-"))
;;;***
@@ -9091,7 +9242,7 @@ an EDE controlled project.
;;;;;; 0 0))
;;; Generated autoloads from cedet/ede/proj-aux.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-aux" '("ede-")))
+(register-definition-prefixes "ede/proj-aux" '("ede-"))
;;;***
@@ -9099,7 +9250,7 @@ an EDE controlled project.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/ede/proj-comp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-comp" '("ede-" "proj-comp-insert-variable-once")))
+(register-definition-prefixes "ede/proj-comp" '("ede-" "proj-comp-insert-variable-once"))
;;;***
@@ -9107,7 +9258,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/proj-elisp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-elisp" '("ede-")))
+(register-definition-prefixes "ede/proj-elisp" '("ede-"))
;;;***
@@ -9115,7 +9266,7 @@ an EDE controlled project.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/ede/proj-info.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-info" '("ede-")))
+(register-definition-prefixes "ede/proj-info" '("ede-"))
;;;***
@@ -9123,7 +9274,7 @@ an EDE controlled project.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/ede/proj-misc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-misc" '("ede-")))
+(register-definition-prefixes "ede/proj-misc" '("ede-"))
;;;***
@@ -9131,7 +9282,7 @@ an EDE controlled project.
;;;;;; 0 0))
;;; Generated autoloads from cedet/ede/proj-obj.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-obj" '("ede-")))
+(register-definition-prefixes "ede/proj-obj" '("ede-"))
;;;***
@@ -9139,7 +9290,7 @@ an EDE controlled project.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/ede/proj-prog.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-prog" '("ede-proj-target-makefile-program")))
+(register-definition-prefixes "ede/proj-prog" '("ede-proj-target-makefile-program"))
;;;***
@@ -9147,7 +9298,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/proj-scheme.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-scheme" '("ede-proj-target-scheme")))
+(register-definition-prefixes "ede/proj-scheme" '("ede-proj-target-scheme"))
;;;***
@@ -9155,7 +9306,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/proj-shared.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-shared" '("ede-")))
+(register-definition-prefixes "ede/proj-shared" '("ede-"))
;;;***
@@ -9163,7 +9314,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/project-am.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/project-am" '("project-am-")))
+(register-definition-prefixes "ede/project-am" '("project-am-"))
;;;***
@@ -9171,21 +9322,21 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/shell.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/shell" '("ede-shell-run-command")))
+(register-definition-prefixes "ede/shell" '("ede-shell-run-command"))
;;;***
;;;### (autoloads nil "ede/simple" "cedet/ede/simple.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/simple.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/simple" '("ede-simple-")))
+(register-definition-prefixes "ede/simple" '("ede-simple-"))
;;;***
;;;### (autoloads nil "ede/source" "cedet/ede/source.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/source.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/source" '("ede-source")))
+(register-definition-prefixes "ede/source" '("ede-source"))
;;;***
@@ -9193,7 +9344,7 @@ an EDE controlled project.
;;;;;; "cedet/ede/speedbar.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/speedbar.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/speedbar" '("ede-")))
+(register-definition-prefixes "ede/speedbar" '("ede-"))
;;;***
@@ -9201,7 +9352,7 @@ an EDE controlled project.
;;;;;; 0))
;;; Generated autoloads from cedet/ede/srecode.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/srecode" '("ede-srecode-")))
+(register-definition-prefixes "ede/srecode" '("ede-srecode-"))
;;;***
@@ -9209,7 +9360,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/util" '("ede-make-buffer-writable")))
+(register-definition-prefixes "ede/util" '("ede-make-buffer-writable"))
;;;***
@@ -9269,7 +9420,7 @@ Toggle edebugging of all definitions." t nil)
(autoload 'edebug-all-forms "edebug" "\
Toggle edebugging of all forms." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edebug" '("cancel-edebug-on-entry" "edebug" "get-edebug-spec" "global-edebug-")))
+(register-definition-prefixes "edebug" '("cancel-edebug-on-entry" "edebug" "get-edebug-spec" "global-edebug-"))
;;;***
@@ -9592,14 +9743,14 @@ Call `ediff-merge-directories' with the next three command line arguments." nil
(autoload 'ediff-merge-directories-with-ancestor-command "ediff" "\
Call `ediff-merge-directories-with-ancestor' with the next four command line arguments." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff" '("ediff-")))
+(register-definition-prefixes "ediff" '("ediff-"))
;;;***
;;;### (autoloads nil "ediff-diff" "vc/ediff-diff.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-diff.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-diff" '("ediff-")))
+(register-definition-prefixes "ediff-diff" '("ediff-"))
;;;***
@@ -9608,21 +9759,21 @@ Call `ediff-merge-directories-with-ancestor' with the next four command line arg
(autoload 'ediff-customize "ediff-help" nil t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-help" '("ediff-")))
+(register-definition-prefixes "ediff-help" '("ediff-"))
;;;***
;;;### (autoloads nil "ediff-init" "vc/ediff-init.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-init.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-init" '("ediff-" "stipple-pixmap")))
+(register-definition-prefixes "ediff-init" '("ediff-" "stipple-pixmap"))
;;;***
;;;### (autoloads nil "ediff-merg" "vc/ediff-merg.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-merg.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-merg" '("ediff-")))
+(register-definition-prefixes "ediff-merg" '("ediff-"))
;;;***
@@ -9634,14 +9785,14 @@ Display Ediff's registry." t nil)
(defalias 'eregistry 'ediff-show-registry)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-mult" '("ediff-")))
+(register-definition-prefixes "ediff-mult" '("ediff-"))
;;;***
;;;### (autoloads nil "ediff-ptch" "vc/ediff-ptch.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-ptch.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-ptch" '("ediff-")))
+(register-definition-prefixes "ediff-ptch" '("ediff-"))
;;;***
@@ -9658,21 +9809,21 @@ Enable or disable Ediff toolbar.
Works only in versions of Emacs that support toolbars.
To change the default, set the variable `ediff-use-toolbar-p', which see." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-util" '("ediff-")))
+(register-definition-prefixes "ediff-util" '("ediff-"))
;;;***
;;;### (autoloads nil "ediff-vers" "vc/ediff-vers.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-vers.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-vers" '("ediff-" "rcs-ediff-view-revision")))
+(register-definition-prefixes "ediff-vers" '("ediff-" "rcs-ediff-view-revision"))
;;;***
;;;### (autoloads nil "ediff-wind" "vc/ediff-wind.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-wind.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-wind" '("ediff-")))
+(register-definition-prefixes "ediff-wind" '("ediff-"))
;;;***
@@ -9724,7 +9875,7 @@ or nil, use a compact 80-column format.
\(fn &optional MACRO VERBOSE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edmacro" '("edmacro-")))
+(register-definition-prefixes "edmacro" '("edmacro-"))
;;;***
@@ -9741,7 +9892,7 @@ Argument BOTTOM is the bottom margin in number of lines or percent of window.
(autoload 'edt-emulation-on "edt" "\
Turn on EDT Emulation." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt" '("edt-")))
+(register-definition-prefixes "edt" '("edt-"))
;;;***
@@ -9749,7 +9900,7 @@ Turn on EDT Emulation." t nil)
;;;;;; 0))
;;; Generated autoloads from emulation/edt-lk201.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt-lk201" '("*EDT-keys*")))
+(register-definition-prefixes "edt-lk201" '("*EDT-keys*"))
;;;***
@@ -9757,14 +9908,14 @@ Turn on EDT Emulation." t nil)
;;;;;; 0 0))
;;; Generated autoloads from emulation/edt-mapper.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt-mapper" '("edt-")))
+(register-definition-prefixes "edt-mapper" '("edt-"))
;;;***
;;;### (autoloads nil "edt-pc" "emulation/edt-pc.el" (0 0 0 0))
;;; Generated autoloads from emulation/edt-pc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt-pc" '("*EDT-keys*")))
+(register-definition-prefixes "edt-pc" '("*EDT-keys*"))
;;;***
@@ -9772,7 +9923,7 @@ Turn on EDT Emulation." t nil)
;;;;;; 0))
;;; Generated autoloads from emulation/edt-vt100.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt-vt100" '("edt-set-term-width-")))
+(register-definition-prefixes "edt-vt100" '("edt-set-term-width-"))
;;;***
@@ -9810,7 +9961,7 @@ BUFFER is put back into its original major mode.
\(fn FUN &optional NAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ehelp" '("ehelp-" "electric-")))
+(register-definition-prefixes "ehelp" '("ehelp-" "electric-"))
;;;***
@@ -9818,7 +9969,7 @@ BUFFER is put back into its original major mode.
;;; Generated autoloads from emacs-lisp/eieio.el
(push (purecopy '(eieio 1 4)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio" '("child-of-class-p" "defclass" "eieio-" "find-class" "obj" "oref" "oset" "same-class-p" "set-slot-value" "slot-" "with-slots")))
+(register-definition-prefixes "eieio" '("child-of-class-p" "defclass" "eieio-" "find-class" "obj" "oref" "oset" "same-class-p" "set-slot-value" "slot-" "with-slots"))
;;;***
@@ -9826,7 +9977,7 @@ BUFFER is put back into its original major mode.
;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/eieio-base.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-base" '("eieio-")))
+(register-definition-prefixes "eieio-base" '("eieio-"))
;;;***
@@ -9834,7 +9985,7 @@ BUFFER is put back into its original major mode.
;;;;;; "emacs-lisp/eieio-compat.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/eieio-compat.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-compat" '("eieio--generic-static-symbol-specializers" "generic-p" "next-method-p" "no-")))
+(register-definition-prefixes "eieio-compat" '("eieio--generic-static-symbol-specializers" "generic-p" "next-method-p" "no-"))
;;;***
@@ -9853,7 +10004,7 @@ It creates an autoload function for CNAME's constructor.
\(fn CNAME SUPERCLASSES FILENAME DOC)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-core" '("class-" "eieio-" "inconsistent-class-hierarchy" "invalid-slot-" "unbound-slot")))
+(register-definition-prefixes "eieio-core" '("class-" "eieio-" "inconsistent-class-hierarchy" "invalid-slot-" "unbound-slot"))
;;;***
@@ -9861,7 +10012,7 @@ It creates an autoload function for CNAME's constructor.
;;;;;; "emacs-lisp/eieio-custom.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/eieio-custom.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-custom" '("eieio-")))
+(register-definition-prefixes "eieio-custom" '("eieio-"))
;;;***
@@ -9869,7 +10020,7 @@ It creates an autoload function for CNAME's constructor.
;;;;;; (0 0 0 0))
;;; Generated autoloads from emacs-lisp/eieio-datadebug.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-datadebug" '("data-debug-insert-object-")))
+(register-definition-prefixes "eieio-datadebug" '("data-debug-insert-object-"))
;;;***
@@ -9877,7 +10028,7 @@ It creates an autoload function for CNAME's constructor.
;;;;;; (0 0 0 0))
;;; Generated autoloads from emacs-lisp/eieio-opt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-opt" '("eieio-")))
+(register-definition-prefixes "eieio-opt" '("eieio-"))
;;;***
@@ -9885,7 +10036,13 @@ It creates an autoload function for CNAME's constructor.
;;;;;; (0 0 0 0))
;;; Generated autoloads from emacs-lisp/eieio-speedbar.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-speedbar" '("eieio-speedbar")))
+(register-definition-prefixes "eieio-speedbar" '("eieio-speedbar"))
+
+;;;***
+
+;;;### (autoloads nil "eldoc" "emacs-lisp/eldoc.el" (0 0 0 0))
+;;; Generated autoloads from emacs-lisp/eldoc.el
+(push (purecopy '(eldoc 1 10 0)) package--builtin-versions)
;;;***
@@ -9910,6 +10067,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Electric Pair mode is a global minor mode. When enabled, typing
an open parenthesis automatically inserts the corresponding
closing parenthesis, and vice versa. (Likewise for brackets, etc.).
@@ -9928,9 +10088,12 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elec-pair" '("electric-pair-")))
+(register-definition-prefixes "elec-pair" '("electric-pair-"))
;;;***
@@ -9947,7 +10110,7 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elide-head" '("elide-head-")))
+(register-definition-prefixes "elide-head" '("elide-head-"))
;;;***
@@ -9980,7 +10143,7 @@ optional prefix argument REINIT is non-nil.
\(fn &optional REINIT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elint" '("elint-")))
+(register-definition-prefixes "elint" '("elint-"))
;;;***
@@ -10015,7 +10178,7 @@ If `elp-reset-after-results' is non-nil, then current profiling
information for all instrumented functions is reset after results are
displayed." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elp" '("elp-")))
+(register-definition-prefixes "elp" '("elp-"))
;;;***
@@ -10023,7 +10186,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-alias.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-alias" '("eshell" "pcomplete/eshell-mode/alias")))
+(register-definition-prefixes "em-alias" '("eshell" "pcomplete/eshell-mode/alias"))
;;;***
@@ -10031,7 +10194,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-banner.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-banner" '("eshell-banner-")))
+(register-definition-prefixes "em-banner" '("eshell-banner-"))
;;;***
@@ -10039,7 +10202,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-basic.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-basic" '("eshell")))
+(register-definition-prefixes "em-basic" '("eshell"))
;;;***
@@ -10047,7 +10210,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-cmpl.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-cmpl" '("eshell-")))
+(register-definition-prefixes "em-cmpl" '("eshell-"))
;;;***
@@ -10055,7 +10218,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-dirs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-dirs" '("eshell")))
+(register-definition-prefixes "em-dirs" '("eshell"))
;;;***
@@ -10063,7 +10226,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-glob.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-glob" '("eshell-")))
+(register-definition-prefixes "em-glob" '("eshell-"))
;;;***
@@ -10071,7 +10234,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-hist.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-hist" '("eshell")))
+(register-definition-prefixes "em-hist" '("eshell"))
;;;***
@@ -10079,7 +10242,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-ls.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-ls" '("eshell")))
+(register-definition-prefixes "em-ls" '("eshell"))
;;;***
@@ -10087,7 +10250,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-pred.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-pred" '("eshell-")))
+(register-definition-prefixes "em-pred" '("eshell-"))
;;;***
@@ -10095,7 +10258,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-prompt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-prompt" '("eshell-")))
+(register-definition-prefixes "em-prompt" '("eshell-"))
;;;***
@@ -10103,7 +10266,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-rebind.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-rebind" '("eshell-")))
+(register-definition-prefixes "em-rebind" '("eshell-"))
;;;***
@@ -10111,7 +10274,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-script.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-script" '("eshell")))
+(register-definition-prefixes "em-script" '("eshell"))
;;;***
@@ -10119,7 +10282,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-smart.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-smart" '("eshell-")))
+(register-definition-prefixes "em-smart" '("eshell-"))
;;;***
@@ -10127,7 +10290,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-term.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-term" '("eshell-")))
+(register-definition-prefixes "em-term" '("eshell-"))
;;;***
@@ -10135,7 +10298,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-tramp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-tramp" '("eshell")))
+(register-definition-prefixes "em-tramp" '("eshell"))
;;;***
@@ -10143,7 +10306,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-unix.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-unix" '("eshell" "nil-blank-string" "pcomplete/")))
+(register-definition-prefixes "em-unix" '("eshell" "nil-blank-string"))
;;;***
@@ -10151,7 +10314,7 @@ displayed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from eshell/em-xtra.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-xtra" '("eshell/" "pcomplete/bcc")))
+(register-definition-prefixes "em-xtra" '("eshell/"))
;;;***
@@ -10181,7 +10344,7 @@ some major modes from being locked under some circumstances.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "emacs-lock" '("emacs-lock-" "toggle-emacs-lock")))
+(register-definition-prefixes "emacs-lock" '("emacs-lock-" "toggle-emacs-lock"))
;;;***
@@ -10192,11 +10355,23 @@ some major modes from being locked under some circumstances.
Report a bug in GNU Emacs.
Prompts for bug subject. Leaves you in a mail buffer.
+Already submitted bugs can be found in the Emacs bug tracker:
+
+ https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1
+
\(fn TOPIC &optional UNUSED)" t nil)
(set-advertised-calling-convention 'report-emacs-bug '(topic) '"24.5")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "emacsbug" '("report-emacs-bug-")))
+(autoload 'submit-emacs-patch "emacsbug" "\
+Send an Emacs patch to the Emacs maintainers.
+Interactively, you will be prompted for SUBJECT and a patch FILE
+name (which will be attached to the mail). You will end up in a
+Message buffer where you can explain more about the patch.
+
+\(fn SUBJECT FILE)" t nil)
+
+(register-definition-prefixes "emacsbug" '("emacs-bug--system-description" "report-emacs-bug-"))
;;;***
@@ -10252,7 +10427,7 @@ Emerge two RCS revisions of a file, with another revision as ancestor.
\(fn A-DIR B-DIR ANCESTOR-DIR OUTPUT-DIR)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "emerge" '("emerge-")))
+(register-definition-prefixes "emerge" '("emerge-"))
;;;***
@@ -10269,6 +10444,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Turning the mode on or off runs `enriched-mode-hook'.
More information about Enriched mode is available in the file
@@ -10290,7 +10468,7 @@ Commands:
\(fn FROM TO)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "enriched" '("enriched-")))
+(register-definition-prefixes "enriched" '("enriched-"))
;;;***
@@ -10480,7 +10658,7 @@ Insert selected KEYS after the point.
\(fn KEYS)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epa" '("epa-")))
+(register-definition-prefixes "epa" '("epa-"))
;;;***
@@ -10513,7 +10691,7 @@ Encrypt marked files." t nil)
(autoload 'epa-file-disable "epa-file" nil t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epa-file" '("epa-")))
+(register-definition-prefixes "epa-file" '("epa-"))
;;;***
@@ -10528,6 +10706,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
(autoload 'epa-mail-decrypt "epa-mail" "\
@@ -10592,9 +10773,12 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epa-mail" '("epa-mail-")))
+(register-definition-prefixes "epa-mail" '("epa-mail-"))
;;;***
@@ -10607,7 +10791,7 @@ Return a context object.
\(fn &optional PROTOCOL ARMOR TEXTMODE INCLUDE-CERTS CIPHER-ALGORITHM DIGEST-ALGORITHM COMPRESS-ALGORITHM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epg" '("epg-")))
+(register-definition-prefixes "epg" '("epg-"))
;;;***
@@ -10647,7 +10831,7 @@ Look at CONFIG and try to expand GROUP.
\(fn CONFIG GROUP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epg-config" '("epg-")))
+(register-definition-prefixes "epg-config" '("epg-"))
;;;***
@@ -10696,7 +10880,7 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
\(fn HOST PORT CHANNEL USER PASSWORD)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc" '("define-erc-module" "erc-")))
+(register-definition-prefixes "erc" '("define-erc-module" "erc-"))
;;;***
@@ -10704,14 +10888,14 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;;;; "erc/erc-autoaway.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-autoaway.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-autoaway" '("erc-auto")))
+(register-definition-prefixes "erc-autoaway" '("erc-auto"))
;;;***
;;;### (autoloads nil "erc-backend" "erc/erc-backend.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-backend.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-backend" '("erc-")))
+(register-definition-prefixes "erc-backend" '("erc-"))
;;;***
@@ -10719,7 +10903,7 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-button.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-button" '("erc-")))
+(register-definition-prefixes "erc-button" '("erc-"))
;;;***
@@ -10727,15 +10911,7 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-capab.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-capab" '("erc-capab-identify-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-compat" "erc/erc-compat.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-compat.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-compat" '("erc-")))
+(register-definition-prefixes "erc-capab" '("erc-capab-identify-"))
;;;***
@@ -10743,7 +10919,7 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-dcc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-dcc" '("erc-" "pcomplete/erc-mode/")))
+(register-definition-prefixes "erc-dcc" '("erc-" "pcomplete/erc-mode/"))
;;;***
@@ -10751,7 +10927,7 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;;;; "erc/erc-desktop-notifications.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-desktop-notifications.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-desktop-notifications" '("erc-notifications-")))
+(register-definition-prefixes "erc-desktop-notifications" '("erc-notifications-"))
;;;***
@@ -10759,7 +10935,7 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;;;; "erc/erc-ezbounce.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-ezbounce.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-ezbounce" '("erc-ezb-")))
+(register-definition-prefixes "erc-ezbounce" '("erc-ezb-"))
;;;***
@@ -10767,21 +10943,21 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-fill.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-fill" '("erc-")))
+(register-definition-prefixes "erc-fill" '("erc-"))
;;;***
;;;### (autoloads nil "erc-goodies" "erc/erc-goodies.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-goodies.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-goodies" '("erc-")))
+(register-definition-prefixes "erc-goodies" '("erc-"))
;;;***
;;;### (autoloads nil "erc-ibuffer" "erc/erc-ibuffer.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-ibuffer.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-ibuffer" '("erc-")))
+(register-definition-prefixes "erc-ibuffer" '("erc-"))
;;;***
@@ -10789,7 +10965,7 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-identd.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-identd" '("erc-identd-")))
+(register-definition-prefixes "erc-identd" '("erc-identd-"))
;;;***
@@ -10797,7 +10973,7 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-imenu.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-imenu" '("erc-unfill-notice")))
+(register-definition-prefixes "erc-imenu" '("erc-unfill-notice"))
;;;***
@@ -10805,14 +10981,14 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-join.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-join" '("erc-")))
+(register-definition-prefixes "erc-join" '("erc-"))
;;;***
;;;### (autoloads nil "erc-lang" "erc/erc-lang.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-lang.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-lang" '("erc-cmd-LANG" "iso-638-languages" "language")))
+(register-definition-prefixes "erc-lang" '("erc-cmd-LANG" "iso-638-languages" "language"))
;;;***
@@ -10820,7 +10996,7 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-list.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-list" '("erc-")))
+(register-definition-prefixes "erc-list" '("erc-"))
;;;***
@@ -10828,7 +11004,7 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-log.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-log" '("erc-")))
+(register-definition-prefixes "erc-log" '("erc-"))
;;;***
@@ -10836,7 +11012,7 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-match.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-match" '("erc-")))
+(register-definition-prefixes "erc-match" '("erc-"))
;;;***
@@ -10844,7 +11020,7 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-menu.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-menu" '("erc-menu-")))
+(register-definition-prefixes "erc-menu" '("erc-menu-"))
;;;***
@@ -10852,7 +11028,7 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;;;; "erc/erc-netsplit.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-netsplit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-netsplit" '("erc-")))
+(register-definition-prefixes "erc-netsplit" '("erc-"))
;;;***
@@ -10868,7 +11044,7 @@ server name and search for a match in `erc-networks-alist'." nil nil)
(autoload 'erc-server-select "erc-networks" "\
Interactively select a server to connect to using `erc-server-alist'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-networks" '("erc-")))
+(register-definition-prefixes "erc-networks" '("erc-"))
;;;***
@@ -10876,7 +11052,7 @@ Interactively select a server to connect to using `erc-server-alist'." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-notify.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-notify" '("erc-")))
+(register-definition-prefixes "erc-notify" '("erc-"))
;;;***
@@ -10884,7 +11060,7 @@ Interactively select a server to connect to using `erc-server-alist'." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-page.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-page" '("erc-")))
+(register-definition-prefixes "erc-page" '("erc-"))
;;;***
@@ -10892,7 +11068,7 @@ Interactively select a server to connect to using `erc-server-alist'." t nil)
;;;;;; "erc/erc-pcomplete.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-pcomplete.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-pcomplete" '("erc-pcomplet" "pcomplete")))
+(register-definition-prefixes "erc-pcomplete" '("erc-pcomplet" "pcomplete"))
;;;***
@@ -10900,7 +11076,7 @@ Interactively select a server to connect to using `erc-server-alist'." t nil)
;;;;;; "erc/erc-replace.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-replace.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-replace" '("erc-replace-")))
+(register-definition-prefixes "erc-replace" '("erc-replace-"))
;;;***
@@ -10908,7 +11084,7 @@ Interactively select a server to connect to using `erc-server-alist'." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-ring.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-ring" '("erc-")))
+(register-definition-prefixes "erc-ring" '("erc-"))
;;;***
@@ -10916,7 +11092,7 @@ Interactively select a server to connect to using `erc-server-alist'." t nil)
;;;;;; "erc/erc-services.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-services.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-services" '("erc-")))
+(register-definition-prefixes "erc-services" '("erc-"))
;;;***
@@ -10924,7 +11100,7 @@ Interactively select a server to connect to using `erc-server-alist'." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-sound.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-sound" '("erc-")))
+(register-definition-prefixes "erc-sound" '("erc-"))
;;;***
@@ -10932,7 +11108,7 @@ Interactively select a server to connect to using `erc-server-alist'." t nil)
;;;;;; "erc/erc-speedbar.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-speedbar.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-speedbar" '("erc-")))
+(register-definition-prefixes "erc-speedbar" '("erc-"))
;;;***
@@ -10940,7 +11116,7 @@ Interactively select a server to connect to using `erc-server-alist'." t nil)
;;;;;; "erc/erc-spelling.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-spelling.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-spelling" '("erc-spelling-")))
+(register-definition-prefixes "erc-spelling" '("erc-spelling-"))
;;;***
@@ -10948,7 +11124,15 @@ Interactively select a server to connect to using `erc-server-alist'." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-stamp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-stamp" '("erc-")))
+(register-definition-prefixes "erc-stamp" '("erc-"))
+
+;;;***
+
+;;;### (autoloads "actual autoloads are elsewhere" "erc-status-sidebar"
+;;;;;; "erc/erc-status-sidebar.el" (0 0 0 0))
+;;; Generated autoloads from erc/erc-status-sidebar.el
+
+(register-definition-prefixes "erc-status-sidebar" '("erc-status-sidebar-"))
;;;***
@@ -10956,7 +11140,7 @@ Interactively select a server to connect to using `erc-server-alist'." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-track.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-track" '("erc-")))
+(register-definition-prefixes "erc-track" '("erc-"))
;;;***
@@ -10964,7 +11148,7 @@ Interactively select a server to connect to using `erc-server-alist'." t nil)
;;;;;; "erc/erc-truncate.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-truncate.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-truncate" '("erc-max-buffer-size")))
+(register-definition-prefixes "erc-truncate" '("erc-max-buffer-size"))
;;;***
@@ -10972,7 +11156,7 @@ Interactively select a server to connect to using `erc-server-alist'." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-xdcc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-xdcc" '("erc-")))
+(register-definition-prefixes "erc-xdcc" '("erc-"))
;;;***
@@ -11047,7 +11231,7 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test).
\(fn TEST-OR-TEST-NAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ert" '("ert-")))
+(register-definition-prefixes "ert" '("ert-"))
;;;***
@@ -11059,35 +11243,35 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test).
(autoload 'ert-kill-all-test-buffers "ert-x" "\
Kill all test buffers that are still live." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ert-x" '("ert-")))
+(register-definition-prefixes "ert-x" '("ert-"))
;;;***
;;;### (autoloads nil "esh-arg" "eshell/esh-arg.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-arg.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-arg" '("eshell-")))
+(register-definition-prefixes "esh-arg" '("eshell-"))
;;;***
;;;### (autoloads nil "esh-cmd" "eshell/esh-cmd.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-cmd.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-cmd" '("eshell" "pcomplete/eshell-mode/eshell-debug")))
+(register-definition-prefixes "esh-cmd" '("eshell" "pcomplete/eshell-mode/eshell-debug"))
;;;***
;;;### (autoloads nil "esh-ext" "eshell/esh-ext.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-ext.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-ext" '("eshell")))
+(register-definition-prefixes "esh-ext" '("eshell"))
;;;***
;;;### (autoloads nil "esh-io" "eshell/esh-io.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-io.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-io" '("eshell-")))
+(register-definition-prefixes "esh-io" '("eshell-"))
;;;***
@@ -11099,7 +11283,12 @@ Emacs shell interactive mode.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-mode" '("eshell")))
+(autoload 'eshell-bookmark-jump "esh-mode" "\
+Default bookmark handler for Eshell buffers.
+
+\(fn BOOKMARK)" nil nil)
+
+(register-definition-prefixes "esh-mode" '("eshell"))
;;;***
@@ -11107,35 +11296,35 @@ Emacs shell interactive mode.
;;;;;; 0))
;;; Generated autoloads from eshell/esh-module.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-module" '("eshell-")))
+(register-definition-prefixes "esh-module" '("eshell-"))
;;;***
;;;### (autoloads nil "esh-opt" "eshell/esh-opt.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-opt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-opt" '("eshell-")))
+(register-definition-prefixes "esh-opt" '("eshell-"))
;;;***
;;;### (autoloads nil "esh-proc" "eshell/esh-proc.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-proc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-proc" '("eshell")))
+(register-definition-prefixes "esh-proc" '("eshell"))
;;;***
;;;### (autoloads nil "esh-util" "eshell/esh-util.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-util" '("eshell-")))
+(register-definition-prefixes "esh-util" '("eshell-"))
;;;***
;;;### (autoloads nil "esh-var" "eshell/esh-var.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-var.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-var" '("eshell" "pcomplete/eshell-mode/")))
+(register-definition-prefixes "esh-var" '("eshell" "pcomplete/eshell-mode/"))
;;;***
@@ -11177,9 +11366,7 @@ corresponding to a successful execution.
\(fn COMMAND &optional STATUS-VAR)" nil nil)
-(define-obsolete-function-alias 'eshell-report-bug 'report-emacs-bug "23.1")
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eshell" '("eshell-")))
+(register-definition-prefixes "eshell" '("eshell-"))
;;;***
@@ -11447,7 +11634,7 @@ 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].
-For non-interactive use, superceded by `fileloop-initialize-replace'.
+For non-interactive use, superseded by `fileloop-initialize-replace'.
\(fn FROM TO &optional DELIMITED FILES)" t nil)
@@ -11483,7 +11670,7 @@ for \\[find-tag] (which see)." t nil)
(autoload 'etags--xref-backend "etags" nil nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "etags" '("default-tags-table-function" "etags-" "file-of-tag" "find-tag-" "goto-tag-location-function" "initialize-new-tags-table" "last-tag" "list-tags-function" "select-tags-table-" "snarf-tag-function" "tag" "verify-tags-table-function" "xref-")))
+(register-definition-prefixes "etags" '("default-tags-table-function" "etags-" "file-of-tag" "find-tag-" "goto-tag-location-function" "initialize-new-tags-table" "last-tag" "list-tags-function" "select-tags-table-" "snarf-tag-function" "tag" "verify-tags-table-function" "xref-"))
;;;***
@@ -11637,7 +11824,7 @@ With ARG, insert that many delimiters.
\(fn POS TO FONT-OBJECT STRING DIRECTION)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ethio-util" '("ethio-" "exit-ethiopic-environment")))
+(register-definition-prefixes "ethio-util" '("ethio-" "exit-ethiopic-environment"))
;;;***
@@ -11704,7 +11891,7 @@ This does nothing except loading eudc by autoload side-effect." t nil)
(fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc" '("eudc-")))
+(register-definition-prefixes "eudc" '("eudc-"))
;;;***
@@ -11741,7 +11928,7 @@ Display a button for the JPEG DATA.
\(fn DATA)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc-bob" '("eudc-")))
+(register-definition-prefixes "eudc-bob" '("eudc-bob-"))
;;;***
@@ -11755,7 +11942,7 @@ This function can only be called from a directory query result buffer." t nil)
(autoload 'eudc-try-bbdb-insert "eudc-export" "\
Call `eudc-insert-record-at-point-into-bbdb' if on a record." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc-export" '("eudc-")))
+(register-definition-prefixes "eudc-export" '("eudc-"))
;;;***
@@ -11766,35 +11953,43 @@ Call `eudc-insert-record-at-point-into-bbdb' if on a record." t nil)
(autoload 'eudc-edit-hotlist "eudc-hotlist" "\
Edit the hotlist of directory servers in a specialized buffer." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc-hotlist" '("eudc-hotlist-")))
+(register-definition-prefixes "eudc-hotlist" '("eudc-hotlist-"))
;;;***
;;;### (autoloads nil "eudc-vars" "net/eudc-vars.el" (0 0 0 0))
;;; Generated autoloads from net/eudc-vars.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc-vars" '("eudc-")))
+(register-definition-prefixes "eudc-vars" '("eudc-"))
;;;***
;;;### (autoloads nil "eudcb-bbdb" "net/eudcb-bbdb.el" (0 0 0 0))
;;; Generated autoloads from net/eudcb-bbdb.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudcb-bbdb" '("eudc-bbdb-")))
+(register-definition-prefixes "eudcb-bbdb" '("eudc-bbdb-"))
;;;***
;;;### (autoloads nil "eudcb-ldap" "net/eudcb-ldap.el" (0 0 0 0))
;;; Generated autoloads from net/eudcb-ldap.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudcb-ldap" '("eudc-")))
+(register-definition-prefixes "eudcb-ldap" '("eudc-"))
;;;***
;;;### (autoloads nil "eudcb-mab" "net/eudcb-mab.el" (0 0 0 0))
;;; Generated autoloads from net/eudcb-mab.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudcb-mab" '("eudc-")))
+(register-definition-prefixes "eudcb-mab" '("eudc-"))
+
+;;;***
+
+;;;### (autoloads nil "eudcb-macos-contacts" "net/eudcb-macos-contacts.el"
+;;;;;; (0 0 0 0))
+;;; Generated autoloads from net/eudcb-macos-contacts.el
+
+(register-definition-prefixes "eudcb-macos-contacts" '("eudc-macos-contacts-"))
;;;***
@@ -11822,7 +12017,7 @@ fourth arg NOSEP non-nil inhibits this.
\(fn PRETTY-PRINTER &optional HEADER FOOTER NOSEP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ewoc" '("ewoc-")))
+(register-definition-prefixes "ewoc" '("ewoc-"))
;;;***
@@ -11837,6 +12032,20 @@ duplicate entries (if any) removed.")
(custom-autoload 'eww-suggest-uris "eww" t)
+(autoload 'eww-browse "eww" "\
+Function to be run to parse command line URLs.
+This is meant to be used for MIME handlers or command line use.
+
+Setting the handler for \"text/x-uri;\" to
+\"emacs -f eww-browse %u\" will then start up Emacs and call eww
+to browse the url.
+
+This can also be used on the command line directly:
+
+ emacs -f eww-browse https://gnu.org
+
+will start Emacs and browse the GNU web site." t nil)
+
(autoload 'eww "eww" "\
Fetch URL and render the page.
If the input doesn't look like an URL or a domain name, the
@@ -11845,7 +12054,11 @@ word(s) will be searched for via `eww-search-prefix'.
If called with a prefix ARG, use a new buffer instead of reusing
the default EWW buffer.
-\(fn URL &optional ARG)" t nil)
+If BUFFER, the data to be rendered is in that buffer. In that
+case, this function doesn't actually fetch URL. BUFFER will be
+killed after rendering.
+
+\(fn URL &optional ARG BUFFER)" t nil)
(defalias 'browse-web 'eww)
(autoload 'eww-open-file "eww" "\
@@ -11854,11 +12067,11 @@ Render FILE using EWW.
\(fn FILE)" t nil)
(autoload 'eww-search-words "eww" "\
-Search the web for the text in the region.
+Search the web for the text between BEG and END.
If region is active (and not whitespace), search the web for
-the text between region beginning and end. Else, prompt the
-user for a search string. See the variable `eww-search-prefix'
-for the search engine used." t nil)
+the text between BEG and END. Else, prompt the user for a search
+string. See the `eww-search-prefix' variable for the search
+engine used." t nil)
(autoload 'eww-mode "eww" "\
Mode for browsing the web.
@@ -11885,7 +12098,7 @@ instead of `browse-url-new-window-flag'.
(autoload 'eww-list-bookmarks "eww" "\
Display the bookmarks." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eww" '("eww-")))
+(register-definition-prefixes "eww" '("erc--download-directory" "eww-"))
;;;***
@@ -11921,14 +12134,14 @@ Make file executable according to umask if not already executable.
If file already has any execute bits set at all, do not change existing
file modes." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "executable" '("executable-")))
+(register-definition-prefixes "executable" '("executable-"))
;;;***
;;;### (autoloads nil "exif" "image/exif.el" (0 0 0 0))
;;; Generated autoloads from image/exif.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "exif" '("exif-")))
+(register-definition-prefixes "exif" '("exif-"))
;;;***
@@ -11973,14 +12186,14 @@ This is used only in conjunction with `expand-add-abbrevs'." t nil)
(define-key abbrev-map "p" 'expand-jump-to-previous-slot)
(define-key abbrev-map "n" 'expand-jump-to-next-slot)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "expand" '("expand-")))
+(register-definition-prefixes "expand" '("expand-"))
;;;***
;;;### (autoloads nil "ezimage" "ezimage.el" (0 0 0 0))
;;; Generated autoloads from ezimage.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ezimage" '("defezimage" "ezimage-")))
+(register-definition-prefixes "ezimage" '("defezimage" "ezimage-"))
;;;***
@@ -12049,7 +12262,7 @@ with no args, if that value is non-nil.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "f90" '("f90-")))
+(register-definition-prefixes "f90" '("f90-"))
;;;***
@@ -12172,6 +12385,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When enabled, the face specified by the variable
`buffer-face-mode-face' is used to display the buffer text.
@@ -12214,7 +12430,7 @@ Besides the choice of face, it is the same as `buffer-face-mode'.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "face-remap" '("buffer-face-mode-" "face-" "internal-lisp-face-attributes" "text-scale-m")))
+(register-definition-prefixes "face-remap" '("buffer-face-mode-" "face-" "internal-lisp-face-attributes" "text-scale-m"))
;;;***
@@ -12253,7 +12469,7 @@ FUNCTION must return an explanation when the test fails and
\(fn FUNCTION)" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "faceup" '("faceup-")))
+(register-definition-prefixes "faceup" '("faceup-"))
;;;***
@@ -12307,7 +12523,7 @@ you can set `feedmail-queue-reminder-alist' to nil.
\(fn &optional WHAT-EVENT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "feedmail" '("feedmail-")))
+(register-definition-prefixes "feedmail" '("feedmail-"))
;;;***
@@ -12369,7 +12585,7 @@ This hook is intended to be put in `file-name-at-point-functions'." nil nil)
(autoload 'ffap-bindings "ffap" "\
Evaluate the forms in variable `ffap-bindings'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ffap" '("dired-at-point-" "ffap-" "find-file-literally-at-point")))
+(register-definition-prefixes "ffap" '("dired-at-point-" "ffap-" "find-file-literally-at-point"))
;;;***
@@ -12428,7 +12644,7 @@ the name is considered already unique; only the second substitution
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "filecache" '("file-cache-")))
+(register-definition-prefixes "filecache" '("file-cache-"))
;;;***
@@ -12455,20 +12671,20 @@ operating on the next file and nil otherwise.
(autoload 'fileloop-initialize-replace "fileloop" "\
Initialize a new round of query&replace on several files.
- FROM is a regexp and TO is the replacement to use.
- FILES describes the files, as in `fileloop-initialize'.
- CASE-FOLD can be t, nil, or `default':
- if it is nil, matching of FROM is case-sensitive.
- if it is t, matching of FROM is case-insensitive, except
- when `search-upper-case' is non-nil and FROM includes
- upper-case letters.
- if it is `default', the function uses the value of
- `case-fold-search' instead.
- DELIMITED if non-nil means replace only word-delimited matches.
+FROM is a regexp and TO is the replacement to use.
+FILES describes the files, as in `fileloop-initialize'.
+CASE-FOLD can be t, nil, or `default':
+ if it is nil, matching of FROM is case-sensitive.
+ if it is t, matching of FROM is case-insensitive, except
+ when `search-upper-case' is non-nil and FROM includes
+ upper-case letters.
+ if it is `default', the function uses the value of
+ `case-fold-search' instead.
+DELIMITED if non-nil means replace only word-delimited matches.
\(fn FROM TO FILES CASE-FOLD &optional DELIMITED)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "fileloop" '("fileloop-")))
+(register-definition-prefixes "fileloop" '("fileloop-"))
;;;***
@@ -12482,7 +12698,7 @@ Otherwise, signal a `file-notify-error'.
\(fn OBJECT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "filenotify" '("file-notify-")))
+(register-definition-prefixes "filenotify" '("file-notify-"))
;;;***
@@ -12588,7 +12804,7 @@ Execute BODY, and unwind connection-local variables.
\(fn &rest BODY)" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "files-x" '("connection-local-" "dir-locals-to-string" "hack-connection-local-variables" "modify-" "read-file-local-variable")))
+(register-definition-prefixes "files-x" '("connection-local-" "dir-locals-to-string" "hack-connection-local-variables" "modify-" "read-file-local-variable"))
;;;***
@@ -12599,7 +12815,7 @@ Execute BODY, and unwind connection-local variables.
Filesets initialization.
Set up hooks, load the cache file -- if existing -- and build the menu." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "filesets" '("filesets-")))
+(register-definition-prefixes "filesets" '("filesets-"))
;;;***
@@ -12621,7 +12837,7 @@ result is a string that should be ready for the command line.
\(fn &rest SUBFINDS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "find-cmd" '("find-")))
+(register-definition-prefixes "find-cmd" '("find-"))
;;;***
@@ -12637,6 +12853,9 @@ The command run (after changing into DIR) is essentially
except that the car of the variable `find-ls-option' specifies what to
use in place of \"-ls\" as the final argument.
+Collect output in the \"*Find*\" buffer. To kill the job before
+it finishes, type \\[kill-find].
+
\(fn DIR ARGS)" t nil)
(autoload 'find-name-dired "find-dired" "\
@@ -12663,7 +12882,7 @@ specifies what to use in place of \"-ls\" as the final argument.
\(fn DIR REGEXP)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "find-dired" '("find-" "kill-find" "lookfor-dired")))
+(register-definition-prefixes "find-dired" '("find-" "kill-find" "lookfor-dired"))
;;;***
@@ -12755,7 +12974,7 @@ Visit the file you click on in another window.
\(fn EVENT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "find-file" '("cc-" "ff-" "modula2-other-file-alist")))
+(register-definition-prefixes "find-file" '("cc-" "ff-" "modula2-other-file-alist"))
;;;***
@@ -12770,6 +12989,13 @@ Interactively, prompt for LIBRARY using the one at or near point.
\(fn LIBRARY)" t nil)
+(autoload 'read-library-name "find-func" "\
+Read and return a library name, defaulting to the one near point.
+
+A library name is the filename of an Emacs Lisp library located
+in a directory under `load-path' (or `find-function-source-path',
+if non-nil)." nil nil)
+
(autoload 'find-library-other-window "find-func" "\
Find the Emacs Lisp source of LIBRARY in another window.
@@ -12937,7 +13163,7 @@ Find directly the variable at point in the other window." t nil)
(autoload 'find-function-setup-keys "find-func" "\
Define some key bindings for the find-function family of functions." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "find-func" '("find-" "read-library-name")))
+(register-definition-prefixes "find-func" '("find-"))
;;;***
@@ -12959,7 +13185,7 @@ Change the filter on a `find-lisp-find-dired' buffer to REGEXP.
\(fn REGEXP)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "find-lisp" '("find-lisp-")))
+(register-definition-prefixes "find-lisp" '("find-lisp-"))
;;;***
@@ -12979,7 +13205,7 @@ FILE should be in a form suitable for passing to `locate-library'.
(autoload 'finder-by-keyword "finder" "\
Find packages matching a given keyword." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "finder" '("finder-" "generated-finder-keywords-file")))
+(register-definition-prefixes "finder" '("finder-" "generated-finder-keywords-file"))
;;;***
@@ -13002,7 +13228,7 @@ to get the effect of a C-q.
\(fn &rest LOSING-TERMINAL-TYPES)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flow-ctrl" '("flow-control-c-")))
+(register-definition-prefixes "flow-ctrl" '("flow-control-c-"))
;;;***
@@ -13023,13 +13249,13 @@ lines.
\(fn &optional BUFFER DELETE-SPACE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flow-fill" '("fill-flowed-")))
+(register-definition-prefixes "flow-fill" '("fill-flowed-"))
;;;***
;;;### (autoloads nil "flymake" "progmodes/flymake.el" (0 0 0 0))
;;; Generated autoloads from progmodes/flymake.el
-(push (purecopy '(flymake 1 0 8)) package--builtin-versions)
+(push (purecopy '(flymake 1 0 9)) package--builtin-versions)
(autoload 'flymake-log "flymake" "\
Log, at level LEVEL, the message MSG formatted with ARGS.
@@ -13078,6 +13304,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Flymake is an Emacs minor mode for on-the-fly syntax checking.
Flymake collects diagnostic information from multiple sources,
called backends, and visually annotates the buffer with the
@@ -13116,7 +13345,7 @@ Turn Flymake mode on." nil nil)
(autoload 'flymake-mode-off "flymake" "\
Turn Flymake mode off." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake" '("flymake-")))
+(register-definition-prefixes "flymake" '("flymake-"))
;;;***
@@ -13132,7 +13361,7 @@ REPORT-FN is Flymake's callback.
\(fn REPORT-FN &rest ARGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake-cc" '("flymake-cc-")))
+(register-definition-prefixes "flymake-cc" '("flymake-cc-"))
;;;***
@@ -13141,7 +13370,7 @@ REPORT-FN is Flymake's callback.
;;; Generated autoloads from progmodes/flymake-proc.el
(push (purecopy '(flymake-proc 1 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake-proc" '("flymake-proc-")))
+(register-definition-prefixes "flymake-proc" '("flymake-proc-"))
;;;***
@@ -13160,6 +13389,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Flyspell mode is a buffer-local minor mode. When enabled, it
spawns a single Ispell process and checks each word. The default
flyspell behavior is to highlight incorrect words.
@@ -13208,7 +13440,7 @@ of a misspelled word removed when you've corrected it.
(autoload 'flyspell-buffer "flyspell" "\
Flyspell whole buffer." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flyspell" '("flyspell-" "mail-mode-flyspell-verify" "make-flyspell-overlay" "sgml-mode-flyspell-verify" "tex")))
+(register-definition-prefixes "flyspell" '("flyspell-" "mail-mode-flyspell-verify" "make-flyspell-overlay" "sgml-mode-flyspell-verify" "tex"))
;;;***
@@ -13216,7 +13448,7 @@ Flyspell whole buffer." t nil)
;;; Generated autoloads from foldout.el
(push (purecopy '(foldout 1 10)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "foldout" '("foldout-")))
+(register-definition-prefixes "foldout" '("foldout-"))
;;;***
@@ -13237,6 +13469,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Follow mode is a minor mode that combines windows into one tall
virtual window. This is accomplished by two main techniques:
@@ -13338,7 +13573,7 @@ selected if the original window is the first one in the frame.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "follow" '("follow-")))
+(register-definition-prefixes "follow" '("follow-"))
;;;***
@@ -13346,7 +13581,7 @@ selected if the original window is the first one in the frame.
;;;;;; 0))
;;; Generated autoloads from international/fontset.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "fontset" '("charset-script-alist" "create-" "fontset-" "generate-fontset-menu" "set" "standard-fontset-spec" "x-" "xlfd-")))
+(register-definition-prefixes "fontset" '("charset-script-alist" "create-" "fontset-" "generate-fontset-menu" "set" "standard-fontset-spec" "x-" "xlfd-"))
;;;***
@@ -13362,6 +13597,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Footnote mode is a buffer-local minor mode. If enabled, it
provides footnote support for `message-mode'. To get started,
play around with the following keys:
@@ -13369,14 +13607,61 @@ play around with the following keys:
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "footnote" '("footnote-")))
+(register-definition-prefixes "footnote" '("footnote-"))
;;;***
;;;### (autoloads nil "format-spec" "format-spec.el" (0 0 0 0))
;;; Generated autoloads from format-spec.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "format-spec" '("format-spec")))
+(autoload 'format-spec "format-spec" "\
+Return a string based on FORMAT and SPECIFICATION.
+FORMAT is a string containing `format'-like specs like \"su - %u %k\".
+SPECIFICATION is an alist mapping format specification characters
+to their substitutions.
+
+For instance:
+
+ (format-spec \"su - %u %l\"
+ \\=`((?u . ,(user-login-name))
+ (?l . \"ls\")))
+
+Each %-spec may contain optional flag, width, and precision
+modifiers, as follows:
+
+ %<flags><width><precision>character
+
+The following flags are allowed:
+
+* 0: Pad to the width, if given, with zeros instead of spaces.
+* -: Pad to the width, if given, on the right instead of the left.
+* <: Truncate to the width and precision, if given, on the left.
+* >: Truncate to the width and precision, if given, on the right.
+* ^: Convert to upper case.
+* _: Convert to lower case.
+
+The width and truncation modifiers behave like the corresponding
+ones in `format' when applied to %s.
+
+For example, \"%<010b\" means \"substitute into the output the
+value associated with ?b in SPECIFICATION, either padding it with
+leading zeros or truncating leading characters until it's ten
+characters wide\".
+
+Any text properties of FORMAT are copied to the result, with any
+text properties of a %-spec itself copied to its substitution.
+
+IGNORE-MISSING indicates how to handle %-spec characters not
+present in SPECIFICATION. If it is nil or omitted, emit an
+error; if it is the symbol `ignore', leave those %-specs verbatim
+in the result, including their text properties, if any; if it is
+the symbol `delete', remove those %-specs from the result;
+otherwise do the same as for the symbol `ignore', but also leave
+any occurrences of \"%%\" in FORMAT verbatim in the result.
+
+\(fn FORMAT SPECIFICATION &optional IGNORE-MISSING)" nil nil)
+
+(register-definition-prefixes "format-spec" '("format-spec-"))
;;;***
@@ -13414,7 +13699,7 @@ Visit a file in Forms mode in other window.
\(fn FN)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "forms" '("forms-")))
+(register-definition-prefixes "forms" '("forms-"))
;;;***
@@ -13493,7 +13778,7 @@ with no args, if that value is non-nil.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "fortran" '("fortran-")))
+(register-definition-prefixes "fortran" '("fortran-"))
;;;***
@@ -13550,7 +13835,7 @@ and choose the directory as the fortune-file.
\(fn &optional FILE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "fortune" '("fortune-")))
+(register-definition-prefixes "fortune" '("fortune-"))
;;;***
@@ -13561,7 +13846,7 @@ and choose the directory as the fortune-file.
Minimum set of parameters to filter for live (on-session) framesets.
DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
-(defvar frameset-persistent-filter-alist (nconc '((background-color . frameset-filter-sanitize-color) (buffer-list . :never) (buffer-predicate . :never) (buried-buffer-list . :never) (client . :never) (delete-before . :never) (font . frameset-filter-font-param) (font-backend . :never) (foreground-color . frameset-filter-sanitize-color) (frameset--text-pixel-height . :save) (frameset--text-pixel-width . :save) (fullscreen . frameset-filter-shelve-param) (GUI:font . frameset-filter-unshelve-param) (GUI:fullscreen . frameset-filter-unshelve-param) (GUI:height . frameset-filter-unshelve-param) (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) (outer-window-id . :never) (parent-frame . :never) (parent-id . :never) (mouse-wheel-frame . :never) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) (window-id . :never) (window-system . :never)) frameset-session-filter-alist) "\
+(defvar frameset-persistent-filter-alist (append '((background-color . frameset-filter-sanitize-color) (buffer-list . :never) (buffer-predicate . :never) (buried-buffer-list . :never) (client . :never) (delete-before . :never) (font . frameset-filter-font-param) (font-backend . :never) (foreground-color . frameset-filter-sanitize-color) (frameset--text-pixel-height . :save) (frameset--text-pixel-width . :save) (fullscreen . frameset-filter-shelve-param) (GUI:font . frameset-filter-unshelve-param) (GUI:fullscreen . frameset-filter-unshelve-param) (GUI:height . frameset-filter-unshelve-param) (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) (outer-window-id . :never) (parent-frame . :never) (parent-id . :never) (mouse-wheel-frame . :never) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) (window-id . :never) (window-system . :never)) frameset-session-filter-alist) "\
Parameters to filter for persistent framesets.
DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
@@ -13726,7 +14011,7 @@ Interactively, reads the register using `register-read-with-preview'.
\(fn REGISTER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "frameset" '("frameset-")))
+(register-definition-prefixes "frameset" '("frameset-"))
;;;***
@@ -13735,7 +14020,7 @@ Interactively, reads the register using `register-read-with-preview'.
(unless (fboundp 'define-fringe-bitmap) (defun define-fringe-bitmap (_bitmap _bits &optional _height _width _align) "Define fringe bitmap BITMAP from BITS of size HEIGHT x WIDTH.\nBITMAP is a symbol identifying the new fringe bitmap.\nBITS is either a string or a vector of integers.\nHEIGHT is height of bitmap. If HEIGHT is nil, use length of BITS.\nWIDTH must be an integer between 1 and 16, or nil which defaults to 8.\nOptional fifth arg ALIGN may be one of ‘top’, ‘center’, or ‘bottom’,\nindicating the positioning of the bitmap relative to the rows where it\nis used; the default is to center the bitmap. Fifth arg may also be a\nlist (ALIGN PERIODIC) where PERIODIC non-nil specifies that the bitmap\nshould be repeated.\nIf BITMAP already exists, the existing definition is replaced."))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "fringe" '("fringe-" "set-fringe-")))
+(register-definition-prefixes "fringe" '("fringe-" "set-fringe-"))
;;;***
@@ -13743,14 +14028,14 @@ Interactively, reads the register using `register-read-with-preview'.
;;; Generated autoloads from play/gamegrid.el
(push (purecopy '(gamegrid 1 2)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gamegrid" '("gamegrid-")))
+(register-definition-prefixes "gamegrid" '("gamegrid-"))
;;;***
;;;### (autoloads nil "gametree" "play/gametree.el" (0 0 0 0))
;;; Generated autoloads from play/gametree.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gametree" '("gametree-")))
+(register-definition-prefixes "gametree" '("gametree-"))
;;;***
@@ -13777,6 +14062,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
(autoload 'gdb "gdb-mi" "\
@@ -13839,7 +14127,7 @@ detailed description of this mode.
\(fn COMMAND-LINE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gdb-mi" '("breakpoint" "def-gdb-" "gdb" "gud-" "hollow-right-triangle" "nil")))
+(register-definition-prefixes "gdb-mi" '("breakpoint" "def-gdb-" "gdb" "gud-" "hollow-right-triangle" "nil"))
;;;***
@@ -13847,7 +14135,7 @@ detailed description of this mode.
;;;;;; 0 0))
;;; Generated autoloads from emacs-lisp/generator.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "generator" '("cps-" "iter-")))
+(register-definition-prefixes "generator" '("cps-" "iter-"))
;;;***
@@ -13862,6 +14150,10 @@ instead (which see).")
(autoload 'define-generic-mode "generic" "\
Create a new generic mode MODE.
+A \"generic\" mode is a simple major mode with basic support for
+comment syntax and Font Lock mode, but otherwise does not have
+any special keystrokes or functionality available.
+
MODE is the name of the command for the generic mode; don't quote it.
The optional DOCSTRING is the documentation for the mode command. If
you do not supply it, `define-generic-mode' uses a default
@@ -13929,14 +14221,14 @@ regular expression that can be used as an element of
(make-obsolete 'generic-make-keywords-list 'regexp-opt '"24.4")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "generic" '("generic-")))
+(register-definition-prefixes "generic" '("generic-"))
;;;***
;;;### (autoloads nil "generic-x" "generic-x.el" (0 0 0 0))
;;; Generated autoloads from generic-x.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "generic-x" '("default-generic-mode" "generic-")))
+(register-definition-prefixes "generic-x" '("default-generic-mode" "generic-"))
;;;***
@@ -13951,12 +14243,15 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When this mode is active, it tries to add virtual
separators (like underscores) at places they belong to.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "glasses" '("glasses-")))
+(register-definition-prefixes "glasses" '("glasses-"))
;;;***
@@ -14012,18 +14307,22 @@ DEFAULT-MAP specifies the default key map for ICON-LIST.
\(fn ICON-LIST ZAP-LIST DEFAULT-MAP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gmm-utils" '("defun-gmm" "gmm-")))
+(register-definition-prefixes "gmm-utils" '("defun-gmm" "gmm-"))
;;;***
;;;### (autoloads nil "gnus" "gnus/gnus.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus.el
(push (purecopy '(gnus 5 13)) package--builtin-versions)
-(when (fboundp 'custom-autoload)
- (custom-autoload 'gnus-select-method "gnus"))
+(custom-autoload 'gnus-select-method "gnus")
+
+(autoload 'gnus-child-no-server "gnus" "\
+Read network news as a child, without connecting to the local server.
+
+\(fn &optional ARG)" t nil)
(autoload 'gnus-slave-no-server "gnus" "\
-Read network news as a slave, without connecting to the local server.
+Read network news as a child, without connecting to the local server.
\(fn &optional ARG)" t nil)
@@ -14036,10 +14335,15 @@ an NNTP server to use.
As opposed to `gnus', this command will not connect to the local
server.
-\(fn &optional ARG SLAVE)" t nil)
+\(fn &optional ARG CHILD)" t nil)
+
+(autoload 'gnus-child "gnus" "\
+Read news as a child.
+
+\(fn &optional ARG)" t nil)
(autoload 'gnus-slave "gnus" "\
-Read news as a slave.
+Read news as a child.
\(fn &optional ARG)" t nil)
@@ -14062,9 +14366,9 @@ If ARG is non-nil and a positive number, Gnus will use that as the
startup level. If ARG is non-nil and not a positive number, Gnus will
prompt the user for the name of an NNTP server to use.
-\(fn &optional ARG DONT-CONNECT SLAVE)" t nil)
+\(fn &optional ARG DONT-CONNECT CHILD)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus" '("gnus-")))
+(register-definition-prefixes "gnus" '("gnus-"))
;;;***
@@ -14077,8 +14381,13 @@ Start Gnus unplugged." t nil)
(autoload 'gnus-plugged "gnus-agent" "\
Start Gnus plugged." t nil)
+(autoload 'gnus-child-unplugged "gnus-agent" "\
+Read news as a child unplugged.
+
+\(fn &optional ARG)" t nil)
+
(autoload 'gnus-slave-unplugged "gnus-agent" "\
-Read news as a slave unplugged.
+Read news as a child unplugged.
\(fn &optional ARG)" t nil)
@@ -14142,7 +14451,7 @@ CLEAN is obsolete and ignored.
\(fn &optional CLEAN REREAD)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-agent" '("gnus-")))
+(register-definition-prefixes "gnus-agent" '("gnus-"))
;;;***
@@ -14152,21 +14461,21 @@ CLEAN is obsolete and ignored.
(autoload 'gnus-article-prepare-display "gnus-art" "\
Make the current buffer look like a nice article." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-art" '("article-" "gnus-")))
+(register-definition-prefixes "gnus-art" '("article-" "gnus-"))
;;;***
;;;### (autoloads nil "gnus-async" "gnus/gnus-async.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-async.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-async" '("gnus-")))
+(register-definition-prefixes "gnus-async" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-bcklg" "gnus/gnus-bcklg.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-bcklg.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-bcklg" '("gnus-backlog-")))
+(register-definition-prefixes "gnus-bcklg" '("gnus-backlog-"))
;;;***
@@ -14188,7 +14497,7 @@ The list is displayed in a buffer named `*Gnus Bookmark List*'.
The leftmost column displays a D if the bookmark is flagged for
deletion, or > if it is flagged for displaying." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-bookmark" '("gnus-bookmark-")))
+(register-definition-prefixes "gnus-bookmark" '("gnus-bookmark-"))
;;;***
@@ -14229,28 +14538,35 @@ supported.
\(fn GROUP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-cache" '("gnus-")))
+(register-definition-prefixes "gnus-cache" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-cite" "gnus/gnus-cite.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-cite.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-cite" '("gnus-" "turn-o")))
+(register-definition-prefixes "gnus-cite" '("gnus-" "turn-o"))
;;;***
;;;### (autoloads nil "gnus-cloud" "gnus/gnus-cloud.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-cloud.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-cloud" '("gnus-cloud-")))
+(register-definition-prefixes "gnus-cloud" '("gnus-cloud-"))
;;;***
;;;### (autoloads nil "gnus-cus" "gnus/gnus-cus.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-cus.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-cus" '("category-fields" "gnus-")))
+(register-definition-prefixes "gnus-cus" '("category-fields" "gnus-"))
+
+;;;***
+
+;;;### (autoloads nil "gnus-dbus" "gnus/gnus-dbus.el" (0 0 0 0))
+;;; Generated autoloads from gnus/gnus-dbus.el
+
+(register-definition-prefixes "gnus-dbus" '("gnus-dbus-"))
;;;***
@@ -14270,6 +14586,10 @@ DELAY is a string, giving the length of the time. Possible values are:
* hh:mm for a specific time. Use 24h format. If it is later than this
time, then the deadline is tomorrow, else today.
+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)
(autoload 'gnus-delay-send-queue "gnus-delay" "\
@@ -14285,14 +14605,14 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil.
\(fn &optional NO-KEYMAP NO-CHECK)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-delay" '("gnus-delay-")))
+(register-definition-prefixes "gnus-delay" '("gnus-delay-"))
;;;***
;;;### (autoloads nil "gnus-demon" "gnus/gnus-demon.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-demon.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-demon" '("gnus-")))
+(register-definition-prefixes "gnus-demon" '("gnus-"))
;;;***
@@ -14309,7 +14629,7 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil.
\(fn HEADER)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-diary" '("gnus-")))
+(register-definition-prefixes "gnus-diary" '("gnus-"))
;;;***
@@ -14319,7 +14639,7 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil.
(autoload 'turn-on-gnus-dired-mode "gnus-dired" "\
Convenience method to turn on gnus-dired-mode." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-dired" '("gnus-dired-")))
+(register-definition-prefixes "gnus-dired" '("gnus-dired-"))
;;;***
@@ -14329,21 +14649,21 @@ Convenience method to turn on gnus-dired-mode." t nil)
(autoload 'gnus-draft-reminder "gnus-draft" "\
Reminder user if there are unsent drafts." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-draft" '("gnus-")))
+(register-definition-prefixes "gnus-draft" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-dup" "gnus/gnus-dup.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-dup.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-dup" '("gnus-")))
+(register-definition-prefixes "gnus-dup" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-eform" "gnus/gnus-eform.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-eform.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-eform" '("gnus-edit-form")))
+(register-definition-prefixes "gnus-eform" '("gnus-edit-form"))
;;;***
@@ -14402,7 +14722,7 @@ Files matching `gnus-face-omit-files' are not considered." t nil)
(autoload 'gnus-insert-random-face-header "gnus-fun" "\
Insert a random Face header from `gnus-face-directory'." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-fun" '("gnus-")))
+(register-definition-prefixes "gnus-fun" '("gnus-"))
;;;***
@@ -14422,7 +14742,7 @@ If gravatars are already displayed, remove them.
\(fn &optional FORCE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-gravatar" '("gnus-gravatar-")))
+(register-definition-prefixes "gnus-gravatar" '("gnus-gravatar-"))
;;;***
@@ -14448,7 +14768,7 @@ The arguments have the same meaning as those of
\(fn IDS &optional WINDOW-CONF)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-group" '("gnus-")))
+(register-definition-prefixes "gnus-group" '("gnus-"))
;;;***
@@ -14465,7 +14785,7 @@ The arguments have the same meaning as those of
\(fn SUMMARY)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-html" '("gnus-")))
+(register-definition-prefixes "gnus-html" '("gnus-"))
;;;***
@@ -14478,14 +14798,14 @@ The arguments have the same meaning as those of
\(fn HANDLE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-icalendar" '("gnus-icalendar")))
+(register-definition-prefixes "gnus-icalendar" '("gnus-icalendar"))
;;;***
;;;### (autoloads nil "gnus-int" "gnus/gnus-int.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-int.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-int" '("gnus-")))
+(register-definition-prefixes "gnus-int" '("gnus-"))
;;;***
@@ -14498,21 +14818,21 @@ The arguments have the same meaning as those of
Run batched scoring.
Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-kill" '("gnus-")))
+(register-definition-prefixes "gnus-kill" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-logic" "gnus/gnus-logic.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-logic.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-logic" '("gnus-")))
+(register-definition-prefixes "gnus-logic" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-mh" "gnus/gnus-mh.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-mh.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-mh" '("gnus-")))
+(register-definition-prefixes "gnus-mh" '("gnus-"))
;;;***
@@ -14535,11 +14855,14 @@ positive, and disable it if ARG is zero or negative. If called
from Lisp, also enable the mode if ARG is omitted or nil, and
toggle it if ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
\\{gnus-mailing-list-mode-map}
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-ml" '("gnus-mailing-list-")))
+(register-definition-prefixes "gnus-ml" '("gnus-mailing-list-"))
;;;***
@@ -14638,7 +14961,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
\(fn &optional GROUPS NO-CROSSPOST CATCH-ALL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-mlspl" '("gnus-group-split-")))
+(register-definition-prefixes "gnus-mlspl" '("gnus-group-split-"))
;;;***
@@ -14666,7 +14989,7 @@ Like `message-reply'.
(define-mail-user-agent 'gnus-user-agent 'gnus-msg-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-msg" '("gnus-")))
+(register-definition-prefixes "gnus-msg" '("gnus-"))
;;;***
@@ -14683,7 +15006,7 @@ notification using `notifications-notify' for it.
This is typically a function to add in
`gnus-after-getting-new-news-hook'" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-notifications" '("gnus-notifications-")))
+(register-definition-prefixes "gnus-notifications" '("gnus-notifications-"))
;;;***
@@ -14702,7 +15025,7 @@ If picons are already displayed, remove them." t nil)
Display picons in the Newsgroups and Followup-To headers.
If picons are already displayed, remove them." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-picon" '("gnus-picon-")))
+(register-definition-prefixes "gnus-picon" '("gnus-picon-"))
;;;***
@@ -14771,7 +15094,7 @@ Add NUM into sorted LIST by side effect.
\(fn LIST NUM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-range" '("gnus-")))
+(register-definition-prefixes "gnus-range" '("gnus-"))
;;;***
@@ -14782,7 +15105,7 @@ Add NUM into sorted LIST by side effect.
(autoload 'gnus-registry-initialize "gnus-registry" "\
Initialize the Gnus registry." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-registry" '("gnus-")))
+(register-definition-prefixes "gnus-registry" '("gnus-"))
;;;***
@@ -14790,21 +15113,21 @@ Initialize the Gnus registry." t nil)
;;;;;; 0 0))
;;; Generated autoloads from gnus/gnus-rfc1843.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-rfc1843" '("rfc1843-")))
+(register-definition-prefixes "gnus-rfc1843" '("rfc1843-"))
;;;***
;;;### (autoloads nil "gnus-salt" "gnus/gnus-salt.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-salt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-salt" '("gnus-")))
+(register-definition-prefixes "gnus-salt" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-score" "gnus/gnus-score.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-score.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-score" '("gnus-")))
+(register-definition-prefixes "gnus-score" '("gnus-"))
;;;***
@@ -14826,7 +15149,7 @@ See the documentation for these variables and functions for details." t nil)
(autoload 'gnus-sieve-article-add-rule "gnus-sieve" nil t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-sieve" '("gnus-sieve-")))
+(register-definition-prefixes "gnus-sieve" '("gnus-sieve-"))
;;;***
@@ -14838,14 +15161,14 @@ Update the format specification near point.
\(fn VAR)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-spec" '("gnus-")))
+(register-definition-prefixes "gnus-spec" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-srvr" "gnus/gnus-srvr.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-srvr.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-srvr" '("gnus-")))
+(register-definition-prefixes "gnus-srvr" '("gnus-"))
;;;***
@@ -14857,7 +15180,7 @@ Declare back end NAME with ABILITIES as a Gnus back end.
\(fn NAME &rest ABILITIES)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-start" '("gnus-")))
+(register-definition-prefixes "gnus-start" '("gnus-"))
;;;***
@@ -14870,42 +15193,42 @@ BOOKMARK is a bookmark name or a bookmark record.
\(fn BOOKMARK)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-sum" '("gnus-")))
+(register-definition-prefixes "gnus-sum" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-topic" "gnus/gnus-topic.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-topic.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-topic" '("gnus-")))
+(register-definition-prefixes "gnus-topic" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-undo" "gnus/gnus-undo.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-undo.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-undo" '("gnus-")))
+(register-definition-prefixes "gnus-undo" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-util" "gnus/gnus-util.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-util" '("gnus-")))
+(register-definition-prefixes "gnus-util" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-uu" "gnus/gnus-uu.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-uu.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-uu" '("gnus-")))
+(register-definition-prefixes "gnus-uu" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-vm" "gnus/gnus-vm.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-vm.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-vm" '("gnus-")))
+(register-definition-prefixes "gnus-vm" '("gnus-"))
;;;***
@@ -14917,14 +15240,14 @@ Add the window configuration CONF to `gnus-buffer-configuration'.
\(fn CONF)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-win" '("gnus-")))
+(register-definition-prefixes "gnus-win" '("gnus-"))
;;;***
;;;### (autoloads nil "gnutls" "net/gnutls.el" (0 0 0 0))
;;; Generated autoloads from net/gnutls.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnutls" '("gnutls-" "open-gnutls-stream")))
+(register-definition-prefixes "gnutls" '("gnutls-" "open-gnutls-stream"))
;;;***
@@ -14952,7 +15275,7 @@ Use \\[describe-mode] for more info.
\(fn &optional N M)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gomoku" '("gomoku-")))
+(register-definition-prefixes "gomoku" '("gomoku-"))
;;;***
@@ -14986,6 +15309,33 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+\(fn &optional ARG)" t nil)
+
+(put 'global-goto-address-mode 'globalized-minor-mode t)
+
+(defvar global-goto-address-mode nil "\
+Non-nil if Global Goto-Address mode is enabled.
+See the `global-goto-address-mode' command
+for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `global-goto-address-mode'.")
+
+(custom-autoload 'global-goto-address-mode "goto-addr" nil)
+
+(autoload 'global-goto-address-mode "goto-addr" "\
+Toggle Goto-Address mode in all buffers.
+With prefix ARG, enable Global Goto-Address mode if ARG is positive;
+otherwise, disable it. If called from Lisp, enable the mode if
+ARG is omitted or nil.
+
+Goto-Address mode is enabled in all buffers where
+`goto-addr-mode--turn-on' would do it.
+See `goto-address-mode' for more information on Goto-Address mode.
+
\(fn &optional ARG)" t nil)
(autoload 'goto-address-prog-mode "goto-addr" "\
@@ -14996,9 +15346,12 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "goto-addr" '("goto-address-")))
+(register-definition-prefixes "goto-addr" '("goto-addr"))
;;;***
@@ -15020,7 +15373,7 @@ retrieval failed.
\(fn MAIL-ADDRESS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gravatar" '("gravatar-")))
+(register-definition-prefixes "gravatar" '("gravatar-"))
;;;***
@@ -15048,7 +15401,12 @@ by `grep-compute-defaults'; to change the default value, use
The default find command for \\[grep-find].
In interactive usage, the actual value of this variable is set up
by `grep-compute-defaults'; to change the default value, use
-\\[customize] or call the function `grep-apply-setting'.")
+\\[customize] or call the function `grep-apply-setting'.
+
+This variable can either be a string, or a cons of the
+form (COMMAND . POSITION). In the latter case, COMMAND will be
+used as the default command, and point will be placed at POSITION
+for easier editing.")
(custom-autoload 'grep-find-command "grep" nil)
@@ -15208,14 +15566,14 @@ command before it's run.
(defalias 'rzgrep 'zrgrep)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "grep" '("grep-" "kill-grep" "rgrep-")))
+(register-definition-prefixes "grep" '("grep-" "kill-grep" "rgrep-"))
;;;***
;;;### (autoloads nil "gssapi" "gnus/gssapi.el" (0 0 0 0))
;;; Generated autoloads from gnus/gssapi.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gssapi" '("gssapi-program" "open-gssapi-stream")))
+(register-definition-prefixes "gssapi" '("gssapi-program" "open-gssapi-stream"))
;;;***
@@ -15325,9 +15683,12 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gud" '("gdb-" "gud-")))
+(register-definition-prefixes "gud" '("gdb-" "gud-"))
;;;***
@@ -15376,9 +15737,13 @@ arguments as NAME. DO is a function as defined in `gv-get'.
\(fn SYMBOL NAME ARGS HANDLER &optional FIX)" nil nil)
-(or (assq 'gv-expander defun-declarations-alist) (let ((x `(gv-expander ,(apply-partially #'gv--defun-declaration 'gv-expander)))) (push x macro-declarations-alist) (push x defun-declarations-alist)))
+(defsubst gv--expander-defun-declaration (&rest args) (apply #'gv--defun-declaration 'gv-expander args))
+
+(defsubst gv--setter-defun-declaration (&rest args) (apply #'gv--defun-declaration 'gv-setter args))
+
+(or (assq 'gv-expander defun-declarations-alist) (let ((x (list 'gv-expander #'gv--expander-defun-declaration))) (push x macro-declarations-alist) (push x defun-declarations-alist)))
-(or (assq 'gv-setter defun-declarations-alist) (push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter)) defun-declarations-alist))
+(or (assq 'gv-setter defun-declarations-alist) (push (list 'gv-setter #'gv--setter-defun-declaration) defun-declarations-alist))
(autoload 'gv-define-setter "gv" "\
Define a setter method for generalized variable NAME.
@@ -15431,7 +15796,7 @@ binding mode.
\(fn PLACE)" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gv" '("gv-")))
+(register-definition-prefixes "gv" '("gv-"))
;;;***
@@ -15448,7 +15813,7 @@ Variables: `handwrite-linespace' (default 12)
`handwrite-numlines' (default 60)
`handwrite-pagenumbering' (default nil)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "handwrite" '("handwrite-" "menu-bar-handwrite-map")))
+(register-definition-prefixes "handwrite" '("handwrite-" "menu-bar-handwrite-map"))
;;;***
@@ -15456,7 +15821,7 @@ Variables: `handwrite-linespace' (default 12)
;;;;;; 0 0))
;;; Generated autoloads from language/hanja-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hanja-util" '("han")))
+(register-definition-prefixes "hanja-util" '("han"))
;;;***
@@ -15481,7 +15846,7 @@ This is, necessarily (as of Emacs 20.3), a crock. When the
current-time interface is made s2G-compliant, hanoi.el will need
to be updated." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hanoi" '("hanoi-")))
+(register-definition-prefixes "hanoi" '("hanoi-"))
;;;***
@@ -15525,7 +15890,7 @@ Prefix arg sets default accept amount temporarily.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hashcash" '("hashcash-")))
+(register-definition-prefixes "hashcash" '("hashcash-"))
;;;***
@@ -15555,6 +15920,9 @@ the `kbd-help' property at point. If `kbd-help' does not produce
a string, but the `help-echo' property does, then that string is
printed instead.
+The string is passed through `substitute-command-keys' before it
+is displayed.
+
A numeric argument ARG prevents display of a message in case
there is no help. While ARG can be used interactively, it is
mainly meant for use from Lisp.
@@ -15581,6 +15949,10 @@ included in this list. Suggested properties are `keymap',
`local-map', `button' and `kbd-help'. Any value other than t or
a non-empty list disables the feature.
+The text printed from the `help-echo' property is often only
+relevant when using the mouse. The presence of a `kbd-help'
+property guarantees that non mouse specific help is available.
+
This variable only takes effect after a call to
`help-at-pt-set-timer'. The help gets printed after Emacs has
been idle for `help-at-pt-timer-delay' seconds. You can call
@@ -15648,7 +16020,7 @@ different regions. With numeric argument ARG, behaves like
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "help-at-pt" '("help-at-pt-" "scan-buf-move-hook")))
+(register-definition-prefixes "help-at-pt" '("help-at-pt-" "scan-buf-move-hook"))
;;;***
@@ -15740,6 +16112,43 @@ BUFFER should be a buffer or a buffer name.
\(fn &optional BUFFER)" t nil)
+(autoload 'describe-keymap "help-fns" "\
+Describe key bindings in KEYMAP.
+When called interactively, prompt for a variable that has a
+keymap value.
+
+\(fn KEYMAP)" t nil)
+
+(autoload 'describe-mode "help-fns" "\
+Display documentation of current major mode and minor modes.
+A brief summary of the minor modes comes first, followed by the
+major mode description. This is followed by detailed
+descriptions of the minor modes, each on a separate page.
+
+For this to work correctly for a minor mode, the mode's indicator
+variable (listed in `minor-mode-alist') must also be a function
+whose documentation describes the minor mode.
+
+If called from Lisp with a non-nil BUFFER argument, display
+documentation for the major and minor modes of that buffer.
+
+\(fn &optional BUFFER)" t nil)
+
+(autoload 'describe-widget "help-fns" "\
+Display a buffer with information about a widget.
+You can use this command to describe buttons (e.g., the links in a *Help*
+buffer), editable fields of the customization buffers, etc.
+
+Interactively, click on a widget to describe it, or hit RET to describe the
+widget at point.
+
+When called from Lisp, POS may be a buffer position or a mouse position list.
+
+Calls each function of the list `describe-widget-functions' in turn, until
+one of them returns non-nil.
+
+\(fn &optional POS)" t nil)
+
(autoload 'doc-file-to-man "help-fns" "\
Produce an nroff buffer containing the doc-strings from the DOC file.
@@ -15750,7 +16159,7 @@ Produce a texinfo buffer with sorted doc-strings from the DOC file.
\(fn FILE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "help-fns" '("describe-" "help-")))
+(register-definition-prefixes "help-fns" '("describe-" "help-"))
;;;***
@@ -15766,7 +16175,7 @@ gives the window that lists the options.")
(custom-autoload 'three-step-help "help-macro" t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "help-macro" '("make-help-screen")))
+(register-definition-prefixes "help-macro" '("make-help-screen"))
;;;***
@@ -15782,10 +16191,10 @@ Commands:
\(fn)" t nil)
(autoload 'help-mode-setup "help-mode" "\
-Enter Help Mode in the current buffer." nil nil)
+Enter Help mode in the current buffer." nil nil)
(autoload 'help-mode-finish "help-mode" "\
-Finalize Help Mode setup in current buffer." nil nil)
+Finalize Help mode setup in current buffer." nil nil)
(autoload 'help-setup-xref "help-mode" "\
Invoked from commands using the \"*Help*\" buffer to install some xref info.
@@ -15863,7 +16272,7 @@ BOOKMARK is a bookmark name or a bookmark record.
\(fn BOOKMARK)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "help-mode" '("describe-symbol-backends" "help-")))
+(register-definition-prefixes "help-mode" '("describe-symbol-backends" "help-"))
;;;***
@@ -15876,14 +16285,14 @@ Describe local key bindings of current mode." t nil)
(autoload 'Helper-help "helper" "\
Provide help for current mode." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "helper" '("Helper-")))
+(register-definition-prefixes "helper" '("Helper-"))
;;;***
;;;### (autoloads nil "hex-util" "hex-util.el" (0 0 0 0))
;;; Generated autoloads from hex-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hex-util" '("decode-hex-string" "encode-hex-string")))
+(register-definition-prefixes "hex-util" '("decode-hex-string" "encode-hex-string"))
;;;***
@@ -15977,7 +16386,7 @@ and edit the file in `hexl-mode'.
Convert a binary buffer to hexl format.
This discards the buffer's undo information." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hexl" '("dehexlify-buffer" "hexl-")))
+(register-definition-prefixes "hexl" '("dehexlify-buffer" "hexl-"))
;;;***
@@ -15985,7 +16394,7 @@ This discards the buffer's undo information." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from hfy-cmap.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hfy-cmap" '("hfy-" "htmlfontify-unload-rgb-file")))
+(register-definition-prefixes "hfy-cmap" '("hfy-" "htmlfontify-unload-rgb-file"))
;;;***
@@ -16000,6 +16409,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Hi Lock mode is automatically enabled when you invoke any of the
highlighting commands listed below, such as \\[highlight-regexp].
To enable Hi Lock mode in all buffers, use `global-hi-lock-mode'
@@ -16097,6 +16509,9 @@ of text in those lines.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type.
@@ -16112,6 +16527,13 @@ Use the global history list for FACE. Limit face setting to the
corresponding SUBEXP (interactively, the prefix argument) of REGEXP.
If SUBEXP is omitted or nil, the entire REGEXP is highlighted.
+LIGHTER is a human-readable string that can be used to select
+a regexp to unhighlight by its name instead of selecting a possibly
+complex regexp or closure.
+
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type. The Font Lock mode
@@ -16119,7 +16541,7 @@ is considered \"enabled\" in a buffer if its `major-mode'
causes `font-lock-specified-p' to return non-nil, which means
the major mode specifies support for Font Lock.
-\(fn REGEXP &optional FACE SUBEXP)" t nil)
+\(fn REGEXP &optional FACE SUBEXP LIGHTER)" t nil)
(defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
@@ -16128,9 +16550,9 @@ Set face of each match of phrase REGEXP to FACE.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
-When called interactively, replace whitespace in user-provided
-regexp with arbitrary whitespace, and make initial lower-case
-letters case-insensitive, before highlighting with `hi-lock-set-pattern'.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+Also set `search-spaces-regexp' to the value of `search-whitespace-regexp'.
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
@@ -16149,6 +16571,9 @@ Uses the next face from `hi-lock-face-defaults' without prompting,
unless you use a prefix argument.
Uses `find-tag-default-as-symbol-regexp' to retrieve the symbol at point.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
This uses Font lock mode if it is enabled; otherwise it uses overlays,
in which case the highlighting will not update as you type. The Font
Lock mode is considered \"enabled\" in a buffer if its `major-mode'
@@ -16173,10 +16598,7 @@ Interactively added patterns are those normally specified using
`highlight-regexp' and `highlight-lines-matching-regexp'; they can
be found in variable `hi-lock-interactive-patterns'." t nil)
-(autoload 'hi-lock-find-patterns "hi-lock" "\
-Add patterns from the current buffer to the list of hi-lock patterns." t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hi-lock" '("hi-lock-" "turn-on-hi-lock-if-enabled")))
+(register-definition-prefixes "hi-lock" '("hi-lock-" "turn-on-hi-lock-if-enabled"))
;;;***
@@ -16191,6 +16613,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Hide-Ifdef mode is a buffer-local minor mode for use with C and
C-like major modes. When enabled, code within #ifdef constructs
that the C preprocessor would eliminate may be hidden from view.
@@ -16227,7 +16652,7 @@ Several variables affect how the hiding is done:
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hideif" '("backward-ifdef" "down-ifdef" "forward-ifdef" "hide-ifdef" "hif-" "intern-safe" "next-ifdef" "previous-ifdef" "show-ifdef" "up-ifdef")))
+(register-definition-prefixes "hideif" '("backward-ifdef" "down-ifdef" "forward-ifdef" "hide-ifdef" "hif-" "intern-safe" "next-ifdef" "previous-ifdef" "show-ifdef" "up-ifdef"))
;;;***
@@ -16270,6 +16695,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When hideshow minor mode is on, the menu bar is augmented with hideshow
commands and the hideshow commands are enabled.
The value (hs . t) is added to `buffer-invisibility-spec'.
@@ -16291,7 +16719,15 @@ Key bindings:
(autoload 'turn-off-hideshow "hideshow" "\
Unconditionally turn off `hs-minor-mode'." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hideshow" '("hs-")))
+(register-definition-prefixes "hideshow" '("hs-"))
+
+;;;***
+
+;;;### (autoloads nil "hierarchy" "emacs-lisp/hierarchy.el" (0 0
+;;;;;; 0 0))
+;;; Generated autoloads from emacs-lisp/hierarchy.el
+
+(register-definition-prefixes "hierarchy" '("hierarchy-"))
;;;***
@@ -16306,6 +16742,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When Highlight Changes is enabled, changes are marked with a text
property. Normally they are displayed in a distinctive face, but
command \\[highlight-changes-visible-mode] can be used to toggle
@@ -16331,6 +16770,9 @@ is positive, and disable it if ARG is zero or negative. If called
from Lisp, also enable the mode if ARG is omitted or nil, and toggle
it if ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Highlight Changes Visible mode only has an effect when Highlight
Changes mode is on. When enabled, the changed text is displayed
in a distinctive face.
@@ -16425,13 +16867,12 @@ See `highlight-changes-mode' for more information on Highlight-Changes mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hilit-chg" '("global-highlight-changes" "highlight-" "hilit-chg-")))
+(register-definition-prefixes "hilit-chg" '("highlight-" "hilit-chg-"))
;;;***
;;;### (autoloads nil "hippie-exp" "hippie-exp.el" (0 0 0 0))
;;; Generated autoloads from hippie-exp.el
-(push (purecopy '(hippie-exp 1 6)) package--builtin-versions)
(defvar hippie-expand-try-functions-list '(try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially try-complete-lisp-symbol) "\
The list of expansion functions tried in order by `hippie-expand'.
@@ -16459,7 +16900,7 @@ argument VERBOSE non-nil makes the function verbose.
\(fn TRY-LIST &optional VERBOSE)" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hippie-exp" '("he-" "hippie-expand-" "try-")))
+(register-definition-prefixes "hippie-exp" '("he-" "hippie-expand-" "try-"))
;;;***
@@ -16474,6 +16915,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Hl-Line mode is a buffer-local minor mode. If
`hl-line-sticky-flag' is non-nil, Hl-Line mode highlights the
line about the buffer's point in all windows. Caveat: the
@@ -16506,6 +16950,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode
highlights the line about the current buffer's point in all live
windows.
@@ -16515,21 +16962,21 @@ and `global-hl-line-maybe-unhighlight' on `post-command-hook'.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hl-line" '("global-hl-line-" "hl-line-")))
+(register-definition-prefixes "hl-line" '("global-hl-line-" "hl-line-"))
;;;***
;;;### (autoloads nil "hmac-def" "net/hmac-def.el" (0 0 0 0))
;;; Generated autoloads from net/hmac-def.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hmac-def" '("define-hmac-function")))
+(register-definition-prefixes "hmac-def" '("define-hmac-function"))
;;;***
;;;### (autoloads nil "hmac-md5" "net/hmac-md5.el" (0 0 0 0))
;;; Generated autoloads from net/hmac-md5.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hmac-md5" '("hmac-md5" "md5-binary")))
+(register-definition-prefixes "hmac-md5" '("hmac-md5" "md5-binary"))
;;;***
@@ -16641,7 +17088,7 @@ The optional LABEL is used to label the buffer created.
(defalias 'holiday-list 'list-holidays)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "holidays" '("calendar-" "holiday-")))
+(register-definition-prefixes "holidays" '("calendar-" "holiday-"))
;;;***
@@ -16677,7 +17124,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'.
\(fn SRCDIR DSTDIR &optional F-EXT L-EXT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "htmlfontify" '("hfy-" "htmlfontify-")))
+(register-definition-prefixes "htmlfontify" '("hfy-" "htmlfontify-"))
;;;***
@@ -16685,7 +17132,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'.
;;;;;; (0 0 0 0))
;;; Generated autoloads from ibuf-ext.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ibuf-ext" '("alphabetic" "basename" "content" "derived-mode" "directory" "eval" "file" "ibuffer-" "major-mode" "mod" "name" "predicate" "print" "process" "query-replace" "rename-uniquely" "replace-regexp" "revert" "shell-command-" "size" "starred-name" "used-mode" "view-and-eval" "visiting-file")))
+(register-definition-prefixes "ibuf-ext" '("alphabetic" "basename" "content" "derived-mode" "directory" "eval" "file" "ibuffer-" "major-mode" "mod" "name" "predicate" "print" "process" "query-replace" "rename-uniquely" "replace-regexp" "revert" "shell-command-" "size" "starred-name" "used-mode" "view-and-eval" "visiting-file"))
;;;***
@@ -16799,7 +17246,7 @@ bound to the current value of the filter.
(function-put 'define-ibuffer-filter 'doc-string-elt '2)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ibuf-macs" '("ibuffer-")))
+(register-definition-prefixes "ibuf-macs" '("ibuffer-"))
;;;***
@@ -16846,14 +17293,13 @@ If optional arg OTHER-WINDOW is non-nil, then use another window.
\(fn &optional OTHER-WINDOW)" t nil)
-(if (fboundp 'register-definition-prefixes) (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" "size"))
;;;***
;;;### (autoloads nil "icalendar" "calendar/icalendar.el" (0 0 0
;;;;;; 0))
;;; Generated autoloads from calendar/icalendar.el
-(push (purecopy '(icalendar 0 19)) package--builtin-versions)
(autoload 'icalendar-export-file "icalendar" "\
Export diary file to iCalendar format.
@@ -16902,7 +17348,7 @@ buffer `*icalendar-errors*'.
\(fn &optional DIARY-FILENAME DO-NOT-ASK NON-MARKING)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "icalendar" '("icalendar-")))
+(register-definition-prefixes "icalendar" '("icalendar-"))
;;;***
@@ -16927,6 +17373,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
This global minor mode makes minibuffer completion behave
more like `ido-mode' than regular `icomplete-mode'.
@@ -16950,6 +17399,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When this global minor mode is enabled, typing in the minibuffer
continuously displays a list of possible completions that match
the string you have typed. See `icomplete-completions' for a
@@ -16969,7 +17421,7 @@ completions:
(make-obsolete 'iswitchb-mode
"use `icomplete-mode' or `ido-mode' instead." "24.4"))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "icomplete" '("icomplete-")))
+(register-definition-prefixes "icomplete" '("icomplete-"))
;;;***
@@ -17011,7 +17463,7 @@ with no args, if that value is non-nil.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "icon" '("beginning-of-icon-defun" "calculate-icon-indent" "electric-icon-brace" "end-of-icon-defun" "icon-" "indent-icon-exp" "mark-icon-function")))
+(register-definition-prefixes "icon" '("beginning-of-icon-defun" "calculate-icon-indent" "electric-icon-brace" "end-of-icon-defun" "icon-" "indent-icon-exp" "mark-icon-function"))
;;;***
@@ -17019,7 +17471,7 @@ with no args, if that value is non-nil.
;;;;;; (0 0 0 0))
;;; Generated autoloads from progmodes/idlw-complete-structtag.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlw-complete-structtag" '("idlwave-")))
+(register-definition-prefixes "idlw-complete-structtag" '("idlwave-"))
;;;***
@@ -17027,7 +17479,7 @@ with no args, if that value is non-nil.
;;;;;; 0))
;;; Generated autoloads from progmodes/idlw-help.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlw-help" '("idlwave-")))
+(register-definition-prefixes "idlw-help" '("idlwave-"))
;;;***
@@ -17055,7 +17507,7 @@ See also the variable `idlwave-shell-prompt-pattern'.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlw-shell" '("idlwave-")))
+(register-definition-prefixes "idlw-shell" '("idlwave-"))
;;;***
@@ -17063,7 +17515,7 @@ See also the variable `idlwave-shell-prompt-pattern'.
;;;;;; (0 0 0 0))
;;; Generated autoloads from progmodes/idlw-toolbar.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlw-toolbar" '("idlwave-toolbar-")))
+(register-definition-prefixes "idlw-toolbar" '("idlwave-toolbar-"))
;;;***
@@ -17172,7 +17624,6 @@ The main features of this mode are
8. Hooks
-----
- Loading idlwave.el runs `idlwave-load-hook'.
Turning on `idlwave-mode' runs `idlwave-mode-hook'.
9. Documentation and Customization
@@ -17181,7 +17632,7 @@ The main features of this mode are
\\[idlwave-info] to display (complain to your sysadmin if that does
not work). For Postscript, PDF, and HTML versions of the
documentation, check IDLWAVE's homepage at URL
- `http://github.com/jdtsmith/idlwave'.
+ `https://github.com/jdtsmith/idlwave'.
IDLWAVE has customize support - see the group `idlwave'.
10.Keybindings
@@ -17194,7 +17645,7 @@ The main features of this mode are
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlwave" '("idlwave-")))
+(register-definition-prefixes "idlwave" '("idlwave-"))
;;;***
@@ -17454,7 +17905,7 @@ DEF, if non-nil, is the default value.
\(fn PROMPT CHOICES &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF INHERIT-INPUT-METHOD)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ido" '("ido-")))
+(register-definition-prefixes "ido" '("ido-"))
;;;***
@@ -17469,14 +17920,14 @@ See `inferior-emacs-lisp-mode' for details.
\(fn &optional BUF-NAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ielm" '("ielm-" "inferior-emacs-lisp-mode")))
+(register-definition-prefixes "ielm" '("ielm-" "inferior-emacs-lisp-mode"))
;;;***
;;;### (autoloads nil "ietf-drums" "mail/ietf-drums.el" (0 0 0 0))
;;; Generated autoloads from mail/ietf-drums.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ietf-drums" '("ietf-drums-")))
+(register-definition-prefixes "ietf-drums" '("ietf-drums-"))
;;;***
@@ -17493,11 +17944,14 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\\{iimage-mode-map}
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "iimage" '("iimage-" "turn-off-iimage-mode")))
+(register-definition-prefixes "iimage" '("iimage-" "turn-off-iimage-mode"))
;;;***
@@ -17697,7 +18151,7 @@ recognizes these files as having image type `imagemagick'.
If Emacs is compiled without ImageMagick support, this does nothing." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "image" '("image" "unknown-image-type")))
+(register-definition-prefixes "image" '("image" "unknown-image-type"))
;;;***
@@ -17705,7 +18159,7 @@ If Emacs is compiled without ImageMagick support, this does nothing." nil nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from image/image-converter.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "image-converter" '("image-convert")))
+(register-definition-prefixes "image-converter" '("image-convert"))
;;;***
@@ -17801,6 +18255,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
(define-obsolete-function-alias 'image-dired-setup-dired-keybindings 'image-dired-minor-mode "26.1")
@@ -17837,7 +18294,7 @@ Edit comment and tags of current or marked image files.
Edit comment and tags for all marked image files in an
easy-to-use form." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "image-dired" '("image-dired-")))
+(register-definition-prefixes "image-dired" '("image-dired-"))
;;;***
@@ -17897,13 +18354,16 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
An image file is one whose name has an extension in
`image-file-name-extensions', or matches a regexp in
`image-file-name-regexps'.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "image-file" '("image-file-")))
+(register-definition-prefixes "image-file" '("image-file-"))
;;;***
@@ -17926,6 +18386,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
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.
@@ -17942,14 +18405,14 @@ displays an image file as text." nil nil)
\(fn BMK)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "image-mode" '("image-")))
+(register-definition-prefixes "image-mode" '("image-"))
;;;***
;;;### (autoloads nil "imap" "net/imap.el" (0 0 0 0))
;;; Generated autoloads from net/imap.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "imap" '("imap-")))
+(register-definition-prefixes "imap" '("imap-"))
;;;***
@@ -18087,7 +18550,7 @@ for more information.
\(fn INDEX-ITEM)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "imenu" '("imenu-")))
+(register-definition-prefixes "imenu" '("imenu-"))
;;;***
@@ -18119,7 +18582,7 @@ Convert old Emacs Devanagari characters to UCS.
\(fn FROM TO)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ind-util" '("indian-" "is13194-")))
+(register-definition-prefixes "ind-util" '("indian-" "is13194-"))
;;;***
@@ -18139,7 +18602,7 @@ of `inferior-lisp-program'). Runs the hooks from
(defalias 'run-lisp 'inferior-lisp)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "inf-lisp" '("inferior-lisp-" "lisp-" "switch-to-lisp")))
+(register-definition-prefixes "inf-lisp" '("inferior-lisp-" "lisp-" "switch-to-lisp"))
;;;***
@@ -18282,6 +18745,7 @@ Moving within a node:
already visible, try to go to the previous menu entry, or up
if there is none.
\\[beginning-of-buffer] Go to beginning of node.
+\\[end-of-buffer] Go to end of node.
Advanced commands:
\\[Info-search] Search through this Info file for specified regexp,
@@ -18343,7 +18807,7 @@ completion alternatives to currently visited manuals.
\(fn MANUAL)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "info" '("Info-" "info-")))
+(register-definition-prefixes "info" '("Info-" "info-"))
;;;***
@@ -18390,7 +18854,7 @@ Perform completion on file preceding point.
\(fn &optional MODE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "info-look" '("info-")))
+(register-definition-prefixes "info-look" '("info-"))
;;;***
@@ -18471,7 +18935,7 @@ the sources handy.
\(fn FILENAME-LIST)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "info-xref" '("info-xref-")))
+(register-definition-prefixes "info-xref" '("info-xref-"))
;;;***
@@ -18512,7 +18976,7 @@ Must be used only with -batch, and kills Emacs on completion.
Each file will be processed even if an error occurred previously.
For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "informat" '("Info-validate-")))
+(register-definition-prefixes "informat" '("Info-validate-"))
;;;***
@@ -18531,7 +18995,7 @@ See Info node `(elisp)Defining Functions' for more details.
(function-put 'define-inline 'doc-string-elt '3)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "inline" '("inline-")))
+(register-definition-prefixes "inline" '("inline-"))
;;;***
@@ -18545,7 +19009,7 @@ Only checks one based on which kind of Emacs is being run.
\(fn EMACS-VER XEMACS-VER SXEMACS-VER)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "inversion" '("inversion-")))
+(register-definition-prefixes "inversion" '("inversion-"))
;;;***
@@ -18564,7 +19028,7 @@ Toggle input method in interactive search." t nil)
\(fn LAST-CHAR &optional COUNT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "isearch-x" '("isearch-")))
+(register-definition-prefixes "isearch-x" '("isearch-"))
;;;***
@@ -18578,7 +19042,7 @@ Executing this command again will terminate the search; or, if
the search has not yet begun, will toggle to the last buffer
accessed via isearchb." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "isearchb" '("isearchb")))
+(register-definition-prefixes "isearchb" '("isearchb"))
;;;***
@@ -18586,7 +19050,7 @@ accessed via isearchb." t nil)
;;;;;; 0 0 0))
;;; Generated autoloads from international/iso-ascii.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "iso-ascii" '("iso-ascii-")))
+(register-definition-prefixes "iso-ascii" '("iso-ascii-"))
;;;***
@@ -18677,7 +19141,7 @@ Warn that format is write-only.
(autoload 'iso-cvt-define-menu "iso-cvt" "\
Add submenus to the File menu, to convert to and from various formats." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "iso-cvt" '("iso-")))
+(register-definition-prefixes "iso-cvt" '("iso-"))
;;;***
@@ -18687,14 +19151,14 @@ Add submenus to the File menu, to convert to and from various formats." t nil)
(define-key key-translation-map "\C-x8" 'iso-transl-ctl-x-8-map)
(autoload 'iso-transl-ctl-x-8-map "iso-transl" "Keymap for C-x 8 prefix." t 'keymap)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "iso-transl" '("iso-transl-")))
+(register-definition-prefixes "iso-transl" '("iso-transl-"))
;;;***
;;;### (autoloads nil "iso8601" "calendar/iso8601.el" (0 0 0 0))
;;; Generated autoloads from calendar/iso8601.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "iso8601" '("iso8601-")))
+(register-definition-prefixes "iso8601" '("iso8601-"))
;;;***
@@ -18827,7 +19291,16 @@ amount for last line processed.
\(fn REG-START REG-END &optional RECHECKP SHIFT)" t nil)
(autoload 'ispell-comments-and-strings "ispell" "\
-Check comments and strings in the current buffer for spelling errors." t nil)
+Check comments and strings in the current buffer for spelling errors.
+If called interactively with an active region, check only comments and
+strings in the region.
+When called from Lisp, START and END buffer positions can be provided
+to limit the check.
+
+\(fn &optional START END)" t nil)
+
+(autoload 'ispell-comment-or-string-at-point "ispell" "\
+Check the comment or string containing point for spelling errors." t nil)
(autoload 'ispell-buffer "ispell" "\
Check the current buffer for spelling errors interactively." t nil)
@@ -18871,6 +19344,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Ispell minor mode is a buffer-local minor mode. When enabled,
typing SPC or RET warns you if the previous word is incorrectly
spelled.
@@ -18904,7 +19380,7 @@ You can bind this to the key C-c i in GNUS or mail by adding to
`news-reply-mode-hook' or `mail-mode-hook' the following lambda expression:
(function (lambda () (local-set-key \"\\C-ci\" \\='ispell-message)))" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ispell" '("check-ispell-version" "ispell-")))
+(register-definition-prefixes "ispell" '("check-ispell-version" "ispell-"))
;;;***
@@ -18912,7 +19388,7 @@ You can bind this to the key C-c i in GNUS or mail by adding to
;;;;;; (0 0 0 0))
;;; Generated autoloads from international/ja-dic-cnv.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ja-dic-cnv" '("batch-skkdic-convert" "ja-dic-filename" "skkdic-")))
+(register-definition-prefixes "ja-dic-cnv" '("batch-skkdic-convert" "ja-dic-filename" "skkdic-"))
;;;***
@@ -18920,7 +19396,7 @@ You can bind this to the key C-c i in GNUS or mail by adding to
;;;;;; (0 0 0 0))
;;; Generated autoloads from international/ja-dic-utl.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ja-dic-utl" '("skkdic-")))
+(register-definition-prefixes "ja-dic-utl" '("skkdic-"))
;;;***
@@ -18997,7 +19473,7 @@ If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
\(fn PROMPT &optional INITIAL-INPUT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "japan-util" '("japanese-")))
+(register-definition-prefixes "japan-util" '("japanese-"))
;;;***
@@ -19020,7 +19496,7 @@ 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)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "jka-compr" '("compression-error" "jka-compr-")))
+(register-definition-prefixes "jka-compr" '("compression-error" "jka-compr-"))
;;;***
@@ -19051,30 +19527,30 @@ one of the aforementioned options instead of using this mode.
(dolist (name (list "node" "nodejs" "gjs" "rhino")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'js-mode)))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "js" '("js-" "with-js")))
+(register-definition-prefixes "js" '("js-" "with-js"))
;;;***
;;;### (autoloads nil "json" "json.el" (0 0 0 0))
;;; Generated autoloads from json.el
-(push (purecopy '(json 1 4)) package--builtin-versions)
+(push (purecopy '(json 1 5)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "json" '("json-")))
+(register-definition-prefixes "json" '("json-"))
;;;***
;;;### (autoloads nil "jsonrpc" "jsonrpc.el" (0 0 0 0))
;;; Generated autoloads from jsonrpc.el
-(push (purecopy '(jsonrpc 1 0 9)) package--builtin-versions)
+(push (purecopy '(jsonrpc 1 0 12)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "jsonrpc" '("jrpc-default-request-timeout" "jsonrpc-")))
+(register-definition-prefixes "jsonrpc" '("jsonrpc-"))
;;;***
;;;### (autoloads nil "kermit" "kermit.el" (0 0 0 0))
;;; Generated autoloads from kermit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "kermit" '("kermit-")))
+(register-definition-prefixes "kermit" '("kermit-"))
;;;***
@@ -19153,7 +19629,7 @@ the context of text formatting.
\(fn LINEBEG)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "kinsoku" '("kinsoku-")))
+(register-definition-prefixes "kinsoku" '("kinsoku-"))
;;;***
@@ -19177,7 +19653,7 @@ and the return value is the length of the conversion.
\(fn FROM TO)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "kkc" '("kkc-")))
+(register-definition-prefixes "kkc" '("kkc-"))
;;;***
@@ -19301,7 +19777,7 @@ Create lambda form for macro bound to symbol or key.
\(fn MAC &optional COUNTER FORMAT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "kmacro" '("kmacro-")))
+(register-definition-prefixes "kmacro" '("kmacro-"))
;;;***
@@ -19315,7 +19791,7 @@ The kind of Korean keyboard for Korean input method.
(autoload 'setup-korean-environment-internal "korea-util" nil nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "korea-util" '("exit-korean-environment" "isearch-" "korean-key-bindings" "quail-hangul-switch-" "toggle-korean-input-method")))
+(register-definition-prefixes "korea-util" '("exit-korean-environment" "isearch-" "korean-key-bindings" "quail-hangul-switch-" "toggle-korean-input-method"))
;;;***
@@ -19354,7 +19830,7 @@ Transcribe Romanized Lao string STR to Lao character string.
\(fn FROM TO)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lao-util" '("lao-")))
+(register-definition-prefixes "lao-util" '("lao-"))
;;;***
@@ -19388,7 +19864,7 @@ coding system names is determined from `latex-inputenc-coding-alist'.
\(fn ARG-LIST)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "latexenc" '("latexenc-dont-use-")))
+(register-definition-prefixes "latexenc" '("latexenc-dont-use-"))
;;;***
@@ -19432,7 +19908,7 @@ use either \\[customize] or the function `latin1-display'.")
(custom-autoload 'latin1-display-ucs-per-lynx "latin1-disp" nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "latin1-disp" '("latin1-display-")))
+(register-definition-prefixes "latin1-disp" '("latin1-display-"))
;;;***
@@ -19445,14 +19921,14 @@ A major mode to edit GNU ld script files
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ld-script" '("ld-script-")))
+(register-definition-prefixes "ld-script" '("ld-script-"))
;;;***
;;;### (autoloads nil "ldap" "net/ldap.el" (0 0 0 0))
;;; Generated autoloads from net/ldap.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ldap" '("ldap-")))
+(register-definition-prefixes "ldap" '("ldap-"))
;;;***
@@ -19460,7 +19936,7 @@ A major mode to edit GNU ld script files
;;;;;; (0 0 0 0))
;;; Generated autoloads from gnus/legacy-gnus-agent.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "legacy-gnus-agent" '("gnus-agent-")))
+(register-definition-prefixes "legacy-gnus-agent" '("gnus-agent-"))
;;;***
@@ -19484,7 +19960,7 @@ Special commands:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "less-css-mode" '("less-css-")))
+(register-definition-prefixes "less-css-mode" '("less-css-"))
;;;***
@@ -19526,7 +20002,7 @@ displayed in the example above.
(function-put 'let-alist 'lisp-indent-function '1)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "let-alist" '("let-alist--")))
+(register-definition-prefixes "let-alist" '("let-alist--"))
;;;***
@@ -19535,19 +20011,22 @@ displayed in the example above.
(autoload 'life "life" "\
Run Conway's Life simulation.
-The starting pattern is randomly selected. Prefix arg (optional first
-arg non-nil from a program) is the number of seconds to sleep between
-generations (this defaults to 1).
+The starting pattern is randomly selected from `life-patterns'.
+
+Prefix arg is the number of tenths of a second to sleep between
+generations (the default is `life-step-time').
+
+When called from Lisp, optional argument STEP-TIME is the time to
+sleep in seconds.
-\(fn &optional SLEEPTIME)" t nil)
+\(fn &optional STEP-TIME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "life" '("life-")))
+(register-definition-prefixes "life" '("life-"))
;;;***
;;;### (autoloads nil "linum" "linum.el" (0 0 0 0))
;;; Generated autoloads from linum.el
-(push (purecopy '(linum 0 9 24)) package--builtin-versions)
(autoload 'linum-mode "linum" "\
Toggle display of line numbers in the left margin (Linum mode).
@@ -19557,6 +20036,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Linum mode is a buffer-local minor mode.
\(fn &optional ARG)" t nil)
@@ -19585,7 +20067,7 @@ See `linum-mode' for more information on Linum mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "linum" '("linum-")))
+(register-definition-prefixes "linum" '("linum-"))
;;;***
@@ -19593,7 +20075,7 @@ See `linum-mode' for more information on Linum mode.
;;;;;; 0))
;;; Generated autoloads from emacs-lisp/lisp-mnt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lisp-mnt" '("lm-")))
+(register-definition-prefixes "lisp-mnt" '("lm-"))
;;;***
@@ -19626,7 +20108,7 @@ something strange, such as redefining an Emacs function.
\(fn FEATURE &optional FORCE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "loadhist" '("feature-" "file-" "loadhist-" "read-feature" "unload-")))
+(register-definition-prefixes "loadhist" '("feature-" "file-" "loadhist-" "read-feature" "unload-"))
;;;***
@@ -19680,7 +20162,7 @@ except that FILTER is not optional.
\(fn SEARCH-STRING FILTER &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "locate" '("locate-")))
+(register-definition-prefixes "locate" '("locate-"))
;;;***
@@ -19713,7 +20195,7 @@ done. Otherwise, it uses the current buffer.
\(fn CALLBACK &optional SETUP PARAMS BUFFER MODE &rest IGNORE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "log-edit" '("log-edit-" "vc-log-")))
+(register-definition-prefixes "log-edit" '("log-edit-"))
;;;***
@@ -19725,7 +20207,7 @@ Major mode for browsing CVS log output.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "log-view" '("log-view-")))
+(register-definition-prefixes "log-view" '("log-view-"))
;;;***
@@ -19818,7 +20300,7 @@ for further customization of the printer command.
\(fn START END)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lpr" '("lpr-" "print")))
+(register-definition-prefixes "lpr" '("lpr-" "print"))
;;;***
@@ -19831,7 +20313,7 @@ Otherwise they are treated as Emacs regexps (for backward compatibility).")
(custom-autoload 'ls-lisp-support-shell-wildcards "ls-lisp" t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ls-lisp" '("ls-lisp-")))
+(register-definition-prefixes "ls-lisp" '("ls-lisp-"))
;;;***
@@ -19845,7 +20327,7 @@ This function is suitable for execution in an init file.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lunar" '("calendar-lunar-phases" "diary-lunar-phases" "lunar-")))
+(register-definition-prefixes "lunar" '("calendar-lunar-phases" "diary-lunar-phases" "eclipse-check" "lunar-"))
;;;***
@@ -19857,7 +20339,7 @@ A major mode to edit m4 macro files.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "m4-mode" '("m4-")))
+(register-definition-prefixes "m4-mode" '("m4-"))
;;;***
@@ -19942,7 +20424,7 @@ and then select the region of un-tablified names and use
\(fn TOP BOTTOM &optional MACRO)" t nil)
(define-key ctl-x-map "q" 'kbd-macro-query)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "macros" '("macros--insert-vector-macro")))
+(register-definition-prefixes "macros" '("macros--insert-vector-macro"))
;;;***
@@ -19981,7 +20463,7 @@ Convert mail domain DOMAIN to the country it corresponds to.
\(fn DOMAIN)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-extr" '("mail-extr-")))
+(register-definition-prefixes "mail-extr" '("mail-extr-"))
;;;***
@@ -20005,21 +20487,21 @@ message.
This function normally would be called when the message is sent." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-hist" '("mail-hist-")))
+(register-definition-prefixes "mail-hist" '("mail-hist-"))
;;;***
;;;### (autoloads nil "mail-parse" "mail/mail-parse.el" (0 0 0 0))
;;; Generated autoloads from mail/mail-parse.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-parse" '("mail-")))
+(register-definition-prefixes "mail-parse" '("mail-"))
;;;***
;;;### (autoloads nil "mail-prsvr" "mail/mail-prsvr.el" (0 0 0 0))
;;; Generated autoloads from mail/mail-prsvr.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-prsvr" '("mail-parse-")))
+(register-definition-prefixes "mail-prsvr" '("mail-parse-"))
;;;***
@@ -20027,7 +20509,7 @@ This function normally would be called when the message is sent." nil nil)
;;;;;; 0))
;;; Generated autoloads from gnus/mail-source.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-source" '("mail-source")))
+(register-definition-prefixes "mail-source" '("mail-source"))
;;;***
@@ -20105,7 +20587,7 @@ matches may be returned from the message body.
\(fn FIELD-NAME &optional LAST ALL LIST DELETE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-utils" '("mail-")))
+(register-definition-prefixes "mail-utils" '("mail-"))
;;;***
@@ -20130,6 +20612,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Mail Abbrevs mode is a global minor mode. When enabled,
abbrev-like expansion is performed when editing certain mail
headers (those specified by `mail-abbrev-mode-regexp'), based on
@@ -20157,7 +20642,7 @@ double-quotes.
\(fn NAME DEFINITION &optional FROM-MAILRC-FILE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mailabbrev" '("mail-" "merge-mail-abbrevs" "rebuild-mail-abbrevs")))
+(register-definition-prefixes "mailabbrev" '("mail-" "merge-mail-abbrevs" "rebuild-mail-abbrevs"))
;;;***
@@ -20210,14 +20695,14 @@ current header, calls `mail-complete-function' and passes prefix ARG if any.
(make-obsolete 'mail-complete 'mail-completion-at-point-function '"24.1")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mailalias" '("build-mail-aliases" "mail-")))
+(register-definition-prefixes "mailalias" '("build-mail-aliases" "mail-"))
;;;***
;;;### (autoloads nil "mailcap" "net/mailcap.el" (0 0 0 0))
;;; Generated autoloads from net/mailcap.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mailcap" '("mailcap-")))
+(register-definition-prefixes "mailcap" '("mailcap-"))
;;;***
@@ -20229,21 +20714,21 @@ Pass current buffer on to the system's mail client.
Suitable value for `send-mail-function'.
The mail client is taken to be the handler of mailto URLs." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mailclient" '("mailclient-")))
+(register-definition-prefixes "mailclient" '("mailclient-"))
;;;***
;;;### (autoloads nil "mailheader" "mail/mailheader.el" (0 0 0 0))
;;; Generated autoloads from mail/mailheader.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mailheader" '("mail-header")))
+(register-definition-prefixes "mailheader" '("mail-header"))
;;;***
;;;### (autoloads nil "mairix" "net/mairix.el" (0 0 0 0))
;;; Generated autoloads from net/mairix.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mairix" '("mairix-")))
+(register-definition-prefixes "mairix" '("mairix-"))
;;;***
@@ -20363,14 +20848,14 @@ An adapted `makefile-mode' that knows about imake.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "make-mode" '("makefile-")))
+(register-definition-prefixes "make-mode" '("makefile-"))
;;;***
;;;### (autoloads nil "makeinfo" "textmodes/makeinfo.el" (0 0 0 0))
;;; Generated autoloads from textmodes/makeinfo.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "makeinfo" '("makeinfo-")))
+(register-definition-prefixes "makeinfo" '("makeinfo-"))
;;;***
@@ -20381,7 +20866,7 @@ An adapted `makefile-mode' that knows about imake.
Make a summary of current key bindings in the buffer *Summary*.
Previous contents of that buffer are killed first." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "makesum" '("double-column")))
+(register-definition-prefixes "makesum" '("double-column"))
;;;***
@@ -20443,21 +20928,20 @@ Default bookmark handler for Man buffers.
\(fn BOOKMARK)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "man" '("Man-" "man")))
+(register-definition-prefixes "man" '("Man-" "man"))
;;;***
;;;### (autoloads nil "map" "emacs-lisp/map.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/map.el
-(push (purecopy '(map 2 0)) package--builtin-versions)
+(push (purecopy '(map 2 1)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "map" '("map-")))
+(register-definition-prefixes "map" '("map-"))
;;;***
;;;### (autoloads nil "master" "master.el" (0 0 0 0))
;;; Generated autoloads from master.el
-(push (purecopy '(master 1 0 2)) package--builtin-versions)
(autoload 'master-mode "master" "\
Toggle Master mode.
@@ -20467,6 +20951,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When Master mode is enabled, you can scroll the slave buffer
using the following commands:
@@ -20478,7 +20965,7 @@ yourself the value of `master-of' by calling `master-show-slave'.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "master" '("master-")))
+(register-definition-prefixes "master" '("master-"))
;;;***
@@ -20503,6 +20990,9 @@ is positive, and disable it if ARG is zero or negative. If called
from Lisp, also enable the mode if ARG is omitted or nil, and toggle
it if ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Minibuffer Depth Indication mode is a global minor mode. When
enabled, any recursive use of the minibuffer will show the
recursion depth in the minibuffer prompt. This is only useful if
@@ -20510,7 +21000,7 @@ recursion depth in the minibuffer prompt. This is only useful if
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mb-depth" '("minibuffer-depth-")))
+(register-definition-prefixes "mb-depth" '("minibuffer-depth-"))
;;;***
@@ -20518,7 +21008,7 @@ recursion depth in the minibuffer prompt. This is only useful if
;;; Generated autoloads from md4.el
(push (purecopy '(md4 1 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "md4" '("md4")))
+(register-definition-prefixes "md4" '("md4"))
;;;***
@@ -20644,7 +21134,13 @@ which specify the range to operate on.
\(fn START END)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "message" '("message-" "nil")))
+(autoload 'message-mailto "message" "\
+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)
+
+(register-definition-prefixes "message" '("message-" "nil"))
;;;***
@@ -20663,71 +21159,28 @@ Major mode for editing MetaPost sources.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "meta-mode" '("font-lock-match-meta-declaration-item-and-skip-to-next" "meta")))
-
-;;;***
-
-;;;### (autoloads nil "metamail" "mail/metamail.el" (0 0 0 0))
-;;; Generated autoloads from mail/metamail.el
-
-(autoload 'metamail-interpret-header "metamail" "\
-Interpret a header part of a MIME message in current buffer.
-Its body part is not interpreted at all." t nil)
-
-(autoload 'metamail-interpret-body "metamail" "\
-Interpret a body part of a MIME message in current buffer.
-Optional argument VIEWMODE specifies the value of the
-EMACS_VIEW_MODE environment variable (defaulted to 1).
-Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted.
-Its header part is not interpreted at all.
-
-\(fn &optional VIEWMODE NODISPLAY)" t nil)
-
-(autoload 'metamail-buffer "metamail" "\
-Process current buffer through `metamail'.
-Optional argument VIEWMODE specifies the value of the
-EMACS_VIEW_MODE environment variable (defaulted to 1).
-Optional argument BUFFER specifies a buffer to be filled (nil
-means current).
-Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted.
-
-\(fn &optional VIEWMODE BUFFER NODISPLAY)" t nil)
-
-(autoload 'metamail-region "metamail" "\
-Process current region through `metamail'.
-Optional argument VIEWMODE specifies the value of the
-EMACS_VIEW_MODE environment variable (defaulted to 1).
-Optional argument BUFFER specifies a buffer to be filled (nil
-means current).
-Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted.
-
-\(fn BEG END &optional VIEWMODE BUFFER NODISPLAY)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "metamail" '("metamail-")))
+(register-definition-prefixes "meta-mode" '("font-lock-match-meta-declaration-item-and-skip-to-next" "meta"))
;;;***
;;;### (autoloads nil "mh-acros" "mh-e/mh-acros.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-acros.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-acros" '("defmacro-mh" "defun-mh" "mh-" "with-mh-folder-updating")))
+(register-definition-prefixes "mh-acros" '("defmacro-mh" "defun-mh" "mh-" "with-mh-folder-updating"))
;;;***
;;;### (autoloads nil "mh-alias" "mh-e/mh-alias.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-alias.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-alias" '("mh-")))
+(register-definition-prefixes "mh-alias" '("mh-"))
;;;***
;;;### (autoloads nil "mh-buffers" "mh-e/mh-buffers.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-buffers.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-buffers" '("mh-")))
+(register-definition-prefixes "mh-buffers" '("mh-"))
;;;***
@@ -20812,14 +21265,14 @@ this command to kill the draft buffer and delete the draft
message. Use the command \\[kill-buffer] if you don't want to
delete the draft message." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-comp" '("mh-")))
+(register-definition-prefixes "mh-comp" '("mh-"))
;;;***
;;;### (autoloads nil "mh-compat" "mh-e/mh-compat.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-compat.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-compat" '("mh-")))
+(register-definition-prefixes "mh-compat" '("mh-"))
;;;***
@@ -20836,7 +21289,7 @@ delete the draft message." t nil)
(autoload 'mh-version "mh-e" "\
Display version information about MH-E and the MH mail handling system." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-e" '("defcustom-mh" "defface-mh" "defgroup-mh" "mh-")))
+(register-definition-prefixes "mh-e" '("defcustom-mh" "defface-mh" "defgroup-mh" "mh-"))
;;;***
@@ -20919,14 +21372,14 @@ perform the operation on all messages in that region.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-folder" '("mh-")))
+(register-definition-prefixes "mh-folder" '("mh-"))
;;;***
;;;### (autoloads nil "mh-funcs" "mh-e/mh-funcs.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-funcs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-funcs" '("mh-")))
+(register-definition-prefixes "mh-funcs" '("mh-"))
;;;***
@@ -20934,91 +21387,91 @@ perform the operation on all messages in that region.
;;;;;; 0))
;;; Generated autoloads from mh-e/mh-identity.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-identity" '("mh-")))
+(register-definition-prefixes "mh-identity" '("mh-"))
;;;***
;;;### (autoloads nil "mh-inc" "mh-e/mh-inc.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-inc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-inc" '("mh-inc-spool-")))
+(register-definition-prefixes "mh-inc" '("mh-inc-spool-"))
;;;***
;;;### (autoloads nil "mh-junk" "mh-e/mh-junk.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-junk.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-junk" '("mh-")))
+(register-definition-prefixes "mh-junk" '("mh-"))
;;;***
;;;### (autoloads nil "mh-letter" "mh-e/mh-letter.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-letter.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-letter" '("mh-")))
+(register-definition-prefixes "mh-letter" '("mh-"))
;;;***
;;;### (autoloads nil "mh-limit" "mh-e/mh-limit.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-limit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-limit" '("mh-")))
+(register-definition-prefixes "mh-limit" '("mh-"))
;;;***
;;;### (autoloads nil "mh-mime" "mh-e/mh-mime.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-mime.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-mime" '("mh-")))
+(register-definition-prefixes "mh-mime" '("mh-"))
;;;***
;;;### (autoloads nil "mh-print" "mh-e/mh-print.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-print.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-print" '("mh-p")))
+(register-definition-prefixes "mh-print" '("mh-p"))
;;;***
;;;### (autoloads nil "mh-scan" "mh-e/mh-scan.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-scan.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-scan" '("mh-")))
+(register-definition-prefixes "mh-scan" '("mh-"))
;;;***
;;;### (autoloads nil "mh-search" "mh-e/mh-search.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-search.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-search" '("mh-")))
+(register-definition-prefixes "mh-search" '("mh-"))
;;;***
;;;### (autoloads nil "mh-seq" "mh-e/mh-seq.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-seq.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-seq" '("mh-")))
+(register-definition-prefixes "mh-seq" '("mh-"))
;;;***
;;;### (autoloads nil "mh-show" "mh-e/mh-show.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-show.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-show" '("mh-")))
+(register-definition-prefixes "mh-show" '("mh-"))
;;;***
;;;### (autoloads nil "mh-speed" "mh-e/mh-speed.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-speed.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-speed" '("mh-")))
+(register-definition-prefixes "mh-speed" '("mh-"))
;;;***
;;;### (autoloads nil "mh-thread" "mh-e/mh-thread.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-thread.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-thread" '("mh-")))
+(register-definition-prefixes "mh-thread" '("mh-"))
;;;***
@@ -21026,21 +21479,21 @@ perform the operation on all messages in that region.
;;;;;; 0))
;;; Generated autoloads from mh-e/mh-tool-bar.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-tool-bar" '("mh-tool-bar-")))
+(register-definition-prefixes "mh-tool-bar" '("mh-tool-bar-"))
;;;***
;;;### (autoloads nil "mh-utils" "mh-e/mh-utils.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-utils.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-utils" '("mh-")))
+(register-definition-prefixes "mh-utils" '("mh-"))
;;;***
;;;### (autoloads nil "mh-xface" "mh-e/mh-xface.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-xface.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-xface" '("mh-")))
+(register-definition-prefixes "mh-xface" '("mh-"))
;;;***
@@ -21057,7 +21510,7 @@ the rules from `css-mode'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mhtml-mode" '("mhtml-")))
+(register-definition-prefixes "mhtml-mode" '("mhtml-"))
;;;***
@@ -21082,6 +21535,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
(autoload 'clean-buffer-list "midnight" "\
@@ -21103,7 +21559,7 @@ to its second argument TM.
\(fn SYMB TM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "midnight" '("clean-buffer-list-" "midnight-")))
+(register-definition-prefixes "midnight" '("clean-buffer-list-" "midnight-"))
;;;***
@@ -21128,6 +21584,9 @@ ARG is positive, and disable it if ARG is zero or negative. If called
from Lisp, also enable the mode if ARG is omitted or nil, and toggle
it if ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Minibuffer Electric Default mode is a global minor mode. When
enabled, minibuffer prompts that show a default value only show
the default when it's applicable -- that is, when hitting RET
@@ -21137,7 +21596,7 @@ is modified to remove the default indication.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "minibuf-eldef" '("minibuf")))
+(register-definition-prefixes "minibuf-eldef" '("minibuf"))
;;;***
@@ -21191,7 +21650,7 @@ upper atmosphere. These cause momentary pockets of higher-pressure
air to form, which act as lenses that deflect incoming cosmic rays,
focusing them to strike the drive platter and flip the desired bit.
You can type `M-x butterfly C-M-c' to run it. This is a permuted
-variation of `C-x M-c M-butterfly' from url `http://xkcd.com/378/'." t nil)
+variation of `C-x M-c M-butterfly' from url `https://xkcd.com/378/'." t nil)
(autoload 'list-dynamic-libraries "misc" "\
Display a list of all dynamic libraries known to Emacs.
@@ -21204,7 +21663,7 @@ The return value is always nil.
\(fn &optional LOADED-ONLY-P BUFFER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "misc" '("list-dynamic-libraries--")))
+(register-definition-prefixes "misc" '("list-dynamic-libraries--"))
;;;***
@@ -21292,7 +21751,7 @@ whose file names match the specified wildcard.
\(fn FILES)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "misearch" '("misearch-unload-function" "multi-isearch-")))
+(register-definition-prefixes "misearch" '("misearch-unload-function" "multi-isearch-"))
;;;***
@@ -21306,28 +21765,28 @@ Major mode for the mixal asm language.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mixal-mode" '("mixal-")))
+(register-definition-prefixes "mixal-mode" '("mixal-"))
;;;***
;;;### (autoloads nil "mm-archive" "gnus/mm-archive.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-archive.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-archive" '("mm-")))
+(register-definition-prefixes "mm-archive" '("mm-"))
;;;***
;;;### (autoloads nil "mm-bodies" "gnus/mm-bodies.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-bodies.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-bodies" '("mm-")))
+(register-definition-prefixes "mm-bodies" '("mm-"))
;;;***
;;;### (autoloads nil "mm-decode" "gnus/mm-decode.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-decode.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-decode" '("mm-")))
+(register-definition-prefixes "mm-decode" '("mm-"))
;;;***
@@ -21339,7 +21798,7 @@ Return a default encoding for FILE.
\(fn FILE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-encode" '("mm-")))
+(register-definition-prefixes "mm-encode" '("mm-"))
;;;***
@@ -21359,7 +21818,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing.
\(fn HANDLE &optional NO-DISPLAY)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-extern" '("mm-extern-")))
+(register-definition-prefixes "mm-extern" '("mm-extern-"))
;;;***
@@ -21374,7 +21833,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing.
\(fn HANDLE &optional NO-DISPLAY)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-partial" '("mm-partial-find-parts")))
+(register-definition-prefixes "mm-partial" '("mm-partial-find-parts"))
;;;***
@@ -21392,14 +21851,14 @@ Insert file contents of URL using `mm-url-program'.
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-url" '("mm-url-")))
+(register-definition-prefixes "mm-url" '("mm-url-"))
;;;***
;;;### (autoloads nil "mm-util" "gnus/mm-util.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-util" '("mm-")))
+(register-definition-prefixes "mm-util" '("mm-"))
;;;***
@@ -21420,14 +21879,14 @@ Assume text has been decoded if DECODED is non-nil.
\(fn HANDLE &optional DECODED)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-uu" '("mm-")))
+(register-definition-prefixes "mm-uu" '("mm-"))
;;;***
;;;### (autoloads nil "mm-view" "gnus/mm-view.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-view.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-view" '("mm-")))
+(register-definition-prefixes "mm-view" '("mm-"))
;;;***
@@ -21456,21 +21915,21 @@ will be computed and used.
\(fn FILE &optional TYPE DESCRIPTION DISPOSITION)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mml" '("mime-to-mml" "mml-")))
+(register-definition-prefixes "mml" '("mime-to-mml" "mml-"))
;;;***
;;;### (autoloads nil "mml-sec" "gnus/mml-sec.el" (0 0 0 0))
;;; Generated autoloads from gnus/mml-sec.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mml-sec" '("mml-")))
+(register-definition-prefixes "mml-sec" '("mml-"))
;;;***
;;;### (autoloads nil "mml-smime" "gnus/mml-smime.el" (0 0 0 0))
;;; Generated autoloads from gnus/mml-smime.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mml-smime" '("mml-smime-")))
+(register-definition-prefixes "mml-smime" '("mml-smime-"))
;;;***
@@ -21487,7 +21946,7 @@ will be computed and used.
\(fn CONT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mml1991" '("mml1991-")))
+(register-definition-prefixes "mml1991" '("mml1991-"))
;;;***
@@ -21526,7 +21985,7 @@ will be computed and used.
(autoload 'mml2015-self-encrypt "mml2015" nil nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mml2015" '("mml2015-")))
+(register-definition-prefixes "mml2015" '("mml2015-"))
;;;***
@@ -21535,7 +21994,7 @@ will be computed and used.
(put 'define-overloadable-function 'doc-string-elt 3)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mode-local" '("def" "describe-mode-local-bindings" "fetch-overload" "get-mode-local-parent" "make-obsolete-overload" "mode-local-" "setq-mode-local" "with-mode-local" "xref-mode-local-")))
+(register-definition-prefixes "mode-local" '("def" "describe-mode-local-bindings" "fetch-overload" "get-mode-local-parent" "make-obsolete-overload" "mode-local-" "setq-mode-local" "with-mode-local" "xref-mode-local-"))
;;;***
@@ -21570,7 +22029,7 @@ followed by the first character of the construct.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "modula2" '("m2-" "m3-font-lock-keywords")))
+(register-definition-prefixes "modula2" '("m2-" "m3-font-lock-keywords"))
;;;***
@@ -21597,14 +22056,14 @@ Convert NATO phonetic alphabet in region to ordinary ASCII text.
\(fn BEG END)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "morse" '("morse-code" "nato-alphabet")))
+(register-definition-prefixes "morse" '("morse-code" "nato-alphabet"))
;;;***
;;;### (autoloads nil "mouse-copy" "mouse-copy.el" (0 0 0 0))
;;; Generated autoloads from mouse-copy.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mouse-copy" '("mouse-")))
+(register-definition-prefixes "mouse-copy" '("mouse-"))
;;;***
@@ -21653,7 +22112,7 @@ To test this function, evaluate:
\(fn START-EVENT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mouse-drag" '("mouse-")))
+(register-definition-prefixes "mouse-drag" '("mouse-"))
;;;***
@@ -21663,7 +22122,7 @@ To test this function, evaluate:
(autoload 'mpc "mpc" "\
Main entry point for MPC." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mpc" '("mpc-" "tag-browser-tagtypes")))
+(register-definition-prefixes "mpc" '("mpc-" "tag-browser-tagtypes"))
;;;***
@@ -21673,7 +22132,7 @@ Main entry point for MPC." t nil)
(autoload 'mpuz "mpuz" "\
Multiplication puzzle with GNU Emacs." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mpuz" '("mpuz-")))
+(register-definition-prefixes "mpuz" '("mpuz-"))
;;;***
@@ -21698,19 +22157,28 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
different buffer menu using the function `msb'.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "msb" '("mouse-select-buffer" "msb")))
+(register-definition-prefixes "msb" '("mouse-select-buffer" "msb"))
;;;***
;;;### (autoloads nil "mspools" "mail/mspools.el" (0 0 0 0))
;;; Generated autoloads from mail/mspools.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mspools" '("mspools-")))
+(autoload 'mspools-show "mspools" "\
+Show the list of non-empty spool files in the *spools* buffer.
+Buffer is not displayed if SHOW is non-nil.
+
+\(fn &optional NOSHOW)" t nil)
+
+(register-definition-prefixes "mspools" '("mspools-"))
;;;***
@@ -21834,7 +22302,7 @@ The default is 20. If LIMIT is negative, do not limit the listing.
\(fn &optional LIMIT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mule-diag" '("charset-history" "describe-font-internal" "insert-section" "list-" "non-iso-charset-alist" "print-" "sort-listed-character-sets")))
+(register-definition-prefixes "mule-diag" '("charset-history" "describe-font-internal" "insert-section" "list-" "print-" "sort-listed-character-sets"))
;;;***
@@ -21941,15 +22409,6 @@ operations such as `find-coding-systems-region'.
\(fn CODING-SYSTEMS &rest BODY)" nil t)
(put 'with-coding-priority 'lisp-indent-function 1)
-(autoload 'detect-coding-with-priority "mule-util" "\
-Detect a coding system of the text between FROM and TO with PRIORITY-LIST.
-PRIORITY-LIST is an alist of coding categories vs the corresponding
-coding systems ordered by priority.
-
-\(fn FROM TO PRIORITY-LIST)" nil t)
-
-(make-obsolete 'detect-coding-with-priority 'with-coding-priority '"23.1")
-
(autoload 'detect-coding-with-language-environment "mule-util" "\
Detect a coding system for the text between FROM and TO with LANG-ENV.
The detection takes into account the coding system priorities for the
@@ -21985,14 +22444,14 @@ QUALITY can be:
\(fn POSITION &optional QUALITY CODING-SYSTEM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mule-util" '("filepos-to-bufferpos--dos" "truncate-string-ellipsis")))
+(register-definition-prefixes "mule-util" '("filepos-to-bufferpos--dos" "truncate-string-ellipsis"))
;;;***
;;;### (autoloads nil "mwheel" "mwheel.el" (0 0 0 0))
;;; Generated autoloads from mwheel.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mwheel" '("mouse-wheel-" "mwheel-")))
+(register-definition-prefixes "mwheel" '("mouse-wheel-" "mwheel-"))
;;;***
@@ -22122,7 +22581,7 @@ Open a network connection to HOST on PORT.
\(fn HOST PORT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "net-utils" '("arp-program" "dig-program" "dns-lookup-program" "finger-X.500-host-regexps" "ftp-" "ifconfig-program" "ipconfig" "iwconfig-program" "net" "nslookup-" "ping-program" "route-program" "run-network-program" "smbclient" "traceroute-program" "whois-")))
+(register-definition-prefixes "net-utils" '("arp-program" "dig-program" "dns-lookup-program" "finger-X.500-host-regexps" "ftp-" "ifconfig-program" "ipconfig" "iwconfig-program" "net" "nslookup-" "ping-program" "route-program" "run-network-program" "smbclient" "traceroute-program" "whois-"))
;;;***
@@ -22136,7 +22595,7 @@ listed in the PORTS list.
\(fn MACHINE &rest PORTS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "netrc" '("netrc-")))
+(register-definition-prefixes "netrc" '("netrc-"))
;;;***
@@ -22180,6 +22639,10 @@ values:
`ssl' -- Equivalent to `tls'.
`shell' -- A shell connection.
+:coding is a symbol or a cons used to specify the coding systems
+used to decode and encode the data which the process reads and
+writes. See `make-network-process' for details.
+
:return-list specifies this function's return value.
If omitted or nil, return a process object. A non-nil means to
return (PROC . PROPS), where PROC is a process object and PROPS
@@ -22202,7 +22665,10 @@ values:
:capability-command specifies a command used to query the HOST
for its capabilities. For instance, for IMAP this should be
- \"1 CAPABILITY\\r\\n\".
+ \"1 CAPABILITY\\r\\n\". This can either be a string (which will
+ then be sent verbatim to the server), or a function (called with
+ a single parameter; the \"greeting\" from the server when connecting),
+ and should return a string to send to the server.
:starttls-function specifies a function for handling STARTTLS.
This function should take one parameter, the response to the
@@ -22233,8 +22699,8 @@ a greeting from the server.
:nowait, if non-nil, says the connection should be made
asynchronously, if possible.
-:shell-command is a format-spec string that can be used if :type
-is `shell'. It has two specs, %s for host and %p for port
+:shell-command is a `format-spec' string that can be used if
+:type is `shell'. It has two specs, %s for host and %p for port
number. Example: \"ssh gateway nc %s %p\".
:tls-parameters is a list that should be supplied if you're
@@ -22247,7 +22713,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters').
(defalias 'open-protocol-stream 'open-network-stream)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "network-stream" '("network-stream-")))
+(register-definition-prefixes "network-stream" '("network-stream-"))
;;;***
@@ -22269,7 +22735,7 @@ Run `newsticker-start-hook' if newsticker was not running already.
\(fn &optional DO-NOT-COMPLAIN-IF-RUNNING)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-backend" '("newsticker-")))
+(register-definition-prefixes "newst-backend" '("newsticker-"))
;;;***
@@ -22280,7 +22746,7 @@ Run `newsticker-start-hook' if newsticker was not running already.
(autoload 'newsticker-plainview "newst-plainview" "\
Start newsticker plainview." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-plainview" '("newsticker-")))
+(register-definition-prefixes "newst-plainview" '("newsticker-"))
;;;***
@@ -22291,7 +22757,7 @@ Start newsticker plainview." t nil)
(autoload 'newsticker-show-news "newst-reader" "\
Start reading news. You may want to bind this to a key." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-reader" '("newsticker-")))
+(register-definition-prefixes "newst-reader" '("newsticker-"))
;;;***
@@ -22310,7 +22776,7 @@ Start newsticker's ticker (but not the news retrieval).
Start display timer for the actual ticker if wanted and not
running already." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-ticker" '("newsticker-")))
+(register-definition-prefixes "newst-ticker" '("newsticker-"))
;;;***
@@ -22321,28 +22787,28 @@ running already." t nil)
(autoload 'newsticker-treeview "newst-treeview" "\
Start newsticker treeview." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-treeview" '("newsticker-")))
+(register-definition-prefixes "newst-treeview" '("newsticker-"))
;;;***
;;;### (autoloads nil "newsticker" "net/newsticker.el" (0 0 0 0))
;;; Generated autoloads from net/newsticker.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newsticker" '("newsticker-version")))
+(register-definition-prefixes "newsticker" '("newsticker-version"))
;;;***
;;;### (autoloads nil "nnagent" "gnus/nnagent.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnagent.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnagent" '("nnagent-")))
+(register-definition-prefixes "nnagent" '("nnagent-"))
;;;***
;;;### (autoloads nil "nnbabyl" "gnus/nnbabyl.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnbabyl.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnbabyl" '("nnbabyl-")))
+(register-definition-prefixes "nnbabyl" '("nnbabyl-"))
;;;***
@@ -22354,14 +22820,14 @@ Generate NOV databases in all nndiary directories.
\(fn &optional SERVER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nndiary" '("nndiary-")))
+(register-definition-prefixes "nndiary" '("nndiary-"))
;;;***
;;;### (autoloads nil "nndir" "gnus/nndir.el" (0 0 0 0))
;;; Generated autoloads from gnus/nndir.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nndir" '("nndir-")))
+(register-definition-prefixes "nndir" '("nndir-"))
;;;***
@@ -22377,21 +22843,21 @@ symbol in the alist.
\(fn DEFINITION &optional POSITION)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nndoc" '("nndoc-")))
+(register-definition-prefixes "nndoc" '("nndoc-"))
;;;***
;;;### (autoloads nil "nndraft" "gnus/nndraft.el" (0 0 0 0))
;;; Generated autoloads from gnus/nndraft.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nndraft" '("nndraft-")))
+(register-definition-prefixes "nndraft" '("nndraft-"))
;;;***
;;;### (autoloads nil "nneething" "gnus/nneething.el" (0 0 0 0))
;;; Generated autoloads from gnus/nneething.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nneething" '("nneething-")))
+(register-definition-prefixes "nneething" '("nneething-"))
;;;***
@@ -22402,70 +22868,70 @@ symbol in the alist.
Look for mbox folders in the nnfolder directory and make them into groups.
This command does not work if you use short group names." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnfolder" '("nnfolder-")))
+(register-definition-prefixes "nnfolder" '("nnfolder-"))
;;;***
;;;### (autoloads nil "nngateway" "gnus/nngateway.el" (0 0 0 0))
;;; Generated autoloads from gnus/nngateway.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nngateway" '("nngateway-")))
+(register-definition-prefixes "nngateway" '("nngateway-"))
;;;***
;;;### (autoloads nil "nnheader" "gnus/nnheader.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnheader.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnheader" '("gnus-" "mail-header-" "make-mail-header" "nnheader-" "nntp-")))
+(register-definition-prefixes "nnheader" '("gnus-" "mail-header-" "make-mail-header" "nnheader-" "nntp-"))
;;;***
;;;### (autoloads nil "nnimap" "gnus/nnimap.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnimap.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnimap" '("nnimap-")))
+(register-definition-prefixes "nnimap" '("nnimap-"))
;;;***
;;;### (autoloads nil "nnir" "gnus/nnir.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnir.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnir" '("gnus-" "nnir-")))
+(register-definition-prefixes "nnir" '("nnir-"))
;;;***
;;;### (autoloads nil "nnmail" "gnus/nnmail.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmail.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnmail" '("nnmail-")))
+(register-definition-prefixes "nnmail" '("nnmail-"))
;;;***
;;;### (autoloads nil "nnmaildir" "gnus/nnmaildir.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmaildir.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnmaildir" '("nnmaildir-")))
+(register-definition-prefixes "nnmaildir" '("nnmaildir-"))
;;;***
;;;### (autoloads nil "nnmairix" "gnus/nnmairix.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmairix.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnmairix" '("nnmairix-")))
+(register-definition-prefixes "nnmairix" '("nnmairix-"))
;;;***
;;;### (autoloads nil "nnmbox" "gnus/nnmbox.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmbox.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnmbox" '("nnmbox-")))
+(register-definition-prefixes "nnmbox" '("nnmbox-"))
;;;***
;;;### (autoloads nil "nnmh" "gnus/nnmh.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmh.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnmh" '("nnmh-")))
+(register-definition-prefixes "nnmh" '("nnmh-"))
;;;***
@@ -22477,70 +22943,77 @@ Generate NOV databases in all nnml directories.
\(fn &optional SERVER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnml" '("nnml-")))
+(register-definition-prefixes "nnml" '("nnml-"))
;;;***
;;;### (autoloads nil "nnnil" "gnus/nnnil.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnnil.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnnil" '("nnnil-")))
+(register-definition-prefixes "nnnil" '("nnnil-"))
;;;***
;;;### (autoloads nil "nnoo" "gnus/nnoo.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnoo.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnoo" '("deffoo" "defvoo" "nnoo-")))
+(register-definition-prefixes "nnoo" '("deffoo" "defvoo" "nnoo-"))
;;;***
;;;### (autoloads nil "nnregistry" "gnus/nnregistry.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnregistry.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnregistry" '("nnregistry-")))
+(register-definition-prefixes "nnregistry" '("nnregistry-"))
;;;***
;;;### (autoloads nil "nnrss" "gnus/nnrss.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnrss.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnrss" '("nnrss-")))
+(register-definition-prefixes "nnrss" '("nnrss-"))
+
+;;;***
+
+;;;### (autoloads nil "nnselect" "gnus/nnselect.el" (0 0 0 0))
+;;; Generated autoloads from gnus/nnselect.el
+
+(register-definition-prefixes "nnselect" '("gnus-" "ids-by-group" "nnselect-" "numbers-by-group"))
;;;***
;;;### (autoloads nil "nnspool" "gnus/nnspool.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnspool.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnspool" '("news-inews-program" "nnspool-")))
+(register-definition-prefixes "nnspool" '("news-inews-program" "nnspool-"))
;;;***
;;;### (autoloads nil "nntp" "gnus/nntp.el" (0 0 0 0))
;;; Generated autoloads from gnus/nntp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nntp" '("nntp-")))
+(register-definition-prefixes "nntp" '("nntp-"))
;;;***
;;;### (autoloads nil "nnvirtual" "gnus/nnvirtual.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnvirtual.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnvirtual" '("nnvirtual-")))
+(register-definition-prefixes "nnvirtual" '("nnvirtual-"))
;;;***
;;;### (autoloads nil "nnweb" "gnus/nnweb.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnweb.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnweb" '("nnweb-")))
+(register-definition-prefixes "nnweb" '("nnweb-"))
;;;***
;;;### (autoloads nil "notifications" "notifications.el" (0 0 0 0))
;;; Generated autoloads from notifications.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "notifications" '("notifications-")))
+(register-definition-prefixes "notifications" '("notifications-"))
;;;***
@@ -22572,7 +23045,7 @@ future sessions.
\(fn COMMAND)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "novice" '("en/disable-command")))
+(register-definition-prefixes "novice" '("en/disable-command"))
;;;***
@@ -22589,14 +23062,14 @@ closing requests for requests that are used in matched pairs.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nroff-mode" '("nroff-")))
+(register-definition-prefixes "nroff-mode" '("nroff-"))
;;;***
;;;### (autoloads nil "nsm" "net/nsm.el" (0 0 0 0))
;;; Generated autoloads from net/nsm.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nsm" '("network-security-" "nsm-")))
+(register-definition-prefixes "nsm" '("network-security-" "nsm-"))
;;;***
@@ -22604,21 +23077,21 @@ closing requests for requests that are used in matched pairs.
;;; Generated autoloads from net/ntlm.el
(push (purecopy '(ntlm 2 1 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ntlm" '("ntlm-")))
+(register-definition-prefixes "ntlm" '("ntlm-"))
;;;***
;;;### (autoloads nil "nxml-enc" "nxml/nxml-enc.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-enc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-enc" '("nxml-")))
+(register-definition-prefixes "nxml-enc" '("nxml-"))
;;;***
;;;### (autoloads nil "nxml-maint" "nxml/nxml-maint.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-maint.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-maint" '("nxml-insert-target-repertoire-glyph-set")))
+(register-definition-prefixes "nxml-maint" '("nxml-insert-target-repertoire-glyph-set"))
;;;***
@@ -22679,63 +23152,63 @@ Many aspects this mode can be customized using
\(fn)" t nil)
(defalias 'xml-mode 'nxml-mode)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-mode" '("nxml-")))
+(register-definition-prefixes "nxml-mode" '("nxml-"))
;;;***
;;;### (autoloads nil "nxml-ns" "nxml/nxml-ns.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-ns.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-ns" '("nxml-ns-")))
+(register-definition-prefixes "nxml-ns" '("nxml-ns-"))
;;;***
;;;### (autoloads nil "nxml-outln" "nxml/nxml-outln.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-outln.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-outln" '("nxml-")))
+(register-definition-prefixes "nxml-outln" '("nxml-"))
;;;***
;;;### (autoloads nil "nxml-parse" "nxml/nxml-parse.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-parse.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-parse" '("nxml-")))
+(register-definition-prefixes "nxml-parse" '("nxml-"))
;;;***
;;;### (autoloads nil "nxml-rap" "nxml/nxml-rap.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-rap.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-rap" '("nxml-")))
+(register-definition-prefixes "nxml-rap" '("nxml-"))
;;;***
;;;### (autoloads nil "nxml-util" "nxml/nxml-util.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-util" '("nxml-")))
+(register-definition-prefixes "nxml-util" '("nxml-"))
;;;***
;;;### (autoloads nil "ob-C" "org/ob-C.el" (0 0 0 0))
;;; Generated autoloads from org/ob-C.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-C" '("org-babel-")))
+(register-definition-prefixes "ob-C" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-J" "org/ob-J.el" (0 0 0 0))
;;; Generated autoloads from org/ob-J.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-J" '("obj-" "org-babel-")))
+(register-definition-prefixes "ob-J" '("obj-" "org-babel-"))
;;;***
;;;### (autoloads nil "ob-R" "org/ob-R.el" (0 0 0 0))
;;; Generated autoloads from org/ob-R.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-R" '("ob-R-" "org-babel-")))
+(register-definition-prefixes "ob-R" '("ob-R-" "org-babel-"))
;;;***
@@ -22743,7 +23216,7 @@ Many aspects this mode can be customized using
;;; Generated autoloads from org/ob-abc.el
(push (purecopy '(ob-abc 0 1)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-abc" '("org-babel-")))
+(register-definition-prefixes "ob-abc" '("org-babel-"))
;;;***
@@ -22751,42 +23224,42 @@ Many aspects this mode can be customized using
;;;;;; 0))
;;; Generated autoloads from org/ob-asymptote.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-asymptote" '("org-babel-")))
+(register-definition-prefixes "ob-asymptote" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-awk" "org/ob-awk.el" (0 0 0 0))
;;; Generated autoloads from org/ob-awk.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-awk" '("org-babel-")))
+(register-definition-prefixes "ob-awk" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-calc" "org/ob-calc.el" (0 0 0 0))
;;; Generated autoloads from org/ob-calc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-calc" '("org-babel-")))
+(register-definition-prefixes "ob-calc" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-clojure" "org/ob-clojure.el" (0 0 0 0))
;;; Generated autoloads from org/ob-clojure.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-clojure" '("org-babel-")))
+(register-definition-prefixes "ob-clojure" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-comint" "org/ob-comint.el" (0 0 0 0))
;;; Generated autoloads from org/ob-comint.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-comint" '("org-babel-comint-")))
+(register-definition-prefixes "ob-comint" '("org-babel-comint-"))
;;;***
;;;### (autoloads nil "ob-coq" "org/ob-coq.el" (0 0 0 0))
;;; Generated autoloads from org/ob-coq.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-coq" '("coq-program-name" "org-babel-")))
+(register-definition-prefixes "ob-coq" '("coq-program-name" "org-babel-"))
;;;***
@@ -22794,28 +23267,28 @@ Many aspects this mode can be customized using
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ob-core.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-core" '("org-")))
+(register-definition-prefixes "ob-core" '("org-"))
;;;***
;;;### (autoloads nil "ob-css" "org/ob-css.el" (0 0 0 0))
;;; Generated autoloads from org/ob-css.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-css" '("org-babel-")))
+(register-definition-prefixes "ob-css" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-ditaa" "org/ob-ditaa.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ditaa.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ditaa" '("org-")))
+(register-definition-prefixes "ob-ditaa" '("org-"))
;;;***
;;;### (autoloads nil "ob-dot" "org/ob-dot.el" (0 0 0 0))
;;; Generated autoloads from org/ob-dot.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-dot" '("org-babel-")))
+(register-definition-prefixes "ob-dot" '("org-babel-"))
;;;***
@@ -22823,7 +23296,7 @@ Many aspects this mode can be customized using
;;; Generated autoloads from org/ob-ebnf.el
(push (purecopy '(ob-ebnf 1 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ebnf" '("org-babel-")))
+(register-definition-prefixes "ob-ebnf" '("org-babel-"))
;;;***
@@ -22831,119 +23304,119 @@ Many aspects this mode can be customized using
;;;;;; 0 0))
;;; Generated autoloads from org/ob-emacs-lisp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-emacs-lisp" '("org-babel-")))
+(register-definition-prefixes "ob-emacs-lisp" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-eshell" "org/ob-eshell.el" (0 0 0 0))
;;; Generated autoloads from org/ob-eshell.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-eshell" '("ob-eshell-session-live-p" "org-babel-")))
+(register-definition-prefixes "ob-eshell" '("ob-eshell-session-live-p" "org-babel-"))
;;;***
;;;### (autoloads nil "ob-eval" "org/ob-eval.el" (0 0 0 0))
;;; Generated autoloads from org/ob-eval.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-eval" '("org-babel-")))
+(register-definition-prefixes "ob-eval" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-exp" "org/ob-exp.el" (0 0 0 0))
;;; Generated autoloads from org/ob-exp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-exp" '("org-")))
+(register-definition-prefixes "ob-exp" '("org-"))
;;;***
;;;### (autoloads nil "ob-forth" "org/ob-forth.el" (0 0 0 0))
;;; Generated autoloads from org/ob-forth.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-forth" '("org-babel-")))
+(register-definition-prefixes "ob-forth" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-fortran" "org/ob-fortran.el" (0 0 0 0))
;;; Generated autoloads from org/ob-fortran.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-fortran" '("org-babel-")))
+(register-definition-prefixes "ob-fortran" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-gnuplot" "org/ob-gnuplot.el" (0 0 0 0))
;;; Generated autoloads from org/ob-gnuplot.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-gnuplot" '("*org-babel-gnuplot-" "org-babel-")))
+(register-definition-prefixes "ob-gnuplot" '("*org-babel-gnuplot-" "org-babel-"))
;;;***
;;;### (autoloads nil "ob-groovy" "org/ob-groovy.el" (0 0 0 0))
;;; Generated autoloads from org/ob-groovy.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-groovy" '("org-babel-")))
+(register-definition-prefixes "ob-groovy" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-haskell" "org/ob-haskell.el" (0 0 0 0))
;;; Generated autoloads from org/ob-haskell.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-haskell" '("org-babel-")))
+(register-definition-prefixes "ob-haskell" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-hledger" "org/ob-hledger.el" (0 0 0 0))
;;; Generated autoloads from org/ob-hledger.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-hledger" '("org-babel-")))
+(register-definition-prefixes "ob-hledger" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-io" "org/ob-io.el" (0 0 0 0))
;;; Generated autoloads from org/ob-io.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-io" '("org-babel-")))
+(register-definition-prefixes "ob-io" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-java" "org/ob-java.el" (0 0 0 0))
;;; Generated autoloads from org/ob-java.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-java" '("org-babel-")))
+(register-definition-prefixes "ob-java" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-js" "org/ob-js.el" (0 0 0 0))
;;; Generated autoloads from org/ob-js.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-js" '("org-babel-")))
+(register-definition-prefixes "ob-js" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-latex" "org/ob-latex.el" (0 0 0 0))
;;; Generated autoloads from org/ob-latex.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-latex" '("org-babel-")))
+(register-definition-prefixes "ob-latex" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-ledger" "org/ob-ledger.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ledger.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ledger" '("org-babel-")))
+(register-definition-prefixes "ob-ledger" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-lilypond" "org/ob-lilypond.el" (0 0 0 0))
;;; Generated autoloads from org/ob-lilypond.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lilypond" '("lilypond-mode" "org-babel-")))
+(register-definition-prefixes "ob-lilypond" '("lilypond-mode" "org-babel-"))
;;;***
;;;### (autoloads nil "ob-lisp" "org/ob-lisp.el" (0 0 0 0))
;;; Generated autoloads from org/ob-lisp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lisp" '("org-babel-")))
+(register-definition-prefixes "ob-lisp" '("org-babel-"))
;;;***
@@ -22951,77 +23424,77 @@ Many aspects this mode can be customized using
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ob-lob.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lob" '("org-babel-")))
+(register-definition-prefixes "ob-lob" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-lua" "org/ob-lua.el" (0 0 0 0))
;;; Generated autoloads from org/ob-lua.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lua" '("org-babel-")))
+(register-definition-prefixes "ob-lua" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-makefile" "org/ob-makefile.el" (0 0 0 0))
;;; Generated autoloads from org/ob-makefile.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-makefile" '("org-babel-")))
+(register-definition-prefixes "ob-makefile" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-maxima" "org/ob-maxima.el" (0 0 0 0))
;;; Generated autoloads from org/ob-maxima.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-maxima" '("org-babel-")))
+(register-definition-prefixes "ob-maxima" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-mscgen" "org/ob-mscgen.el" (0 0 0 0))
;;; Generated autoloads from org/ob-mscgen.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-mscgen" '("org-babel-")))
+(register-definition-prefixes "ob-mscgen" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-ocaml" "org/ob-ocaml.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ocaml.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ocaml" '("org-babel-")))
+(register-definition-prefixes "ob-ocaml" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-octave" "org/ob-octave.el" (0 0 0 0))
;;; Generated autoloads from org/ob-octave.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-octave" '("org-babel-")))
+(register-definition-prefixes "ob-octave" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-org" "org/ob-org.el" (0 0 0 0))
;;; Generated autoloads from org/ob-org.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-org" '("org-babel-")))
+(register-definition-prefixes "ob-org" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-perl" "org/ob-perl.el" (0 0 0 0))
;;; Generated autoloads from org/ob-perl.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-perl" '("org-babel-")))
+(register-definition-prefixes "ob-perl" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-picolisp" "org/ob-picolisp.el" (0 0 0 0))
;;; Generated autoloads from org/ob-picolisp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-picolisp" '("org-babel-")))
+(register-definition-prefixes "ob-picolisp" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-plantuml" "org/ob-plantuml.el" (0 0 0 0))
;;; Generated autoloads from org/ob-plantuml.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-plantuml" '("org-")))
+(register-definition-prefixes "ob-plantuml" '("org-"))
;;;***
@@ -23029,49 +23502,49 @@ Many aspects this mode can be customized using
;;;;;; 0 0))
;;; Generated autoloads from org/ob-processing.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-processing" '("org-babel-")))
+(register-definition-prefixes "ob-processing" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-python" "org/ob-python.el" (0 0 0 0))
;;; Generated autoloads from org/ob-python.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-python" '("org-babel-")))
+(register-definition-prefixes "ob-python" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-ref" "org/ob-ref.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ref.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ref" '("org-babel-")))
+(register-definition-prefixes "ob-ref" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-ruby" "org/ob-ruby.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ruby.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ruby" '("org-babel-")))
+(register-definition-prefixes "ob-ruby" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-sass" "org/ob-sass.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sass.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sass" '("org-babel-")))
+(register-definition-prefixes "ob-sass" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-scheme" "org/ob-scheme.el" (0 0 0 0))
;;; Generated autoloads from org/ob-scheme.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-scheme" '("org-babel-")))
+(register-definition-prefixes "ob-scheme" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-screen" "org/ob-screen.el" (0 0 0 0))
;;; Generated autoloads from org/ob-screen.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-screen" '("org-babel-")))
+(register-definition-prefixes "ob-screen" '("org-babel-"))
;;;***
@@ -23079,49 +23552,49 @@ Many aspects this mode can be customized using
;;; Generated autoloads from org/ob-sed.el
(push (purecopy '(ob-sed 0 1 1)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sed" '("org-babel-")))
+(register-definition-prefixes "ob-sed" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-shell" "org/ob-shell.el" (0 0 0 0))
;;; Generated autoloads from org/ob-shell.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-shell" '("org-babel-")))
+(register-definition-prefixes "ob-shell" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-shen" "org/ob-shen.el" (0 0 0 0))
;;; Generated autoloads from org/ob-shen.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-shen" '("org-babel-")))
+(register-definition-prefixes "ob-shen" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-sql" "org/ob-sql.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sql.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sql" '("org-babel-")))
+(register-definition-prefixes "ob-sql" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-sqlite" "org/ob-sqlite.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sqlite.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sqlite" '("org-babel-")))
+(register-definition-prefixes "ob-sqlite" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-stan" "org/ob-stan.el" (0 0 0 0))
;;; Generated autoloads from org/ob-stan.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-stan" '("org-babel-")))
+(register-definition-prefixes "ob-stan" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-table" "org/ob-table.el" (0 0 0 0))
;;; Generated autoloads from org/ob-table.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-table" '("org-")))
+(register-definition-prefixes "ob-table" '("org-"))
;;;***
@@ -23129,14 +23602,14 @@ Many aspects this mode can be customized using
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ob-tangle.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-tangle" '("org-babel-")))
+(register-definition-prefixes "ob-tangle" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-vala" "org/ob-vala.el" (0 0 0 0))
;;; Generated autoloads from org/ob-vala.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-vala" '("org-babel-")))
+(register-definition-prefixes "ob-vala" '("org-babel-"))
;;;***
@@ -23179,14 +23652,14 @@ startup file, `~/.emacs-octave'.
(defalias 'run-octave 'inferior-octave)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "octave" '("inferior-octave-" "octave-")))
+(register-definition-prefixes "octave" '("inferior-octave-" "octave-"))
;;;***
;;;### (autoloads nil "ogonek" "international/ogonek.el" (0 0 0 0))
;;; Generated autoloads from international/ogonek.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ogonek" '("ogonek-")))
+(register-definition-prefixes "ogonek" '("ogonek-"))
;;;***
@@ -23290,7 +23763,7 @@ This command can be called in any mode to insert a link in Org syntax." t nil)
Find all radio targets in this file and update the regular expression.
Also refresh fontification if needed." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol" '("org-")))
+(register-definition-prefixes "ol" '("org-"))
;;;***
@@ -23298,49 +23771,49 @@ Also refresh fontification if needed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ol-bbdb.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-bbdb" '("org-bbdb-")))
+(register-definition-prefixes "ol-bbdb" '("org-bbdb-"))
;;;***
;;;### (autoloads nil "ol-bibtex" "org/ol-bibtex.el" (0 0 0 0))
;;; Generated autoloads from org/ol-bibtex.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-bibtex" '("org-")))
+(register-definition-prefixes "ol-bibtex" '("org-"))
;;;***
;;;### (autoloads nil "ol-docview" "org/ol-docview.el" (0 0 0 0))
;;; Generated autoloads from org/ol-docview.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-docview" '("org-docview-")))
+(register-definition-prefixes "ol-docview" '("org-docview-"))
;;;***
;;;### (autoloads nil "ol-eshell" "org/ol-eshell.el" (0 0 0 0))
;;; Generated autoloads from org/ol-eshell.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-eshell" '("org-eshell-")))
+(register-definition-prefixes "ol-eshell" '("org-eshell-"))
;;;***
;;;### (autoloads nil "ol-eww" "org/ol-eww.el" (0 0 0 0))
;;; Generated autoloads from org/ol-eww.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-eww" '("org-eww-")))
+(register-definition-prefixes "ol-eww" '("org-eww-"))
;;;***
;;;### (autoloads nil "ol-gnus" "org/ol-gnus.el" (0 0 0 0))
;;; Generated autoloads from org/ol-gnus.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-gnus" '("org-gnus-")))
+(register-definition-prefixes "ol-gnus" '("org-gnus-"))
;;;***
;;;### (autoloads nil "ol-info" "org/ol-info.el" (0 0 0 0))
;;; Generated autoloads from org/ol-info.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-info" '("org-info-")))
+(register-definition-prefixes "ol-info" '("org-info-"))
;;;***
@@ -23348,28 +23821,28 @@ Also refresh fontification if needed." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ol-irc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-irc" '("org-irc-")))
+(register-definition-prefixes "ol-irc" '("org-irc-"))
;;;***
;;;### (autoloads nil "ol-mhe" "org/ol-mhe.el" (0 0 0 0))
;;; Generated autoloads from org/ol-mhe.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-mhe" '("org-mhe-")))
+(register-definition-prefixes "ol-mhe" '("org-mhe-"))
;;;***
;;;### (autoloads nil "ol-rmail" "org/ol-rmail.el" (0 0 0 0))
;;; Generated autoloads from org/ol-rmail.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-rmail" '("org-rmail-")))
+(register-definition-prefixes "ol-rmail" '("org-rmail-"))
;;;***
;;;### (autoloads nil "ol-w3m" "org/ol-w3m.el" (0 0 0 0))
;;; Generated autoloads from org/ol-w3m.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-w3m" '("org-w3m-")))
+(register-definition-prefixes "ol-w3m" '("org-w3m-"))
;;;***
@@ -23406,7 +23879,7 @@ Coloring:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "opascal" '("opascal-")))
+(register-definition-prefixes "opascal" '("opascal-"))
;;;***
@@ -23601,7 +24074,7 @@ With prefix arg UNCOMPILED, load the uncompiled versions.
(autoload 'org-customize "org" "\
Call the customize function with org as argument." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org" '("org-" "turn-on-org-cdlatex")))
+(register-definition-prefixes "org" '("org-" "turn-on-org-cdlatex"))
;;;***
@@ -23877,7 +24350,7 @@ to override `appt-message-warning-time'.
\(fn &optional REFRESH FILTER &rest ARGS)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-agenda" '("org-")))
+(register-definition-prefixes "org-agenda" '("org-"))
;;;***
@@ -23885,7 +24358,7 @@ to override `appt-message-warning-time'.
;;;;;; "org/org-archive.el" (0 0 0 0))
;;; Generated autoloads from org/org-archive.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-archive" '("org-a")))
+(register-definition-prefixes "org-archive" '("org-a"))
;;;***
@@ -23893,7 +24366,7 @@ to override `appt-message-warning-time'.
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/org-attach.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-attach" '("org-attach-")))
+(register-definition-prefixes "org-attach" '("org-attach-"))
;;;***
@@ -23901,7 +24374,7 @@ to override `appt-message-warning-time'.
;;;;;; 0 0 0))
;;; Generated autoloads from org/org-attach-git.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-attach-git" '("org-attach-git-")))
+(register-definition-prefixes "org-attach-git" '("org-attach-git-"))
;;;***
@@ -23947,7 +24420,7 @@ of the day at point (if any) or the current HH:MM time.
(autoload 'org-capture-import-remember-templates "org-capture" "\
Set `org-capture-templates' to be similar to `org-remember-templates'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-capture" '("org-capture-")))
+(register-definition-prefixes "org-capture" '("org-capture-"))
;;;***
@@ -23955,7 +24428,7 @@ Set `org-capture-templates' to be similar to `org-remember-templates'." t nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/org-clock.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-clock" '("org-")))
+(register-definition-prefixes "org-clock" '("org-"))
;;;***
@@ -24046,7 +24519,7 @@ Create a dynamic block capturing a column view table." t nil)
(autoload 'org-agenda-columns "org-colview" "\
Turn on or update column view in the agenda." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-colview" '("org-")))
+(register-definition-prefixes "org-colview" '("org-"))
;;;***
@@ -24056,21 +24529,21 @@ Turn on or update column view in the agenda." t nil)
(autoload 'org-check-version "org-compat" "\
Try very hard to provide sensible version strings." nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-compat" '("org-")))
+(register-definition-prefixes "org-compat" '("org-"))
;;;***
;;;### (autoloads nil "org-crypt" "org/org-crypt.el" (0 0 0 0))
;;; Generated autoloads from org/org-crypt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-crypt" '("org-")))
+(register-definition-prefixes "org-crypt" '("org-"))
;;;***
;;;### (autoloads nil "org-ctags" "org/org-ctags.el" (0 0 0 0))
;;; Generated autoloads from org/org-ctags.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-ctags" '("org-ctags-")))
+(register-definition-prefixes "org-ctags" '("org-ctags-"))
;;;***
@@ -24078,7 +24551,7 @@ Try very hard to provide sensible version strings." nil t)
;;;;;; "org/org-datetree.el" (0 0 0 0))
;;; Generated autoloads from org/org-datetree.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-datetree" '("org-datetree-")))
+(register-definition-prefixes "org-datetree" '("org-datetree-"))
;;;***
@@ -24133,7 +24606,7 @@ with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return
\(fn TIMES)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-duration" '("org-duration-")))
+(register-definition-prefixes "org-duration" '("org-duration-"))
;;;***
@@ -24141,7 +24614,7 @@ with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return
;;;;;; "org/org-element.el" (0 0 0 0))
;;; Generated autoloads from org/org-element.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-element" '("org-element-")))
+(register-definition-prefixes "org-element" '("org-element-"))
;;;***
@@ -24149,14 +24622,14 @@ with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return
;;;;;; 0))
;;; Generated autoloads from org/org-entities.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-entities" '("org-entit")))
+(register-definition-prefixes "org-entities" '("org-entit"))
;;;***
;;;### (autoloads nil "org-faces" "org/org-faces.el" (0 0 0 0))
;;; Generated autoloads from org/org-faces.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-faces" '("org-")))
+(register-definition-prefixes "org-faces" '("org-"))
;;;***
@@ -24164,7 +24637,7 @@ with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/org-feed.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-feed" '("org-feed-")))
+(register-definition-prefixes "org-feed" '("org-feed-"))
;;;***
@@ -24172,7 +24645,7 @@ with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return
;;;;;; "org/org-footnote.el" (0 0 0 0))
;;; Generated autoloads from org/org-footnote.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-footnote" '("org-footnote-")))
+(register-definition-prefixes "org-footnote" '("org-footnote-"))
;;;***
@@ -24208,14 +24681,14 @@ With a prefix argument, use the alternative interface: e.g., if
\(fn &optional ALTERNATIVE-INTERFACE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-goto" '("org-goto-")))
+(register-definition-prefixes "org-goto" '("org-goto-"))
;;;***
;;;### (autoloads nil "org-habit" "org/org-habit.el" (0 0 0 0))
;;; Generated autoloads from org/org-habit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-habit" '("org-")))
+(register-definition-prefixes "org-habit" '("org-"))
;;;***
@@ -24223,7 +24696,7 @@ With a prefix argument, use the alternative interface: e.g., if
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/org-id.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-id" '("org-id-")))
+(register-definition-prefixes "org-id" '("org-id-"))
;;;***
@@ -24231,7 +24704,7 @@ With a prefix argument, use the alternative interface: e.g., if
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/org-indent.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-indent" '("org-")))
+(register-definition-prefixes "org-indent" '("org-"))
;;;***
@@ -24239,7 +24712,7 @@ With a prefix argument, use the alternative interface: e.g., if
;;;;;; 0 0 0))
;;; Generated autoloads from org/org-inlinetask.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-inlinetask" '("org-inlinetask-")))
+(register-definition-prefixes "org-inlinetask" '("org-inlinetask-"))
;;;***
@@ -24249,7 +24722,7 @@ With a prefix argument, use the alternative interface: e.g., if
(autoload 'org-babel-describe-bindings "org-keys" "\
Describe all keybindings behind `org-babel-key-prefix'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-keys" '("org-")))
+(register-definition-prefixes "org-keys" '("org-"))
;;;***
@@ -24267,21 +24740,21 @@ ARG can also be a list of checker names, as symbols, to run.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-lint" '("org-lint-")))
+(register-definition-prefixes "org-lint" '("org-lint-"))
;;;***
;;;### (autoloads nil "org-list" "org/org-list.el" (0 0 0 0))
;;; Generated autoloads from org/org-list.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-list" '("org-")))
+(register-definition-prefixes "org-list" '("org-"))
;;;***
;;;### (autoloads nil "org-macro" "org/org-macro.el" (0 0 0 0))
;;; Generated autoloads from org/org-macro.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-macro" '("org-macro-")))
+(register-definition-prefixes "org-macro" '("org-macro-"))
;;;***
@@ -24293,7 +24766,7 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX.
\(fn FILE)" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-macs" '("org-")))
+(register-definition-prefixes "org-macs" '("org-"))
;;;***
@@ -24301,14 +24774,14 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX.
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/org-mobile.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-mobile" '("org-mobile-")))
+(register-definition-prefixes "org-mobile" '("org-mobile-"))
;;;***
;;;### (autoloads nil "org-mouse" "org/org-mouse.el" (0 0 0 0))
;;; Generated autoloads from org/org-mouse.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-mouse" '("org-mouse-")))
+(register-definition-prefixes "org-mouse" '("org-mouse-"))
;;;***
@@ -24329,9 +24802,12 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-num" '("org-num-")))
+(register-definition-prefixes "org-num" '("org-num-"))
;;;***
@@ -24339,7 +24815,7 @@ enable the mode if ARG is omitted or nil, and toggle it if ARG is
;;;;;; 0 0))
;;; Generated autoloads from org/org-pcomplete.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-pcomplete" '("org-" "pcomplete/org-mode/")))
+(register-definition-prefixes "org-pcomplete" '("org-" "pcomplete/org-mode/"))
;;;***
@@ -24347,7 +24823,7 @@ enable the mode if ARG is omitted or nil, and toggle it if ARG is
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/org-plot.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-plot" '("org-plot")))
+(register-definition-prefixes "org-plot" '("org-plot"))
;;;***
@@ -24355,14 +24831,14 @@ enable the mode if ARG is omitted or nil, and toggle it if ARG is
;;;;;; 0))
;;; Generated autoloads from org/org-protocol.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-protocol" '("org-protocol-")))
+(register-definition-prefixes "org-protocol" '("org-protocol-"))
;;;***
;;;### (autoloads nil "org-src" "org/org-src.el" (0 0 0 0))
;;; Generated autoloads from org/org-src.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-src" '("org-")))
+(register-definition-prefixes "org-src" '("org-"))
;;;***
@@ -24370,14 +24846,14 @@ enable the mode if ARG is omitted or nil, and toggle it if ARG is
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/org-table.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-table" '("org")))
+(register-definition-prefixes "org-table" '("org"))
;;;***
;;;### (autoloads nil "org-tempo" "org/org-tempo.el" (0 0 0 0))
;;; Generated autoloads from org/org-tempo.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-tempo" '("org-tempo-")))
+(register-definition-prefixes "org-tempo" '("org-tempo-"))
;;;***
@@ -24385,7 +24861,7 @@ enable the mode if ARG is omitted or nil, and toggle it if ARG is
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/org-timer.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-timer" '("org-timer-")))
+(register-definition-prefixes "org-timer" '("org-timer-"))
;;;***
@@ -24440,12 +24916,15 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
See the command `outline-mode' for more information on this mode.
\(fn &optional ARG)" t nil)
(put 'outline-level 'risky-local-variable t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "outline" '("outline-")))
+(register-definition-prefixes "outline" '("outline-"))
;;;***
@@ -24453,7 +24932,7 @@ See the command `outline-mode' for more information on this mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ox.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox" '("org-export-")))
+(register-definition-prefixes "ox" '("org-export-"))
;;;***
@@ -24461,7 +24940,7 @@ See the command `outline-mode' for more information on this mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ox-ascii.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-ascii" '("org-ascii-")))
+(register-definition-prefixes "ox-ascii" '("org-ascii-"))
;;;***
@@ -24469,7 +24948,7 @@ See the command `outline-mode' for more information on this mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ox-beamer.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-beamer" '("org-beamer-")))
+(register-definition-prefixes "ox-beamer" '("org-beamer-"))
;;;***
@@ -24477,7 +24956,7 @@ See the command `outline-mode' for more information on this mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ox-html.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-html" '("org-html-")))
+(register-definition-prefixes "ox-html" '("org-html-"))
;;;***
@@ -24485,7 +24964,7 @@ See the command `outline-mode' for more information on this mode.
;;;;;; "org/ox-icalendar.el" (0 0 0 0))
;;; Generated autoloads from org/ox-icalendar.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-icalendar" '("org-icalendar-")))
+(register-definition-prefixes "ox-icalendar" '("org-icalendar-"))
;;;***
@@ -24493,7 +24972,7 @@ See the command `outline-mode' for more information on this mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ox-latex.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-latex" '("org-latex-")))
+(register-definition-prefixes "ox-latex" '("org-latex-"))
;;;***
@@ -24501,7 +24980,7 @@ See the command `outline-mode' for more information on this mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ox-man.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-man" '("org-man-")))
+(register-definition-prefixes "ox-man" '("org-man-"))
;;;***
@@ -24509,7 +24988,7 @@ See the command `outline-mode' for more information on this mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ox-md.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-md" '("org-md-")))
+(register-definition-prefixes "ox-md" '("org-md-"))
;;;***
@@ -24517,7 +24996,7 @@ See the command `outline-mode' for more information on this mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ox-odt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-odt" '("org-odt-")))
+(register-definition-prefixes "ox-odt" '("org-odt-"))
;;;***
@@ -24525,7 +25004,7 @@ See the command `outline-mode' for more information on this mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ox-org.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-org" '("org-org-")))
+(register-definition-prefixes "ox-org" '("org-org-"))
;;;***
@@ -24533,7 +25012,7 @@ See the command `outline-mode' for more information on this mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ox-publish.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-publish" '("org-publish-")))
+(register-definition-prefixes "ox-publish" '("org-publish-"))
;;;***
@@ -24541,7 +25020,7 @@ See the command `outline-mode' for more information on this mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ox-texinfo.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-texinfo" '("org-texinfo-")))
+(register-definition-prefixes "ox-texinfo" '("org-texinfo-"))
;;;***
@@ -24684,7 +25163,7 @@ The return value is a string (or nil in case we can't find it)." nil nil)
(function-put 'package-get-version 'pure 't)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "package" '("bad-signature" "define-package" "describe-package-1" "package-")))
+(register-definition-prefixes "package" '("bad-signature" "define-package" "describe-package-1" "package-"))
;;;***
@@ -24707,14 +25186,14 @@ archive).
\(fn FILE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "package-x" '("package-")))
+(register-definition-prefixes "package-x" '("package-"))
;;;***
;;;### (autoloads nil "page-ext" "textmodes/page-ext.el" (0 0 0 0))
;;; Generated autoloads from textmodes/page-ext.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "page-ext" '("pages-")))
+(register-definition-prefixes "page-ext" '("pages-"))
;;;***
@@ -24739,13 +25218,16 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Show Paren mode is a global minor mode. When enabled, any
matching parenthesis is highlighted in `show-paren-style' after
`show-paren-delay' seconds of Emacs idle time.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "paren" '("show-paren-")))
+(register-definition-prefixes "paren" '("show-paren-"))
;;;***
@@ -24756,8 +25238,9 @@ matching parenthesis is highlighted in `show-paren-style' after
(autoload 'parse-time-string "parse-time" "\
Parse the time in STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
-STRING should be something resembling an RFC 822 (or later) date-time, e.g.,
-\"Fri, 25 Mar 2016 16:24:56 +0100\", but this function is
+STRING should be an ISO 8601 time string, e.g., \"2020-01-15T16:12:21-08:00\",
+or something resembling an RFC 822 (or later) date-time, e.g.,
+\"Wed, 15 Jan 2020 16:12:21 -0800\". This function is
somewhat liberal in what format it accepts, and will attempt to
return a \"likely\" value even for somewhat malformed strings.
The values returned are identical to those of `decode-time', but
@@ -24766,7 +25249,7 @@ unknown DST value is returned as -1.
\(fn STRING)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "parse-time" '("parse-")))
+(register-definition-prefixes "parse-time" '("parse-"))
;;;***
@@ -24817,7 +25300,7 @@ See also the user variables `pascal-type-keywords', `pascal-start-keywords' and
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pascal" '("electric-pascal-" "pascal-")))
+(register-definition-prefixes "pascal" '("electric-pascal-" "pascal-"))
;;;***
@@ -24841,7 +25324,7 @@ Check if KEY is in the cache.
\(fn KEY)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "password-cache" '("password-")))
+(register-definition-prefixes "password-cache" '("password-"))
;;;***
@@ -24975,7 +25458,7 @@ for the result of evaluating EXP (first arg to `pcase').
(function-put 'pcase-defmacro 'doc-string-elt '3)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcase" '("pcase-")))
+(register-definition-prefixes "pcase" '("pcase-"))
;;;***
@@ -24985,7 +25468,7 @@ for the result of evaluating EXP (first arg to `pcase').
(autoload 'pcomplete/cvs "pcmpl-cvs" "\
Completion rules for the `cvs' command." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-cvs" '("pcmpl-cvs-")))
+(register-definition-prefixes "pcmpl-cvs" '("pcmpl-cvs-"))
;;;***
@@ -25009,7 +25492,7 @@ Completion for the GNU find utility." nil nil)
(defalias 'pcomplete/gdb 'pcomplete/xargs)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-gnu" '("pcmpl-gnu-")))
+(register-definition-prefixes "pcmpl-gnu" '("pcmpl-gnu-"))
;;;***
@@ -25025,7 +25508,7 @@ Completion for GNU/Linux `umount'." nil nil)
(autoload 'pcomplete/mount "pcmpl-linux" "\
Completion for GNU/Linux `mount'." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-linux" '("pcmpl-linux-" "pcomplete-pare-list")))
+(register-definition-prefixes "pcmpl-linux" '("pcmpl-linux-" "pcomplete-pare-list"))
;;;***
@@ -25035,7 +25518,7 @@ Completion for GNU/Linux `mount'." nil nil)
(autoload 'pcomplete/rpm "pcmpl-rpm" "\
Completion for the `rpm' command." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-rpm" '("pcmpl-rpm-")))
+(register-definition-prefixes "pcmpl-rpm" '("pcmpl-rpm-"))
;;;***
@@ -25074,7 +25557,12 @@ Completion rules for the `ssh' command." nil nil)
Completion rules for the `scp' command.
Includes files as well as host names followed by a colon." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-unix" '("pcmpl-")))
+(autoload 'pcomplete/telnet "pcmpl-unix" nil nil nil)
+
+(autoload 'pcomplete/rsh "pcmpl-unix" "\
+Complete `rsh', which, after the user and hostname, is like xargs." nil nil)
+
+(register-definition-prefixes "pcmpl-unix" '("pcmpl-" "pcomplete/"))
;;;***
@@ -25094,7 +25582,12 @@ long options." nil nil)
(autoload 'pcomplete/ag "pcmpl-x" "\
Completion for the `ag' command." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-x" '("pcmpl-x-")))
+(autoload 'pcomplete/bcc32 "pcmpl-x" "\
+Completion function for Borland's C++ compiler." nil nil)
+
+(defalias 'pcomplete/bcc 'pcomplete/bcc32)
+
+(register-definition-prefixes "pcmpl-x" '("pcmpl-x-"))
;;;***
@@ -25143,7 +25636,7 @@ this is `comint-dynamic-complete-functions'.
(autoload 'pcomplete-shell-setup "pcomplete" "\
Setup `shell-mode' to use pcomplete." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcomplete" '("pcomplete-")))
+(register-definition-prefixes "pcomplete" '("pcomplete-"))
;;;***
@@ -25220,7 +25713,7 @@ Anything else means to do it only if the prefix arg is equal to this value.")
Run `cvs-examine' if DIR is a CVS administrative directory.
The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp dir) (setq dir (directory-file-name dir)) (when (and (string= "CVS" (file-name-nondirectory dir)) (file-readable-p (expand-file-name "Entries" dir)) cvs-dired-use-hook (if (eq cvs-dired-use-hook 'always) (not current-prefix-arg) (equal current-prefix-arg cvs-dired-use-hook))) (save-excursion (funcall cvs-dired-action (file-name-directory dir) t t)))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcvs" '("cvs-" "defun-cvs-mode")))
+(register-definition-prefixes "pcvs" '("cvs-" "defun-cvs-mode"))
;;;***
@@ -25230,28 +25723,28 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d
(defvar cvs-global-menu (let ((m (make-sparse-keymap "PCL-CVS"))) (define-key m [status] `(menu-item ,(purecopy "Directory Status") cvs-status :help ,(purecopy "A more verbose status of a workarea"))) (define-key m [checkout] `(menu-item ,(purecopy "Checkout Module") cvs-checkout :help ,(purecopy "Check out a module from the repository"))) (define-key m [update] `(menu-item ,(purecopy "Update Directory") cvs-update :help ,(purecopy "Fetch updates from the repository"))) (define-key m [examine] `(menu-item ,(purecopy "Examine Directory") cvs-examine :help ,(purecopy "Examine the current state of a workarea"))) (fset 'cvs-global-menu m)) "\
Global menu used by PCL-CVS.")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcvs-defs" '("cvs-")))
+(register-definition-prefixes "pcvs-defs" '("cvs-"))
;;;***
;;;### (autoloads nil "pcvs-info" "vc/pcvs-info.el" (0 0 0 0))
;;; Generated autoloads from vc/pcvs-info.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcvs-info" '("cvs-")))
+(register-definition-prefixes "pcvs-info" '("cvs-"))
;;;***
;;;### (autoloads nil "pcvs-parse" "vc/pcvs-parse.el" (0 0 0 0))
;;; Generated autoloads from vc/pcvs-parse.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcvs-parse" '("cvs-")))
+(register-definition-prefixes "pcvs-parse" '("cvs-"))
;;;***
;;;### (autoloads nil "pcvs-util" "vc/pcvs-util.el" (0 0 0 0))
;;; Generated autoloads from vc/pcvs-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcvs-util" '("cvs-")))
+(register-definition-prefixes "pcvs-util" '("cvs-"))
;;;***
@@ -25323,7 +25816,7 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "perl-mode" '("indent-perl-exp" "mark-perl-function" "perl-")))
+(register-definition-prefixes "perl-mode" '("indent-perl-exp" "mark-perl-function" "perl-"))
;;;***
@@ -25403,14 +25896,14 @@ they are not by default assigned to keys." t nil)
(defalias 'edit-picture 'picture-mode)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "picture" '("picture-")))
+(register-definition-prefixes "picture" '("picture-"))
;;;***
;;;### (autoloads nil "pinyin" "language/pinyin.el" (0 0 0 0))
;;; Generated autoloads from language/pinyin.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pinyin" '("pinyin-character-map")))
+(register-definition-prefixes "pinyin" '("pinyin-character-map"))
;;;***
@@ -25435,9 +25928,12 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pixel-scroll" '("pixel-")))
+(register-definition-prefixes "pixel-scroll" '("pixel-"))
;;;***
@@ -25454,7 +25950,7 @@ Major mode for editing PLSTORE files.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "plstore" '("plstore-")))
+(register-definition-prefixes "plstore" '("plstore-"))
;;;***
@@ -25467,7 +25963,7 @@ Called through `file-coding-system-alist', before the file is visited for real.
\(fn ARG-LIST)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "po" '("po-")))
+(register-definition-prefixes "po" '("po-"))
;;;***
@@ -25483,7 +25979,7 @@ pong-mode keybindings:\\<pong-mode-map>
\\{pong-mode-map}" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pong" '("pong-")))
+(register-definition-prefixes "pong" '("pong-"))
;;;***
@@ -25496,7 +25992,7 @@ Use streaming commands.
\(fn FILE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pop3" '("pop3-")))
+(register-definition-prefixes "pop3" '("pop3-"))
;;;***
@@ -25546,7 +26042,7 @@ Ignores leading comment characters.
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pp" '("pp-")))
+(register-definition-prefixes "pp" '("pp-"))
;;;***
@@ -26086,7 +26582,7 @@ are both set to t.
\(fn &optional SELECT-PRINTER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "printing" '("lpr-setup" "pr-")))
+(register-definition-prefixes "printing" '("lpr-setup" "pr-"))
;;;***
@@ -26106,7 +26602,7 @@ Proced buffers.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "proced" '("proced-")))
+(register-definition-prefixes "proced" '("proced-"))
;;;***
@@ -26136,21 +26632,63 @@ Open profile FILENAME.
\(fn FILENAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "profiler" '("profiler-")))
+(register-definition-prefixes "profiler" '("profiler-"))
;;;***
;;;### (autoloads nil "project" "progmodes/project.el" (0 0 0 0))
;;; Generated autoloads from progmodes/project.el
+(push (purecopy '(project 0 5 2)) package--builtin-versions)
(autoload 'project-current "project" "\
-Return the project instance in DIR or `default-directory'.
-When no project found in DIR, and MAYBE-PROMPT is non-nil, ask
-the user for a different directory to look in. If that directory
-is not a part of a detectable project either, return a
-`transient' project instance rooted in it.
+Return the project instance in DIRECTORY, defaulting to `default-directory'.
+
+When no project is found in that directory, the result depends on
+the value of MAYBE-PROMPT: if it is nil or omitted, return nil,
+else ask the user for a directory in which to look for the
+project, and if no project is found there, return a \"transient\"
+project instance.
+
+The \"transient\" project instance is a special kind of value
+which denotes a project rooted in that directory and includes all
+the files under the directory except for those that should be
+ignored (per `project-ignores').
+
+See the doc string of `project-find-functions' for the general form
+of the project instance object.
+
+\(fn &optional MAYBE-PROMPT DIRECTORY)" nil nil)
+
+(defvar project-prefix-map (let ((map (make-sparse-keymap))) (define-key map "!" 'project-shell-command) (define-key map "&" 'project-async-shell-command) (define-key map "f" 'project-find-file) (define-key map "F" 'project-or-external-find-file) (define-key map "b" 'project-switch-to-buffer) (define-key map "s" 'project-shell) (define-key map "d" 'project-dired) (define-key map "v" 'project-vc-dir) (define-key map "c" 'project-compile) (define-key map "e" 'project-eshell) (define-key map "k" 'project-kill-buffers) (define-key map "p" 'project-switch-project) (define-key map "g" 'project-find-regexp) (define-key map "G" 'project-or-external-find-regexp) (define-key map "r" 'project-query-replace-regexp) map) "\
+Keymap for project commands.")
+ (define-key ctl-x-map "p" project-prefix-map)
-\(fn &optional MAYBE-PROMPT DIR)" nil nil)
+(autoload 'project-other-window-command "project" "\
+Run project command, displaying resultant buffer in another window.
+
+The following commands are available:
+
+\\{project-prefix-map}
+\\{project-other-window-map}" t nil)
+ (define-key ctl-x-4-map "p" #'project-other-window-command)
+
+(autoload 'project-other-frame-command "project" "\
+Run project command, displaying resultant buffer in another frame.
+
+The following commands are available:
+
+\\{project-prefix-map}
+\\{project-other-frame-map}" t nil)
+ (define-key ctl-x-5-map "p" #'project-other-frame-command)
+
+(autoload 'project-other-tab-command "project" "\
+Run project command, displaying resultant buffer in a new tab.
+
+The following commands are available:
+
+\\{project-prefix-map}" t nil)
+
+(when (bound-and-true-p tab-prefix-map) (define-key tab-prefix-map "p" #'project-other-tab-command))
(autoload 'project-find-regexp "project" "\
Find all matches for REGEXP in the current project's roots.
@@ -26171,15 +26709,41 @@ pattern to search for.
\(fn REGEXP)" t nil)
(autoload 'project-find-file "project" "\
-Visit a file (with completion) in the current project's roots.
+Visit a file (with completion) in the current project.
The completion default is the filename at point, if one is
recognized." t nil)
(autoload 'project-or-external-find-file "project" "\
-Visit a file (with completion) in the current project's roots or external roots.
+Visit a file (with completion) in the current project or external roots.
The completion default is the filename at point, if one is
recognized." t nil)
+(autoload 'project-dired "project" "\
+Start Dired in the current project's root." t nil)
+
+(autoload 'project-vc-dir "project" "\
+Run VC-Dir in the current project's root." t nil)
+
+(autoload 'project-shell "project" "\
+Start an inferior shell in the current project's root directory.
+If a buffer already exists for running a shell in the project's root,
+switch to it. Otherwise, create a new shell buffer.
+With \\[universal-argument] prefix arg, create a new inferior shell buffer even
+if one already exists." t nil)
+
+(autoload 'project-eshell "project" "\
+Start Eshell in the current project's root directory.
+If a buffer already exists for running Eshell in the project's root,
+switch to it. Otherwise, create a new Eshell buffer.
+With \\[universal-argument] prefix arg, create a new Eshell buffer even
+if one already exists." t nil)
+
+(autoload 'project-async-shell-command "project" "\
+Run `async-shell-command' in the current project's root directory." t nil)
+
+(autoload 'project-shell-command "project" "\
+Run `shell-command' in the current project's root directory." t nil)
+
(autoload 'project-search "project" "\
Search for REGEXP in all the files of the project.
Stops when a match is found.
@@ -26196,7 +26760,82 @@ loop using the command \\[fileloop-continue].
\(fn FROM TO)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "project" '("project-")))
+(autoload 'project-compile "project" "\
+Run `compile' in the project root.
+Arguments the same as in `compile'.
+
+\(fn COMMAND &optional COMINT)" t nil)
+
+(autoload 'project-switch-to-buffer "project" "\
+Display buffer BUFFER-OR-NAME in the selected window.
+When called interactively, prompts for a buffer belonging to the
+current project. Two buffers belong to the same project if their
+project instances, as reported by `project-current' in each
+buffer, are identical.
+
+\(fn BUFFER-OR-NAME)" t nil)
+
+(autoload 'project-display-buffer "project" "\
+Display BUFFER-OR-NAME in some window, without selecting it.
+When called interactively, prompts for a buffer belonging to the
+current project. Two buffers belong to the same project if their
+project instances, as reported by `project-current' in each
+buffer, are identical.
+
+This function uses `display-buffer' as a subroutine, which see
+for how it is determined where the buffer will be displayed.
+
+\(fn BUFFER-OR-NAME)" t nil)
+
+(autoload 'project-display-buffer-other-frame "project" "\
+Display BUFFER-OR-NAME preferably in another frame.
+When called interactively, prompts for a buffer belonging to the
+current project. Two buffers belong to the same project if their
+project instances, as reported by `project-current' in each
+buffer, are identical.
+
+This function uses `display-buffer-other-frame' as a subroutine,
+which see for how it is determined where the buffer will be
+displayed.
+
+\(fn BUFFER-OR-NAME)" t nil)
+
+(autoload 'project-kill-buffers "project" "\
+Kill the buffers belonging to the current project.
+Two buffers belong to the same project if their project
+instances, as reported by `project-current' in each buffer, are
+identical. Only the buffers that match a condition in
+`project-kill-buffer-conditions' will be killed. If NO-CONFIRM
+is non-nil, the command will not ask the user for confirmation.
+NO-CONFIRM is always nil when the command is invoked
+interactively.
+
+\(fn &optional NO-CONFIRM)" t nil)
+
+(autoload 'project-remember-project "project" "\
+Add project PR to the front of the project list.
+Save the result in `project-list-file' if the list of projects has changed.
+
+\(fn PR)" nil nil)
+
+(autoload 'project-known-project-roots "project" "\
+Return the list of root directories of all known projects." nil nil)
+
+(defvar project-switch-commands '((102 "Find file" project-find-file) (103 "Find regexp" project-find-regexp) (100 "Dired" project-dired) (118 "VC-Dir" project-vc-dir) (101 "Eshell" project-eshell)) "\
+Alist mapping keys to project switching menu entries.
+Used by `project-switch-project' to construct a dispatch menu of
+commands available upon \"switching\" to another project.
+
+Each element is of the form (KEY LABEL COMMAND), where COMMAND is the
+command to run when KEY is pressed. LABEL is used to distinguish
+the menu entries in the dispatch menu.")
+
+(autoload 'project-switch-project "project" "\
+\"Switch\" to another project by running an Emacs command.
+The available commands are presented as a dispatch menu
+made from `project-switch-commands'." t nil)
+
+(register-definition-prefixes "project" '("project-"))
;;;***
@@ -26231,7 +26870,7 @@ With prefix argument ARG, restart the Prolog process if running before.
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "prolog" '("mercury-mode-map" "prolog-")))
+(register-definition-prefixes "prolog" '("mercury-mode-map" "prolog-"))
;;;***
@@ -26244,14 +26883,14 @@ The default value is (\"/usr/local/share/emacs/fonts/bdf\").")
(custom-autoload 'bdf-directory-list "ps-bdf" t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-bdf" '("bdf-")))
+(register-definition-prefixes "ps-bdf" '("bdf-"))
;;;***
;;;### (autoloads nil "ps-def" "ps-def.el" (0 0 0 0))
;;; Generated autoloads from ps-def.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-def" '("ps-")))
+(register-definition-prefixes "ps-def" '("ps-"))
;;;***
@@ -26299,7 +26938,7 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-mode" '("ps-")))
+(register-definition-prefixes "ps-mode" '("ps-"))
;;;***
@@ -26307,7 +26946,7 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number
;;;;;; (0 0 0 0))
;;; Generated autoloads from ps-mule.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-mule" '("ps-mule-")))
+(register-definition-prefixes "ps-mule" '("ps-mule-"))
;;;***
@@ -26496,14 +27135,14 @@ If EXTENSION is any other symbol, it is ignored.
\(fn FACE-EXTENSION &optional MERGE-P ALIST-SYM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-print" '("ps-")))
+(register-definition-prefixes "ps-print" '("ps-"))
;;;***
;;;### (autoloads nil "ps-samp" "ps-samp.el" (0 0 0 0))
;;; Generated autoloads from ps-samp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-samp" '("ps-")))
+(register-definition-prefixes "ps-samp" '("ps-"))
;;;***
@@ -26523,14 +27162,14 @@ Optional argument FACE specifies the face to do the highlighting.
\(fn START END &optional FACE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pulse" '("pulse-")))
+(register-definition-prefixes "pulse" '("pulse-"))
;;;***
;;;### (autoloads nil "puny" "net/puny.el" (0 0 0 0))
;;; Generated autoloads from net/puny.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "puny" '("puny-")))
+(register-definition-prefixes "puny" '("puny-"))
;;;***
@@ -26569,7 +27208,7 @@ Major mode for editing Python files.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "python" '("inferior-python-mode" "python-" "run-python-internal")))
+(register-definition-prefixes "python" '("inferior-python-mode" "python-" "run-python-internal"))
;;;***
@@ -26590,7 +27229,7 @@ them into characters should be done separately.
\(fn FROM TO &optional CODING-SYSTEM)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "qp" '("quoted-printable-")))
+(register-definition-prefixes "qp" '("quoted-printable-"))
;;;***
@@ -26820,7 +27459,7 @@ of each directory.
\(fn DIRNAME &rest DIRNAMES)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail" '("quail-")))
+(register-definition-prefixes "quail" '("quail-"))
;;;***
@@ -26828,7 +27467,7 @@ of each directory.
;;;;;; 0 0 0))
;;; Generated autoloads from leim/quail/ethiopic.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/ethiopic" '("ethio-select-a-translation")))
+(register-definition-prefixes "quail/ethiopic" '("ethio-select-a-translation"))
;;;***
@@ -26843,7 +27482,7 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'.
\(fn INPUT-METHOD FUNC HELP-TEXT &rest ARGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/hangul" '("alphabetp" "hangul" "notzerop")))
+(register-definition-prefixes "quail/hangul" '("alphabetp" "hangul" "notzerop"))
;;;***
@@ -26851,14 +27490,14 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'.
;;;;;; 0 0))
;;; Generated autoloads from leim/quail/indian.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/indian" '("inscript-" "quail-")))
+(register-definition-prefixes "quail/indian" '("indian-mlm-mozhi-u" "inscript-" "quail-"))
;;;***
;;;### (autoloads nil "quail/ipa" "leim/quail/ipa.el" (0 0 0 0))
;;; Generated autoloads from leim/quail/ipa.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/ipa" '("ipa-x-sampa-")))
+(register-definition-prefixes "quail/ipa" '("ipa-x-sampa-"))
;;;***
@@ -26866,21 +27505,21 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'.
;;;;;; 0 0 0))
;;; Generated autoloads from leim/quail/japanese.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/japanese" '("quail-japanese-")))
+(register-definition-prefixes "quail/japanese" '("quail-japanese-"))
;;;***
;;;### (autoloads nil "quail/lao" "leim/quail/lao.el" (0 0 0 0))
;;; Generated autoloads from leim/quail/lao.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/lao" '("lao-" "quail-lao-update-translation")))
+(register-definition-prefixes "quail/lao" '("lao-" "quail-lao-update-translation"))
;;;***
;;;### (autoloads nil "quail/lrt" "leim/quail/lrt.el" (0 0 0 0))
;;; Generated autoloads from leim/quail/lrt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/lrt" '("quail-lrt-update-translation")))
+(register-definition-prefixes "quail/lrt" '("quail-lrt-update-translation"))
;;;***
@@ -26888,14 +27527,14 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'.
;;;;;; 0 0 0))
;;; Generated autoloads from leim/quail/sisheng.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/sisheng" '("quail-make-sisheng-rules" "sisheng-")))
+(register-definition-prefixes "quail/sisheng" '("quail-make-sisheng-rules" "sisheng-"))
;;;***
;;;### (autoloads nil "quail/thai" "leim/quail/thai.el" (0 0 0 0))
;;; Generated autoloads from leim/quail/thai.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/thai" '("thai-generate-quail-map")))
+(register-definition-prefixes "quail/thai" '("thai-generate-quail-map"))
;;;***
@@ -26903,7 +27542,7 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'.
;;;;;; 0 0 0))
;;; Generated autoloads from leim/quail/tibetan.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/tibetan" '("quail-tib" "tibetan-")))
+(register-definition-prefixes "quail/tibetan" '("quail-tib" "tibetan-"))
;;;***
@@ -26920,14 +27559,14 @@ While this input method is active, the variable
\(fn &optional ARG)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/uni-input" '("ucs-input-")))
+(register-definition-prefixes "quail/uni-input" '("ucs-input-"))
;;;***
;;;### (autoloads nil "quail/viqr" "leim/quail/viqr.el" (0 0 0 0))
;;; Generated autoloads from leim/quail/viqr.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/viqr" '("viet-quail-define-rules")))
+(register-definition-prefixes "quail/viqr" '("viet-quail-define-rules"))
;;;***
@@ -26996,7 +27635,7 @@ The key bindings for `quickurl-list-mode' are:
(autoload 'quickurl-list "quickurl" "\
Display `quickurl-list' as a formatted list using `quickurl-list-mode'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quickurl" '("quickurl-")))
+(register-definition-prefixes "quickurl" '("quickurl-"))
;;;***
@@ -27004,7 +27643,7 @@ Display `quickurl-list' as a formatted list using `quickurl-list-mode'." t nil)
;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/radix-tree.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "radix-tree" '("radix-tree-")))
+(register-definition-prefixes "radix-tree" '("radix-tree-"))
;;;***
@@ -27045,9 +27684,12 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rcirc" '("defun-rcirc-command" "rcirc-" "set-rcirc-" "with-rcirc-")))
+(register-definition-prefixes "rcirc" '("defun-rcirc-command" "rcirc-" "set-rcirc-" "with-rcirc-"))
;;;***
@@ -27066,7 +27708,7 @@ 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)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "re-builder" '("re-builder-unload-function" "reb-")))
+(register-definition-prefixes "re-builder" '("re-builder-unload-function" "reb-"))
;;;***
@@ -27091,13 +27733,16 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When Recentf mode is enabled, a \"Open Recent\" submenu is
displayed in the \"File\" menu, containing a list of files that
were operated on recently, in the most-recently-used order.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "recentf" '("recentf-")))
+(register-definition-prefixes "recentf" '("recentf-"))
;;;***
@@ -27243,25 +27888,28 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Activates the region if needed. Only lasts until the region is deactivated.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rect" '("apply-on-rectangle" "clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope" "rectangle-" "spaces-string" "string-rectangle-")))
+(register-definition-prefixes "rect" '("apply-on-rectangle" "clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope" "rectangle-" "spaces-string" "string-rectangle-"))
;;;***
;;;### (autoloads nil "refbib" "textmodes/refbib.el" (0 0 0 0))
;;; Generated autoloads from textmodes/refbib.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "refbib" '("r2b-")))
+(register-definition-prefixes "refbib" '("r2b-"))
;;;***
;;;### (autoloads nil "refer" "textmodes/refer.el" (0 0 0 0))
;;; Generated autoloads from textmodes/refer.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "refer" '("refer-")))
+(register-definition-prefixes "refer" '("refer-"))
;;;***
@@ -27276,6 +27924,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Refill mode is a buffer-local minor mode. When enabled, the
current paragraph is refilled as you edit. Self-inserting
characters only cause refilling if they would cause
@@ -27285,7 +27936,7 @@ For true \"word wrap\" behavior, use `visual-line-mode' instead.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "refill" '("refill-")))
+(register-definition-prefixes "refill" '("refill-"))
;;;***
@@ -27307,6 +27958,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\\<reftex-mode-map>A Table of Contents of the entire (multifile) document with browsing
capabilities is available with `\\[reftex-toc]'.
@@ -27341,7 +27995,7 @@ on the menu bar.
Reset the symbols containing information from buffer scanning.
This enforces rescanning the buffer on next use." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex" '("reftex-")))
+(register-definition-prefixes "reftex" '("reftex-"))
;;;***
@@ -27349,7 +28003,7 @@ This enforces rescanning the buffer on next use." nil nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from textmodes/reftex-auc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-auc" '("reftex-")))
+(register-definition-prefixes "reftex-auc" '("reftex-"))
;;;***
@@ -27357,7 +28011,7 @@ This enforces rescanning the buffer on next use." nil nil)
;;;;;; "textmodes/reftex-cite.el" (0 0 0 0))
;;; Generated autoloads from textmodes/reftex-cite.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-cite" '("reftex-")))
+(register-definition-prefixes "reftex-cite" '("reftex-"))
;;;***
@@ -27365,7 +28019,7 @@ This enforces rescanning the buffer on next use." nil nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from textmodes/reftex-dcr.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-dcr" '("reftex-")))
+(register-definition-prefixes "reftex-dcr" '("reftex-"))
;;;***
@@ -27373,7 +28027,7 @@ This enforces rescanning the buffer on next use." nil nil)
;;;;;; "textmodes/reftex-global.el" (0 0 0 0))
;;; Generated autoloads from textmodes/reftex-global.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-global" '("reftex-")))
+(register-definition-prefixes "reftex-global" '("reftex-"))
;;;***
@@ -27381,7 +28035,7 @@ This enforces rescanning the buffer on next use." nil nil)
;;;;;; "textmodes/reftex-index.el" (0 0 0 0))
;;; Generated autoloads from textmodes/reftex-index.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-index" '("reftex-")))
+(register-definition-prefixes "reftex-index" '("reftex-"))
;;;***
@@ -27389,7 +28043,7 @@ This enforces rescanning the buffer on next use." nil nil)
;;;;;; "textmodes/reftex-parse.el" (0 0 0 0))
;;; Generated autoloads from textmodes/reftex-parse.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-parse" '("reftex-")))
+(register-definition-prefixes "reftex-parse" '("reftex-"))
;;;***
@@ -27397,7 +28051,7 @@ This enforces rescanning the buffer on next use." nil nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from textmodes/reftex-ref.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-ref" '("reftex-")))
+(register-definition-prefixes "reftex-ref" '("reftex-"))
;;;***
@@ -27405,7 +28059,7 @@ This enforces rescanning the buffer on next use." nil nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from textmodes/reftex-sel.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-sel" '("reftex-")))
+(register-definition-prefixes "reftex-sel" '("reftex-"))
;;;***
@@ -27413,7 +28067,7 @@ This enforces rescanning the buffer on next use." nil nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from textmodes/reftex-toc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-toc" '("reftex-")))
+(register-definition-prefixes "reftex-toc" '("reftex-"))
;;;***
@@ -27425,7 +28079,7 @@ This enforces rescanning the buffer on next use." nil nil)
(put 'reftex-level-indent 'safe-local-variable 'integerp)
(put 'reftex-guess-label-type 'safe-local-variable (lambda (x) (memq x '(nil t))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-vars" '("reftex-")))
+(register-definition-prefixes "reftex-vars" '("reftex-"))
;;;***
@@ -27489,7 +28143,7 @@ This means the number of non-shy regexp grouping constructs
\(fn REGEXP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "regexp-opt" '("regexp-opt-")))
+(register-definition-prefixes "regexp-opt" '("regexp-opt-"))
;;;***
@@ -27497,20 +28151,19 @@ This means the number of non-shy regexp grouping constructs
;;; Generated autoloads from emacs-lisp/regi.el
(push (purecopy '(regi 1 8)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "regi" '("regi-")))
+(register-definition-prefixes "regi" '("regi-"))
;;;***
;;;### (autoloads nil "registry" "registry.el" (0 0 0 0))
;;; Generated autoloads from registry.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "registry" '("registry-")))
+(register-definition-prefixes "registry" '("registry-"))
;;;***
;;;### (autoloads nil "remember" "textmodes/remember.el" (0 0 0 0))
;;; Generated autoloads from textmodes/remember.el
-(push (purecopy '(remember 2 0)) package--builtin-versions)
(autoload 'remember "remember" "\
Remember an arbitrary piece of data.
@@ -27556,13 +28209,12 @@ to turn the *scratch* buffer into your notes buffer.
\(fn &optional SWITCH-TO)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "remember" '("remember-")))
+(register-definition-prefixes "remember" '("remember-"))
;;;***
;;;### (autoloads nil "repeat" "repeat.el" (0 0 0 0))
;;; Generated autoloads from repeat.el
-(push (purecopy '(repeat 0 51)) package--builtin-versions)
(autoload 'repeat "repeat" "\
Repeat most recently executed command.
@@ -27581,7 +28233,7 @@ recently executed command not bound to an input event\".
\(fn REPEAT-ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "repeat" '("repeat-")))
+(register-definition-prefixes "repeat" '("repeat-"))
;;;***
@@ -27614,7 +28266,7 @@ mail-sending package is used for editing and sending the message.
\(fn ADDRESS PKGNAME VARLIST &optional PRE-HOOKS POST-HOOKS SALUTATION)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reporter" '("reporter-")))
+(register-definition-prefixes "reporter" '("reporter-"))
;;;***
@@ -27642,7 +28294,7 @@ first comment line visible (if point is in a comment).
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reposition" '("repos-count-screen-lines")))
+(register-definition-prefixes "reposition" '("repos-count-screen-lines"))
;;;***
@@ -27657,9 +28309,14 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Reveal mode is a buffer-local minor mode. When enabled, it
reveals invisible text around point.
+Also see the `reveal-auto-hide' variable.
+
\(fn &optional ARG)" t nil)
(defvar global-reveal-mode nil "\
@@ -27681,9 +28338,12 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reveal" '("reveal-")))
+(register-definition-prefixes "reveal" '("reveal-"))
;;;***
@@ -27691,49 +28351,49 @@ enable the mode if ARG is omitted or nil, and toggle it if ARG is
;;;;;; 0))
;;; Generated autoloads from international/rfc1843.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc1843" '("rfc1843-")))
+(register-definition-prefixes "rfc1843" '("rfc1843-"))
;;;***
;;;### (autoloads nil "rfc2045" "mail/rfc2045.el" (0 0 0 0))
;;; Generated autoloads from mail/rfc2045.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc2045" '("rfc2045-encode-string")))
+(register-definition-prefixes "rfc2045" '("rfc2045-encode-string"))
;;;***
;;;### (autoloads nil "rfc2047" "mail/rfc2047.el" (0 0 0 0))
;;; Generated autoloads from mail/rfc2047.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc2047" '("rfc2047-")))
+(register-definition-prefixes "rfc2047" '("rfc2047-"))
;;;***
;;;### (autoloads nil "rfc2104" "net/rfc2104.el" (0 0 0 0))
;;; Generated autoloads from net/rfc2104.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc2104" '("rfc2104-")))
+(register-definition-prefixes "rfc2104" '("rfc2104-"))
;;;***
;;;### (autoloads nil "rfc2231" "mail/rfc2231.el" (0 0 0 0))
;;; Generated autoloads from mail/rfc2231.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc2231" '("rfc2231-")))
+(register-definition-prefixes "rfc2231" '("rfc2231-"))
;;;***
;;;### (autoloads nil "rfc2368" "mail/rfc2368.el" (0 0 0 0))
;;; Generated autoloads from mail/rfc2368.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc2368" '("rfc2368-")))
+(register-definition-prefixes "rfc2368" '("rfc2368-"))
;;;***
;;;### (autoloads nil "rfc822" "mail/rfc822.el" (0 0 0 0))
;;; Generated autoloads from mail/rfc822.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc822" '("rfc822-")))
+(register-definition-prefixes "rfc822" '("rfc822-"))
;;;***
@@ -27750,7 +28410,7 @@ Make a ring that can contain SIZE elements.
\(fn SIZE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ring" '("ring-")))
+(register-definition-prefixes "ring" '("ring-"))
;;;***
@@ -27796,7 +28456,7 @@ variable.
\(fn INPUT-ARGS &optional BUFFER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rlogin" '("rlogin-")))
+(register-definition-prefixes "rlogin" '("rlogin-"))
;;;***
@@ -27993,7 +28653,7 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server.
\(fn PASSWORD)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmail" '("mail-" "rmail-")))
+(register-definition-prefixes "rmail" '("mail-" "rmail-"))
;;;***
@@ -28001,7 +28661,7 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server.
;;;;;; (0 0 0 0))
;;; Generated autoloads from mail/rmail-spam-filter.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmail-spam-filter" '("rmail-" "rsf-")))
+(register-definition-prefixes "rmail-spam-filter" '("rmail-" "rsf-"))
;;;***
@@ -28009,7 +28669,7 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server.
;;;;;; (0 0 0 0))
;;; Generated autoloads from mail/rmailedit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailedit" '("rmail-")))
+(register-definition-prefixes "rmailedit" '("rmail-"))
;;;***
@@ -28017,7 +28677,7 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server.
;;;;;; (0 0 0 0))
;;; Generated autoloads from mail/rmailkwd.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailkwd" '("rmail-")))
+(register-definition-prefixes "rmailkwd" '("rmail-"))
;;;***
@@ -28025,7 +28685,7 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server.
;;;;;; (0 0 0 0))
;;; Generated autoloads from mail/rmailmm.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailmm" '("rmail-")))
+(register-definition-prefixes "rmailmm" '("rmail-"))
;;;***
@@ -28097,7 +28757,7 @@ than appending to it. Deletes the message after writing if
\(fn FILE-NAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailout" '("rmail-")))
+(register-definition-prefixes "rmailout" '("rmail-"))
;;;***
@@ -28105,7 +28765,7 @@ than appending to it. Deletes the message after writing if
;;;;;; (0 0 0 0))
;;; Generated autoloads from mail/rmailsort.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailsort" '("rmail-")))
+(register-definition-prefixes "rmailsort" '("rmail-"))
;;;***
@@ -28113,7 +28773,7 @@ than appending to it. Deletes the message after writing if
;;;;;; (0 0 0 0))
;;; Generated autoloads from mail/rmailsum.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailsum" '("rmail-")))
+(register-definition-prefixes "rmailsum" '("rmail-"))
;;;***
@@ -28166,35 +28826,35 @@ Return a pattern.
\(fn FILENAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-cmpct" '("rng-")))
+(register-definition-prefixes "rng-cmpct" '("rng-"))
;;;***
;;;### (autoloads nil "rng-dt" "nxml/rng-dt.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-dt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-dt" '("rng-dt-")))
+(register-definition-prefixes "rng-dt" '("rng-dt-"))
;;;***
;;;### (autoloads nil "rng-loc" "nxml/rng-loc.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-loc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-loc" '("rng-")))
+(register-definition-prefixes "rng-loc" '("rng-"))
;;;***
;;;### (autoloads nil "rng-maint" "nxml/rng-maint.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-maint.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-maint" '("rng-")))
+(register-definition-prefixes "rng-maint" '("rng-"))
;;;***
;;;### (autoloads nil "rng-match" "nxml/rng-match.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-match.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-match" '("rng-")))
+(register-definition-prefixes "rng-match" '("rng-"))
;;;***
@@ -28206,35 +28866,35 @@ Initialize `nxml-mode' to take advantage of `rng-validate-mode'.
This is typically called from `nxml-mode-hook'.
Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-nxml" '("rng-")))
+(register-definition-prefixes "rng-nxml" '("rng-"))
;;;***
;;;### (autoloads nil "rng-parse" "nxml/rng-parse.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-parse.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-parse" '("rng-parse-")))
+(register-definition-prefixes "rng-parse" '("rng-parse-"))
;;;***
;;;### (autoloads nil "rng-pttrn" "nxml/rng-pttrn.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-pttrn.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-pttrn" '("rng-")))
+(register-definition-prefixes "rng-pttrn" '("rng-"))
;;;***
;;;### (autoloads nil "rng-uri" "nxml/rng-uri.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-uri.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-uri" '("rng-")))
+(register-definition-prefixes "rng-uri" '("rng-"))
;;;***
;;;### (autoloads nil "rng-util" "nxml/rng-util.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-util" '("rng-")))
+(register-definition-prefixes "rng-util" '("rng-"))
;;;***
@@ -28249,6 +28909,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Checks whether the buffer is a well-formed XML 1.0 document,
conforming to the XML Namespaces Recommendation and valid against a
RELAX NG schema. The mode-line indicates whether it is or not. Any
@@ -28271,14 +28934,14 @@ to use for finding the schema.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-valid" '("rng-")))
+(register-definition-prefixes "rng-valid" '("rng-"))
;;;***
;;;### (autoloads nil "rng-xsd" "nxml/rng-xsd.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-xsd.el
-(put 'http://www\.w3\.org/2001/XMLSchema-datatypes 'rng-dt-compile #'rng-xsd-compile)
+(put 'https://www\.w3\.org/2001/XMLSchema-datatypes 'rng-dt-compile #'rng-xsd-compile)
(autoload 'rng-xsd-compile "rng-xsd" "\
Provide W3C XML Schema as a RELAX NG datatypes library.
@@ -28300,7 +28963,7 @@ must be equal.
\(fn NAME PARAMS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-xsd" '("rng-xsd-" "xsd-duration-reference-dates")))
+(register-definition-prefixes "rng-xsd" '("rng-xsd-" "xsd-duration-reference-dates"))
;;;***
@@ -28334,7 +28997,7 @@ Start using robin package NAME, which is a string.
\(fn NAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "robin" '("robin-")))
+(register-definition-prefixes "robin" '("robin-"))
;;;***
@@ -28372,7 +29035,7 @@ See also `toggle-rot13-mode'." t nil)
(autoload 'toggle-rot13-mode "rot13" "\
Toggle the use of ROT13 encoding for the current window." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rot13" '("rot13-")))
+(register-definition-prefixes "rot13" '("rot13-"))
;;;***
@@ -28400,20 +29063,23 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
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.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rst" '("rst-")))
+(register-definition-prefixes "rst" '("rst-"))
;;;***
;;;### (autoloads nil "rtree" "rtree.el" (0 0 0 0))
;;; Generated autoloads from rtree.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rtree" '("rtree-")))
+(register-definition-prefixes "rtree" '("rtree-"))
;;;***
@@ -28431,13 +29097,12 @@ Major mode for editing Ruby code.
(dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'ruby-mode)))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ruby-mode" '("ruby-")))
+(register-definition-prefixes "ruby-mode" '("ruby-"))
;;;***
;;;### (autoloads nil "ruler-mode" "ruler-mode.el" (0 0 0 0))
;;; Generated autoloads from ruler-mode.el
-(push (purecopy '(ruler-mode 1 6)) package--builtin-versions)
(defvar ruler-mode nil "\
Non-nil if Ruler mode is enabled.
@@ -28451,9 +29116,12 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ruler-mode" '("ruler-")))
+(register-definition-prefixes "ruler-mode" '("ruler-"))
;;;***
@@ -28645,30 +29313,30 @@ For more details, see Info node `(elisp) Extending Rx'.
\(fn NAME [(ARGS...)] RX)" nil t)
-(function-put 'rx-define 'lisp-indent-function '1)
+(function-put 'rx-define 'lisp-indent-function 'defun)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rx" '("rx-")))
+(register-definition-prefixes "rx" '("rx-"))
;;;***
;;;### (autoloads nil "sasl" "net/sasl.el" (0 0 0 0))
;;; Generated autoloads from net/sasl.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl" '("sasl-")))
+(register-definition-prefixes "sasl" '("sasl-"))
;;;***
;;;### (autoloads nil "sasl-cram" "net/sasl-cram.el" (0 0 0 0))
;;; Generated autoloads from net/sasl-cram.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl-cram" '("sasl-cram-md5-")))
+(register-definition-prefixes "sasl-cram" '("sasl-cram-md5-"))
;;;***
;;;### (autoloads nil "sasl-digest" "net/sasl-digest.el" (0 0 0 0))
;;; Generated autoloads from net/sasl-digest.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl-digest" '("sasl-digest-md5-")))
+(register-definition-prefixes "sasl-digest" '("sasl-digest-md5-"))
;;;***
@@ -28676,7 +29344,7 @@ For more details, see Info node `(elisp) Extending Rx'.
;;; Generated autoloads from net/sasl-ntlm.el
(push (purecopy '(sasl 1 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl-ntlm" '("sasl-ntlm-")))
+(register-definition-prefixes "sasl-ntlm" '("sasl-ntlm-"))
;;;***
@@ -28684,7 +29352,15 @@ For more details, see Info node `(elisp) Extending Rx'.
;;;;;; 0 0 0))
;;; Generated autoloads from net/sasl-scram-rfc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl-scram-rfc" '("sasl-scram-")))
+(register-definition-prefixes "sasl-scram-rfc" '("sasl-scram-"))
+
+;;;***
+
+;;;### (autoloads nil "sasl-scram-sha256" "net/sasl-scram-sha256.el"
+;;;;;; (0 0 0 0))
+;;; Generated autoloads from net/sasl-scram-sha256.el
+
+(register-definition-prefixes "sasl-scram-sha256" '("sasl-scram-sha"))
;;;***
@@ -28710,6 +29386,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When Savehist mode is enabled, minibuffer history is saved
to `savehist-file' periodically and when exiting Emacs. When
Savehist mode is enabled for the first time in an Emacs session,
@@ -28738,7 +29417,7 @@ histories, which is probably undesirable.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "savehist" '("savehist-")))
+(register-definition-prefixes "savehist" '("savehist-"))
;;;***
@@ -28765,6 +29444,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
(autoload 'save-place-local-mode "saveplace" "\
@@ -28778,6 +29460,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
To save places automatically in all files, put this in your init
file:
@@ -28785,14 +29470,7 @@ file:
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "saveplace" '("load-save-place-alist-from-file" "save-place")))
-
-;;;***
-
-;;;### (autoloads nil "sb-image" "sb-image.el" (0 0 0 0))
-;;; Generated autoloads from sb-image.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sb-image" '("defimage-speedbar" "speedbar-")))
+(register-definition-prefixes "saveplace" '("load-save-place-alist-from-file" "save-place"))
;;;***
@@ -28833,7 +29511,7 @@ that variable's value is a string.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "scheme" '("dsssl-" "scheme-")))
+(register-definition-prefixes "scheme" '("dsssl-" "scheme-"))
;;;***
@@ -28848,7 +29526,7 @@ This mode is an extended emacs-lisp mode.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "score-mode" '("gnus-score-" "score-mode-")))
+(register-definition-prefixes "score-mode" '("gnus-score-" "score-mode-"))
;;;***
@@ -28873,19 +29551,22 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When Scroll-All mode is enabled, scrolling commands invoked in
one window apply to all visible windows in the same frame.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "scroll-all" '("scroll-all-")))
+(register-definition-prefixes "scroll-all" '("scroll-all-"))
;;;***
;;;### (autoloads nil "scroll-bar" "scroll-bar.el" (0 0 0 0))
;;; Generated autoloads from scroll-bar.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "scroll-bar" '("get-scroll-bar-mode" "horizontal-scroll-bar" "previous-scroll-bar-mode" "scroll-bar-" "set-scroll-bar-mode" "toggle-")))
+(register-definition-prefixes "scroll-bar" '("get-scroll-bar-mode" "horizontal-scroll-bar" "previous-scroll-bar-mode" "scroll-bar-" "set-scroll-bar-mode" "toggle-"))
;;;***
@@ -28900,6 +29581,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When enabled, keys that normally move point by line or paragraph
will scroll the buffer by the respective amount of lines instead
and point will be kept vertically fixed relative to window
@@ -28910,7 +29594,7 @@ MS-Windows systems if `w32-scroll-lock-modifier' is non-nil.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "scroll-lock" '("scroll-lock-")))
+(register-definition-prefixes "scroll-lock" '("scroll-lock-"))
;;;***
@@ -28919,7 +29603,7 @@ MS-Windows systems if `w32-scroll-lock-modifier' is non-nil.
(when (featurep 'dbusbind)
(autoload 'secrets-show-secrets "secrets" nil t))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "secrets" '("secrets-")))
+(register-definition-prefixes "secrets" '("secrets-"))
;;;***
@@ -28971,6 +29655,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
In Semantic mode, Emacs parses the buffers you visit for their
semantic content. This information is used by a variety of
auxiliary minor modes, listed in `semantic-default-submodes';
@@ -28981,7 +29668,7 @@ Semantic mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic" '("bovinate" "semantic-")))
+(register-definition-prefixes "semantic" '("bovinate" "semantic-"))
;;;***
@@ -28989,7 +29676,7 @@ Semantic mode.
;;;;;; "cedet/semantic/analyze.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/analyze.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/analyze" '("semantic-a")))
+(register-definition-prefixes "semantic/analyze" '("semantic-a"))
;;;***
@@ -28997,7 +29684,7 @@ Semantic mode.
;;;;;; "cedet/semantic/analyze/complete.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/analyze/complete.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/analyze/complete" '("semantic-analyze-")))
+(register-definition-prefixes "semantic/analyze/complete" '("semantic-analyze-"))
;;;***
@@ -29005,7 +29692,7 @@ Semantic mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/analyze/debug.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/analyze/debug" '("semantic-analyze")))
+(register-definition-prefixes "semantic/analyze/debug" '("semantic-analyze"))
;;;***
@@ -29013,7 +29700,7 @@ Semantic mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/analyze/fcn.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/analyze/fcn" '("semantic-analyze-")))
+(register-definition-prefixes "semantic/analyze/fcn" '("semantic-analyze-"))
;;;***
@@ -29021,7 +29708,7 @@ Semantic mode.
;;;;;; "cedet/semantic/analyze/refs.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/analyze/refs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/analyze/refs" '("semantic-")))
+(register-definition-prefixes "semantic/analyze/refs" '("semantic-"))
;;;***
@@ -29029,7 +29716,7 @@ Semantic mode.
;;;;;; "cedet/semantic/bovine.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/bovine.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine" '("semantic-")))
+(register-definition-prefixes "semantic/bovine" '("semantic-"))
;;;***
@@ -29037,7 +29724,7 @@ Semantic mode.
;;;;;; "cedet/semantic/bovine/c.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/bovine/c.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/c" '("c-mode" "semantic")))
+(register-definition-prefixes "semantic/bovine/c" '("c-mode" "semantic"))
;;;***
@@ -29045,7 +29732,7 @@ Semantic mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/bovine/debug.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/debug" '("semantic-")))
+(register-definition-prefixes "semantic/bovine/debug" '("semantic-"))
;;;***
@@ -29053,7 +29740,7 @@ Semantic mode.
;;;;;; "cedet/semantic/bovine/el.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/bovine/el.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/el" '("emacs-lisp-mode" "semantic-")))
+(register-definition-prefixes "semantic/bovine/el" '("emacs-lisp-mode" "semantic-"))
;;;***
@@ -29061,7 +29748,7 @@ Semantic mode.
;;;;;; "cedet/semantic/bovine/gcc.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/bovine/gcc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/gcc" '("semantic-")))
+(register-definition-prefixes "semantic/bovine/gcc" '("semantic-"))
;;;***
@@ -29074,7 +29761,7 @@ Major mode for editing Bovine grammars.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/grammar" '("bovine-")))
+(register-definition-prefixes "semantic/bovine/grammar" '("bovine-"))
;;;***
@@ -29082,7 +29769,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/bovine/make.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/bovine/make.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/make" '("makefile-mode" "semantic-")))
+(register-definition-prefixes "semantic/bovine/make" '("makefile-mode" "semantic-"))
;;;***
@@ -29090,7 +29777,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/bovine/scm.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/bovine/scm.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/scm" '("semantic-")))
+(register-definition-prefixes "semantic/bovine/scm" '("semantic-"))
;;;***
@@ -29098,7 +29785,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/chart.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/chart" '("semantic-chart-")))
+(register-definition-prefixes "semantic/chart" '("semantic-chart-"))
;;;***
@@ -29106,7 +29793,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/complete.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/complete.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/complete" '("semantic-")))
+(register-definition-prefixes "semantic/complete" '("semantic-"))
;;;***
@@ -29114,7 +29801,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/ctxt.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/ctxt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/ctxt" '("semantic-")))
+(register-definition-prefixes "semantic/ctxt" '("semantic-"))
;;;***
@@ -29122,7 +29809,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/db.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db" '("semanticdb-")))
+(register-definition-prefixes "semantic/db" '("semanticdb-"))
;;;***
@@ -29130,7 +29817,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db-debug.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-debug" '("semanticdb-")))
+(register-definition-prefixes "semantic/db-debug" '("semanticdb-"))
;;;***
@@ -29138,7 +29825,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db-ebrowse.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-ebrowse" '("c++-mode" "semanticdb-")))
+(register-definition-prefixes "semantic/db-ebrowse" '("c++-mode" "semanticdb-"))
;;;***
@@ -29146,7 +29833,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db-el.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-el" '("emacs-lisp-mode" "semanticdb-")))
+(register-definition-prefixes "semantic/db-el" '("emacs-lisp-mode" "semanticdb-"))
;;;***
@@ -29154,7 +29841,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/db-file.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db-file.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-file" '("semanticdb-")))
+(register-definition-prefixes "semantic/db-file" '("semanticdb-"))
;;;***
@@ -29162,7 +29849,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/db-find.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db-find.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-find" '("semanticdb-")))
+(register-definition-prefixes "semantic/db-find" '("semanticdb-"))
;;;***
@@ -29170,7 +29857,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/db-global.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db-global.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-global" '("semanticdb-")))
+(register-definition-prefixes "semantic/db-global" '("semanticdb-"))
;;;***
@@ -29178,7 +29865,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db-javascript.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-javascript" '("javascript-mode" "semanticdb-")))
+(register-definition-prefixes "semantic/db-javascript" '("javascript-mode" "semanticdb-"))
;;;***
@@ -29186,7 +29873,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/db-mode.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db-mode.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-mode" '("semanticdb-")))
+(register-definition-prefixes "semantic/db-mode" '("semanticdb-"))
;;;***
@@ -29194,7 +29881,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db-ref.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-ref" '("semanticdb-ref-")))
+(register-definition-prefixes "semantic/db-ref" '("semanticdb-ref-"))
;;;***
@@ -29202,7 +29889,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/db-typecache.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db-typecache.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-typecache" '("semanticdb-")))
+(register-definition-prefixes "semantic/db-typecache" '("semanticdb-"))
;;;***
@@ -29210,7 +29897,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/debug.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/debug.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/debug" '("semantic-debug-")))
+(register-definition-prefixes "semantic/debug" '("semantic-debug-"))
;;;***
@@ -29218,7 +29905,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/decorate.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/decorate" '("semantic-")))
+(register-definition-prefixes "semantic/decorate" '("semantic-"))
;;;***
@@ -29226,7 +29913,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/decorate/include.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/decorate/include.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/decorate/include" '("semantic-decoration-")))
+(register-definition-prefixes "semantic/decorate/include" '("semantic-decoration-"))
;;;***
@@ -29234,7 +29921,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/decorate/mode.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/decorate/mode.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/decorate/mode" '("define-semantic-decoration-style" "semantic-")))
+(register-definition-prefixes "semantic/decorate/mode" '("define-semantic-decoration-style" "semantic-"))
;;;***
@@ -29242,7 +29929,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/dep.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/dep.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/dep" '("defcustom-mode-local-semantic-dependency-system-include-path" "semantic-")))
+(register-definition-prefixes "semantic/dep" '("defcustom-mode-local-semantic-dependency-system-include-path" "semantic-"))
;;;***
@@ -29250,7 +29937,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/doc.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/doc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/doc" '("semantic-doc")))
+(register-definition-prefixes "semantic/doc" '("semantic-doc"))
;;;***
@@ -29258,7 +29945,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/ede-grammar.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/ede-grammar" '("semantic-ede-")))
+(register-definition-prefixes "semantic/ede-grammar" '("semantic-ede-"))
;;;***
@@ -29266,7 +29953,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/edit.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/edit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/edit" '("semantic-")))
+(register-definition-prefixes "semantic/edit" '("semantic-"))
;;;***
@@ -29274,7 +29961,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/find.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/find.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/find" '("semantic-")))
+(register-definition-prefixes "semantic/find" '("semantic-"))
;;;***
@@ -29282,7 +29969,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/format.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/format.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/format" '("semantic-")))
+(register-definition-prefixes "semantic/format" '("semantic-"))
;;;***
@@ -29290,7 +29977,7 @@ Major mode for editing Bovine grammars.
;;;;;; 0))
;;; Generated autoloads from cedet/semantic/fw.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/fw" '("semantic")))
+(register-definition-prefixes "semantic/fw" '("semantic"))
;;;***
@@ -29298,7 +29985,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/grammar.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/grammar" '("semantic-")))
+(register-definition-prefixes "semantic/grammar" '("semantic-"))
;;;***
@@ -29306,7 +29993,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/grammar-wy.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/grammar-wy" '("semantic-grammar-wy--")))
+(register-definition-prefixes "semantic/grammar-wy" '("semantic-grammar-wy--"))
;;;***
@@ -29314,7 +30001,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/html.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/html.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/html" '("semantic-")))
+(register-definition-prefixes "semantic/html" '("semantic-"))
;;;***
@@ -29322,7 +30009,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/ia.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/ia.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/ia" '("semantic-ia-")))
+(register-definition-prefixes "semantic/ia" '("semantic-ia-"))
;;;***
@@ -29330,7 +30017,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/ia-sb.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/ia-sb.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/ia-sb" '("semantic-ia-s")))
+(register-definition-prefixes "semantic/ia-sb" '("semantic-ia-s"))
;;;***
@@ -29338,7 +30025,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/idle.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/idle.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/idle" '("define-semantic-idle-service" "global-semantic-idle-summary-mode" "semantic-")))
+(register-definition-prefixes "semantic/idle" '("define-semantic-idle-service" "global-semantic-idle-summary-mode" "semantic-"))
;;;***
@@ -29346,7 +30033,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/imenu.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/imenu.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/imenu" '("semantic-")))
+(register-definition-prefixes "semantic/imenu" '("semantic-"))
;;;***
@@ -29354,7 +30041,7 @@ Major mode for editing Bovine grammars.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/semantic/java.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/java" '("semantic-")))
+(register-definition-prefixes "semantic/java" '("semantic-"))
;;;***
@@ -29362,7 +30049,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/lex.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/lex.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/lex" '("define-lex" "semantic-")))
+(register-definition-prefixes "semantic/lex" '("define-lex" "semantic-"))
;;;***
@@ -29370,7 +30057,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/lex-spp.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/lex-spp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/lex-spp" '("define-lex-spp-" "semantic-lex-")))
+(register-definition-prefixes "semantic/lex-spp" '("define-lex-spp-" "semantic-lex-"))
;;;***
@@ -29378,7 +30065,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/mru-bookmark.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/mru-bookmark.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/mru-bookmark" '("global-semantic-mru-bookmark-mode" "semantic-")))
+(register-definition-prefixes "semantic/mru-bookmark" '("global-semantic-mru-bookmark-mode" "semantic-"))
;;;***
@@ -29386,7 +30073,7 @@ Major mode for editing Bovine grammars.
;;;;;; 0))
;;; Generated autoloads from cedet/semantic/sb.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/sb" '("semantic-sb-")))
+(register-definition-prefixes "semantic/sb" '("semantic-sb-"))
;;;***
@@ -29394,7 +30081,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/scope.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/scope.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/scope" '("semantic-")))
+(register-definition-prefixes "semantic/scope" '("semantic-"))
;;;***
@@ -29402,7 +30089,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/senator.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/senator.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/senator" '("semantic-up-reference" "senator-")))
+(register-definition-prefixes "semantic/senator" '("semantic-up-reference" "senator-"))
;;;***
@@ -29410,7 +30097,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/sort.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/sort.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/sort" '("semantic-")))
+(register-definition-prefixes "semantic/sort" '("semantic-"))
;;;***
@@ -29418,7 +30105,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/symref.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/symref.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref" '("semantic-symref-")))
+(register-definition-prefixes "semantic/symref" '("semantic-symref-"))
;;;***
@@ -29426,7 +30113,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/symref/cscope.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/symref/cscope.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/cscope" '("semantic-symref-cscope--line-re")))
+(register-definition-prefixes "semantic/symref/cscope" '("semantic-symref-cscope--line-re"))
;;;***
@@ -29434,7 +30121,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/symref/filter.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/filter" '("semantic-symref-")))
+(register-definition-prefixes "semantic/symref/filter" '("semantic-symref-"))
;;;***
@@ -29442,7 +30129,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/symref/global.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/symref/global.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/global" '("semantic-symref-global--line-re")))
+(register-definition-prefixes "semantic/symref/global" '("semantic-symref-global--line-re"))
;;;***
@@ -29450,7 +30137,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/symref/grep.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/symref/grep.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/grep" '("semantic-symref-")))
+(register-definition-prefixes "semantic/symref/grep" '("semantic-symref-"))
;;;***
@@ -29458,7 +30145,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/symref/idutils.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/symref/idutils.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/idutils" '("semantic-symref-idutils--line-re")))
+(register-definition-prefixes "semantic/symref/idutils" '("semantic-symref-idutils--line-re"))
;;;***
@@ -29466,7 +30153,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/symref/list.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/symref/list.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/list" '("semantic-symref-")))
+(register-definition-prefixes "semantic/symref/list" '("semantic-symref-"))
;;;***
@@ -29474,7 +30161,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/tag.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/tag.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/tag" '("semantic-")))
+(register-definition-prefixes "semantic/tag" '("semantic-"))
;;;***
@@ -29482,7 +30169,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/tag-file.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/tag-file.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/tag-file" '("semantic-prototype-file")))
+(register-definition-prefixes "semantic/tag-file" '("semantic-prototype-file"))
;;;***
@@ -29490,7 +30177,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/tag-ls.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/tag-ls.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/tag-ls" '("semantic-")))
+(register-definition-prefixes "semantic/tag-ls" '("semantic-"))
;;;***
@@ -29498,7 +30185,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/tag-write.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/tag-write.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/tag-write" '("semantic-tag-write-")))
+(register-definition-prefixes "semantic/tag-write" '("semantic-tag-write-"))
;;;***
@@ -29506,7 +30193,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/texi.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/texi.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/texi" '("semantic-")))
+(register-definition-prefixes "semantic/texi" '("semantic-"))
;;;***
@@ -29514,7 +30201,7 @@ Major mode for editing Bovine grammars.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/semantic/util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/util" '("semantic-")))
+(register-definition-prefixes "semantic/util" '("semantic-"))
;;;***
@@ -29522,7 +30209,7 @@ Major mode for editing Bovine grammars.
;;;;;; "cedet/semantic/util-modes.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/util-modes.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/util-modes" '("semantic-")))
+(register-definition-prefixes "semantic/util-modes" '("semantic-"))
;;;***
@@ -29530,7 +30217,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/wisent.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent" '("define-wisent-lexer" "wisent-")))
+(register-definition-prefixes "semantic/wisent" '("define-wisent-lexer" "wisent-"))
;;;***
@@ -29538,7 +30225,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/wisent/comp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/comp" '("wisent-")))
+(register-definition-prefixes "semantic/wisent/comp" '("wisent-"))
;;;***
@@ -29551,7 +30238,7 @@ Major mode for editing Wisent grammars.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/grammar" '("wisent-")))
+(register-definition-prefixes "semantic/wisent/grammar" '("wisent-"))
;;;***
@@ -29559,7 +30246,7 @@ Major mode for editing Wisent grammars.
;;;;;; "cedet/semantic/wisent/java-tags.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/wisent/java-tags.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/java-tags" '("semantic-" "wisent-java-parse-error")))
+(register-definition-prefixes "semantic/wisent/java-tags" '("semantic-" "wisent-java-parse-error"))
;;;***
@@ -29567,7 +30254,7 @@ Major mode for editing Wisent grammars.
;;;;;; "cedet/semantic/wisent/javascript.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/wisent/javascript.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/javascript" '("semantic-" "wisent-javascript-jv-expand-tag")))
+(register-definition-prefixes "semantic/wisent/javascript" '("semantic-" "wisent-javascript-jv-expand-tag"))
;;;***
@@ -29575,7 +30262,7 @@ Major mode for editing Wisent grammars.
;;;;;; "cedet/semantic/wisent/python.el" (0 0 0 0))
;;; Generated autoloads from cedet/semantic/wisent/python.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/python" '("semantic-" "wisent-python-")))
+(register-definition-prefixes "semantic/wisent/python" '("semantic-" "wisent-python-"))
;;;***
@@ -29583,7 +30270,7 @@ Major mode for editing Wisent grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/wisent/wisent.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/wisent" '("$action" "$nterm" "$region" "wisent-")))
+(register-definition-prefixes "semantic/wisent/wisent" '("$action" "$nterm" "$region" "wisent-"))
;;;***
@@ -29795,7 +30482,7 @@ and `default-sendmail-coding-system',
but lower priority than the local value of `buffer-file-coding-system'.
See also the function `select-message-coding-system'.")
-(defvar default-sendmail-coding-system 'iso-latin-1 "\
+(defvar default-sendmail-coding-system 'utf-8 "\
Default coding system for encoding the outgoing mail.
This variable is used only when `sendmail-coding-system' is nil.
@@ -29865,13 +30552,13 @@ Like `mail' command, but display mail buffer in another frame.
\(fn &optional NOERASE TO SUBJECT IN-REPLY-TO CC REPLYBUFFER SENDACTIONS)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sendmail" '("mail-" "sendmail-")))
+(register-definition-prefixes "sendmail" '("mail-" "sendmail-"))
;;;***
;;;### (autoloads nil "seq" "emacs-lisp/seq.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/seq.el
-(push (purecopy '(seq 2 21)) package--builtin-versions)
+(push (purecopy '(seq 2 22)) package--builtin-versions)
(autoload 'seq-take "seq" "\
Take the first N elements of SEQUENCE and return the result.
@@ -29911,6 +30598,11 @@ If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called.
\(fn FUNCTION SEQUENCE INITIAL-VALUE)" nil nil)
+(autoload 'seq-every-p "seq" "\
+Return non-nil if (PRED element) is non-nil for all elements of SEQUENCE.
+
+\(fn PRED SEQUENCE)" nil nil)
+
(autoload 'seq-some "seq" "\
Return non-nil if PRED is satisfied for at least one element of SEQUENCE.
If so, return the first non-nil value returned by PRED.
@@ -29933,7 +30625,13 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil.
\(fn SEQUENCE ELT &optional TESTFN)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "seq" '("seq-")))
+(autoload 'seq-max "seq" "\
+Return the largest element of SEQUENCE.
+SEQUENCE must be a sequence of numbers or markers.
+
+\(fn SEQUENCE)" nil nil)
+
+(register-definition-prefixes "seq" '("seq-"))
;;;***
@@ -29993,6 +30691,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Server mode runs a process that accepts commands from the
`emacsclient' program. See Info node `Emacs server' and
`server-start' for details.
@@ -30008,7 +30709,7 @@ only these files will be asked to be saved.
\(fn ARG)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "server" '("server-")))
+(register-definition-prefixes "server" '("server-"))
;;;***
@@ -30052,7 +30753,7 @@ These are active only in the minibuffer, when entering or editing a
formula:
\\{ses-mode-edit-map}" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ses" '("ses")))
+(register-definition-prefixes "ses" '("ses"))
;;;***
@@ -30101,7 +30802,7 @@ have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6>
<p>Paragraphs only need an opening tag. Line breaks and multiple spaces are
ignored unless the text is <pre>preformatted.</pre> Text can be marked as
-<b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal M-o or
+<strong>bold</strong>, <em>italic</em> or <u>underlined</u> using the normal M-o or
Edit/Text Properties/Face commands.
Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
@@ -30120,7 +30821,7 @@ To work around that, do:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sgml-mode" '("html-" "sgml-")))
+(register-definition-prefixes "sgml-mode" '("html-" "sgml-"))
;;;***
@@ -30159,11 +30860,9 @@ following commands are available, based on the current shell's syntax:
\\[sh-while] while loop
For sh and rc shells indentation commands are:
-\\[sh-show-indent] Show the variable controlling this line's indentation.
-\\[sh-set-indent] Set then variable controlling this line's indentation.
-\\[sh-learn-line-indent] Change the indentation variable so this line
-would indent to the way it currently is.
-\\[sh-learn-buffer-indent] Set the indentation variables so the
+\\[smie-config-show-indent] Show the rules controlling this line's indentation.
+\\[smie-config-set-indent] Change the rules controlling this line's indentation.
+\\[smie-config-guess] Try to tweak the indentation rules so the
buffer indents as it currently is indented.
@@ -30188,7 +30887,7 @@ with your script for an edit-interpret-debug cycle.
(defalias 'shell-script-mode 'sh-mode)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sh-script" '("sh-")))
+(register-definition-prefixes "sh-script" '("sh-"))
;;;***
@@ -30239,7 +30938,7 @@ function, `load-path-shadows-find'.
\(fn &optional STRINGP)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "shadow" '("load-path-shadows-")))
+(register-definition-prefixes "shadow" '("load-path-shadows-"))
;;;***
@@ -30273,7 +30972,7 @@ function). Each site can be either a hostname or the name of a cluster (see
(autoload 'shadow-initialize "shadowfile" "\
Set up file shadowing." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "shadowfile" '("shadow")))
+(register-definition-prefixes "shadowfile" '("shadow"))
;;;***
@@ -30325,7 +31024,7 @@ Make the shell buffer the current buffer, and return it.
\(fn &optional BUFFER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "shell" '("dirs" "explicit-" "shell-")))
+(register-definition-prefixes "shell" '("dirs" "explicit-" "shell-"))
;;;***
@@ -30344,14 +31043,14 @@ DOM should be a parse tree as generated by
\(fn DOM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "shr" '("shr-" "svg--wrap-svg")))
+(register-definition-prefixes "shr" '("shr-"))
;;;***
;;;### (autoloads nil "shr-color" "net/shr-color.el" (0 0 0 0))
;;; Generated autoloads from net/shr-color.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "shr-color" '("shr-color-")))
+(register-definition-prefixes "shr-color" '("shr-color-"))
;;;***
@@ -30378,7 +31077,7 @@ DOM should be a parse tree as generated by
\(fn &optional NAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sieve" '("sieve-")))
+(register-definition-prefixes "sieve" '("sieve-"))
;;;***
@@ -30386,7 +31085,7 @@ DOM should be a parse tree as generated by
;;;;;; 0))
;;; Generated autoloads from net/sieve-manage.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sieve-manage" '("sieve-")))
+(register-definition-prefixes "sieve-manage" '("sieve-"))
;;;***
@@ -30403,7 +31102,7 @@ Turning on Sieve mode runs `sieve-mode-hook'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sieve-mode" '("sieve-")))
+(register-definition-prefixes "sieve-mode" '("sieve-"))
;;;***
@@ -30453,7 +31152,7 @@ with no arguments, if that value is non-nil.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "simula" '("simula-")))
+(register-definition-prefixes "simula" '("simula-"))
;;;***
@@ -30575,7 +31274,7 @@ twice for the others.
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "skeleton" '("skeleton-")))
+(register-definition-prefixes "skeleton" '("skeleton-"))
;;;***
@@ -30614,22 +31313,27 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\\{smerge-mode-map}
\(fn &optional ARG)" t nil)
(autoload 'smerge-start-session "smerge-mode" "\
Turn on `smerge-mode' and move point to first conflict marker.
-If no conflict maker is found, turn off `smerge-mode'." t nil)
+If no conflict maker is found, turn off `smerge-mode'.
+
+\(fn &optional INTERACTIVELY)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smerge-mode" '("smerge-")))
+(register-definition-prefixes "smerge-mode" '("smerge-"))
;;;***
;;;### (autoloads nil "smie" "emacs-lisp/smie.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/smie.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smie" '("smie-")))
+(register-definition-prefixes "smie" '("smie-"))
;;;***
@@ -30648,14 +31352,14 @@ interactively. If there's no argument, do it at the current buffer.
\(fn &optional BUFFER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smiley" '("gnus-smiley-file-types" "smiley-")))
+(register-definition-prefixes "smiley" '("gnus-smiley-file-types" "smiley-"))
;;;***
;;;### (autoloads nil "smime" "gnus/smime.el" (0 0 0 0))
;;; Generated autoloads from gnus/smime.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smime" '("smime")))
+(register-definition-prefixes "smime" '("smime"))
;;;***
@@ -30667,7 +31371,7 @@ interactively. If there's no argument, do it at the current buffer.
(autoload 'smtpmail-send-queued-mail "smtpmail" "\
Send mail that was queued as a result of setting `smtpmail-queue-mail'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smtpmail" '("smtpmail-")))
+(register-definition-prefixes "smtpmail" '("smtpmail-"))
;;;***
@@ -30690,7 +31394,7 @@ Snake mode keybindings:
\\[snake-move-up] Makes the snake move up
\\[snake-move-down] Makes the snake move down" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "snake" '("snake-")))
+(register-definition-prefixes "snake" '("snake-"))
;;;***
@@ -30717,7 +31421,7 @@ Delete converts tabs to spaces as it moves back.
Turning on snmp-mode runs the hooks in `snmp-common-mode-hook',
then `snmpv2-mode-hook'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "snmp-mode" '("snmp")))
+(register-definition-prefixes "snmp-mode" '("snmp"))
;;;***
@@ -30739,6 +31443,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Any active minor modes listed in `so-long-minor-modes' are disabled for the
current buffer, and buffer-local values are assigned to variables in accordance
with `so-long-variable-overrides'.
@@ -30815,6 +31522,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Many Emacs modes struggle with buffers which contain excessively long lines,
and may consequently cause unacceptable performance issues.
@@ -30831,15 +31541,15 @@ Use \\[so-long-customize] to configure the behaviour.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "so-long" '("so-long-" "turn-o")))
+(register-definition-prefixes "so-long" '("so-long-" "turn-o"))
;;;***
;;;### (autoloads nil "soap-client" "net/soap-client.el" (0 0 0 0))
;;; Generated autoloads from net/soap-client.el
-(push (purecopy '(soap-client 3 1 5)) package--builtin-versions)
+(push (purecopy '(soap-client 3 2 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soap-client" '("soap-")))
+(register-definition-prefixes "soap-client" '("soap-"))
;;;***
@@ -30847,14 +31557,14 @@ Use \\[so-long-customize] to configure the behaviour.
;;;;;; 0))
;;; Generated autoloads from net/soap-inspect.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soap-inspect" '("soap-")))
+(register-definition-prefixes "soap-inspect" '("soap-"))
;;;***
;;;### (autoloads nil "socks" "net/socks.el" (0 0 0 0))
;;; Generated autoloads from net/socks.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "socks" '("socks-")))
+(register-definition-prefixes "socks" '("socks-"))
;;;***
@@ -30871,7 +31581,7 @@ This function is suitable for execution in an init file.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "solar" '("calendar-" "diary-sunrise-sunset" "solar-")))
+(register-definition-prefixes "solar" '("calendar-" "diary-sunrise-sunset" "solar-"))
;;;***
@@ -30948,7 +31658,7 @@ Pick your favorite shortcuts:
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "solitaire" '("solitaire-")))
+(register-definition-prefixes "solitaire" '("solitaire-"))
;;;***
@@ -31130,14 +31840,14 @@ is non-nil, it also prints a message describing the number of deletions.
\(fn BEG END &optional REVERSE ADJACENT KEEP-BLANKS INTERACTIVE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sort" '("sort-")))
+(register-definition-prefixes "sort" '("sort-"))
;;;***
;;;### (autoloads nil "soundex" "soundex.el" (0 0 0 0))
;;; Generated autoloads from soundex.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soundex" '("soundex")))
+(register-definition-prefixes "soundex" '("soundex"))
;;;***
@@ -31153,7 +31863,7 @@ installed through `spam-necessary-extra-headers'.
\(fn &rest SYMBOLS)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "spam" '("spam-")))
+(register-definition-prefixes "spam" '("spam-"))
;;;***
@@ -31194,21 +31904,21 @@ Remove spam-report support from the Agent.
Spam reports will be queued with the method used when
\\[spam-report-agentize] was run." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "spam-report" '("spam-report-")))
+(register-definition-prefixes "spam-report" '("spam-report-"))
;;;***
;;;### (autoloads nil "spam-stat" "gnus/spam-stat.el" (0 0 0 0))
;;; Generated autoloads from gnus/spam-stat.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "spam-stat" '("spam-stat" "with-spam-stat-max-buffer-size")))
+(register-definition-prefixes "spam-stat" '("spam-stat" "with-spam-stat-max-buffer-size"))
;;;***
;;;### (autoloads nil "spam-wash" "gnus/spam-wash.el" (0 0 0 0))
;;; Generated autoloads from gnus/spam-wash.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "spam-wash" '("spam-")))
+(register-definition-prefixes "spam-wash" '("spam-"))
;;;***
@@ -31232,7 +31942,7 @@ Change frame focus to or from the speedbar frame.
If the selected frame is not speedbar, then speedbar frame is
selected. If the speedbar frame is active, then select the attached frame." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "speedbar" '("speedbar-")))
+(register-definition-prefixes "speedbar" '("speedbar-"))
;;;***
@@ -31245,7 +31955,7 @@ Adds that special touch of class to your outgoing mail." t nil)
(autoload 'snarf-spooks "spook" "\
Return a vector containing the lines from `spook-phrases-file'." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "spook" '("spook-phrase")))
+(register-definition-prefixes "spook" '("spook-phrase"))
;;;***
@@ -31300,7 +32010,7 @@ must tell Emacs. Here's how to do that in your init file:
\(add-hook \\='sql-mode-hook
(lambda ()
- (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))
+ (modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))
\(fn)" t nil)
@@ -31745,7 +32455,7 @@ Run vsql as an inferior process.
\(fn &optional BUFFER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sql" '("sql-")))
+(register-definition-prefixes "sql" '("sql-"))
;;;***
@@ -31753,7 +32463,7 @@ Run vsql as an inferior process.
;;; Generated autoloads from cedet/srecode.el
(push (purecopy '(srecode 1 2)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode" '("srecode-version")))
+(register-definition-prefixes "srecode" '("srecode-version"))
;;;***
@@ -31761,7 +32471,7 @@ Run vsql as an inferior process.
;;;;;; 0 0))
;;; Generated autoloads from cedet/srecode/args.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/args" '("srecode-")))
+(register-definition-prefixes "srecode/args" '("srecode-"))
;;;***
@@ -31769,7 +32479,7 @@ Run vsql as an inferior process.
;;;;;; "cedet/srecode/compile.el" (0 0 0 0))
;;; Generated autoloads from cedet/srecode/compile.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/compile" '("srecode-")))
+(register-definition-prefixes "srecode/compile" '("srecode-"))
;;;***
@@ -31777,7 +32487,7 @@ Run vsql as an inferior process.
;;;;;; "cedet/srecode/cpp.el" (0 0 0 0))
;;; Generated autoloads from cedet/srecode/cpp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/cpp" '("srecode-")))
+(register-definition-prefixes "srecode/cpp" '("srecode-"))
;;;***
@@ -31785,7 +32495,7 @@ Run vsql as an inferior process.
;;;;;; 0 0))
;;; Generated autoloads from cedet/srecode/ctxt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/ctxt" '("srecode-")))
+(register-definition-prefixes "srecode/ctxt" '("srecode-"))
;;;***
@@ -31793,7 +32503,7 @@ Run vsql as an inferior process.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/srecode/dictionary.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/dictionary" '("srecode-")))
+(register-definition-prefixes "srecode/dictionary" '("srecode-"))
;;;***
@@ -31801,7 +32511,7 @@ Run vsql as an inferior process.
;;;;;; "cedet/srecode/document.el" (0 0 0 0))
;;; Generated autoloads from cedet/srecode/document.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/document" '("srecode-document-")))
+(register-definition-prefixes "srecode/document" '("srecode-document-"))
;;;***
@@ -31809,7 +32519,7 @@ Run vsql as an inferior process.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/srecode/el.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/el" '("srecode-semantic-apply-tag-to-dict")))
+(register-definition-prefixes "srecode/el" '("srecode-semantic-apply-tag-to-dict"))
;;;***
@@ -31817,7 +32527,7 @@ Run vsql as an inferior process.
;;;;;; "cedet/srecode/expandproto.el" (0 0 0 0))
;;; Generated autoloads from cedet/srecode/expandproto.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/expandproto" '("srecode-")))
+(register-definition-prefixes "srecode/expandproto" '("srecode-"))
;;;***
@@ -31825,7 +32535,7 @@ Run vsql as an inferior process.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/srecode/extract.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/extract" '("srecode-extract")))
+(register-definition-prefixes "srecode/extract" '("srecode-extract"))
;;;***
@@ -31833,7 +32543,7 @@ Run vsql as an inferior process.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/srecode/fields.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/fields" '("srecode-")))
+(register-definition-prefixes "srecode/fields" '("srecode-"))
;;;***
@@ -31841,7 +32551,7 @@ Run vsql as an inferior process.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/srecode/filters.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/filters" '("srecode-comment-prefix")))
+(register-definition-prefixes "srecode/filters" '("srecode-comment-prefix"))
;;;***
@@ -31849,7 +32559,7 @@ Run vsql as an inferior process.
;;;;;; 0 0))
;;; Generated autoloads from cedet/srecode/find.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/find" '("srecode-")))
+(register-definition-prefixes "srecode/find" '("srecode-"))
;;;***
@@ -31857,7 +32567,7 @@ Run vsql as an inferior process.
;;;;;; "cedet/srecode/getset.el" (0 0 0 0))
;;; Generated autoloads from cedet/srecode/getset.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/getset" '("srecode-")))
+(register-definition-prefixes "srecode/getset" '("srecode-"))
;;;***
@@ -31865,7 +32575,7 @@ Run vsql as an inferior process.
;;;;;; "cedet/srecode/insert.el" (0 0 0 0))
;;; Generated autoloads from cedet/srecode/insert.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/insert" '("srecode-")))
+(register-definition-prefixes "srecode/insert" '("srecode-"))
;;;***
@@ -31873,7 +32583,7 @@ Run vsql as an inferior process.
;;;;;; "cedet/srecode/map.el" (0 0 0 0))
;;; Generated autoloads from cedet/srecode/map.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/map" '("srecode-")))
+(register-definition-prefixes "srecode/map" '("srecode-"))
;;;***
@@ -31881,7 +32591,7 @@ Run vsql as an inferior process.
;;;;;; "cedet/srecode/mode.el" (0 0 0 0))
;;; Generated autoloads from cedet/srecode/mode.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/mode" '("srecode-")))
+(register-definition-prefixes "srecode/mode" '("srecode-"))
;;;***
@@ -31889,7 +32599,7 @@ Run vsql as an inferior process.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/srecode/semantic.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/semantic" '("srecode-semantic-")))
+(register-definition-prefixes "srecode/semantic" '("srecode-semantic-"))
;;;***
@@ -31897,7 +32607,7 @@ Run vsql as an inferior process.
;;;;;; "cedet/srecode/srt.el" (0 0 0 0))
;;; Generated autoloads from cedet/srecode/srt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/srt" '("srecode-read-")))
+(register-definition-prefixes "srecode/srt" '("srecode-read-"))
;;;***
@@ -31912,7 +32622,7 @@ Major-mode for writing SRecode macros.
(defalias 'srt-mode 'srecode-template-mode)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/srt-mode" '("semantic-" "srecode-")))
+(register-definition-prefixes "srecode/srt-mode" '("semantic-" "srecode-"))
;;;***
@@ -31920,7 +32630,7 @@ Major-mode for writing SRecode macros.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/srecode/table.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/table" '("object-sort-list" "srecode-")))
+(register-definition-prefixes "srecode/table" '("object-sort-list" "srecode-"))
;;;***
@@ -31928,7 +32638,7 @@ Major-mode for writing SRecode macros.
;;;;;; "cedet/srecode/template.el" (0 0 0 0))
;;; Generated autoloads from cedet/srecode/template.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/template" '("semantic-tag-components")))
+(register-definition-prefixes "srecode/template" '("semantic-tag-components"))
;;;***
@@ -31936,7 +32646,7 @@ Major-mode for writing SRecode macros.
;;;;;; "cedet/srecode/texi.el" (0 0 0 0))
;;; Generated autoloads from cedet/srecode/texi.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/texi" '("semantic-insert-foreign-tag" "srecode-texi-")))
+(register-definition-prefixes "srecode/texi" '("semantic-insert-foreign-tag" "srecode-texi-"))
;;;***
@@ -32023,6 +32733,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\\<strokes-mode-map>
Strokes are pictographic mouse gestures which invoke commands.
Strokes are invoked with \\[strokes-do-stroke]. You can define
@@ -32048,7 +32761,7 @@ Optional FORCE non-nil will ignore the buffer's read-only status.
(autoload 'strokes-compose-complex-stroke "strokes" "\
Read a complex stroke and insert its glyph into the current buffer." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "strokes" '("strokes-")))
+(register-definition-prefixes "strokes" '("strokes-"))
;;;***
@@ -32073,6 +32786,27 @@ Studlify-case the current buffer." t nil)
;;;### (autoloads nil "subr-x" "emacs-lisp/subr-x.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/subr-x.el
+(autoload 'if-let "subr-x" "\
+Bind variables according to SPEC and evaluate THEN or ELSE.
+Evaluate each binding in turn, as in `let*', stopping if a
+binding value is nil. If all are non-nil return the value of
+THEN, otherwise the last form in ELSE.
+
+Each element of SPEC is a list (SYMBOL VALUEFORM) that binds
+SYMBOL to the value of VALUEFORM. An element can additionally be
+of the form (VALUEFORM), which is evaluated and checked for nil;
+i.e. SYMBOL can be omitted if only the test result is of
+interest. It can also be of the form SYMBOL, then the binding of
+SYMBOL is checked for nil.
+
+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.
+
+\(fn SPEC THEN &rest ELSE)" nil t)
+
+(function-put 'if-let 'lisp-indent-function '2)
+
(autoload 'when-let "subr-x" "\
Bind variables according to SPEC and conditionally evaluate BODY.
Evaluate each binding in turn, stopping if a binding value is nil.
@@ -32084,7 +32818,12 @@ The variable list SPEC is the same as in `if-let'.
(function-put 'when-let 'lisp-indent-function '1)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let" "internal--" "replace-region-contents" "string-" "thread-" "when-let*")))
+(autoload 'string-truncate-left "subr-x" "\
+Truncate STRING to LENGTH, replacing initial surplus with \"...\".
+
+\(fn STRING LENGTH)" nil nil)
+
+(register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let*" "internal--" "replace-region-contents" "string-" "thread-" "when-let*"))
;;;***
@@ -32101,6 +32840,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Subword mode is a buffer-local minor mode. Enabling it changes
the definition of a word so that word-based commands stop inside
symbols with mixed uppercase and lowercase letters,
@@ -32153,6 +32895,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Superword mode is a buffer-local minor mode. Enabling it changes
the definition of words such that symbols characters are treated
as parts of words: e.g., in `superword-mode',
@@ -32186,7 +32931,7 @@ See `superword-mode' for more information on Superword mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "subword" '("subword-" "superword-mode-map")))
+(register-definition-prefixes "subword" '("subword-" "superword-mode-map"))
;;;***
@@ -32218,23 +32963,21 @@ The region need not be active (and typically isn't when this
function is called). Also, the hook `sc-pre-hook' is run before,
and `sc-post-hook' is run after the guts of this function." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "supercite" '("sc-")))
+(register-definition-prefixes "supercite" '("sc-"))
;;;***
;;;### (autoloads nil "svg" "svg.el" (0 0 0 0))
;;; Generated autoloads from svg.el
-(push (purecopy '(svg 1 0)) package--builtin-versions)
+(push (purecopy '(svg 1 1)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "svg" '("svg-")))
+(register-definition-prefixes "svg" '("svg-"))
;;;***
;;;### (autoloads nil "t-mouse" "t-mouse.el" (0 0 0 0))
;;; Generated autoloads from t-mouse.el
-(define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1")
-
(defvar gpm-mouse-mode t "\
Non-nil if Gpm-Mouse mode is enabled.
See the `gpm-mouse-mode' command
@@ -32253,6 +32996,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
This allows the use of the mouse when operating on a GNU/Linux console,
in the same way as you can use the mouse under X11.
It relies on the `gpm' daemon being activated.
@@ -32263,7 +33009,7 @@ GPM. This is due to limitations in GPM and the Linux kernel.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "t-mouse" '("gpm-mouse-")))
+(register-definition-prefixes "t-mouse" '("gpm-mouse-"))
;;;***
@@ -32278,6 +33024,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+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)
@@ -32308,7 +33057,7 @@ See `tab-line-mode' for more information on Tab-Line mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tab-line" '("tab-line-")))
+(register-definition-prefixes "tab-line" '("tab-line-"))
;;;***
@@ -32339,7 +33088,7 @@ The variable `tab-width' controls the spacing of tab stops.
\(fn START END &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tabify" '("tabify-regexp")))
+(register-definition-prefixes "tabify" '("tabify-regexp"))
;;;***
@@ -32686,6 +33435,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
(autoload 'table-query-dimension "table" "\
@@ -32720,7 +33472,7 @@ buffer, and leaves the previous contents of the buffer untouched.
References used for this implementation:
HTML:
- URL `http://www.w3.org'
+ URL `https://www.w3.org'
LaTeX:
URL `http://www.maths.tcd.ie/~dwilkins/LaTeXPrimer/Tables.html'
@@ -32903,7 +33655,7 @@ Remove the frame from a table and deactivate the table. This command
converts a table into plain text without frames. It is a companion to
`table-capture' which does the opposite process." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "table" '("*table--" "table-")))
+(register-definition-prefixes "table" '("*table--" "table-"))
;;;***
@@ -32925,7 +33677,7 @@ Connect to display DISPLAY for the Emacs talk group.
(autoload 'talk "talk" "\
Connect to the Emacs talk group from the current X display or tty frame." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "talk" '("talk-")))
+(register-definition-prefixes "talk" '("talk-"))
;;;***
@@ -32950,7 +33702,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tar-mode" '("tar-")))
+(register-definition-prefixes "tar-mode" '("tar-"))
;;;***
@@ -33000,7 +33752,7 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'.
\(fn COMMAND &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tcl" '("add-log-tcl-defun" "calculate-tcl-indent" "indent-tcl-exp" "inferior-tcl-" "run-tcl" "switch-to-tcl" "tcl-")))
+(register-definition-prefixes "tcl" '("add-log-tcl-defun" "calculate-tcl-indent" "indent-tcl-exp" "inferior-tcl-" "run-tcl" "switch-to-tcl" "tcl-"))
;;;***
@@ -33008,15 +33760,7 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'.
;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/tcover-ses.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tcover-ses" '("ses-exercise")))
-
-;;;***
-
-;;;### (autoloads nil "tcover-unsafep" "emacs-lisp/tcover-unsafep.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from emacs-lisp/tcover-unsafep.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tcover-unsafep" '("testcover-unsafep")))
+(register-definition-prefixes "tcover-ses" '("ses-exercise"))
;;;***
@@ -33043,14 +33787,14 @@ Normally input is edited in Emacs and sent a line at a time.
\(fn HOST)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "telnet" '("send-process-next-char" "telnet-")))
+(register-definition-prefixes "telnet" '("send-process-next-char" "telnet-"))
;;;***
;;;### (autoloads nil "tempo" "tempo.el" (0 0 0 0))
;;; Generated autoloads from tempo.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tempo" '("tempo-")))
+(register-definition-prefixes "tempo" '("tempo-"))
;;;***
@@ -33103,7 +33847,7 @@ use in that buffer.
\(fn PORT SPEED &optional LINE-MODE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "term" '("ansi-term-color-vector" "explicit-shell-file-name" "serial-" "term-")))
+(register-definition-prefixes "term" '("ansi-term-color-vector" "explicit-shell-file-name" "serial-" "term-"))
;;;***
@@ -33120,7 +33864,7 @@ If BYTE-COMPILE is non-nil, byte compile each function after instrumenting.
(autoload 'testcover-this-defun "testcover" "\
Start coverage on function under point." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "testcover" '("testcover-")))
+(register-definition-prefixes "testcover" '("testcover-"))
;;;***
@@ -33147,7 +33891,7 @@ tetris-mode keybindings:
" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tetris" '("tetris-")))
+(register-definition-prefixes "tetris" '("tetris-"))
;;;***
@@ -33276,7 +34020,7 @@ Should show the queue(s) that \\[tex-print] puts jobs on.")
(custom-autoload 'tex-show-queue-command "tex-mode" t)
-(defvar tex-default-mode 'latex-mode "\
+(defvar tex-default-mode #'latex-mode "\
Mode to enter for a new file that might be either TeX or LaTeX.
This variable is used when it can't be determined whether the file
is plain TeX or LaTeX or what because the file contains no commands.
@@ -33296,11 +34040,14 @@ String inserted by typing \\[tex-insert-quote] to close a quotation.")
(autoload 'tex-mode "tex-mode" "\
Major mode for editing files of input for TeX, LaTeX, or SliTeX.
+This is the shared parent mode of several submodes.
Tries to determine (by looking at the beginning of the file) whether
this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode',
-`latex-mode', or `slitex-mode', respectively. If it cannot be determined,
+`latex-mode', or `slitex-mode', accordingly. If it cannot be determined,
such as if there are no commands in the file, the value of `tex-default-mode'
-says which mode to use." t nil)
+says which mode to use.
+
+\(fn)" t nil)
(defalias 'TeX-mode 'tex-mode)
@@ -33445,7 +34192,7 @@ Major mode to edit DocTeX files.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tex-mode" '("doctex-font-lock-" "latex-" "plain-tex-mode-map" "tex-")))
+(register-definition-prefixes "tex-mode" '("doctex-font-lock-" "latex-" "plain-tex-mode-map" "tex-"))
;;;***
@@ -33486,7 +34233,7 @@ if large. You can use `Info-split' to do this manually.
\(fn &optional NOSPLIT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "texinfmt" '("batch-texinfo-format" "texinf")))
+(register-definition-prefixes "texinfmt" '("batch-texinfo-format" "texinf"))
;;;***
@@ -33572,7 +34319,7 @@ value of `texinfo-mode-hook'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "texinfo" '("texinfo-")))
+(register-definition-prefixes "texinfo" '("texinfo-"))
;;;***
@@ -33580,7 +34327,7 @@ value of `texinfo-mode-hook'.
;;;;;; 0 0))
;;; Generated autoloads from textmodes/texnfo-upd.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "texnfo-upd" '("texinfo-")))
+(register-definition-prefixes "texnfo-upd" '("texinfo-"))
;;;***
@@ -33588,7 +34335,7 @@ value of `texinfo-mode-hook'.
;;;;;; (0 0 0 0))
;;; Generated autoloads from emacs-lisp/text-property-search.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "text-property-search" '("text-property-")))
+(register-definition-prefixes "text-property-search" '("text-property-"))
;;;***
@@ -33616,7 +34363,7 @@ Compose Thai characters in the current buffer." t nil)
\(fn GSTRING DIRECTION)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thai-util" '("exit-thai-language-environment-internal" "setup-thai-language-environment-internal" "thai-")))
+(register-definition-prefixes "thai-util" '("exit-thai-language-environment-internal" "setup-thai-language-environment-internal" "thai-"))
;;;***
@@ -33624,7 +34371,7 @@ Compose Thai characters in the current buffer." t nil)
;;;;;; 0))
;;; Generated autoloads from language/thai-word.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thai-word" '("thai-")))
+(register-definition-prefixes "thai-word" '("thai-"))
;;;***
@@ -33688,7 +34435,7 @@ treated as white space.
\(fn &optional IGNORE-COMMENT-OR-STRING)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thingatpt" '("beginning-of-thing" "define-thing-chars" "end-of-thing" "filename" "form-at-point" "in-string-p" "sentence-at-point" "thing-at-point-" "word-at-point")))
+(register-definition-prefixes "thingatpt" '("beginning-of-thing" "define-thing-chars" "end-of-thing" "filename" "form-at-point" "in-string-p" "sentence-at-point" "thing-at-point-" "word-at-point"))
;;;***
@@ -33706,7 +34453,7 @@ An EVENT has the format
Display a list of threads." t nil)
(put 'list-threads 'disabled "Beware: manually canceling threads can ruin your Emacs session.")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thread" '("thread-list-")))
+(register-definition-prefixes "thread" '("thread-list-"))
;;;***
@@ -33736,7 +34483,7 @@ In dired, make a thumbs buffer with all files in current directory." t nil)
(autoload 'thumbs-dired-setroot "thumbs" "\
In dired, call the setroot program on the image at point." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thumbs" '("thumbs-")))
+(register-definition-prefixes "thumbs" '("thumbs-"))
;;;***
@@ -33744,7 +34491,7 @@ In dired, call the setroot program on the image at point." t nil)
;;; Generated autoloads from emacs-lisp/thunk.el
(push (purecopy '(thunk 1 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thunk" '("thunk-")))
+(register-definition-prefixes "thunk" '("thunk-"))
;;;***
@@ -33816,7 +34563,7 @@ See also docstring of the function tibetan-compose-region." t nil)
\(fn FROM TO)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tibet-util" '("tibetan-")))
+(register-definition-prefixes "tibet-util" '("tibetan-"))
;;;***
@@ -33876,6 +34623,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When space is inserted into a buffer in a position where hard space is required
instead (determined by `tildify-space-pattern' and `tildify-space-predicates'),
that space character is replaced by a hard space specified by
@@ -33887,7 +34637,7 @@ variable will be set to the representation.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tildify" '("tildify-")))
+(register-definition-prefixes "tildify" '("tildify-"))
;;;***
@@ -33925,6 +34675,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When Display Time mode is enabled, it updates every minute (you
can control the number of seconds between updates by customizing
`display-time-interval'). If `display-time-day-and-date' is
@@ -33933,22 +34686,26 @@ runs the normal hook `display-time-hook' after each update.
\(fn &optional ARG)" t nil)
-(autoload 'display-time-world "time" "\
-Enable updating display of times in various time zones.
-`display-time-world-list' specifies the zones.
-To turn off the world time display, go to that window and type `q'." t nil)
+(define-obsolete-function-alias 'display-time-world #'world-clock "28.1")
+
+(autoload 'world-clock "time" "\
+Display a world clock buffer with times in various time zones.
+The variable `world-clock-list' specifies which time zones to use.
+To turn off the world time display, go to the window and type `\\[quit-window]'." t nil)
(autoload 'emacs-uptime "time" "\
Return a string giving the uptime of this instance of Emacs.
FORMAT is a string to format the result, using `format-seconds'.
For example, the Unix uptime command format is \"%D, %z%2h:%.2m\".
+If the optional argument HERE is non-nil, insert string at
+point.
-\(fn &optional FORMAT)" t nil)
+\(fn &optional FORMAT HERE)" t nil)
(autoload 'emacs-init-time "time" "\
Return a string giving the duration of the Emacs initialization." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "time" '("display-time-" "legacy-style-world-list" "time--display-world-list" "zoneinfo-style-world-list")))
+(register-definition-prefixes "time" '("display-time-" "legacy-style-world-list" "time--display-world-list" "world-clock-" "zoneinfo-style-world-list"))
;;;***
@@ -34045,7 +34802,7 @@ Convert the time interval in seconds to a short string.
\(fn DELAY)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "time-date" '("date-" "decoded-time-" "encode-time-value" "seconds-to-string" "time-" "with-decoded-time-value")))
+(register-definition-prefixes "time-date" '("date-" "decoded-time-" "encode-time-value" "seconds-to-string" "time-" "with-decoded-time-value"))
;;;***
@@ -34093,7 +34850,7 @@ With ARG, turn time stamping on if and only if arg is positive.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "time-stamp" '("time-stamp-")))
+(register-definition-prefixes "time-stamp" '("time-stamp-"))
;;;***
@@ -34202,7 +34959,7 @@ relative only to the time worked today, and not to past time.
\(fn &optional SHOW-SECONDS TODAY-ONLY)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "timeclock" '("timeclock-")))
+(register-definition-prefixes "timeclock" '("timeclock-"))
;;;***
@@ -34216,14 +34973,14 @@ List all timers in a buffer.
\(fn &optional IGNORE-AUTO NONCONFIRM)" t nil)
(put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "timer-list" '("timer-list-")))
+(register-definition-prefixes "timer-list" '("timer-list-"))
;;;***
;;;### (autoloads nil "timezone" "timezone.el" (0 0 0 0))
;;; Generated autoloads from timezone.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "timezone" '("timezone-")))
+(register-definition-prefixes "timezone" '("timezone-"))
;;;***
@@ -34248,7 +35005,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\".
\(fn &optional FORCE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "titdic-cnv" '("batch-miscdic-convert" "ctlau-" "miscdic-convert" "pinyin-convert" "py-converter" "quail-" "quick-" "tit-" "tsang-" "ziranma-converter")))
+(register-definition-prefixes "titdic-cnv" '("batch-miscdic-convert" "ctlau-" "miscdic-convert" "pinyin-convert" "py-converter" "quail-" "quick-" "tit-" "tsang-" "ziranma-converter"))
;;;***
@@ -34294,7 +35051,7 @@ instead of executing it.
\(fn MENU &optional IN-POPUP DEFAULT-ITEM NO-EXECUTE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tmm" '("tmm-")))
+(register-definition-prefixes "tmm" '("tmm-"))
;;;***
@@ -34362,7 +35119,7 @@ Mode for displaying and reprioritizing top priority Todo.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "todo-mode" '("todo-")))
+(register-definition-prefixes "todo-mode" '("todo-"))
;;;***
@@ -34434,14 +35191,14 @@ holds a keymap.
\(fn COMMAND ICON IN-MAP &optional FROM-MAP &rest PROPS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tool-bar" '("tool-bar-")))
+(register-definition-prefixes "tool-bar" '("tool-bar-"))
;;;***
;;;### (autoloads nil "tooltip" "tooltip.el" (0 0 0 0))
;;; Generated autoloads from tooltip.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tooltip" '("tooltip-")))
+(register-definition-prefixes "tooltip" '("tooltip-"))
;;;***
@@ -34456,7 +35213,7 @@ to a tcp server on another machine.
\(fn PROCESS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tq" '("tq-")))
+(register-definition-prefixes "tq" '("tq-"))
;;;***
@@ -34505,13 +35262,13 @@ the output buffer or changing the window configuration.
(defalias 'trace-function 'trace-function-foreground)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trace" '("inhibit-trace" "trace-" "untrace-")))
+(register-definition-prefixes "trace" '("inhibit-trace" "trace-" "untrace-"))
;;;***
;;;### (autoloads nil "tramp" "net/tramp.el" (0 0 0 0))
;;; Generated autoloads from net/tramp.el
-(push (purecopy '(tramp 2 4 5 -1)) package--builtin-versions)
+(push (purecopy '(tramp 2 5 0 -1)) package--builtin-versions)
(defvar tramp-mode t "\
Whether Tramp is enabled.
@@ -34541,29 +35298,26 @@ 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) (if 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)) (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 "\
Unload Tramp file name handlers from `file-name-handler-alist'." (dolist (fnh file-name-handler-alist) (when (and (symbolp (cdr fnh)) (string-prefix-p "tramp-" (symbol-name (cdr fnh)))) (setq file-name-handler-alist (delq fnh file-name-handler-alist)))))
-(defvar tramp-completion-mode nil "\
-If non-nil, external packages signal that they are in file name completion.")
-
(defun tramp-unload-tramp nil "\
Discard Tramp from loading remote files." (interactive) (ignore-errors (unload-feature 'tramp 'force)))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp" '("tramp-" "with-")))
+(register-definition-prefixes "tramp" '("tramp-" "with-"))
;;;***
;;;### (autoloads nil "tramp-adb" "net/tramp-adb.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-adb.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-adb" '("tramp-")))
+(register-definition-prefixes "tramp-adb" '("tramp-"))
;;;***
@@ -34588,27 +35342,27 @@ Regular expression matching archive file names." '(concat "\\`" "\\(" ".+" "\\."
(defalias 'tramp-archive-autoload-file-name-handler #'tramp-autoload-file-name-handler)
(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)))
+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)))
(add-hook 'after-init-hook #'tramp-register-archive-file-name-handler)
(add-hook 'tramp-archive-unload-hook (lambda nil (remove-hook 'after-init-hook #'tramp-register-archive-file-name-handler)))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-archive" '("tramp-" "with-parsed-tramp-archive-file-name")))
+(register-definition-prefixes "tramp-archive" '("tramp-" "with-parsed-tramp-archive-file-name"))
;;;***
;;;### (autoloads nil "tramp-cache" "net/tramp-cache.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-cache.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-cache" '("tramp-")))
+(register-definition-prefixes "tramp-cache" '("tramp-"))
;;;***
;;;### (autoloads nil "tramp-cmds" "net/tramp-cmds.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-cmds.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-cmds" '("tramp-")))
+(register-definition-prefixes "tramp-cmds" '("tramp-"))
;;;***
@@ -34616,21 +35370,28 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive
;;;;;; 0))
;;; Generated autoloads from net/tramp-compat.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-compat" '("tramp-")))
+(register-definition-prefixes "tramp-compat" '("tramp-"))
+
+;;;***
+
+;;;### (autoloads nil "tramp-crypt" "net/tramp-crypt.el" (0 0 0 0))
+;;; Generated autoloads from net/tramp-crypt.el
+
+(register-definition-prefixes "tramp-crypt" '("tramp-crypt-"))
;;;***
;;;### (autoloads nil "tramp-ftp" "net/tramp-ftp.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-ftp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-ftp" '("tramp-")))
+(register-definition-prefixes "tramp-ftp" '("tramp-"))
;;;***
;;;### (autoloads nil "tramp-gvfs" "net/tramp-gvfs.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-gvfs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-gvfs" '("tramp-" "with-tramp-dbus-")))
+(register-definition-prefixes "tramp-gvfs" '("tramp-" "with-tramp-dbus-"))
;;;***
@@ -34638,7 +35399,7 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive
;;;;;; (0 0 0 0))
;;; Generated autoloads from net/tramp-integration.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-integration" '("tramp-")))
+(register-definition-prefixes "tramp-integration" '("tramp-"))
;;;***
@@ -34646,21 +35407,21 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive
;;;;;; 0))
;;; Generated autoloads from net/tramp-rclone.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-rclone" '("tramp-rclone-")))
+(register-definition-prefixes "tramp-rclone" '("tramp-rclone-"))
;;;***
;;;### (autoloads nil "tramp-sh" "net/tramp-sh.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-sh.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-sh" '("tramp-")))
+(register-definition-prefixes "tramp-sh" '("tramp-"))
;;;***
;;;### (autoloads nil "tramp-smb" "net/tramp-smb.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-smb.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-smb" '("tramp-smb-")))
+(register-definition-prefixes "tramp-smb" '("tramp-smb-"))
;;;***
@@ -34668,28 +35429,28 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive
;;;;;; 0 0 0))
;;; Generated autoloads from net/tramp-sudoedit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-sudoedit" '("tramp-sudoedit-")))
+(register-definition-prefixes "tramp-sudoedit" '("tramp-sudoedit-"))
;;;***
;;;### (autoloads nil "tramp-uu" "net/tramp-uu.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-uu.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-uu" '("tramp-uu")))
+(register-definition-prefixes "tramp-uu" '("tramp-uu"))
;;;***
;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0))
;;; Generated autoloads from net/trampver.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-")))
+(register-definition-prefixes "trampver" '("tramp-"))
;;;***
;;;### (autoloads nil "tree-widget" "tree-widget.el" (0 0 0 0))
;;; Generated autoloads from tree-widget.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tree-widget" '("tree-widget-")))
+(register-definition-prefixes "tree-widget" '("tree-widget-"))
;;;***
@@ -34715,7 +35476,7 @@ resumed later.
\(fn &optional ARG DONT-ASK-FOR-REVERT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tutorial" '("get-lang-string" "lang-strings" "tutorial--")))
+(register-definition-prefixes "tutorial" '("get-lang-string" "lang-strings" "tutorial--"))
;;;***
@@ -34727,7 +35488,7 @@ resumed later.
\(fn FROM TO FONT-OBJECT STRING DIRECTION)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tv-util" '("tai-viet-")))
+(register-definition-prefixes "tv-util" '("tai-viet-"))
;;;***
@@ -34775,7 +35536,7 @@ First column's text sSs Second column's text
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "two-column" '("2C-")))
+(register-definition-prefixes "two-column" '("2C-"))
;;;***
@@ -34801,6 +35562,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When this mode is enabled, the user is encouraged to take typing breaks at
appropriate intervals; either after a specified amount of time or when the
user has exceeded a keystroke threshold. When the time arrives, the user
@@ -34908,7 +35672,7 @@ FRAC should be the inverse of the fractional value; for example, a value of
\(fn WPM &optional WORDLEN FRAC)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "type-break" '("timep" "type-break-")))
+(register-definition-prefixes "type-break" '("timep" "type-break-"))
;;;***
@@ -34923,7 +35687,7 @@ You might need to set `uce-mail-reader' before using this.
\(fn &optional IGNORED)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "uce" '("uce-")))
+(register-definition-prefixes "uce" '("uce-"))
;;;***
@@ -34991,7 +35755,7 @@ Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus.
\(fn STR)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ucs-normalize" '("ucs-normalize-" "utf-8-hfs")))
+(register-definition-prefixes "ucs-normalize" '("ucs-normalize-" "utf-8-hfs"))
;;;***
@@ -35020,7 +35784,7 @@ which specify the range to operate on.
;;;;;; (0 0 0 0))
;;; Generated autoloads from mail/undigest.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "undigest" '("rmail-")))
+(register-definition-prefixes "undigest" '("rmail-"))
;;;***
@@ -35040,7 +35804,7 @@ The variable `unrmail-mbox-format' controls which mbox format to use.
\(fn FILE TO-FILE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "unrmail" '("unrmail-mbox-format")))
+(register-definition-prefixes "unrmail" '("unrmail-mbox-format"))
;;;***
@@ -35054,7 +35818,7 @@ UNSAFEP-VARS is a list of symbols with local bindings.
\(fn FORM &optional UNSAFEP-VARS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "unsafep" '("safe-functions" "unsafep-")))
+(register-definition-prefixes "unsafep" '("safe-functions" "unsafep-"))
;;;***
@@ -35110,14 +35874,14 @@ how long to wait for a response before giving up.
\(fn URL &optional SILENT INHIBIT-COOKIES TIMEOUT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url" '("url-")))
+(register-definition-prefixes "url" '("url-"))
;;;***
;;;### (autoloads nil "url-about" "url/url-about.el" (0 0 0 0))
;;; Generated autoloads from url/url-about.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-about" '("url-")))
+(register-definition-prefixes "url-about" '("url-"))
;;;***
@@ -35160,7 +35924,7 @@ RATING a rating between 1 and 10 of the strength of the authentication.
\(fn TYPE &optional FUNCTION RATING)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-auth" '("url-")))
+(register-definition-prefixes "url-auth" '("url-"))
;;;***
@@ -35183,7 +35947,7 @@ Extract FNAM from the local disk cache.
\(fn FNAM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-cache" '("url-")))
+(register-definition-prefixes "url-cache" '("url-"))
;;;***
@@ -35195,14 +35959,14 @@ Extract FNAM from the local disk cache.
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-cid" '("url-cid-gnus")))
+(register-definition-prefixes "url-cid" '("url-cid-gnus"))
;;;***
;;;### (autoloads nil "url-cookie" "url/url-cookie.el" (0 0 0 0))
;;; Generated autoloads from url/url-cookie.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-cookie" '("url-cookie")))
+(register-definition-prefixes "url-cookie" '("url-cookie"))
;;;***
@@ -35238,28 +36002,28 @@ added to this list, so most requests can just pass in nil.
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-dav" '("url-")))
+(register-definition-prefixes "url-dav" '("url-"))
;;;***
;;;### (autoloads nil "url-dired" "url/url-dired.el" (0 0 0 0))
;;; Generated autoloads from url/url-dired.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-dired" '("url-")))
+(register-definition-prefixes "url-dired" '("url-"))
;;;***
;;;### (autoloads nil "url-domsuf" "url/url-domsuf.el" (0 0 0 0))
;;; Generated autoloads from url/url-domsuf.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-domsuf" '("url-domsuf-")))
+(register-definition-prefixes "url-domsuf" '("url-domsuf-"))
;;;***
;;;### (autoloads nil "url-expand" "url/url-expand.el" (0 0 0 0))
;;; Generated autoloads from url/url-expand.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-expand" '("url-")))
+(register-definition-prefixes "url-expand" '("url-"))
;;;***
@@ -35271,21 +36035,21 @@ Handle file: and ftp: URLs.
\(fn URL CALLBACK CBARGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-file" '("url-file-")))
+(register-definition-prefixes "url-file" '("url-file-"))
;;;***
;;;### (autoloads nil "url-ftp" "url/url-ftp.el" (0 0 0 0))
;;; Generated autoloads from url/url-ftp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-ftp" '("url-ftp")))
+(register-definition-prefixes "url-ftp" '("url-ftp"))
;;;***
;;;### (autoloads nil "url-future" "url/url-future.el" (0 0 0 0))
;;; Generated autoloads from url/url-future.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-future" '("url-future-")))
+(register-definition-prefixes "url-future" '("url-future-"))
;;;***
@@ -35308,7 +36072,7 @@ overriding the value of `url-gateway-method'.
\(fn NAME BUFFER HOST SERVICE &optional GATEWAY-METHOD)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-gw" '("url-")))
+(register-definition-prefixes "url-gw" '("url-"))
;;;***
@@ -35334,6 +36098,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
(autoload 'url-file-handler "url-handlers" "\
@@ -35371,14 +36138,14 @@ if it had been inserted from a file named URL.
\(fn URL &optional VISIT BEG END REPLACE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-handlers" '("url-")))
+(register-definition-prefixes "url-handlers" '("url-"))
;;;***
;;;### (autoloads nil "url-history" "url/url-history.el" (0 0 0 0))
;;; Generated autoloads from url/url-history.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-history" '("url-")))
+(register-definition-prefixes "url-history" '("url-"))
;;;***
@@ -35392,14 +36159,14 @@ if it had been inserted from a file named URL.
(autoload 'url-https-file-readable-p "url-http")
(autoload 'url-https-file-attributes "url-http")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-http" '("url-h")))
+(register-definition-prefixes "url-http" '("url-h"))
;;;***
;;;### (autoloads nil "url-imap" "url/url-imap.el" (0 0 0 0))
;;; Generated autoloads from url/url-imap.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-imap" '("url-imap")))
+(register-definition-prefixes "url-imap" '("url-imap"))
;;;***
@@ -35411,7 +36178,7 @@ if it had been inserted from a file named URL.
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-irc" '("url-irc-")))
+(register-definition-prefixes "url-irc" '("url-irc-"))
;;;***
@@ -35426,7 +36193,7 @@ URL can be a URL string, or a URL record of the type returned by
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-ldap" '("url-ldap-")))
+(register-definition-prefixes "url-ldap" '("url-ldap-"))
;;;***
@@ -35443,14 +36210,14 @@ Handle the mailto: URL syntax.
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-mailto" '("url-mail-goto-field")))
+(register-definition-prefixes "url-mailto" '("url-mail-goto-field"))
;;;***
;;;### (autoloads nil "url-methods" "url/url-methods.el" (0 0 0 0))
;;; Generated autoloads from url/url-methods.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-methods" '("url-scheme-")))
+(register-definition-prefixes "url-methods" '("url-scheme-"))
;;;***
@@ -35483,7 +36250,7 @@ Fetch a data URL (RFC 2397).
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-misc" '("url-do-terminal-emulator")))
+(register-definition-prefixes "url-misc" '("url-do-terminal-emulator"))
;;;***
@@ -35500,14 +36267,14 @@ Fetch a data URL (RFC 2397).
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-news" '("url-news-")))
+(register-definition-prefixes "url-news" '("url-news-"))
;;;***
;;;### (autoloads nil "url-nfs" "url/url-nfs.el" (0 0 0 0))
;;; Generated autoloads from url/url-nfs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-nfs" '("url-nfs")))
+(register-definition-prefixes "url-nfs" '("url-nfs"))
;;;***
@@ -35560,7 +36327,7 @@ parses to
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-parse" '("url-")))
+(register-definition-prefixes "url-parse" '("url-"))
;;;***
@@ -35570,14 +36337,14 @@ parses to
(autoload 'url-setup-privacy-info "url-privacy" "\
Setup variables that expose info about you and your system." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-privacy" '("url-device-type")))
+(register-definition-prefixes "url-privacy" '("url-device-type"))
;;;***
;;;### (autoloads nil "url-proxy" "url/url-proxy.el" (0 0 0 0))
;;; Generated autoloads from url/url-proxy.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-proxy" '("url-")))
+(register-definition-prefixes "url-proxy" '("url-"))
;;;***
@@ -35593,7 +36360,7 @@ The variable `url-queue-timeout' sets a timeout.
\(fn URL CALLBACK &optional CBARGS SILENT INHIBIT-COOKIES)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-queue" '("url-queue")))
+(register-definition-prefixes "url-queue" '("url-queue"))
;;;***
@@ -35613,7 +36380,7 @@ would have been passed to OPERATION.
\(fn OPERATION &rest ARGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-tramp" '("url-tramp-convert-")))
+(register-definition-prefixes "url-tramp" '("url-tramp-convert-"))
;;;***
@@ -35793,14 +36560,14 @@ is \"www.fsf.co.uk\".
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-util" '("url-")))
+(register-definition-prefixes "url-util" '("url-"))
;;;***
;;;### (autoloads nil "url-vars" "url/url-vars.el" (0 0 0 0))
;;; Generated autoloads from url/url-vars.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-vars" '("url-")))
+(register-definition-prefixes "url-vars" '("url-"))
;;;***
@@ -35837,7 +36604,7 @@ The buffer in question is current when this function is called.
\(fn FILENAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "userlock" '("ask-user-about-" "file-" "userlock--check-content-unchanged")))
+(register-definition-prefixes "userlock" '("ask-user-about-" "file-" "userlock--check-content-unchanged"))
;;;***
@@ -35864,7 +36631,7 @@ The buffer in question is current when this function is called.
\(fn FROM TO)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "utf-7" '("utf-7-")))
+(register-definition-prefixes "utf-7" '("utf-7-"))
;;;***
@@ -35876,7 +36643,7 @@ Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil.
\(fn STRING &optional FOR-IMAP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "utf7" '("utf7-")))
+(register-definition-prefixes "utf7" '("utf7-"))
;;;***
@@ -35902,7 +36669,7 @@ If FILE-NAME is non-nil, save the result to FILE-NAME.
\(fn START END &optional FILE-NAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "uudecode" '("uudecode-")))
+(register-definition-prefixes "uudecode" '("uudecode-"))
;;;***
@@ -35939,7 +36706,10 @@ Note that if FILE is a symbolic link, it will not be resolved --
the responsible backend system for the symbolic link itself will
be reported.
-\(fn FILE)" nil nil)
+If NO-ERROR is nil, signal an error that no VC backend is
+responsible for the given file.
+
+\(fn FILE &optional NO-ERROR)" nil nil)
(autoload 'vc-next-action "vc" "\
Do the next logical version control operation on the current fileset.
@@ -36135,7 +36905,7 @@ with its diffs (if the underlying VCS supports that).
\(fn &optional LIMIT REVISION)" t nil)
(autoload 'vc-print-branch-log "vc" "\
-Show the change log for BRANCH in a window.
+Show the change log for BRANCH root in a window.
\(fn BRANCH)" t nil)
@@ -36183,8 +36953,6 @@ Revert working copies of the selected fileset to their repository contents.
This asks for confirmation if the buffer contents are not identical
to the working revision (except for keyword expansion)." t nil)
-(define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
-
(autoload 'vc-pull "vc" "\
Update the current fileset or branch.
You must be visiting a version controlled file, or in a `vc-dir' buffer.
@@ -36273,7 +37041,7 @@ Return the branch part of a revision number REV.
\(fn REV)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc" '("vc-" "with-vc-properties")))
+(register-definition-prefixes "vc" '("vc-" "with-vc-properties"))
;;;***
@@ -36314,7 +37082,7 @@ should be applied to the background or to the foreground.
\(fn FILE REV &optional DISPLAY-MODE BUF MOVE-POINT-TO VC-BK)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-annotate" '("vc-")))
+(register-definition-prefixes "vc-annotate" '("vc-"))
;;;***
@@ -36332,7 +37100,7 @@ Name of the format file in a .bzr directory.")
(load "vc-bzr" nil t)
(vc-bzr-registered file))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-bzr" '("vc-bzr-")))
+(register-definition-prefixes "vc-bzr" '("vc-bzr-"))
;;;***
@@ -36345,20 +37113,25 @@ Name of the format file in a .bzr directory.")
(load "vc-cvs" nil t)
(vc-cvs-registered f)))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-cvs" '("vc-cvs-")))
+(register-definition-prefixes "vc-cvs" '("vc-cvs-"))
;;;***
;;;### (autoloads nil "vc-dav" "vc/vc-dav.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-dav.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-dav" '("vc-dav-")))
+(register-definition-prefixes "vc-dav" '("vc-dav-"))
;;;***
;;;### (autoloads nil "vc-dir" "vc/vc-dir.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-dir.el
+(autoload 'vc-dir-root "vc-dir" "\
+Run `vc-dir' in the repository root directory without prompt.
+If the default directory of the current buffer is
+not under version control, prompt for a directory." t nil)
+
(autoload 'vc-dir "vc-dir" "\
Show the VC status for \"interesting\" files in and below DIR.
This allows you to mark files and perform VC operations on them.
@@ -36378,7 +37151,14 @@ These are the commands available for use in the file status buffer:
\(fn DIR &optional BACKEND)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-dir" '("vc-")))
+(autoload 'vc-dir-bookmark-jump "vc-dir" "\
+Provides the bookmark-jump behavior for a `vc-dir' buffer.
+This implements the `handler' function interface for the record
+type returned by `vc-dir-bookmark-make-record'.
+
+\(fn BMK)" nil nil)
+
+(register-definition-prefixes "vc-dir" '("vc-"))
;;;***
@@ -36404,14 +37184,14 @@ case, and the process object in the asynchronous case.
\(fn BUFFER OKSTATUS COMMAND FILE-OR-LIST &rest FLAGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-dispatcher" '("vc-")))
+(register-definition-prefixes "vc-dispatcher" '("vc-"))
;;;***
;;;### (autoloads nil "vc-filewise" "vc/vc-filewise.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-filewise.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-filewise" '("vc-")))
+(register-definition-prefixes "vc-filewise" '("vc-"))
;;;***
@@ -36424,7 +37204,7 @@ case, and the process object in the asynchronous case.
(load "vc-git" nil t)
(vc-git-registered file))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-git" '("vc-git-")))
+(register-definition-prefixes "vc-git" '("vc-git-"))
;;;***
@@ -36437,7 +37217,7 @@ case, and the process object in the asynchronous case.
(load "vc-hg" nil t)
(vc-hg-registered file))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-hg" '("vc-hg-")))
+(register-definition-prefixes "vc-hg" '("vc-hg-"))
;;;***
@@ -36455,7 +37235,7 @@ Name of the monotone directory's format file.")
(load "vc-mtn" nil t)
(vc-mtn-registered file))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-mtn" '("vc-mtn-")))
+(register-definition-prefixes "vc-mtn" '("vc-mtn-"))
;;;***
@@ -36470,7 +37250,7 @@ For a description of possible values, see `vc-check-master-templates'.")
(defun vc-rcs-registered (f) (vc-default-registered 'RCS f))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-rcs" '("vc-r")))
+(register-definition-prefixes "vc-rcs" '("vc-r"))
;;;***
@@ -36490,7 +37270,7 @@ Return the name of a master file in the SCCS project directory.
Does not check whether the file exists but returns nil if it does not
find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) (when project-dir (if (file-name-absolute-p project-dir) (setq dirs '("SCCS" "")) (setq dirs '("src/SCCS" "src" "source/SCCS" "source")) (setq project-dir (expand-file-name (concat "~" project-dir)))) (while (and (not dir) dirs) (setq dir (expand-file-name (car dirs) project-dir)) (unless (file-directory-p dir) (setq dir nil) (setq dirs (cdr dirs)))) (and dir (expand-file-name (concat "s." basename) dir)))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-sccs" '("vc-sccs-")))
+(register-definition-prefixes "vc-sccs" '("vc-sccs-"))
;;;***
@@ -36505,7 +37285,7 @@ For a description of possible values, see `vc-check-master-templates'.")
(defun vc-src-registered (f) (vc-default-registered 'src f))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-src" '("vc-src-")))
+(register-definition-prefixes "vc-src" '("vc-src-"))
;;;***
@@ -36520,14 +37300,14 @@ For a description of possible values, see `vc-check-master-templates'.")
(load "vc-svn" nil t)
(vc-svn-registered f))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-svn" '("vc-svn-")))
+(register-definition-prefixes "vc-svn" '("vc-svn-"))
;;;***
;;;### (autoloads nil "vcursor" "vcursor.el" (0 0 0 0))
;;; Generated autoloads from vcursor.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vcursor" '("vcursor-")))
+(register-definition-prefixes "vcursor" '("vcursor-"))
;;;***
@@ -36588,14 +37368,14 @@ Key bindings:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vera-mode" '("vera-")))
+(register-definition-prefixes "vera-mode" '("vera-"))
;;;***
;;;### (autoloads nil "verilog-mode" "progmodes/verilog-mode.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from progmodes/verilog-mode.el
-(push (purecopy '(verilog-mode 2019 12 17 268053413)) package--builtin-versions)
+(push (purecopy '(verilog-mode 2020 6 27 14326051)) package--builtin-versions)
(autoload 'verilog-mode "verilog-mode" "\
Major mode for editing Verilog code.
@@ -36731,7 +37511,7 @@ Key bindings specific to `verilog-mode-map' are:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "verilog-mode" '("electric-verilog-" "verilog-" "vl-")))
+(register-definition-prefixes "verilog-mode" '("electric-verilog-" "verilog-" "vl-"))
;;;***
@@ -37288,7 +38068,7 @@ Key bindings:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vhdl-mode" '("vhdl-")))
+(register-definition-prefixes "vhdl-mode" '("vhdl-"))
;;;***
@@ -37331,7 +38111,7 @@ Convert Vietnamese characters of the current buffer to `VIQR' mnemonics." t nil)
\(fn FROM TO)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viet-util" '("viet-viqr-alist" "viqr-regexp")))
+(register-definition-prefixes "viet-util" '("viet-viqr-alist" "viqr-regexp"))
;;;***
@@ -37476,6 +38256,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
When View mode is enabled, commands that do not change the buffer
contents are available as usual. Kill commands save text but
do not delete it from the buffer. Most other commands beep and
@@ -37589,7 +38372,7 @@ This function runs the normal hook `view-mode-hook'.
(autoload 'View-exit-and-edit "view" "\
Exit View mode and make the current buffer editable." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "view" '("View-" "view-")))
+(register-definition-prefixes "view" '("View-" "view-"))
;;;***
@@ -37604,7 +38387,7 @@ If Viper is enabled, turn it off. Otherwise, turn it on." t nil)
(autoload 'viper-mode "viper" "\
Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper" '("set-viper-state-in-major-mode" "this-major-mode-requires-vi-state" "viper-")))
+(register-definition-prefixes "viper" '("set-viper-state-in-major-mode" "this-major-mode-requires-vi-state" "viper-"))
;;;***
@@ -37612,14 +38395,14 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
;;;;;; 0))
;;; Generated autoloads from emulation/viper-cmd.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-cmd" '("viper-")))
+(register-definition-prefixes "viper-cmd" '("viper-"))
;;;***
;;;### (autoloads nil "viper-ex" "emulation/viper-ex.el" (0 0 0 0))
;;; Generated autoloads from emulation/viper-ex.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-ex" '("ex-" "viper-")))
+(register-definition-prefixes "viper-ex" '("ex-" "viper-"))
;;;***
@@ -37627,7 +38410,7 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
;;;;;; 0 0))
;;; Generated autoloads from emulation/viper-init.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-init" '("viper-")))
+(register-definition-prefixes "viper-init" '("viper-"))
;;;***
@@ -37635,7 +38418,7 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
;;;;;; 0 0))
;;; Generated autoloads from emulation/viper-keym.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-keym" '("ex-read-filename-map" "viper-")))
+(register-definition-prefixes "viper-keym" '("ex-read-filename-map" "viper-"))
;;;***
@@ -37643,7 +38426,7 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
;;;;;; 0 0))
;;; Generated autoloads from emulation/viper-macs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-macs" '("ex-" "viper-")))
+(register-definition-prefixes "viper-macs" '("ex-" "viper-"))
;;;***
@@ -37651,7 +38434,7 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
;;;;;; 0 0))
;;; Generated autoloads from emulation/viper-mous.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-mous" '("viper-")))
+(register-definition-prefixes "viper-mous" '("viper-"))
;;;***
@@ -37659,35 +38442,35 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
;;;;;; 0 0))
;;; Generated autoloads from emulation/viper-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-util" '("viper")))
+(register-definition-prefixes "viper-util" '("viper"))
;;;***
;;;### (autoloads nil "vt-control" "vt-control.el" (0 0 0 0))
;;; Generated autoloads from vt-control.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vt-control" '("vt-")))
+(register-definition-prefixes "vt-control" '("vt-"))
;;;***
;;;### (autoloads nil "vt100-led" "vt100-led.el" (0 0 0 0))
;;; Generated autoloads from vt100-led.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vt100-led" '("led-")))
+(register-definition-prefixes "vt100-led" '("led-"))
;;;***
;;;### (autoloads nil "w32-fns" "w32-fns.el" (0 0 0 0))
;;; Generated autoloads from w32-fns.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "w32-fns" '("w32-")))
+(register-definition-prefixes "w32-fns" '("w32-"))
;;;***
;;;### (autoloads nil "w32-vars" "w32-vars.el" (0 0 0 0))
;;; Generated autoloads from w32-vars.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "w32-vars" '("w32-")))
+(register-definition-prefixes "w32-vars" '("w32-"))
;;;***
@@ -37749,6 +38532,11 @@ See also `warning-series', `warning-prefix-function',
`warning-fill-prefix', and `warning-fill-column' for additional
programming features.
+This will also display buttons allowing the user to permanently
+disable automatic display of the warning or disable the warning
+entirely by setting `warning-suppress-types' or
+`warning-suppress-log-types' on their behalf.
+
\(fn TYPE MESSAGE &optional LEVEL BUFFER-NAME)" nil nil)
(autoload 'lwarn "warnings" "\
@@ -37781,13 +38569,12 @@ this is equivalent to `display-warning', using
\(fn MESSAGE &rest ARGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "warnings" '("display-warning-minimum-level" "log-warning-minimum-level" "warning-")))
+(register-definition-prefixes "warnings" '("warning-"))
;;;***
;;;### (autoloads nil "wdired" "wdired.el" (0 0 0 0))
;;; Generated autoloads from wdired.el
-(push (purecopy '(wdired 2 0)) package--builtin-versions)
(autoload 'wdired-change-to-wdired-mode "wdired" "\
Put a Dired buffer in Writable Dired (WDired) mode.
@@ -37799,7 +38586,7 @@ directories to reflect your edits.
See `wdired-mode'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "wdired" '("wdired-")))
+(register-definition-prefixes "wdired" '("wdired-"))
;;;***
@@ -37815,7 +38602,7 @@ hotlist.
Please submit bug reports and other feedback to the author, Neil W. Van Dyke
<nwv@acm.org>." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "webjump" '("webjump-")))
+(register-definition-prefixes "webjump" '("webjump-"))
;;;***
@@ -37845,13 +38632,16 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Which Function mode is a global minor mode. When enabled, the
current function name is continuously displayed in the mode line,
in certain major modes.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "which-func" '("which-func")))
+(register-definition-prefixes "which-func" '("which-func"))
;;;***
@@ -37867,6 +38657,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
See also `whitespace-style', `whitespace-newline' and
`whitespace-display-mappings'.
@@ -37880,6 +38673,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Use `whitespace-newline-mode' only for NEWLINE visualization
exclusively. For other visualizations, including NEWLINE
visualization together with (HARD) SPACEs and/or TABs, please,
@@ -37907,6 +38703,9 @@ positive, and disable it if ARG is zero or negative. If called from
Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
See also `whitespace-style', `whitespace-newline' and
`whitespace-display-mappings'.
@@ -37930,6 +38729,9 @@ is positive, and disable it if ARG is zero or negative. If called
from Lisp, also enable the mode if ARG is omitted or nil, and toggle
it if ARG is `toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Use `global-whitespace-newline-mode' only for NEWLINE
visualization exclusively. For other visualizations, including
NEWLINE visualization together with (HARD) SPACEs and/or TABs,
@@ -38224,7 +39026,7 @@ cleaning up these problems.
\(fn START END &optional FORCE REPORT-IF-BOGUS)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "whitespace" '("whitespace-")))
+(register-definition-prefixes "whitespace" '("whitespace-"))
;;;***
@@ -38254,9 +39056,12 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "wid-browse" '("widget-")))
+(register-definition-prefixes "wid-browse" '("widget-"))
;;;***
@@ -38298,7 +39103,7 @@ Note that such modes will need to require wid-edit.")
(autoload 'widget-setup "wid-edit" "\
Setup current buffer so editing string widgets works." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "wid-edit" '("widget-")))
+(register-definition-prefixes "wid-edit" '("widget-"))
;;;***
@@ -38386,6 +39191,11 @@ Display the next buffer in the same window.
\(fn &optional ARG)" t nil)
+(autoload 'windmove-display-new-frame "windmove" "\
+Display the next buffer in a new frame.
+
+\(fn &optional ARG)" t nil)
+
(autoload 'windmove-display-new-tab "windmove" "\
Display the next buffer in a new tab.
@@ -38458,7 +39268,7 @@ or a single modifier. Default value of MODIFIERS is `shift-super'.
\(fn &optional MODIFIERS)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "windmove" '("windmove-")))
+(register-definition-prefixes "windmove" '("windmove-"))
;;;***
@@ -38483,6 +39293,9 @@ disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Winner mode is a global minor mode that records the changes in
the window configuration (i.e. how the frames are partitioned
into windows) so that the changes can be \"undone\" using the
@@ -38492,13 +39305,12 @@ you can press `C-c <right>' (calling `winner-redo').
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "winner" '("winner-")))
+(register-definition-prefixes "winner" '("winner-"))
;;;***
;;;### (autoloads nil "woman" "woman.el" (0 0 0 0))
;;; Generated autoloads from woman.el
-(push (purecopy '(woman 0 551)) package--builtin-versions)
(defvar woman-locale nil "\
String specifying a manual page locale, or nil.
@@ -38541,21 +39353,21 @@ Default bookmark handler for Woman buffers.
\(fn BOOKMARK)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "woman" '("WoMan-" "menu-bar-manuals-menu" "set-woman-file-regexp" "woman")))
+(register-definition-prefixes "woman" '("WoMan-" "menu-bar-manuals-menu" "set-woman-file-regexp" "woman"))
;;;***
;;;### (autoloads nil "x-dnd" "x-dnd.el" (0 0 0 0))
;;; Generated autoloads from x-dnd.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "x-dnd" '("x-dnd-")))
+(register-definition-prefixes "x-dnd" '("x-dnd-"))
;;;***
;;;### (autoloads nil "xdg" "xdg.el" (0 0 0 0))
;;; Generated autoloads from xdg.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xdg" '("xdg-")))
+(register-definition-prefixes "xdg" '("xdg-"))
;;;***
@@ -38619,7 +39431,7 @@ All text between the <!-- ... --> markers will be removed.
\(fn BEG END)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xml" '("xml-")))
+(register-definition-prefixes "xml" '("xml-"))
;;;***
@@ -38639,12 +39451,13 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT.
\(fn &optional LIMIT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xmltok" '("xmltok-")))
+(register-definition-prefixes "xmltok" '("xmltok-"))
;;;***
;;;### (autoloads nil "xref" "progmodes/xref.el" (0 0 0 0))
;;; Generated autoloads from progmodes/xref.el
+(push (purecopy '(xref 1 0 3)) package--builtin-versions)
(autoload 'xref-find-backend "xref" nil nil nil)
@@ -38730,21 +39543,21 @@ FILES must be a list of absolute file names.
\(fn REGEXP FILES)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xref" '("xref-")))
+(register-definition-prefixes "xref" '("xref-"))
;;;***
;;;### (autoloads nil "xscheme" "progmodes/xscheme.el" (0 0 0 0))
;;; Generated autoloads from progmodes/xscheme.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xscheme" '("default-xscheme-runlight" "exit-scheme-interaction-mode" "global-set-scheme-interaction-buffer" "local-" "reset-scheme" "run-scheme" "scheme-" "start-scheme" "verify-xscheme-buffer" "xscheme-")))
+(register-definition-prefixes "xscheme" '("default-xscheme-runlight" "exit-scheme-interaction-mode" "global-set-scheme-interaction-buffer" "local-" "reset-scheme" "run-scheme" "scheme-" "start-scheme" "verify-xscheme-buffer" "xscheme-"))
;;;***
;;;### (autoloads nil "xsd-regexp" "nxml/xsd-regexp.el" (0 0 0 0))
;;; Generated autoloads from nxml/xsd-regexp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xsd-regexp" '("xsdre-")))
+(register-definition-prefixes "xsd-regexp" '("xsdre-"))
;;;***
@@ -38769,6 +39582,9 @@ and disable it if ARG is zero or negative. If called from Lisp, also
enable the mode if ARG is omitted or nil, and toggle it if ARG is
`toggle'; disable the mode otherwise.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
Turn it on to use Emacs mouse commands, and off to use xterm mouse commands.
This works in terminal emulators compatible with xterm. It only
works for simple uses of the mouse. Basically, only non-modified
@@ -38778,7 +39594,7 @@ down the SHIFT key while pressing the mouse button.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xt-mouse" '("turn-o" "xt-mouse-epoch" "xterm-mouse-")))
+(register-definition-prefixes "xt-mouse" '("turn-o" "xt-mouse-epoch" "xterm-mouse-"))
;;;***
@@ -38792,7 +39608,7 @@ Interactively, URL defaults to the string looking like a url around point.
\(fn URL &optional NEW-SESSION)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xwidget" '("xwidget-")))
+(register-definition-prefixes "xwidget" '("xwidget-"))
;;;***
@@ -38807,14 +39623,14 @@ Yenc decode region between START and END using an internal decoder.
(autoload 'yenc-extract-filename "yenc" "\
Extract file name from an yenc header." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "yenc" '("yenc-")))
+(register-definition-prefixes "yenc" '("yenc-"))
;;;***
;;;### (autoloads nil "zeroconf" "net/zeroconf.el" (0 0 0 0))
;;; Generated autoloads from net/zeroconf.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "zeroconf" '("zeroconf-")))
+(register-definition-prefixes "zeroconf" '("zeroconf-"))
;;;***
@@ -38824,7 +39640,7 @@ Extract file name from an yenc header." nil nil)
(autoload 'zone "zone" "\
Zone out, completely." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "zone" '("zone-")))
+(register-definition-prefixes "zone" '("zone-"))
;;;***
@@ -38870,31 +39686,40 @@ Zone out, completely." t nil)
;;;;;; "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/eldoc.el" "emacs-lisp/float-sup.el"
-;;;;;; "emacs-lisp/lisp-mode.el" "emacs-lisp/lisp.el" "emacs-lisp/macroexp.el"
-;;;;;; "emacs-lisp/map-ynp.el" "emacs-lisp/nadvice.el" "emacs-lisp/syntax.el"
-;;;;;; "emacs-lisp/timer.el" "env.el" "epa-hook.el" "erc/erc-autoaway.el"
-;;;;;; "erc/erc-button.el" "erc/erc-capab.el" "erc/erc-compat.el"
-;;;;;; "erc/erc-dcc.el" "erc/erc-desktop-notifications.el" "erc/erc-ezbounce.el"
-;;;;;; "erc/erc-fill.el" "erc/erc-identd.el" "erc/erc-imenu.el"
-;;;;;; "erc/erc-join.el" "erc/erc-list.el" "erc/erc-log.el" "erc/erc-match.el"
-;;;;;; "erc/erc-menu.el" "erc/erc-netsplit.el" "erc/erc-notify.el"
-;;;;;; "erc/erc-page.el" "erc/erc-pcomplete.el" "erc/erc-replace.el"
-;;;;;; "erc/erc-ring.el" "erc/erc-services.el" "erc/erc-sound.el"
-;;;;;; "erc/erc-speedbar.el" "erc/erc-spelling.el" "erc/erc-stamp.el"
-;;;;;; "erc/erc-track.el" "erc/erc-truncate.el" "erc/erc-xdcc.el"
-;;;;;; "eshell/em-alias.el" "eshell/em-banner.el" "eshell/em-basic.el"
-;;;;;; "eshell/em-cmpl.el" "eshell/em-dirs.el" "eshell/em-glob.el"
-;;;;;; "eshell/em-hist.el" "eshell/em-ls.el" "eshell/em-pred.el"
-;;;;;; "eshell/em-prompt.el" "eshell/em-rebind.el" "eshell/em-script.el"
-;;;;;; "eshell/em-smart.el" "eshell/em-term.el" "eshell/em-tramp.el"
-;;;;;; "eshell/em-unix.el" "eshell/em-xtra.el" "facemenu.el" "faces.el"
-;;;;;; "files.el" "font-core.el" "font-lock.el" "format.el" "frame.el"
-;;;;;; "help.el" "hfy-cmap.el" "ibuf-ext.el" "indent.el" "international/characters.el"
+;;;;;; "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"
+;;;;;; "erc/erc-notify.el" "erc/erc-page.el" "erc/erc-pcomplete.el"
+;;;;;; "erc/erc-replace.el" "erc/erc-ring.el" "erc/erc-services.el"
+;;;;;; "erc/erc-sound.el" "erc/erc-speedbar.el" "erc/erc-spelling.el"
+;;;;;; "erc/erc-stamp.el" "erc/erc-status-sidebar.el" "erc/erc-track.el"
+;;;;;; "erc/erc-truncate.el" "erc/erc-xdcc.el" "eshell/em-alias.el"
+;;;;;; "eshell/em-banner.el" "eshell/em-basic.el" "eshell/em-cmpl.el"
+;;;;;; "eshell/em-dirs.el" "eshell/em-glob.el" "eshell/em-hist.el"
+;;;;;; "eshell/em-ls.el" "eshell/em-pred.el" "eshell/em-prompt.el"
+;;;;;; "eshell/em-rebind.el" "eshell/em-script.el" "eshell/em-smart.el"
+;;;;;; "eshell/em-term.el" "eshell/em-tramp.el" "eshell/em-unix.el"
+;;;;;; "eshell/em-xtra.el" "facemenu.el" "faces.el" "files.el" "font-core.el"
+;;;;;; "font-lock.el" "format.el" "frame.el" "help.el" "hfy-cmap.el"
+;;;;;; "ibuf-ext.el" "indent.el" "international/characters.el" "international/charprop.el"
;;;;;; "international/charscript.el" "international/cp51932.el"
;;;;;; "international/eucjp-ms.el" "international/mule-cmds.el"
-;;;;;; "international/mule-conf.el" "international/mule.el" "isearch.el"
-;;;;;; "jit-lock.el" "jka-cmpr-hook.el" "language/burmese.el" "language/cham.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"
diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el
index 2681eab0e5e..100ae63f6ac 100644
--- a/lisp/leim/quail/indian.el
+++ b/lisp/leim/quail/indian.el
@@ -117,6 +117,7 @@
indian-knd-itrans-v5-hash "kannada-itrans" "Kannada" "KndIT"
"Kannada transliteration by ITRANS method.")
+;; ITRANS not applicable to Malayalam & could be removed eventually
(if nil
(quail-define-package "malayalam-itrans" "Malayalam" "MlmIT" t "Malayalam ITRANS"))
(quail-define-indian-trans-package
@@ -358,24 +359,23 @@ Full key sequences are listed below:")
'(
(;; VOWELS (18)
(?D nil) (?E ?e) (?F ?f) (?R ?r) (?G ?g) (?T ?t)
- (?+ ?=) ("F]" "f]") (?! ?@) (?S ?s) (?Z ?z) (?W ?w)
- (?| ?\\) (?~ ?`) (?A ?a) (?Q ?q) ("+]" "=]") ("R]" "r]"))
+ (?= ?+) nil nil (?S ?s) (?Z ?z) (?W ?w)
+ nil (?~ ?`) (?A ?a) (?Q ?q))
(;; CONSONANTS (42)
?k ?K ?i ?I ?U ;; GRUTTALS
?\; ?: ?p ?P ?} ;; PALATALS
?' ?\" ?\[ ?{ ?C ;; CEREBRALS
- ?l ?L ?o ?O ?v ?V ;; DENTALS
+ ?l ?L ?o ?O ?v nil ;; DENTALS
?h ?H ?y ?Y ?c ;; LABIALS
- ?/ ?j ?J ?n ?N "N]" ?b ;; SEMIVOWELS
+ ?/ ?j ?J ?n ?N ?B ?b ;; SEMIVOWELS
?M ?< ?m ?u ;; SIBILANTS
- "k]" "K]" "i]" "p]" "[]" "{]" "H]" "/]" ;; NUKTAS
- ?% ?&)
+ nil nil nil nil nil nil nil nil nil) ;; NUKTAS
(;; Misc Symbols (7)
- ?X ?x ?_ ">]" ?d "X]" ?>)
+ nil ?x ?_ nil ?d)
(;; Digits
?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)
- (;; Inscripts
- ?# ?$ ?^ ?* ?\])))
+ (;; Chillus
+ "Cd" "Cd]" "vd" "vd]" "jd" "jd]" "nd" "nd]" "Nd" "Nd]")))
(defvar inscript-tml-keytable
'(
@@ -463,6 +463,9 @@ Full key sequences are listed below:")
"malayalam-inscript" "Malayalam" "MlmIS"
"Malayalam keyboard Inscript.")
+(quail-defrule "\\" ?‌)
+(quail-defrule "X" ?​)
+
(if nil
(quail-define-package "tamil-inscript" "Tamil" "TmlIS" t "Tamil keyboard Inscript"))
(quail-define-inscript-package
@@ -571,4 +574,72 @@ Full key sequences are listed below:")
("?" ?\?)
("/" ?্))
+(defun indian-mlm-mozhi-update-translation (control-flag)
+ (let ((len (length quail-current-key)) chillu
+ (vowels '(?a ?e ?i ?o ?u ?A ?E ?I ?O ?U ?R)))
+ (cond ((numberp control-flag)
+ (progn (if (= control-flag 0)
+ (setq quail-current-str quail-current-key)
+ (cond (input-method-exit-on-first-char)
+ ((and (memq (aref quail-current-key
+ (1- control-flag))
+ vowels)
+ (setq chillu (cl-position
+ (aref quail-current-key
+ control-flag)
+ '(?m ?N ?n ?r ?l ?L))))
+ ;; conditions for putting chillu
+ (and (or (and (= control-flag (1- len))
+ (not (setq control-flag nil)))
+ (and (= control-flag (- len 2))
+ (let ((temp (aref quail-current-key
+ (1- len))))
+ ;; is it last char of word?
+ (not
+ (or (and (>= temp ?a) (<= temp ?z))
+ (and (>= temp ?A) (<= temp ?Z))
+ (eq temp ?~))))
+ (setq control-flag (1+ control-flag))))
+ (setq quail-current-str ;; put chillu
+ (concat (if (not (stringp
+ quail-current-str))
+ (string quail-current-str)
+ quail-current-str)
+ (string
+ (nth chillu '(?ം ?ൺ ?ൻ ?ർ ?ൽ ?ൾ)))))))))
+ (and (not input-method-exit-on-first-char) control-flag
+ (while (> len control-flag)
+ (setq len (1- len))
+ (setq unread-command-events
+ (cons (aref quail-current-key len)
+ unread-command-events))))
+ ))
+ ((null control-flag)
+ (unless quail-current-str
+ (setq quail-current-str quail-current-key)
+ ))
+ ((equal control-flag t)
+ (if (memq (aref quail-current-key (1- len)) ;; If vowel ending,
+ vowels) ;; may have to put
+ (setq control-flag nil))))) ;; chillu. So don't
+ control-flag) ;; end translation
+
+(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)
+
+(maphash
+ (lambda (key val)
+ (quail-defrule key (if (= (length val) 1)
+ (string-to-char val)
+ (vector val))))
+ (cdr indian-mlm-mozhi-hash))
+
+(defun indian-mlm-mozhi-underscore (key len) (throw 'quail-tag nil))
+
+(quail-defrule "_" 'indian-mlm-mozhi-underscore)
+(quail-defrule "|" ?‌)
+(quail-defrule "||" ?​)
+
;;; indian.el ends here
diff --git a/lisp/leim/quail/ipa.el b/lisp/leim/quail/ipa.el
index d4170564c58..cbc555d1faa 100644
--- a/lisp/leim/quail/ipa.el
+++ b/lisp/leim/quail/ipa.el
@@ -340,7 +340,7 @@ See http://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf for a full definition
of the mapping.")
(quail-define-rules
- ;; Table taken from http://en.wikipedia.org/wiki/X-SAMPA, checked with
+ ;; Table taken from https://en.wikipedia.org/wiki/X-SAMPA, checked with
;; http://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf
("d`" "ɖ") ;; Voiced retroflex plosive U+0256
diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el
index 35a9adbe29b..6a2508ba31d 100644
--- a/lisp/leim/quail/latin-ltx.el
+++ b/lisp/leim/quail/latin-ltx.el
@@ -242,12 +242,14 @@ system, including many technical ones. Examples:
((lambda (name char)
;; "GREEK SMALL LETTER PHI" (which is \phi) and "GREEK PHI SYMBOL"
;; (which is \varphi) are reversed in `ucs-names', so we define
- ;; them manually.
- (unless (string-match-p "\\<PHI\\>" name)
+ ;; them manually. Also ignore "GREEK SMALL LETTER EPSILON" and
+ ;; add the correct value for \epsilon manually.
+ (unless (string-match-p "\\<\\(?:PHI\\|GREEK SMALL LETTER EPSILON\\)\\>" name)
(concat "\\" (funcall (if (match-end 1) #' capitalize #'downcase)
(match-string 2 name)))))
"\\`GREEK \\(?:SMALL\\|CAPITA\\(L\\)\\) LETTER \\([^- ]+\\)\\'")
+ ("\\epsilon" ?ϵ)
("\\phi" ?ϕ)
("\\Box" ?□)
("\\Bumpeq" ?≎)
@@ -641,6 +643,7 @@ system, including many technical ones. Examples:
(concat "\\var" (downcase (match-string 1 name)))))
"\\`GREEK \\([^- ]+\\) SYMBOL\\'")
+ ("\\varepsilon" ?ε)
("\\varphi" ?φ)
("\\varprime" ?′)
("\\varpropto" ?∝)
@@ -727,7 +730,9 @@ system, including many technical ones. Examples:
("\\ldq" ?\“)
("\\rdq" ?\”)
("\\defs" ?≙) ; per fuzz/zed
- ;; ("\\sqrt[3]" ?∛)
+ ("\\sqrt" ?√)
+ ("\\sqrt[3]" ?∛)
+ ("\\sqrt[4]" ?∜)
("\\llbracket" ?\〚) ; stmaryrd
("\\rrbracket" ?\〛)
;; ("\\lbag" ?\〚) ; fuzz
diff --git a/lisp/linum.el b/lisp/linum.el
index 8f0e7ddce4d..e8c364245ae 100644
--- a/lisp/linum.el
+++ b/lisp/linum.el
@@ -5,7 +5,7 @@
;; Author: Markus Triska <markus.triska@gmx.at>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
-;; Version: 0.9x
+;; Old-Version: 0.9x
;; This file is part of GNU Emacs.
@@ -32,6 +32,7 @@
;;; Code:
(defconst linum-version "0.9x")
+(make-obsolete-variable 'linum-version nil "28.1")
(defvar linum-overlays nil "Overlays used in this buffer.")
(defvar linum-available nil "Overlays available for reuse.")
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 97525b27086..568b9fe40df 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -170,7 +170,6 @@
(load "cus-face")
(load "faces") ; after here, `defface' may be used.
-(load "button")
;; We don't want to store loaddefs.el in the repository because it is
;; a generated file; but it is required in order to compile the lisp files.
@@ -193,6 +192,7 @@
definition-prefixes)
(setq definition-prefixes new))
+(load "button") ;After loaddefs, because of define-minor-mode!
(load "emacs-lisp/nadvice")
(load "emacs-lisp/cl-preloaded")
(load "obarray") ;abbrev.el is implemented in terms of obarrays.
diff --git a/lisp/locate.el b/lisp/locate.el
index 9f402716d02..bc78e06eab2 100644
--- a/lisp/locate.el
+++ b/lisp/locate.el
@@ -267,9 +267,7 @@ that is, with a prefix arg, you get the default behavior."
(let* ((default (locate-word-at-point))
(input
(read-from-minibuffer
- (if (> (length default) 0)
- (format "Locate (default %s): " default)
- (format "Locate: "))
+ (format-prompt "Locate" default)
nil nil nil 'locate-history-list default t)))
(and (equal input "") default
(setq input default))
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 2952242c251..8851522bbdb 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -435,9 +435,9 @@ not contain `d', so that a full listing is expected."
;; text. But if the listing is empty, as e.g. in empty
;; directories with -a removed from switches, point will be
;; before the inserted text, and dired-insert-directory will
- ;; not indent the listing correctly. Going to the end of the
- ;; buffer fixes that.
- (unless files (goto-char (point-max)))
+ ;; not indent the listing correctly. Getting past the
+ ;; inserted text solves this.
+ (unless (cdr total-line) (forward-line 2))
(if (memq ?R switches)
;; List the contents of all directories recursively.
;; cadr of each element of `file-alist' is t for
diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el
index 896f82d7bcc..2c77f88f97b 100644
--- a/lisp/mail/binhex.el
+++ b/lisp/mail/binhex.el
@@ -83,10 +83,8 @@ input and write the converted data to its standard output."
"^[^:]...............................................................$")
(defconst binhex-end-line ":$") ; unused
-(defvar binhex-temporary-file-directory
- (cond ((fboundp 'temp-directory) (temp-directory))
- ((boundp 'temporary-file-directory) temporary-file-directory)
- ("/tmp/")))
+(make-obsolete-variable 'binhex-temporary-file-directory
+ 'temporary-file-directory "28.1")
(defun binhex-insert-char (char &optional count ignored buffer)
"Insert COUNT copies of CHARACTER into BUFFER."
@@ -285,7 +283,7 @@ If HEADER-ONLY is non-nil only decode header and return filename."
(file-name (expand-file-name
(concat (binhex-decode-region-internal start end t)
".data")
- binhex-temporary-file-directory)))
+ temporary-file-directory)))
(save-excursion
(goto-char start)
(when (re-search-forward binhex-begin-line nil t)
@@ -296,7 +294,7 @@ If HEADER-ONLY is non-nil only decode header and return filename."
(generate-new-buffer " *binhex-work*")))
(buffer-disable-undo work-buffer)
(insert-buffer-substring cbuf firstline end)
- (cd binhex-temporary-file-directory)
+ (cd temporary-file-directory)
(apply 'call-process-region
(point-min)
(point-max)
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 7f3dc4454ab..e48c25436ee 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -208,7 +208,11 @@ This requires either the macOS \"open\" command, or the freedesktop
;;;###autoload
(defun report-emacs-bug (topic &optional unused)
"Report a bug in GNU Emacs.
-Prompts for bug subject. Leaves you in a mail buffer."
+Prompts for bug subject. Leaves you in a mail buffer.
+
+Already submitted bugs can be found in the Emacs bug tracker:
+
+ https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1"
(declare (advertised-calling-convention (topic) "24.5"))
(interactive "sBug Subject: ")
;; The syntax `version;' is preferred to `[version]' because the
@@ -270,7 +274,7 @@ Prompts for bug subject. Leaves you in a mail buffer."
'face 'link
'help-echo (concat "mouse-2, RET: Follow this link")
'action (lambda (button)
- (browse-url "https://debbugs.gnu.org/"))
+ (browse-url "https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1"))
'follow-link t)
(insert ". Please check that
@@ -301,42 +305,7 @@ usually do not have translators for other languages.\n\n")))
(let ((txt (delete-and-extract-region (1+ user-point) (point))))
(insert (propertize "\n" 'display txt)))
- (insert "\nIn " (emacs-version))
- (if emacs-build-system
- (insert " built on " emacs-build-system))
- (insert "\n")
-
- (if (stringp emacs-repository-version)
- (insert "Repository revision: " emacs-repository-version "\n"))
- (if (stringp emacs-repository-branch)
- (insert "Repository branch: " emacs-repository-branch "\n"))
- (if (fboundp 'x-server-vendor)
- (condition-case nil
- ;; 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")
- (error t)))
- (let ((os (ignore-errors (report-emacs-bug--os-description))))
- (if (stringp os)
- (insert "System Description: " os "\n\n")))
- (let ((message-buf (get-buffer "*Messages*")))
- (if message-buf
- (let (beg-pos
- (end-pos message-end-point))
- (with-current-buffer message-buf
- (goto-char end-pos)
- (forward-line -10)
- (setq beg-pos (point)))
- (terpri (current-buffer) t)
- (insert "Recent messages:\n")
- (insert-buffer-substring message-buf beg-pos end-pos))))
- (insert "\n")
- (when (and system-configuration-options
- (not (equal system-configuration-options "")))
- (insert "Configured using:\n 'configure "
- system-configuration-options "'\n\n")
- (fill-region (line-beginning-position -1) (point)))
+ (emacs-bug--system-description)
(insert "Configured features:\n" system-configuration-features "\n\n")
(fill-region (line-beginning-position -1) (point))
(insert "Important settings:\n")
@@ -417,72 +386,148 @@ usually do not have translators for other languages.\n\n")))
(buffer-substring-no-properties (point-min) (point)))
(goto-char user-point)))
+(defun emacs-bug--system-description ()
+ (insert "\nIn " (emacs-version))
+ (if emacs-build-system
+ (insert " built on " emacs-build-system))
+ (insert "\n")
+
+ (if (stringp emacs-repository-version)
+ (insert "Repository revision: " emacs-repository-version "\n"))
+ (if (stringp emacs-repository-branch)
+ (insert "Repository branch: " emacs-repository-branch "\n"))
+ (if (fboundp 'x-server-vendor)
+ (condition-case nil
+ ;; 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")
+ (error t)))
+ (let ((os (ignore-errors (report-emacs-bug--os-description))))
+ (if (stringp os)
+ (insert "System Description: " os "\n\n")))
+ (when (and system-configuration-options
+ (not (equal system-configuration-options "")))
+ (insert "Configured using:\n 'configure "
+ 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")
(defun report-emacs-bug-hook ()
"Do some checking before sending a bug report."
- (save-excursion
- (goto-char (point-max))
- (skip-chars-backward " \t\n")
- (and (= (- (point) (point-min))
- (length report-emacs-bug-orig-text))
- (string-equal (buffer-substring-no-properties (point-min) (point))
- report-emacs-bug-orig-text)
- (error "No text entered in bug report"))
- ;; Warning for novice users.
- (when (and (string-match "bug-gnu-emacs@gnu\\.org" (mail-fetch-field "to"))
- (not report-emacs-bug-no-confirmation)
- (not (yes-or-no-p
- "Send this bug report to the Emacs maintainers? ")))
- (with-output-to-temp-buffer "*Bug Help*"
- (princ (substitute-command-keys
- (format "\
+ (goto-char (point-max))
+ (skip-chars-backward " \t\n")
+ (and (= (- (point) (point-min))
+ (length report-emacs-bug-orig-text))
+ (string-equal (buffer-substring-no-properties (point-min) (point))
+ report-emacs-bug-orig-text)
+ (error "No text entered in bug report"))
+ ;; Warning for novice users.
+ (when (and (string-match "bug-gnu-emacs@gnu\\.org" (mail-fetch-field "to"))
+ (not report-emacs-bug-no-confirmation)
+ (not (yes-or-no-p
+ "Send this bug report to the Emacs maintainers? ")))
+ (with-output-to-temp-buffer "*Bug Help*"
+ (princ (substitute-command-keys
+ (format "\
You invoked the command M-x report-emacs-bug,
but you decided not to mail the bug report to the Emacs maintainers.
If you want to mail it to someone else instead,
please insert the proper e-mail address after \"To: \",
and send the mail again%s."
- (if report-emacs-bug-send-command
- (format " using \\[%s]"
- report-emacs-bug-send-command)
- "")))))
- (error "M-x report-emacs-bug was canceled, please read *Bug Help* buffer"))
- ;; Query the user for the SMTP method, so that we can skip
- ;; questions about From header validity if the user is going to
- ;; use mailclient, anyway.
- (when (or (and (derived-mode-p 'message-mode)
- (eq message-send-mail-function 'sendmail-query-once))
- (and (not (derived-mode-p 'message-mode))
- (eq send-mail-function 'sendmail-query-once)))
- (sendmail-query-user-about-smtp)
- (when (derived-mode-p 'message-mode)
- (setq message-send-mail-function (message-default-send-mail-function))))
- (or report-emacs-bug-no-confirmation
- ;; mailclient.el does not need a valid From
- (if (derived-mode-p 'message-mode)
- (eq message-send-mail-function 'message-send-mail-with-mailclient)
- (eq send-mail-function 'mailclient-send-it))
- ;; Not narrowing to the headers, but that's OK.
- (let ((from (mail-fetch-field "From")))
- (and (or (not from)
- (message-bogus-recipient-p from)
- ;; This is the default user-mail-address. On today's
- ;; systems, it seems more likely to be wrong than right,
- ;; since most people don't run their own mail server.
- (string-match (format "\\<%s@%s\\>"
- (regexp-quote (user-login-name))
- (regexp-quote (system-name)))
- from))
- (not (yes-or-no-p
- (format-message "Is `%s' really your email address? "
- from)))
- (error "Please edit the From address and try again"))))
- ;; Bury the help buffer (if it's shown).
- (when-let ((help (get-buffer "*Bug Help*")))
- (when (get-buffer-window help)
- (quit-window nil (get-buffer-window help))))))
+ (if report-emacs-bug-send-command
+ (format " using \\[%s]"
+ report-emacs-bug-send-command)
+ "")))))
+ (error "M-x report-emacs-bug was canceled, please read *Bug Help* buffer"))
+ ;; Query the user for the SMTP method, so that we can skip
+ ;; questions about From header validity if the user is going to
+ ;; use mailclient, anyway.
+ (when (or (and (derived-mode-p 'message-mode)
+ (eq (message-default-send-mail-function) 'sendmail-query-once))
+ (and (not (derived-mode-p 'message-mode))
+ (eq send-mail-function 'sendmail-query-once)))
+ (setq send-mail-function (sendmail-query-user-about-smtp))
+ (when (derived-mode-p 'message-mode)
+ (setq message-send-mail-function (message-default-send-mail-function))
+ (add-hook 'message-sent-hook
+ (lambda ()
+ (when (y-or-n-p "Save this mail sending choice?")
+ (customize-save-variable 'send-mail-function
+ send-mail-function)))
+ nil t)))
+ (or report-emacs-bug-no-confirmation
+ ;; mailclient.el does not need a valid From
+ (eq send-mail-function 'mailclient-send-it)
+ ;; Not narrowing to the headers, but that's OK.
+ (let ((from (mail-fetch-field "From")))
+ (when (and (or (not from)
+ (message-bogus-recipient-p from)
+ ;; This is the default user-mail-address. On
+ ;; today's systems, it seems more likely to
+ ;; be wrong than right, since most people
+ ;; don't run their own mail server.
+ (string-match (format "\\<%s@%s\\>"
+ (regexp-quote (user-login-name))
+ (regexp-quote (system-name)))
+ from))
+ (not (yes-or-no-p
+ (format-message "Is `%s' really your email address? "
+ from))))
+ (goto-char (point-min))
+ (re-search-forward "^From: " nil t)
+ (error "Please edit the From address and try again"))))
+ ;; Bury the help buffer (if it's shown).
+ (when-let ((help (get-buffer "*Bug Help*")))
+ (when (get-buffer-window help)
+ (quit-window nil (get-buffer-window help)))))
+;;;###autoload
+(defun submit-emacs-patch (subject file)
+ "Send an Emacs patch to the Emacs maintainers.
+Interactively, you will be prompted for SUBJECT and a patch FILE
+name (which will be attached to the mail). You will end up in a
+Message buffer where you can explain more about the patch."
+ (interactive "sThis patch is about: \nfPatch file name: ")
+ (switch-to-buffer "*Patch Help*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert "Thank you for considering submitting a patch to the Emacs project.\n\n"
+ "Please describe what the patch fixes (or, if it's a new feature, what it\n"
+ "implements) in the mail buffer below. When done, use the `C-c C-c' command\n"
+ "to send the patch as an email to the Emacs issue tracker.\n\n"
+ "If this is the first time you've submitted an Emacs patch, please\n"
+ "read the ")
+ (insert-text-button
+ "CONTRIBUTE"
+ 'action (lambda (_)
+ (view-buffer
+ (find-file-noselect
+ (expand-file-name "CONTRIBUTE" installation-directory)))))
+ (insert " file first.\n")
+ (goto-char (point-min))
+ (view-mode 1)
+ (button-mode 1))
+ (message-mail-other-window report-emacs-bug-address subject)
+ (insert "\n\n\n")
+ (emacs-bug--system-description)
+ (mml-attach-file file "text/patch" nil "attachment")
+ (message-goto-body)
+ (message "Write a description of the patch and use `C-c C-c' to send it")
+ (add-hook 'message-send-hook
+ (lambda ()
+ (message-goto-body)
+ (insert "Tags: patch\nthanks\n\n"))
+ t)
+ (message-add-action
+ (lambda ()
+ ;; Bury the help buffer (if it's shown).
+ (when-let ((help (get-buffer "*Patch Help*")))
+ (when (get-buffer-window help)
+ (quit-window nil (get-buffer-window help)))))
+ 'send))
(provide 'emacsbug)
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index b9920023d82..0d7193c1be0 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -1203,7 +1203,7 @@ no longer matches to transformed string. Used by function
feedmail-tidy-up-slug and indirectly by feedmail-queue-subject-slug-maker."
:version "24.1"
:group 'feedmail-queue
- :type 'string
+ :type 'regexp
)
diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el
index af3b493a08a..b357b3e2563 100644
--- a/lisp/mail/flow-fill.el
+++ b/lisp/mail/flow-fill.el
@@ -131,31 +131,38 @@ lines."
(goto-char (match-end 0))
(unless (looking-at " ")
(insert " "))
- (end-of-line)
- (when (and (not (eobp))
- (save-excursion
- (forward-line 1)
- (looking-at (format "\\(%s ?\\)[^>]" prefix))))
- ;; Delete the newline and the quote at the start of the
- ;; next line.
- (delete-region (point) (match-end 1))
- (ignore-errors
+ (while (and (eq (char-before (line-end-position)) ?\s)
+ (not (eobp))
+ (save-excursion
+ (forward-line 1)
+ (looking-at (format "\\(%s ?\\)[^>]" prefix))))
+ (end-of-line)
+ (when (and (not (eobp))
+ (save-excursion
+ (forward-line 1)
+ (looking-at (format "\\(%s ?\\)[^>]" prefix))))
+ ;; Delete the newline and the quote at the start of the
+ ;; next line.
+ (delete-region (point) (match-end 1))))
+ (ignore-errors
(let ((fill-prefix (concat prefix " "))
adaptive-fill-mode)
(fill-region (line-beginning-position)
(line-end-position)
- 'left 'nosqueeze))))))
- (t
+ 'left 'nosqueeze)))))
+ (t
;; Delete the newline.
(when (eq (following-char) ?\s)
(delete-char 1))
;; Hack: Don't do the flowing on the signature line.
(when (and (not (looking-at "-- $"))
(eq (char-before (line-end-position)) ?\s))
- (end-of-line)
- (when delete-space
- (delete-char -1))
- (delete-char 1)
+ (while (and (not (eobp))
+ (eq (char-before (line-end-position)) ?\s))
+ (end-of-line)
+ (when delete-space
+ (delete-char -1))
+ (delete-char 1))
(ignore-errors
(let ((fill-prefix ""))
(fill-region (line-beginning-position)
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index f1a455dce2d..bd9aef17a87 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -1852,8 +1852,8 @@ place. It affects how `mail-extract-address-components' works."
;;
;; Source: ISO 3166 Maintenance Agency
;; http://www.iso.org/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1-semic.txt
-;; http://www.iana.org/domain-names.htm
-;; http://www.iana.org/cctld/cctld-whois.htm
+;; https://www.iana.org/domain-names.htm
+;; https://www.iana.org/cctld/cctld-whois.htm
;; Latest change: 2007/11/15
(defconst mail-extr-all-top-level-domains
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index a6a606828f9..09afad7aa47 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -534,8 +534,7 @@ of a mail alias. The value is set up, buffer-local, when first needed.")
(default-directory (expand-file-name "~/"))
(def mail-personal-alias-file))
(read-file-name
- (format "Read additional aliases from file (default %s): "
- def)
+ (format-prompt "Read additional aliases from file" def)
default-directory
(expand-file-name def default-directory)
t))))
@@ -548,7 +547,7 @@ of a mail alias. The value is set up, buffer-local, when first needed.")
(default-directory (expand-file-name "~/"))
(def mail-personal-alias-file))
(read-file-name
- (format "Read mail aliases from file (default %s): " def)
+ (format-prompt "Read mail aliases from file" def)
default-directory
(expand-file-name def default-directory)
t))))
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
index 8e7aaf94937..2b76539e152 100644
--- a/lisp/mail/mailalias.el
+++ b/lisp/mail/mailalias.el
@@ -255,9 +255,9 @@ removed from alias expansions."
By default, this is the file specified by `mail-personal-alias-file'."
(interactive
(list
- (read-file-name (format "Read mail alias file (default %s): "
- mail-personal-alias-file)
- nil mail-personal-alias-file t)))
+ (read-file-name
+ (format-prompt "Read mail alias file" mail-personal-alias-file)
+ nil mail-personal-alias-file t)))
(setq file (expand-file-name (or file mail-personal-alias-file)))
;; In case mail-aliases is t, make sure define-mail-alias
;; does not recursively call build-mail-aliases.
@@ -517,7 +517,7 @@ PREFIX is the string we want to complete."
(setq mail-names
(sort (append (if (consp mail-aliases)
(mapcar
- (function (lambda (a) (list (car a))))
+ (lambda (a) (list (car a)))
mail-aliases))
(if (consp mail-local-names)
mail-local-names)
diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el
index 08325484677..405ae17a12c 100644
--- a/lisp/mail/mailclient.el
+++ b/lisp/mail/mailclient.el
@@ -134,7 +134,7 @@ The mail client is taken to be the handler of mailto URLs."
character-coding
;; Use the external browser function to send the
;; message.
- (browse-url-mailto-function nil))
+ (browse-url-default-handlers nil))
;; initialize limiter
(setq mailclient-delim-static "?")
;; construct and call up mailto URL
diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el
index 94b0886c75f..ab2649feb4b 100644
--- a/lisp/mail/mspools.el
+++ b/lisp/mail/mspools.el
@@ -1,4 +1,4 @@
-;;; mspools.el --- show mail spools waiting to be read
+;;; mspools.el --- show mail spools waiting to be read -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
@@ -125,18 +125,15 @@
(defcustom mspools-update nil
"Non-nil means update *spools* buffer after visiting any folder."
- :type 'boolean
- :group 'mspools)
+ :type 'boolean)
(defcustom mspools-suffix "spool"
"Extension used for spool files (not including full stop)."
- :type 'string
- :group 'mspools)
+ :type 'string)
(defcustom mspools-using-vm (fboundp 'vm)
"Non-nil if VM is used as mail reader, otherwise RMAIL is used."
- :type 'boolean
- :group 'mspools)
+ :type 'boolean)
(defcustom mspools-folder-directory
(if (boundp 'vm-folder-directory)
@@ -144,8 +141,7 @@
"~/MAIL/")
"Directory where mail folders are kept. Ensure it has a trailing /.
Defaults to `vm-folder-directory' if bound else to ~/MAIL/."
- :type 'directory
- :group 'mspools)
+ :type 'directory)
(defcustom mspools-vm-system-mail (or (getenv "MAIL")
(concat rmail-spool-directory
@@ -156,8 +152,7 @@ without it. By default this will be set to the environment variable
$MAIL. Otherwise it will use `rmail-spool-directory' to guess where
your primary spool is. If this fails, set it to something like
/usr/spool/mail/login-name."
- :type 'file
- :group 'mspools)
+ :type 'file)
;;; Internal Variables
@@ -175,11 +170,8 @@ your primary spool is. If this fails, set it to something like
(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 "?" 'mspools-help)
- (define-key map "q" 'mspools-quit)
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
- (define-key map "g" 'revert-buffer)
map)
"Keymap for the *spools* buffer.")
@@ -221,14 +213,15 @@ your primary spool is. If this fails, set it to something like
(concat mspools-folder-directory s "." mspools-suffix)
(concat mspools-folder-directory s ".crash")))
;; So I create a vm-spool-files entry for each of those mail drops
- (mapcar 'file-name-sans-extension
+ (mapcar #'file-name-sans-extension
(directory-files mspools-folder-directory nil
(format "\\`[^.]+\\.%s" mspools-suffix)))
))
))
;;; MSPOOLS-SHOW -- the main function
-(defun mspools-show ( &optional noshow)
+;;;###autoload
+(defun mspools-show (&optional noshow)
"Show the list of non-empty spool files in the *spools* buffer.
Buffer is not displayed if SHOW is non-nil."
(interactive)
@@ -237,7 +230,7 @@ Buffer is not displayed if SHOW is non-nil."
(progn
(set-buffer mspools-buffer)
(setq buffer-read-only nil)
- (delete-region (point-min) (point-max)))
+ (erase-buffer))
;; else buffer doesn't exist so create it
(get-buffer-create mspools-buffer))
@@ -260,8 +253,8 @@ Buffer is not displayed if SHOW is non-nil."
(defun mspools-visit-spool ()
"Visit the folder on the current line of the *spools* buffer."
(interactive)
- (let ( spool-name folder-name)
- (setq spool-name (mspools-get-spool-name))
+ (let ((spool-name (mspools-get-spool-name))
+ folder-name)
(if (null spool-name)
(message "No spool on current line")
@@ -270,19 +263,20 @@ Buffer is not displayed if SHOW is non-nil."
;; put in a little "*" to indicate spool file has been read.
(if (not mspools-update)
(save-excursion
- (setq buffer-read-only nil)
(beginning-of-line)
- (insert "*")
- (delete-char 1)
- (setq buffer-read-only t)
- ))
+ (let ((inhibit-read-only t))
+ (insert "*")
+ (delete-char 1))))
(message "folder %s spool %s" folder-name spool-name)
- (if (eq (count-lines (point-min) (point-at-eol))
- mspools-files-len)
- (forward-line (- 1 mspools-files-len)) ;back to top of list
- ;; else just on to next line
- (forward-line 1))
+ (forward-line (if (eq (count-lines (point-min) (point-at-eol))
+ mspools-files-len)
+ ;; FIXME: Why use `mspools-files-len' instead
+ ;; of looking if we're on the last line and
+ ;; jumping to the first one if so?
+ (- 1 mspools-files-len) ;back to top of list
+ ;; else just on to next line
+ 1))
;; Choose whether to use VM or RMAIL for reading folder.
(if mspools-using-vm
@@ -296,8 +290,8 @@ Buffer is not displayed if SHOW is non-nil."
(if mspools-update
;; generate new list of spools.
- (save-excursion
- (mspools-show-again 'noshow))))))
+ (save-excursion ;;FIXME: Why?
+ (mspools-revert-buffer))))))
(defun mspools-get-folder-from-spool (name)
"Return folder name corresponding to the spool file NAME."
@@ -319,27 +313,31 @@ Buffer is not displayed if SHOW is non-nil."
(defun mspools-get-spool-name ()
"Return the name of the spool on the current line."
(let ((line-num (1- (count-lines (point-min) (point-at-eol)))))
+ ;; FIXME: Why not extract the name directly from the current line's text?
(car (nth line-num mspools-files))))
;;; Spools mode functions
-(defun mspools-revert-buffer (ignore noconfirm)
- "Re-run mspools-show to revert the *spools* buffer."
+(defun mspools-revert-buffer (&optional _ignore _noconfirm)
+ "Re-run `mspools-show' to revert the *spools* buffer."
(mspools-show 'noshow))
(defun mspools-show-again (&optional noshow)
- "Update the *spools* buffer. This is useful if mspools-update is
-nil."
+ "Update the *spools* buffer.
+This is useful if `mspools-update' is nil."
+ (declare (obsolete revert-buffer "28.1"))
(interactive)
(mspools-show noshow))
(defun mspools-help ()
"Show help for `mspools-mode'."
+ (declare (obsolete describe-mode "28.1"))
(interactive)
(describe-function 'mspools-mode))
(defun mspools-quit ()
"Quit the *spools* buffer."
+ (declare (obsolete quit-window "28.1"))
(interactive)
(kill-buffer mspools-buffer))
@@ -353,32 +351,26 @@ nil."
(defun mspools-get-spool-files ()
"Find the list of spool files and display them in *spools* buffer."
- (let (folders head spool len beg end any)
- (if (null mspools-folder-directory)
- (error "Set `mspools-folder-directory' to where the spool files are"))
- (setq folders (directory-files mspools-folder-directory nil
+ (if (null mspools-folder-directory)
+ (error "Set `mspools-folder-directory' to where the spool files are"))
+ (let* ((folders (directory-files mspools-folder-directory nil
(format "\\`[^.]+\\.%s\\'" mspools-suffix)))
- (setq folders (mapcar 'mspools-size-folder folders))
- (setq folders (delq nil folders))
+ (folders (delq nil (mapcar #'mspools-size-folder folders)))
+ ;; beg end
+ )
(setq mspools-files folders)
(setq mspools-files-len (length mspools-files))
- (set-buffer mspools-buffer)
- (while folders
- (setq any t)
- (setq head (car folders))
- (setq spool (car head))
- (setq len (cdr head))
- (setq folders (cdr folders))
- (setq beg (point))
- (insert (format " %10d %s" len spool))
- (setq end (point))
- (insert "\n")
- ;;(put-text-property beg end 'mouse-face 'highlight)
- )
- (if any
- (delete-char -1)) ;delete last RET
- (goto-char (point-min))
- ))
+ (with-current-buffer mspools-buffer
+ (pcase-dolist (`(,spool . ,len) folders)
+ ;; (setq beg (point))
+ (insert (format " %10d %s" len spool))
+ ;; (setq end (point))
+ (insert "\n")
+ ;;(put-text-property beg end 'mouse-face 'highlight)
+ )
+ (if (not (bolp))
+ (delete-char -1)) ;delete last RET
+ (goto-char (point-min)))))
(defun mspools-size-folder (spool)
"Return (SPOOL . SIZE ), if SIZE of spool file is non-zero."
diff --git a/lisp/mail/qp.el b/lisp/mail/qp.el
index 388c3981c97..10ac696fecf 100644
--- a/lisp/mail/qp.el
+++ b/lisp/mail/qp.el
@@ -1,4 +1,4 @@
-;;; qp.el --- Quoted-Printable functions
+;;; qp.el --- Quoted-Printable functions -*- lexical-binding:t -*-
;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
@@ -125,7 +125,7 @@ encode lines starting with \"From\"."
(not (eobp)))
(insert
(prog1
- (format "=%02X" (char-after))
+ (format "=%02X" (get-byte))
(delete-char 1))))
;; Encode white space at the end of lines.
(goto-char (point-min))
@@ -134,7 +134,7 @@ encode lines starting with \"From\"."
(while (not (eolp))
(insert
(prog1
- (format "=%02X" (char-after))
+ (format "=%02X" (get-byte))
(delete-char 1)))))
(let ((ultra
(and (boundp 'mm-use-ultra-safe-encoding)
diff --git a/lisp/mail/rfc2045.el b/lisp/mail/rfc2045.el
index 7d962ea2348..dba9c04cc83 100644
--- a/lisp/mail/rfc2045.el
+++ b/lisp/mail/rfc2045.el
@@ -1,4 +1,4 @@
-;;; rfc2045.el --- Functions for decoding rfc2045 headers
+;;; rfc2045.el --- Functions for decoding rfc2045 headers -*- lexical-binding:t -*-
;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el
index 234f319669f..4aa0c2809b2 100644
--- a/lisp/mail/rfc2047.el
+++ b/lisp/mail/rfc2047.el
@@ -716,11 +716,13 @@ Point moves to the end of the region."
(goto-char e)))))
(defun rfc2047-fold-field ()
- "Fold the current header field."
+ "Fold the current header field.
+Return the new end point."
(save-excursion
(save-restriction
(rfc2047-narrow-to-field)
- (rfc2047-fold-region (point-min) (point-max)))))
+ (rfc2047-fold-region (point-min) (point-max))
+ (point-max))))
(defun rfc2047-fold-region (b e)
"Fold long lines in region B to E."
diff --git a/lisp/mail/rfc2368.el b/lisp/mail/rfc2368.el
index 7b38288be20..afa30590059 100644
--- a/lisp/mail/rfc2368.el
+++ b/lisp/mail/rfc2368.el
@@ -1,4 +1,4 @@
-;;; rfc2368.el --- support for rfc2368
+;;; rfc2368.el --- support for rfc2368 -*- lexical-binding:t -*-
;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el
index 1755f4eb467..db518482591 100644
--- a/lisp/mail/rmail-spam-filter.el
+++ b/lisp/mail/rmail-spam-filter.el
@@ -133,7 +133,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 string)
+ :type '(repeat regexp)
:group 'rmail-spam-filter)
(defcustom rsf-definitions-alist nil
@@ -157,22 +157,22 @@ A rule matches only if all the specified elements match."
(list :format "%v"
(cons :format "%v" :value (from . "")
(const :format "" from)
- (string :tag "From" ""))
+ (regexp :tag "From" ""))
(cons :format "%v" :value (to . "")
(const :format "" to)
- (string :tag "To" ""))
+ (regexp :tag "To" ""))
(cons :format "%v" :value (subject . "")
(const :format "" subject)
- (string :tag "Subject" ""))
+ (regexp :tag "Subject" ""))
(cons :format "%v" :value (content-type . "")
(const :format "" content-type)
- (string :tag "Content-Type" ""))
+ (regexp :tag "Content-Type" ""))
(cons :format "%v" :value (contents . "")
(const :format "" contents)
- (string :tag "Contents" ""))
+ (regexp :tag "Contents" ""))
(cons :format "%v" :value (x-spam-status . "")
(const :format "" x-spam-status)
- (string :tag "X-Spam-Status" ""))
+ (regexp :tag "X-Spam-Status" ""))
(cons :format "%v" :value (action . output-and-delete)
(const :format "" action)
(choice :tag "Action selection"
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 5a2391d6272..7ff7db3e8cb 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -39,6 +39,7 @@
(require 'mail-utils)
(require 'rfc2047)
+(require 'auth-source)
(require 'rmail-loaddefs)
@@ -417,20 +418,6 @@ The variable `rmail-highlighted-headers' specifies which headers."
:group 'rmail-headers
:version "22.1")
-;; This was removed in Emacs 23.1 with no notification, an unnecessary
-;; incompatible change.
-(defcustom rmail-highlight-face 'rmail-highlight
- "Face used by Rmail for highlighting headers."
- ;; Note that nil doesn't actually mean use the default face, it
- ;; means use either bold or highlight. It's not worth fixing this
- ;; now that this is obsolete.
- :type '(choice (const :tag "Default" nil)
- face)
- :group 'rmail-headers)
-(make-obsolete-variable 'rmail-highlight-face
- "customize the face `rmail-highlight' instead."
- "23.2")
-
(defface rmail-header-name
'((t (:inherit font-lock-function-name-face)))
"Face to use for highlighting the header names.
@@ -521,25 +508,6 @@ still the current message in the Rmail buffer.")
(defvar rmail-mmdf-delim2 "^\001\001\001\001\n"
"Regexp marking the end of an mmdf message.")
-;; FIXME Post-mbox, this is now unused.
-;; In Emacs-22, this was called:
-;; i) the very first time a message was shown.
-;; ii) when toggling the headers to the normal state, every time.
-;; It's not clear what it should do now, since there is nothing that
-;; records when a message is shown for the first time (unseen is not
-;; necessarily the same thing).
-;; See https://lists.gnu.org/r/emacs-devel/2009-03/msg00013.html
-(defcustom rmail-message-filter nil
- "If non-nil, a filter function for new messages in RMAIL.
-Called with region narrowed to the message, including headers,
-before obeying `rmail-ignored-headers'."
- :group 'rmail-headers
- :type '(choice (const nil) function))
-
-(make-obsolete-variable 'rmail-message-filter
- "it is not used (try `rmail-show-message-hook')."
- "23.1")
-
(defcustom rmail-automatic-folder-directives nil
"List of directives specifying how to automatically file messages.
Whenever Rmail shows a message in the folder that `rmail-file-name'
@@ -578,11 +546,21 @@ Examples:
(defvar rmail-reply-prefix "Re: "
"String to prepend to Subject line when replying to a message.")
+;; Note: this is matched with case-fold-search bound to t.
+(defcustom rmail-re-abbrevs
+ "\\(RE\\|رد\\|回复\\|回覆\\|SV\\|Antw\\|VS\\|REF\\|AW\\|ΑΠ\\|ΣΧΕΤ\\|השב\\|Vá\\|R\\|RIF\\|BLS\\|RES\\|Odp\\|YNT\\|ATB\\)"
+ "Regexp with localized 'Re:' abbreviations in various languages."
+ :version "28.1"
+ :type 'regexp)
+
;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:" or "Re[2]:".
;; This pattern should catch all the common variants.
;; rms: I deleted the change to delete tags in square brackets
;; because they mess up RT tags.
-(defvar rmail-reply-regexp "\\`\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*"
+(defvar rmail-reply-regexp
+ (concat "\\`\\("
+ rmail-re-abbrevs
+ "\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?[::] *\\)*")
"Regexp to delete from Subject line before inserting `rmail-reply-prefix'.")
(defcustom rmail-display-summary nil
@@ -1907,7 +1885,8 @@ interactively."
(when rmail-remote-password-required
(setq got-password (not (rmail-have-password)))
(setq supplied-password (rmail-get-remote-password
- (string-match "^imaps?" proto))))
+ (string-match "^imaps?" proto)
+ user host)))
;; FIXME
;; The password is embedded. Strip it out since movemail
;; does not really like it, in spite of the movemail spec.
@@ -1927,14 +1906,12 @@ interactively."
((string-match "^po:\\([^:]+\\)\\(:\\(.*\\)\\)?" file)
(let (got-password supplied-password
- ;; (proto "pop")
- ;; (user (match-string 1 file))
- ;; (host (match-string 3 file))
- )
+ (user (match-string 1 file))
+ (host (match-string 3 file)))
(when rmail-remote-password-required
(setq got-password (not (rmail-have-password)))
- (setq supplied-password (rmail-get-remote-password nil)))
+ (setq supplied-password (rmail-get-remote-password nil user host)))
(list file "pop" supplied-password got-password)))
@@ -3021,7 +2998,7 @@ using the coding system CODING."
(defun rmail-highlight-headers ()
"Highlight the headers specified by `rmail-highlighted-headers'.
-Uses the face specified by `rmail-highlight-face'."
+Uses the face `rmail-highlight'."
(if rmail-highlighted-headers
(save-excursion
(search-forward "\n\n" nil 'move)
@@ -3029,11 +3006,7 @@ Uses the face specified by `rmail-highlight-face'."
(narrow-to-region (point-min) (point))
(let ((case-fold-search t)
(inhibit-read-only t)
- ;; When rmail-highlight-face is removed, just
- ;; use 'rmail-highlight here.
- (face (or rmail-highlight-face
- (if (face-differs-from-default-p 'bold)
- 'bold 'highlight)))
+ (face 'rmail-highlight)
;; List of overlays to reuse.
(overlays rmail-overlay-list))
(goto-char (point-min))
@@ -3398,7 +3371,7 @@ 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,3\\}:\\|\\[[^]]+]\\)[ \t\n]+\\)*"))
+ (regexp "\\`[ \t\n]*\\(\\(\\w\\{1,4\\}[::]\\|\\[[^]]+]\\)[ \t\n]+\\)*"))
(setq subject (rfc2047-decode-string subject))
(setq subject (replace-regexp-in-string regexp "" subject))
(replace-regexp-in-string "[ \t\n]+" " " subject)))
@@ -4393,9 +4366,8 @@ browsing, and moving of messages."
(text face mouse function &optional token prevline))
;; Make sure our special speedbar major mode is loaded
-(if (featurep 'speedbar)
- (rmail-install-speedbar-variables)
- (add-hook 'speedbar-load-hook 'rmail-install-speedbar-variables))
+(with-eval-after-load 'speedbar
+ (rmail-install-speedbar-variables))
(defun rmail-speedbar-buttons (buffer)
"Create buttons for BUFFER containing rmail messages.
@@ -4489,15 +4461,30 @@ TEXT and INDENT are not used."
(setq rmail-remote-password nil)
(setq rmail-encoded-remote-password nil)))
-(defun rmail-get-remote-password (imap)
- "Get the password for retrieving mail from a POP or IMAP server. If none
-has been set, then prompt the user for one."
+(defun rmail-get-remote-password (imap user host)
+ "Get the password for retrieving mail from a POP or IMAP server.
+If none has been set, the password is found via auth-source. If
+you use ~/.authinfo as your auth-source backend, then put
+something like the following in that file:
+
+machine mymachine login myloginname password mypassword
+
+If auth-source search yields no result, prompt the user for the
+password."
(when (not rmail-encoded-remote-password)
(if (not rmail-remote-password)
- (setq rmail-remote-password
- (read-passwd (if imap
- "IMAP password: "
- "POP password: "))))
+ (setq rmail-remote-password
+ (let ((found (nth 0 (auth-source-search
+ :max 1 :user user :host host
+ :require '(:secret)))))
+ (if found
+ (let ((secret (plist-get found :secret)))
+ (if (functionp secret)
+ (funcall secret)
+ secret))
+ (read-passwd (if imap
+ "IMAP password: "
+ "POP password: "))))))
(rmail-set-remote-password rmail-remote-password)
(setq rmail-remote-password nil))
(rmail-encode-string rmail-encoded-remote-password (emacs-pid)))
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index ba6ebad082c..3026283a082 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -63,9 +63,7 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
(use-local-map rmail-edit-map)
(setq major-mode 'rmail-edit-mode)
(setq mode-name "RMAIL Edit")
- (if (boundp 'mode-line-modified)
- (setq mode-line-modified (default-value 'mode-line-modified))
- (setq mode-line-format (default-value 'mode-line-format)))
+ (setq mode-line-modified (default-value 'mode-line-modified))
;; Don't turn off auto-saving based on the size of the buffer
;; because that code does not understand buffer-swapping.
(make-local-variable 'auto-save-include-big-deletions)
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 65d598c3bac..7610939e575 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -529,7 +529,7 @@ This also saves the value of `send-mail-function' via Customize."
(display-buffer (current-buffer))
(let ((completion-ignore-case t))
(completing-read
- (format "Send mail via (default %s): " (caar options))
+ (format-prompt "Send mail via" (caar options))
options nil 'require-match nil nil (car options))))))
;; Return the choice.
(cdr (assoc-string choice options t))))
@@ -975,7 +975,7 @@ but lower priority than the local value of `buffer-file-coding-system'.
See also the function `select-message-coding-system'.")
;;;###autoload
-(defvar default-sendmail-coding-system 'iso-latin-1
+(defvar default-sendmail-coding-system 'utf-8
"Default coding system for encoding the outgoing mail.
This variable is used only when `sendmail-coding-system' is nil.
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index f5c9432879f..63c8f14085a 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -50,9 +50,10 @@
;; Modified by Simon Josefsson <jas@pdc.kth.se>, 22/2/99, to support SMTP
;; Authentication by the AUTH mechanism.
-;; See http://www.ietf.org/rfc/rfc2554.txt
+;; See https://www.ietf.org/rfc/rfc2554.txt
;;; Code:
+;;; Dependencies
(require 'sendmail)
(require 'auth-source)
@@ -61,12 +62,12 @@
(autoload 'message-make-message-id "message")
(autoload 'rfc2104-hash "rfc2104")
-;;;
+;;; Options
+
(defgroup smtpmail nil
"SMTP protocol for sending mail."
:group 'mail)
-
(defcustom smtpmail-default-smtp-server nil
"Specify default SMTP server.
This only has effect if you specify it before loading the smtpmail library."
@@ -172,8 +173,7 @@ mean \"try again\"."
:type 'integer
:version "27.1")
-;; End of customizable variables.
-
+;;; Variables
(defvar smtpmail-address-buffer)
(defvar smtpmail-recipient-address-list)
@@ -192,6 +192,8 @@ for `smtpmail-try-auth-method'.")
(defvar smtpmail-mail-address nil
"Value to use for envelope-from address for mail from ambient buffer.")
+;;; Functions
+
;;;###autoload
(defun smtpmail-send-it ()
(let ((errbuf (if mail-interactive
@@ -510,8 +512,9 @@ for `smtpmail-try-auth-method'.")
(if port
(format "%s" port)
"smtp"))
- (let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
- (mech (car (smtpmail-intersection mechs smtpmail-auth-supported)))
+ (let* ((mechs (smtpmail-intersection
+ (cdr-safe (assoc 'auth supported-extensions))
+ smtpmail-auth-supported))
(auth-source-creation-prompts
'((user . "SMTP user name for %h: ")
(secret . "SMTP password for %u@%h: ")))
@@ -524,6 +527,7 @@ for `smtpmail-try-auth-method'.")
:require (and ask-for-password
'(:user :secret))
:create ask-for-password)))
+ (mech (or (plist-get auth-info :smtp-auth) (car mechs)))
(user (plist-get auth-info :user))
(password (plist-get auth-info :secret))
(save-function (and ask-for-password
diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el
index 9423275b2e5..945bff35f79 100644
--- a/lisp/mail/uudecode.el
+++ b/lisp/mail/uudecode.el
@@ -61,10 +61,8 @@ input and write the converted data to its standard output."
(setq str (concat str "[^a-z]")))
(concat str ".?$")))
-(defvar uudecode-temporary-file-directory
- (cond ((fboundp 'temp-directory) (temp-directory))
- ((boundp 'temporary-file-directory) temporary-file-directory)
- ("/tmp")))
+(make-obsolete-variable 'uudecode-temporary-file-directory
+ 'temporary-file-directory "28.1")
;;;###autoload
(defun uudecode-decode-region-external (start end &optional file-name)
@@ -86,13 +84,7 @@ used is specified by `uudecode-decoder-program'."
(match-string 1)))))
(setq tempfile (if file-name
(expand-file-name file-name)
- (if (fboundp 'make-temp-file)
- (let ((temporary-file-directory
- uudecode-temporary-file-directory))
- (make-temp-file "uu"))
- (expand-file-name
- (make-temp-name "uu")
- uudecode-temporary-file-directory))))
+ (make-temp-file "uu")))
(let ((cdir default-directory)
(default-process-coding-system nil))
(unwind-protect
diff --git a/lisp/man.el b/lisp/man.el
index bec3bfdbb2e..bd55d7eff06 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -253,7 +253,7 @@ the associated section number."
"Regexp that matches the text that precedes the command's name.
Used in `bookmark-set' to get the default bookmark name."
:version "24.1"
- :type 'string :group 'bookmark)
+ :type 'regexp :group 'bookmark)
(defcustom manual-program "man"
"Program used by `man' to produce man pages."
@@ -836,7 +836,8 @@ POS defaults to `point'."
;; ======================================================================
;; Top level command and background process sentinel
-;; For compatibility with older versions.
+;; This alias was originally for compatibility with older versions.
+;; Some users got used to having it, so we will not remove it.
;;;###autoload
(defalias 'manual-entry 'man)
@@ -926,15 +927,18 @@ foo(sec)[, bar(sec) [, ...]] [other stuff] - description"
;; run differently in Man-getpage-in-background, an error
;; here may not necessarily mean that we'll also get an
;; error later.
- (ignore-errors
- (call-process manual-program nil '(t nil) nil
- "-k" (concat (when (or Man-man-k-use-anchor
- (string-equal prefix ""))
- "^")
- prefix))))
- (setq table (Man-parse-man-k)))
+ (when (eq 0
+ (ignore-errors
+ (call-process
+ manual-program nil '(t nil) nil
+ "-k" (concat (when (or Man-man-k-use-anchor
+ (string-equal prefix ""))
+ "^")
+ prefix))))
+ (setq table (Man-parse-man-k)))))
;; Cache the table for later reuse.
- (setq Man-completion-cache (cons prefix table)))
+ (when table
+ (setq Man-completion-cache (cons prefix table))))
;; The table may contain false positives since the match is made
;; by "man -k" not just on the manpage's name.
(if section
@@ -1013,10 +1017,9 @@ to auto-complete your input based on the installed manual pages."
(completion-ignore-case t)
Man-completion-cache ;Don't cache across calls.
(input (completing-read
- (format "Manual entry%s"
- (if (string= default-entry "")
- ": "
- (format " (default %s): " default-entry)))
+ (format-prompt "Manual entry"
+ (and (not (equal default-entry ""))
+ default-entry))
'Man-completion-table
nil nil nil 'Man-topic-history default-entry)))
(if (string= input "")
@@ -1396,7 +1399,7 @@ synchronously, PROCESS is the name of the buffer where the manpage
command is run. Second argument STRING is the entire string of output."
(save-excursion
(let ((Man-buffer (process-buffer process)))
- (if (null (buffer-name Man-buffer)) ;; deleted buffer
+ (if (not (buffer-live-p Man-buffer)) ;; deleted buffer
(set-process-buffer process nil)
(with-current-buffer Man-buffer
@@ -1430,7 +1433,7 @@ manpage command."
(delete-buff nil)
message)
- (if (null (buffer-name Man-buffer)) ;; deleted buffer
+ (if (not (buffer-live-p Man-buffer)) ;; deleted buffer
(or (stringp process)
(set-process-buffer process nil))
@@ -1508,8 +1511,11 @@ manpage command."
(when delete-buff
(if (window-live-p (get-buffer-window Man-buffer t))
- (quit-restore-window
- (get-buffer-window Man-buffer t) 'kill)
+ (progn
+ (quit-restore-window
+ (get-buffer-window Man-buffer t) 'kill)
+ ;; Ensure that we end up in the correct window.
+ (select-window (old-selected-window)))
(kill-buffer Man-buffer)))
(when message
diff --git a/lisp/master.el b/lisp/master.el
index b0996bf1290..32556a535f3 100644
--- a/lisp/master.el
+++ b/lisp/master.el
@@ -3,7 +3,7 @@
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; Version: 1.0.2
+;; Old-Version: 1.0.2
;; Keywords: comm
;; This file is part of GNU Emacs.
@@ -36,12 +36,12 @@
;; SQL buffer.
;;
;; (add-hook 'sql-mode-hook
-;; (function (lambda ()
-;; (master-mode t)
-;; (master-set-slave sql-buffer))))
+;; (lambda ()
+;; (master-mode t)
+;; (master-set-slave sql-buffer)))
;; (add-hook 'sql-set-sqli-hook
-;; (function (lambda ()
-;; (master-set-slave sql-buffer))))
+;; (lambda ()
+;; (master-set-slave sql-buffer)))
;;; Thanks to all the people who helped me out:
;;
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index ef64c74acda..d3e434aec90 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -540,6 +540,12 @@
(if (featurep 'ns)
(bindings--define-key menu [separator-undo] menu-bar-separator))
+ (bindings--define-key menu [undo-redo]
+ '(menu-item "Redo" undo-redo
+ :enable (and (not buffer-read-only)
+ (undo--last-change-was-undo-p buffer-undo-list))
+ :help "Redo last undone edits"))
+
(bindings--define-key menu [undo]
'(menu-item "Undo" undo
:enable (and (not buffer-read-only)
@@ -547,7 +553,7 @@
(if (eq last-command 'undo)
(listp pending-undo-list)
(consp buffer-undo-list)))
- :help "Undo last operation"))
+ :help "Undo last edits"))
menu))
@@ -661,31 +667,63 @@ PROPS are additional properties."
:button (:toggle . (and (default-boundp ',fname)
(default-value ',fname)))))
-(defmacro menu-bar-make-toggle (name variable doc message help &rest body)
+(defmacro menu-bar-make-toggle (command variable item-name message help
+ &rest body)
+ "Define a menu-bar toggle command.
+See `menu-bar-make-toggle-command', for which this is a
+compatability wrapper. BODY is passed in as SETTING-SEXP in that macro."
+ (declare (obsolete menu-bar-make-toggle-command "28.1"))
+ `(menu-bar-make-toggle-command ,command ,variable ,item-name ,message ,help
+ ,(and body
+ `(progn
+ ,@body))))
+
+(defmacro menu-bar-make-toggle-command (command variable item-name message
+ help
+ &optional setting-sexp
+ &rest keywords)
+ "Define a menu-bar toggle command.
+COMMAND (a symbol) is the toggle command to define.
+
+VARIABLE (a symbol) is the variable to set.
+
+ITEM-NAME (a string) is the menu-item name.
+
+MESSAGE is a format string for the toggle message, with %s for the new
+status.
+
+HELP (a string) is the `:help' tooltip text and the doc string first
+line (minus final period) for the command.
+
+SETTING-SEXP is a Lisp sexp that sets VARIABLE, or it is nil meaning
+set it according to its `defcustom' or using `set-default'.
+
+KEYWORDS is a plist for `menu-item' for keywords other than `:help'."
`(progn
- (defun ,name (&optional interactively)
+ (defun ,command (&optional interactively)
,(concat "Toggle whether to " (downcase (substring help 0 1))
- (substring help 1) ".
+ (substring help 1) ".
In an interactive call, record this option as a candidate for saving
by \"Save Options\" in Custom buffers.")
(interactive "p")
- (if ,(if body `(progn . ,body)
- `(progn
+ (if ,(if setting-sexp
+ `,setting-sexp
+ `(progn
(custom-load-symbol ',variable)
(let ((set (or (get ',variable 'custom-set) 'set-default))
(get (or (get ',variable 'custom-get) 'default-value)))
(funcall set ',variable (not (funcall get ',variable))))))
- (message ,message "enabled globally")
- (message ,message "disabled globally"))
- ;; The function `customize-mark-as-set' must only be called when
- ;; a variable is set interactively, as the purpose is to mark it as
- ;; a candidate for "Save Options", and we do not want to save options
- ;; the user have already set explicitly in his init file.
- (if interactively (customize-mark-as-set ',variable)))
- '(menu-item ,doc ,name
- :help ,help
- :button (:toggle . (and (default-boundp ',variable)
- (default-value ',variable))))))
+ (message ,message "enabled globally")
+ (message ,message "disabled globally"))
+ ;; `customize-mark-as-set' must only be called when a variable is set
+ ;; interactively, because the purpose is to mark the variable as a
+ ;; candidate for `Save Options', and we do not want to save options that
+ ;; the user has already set explicitly in the init file.
+ (when interactively (customize-mark-as-set ',variable)))
+ '(menu-item ,item-name ,command :help ,help
+ :button (:toggle . (and (default-boundp ',variable)
+ (default-value ',variable)))
+ ,@keywords)))
;; Function for setting/saving default font.
@@ -957,10 +995,11 @@ The selected font will be the default on both the existing and future frames."
:help "Indicate buffer boundaries in fringe"))
(bindings--define-key menu [indicate-empty-lines]
- (menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines
- "Empty Line Indicators"
- "Indicating of empty lines %s"
- "Indicate trailing empty lines in fringe, globally"))
+ (menu-bar-make-toggle-command
+ toggle-indicate-empty-lines indicate-empty-lines
+ "Empty Line Indicators"
+ "Indicating of empty lines %s"
+ "Indicate trailing empty lines in fringe, globally"))
(bindings--define-key menu [customize]
'(menu-item "Customize Fringe" menu-bar-showhide-fringe-menu-customize
@@ -1405,7 +1444,7 @@ mail status in mode line"))
(bindings--define-key menu [custom-separator]
menu-bar-separator)
(bindings--define-key menu [case-fold-search]
- (menu-bar-make-toggle
+ (menu-bar-make-toggle-command
toggle-case-fold-search case-fold-search
"Ignore Case"
"Case-Insensitive Search %s"
@@ -1436,7 +1475,7 @@ mail status in mode line"))
(if (featurep 'system-font-setting)
(bindings--define-key menu [menu-system-font]
- (menu-bar-make-toggle
+ (menu-bar-make-toggle-command
toggle-use-system-font font-use-system-font
"Use System Font"
"Use system font: %s"
@@ -1462,13 +1501,15 @@ mail status in mode line"))
menu-bar-separator)
(bindings--define-key menu [debug-on-quit]
- (menu-bar-make-toggle toggle-debug-on-quit debug-on-quit
- "Enter Debugger on Quit/C-g" "Debug on Quit %s"
- "Enter Lisp debugger when C-g is pressed"))
+ (menu-bar-make-toggle-command
+ toggle-debug-on-quit debug-on-quit
+ "Enter Debugger on Quit/C-g" "Debug on Quit %s"
+ "Enter Lisp debugger when C-g is pressed"))
(bindings--define-key menu [debug-on-error]
- (menu-bar-make-toggle toggle-debug-on-error debug-on-error
- "Enter Debugger on Error" "Debug on Error %s"
- "Enter Lisp debugger when an error is signaled"))
+ (menu-bar-make-toggle-command
+ toggle-debug-on-error debug-on-error
+ "Enter Debugger on Error" "Debug on Error %s"
+ "Enter Lisp debugger when an error is signaled"))
(bindings--define-key menu [debugger-separator]
menu-bar-separator)
@@ -1480,20 +1521,34 @@ mail status in mode line"))
(bindings--define-key menu [cursor-separator]
menu-bar-separator)
+ (bindings--define-key menu [save-desktop]
+ (menu-bar-make-toggle-command
+ toggle-save-desktop-globally desktop-save-mode
+ "Save State between Sessions"
+ "Saving desktop state %s"
+ "Visit desktop of previous session when restarting Emacs"
+ (progn
+ (require 'desktop)
+ ;; Do it by name, to avoid a free-variable
+ ;; warning during byte compilation.
+ (set-default
+ 'desktop-save-mode (not (symbol-value 'desktop-save-mode))))))
+
(bindings--define-key menu [save-place]
- (menu-bar-make-toggle
+ (menu-bar-make-toggle-command
toggle-save-place-globally save-place-mode
"Save Place in Files between Sessions"
"Saving place in files %s"
"Visit files of previous session when restarting Emacs"
- (require 'saveplace)
- ;; Do it by name, to avoid a free-variable
- ;; warning during byte compilation.
- (set-default
- 'save-place-mode (not (symbol-value 'save-place-mode)))))
+ (progn
+ (require 'saveplace)
+ ;; Do it by name, to avoid a free-variable
+ ;; warning during byte compilation.
+ (set-default
+ 'save-place-mode (not (symbol-value 'save-place-mode))))))
(bindings--define-key menu [uniquify]
- (menu-bar-make-toggle
+ (menu-bar-make-toggle-command
toggle-uniquify-buffer-names uniquify-buffer-name-style
"Use Directory Names in Buffer Names"
"Directory name in buffer names (uniquify) %s"
@@ -1507,7 +1562,7 @@ mail status in mode line"))
(bindings--define-key menu [cua-mode]
(menu-bar-make-mm-toggle
cua-mode
- "Use CUA Keys (Cut/Paste with C-x/C-c/C-v)"
+ "Cut/Paste with C-x/C-c/C-v (CUA Mode)"
"Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste"
(:visible (or (not (boundp 'cua-enable-cua-keys))
cua-enable-cua-keys))))
@@ -1807,6 +1862,10 @@ mail status in mode line"))
(bindings--define-key menu [list-keybindings]
'(menu-item "List Key Bindings" describe-bindings
:help "Display all current key bindings (keyboard shortcuts)"))
+ (bindings--define-key menu [list-recent-keystrokes]
+ '(menu-item "Show Recent Inputs" view-lossage
+ :help "Display last few input events and the commands \
+they ran"))
(bindings--define-key menu [describe-current-display-table]
'(menu-item "Describe Display Table" describe-current-display-table
:help "Describe the current display table"))
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index f7e30bfbb3d..8a69adbb756 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -305,6 +305,7 @@ message and scan line."
(let ((draft-buffer (current-buffer))
(file-name buffer-file-name)
(config mh-previous-window-config)
+ ;; FIXME this is subtly different to select-message-coding-system.
(coding-system-for-write
(if (fboundp 'select-message-coding-system)
(select-message-coding-system) ; Emacs has this since at least 21.1
@@ -318,7 +319,7 @@ message and scan line."
(or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
(and (default-boundp 'buffer-file-coding-system)
(default-value 'buffer-file-coding-system))
- 'iso-latin-1)))))
+ 'utf-8)))))
;; Older versions of spost do not support -msgid and -mime.
(unless mh-send-uses-spost-flag
;; Adding a Message-ID field looks good, makes it easier to search for
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index dd05d691c91..3ac5c8f7aed 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -1550,7 +1550,7 @@ as the result is undefined."
,(append
'(radio)
(mapcar
- (function (lambda (arg) `(const ,arg)))
+ (lambda (arg) `(const ,arg))
(mapcar 'car mh-identity-list))))
(cons :tag "Fcc Field"
(const "fcc")
@@ -1577,7 +1577,7 @@ See `mh-identity-list'."
:type (append
'(radio)
(cons '(const :tag "None" nil)
- (mapcar (function (lambda (arg) `(const ,arg)))
+ (mapcar (lambda (arg) `(const ,arg))
(mapcar 'car mh-identity-list))))
:group 'mh-identity
:package-version '(MH-E . "7.1"))
@@ -1914,7 +1914,7 @@ of images into \"X-Face:\" header fields (see URL
Use the \"make-face\" script to convert a JPEG image to the higher
resolution, color, \"Face:\" header field (see URL
-`http://quimby.gnus.org/circus/face/make-face').
+`https://quimby.gnus.org/circus/face/make-face').
The URL of any image can be used for the \"X-Image-URL:\" field and no
processing of the image is required.
@@ -2420,11 +2420,11 @@ of citations entirely, choose \"None\"."
;; These entries have been intentionally excluded by the developers.
;; "Comments:" ; RFC 822 (or later) - show this one
-;; "Fax:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
-;; "Mail-System-Version:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
-;; "Mailer:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+;; "Fax:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+;; "Mail-System-Version:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+;; "Mailer:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
;; "Organization:" ;
-;; "Phone:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+;; "Phone:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
;; "Reply-By:" ; RFC 2156
;; "Reply-To:" ; RFC 822 (or later)
;; "Sender:" ;
@@ -2437,13 +2437,13 @@ of citations entirely, choose \"None\"."
;; Mention source, if known.
(defvar mh-invisible-header-fields-internal
'(
- "Abuse-Reports-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Abuse-Reports-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Accept-Language:"
"AcceptLanguage:"
"Accreditor:" ; Habeas
"Also-Control:" ; H. Spencer: News Article Format and Transmission, June 1994
"Alternate-recipient:" ; RFC 2156
- "Approved-By:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Approved-By:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Approved:" ; RFC 1036
"Article-Names:" ; H. Spencer: News Article Format and Transmission, June 1994
"Article-Updates:" ; H. Spencer: News Article Format and Transmission, June 1994
@@ -2454,7 +2454,7 @@ of citations entirely, choose \"None\"."
"Bounces-To:"
"Bounces_to:"
"Bytes:"
- "Cancel-Key:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Cancel-Key:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Cancel-Lock:" ; NNTP posts
"Comment:" ; Shows up with DomainKeys
"Content-" ; RFC 2045, 1123, 1766, 1864, 2045, 2110, 2156, 2183, 2912
@@ -2475,14 +2475,14 @@ of citations entirely, choose \"None\"."
"DomainKey-Signature:"
"Encoding:" ; RFC 1505
"Envelope-to:"
- "Errors-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Errors-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Expires:" ; RFC 1036
"Expiry-Date:" ; RFC 2156
"Face:" ; Gnus Face header
"Followup-To:" ; RFC 1036
- "For-Approval:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "For-Comment:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "For-Handling:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "For-Approval:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "For-Comment:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "For-Handling:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Forwarded:" ; MH
"From " ; sendmail
"Generate-Delivery-Report:" ; RFC 2156
@@ -2493,12 +2493,12 @@ of citations entirely, choose \"None\"."
"Language:" ; RFC 2156
"Lines:" ; RFC 1036
"List-" ; RFC 2369, 2919
- "Mail-Copies-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "Mail-Followup-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Mail-Copies-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Mail-Followup-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Mail-from:" ; MH
- "Mail-Reply-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Mail-Reply-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Mailing-List:" ; Egroups/yahoogroups mailing list manager
- "Message-Content:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Message-Content:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Message-ID:" ; RFC 822 (or later)
"Message-Type:" ; RFC 2156
"Mime-Version" ; RFC 2045
@@ -2516,42 +2516,42 @@ of citations entirely, choose \"None\"."
"Original-Recipient:" ; RFC 2298
"Original-To:" ; mail to news
"Original-X-" ; mail to news
- "Origination-Client:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "Originator:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Origination-Client:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Originator:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"P1-Content-Type:" ; X400
"P1-Message-Id:" ; X400
"P1-Recipient:" ; X400
"Path:" ; RFC 1036
"Pics-Label:" ; W3C
- "Posted-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "Precedence:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Posted-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Precedence:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Prev-Resent" ; MH
"Prevent-NonDelivery-Report:" ; RFC 2156
"Priority:" ; RFC 2156
- "Read-Receipt-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Read-Receipt-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Received-SPF:" ; Gmail
"Received:" ; RFC 822 (or later)
"References:" ; RFC 822 (or later)
- "Registered-Mail-Reply-Requested-By:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Registered-Mail-Reply-Requested-By:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Remailed-" ; MH
- "Replaces:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Replaces:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Replied:" ; MH
"Resent-" ; RFC 822 (or later)
"Return-Path:" ; RFC 822 (or later)
- "Return-Receipt-Requested:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "Return-Receipt-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Return-Receipt-Requested:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Return-Receipt-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Seal-Send-Time:"
"See-Also:" ; H. Spencer: News Article Format and Transmission, June 1994
"Sensitivity:" ; RFC 2156, 2421
- "Speech-Act:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Speech-Act:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Status:" ; sendmail
"Supersedes:" ; H. Spencer: News Article Format and Transmission, June 1994
- "Telefax:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Telefax:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Thread-"
"Thread-Index:"
"Thread-Topic:"
- "Translated-By:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "Translation-Of:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Translated-By:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Translation-Of:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Ua-Content-Id:" ; X400
"Via:" ; MH
"X-Abuse-and-DMCA-"
@@ -2559,7 +2559,7 @@ of citations entirely, choose \"None\"."
"X-Accept-Language:" ; Netscape/Mozilla
"X-Ack:"
"X-ACL-Warn:" ; http://www.exim.org
- "X-Admin:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Admin:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Administrivia-To:"
"X-AMAZON" ; Amazon.com
"X-AnalysisOut:" ; Exchange
@@ -2594,9 +2594,9 @@ of citations entirely, choose \"None\"."
"X-CanIt-Geo:" ; IEEE spam filter
"X-Cloudmark-SP-" ; Cloudmark (www.cloudmark.com)
"X-Comment:" ; AT&T Mailennium
- "X-Complaints-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Complaints-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Completed:"
- "X-Confirm-Reading-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "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
@@ -2622,13 +2622,13 @@ of citations entirely, choose \"None\"."
"X-Email-Type-Id:" ; Paypal http://www.paypal.com
"X-Enigmail-Version:"
"X-Envelope-Date:" ; GNU mailutils
- "X-Envelope-From:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Envelope-From:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Envelope-Sender:"
- "X-Envelope-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Envelope-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-EviteMessageId:" ; evite.com
"X-Evolution:" ; Evolution mail client
"X-ExtLoop"
- "X-Face:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Face:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Facebook" ; Facebook
"X-FB-SS:"
"X-fmx-"
@@ -2652,7 +2652,7 @@ of citations entirely, choose \"None\"."
"X-Identity:" ; http://www.declude.com/x-note.htm
"X-IEEE-UCE-" ; IEEE spam filter
"X-Image-URL:"
- "X-IMAP:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-IMAP:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Info:" ; NTMail
"X-IronPort-" ; IronPort AV
"X-ISI-4-30-3-MailScanner:"
@@ -2662,12 +2662,12 @@ of citations entirely, choose \"None\"."
"X-Juno-" ; Juno
"X-Key:"
"X-Launchpad-" ; plaunchpad.net
- "X-List-Host:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-List-Host:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-List-Subscribe:" ; Unknown mailing list managers
"X-List-Unsubscribe:" ; Unknown mailing list managers
"X-Listprocessor-" ; ListProc(tm) by CREN
- "X-Listserver:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "X-Loop:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Listserver:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "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
@@ -2693,18 +2693,18 @@ of citations entirely, choose \"None\"."
"X-MessageWall-Score:" ; Unknown mailing list manager, AUC TeX
"X-MHE-Checksum:" ; Checksum added during index search
"X-MIME-Autoconverted:" ; sendmail
- "X-MIMEOLE:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/sendmail
+ "X-MIMEOLE:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/sendmail
"X-MIMETrack:"
"X-Mms-" ; T-Mobile pictures
"X-Mozilla-Status:" ; Netscape/Mozilla
"X-MS-" ; MS Outlook
"X-Msmail-" ; MS Outlook
- "X-MSMail-Priority" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-MSMail-Priority" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-MXL-Hash:"
"X-NAI-Spam-" ; Network Associates Inc. SpamKiller
"X-News:" ; News
- "X-Newsreader:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "X-No-Archive:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Newsreader:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-No-Archive:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Notes-Item:" ; Lotus Notes Domino structured header
"X-Notification-" ; Google+
"X-Notifications:" ; Google+
@@ -2713,7 +2713,7 @@ of citations entirely, choose \"None\"."
"X-ORBL:"
"X-Orcl-Content-Type:"
"X-Organization:"
- "X-Original-Arrival-Type:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Original-Arrival-Type:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Original-Complaints-To:"
"X-Original-Date:" ; SourceForge mailing list manager
"X-Original-To:"
@@ -2733,10 +2733,10 @@ of citations entirely, choose \"None\"."
"X-Provags-ID:"
"X-PSTN-"
"X-Qotd-" ; User added
- "X-RCPT-TO:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-RCPT-TO:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Received-Date:"
"X-Received:"
- "X-Report-Abuse-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Report-Abuse-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Request-"
"X-Resolved-to:" ; fastmail.fm
"X-Return-Path-Hint:" ; Roving ConstantContact
@@ -2753,7 +2753,7 @@ of citations entirely, choose \"None\"."
"X-SBRule:" ; Spam
"X-Scanned-By:"
"X-Sender-ID:" ; Google+
- "X-Sender:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Sender:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Sendergroup:" ; Cisco Email Security (formerly IronPort; http://www.ironport.com)
"X-Server-Date:"
"X-Server-Uuid:"
@@ -2776,11 +2776,11 @@ of citations entirely, choose \"None\"."
"X-TM-IMSS-Message-ID:" ; http://www.trendmicro.com
"X-Trace:"
"X-UID"
- "X-UIDL:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-UIDL:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Unity"
"X-UNTD-" ; NetZero
- "X-URI:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "X-URL:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-URI:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-URL:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-USANET-" ; usa.net
"X-Usenet-Provider"
"X-UserInfo1:"
@@ -2792,7 +2792,7 @@ of citations entirely, choose \"None\"."
"X-VSMLoop:" ; NTMail
"X-WebTV-Signature:"
"X-Wss-Id:" ; Worldtalk gateways
- "X-X-Sender:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-X-Sender:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-XPT-XSL-Name:" ; Paypal http://www.paypal.com
"X-xsi-"
"X-XWALL-" ; http://www.dataenter.co.at/doc/xwall_undocumented_config.htm
@@ -3036,7 +3036,7 @@ supports it.
The first header field used, if present, is the Gnus-specific
\"Face:\" field. The \"Face:\" field appeared in GNU Emacs 21 and
XEmacs. For more information, see URL
-`http://quimby.gnus.org/circus/face/'. Next is the traditional
+`https://quimby.gnus.org/circus/face/'. Next is the traditional
\"X-Face:\" header field. The display of this field requires the
\"uncompface\" program (see URL
`ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.z'). Recent
@@ -3049,7 +3049,7 @@ header field if neither the \"Face:\" nor the \"X-Face:\" fields are
present. The display of the images requires \"wget\" (see URL
`https://www.gnu.org/software/wget/wget.html'), \"fetch\", or \"curl\"
to fetch the image and the \"convert\" program from the ImageMagick
-suite (see URL `http://www.imagemagick.org/'). Of the three header
+suite (see URL `https://www.imagemagick.org/'). Of the three header
fields this is the most efficient in terms of network usage since the
image doesn't need to be transmitted with every single mail.
diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el
index a3fbb89bb88..d4577807c92 100644
--- a/lisp/mh-e/mh-limit.el
+++ b/lisp/mh-e/mh-limit.el
@@ -148,7 +148,7 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
"Put all following messages with same subject in sequence 'subject.
If arg ALL is t, move to beginning of folder buffer to collect all
messages.
-If arg ALL is nil, collect only messages fron current one on forward.
+If arg ALL is nil, collect only messages from current one on forward.
Return number of messages put in the sequence:
@@ -198,7 +198,7 @@ It would be desirable to avoid hard-coding this.")
This function only works with an unthreaded folder. If arg ALL is
t, move to beginning of folder buffer to collect all messages. If
-arg ALL is nil, collect only messages fron current one on
+arg ALL is nil, collect only messages from current one on
forward.
Return number of messages put in the sequence:
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index 7e0981bed3a..0732a16dc7d 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -307,7 +307,7 @@ The function will expand out parent folders of FOLDER if needed."
(mh-speed-toggle))
(goto-char (gethash prefix mh-speed-folder-map))))
(while suffix-list
- ;; We always need atleast one toggle. We need two if the directory list
+ ;; We always need at least one toggle. We need two if the directory list
;; is stale since a folder was added.
(when (equal prefix (get-text-property (mh-line-beginning-position)
'mh-folder))
diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
index fc30187245d..43a589aeca2 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -26,7 +26,7 @@
;; The threading portion of this files tries to implement the
;; algorithm described at:
-;; http://www.jwz.org/doc/threading.html
+;; https://www.jwz.org/doc/threading.html
;; It also begins to implement the threading section of the IMAP -
;; SORT and THREAD Extensions RFC at:
;; http://tools.ietf.org/html/rfc5256
diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el
index 01672c027f0..363899d2656 100644
--- a/lisp/minibuf-eldef.el
+++ b/lisp/minibuf-eldef.el
@@ -36,10 +36,24 @@
(defvar minibuffer-eldef-shorten-default)
(defun minibuffer-default--in-prompt-regexps ()
- `(("\\( (default\\(?: is\\)? \\(.*\\))\\):? \\'"
- 1 ,(if minibuffer-eldef-shorten-default " [\\2]"))
- ("([^(]+?\\(, default\\(?: is\\)? \\(.*\\)\\)):? \\'" 1)
- ("\\( \\[.*\\]\\):? *\\'" 1)))
+ (cons
+ (list
+ (concat
+ "\\("
+ (if (string-match "%s" minibuffer-default-prompt-format)
+ (concat
+ (regexp-quote (substring minibuffer-default-prompt-format
+ 0 (match-beginning 0)))
+ "\\(.*?\\)"
+ (regexp-quote (substring minibuffer-default-prompt-format
+ (match-end 0))))
+ (regexp-quote minibuffer-default-prompt-format))
+ "\\): ")
+ 1 (and minibuffer-eldef-shorten-default " [\\2]"))
+ `(("\\( (default\\(?: is\\)? \\(.*\\))\\):? \\'"
+ 1 ,(if minibuffer-eldef-shorten-default " [\\2]"))
+ ("([^(]+?\\(, default\\(?: is\\)? \\(.*\\)\\)):? \\'" 1)
+ ("\\( \\[.*\\]\\):? *\\'" 1))))
(defcustom minibuffer-eldef-shorten-default nil
"If non-nil, shorten \"(default ...)\" to \"[...]\" in minibuffer prompts."
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index f6e2b236f3e..427636e8662 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -685,13 +685,6 @@ for use at QPOS."
completions)
qboundary))))
-;; (defmacro complete-in-turn (a b) `(completion-table-in-turn ,a ,b))
-;; (defmacro dynamic-completion-table (fun) `(completion-table-dynamic ,fun))
-(define-obsolete-function-alias
- 'complete-in-turn #'completion-table-in-turn "23.1")
-(define-obsolete-function-alias
- 'dynamic-completion-table #'completion-table-dynamic "23.1")
-
;;; Minibuffer completion
(defgroup minibuffer nil
@@ -1072,10 +1065,16 @@ in the last `cdr'."
(defun completion--replace (beg end newtext)
"Replace the buffer text between BEG and END with NEWTEXT.
Moves point to the end of the new text."
- ;; The properties on `newtext' include things like
- ;; completions-first-difference, which we don't want to include
- ;; upon insertion.
- (set-text-properties 0 (length newtext) nil newtext)
+ ;; The properties on `newtext' include things like the
+ ;; `completions-first-difference' face, which we don't want to
+ ;; include upon insertion.
+ (if minibuffer-allow-text-properties
+ ;; If we're preserving properties, then just remove the faces
+ ;; and other properties added by the completion machinery.
+ (remove-text-properties 0 (length newtext) '(face completion-score)
+ newtext)
+ ;; Remove all text properties.
+ (set-text-properties 0 (length newtext) nil newtext))
;; Maybe this should be in subr.el.
;; You'd think this is trivial to do, but details matter if you want
;; to keep markers "at the right place" and be robust in the face of
@@ -1770,9 +1769,6 @@ It also eliminates runs of equal strings."
;; Round up to a whole number of columns.
(* colwidth (ceiling length colwidth))))))))))))
-(defvar completion-common-substring nil)
-(make-obsolete-variable 'completion-common-substring nil "23.1")
-
(defvar completion-setup-hook nil
"Normal hook run at the end of setting up a completion list buffer.
When this hook is run, the current buffer is the one in which the
@@ -1864,11 +1860,7 @@ It can find the completion buffer in `standard-output'."
(insert "Possible completions are:\n")
(completion--insert-strings completions))))
- ;; The hilit used to be applied via completion-setup-hook, so there
- ;; may still be some code that uses completion-common-substring.
- (with-no-warnings
- (let ((completion-common-substring common-substring))
- (run-hooks 'completion-setup-hook)))
+ (run-hooks 'completion-setup-hook)
nil)
(defvar completion-extra-properties nil
@@ -1968,12 +1960,13 @@ variables.")
(plist-get completion-extra-properties
:annotation-function)
completion-annotate-function))
+ (mainbuf (current-buffer))
;; If the *Completions* buffer is shown in a new
;; window, mark it as softly-dedicated, so bury-buffer in
;; minibuffer-hide-completions will know whether to
;; delete the window or not.
(display-buffer-mark-dedicated 'soft))
- (with-displayed-buffer-window
+ (with-current-buffer-window
"*Completions*"
;; This is a copy of `display-buffer-fallback-action'
;; where `display-buffer-use-some-window' is replaced
@@ -1987,66 +1980,69 @@ variables.")
,(if (eq (selected-window) (minibuffer-window))
'display-buffer-at-bottom
'display-buffer-below-selected))
- ,(if temp-buffer-resize-mode
- '(window-height . resize-temp-buffer-window)
- '(window-height . fit-window-to-buffer))
- ,(when temp-buffer-resize-mode
- '(preserve-size . (nil . t))))
- nil
- ;; 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))))
- (when afun
- (setq completions
- (mapcar (lambda (s)
- (let ((ann (funcall afun s)))
- (if ann (list s ann) s)))
- completions)))
-
- (with-current-buffer standard-output
- (set (make-local-variable 'completion-base-position)
- (list (+ start base-size)
- ;; FIXME: We should pay attention to completion
- ;; boundaries here, but currently
- ;; completion-all-completions does not give us the
- ;; necessary information.
- end))
- (set (make-local-variable 'completion-list-insert-choice-function)
- (let ((ctable minibuffer-completion-table)
- (cpred minibuffer-completion-predicate)
- (cprops completion-extra-properties))
- (lambda (start end choice)
- (unless (or (zerop (length prefix))
- (equal prefix
- (buffer-substring-no-properties
- (max (point-min)
- (- start (length prefix)))
- start)))
- (message "*Completions* out of date"))
- ;; FIXME: Use `md' to do quoting&terminator here.
- (completion--replace start end choice)
- (let* ((minibuffer-completion-table ctable)
- (minibuffer-completion-predicate cpred)
- (completion-extra-properties cprops)
- (result (concat prefix choice))
- (bounds (completion-boundaries
- result ctable cpred "")))
- ;; If the completion introduces a new field, then
- ;; completion is not finished.
- (completion--done result
- (if (eq (car bounds) (length result))
- 'exact 'finished)))))))
-
- (display-completion-list completions))))
+ ,(if temp-buffer-resize-mode
+ '(window-height . resize-temp-buffer-window)
+ '(window-height . fit-window-to-buffer))
+ ,(when temp-buffer-resize-mode
+ '(preserve-size . (nil . t)))
+ (body-function
+ . ,#'(lambda (_window)
+ (with-current-buffer mainbuf
+ ;; 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))))
+ (when afun
+ (setq completions
+ (mapcar (lambda (s)
+ (let ((ann (funcall afun s)))
+ (if ann (list s ann) s)))
+ completions)))
+
+ (with-current-buffer standard-output
+ (set (make-local-variable 'completion-base-position)
+ (list (+ start base-size)
+ ;; FIXME: We should pay attention to completion
+ ;; boundaries here, but currently
+ ;; completion-all-completions does not give us the
+ ;; necessary information.
+ end))
+ (set (make-local-variable 'completion-list-insert-choice-function)
+ (let ((ctable minibuffer-completion-table)
+ (cpred minibuffer-completion-predicate)
+ (cprops completion-extra-properties))
+ (lambda (start end choice)
+ (unless (or (zerop (length prefix))
+ (equal prefix
+ (buffer-substring-no-properties
+ (max (point-min)
+ (- start (length prefix)))
+ start)))
+ (message "*Completions* out of date"))
+ ;; FIXME: Use `md' to do quoting&terminator here.
+ (completion--replace start end choice)
+ (let* ((minibuffer-completion-table ctable)
+ (minibuffer-completion-predicate cpred)
+ (completion-extra-properties cprops)
+ (result (concat prefix choice))
+ (bounds (completion-boundaries
+ result ctable cpred "")))
+ ;; If the completion introduces a new field, then
+ ;; completion is not finished.
+ (completion--done result
+ (if (eq (car bounds) (length result))
+ 'exact 'finished)))))))
+
+ (display-completion-list completions)))))
+ nil)))
nil))
(defun minibuffer-hide-completions ()
@@ -2370,8 +2366,6 @@ The completion method is determined by `completion-at-point-functions'."
Gets combined either with `minibuffer-local-completion-map' or
with `minibuffer-local-must-match-map'.")
-(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map
- 'minibuffer-local-filename-must-match-map "23.1")
(defvar minibuffer-local-filename-must-match-map (make-sparse-keymap))
(make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1")
@@ -2545,11 +2539,6 @@ same as `substitute-in-file-name'."
all))))))
(file-error nil))) ;PCM often calls with invalid directories.
-(defvar read-file-name-predicate nil
- "Current predicate used by `read-file-name-internal'.")
-(make-obsolete-variable 'read-file-name-predicate
- "use the regular PRED argument" "23.2")
-
(defun completion--sifn-requote (upos qstr)
;; We're looking for `qpos' such that:
;; (equal (substring (substitute-in-file-name qstr) 0 upos)
@@ -3039,6 +3028,19 @@ the commands start with a \"-\" or a SPC."
:version "24.1"
:type 'boolean)
+(defcustom minibuffer-default-prompt-format " (default %s)"
+ "Format string used to output \"default\" values.
+When prompting for input, there will often be a default value,
+leading to prompts like \"Number of articles (default 50): \".
+The \"default\" part of that prompt is controlled by this
+variable, and can be set to, for instance, \" [%s]\" if you want
+a shorter displayed prompt, or \"\", if you don't want to display
+the default at all.
+
+This variable is used by the `format-prompt' function."
+ :version "28.1"
+ :type 'string)
+
(defun completion-pcm--pattern-trivial-p (pattern)
(and (stringp (car pattern))
;; It can be followed by `point' and "" and still be trivial.
@@ -3108,12 +3110,12 @@ or a symbol, see `completion-pcm--merge-completions'."
(while p
(pcase p
(`(,(or 'any 'any-delim) point . ,rest) (setq p `(point . ,rest)))
- ;; This is not just a performance improvement: it also turns
- ;; a terminating `point' into an implicit `any', which
- ;; affects the final position of point (because `point' gets
- ;; turned into a non-greedy ".*?" regexp whereas we need
- ;; it the be greedy when it's at the end, see bug#38458).
- (`(,(pred symbolp)) (setq p nil)) ;Implicit terminating `any'.
+ ;; This is not just a performance improvement: it turns a
+ ;; terminating `point' into an implicit `any', which affects
+ ;; the final position of point (because `point' gets turned
+ ;; into a non-greedy ".*?" regexp whereas we need it to be
+ ;; greedy when it's at the end, see bug#38458).
+ (`(point) (setq p nil)) ;Implicit terminating `any'.
(_ (push (pop p) n))))
(nreverse n)))
@@ -3856,6 +3858,29 @@ the minibuffer was activated, and execute the forms."
(with-minibuffer-selected-window
(scroll-other-window-down arg)))
+(defun format-prompt (prompt default &rest format-args)
+ "Format PROMPT with DEFAULT according to `minibuffer-default-prompt-format'.
+If FORMAT-ARGS is nil, PROMPT is used as a plain string. If
+FORMAT-ARGS is non-nil, PROMPT is used as a format control
+string, and FORMAT-ARGS are the arguments to be substituted into
+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."
+ (concat
+ (if (null format-args)
+ prompt
+ (apply #'format prompt format-args))
+ (and default
+ (format minibuffer-default-prompt-format
+ (if (consp default)
+ (car default)
+ default)))
+ ": "))
+
(provide 'minibuffer)
;;; minibuffer.el ends here
diff --git a/lisp/misc.el b/lisp/misc.el
index 05244a6ea2f..be191c50d2f 100644
--- a/lisp/misc.el
+++ b/lisp/misc.el
@@ -1,4 +1,4 @@
-;;; misc.el --- some nonstandard editing and utility commands for Emacs
+;;; misc.el --- some nonstandard editing and utility commands for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1989, 2001-2020 Free Software Foundation, Inc.
@@ -69,7 +69,9 @@ The characters copied are inserted in the buffer before point."
Case is ignored if `case-fold-search' is non-nil in the current buffer.
Goes backward if ARG is negative; error if CHAR not found.
Ignores CHAR at point."
- (interactive "p\ncZap up to char: ")
+ (interactive (list (prefix-numeric-value current-prefix-arg)
+ (read-char-from-minibuffer "Zap up to char: "
+ nil 'read-char-history)))
(let ((direction (if (>= arg 0) 1 -1)))
(kill-region (point)
(progn
@@ -162,7 +164,7 @@ Internal use only."
"Recompute the list of dynamic libraries.
Internal use only."
(setq tabulated-list-format ; recomputed because column widths can change
- (let ((max-id-len 0) (max-name-len 0))
+ (let ((max-id-len 7) (max-name-len 11))
(dolist (lib dynamic-library-alist)
(let ((id-len (length (symbol-name (car lib))))
(name-len (apply 'max (mapcar 'length (cdr lib)))))
@@ -181,7 +183,9 @@ Internal use only."
(push (list id (vector (symbol-name id)
(list-dynamic-libraries--loaded from)
(mapconcat 'identity (cdr lib) ", ")))
- tabulated-list-entries)))))
+ tabulated-list-entries))))
+ (when (not dynamic-library-alist)
+ (message "No dynamic libraries found")))
;;;###autoload
(defun list-dynamic-libraries (&optional loaded-only-p buffer)
diff --git a/lisp/misearch.el b/lisp/misearch.el
index 958c10a1bf6..6ec10fe2c2e 100644
--- a/lisp/misearch.el
+++ b/lisp/misearch.el
@@ -236,11 +236,7 @@ set in `multi-isearch-buffers' or `multi-isearch-buffers-regexp'."
(buf nil)
(ido-ignore-item-temp-list bufs))
(while (not (string-equal
- (setq buf (read-buffer
- (if (eq read-buffer-function #'ido-read-buffer)
- "Next buffer to search (C-j to end): "
- "Next buffer to search (RET to end): ")
- nil t))
+ (setq buf (read-buffer (multi-occur--prompt) nil t))
""))
(add-to-list 'bufs buf)
(setq ido-ignore-item-temp-list bufs))
diff --git a/lisp/mouse.el b/lisp/mouse.el
index e58a2e6da18..9e7eee61e57 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -49,7 +49,10 @@
"If non-nil, copy to kill-ring upon mouse adjustments of the region.
This affects `mouse-save-then-kill' (\\[mouse-save-then-kill]) in
-addition to mouse drags."
+addition to mouse drags.
+
+This variable applies only to mouse adjustments in Emacs, not
+selecting and adjusting regions in other windows."
:type 'boolean
:version "24.1")
@@ -271,34 +274,6 @@ not it is actually displayed."
local-menu
minor-mode-menus)))
-(defun mouse-major-mode-menu (event &optional prefix)
- "Pop up a mode-specific menu of mouse commands.
-Default to the Edit menu if the major mode doesn't define a menu."
- (declare (obsolete mouse-menu-major-mode-map "23.1"))
- (interactive "@e\nP")
- (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
- (popup-menu (mouse-menu-major-mode-map) event prefix))
-
-(defun mouse-popup-menubar (event prefix)
- "Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX.
-The contents are the items that would be in the menu bar whether or
-not it is actually displayed."
- (declare (obsolete mouse-menu-bar-map "23.1"))
- (interactive "@e \nP")
- (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
- (popup-menu (mouse-menu-bar-map) (unless (integerp event) event) prefix))
-
-(defun mouse-popup-menubar-stuff (event prefix)
- "Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'.
-Use the former if the menu bar is showing, otherwise the latter."
- (declare (obsolete nil "23.1"))
- (interactive "@e\nP")
- (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
- (popup-menu
- (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))
- (mouse-menu-bar-map)
- (mouse-menu-major-mode-map))
- event prefix))
;; Commands that operate on windows.
@@ -552,7 +527,7 @@ frame instead."
(not (eq (window-frame minibuffer-window) frame))))
;; Drag frame when the window is on the bottom of its frame and
;; there is no minibuffer window below.
- (mouse-drag-frame start-event 'move)))))
+ (mouse-drag-frame-move start-event)))))
(defun mouse-drag-header-line (start-event)
"Change the height of a window by dragging on its header line.
@@ -569,7 +544,7 @@ the frame instead."
(mouse-drag-line start-event 'header)
(let ((frame (window-frame window)))
(when (frame-parameter frame 'drag-with-header-line)
- (mouse-drag-frame start-event 'move))))))
+ (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.
@@ -577,46 +552,137 @@ START-EVENT is the starting mouse event of the drag action."
(interactive "e")
(mouse-drag-line start-event 'vertical))
-(defun mouse-resize-frame (frame x-diff y-diff &optional x-move y-move)
- "Helper function for `mouse-drag-frame'."
- (let* ((frame-x-y (frame-position frame))
- (frame-x (car frame-x-y))
- (frame-y (cdr frame-x-y))
- alist)
- (if (> x-diff 0)
- (when x-move
- (setq x-diff (min x-diff frame-x))
- (setq x-move (- frame-x x-diff)))
- (let* ((min-width (frame-windows-min-size frame t nil t))
- (min-diff (max 0 (- (frame-inner-width frame) min-width))))
- (setq x-diff (max x-diff (- min-diff)))
- (when x-move
- (setq x-move (+ frame-x (- x-diff))))))
-
- (if (> y-diff 0)
- (when y-move
- (setq y-diff (min y-diff frame-y))
- (setq y-move (- frame-y y-diff)))
- (let* ((min-height (frame-windows-min-size frame nil nil t))
- (min-diff (max 0 (- (frame-inner-height frame) min-height))))
- (setq y-diff (max y-diff (- min-diff)))
- (when y-move
- (setq y-move (+ frame-y (- y-diff))))))
-
- (unless (zerop x-diff)
- (when x-move
- (push `(left . ,x-move) alist))
- (push `(width . (text-pixels . ,(+ (frame-text-width frame) x-diff)))
- alist))
- (unless (zerop y-diff)
- (when y-move
- (push `(top . ,y-move) alist))
- (push `(height . (text-pixels . ,(+ (frame-text-height frame) y-diff)))
- alist))
- (when alist
- (modify-frame-parameters frame alist))))
-
-(defun mouse-drag-frame (start-event part)
+(defun mouse-drag-frame-resize (start-event part)
+ "Drag a frame or one of its edges with the mouse.
+START-EVENT is the starting mouse event of the drag action. Its
+position window denotes the frame that will be dragged.
+
+PART specifies the part that has been dragged and must be one of
+the symbols `left', `top', `right', `bottom', `top-left',
+`top-right', `bottom-left', `bottom-right' to drag an internal
+border or edge. If PART equals `move', this means to move the
+frame with the mouse."
+ ;; Give temporary modes such as isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (let* ((echo-keystrokes 0)
+ (start (event-start start-event))
+ (window (posn-window start))
+ ;; FRAME is the frame to drag.
+ (frame (if (window-live-p window)
+ (window-frame window)
+ window))
+ ;; Initial "first" frame position and size. While dragging we
+ ;; base all calculations against that size and position.
+ (first-pos (frame-position frame))
+ (first-left (car first-pos))
+ (first-top (cdr first-pos))
+ (first-width (frame-text-width frame))
+ (first-height (frame-text-height frame))
+ ;; Don't let FRAME become less large than the size needed to
+ ;; fit all of its windows.
+ (min-text-width
+ (+ (frame-windows-min-size frame t nil t)
+ (- (frame-inner-width frame) first-width)))
+ (min-text-height
+ (+ (frame-windows-min-size frame nil nil t)
+ (- (frame-inner-height frame) first-height)))
+ ;; PARENT is the parent frame of FRAME or, if FRAME is a
+ ;; top-level frame, FRAME's workarea.
+ (parent (frame-parent frame))
+ (parent-edges
+ (if parent
+ (frame-edges parent)
+ (let* ((attributes
+ (car (display-monitor-attributes-list)))
+ (workarea (assq 'workarea attributes)))
+ (and workarea
+ `(,(nth 1 workarea) ,(nth 2 workarea)
+ ,(+ (nth 1 workarea) (nth 3 workarea))
+ ,(+ (nth 2 workarea) (nth 4 workarea)))))))
+ (parent-left (and parent-edges (nth 0 parent-edges)))
+ (parent-top (and parent-edges (nth 1 parent-edges)))
+ (parent-right (and parent-edges (nth 2 parent-edges)))
+ (parent-bottom (and parent-edges (nth 3 parent-edges)))
+ ;; Drag types. drag-left/drag-right and drag-top/drag-bottom
+ ;; are mutually exclusive.
+ (drag-left (memq part '(bottom-left left top-left)))
+ (drag-top (memq part '(top-left top top-right)))
+ (drag-right (memq part '(top-right right bottom-right)))
+ (drag-bottom (memq part '(bottom-right bottom bottom-left)))
+ ;; Initial "first" mouse position. While dragging we base all
+ ;; calculations against that position.
+ (first-x-y (mouse-absolute-pixel-position))
+ (first-x (car first-x-y))
+ (first-y (cdr first-x-y))
+ (exitfun nil)
+ (move
+ (lambda (event)
+ (interactive "e")
+ (when (consp event)
+ (let* ((last-x-y (mouse-absolute-pixel-position))
+ (last-x (car last-x-y))
+ (last-y (cdr last-x-y))
+ (left (- last-x first-x))
+ (top (- last-y first-y))
+ alist)
+ ;; We never want to warp the mouse position here. When
+ ;; moving the mouse leftward or upward, then with a wide
+ ;; border the calculated left or top position of the
+ ;; frame could drop to a value less than zero depending
+ ;; on where precisely the mouse within the border. We
+ ;; guard against this by never allowing the frame to
+ ;; move to a position less than zero here. No such
+ ;; precautions are used for the right and bottom borders
+ ;; so with a large internal border parts of that border
+ ;; may disappear.
+ (when (and drag-left (>= last-x parent-left)
+ (>= (- first-width left) min-text-width))
+ (push `(left . ,(max (+ first-left left) 0)) alist)
+ (push `(width . (text-pixels . ,(- first-width left)))
+ alist))
+ (when (and drag-top (>= last-y parent-top)
+ (>= (- first-height top) min-text-height))
+ (push `(top . ,(max 0 (+ first-top top))) alist)
+ (push `(height . (text-pixels . ,(- first-height top)))
+ alist))
+ (when (and drag-right (<= last-x parent-right)
+ (>= (+ first-width left) min-text-width))
+ (push `(width . (text-pixels . ,(+ first-width left)))
+ alist))
+ (when (and drag-bottom (<= last-y parent-bottom)
+ (>= (+ first-height top) min-text-height))
+ (push `(height . (text-pixels . ,(+ first-height top)))
+ alist))
+ (modify-frame-parameters frame alist)))))
+ (old-track-mouse track-mouse))
+ ;; Start tracking. The special value 'dragging' signals the
+ ;; display engine to freeze the mouse pointer shape for as long
+ ;; as we drag.
+ (setq track-mouse 'dragging)
+ ;; Loop reading events and sampling the position of the mouse.
+ (setq exitfun
+ (set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [switch-frame] #'ignore)
+ (define-key map [select-window] #'ignore)
+ (define-key map [scroll-bar-movement] #'ignore)
+ (define-key map [mouse-movement] move)
+ ;; Swallow drag-mouse-1 events to avoid selecting some other window.
+ (define-key map [drag-mouse-1]
+ (lambda () (interactive) (funcall exitfun)))
+ ;; Some of the events will of course end up looked up
+ ;; with a mode-line, header-line or vertical-line prefix ...
+ (define-key map [mode-line] map)
+ (define-key map [header-line] map)
+ (define-key map [vertical-line] map)
+ ;; ... and some maybe even with a right- or bottom-divider
+ ;; prefix.
+ (define-key map [right-divider] map)
+ (define-key map [bottom-divider] map)
+ map)
+ t (lambda () (setq track-mouse old-track-mouse))))))
+
+(defun mouse-drag-frame-move (start-event)
"Drag a frame or one of its edges with the mouse.
START-EVENT is the starting mouse event of the drag action. Its
position window denotes the frame that will be dragged.
@@ -635,9 +701,14 @@ frame with the mouse."
(frame (if (window-live-p window)
(window-frame window)
window))
- (width (frame-native-width frame))
- (height (frame-native-height frame))
- ;; PARENT is the parent frame of FRAME or, if FRAME is a
+ (native-width (frame-native-width frame))
+ (native-height (frame-native-height frame))
+ ;; Initial "first" frame position and size. While dragging we
+ ;; base all calculations against that size and position.
+ (first-pos (frame-position frame))
+ (first-left (car first-pos))
+ (first-top (cdr first-pos))
+ ;; PARENT is the parent frame of FRAME or, if FRAME is a
;; top-level frame, FRAME's workarea.
(parent (frame-parent frame))
(parent-edges
@@ -654,19 +725,16 @@ frame with the mouse."
(parent-top (and parent-edges (nth 1 parent-edges)))
(parent-right (and parent-edges (nth 2 parent-edges)))
(parent-bottom (and parent-edges (nth 3 parent-edges)))
- ;; `pos-x' and `pos-y' record the x- and y-coordinates of the
- ;; last sampled mouse position. Note that we sample absolute
- ;; mouse positions to avoid that moving the mouse from one
- ;; frame into another gets into our way. `last-x' and `last-y'
- ;; records the x- and y-coordinates of the previously sampled
- ;; position. The differences between `last-x' and `pos-x' as
- ;; well as `last-y' and `pos-y' determine the amount the mouse
- ;; has been dragged between the last two samples.
- pos-x-y pos-x pos-y
- (last-x-y (mouse-absolute-pixel-position))
- (last-x (car last-x-y))
- (last-y (cdr last-x-y))
- ;; `snap-x' and `snap-y' record the x- and y-coordinates of the
+ ;; Initial "first" mouse position. While dragging we base all
+ ;; calculations against that position.
+ (first-x-y (mouse-absolute-pixel-position))
+ (first-x (car first-x-y))
+ (first-y (cdr first-x-y))
+ ;; `snap-width' (maybe also a yet to be provided `snap-height')
+ ;; could become floats to handle proportionality wrt PARENT.
+ ;; We don't do any checks on this parameter so far.
+ (snap-width (frame-parameter frame 'snap-width))
+ ;; `snap-x' and `snap-y' record the x- and y-coordinates of the
;; mouse position when FRAME snapped. As soon as the
;; difference between `pos-x' and `snap-x' (or `pos-y' and
;; `snap-y') exceeds the value of FRAME's `snap-width'
@@ -678,176 +746,141 @@ frame with the mouse."
(lambda (event)
(interactive "e")
(when (consp event)
- (setq pos-x-y (mouse-absolute-pixel-position))
- (setq pos-x (car pos-x-y))
- (setq pos-y (cdr pos-x-y))
- (cond
- ((eq part 'left)
- (mouse-resize-frame frame (- last-x pos-x) 0 t))
- ((eq part 'top)
- (mouse-resize-frame frame 0 (- last-y pos-y) nil t))
- ((eq part 'right)
- (mouse-resize-frame frame (- pos-x last-x) 0))
- ((eq part 'bottom)
- (mouse-resize-frame frame 0 (- pos-y last-y)))
- ((eq part 'top-left)
- (mouse-resize-frame
- frame (- last-x pos-x) (- last-y pos-y) t t))
- ((eq part 'top-right)
- (mouse-resize-frame
- frame (- pos-x last-x) (- last-y pos-y) nil t))
- ((eq part 'bottom-left)
- (mouse-resize-frame
- frame (- last-x pos-x) (- pos-y last-y) t))
- ((eq part 'bottom-right)
- (mouse-resize-frame
- frame (- pos-x last-x) (- pos-y last-y)))
- ((eq part 'move)
- (let* ((old-position (frame-position frame))
- (old-left (car old-position))
- (old-top (cdr old-position))
- (left (+ old-left (- pos-x last-x)))
- (top (+ old-top (- pos-y last-y)))
- right bottom
- ;; `snap-width' (maybe also a yet to be provided
- ;; `snap-height') could become floats to handle
- ;; proportionality wrt PARENT. We don't do any
- ;; checks on this parameter so far.
- (snap-width (frame-parameter frame 'snap-width)))
- ;; Docking and constraining.
- (when (and (numberp snap-width) parent-edges)
+ (let* ((last-x-y (mouse-absolute-pixel-position))
+ (last-x (car last-x-y))
+ (last-y (cdr last-x-y))
+ (left (- last-x first-x))
+ (top (- last-y first-y))
+ right bottom)
+ (setq left (+ first-left left))
+ (setq top (+ first-top top))
+ ;; Docking and constraining.
+ (when (and (numberp snap-width) parent-edges)
+ (cond
+ ;; Docking at the left parent edge.
+ ((< last-x first-x)
(cond
- ;; Docking at the left parent edge.
- ((< pos-x last-x)
- (cond
- ((and (> left parent-left)
- (<= (- left parent-left) snap-width))
- ;; Snap when the mouse moved leftward and
- ;; FRAME's left edge would end up within
- ;; `snap-width' pixels from PARENT's left edge.
- (setq snap-x pos-x)
- (setq left parent-left))
- ((and (<= left parent-left)
- (<= (- parent-left left) snap-width)
- snap-x (<= (- snap-x pos-x) snap-width))
- ;; Stay snapped when the mouse moved leftward
- ;; but not more than `snap-width' pixels from
- ;; the time FRAME snapped.
- (setq left parent-left))
- (t
- ;; Unsnap when the mouse moved more than
- ;; `snap-width' pixels leftward from the time
- ;; FRAME snapped.
- (setq snap-x nil))))
- ((> pos-x last-x)
- (setq right (+ left width))
- (cond
- ((and (< right parent-right)
- (<= (- parent-right right) snap-width))
- ;; Snap when the mouse moved rightward and
- ;; FRAME's right edge would end up within
- ;; `snap-width' pixels from PARENT's right edge.
- (setq snap-x pos-x)
- (setq left (- parent-right width)))
- ((and (>= right parent-right)
- (<= (- right parent-right) snap-width)
- snap-x (<= (- pos-x snap-x) snap-width))
- ;; Stay snapped when the mouse moved rightward
- ;; but not more more than `snap-width' pixels
- ;; from the time FRAME snapped.
- (setq left (- parent-right width)))
- (t
- ;; Unsnap when the mouse moved rightward more
- ;; than `snap-width' pixels from the time FRAME
- ;; snapped.
- (setq snap-x nil)))))
-
+ ((and (> left parent-left)
+ (<= (- left parent-left) snap-width))
+ ;; Snap when the mouse moved leftward and FRAME's
+ ;; left edge would end up within `snap-width'
+ ;; pixels from PARENT's left edge.
+ (setq snap-x last-x)
+ (setq left parent-left))
+ ((and (<= left parent-left)
+ (<= (- parent-left left) snap-width)
+ snap-x (<= (- snap-x last-x) snap-width))
+ ;; Stay snapped when the mouse moved leftward but
+ ;; not more than `snap-width' pixels from the time
+ ;; FRAME snapped.
+ (setq left parent-left))
+ (t
+ ;; Unsnap when the mouse moved more than
+ ;; `snap-width' pixels leftward from the time
+ ;; FRAME snapped.
+ (setq snap-x nil))))
+ ((> last-x first-x)
+ (setq right (+ left native-width))
(cond
- ((< pos-y last-y)
- (cond
- ((and (> top parent-top)
- (<= (- top parent-top) snap-width))
- ;; Snap when the mouse moved upward and FRAME's
- ;; top edge would end up within `snap-width'
- ;; pixels from PARENT's top edge.
- (setq snap-y pos-y)
- (setq top parent-top))
- ((and (<= top parent-top)
- (<= (- parent-top top) snap-width)
- snap-y (<= (- snap-y pos-y) snap-width))
- ;; Stay snapped when the mouse moved upward but
- ;; not more more than `snap-width' pixels from
- ;; the time FRAME snapped.
- (setq top parent-top))
- (t
- ;; Unsnap when the mouse moved upward more than
- ;; `snap-width' pixels from the time FRAME
- ;; snapped.
- (setq snap-y nil))))
- ((> pos-y last-y)
- (setq bottom (+ top height))
- (cond
- ((and (< bottom parent-bottom)
- (<= (- parent-bottom bottom) snap-width))
- ;; Snap when the mouse moved downward and
- ;; FRAME's bottom edge would end up within
- ;; `snap-width' pixels from PARENT's bottom
- ;; edge.
- (setq snap-y pos-y)
- (setq top (- parent-bottom height)))
- ((and (>= bottom parent-bottom)
- (<= (- bottom parent-bottom) snap-width)
- snap-y (<= (- pos-y snap-y) snap-width))
- ;; Stay snapped when the mouse moved downward
- ;; but not more more than `snap-width' pixels
- ;; from the time FRAME snapped.
- (setq top (- parent-bottom height)))
- (t
- ;; Unsnap when the mouse moved downward more
- ;; than `snap-width' pixels from the time FRAME
- ;; snapped.
- (setq snap-y nil))))))
-
- ;; If requested, constrain FRAME's draggable areas to
- ;; PARENT's edges. The `top-visible' parameter should
- ;; be set when FRAME has a draggable header-line. If
- ;; set to a number, it ascertains that the top of
- ;; FRAME is always constrained to the top of PARENT
- ;; and that at least as many pixels of FRAME as
- ;; specified by that number are visible on each of the
- ;; three remaining sides of PARENT.
- ;;
- ;; The `bottom-visible' parameter should be set when
- ;; FRAME has a draggable mode-line. If set to a
- ;; number, it ascertains that the bottom of FRAME is
- ;; always constrained to the bottom of PARENT and that
- ;; at least as many pixels of FRAME as specified by
- ;; that number are visible on each of the three
- ;; remaining sides of PARENT.
- (let ((par (frame-parameter frame 'top-visible))
- bottom-visible)
- (unless par
- (setq par (frame-parameter frame 'bottom-visible))
- (setq bottom-visible t))
- (when (and (numberp par) parent-edges)
- (setq left
- (max (min (- parent-right par) left)
- (+ (- parent-left width) par)))
- (setq top
- (if bottom-visible
- (min (max top (- parent-top (- height par)))
- (- parent-bottom height))
- (min (max top parent-top)
- (- parent-bottom par))))))
-
- ;; Use `modify-frame-parameters' since `left' and
- ;; `top' may want to move FRAME out of its PARENT.
- (modify-frame-parameters
- frame
- `((left . (+ ,left)) (top . (+ ,top)))))))
- (setq last-x pos-x)
- (setq last-y pos-y))))
- (old-track-mouse track-mouse))
+ ((and (< right parent-right)
+ (<= (- parent-right right) snap-width))
+ ;; Snap when the mouse moved rightward and FRAME's
+ ;; right edge would end up within `snap-width'
+ ;; pixels from PARENT's right edge.
+ (setq snap-x last-x)
+ (setq left (- parent-right native-width)))
+ ((and (>= right parent-right)
+ (<= (- right parent-right) snap-width)
+ snap-x (<= (- last-x snap-x) snap-width))
+ ;; Stay snapped when the mouse moved rightward but
+ ;; not more more than `snap-width' pixels from the
+ ;; time FRAME snapped.
+ (setq left (- parent-right native-width)))
+ (t
+ ;; Unsnap when the mouse moved rightward more than
+ ;; `snap-width' pixels from the time FRAME
+ ;; snapped.
+ (setq snap-x nil)))))
+ (cond
+ ((< last-y first-y)
+ (cond
+ ((and (> top parent-top)
+ (<= (- top parent-top) snap-width))
+ ;; Snap when the mouse moved upward and FRAME's
+ ;; top edge would end up within `snap-width'
+ ;; pixels from PARENT's top edge.
+ (setq snap-y last-y)
+ (setq top parent-top))
+ ((and (<= top parent-top)
+ (<= (- parent-top top) snap-width)
+ snap-y (<= (- snap-y last-y) snap-width))
+ ;; Stay snapped when the mouse moved upward but
+ ;; not more more than `snap-width' pixels from the
+ ;; time FRAME snapped.
+ (setq top parent-top))
+ (t
+ ;; Unsnap when the mouse moved upward more than
+ ;; `snap-width' pixels from the time FRAME
+ ;; snapped.
+ (setq snap-y nil))))
+ ((> last-y first-y)
+ (setq bottom (+ top native-height))
+ (cond
+ ((and (< bottom parent-bottom)
+ (<= (- parent-bottom bottom) snap-width))
+ ;; Snap when the mouse moved downward and FRAME's
+ ;; bottom edge would end up within `snap-width'
+ ;; pixels from PARENT's bottom edge.
+ (setq snap-y last-y)
+ (setq top (- parent-bottom native-height)))
+ ((and (>= bottom parent-bottom)
+ (<= (- bottom parent-bottom) snap-width)
+ snap-y (<= (- last-y snap-y) snap-width))
+ ;; Stay snapped when the mouse moved downward but
+ ;; not more more than `snap-width' pixels from the
+ ;; time FRAME snapped.
+ (setq top (- parent-bottom native-height)))
+ (t
+ ;; Unsnap when the mouse moved downward more than
+ ;; `snap-width' pixels from the time FRAME
+ ;; snapped.
+ (setq snap-y nil))))))
+
+ ;; If requested, constrain FRAME's draggable areas to
+ ;; PARENT's edges. The `top-visible' parameter should
+ ;; be set when FRAME has a draggable header-line. If
+ ;; set to a number, it ascertains that the top of FRAME
+ ;; is always constrained to the top of PARENT and that
+ ;; at least as many pixels of FRAME as specified by that
+ ;; number are visible on each of the three remaining
+ ;; sides of PARENT.
+ ;;
+ ;; The `bottom-visible' parameter should be set when
+ ;; FRAME has a draggable mode-line. If set to a number,
+ ;; it ascertains that the bottom of FRAME is always
+ ;; constrained to the bottom of PARENT and that at least
+ ;; as many pixels of FRAME as specified by that number
+ ;; are visible on each of the three remaining sides of
+ ;; PARENT.
+ (let ((par (frame-parameter frame 'top-visible))
+ bottom-visible)
+ (unless par
+ (setq par (frame-parameter frame 'bottom-visible))
+ (setq bottom-visible t))
+ (when (and (numberp par) parent-edges)
+ (setq left
+ (max (min (- parent-right par) left)
+ (+ (- parent-left native-width) par)))
+ (setq top
+ (if bottom-visible
+ (min (max top (- parent-top (- native-height par)))
+ (- parent-bottom native-height))
+ (min (max top parent-top)
+ (- parent-bottom par))))))
+ ;; Use `modify-frame-parameters' since `left' and `top'
+ ;; may want to move FRAME out of its PARENT.
+ (modify-frame-parameters frame `((left . (+ ,left)) (top . (+ ,top))))))))
+ (old-track-mouse track-mouse))
;; Start tracking. The special value 'dragging' signals the
;; display engine to freeze the mouse pointer shape for as long
;; as we drag.
@@ -879,49 +912,49 @@ frame with the mouse."
"Drag left edge of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'left))
+ (mouse-drag-frame-resize start-event 'left))
(defun mouse-drag-top-left-corner (start-event)
"Drag top left corner of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'top-left))
+ (mouse-drag-frame-resize start-event 'top-left))
(defun mouse-drag-top-edge (start-event)
"Drag top edge of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'top))
+ (mouse-drag-frame-resize start-event 'top))
(defun mouse-drag-top-right-corner (start-event)
"Drag top right corner of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'top-right))
+ (mouse-drag-frame-resize start-event 'top-right))
(defun mouse-drag-right-edge (start-event)
"Drag right edge of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'right))
+ (mouse-drag-frame-resize start-event 'right))
(defun mouse-drag-bottom-right-corner (start-event)
"Drag bottom right corner of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'bottom-right))
+ (mouse-drag-frame-resize start-event 'bottom-right))
(defun mouse-drag-bottom-edge (start-event)
"Drag bottom edge of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'bottom))
+ (mouse-drag-frame-resize start-event 'bottom))
(defun mouse-drag-bottom-left-corner (start-event)
"Drag bottom left corner of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'bottom-left))
+ (mouse-drag-frame-resize start-event 'bottom-left))
(defcustom mouse-select-region-move-to-beginning nil
"Effect of selecting a region extending backward from double click.
@@ -2173,8 +2206,8 @@ and selects that window."
;; Sort the list to put the most popular major modes first.
(setq split-by-major-mode
(sort split-by-major-mode
- (function (lambda (elt1 elt2)
- (> (length elt1) (length elt2))))))
+ (lambda (elt1 elt2)
+ (> (length elt1) (length elt2)))))
;; Make a separate submenu for each major mode
;; that has more than one buffer,
;; unless all the remaining buffers are less than 1/10 of them.
@@ -2215,8 +2248,8 @@ and selects that window."
head)
(setq buffers
(sort buffers
- (function (lambda (elt1 elt2)
- (string< (buffer-name elt1) (buffer-name elt2))))))
+ (lambda (elt1 elt2)
+ (string< (buffer-name elt1) (buffer-name elt2)))))
(setq tail buffers)
(while tail
(or (eq ?\s (aref (buffer-name (car tail)) 0))
@@ -2270,9 +2303,6 @@ and selects that window."
;; Few buffers--put them all in one pane.
(list (cons title alist))))
-(define-obsolete-function-alias
- 'mouse-choose-completion 'choose-completion "23.2")
-
;; Font selection.
(defun font-menu-add-default ()
@@ -2498,7 +2528,7 @@ region, text is copied instead of being cut."
(lambda (modifier)
`(const :tag ,(format "Enable, but copy with the %s modifier"
modifier)
- modifier))
+ ,modifier))
'(alt super hyper shift control meta))
(other :tag "Enable dragging the region" t))
:version "26.1")
@@ -2517,9 +2547,12 @@ as it does when dropping text in the source buffer."
If this option is nil, `mouse-drag-and-drop-region' does not show
tooltips. If this is t, it shows the entire text dragged in a
tooltip. If this is an integer (as with the default value of
-256), it will show that many characters of the dragged text in
-a tooltip."
- :type 'integer
+256), it will show up to that many characters of the dragged text
+in a tooltip."
+ :type '(choice
+ (const :tag "Do not show tooltips" nil)
+ (const :tag "Show all text" t)
+ (integer :tag "Max number of characters to show" 256))
:version "26.1")
(defcustom mouse-drag-and-drop-region-show-cursor t
@@ -2553,6 +2586,7 @@ is copied instead of being cut."
(let* ((mouse-button (event-basic-type last-input-event))
(mouse-drag-and-drop-region-show-tooltip
(when (and mouse-drag-and-drop-region-show-tooltip
+ (> mouse-drag-and-drop-region-show-tooltip 0)
(display-multi-frame-p)
(require 'tooltip))
mouse-drag-and-drop-region-show-tooltip))
diff --git a/lisp/mpc.el b/lisp/mpc.el
index 47fe4dea7fa..d22b7ab4506 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -2750,7 +2750,9 @@ If stopped, start playback."
(if current-prefix-arg
;; FIXME: We should provide some completion here, especially for the
;; case where the user specifies a local socket/file name.
- (setq mpc-host (read-string "MPD host and port: " nil nil mpc-host)))
+ (setq mpc-host (read-string
+ (format-prompt "MPD host and port" mpc-host)
+ nil nil mpc-host)))
nil))
(let* ((song-buf (mpc-songs-buf))
(song-win (get-buffer-window song-buf 0)))
diff --git a/lisp/msb.el b/lisp/msb.el
index ebaf98cbe83..15aeaa2e73f 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -372,6 +372,8 @@ This is instead of the groups in `msb-menu-cond'."
:type 'hook
:set 'msb-custom-set
:group 'msb)
+(make-obsolete-variable 'msb-after-load-hook
+ "use `with-eval-after-load' instead." "28.1")
;;;
;;; Internal variables
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 317f2cd8edd..c6a7391df1a 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -1,4 +1,4 @@
-;;; mwheel.el --- Wheel mouse support
+;;; mwheel.el --- Mouse wheel support -*- lexical-binding:t -*-
;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
;; Keywords: mouse
@@ -25,8 +25,8 @@
;; Under X11/X.Org, the wheel events are sent as button4/button5
;; events.
-;; It is already enabled by default on most graphical displays. You
-;; can toggle it with M-x mouse-wheel-mode.
+;; Mouse wheel support is already enabled by default on most graphical
+;; displays. You can toggle it using `M-x mouse-wheel-mode'.
;;; Code:
@@ -85,7 +85,7 @@ set to the event sent when clicking on the mouse wheel button."
:type 'number)
(defcustom mouse-wheel-scroll-amount
- '(5 ((shift) . 1) ((meta) . nil) ((control) . text-scale))
+ '(1 ((shift) . hscroll) ((meta) . nil) ((control) . text-scale))
"Amount to scroll windows by when spinning the mouse wheel.
This is an alist mapping the modifier key to the amount to scroll when
the wheel is moved with the modifier key depressed.
@@ -97,6 +97,9 @@ screen. It can also be a floating point number, specifying the fraction of
a full screen to scroll. A near full screen is `next-screen-context-lines'
less than a full screen.
+If AMOUNT is the symbol 'hscroll', this means that with MODIFIER,
+the mouse wheel will scroll horizontally instead of vertically.
+
If AMOUNT is the symbol text-scale, this means that with
MODIFIER, the mouse wheel will change the face height instead of
scrolling."
@@ -123,9 +126,10 @@ scrolling."
(const :tag "Scroll full screen" :value nil)
(integer :tag "Scroll specific # of lines")
(float :tag "Scroll fraction of window")
+ (const :tag "Scroll horizontally" :value hscroll)
(const :tag "Change face size" :value text-scale)))))
:set 'mouse-wheel-change-button
- :version "27.1")
+ :version "28.1")
(defcustom mouse-wheel-progressive-speed t
"If non-nil, the faster the user moves the wheel, the faster the scrolling.
@@ -162,23 +166,18 @@ Also see `mouse-wheel-tilt-scroll'."
:type 'boolean
:version "26.1")
-(eval-and-compile
- (if (fboundp 'event-button)
- (fset 'mwheel-event-button 'event-button)
- (defun mwheel-event-button (event)
- (let ((x (event-basic-type event)))
- ;; Map mouse-wheel events to appropriate buttons
- (if (eq 'mouse-wheel x)
- (let ((amount (car (cdr (cdr (cdr event))))))
- (if (< amount 0)
- mouse-wheel-up-event
- mouse-wheel-down-event))
- x))))
-
- (if (fboundp 'event-window)
- (fset 'mwheel-event-window 'event-window)
- (defun mwheel-event-window (event)
- (posn-window (event-start event)))))
+(defun mwheel-event-button (event)
+ (let ((x (event-basic-type event)))
+ ;; Map mouse-wheel events to appropriate buttons
+ (if (eq 'mouse-wheel x)
+ (let ((amount (car (cdr (cdr (cdr event))))))
+ (if (< amount 0)
+ mouse-wheel-up-event
+ mouse-wheel-down-event))
+ x)))
+
+(defun mwheel-event-window (event)
+ (posn-window (event-start event)))
(defvar mwheel-inhibit-click-event-timer nil
"Timer running while mouse wheel click event is inhibited.")
@@ -208,13 +207,13 @@ Also see `mouse-wheel-tilt-scroll'."
(defvar mouse-wheel-left-event
(if (or (featurep 'w32-win) (featurep 'ns-win))
'wheel-left
- (intern "mouse-6"))
+ 'mouse-6)
"Event used for scrolling left.")
(defvar mouse-wheel-right-event
(if (or (featurep 'w32-win) (featurep 'ns-win))
'wheel-right
- (intern "mouse-7"))
+ 'mouse-7)
"Event used for scrolling right.")
(defun mouse-wheel--get-scroll-window (event)
@@ -275,7 +274,11 @@ non-Windows systems."
(condition-case nil
(unwind-protect
(let ((button (mwheel-event-button event)))
- (cond ((eq button mouse-wheel-down-event)
+ (cond ((and (eq amt 'hscroll) (eq button mouse-wheel-down-event))
+ (funcall (if mouse-wheel-flip-direction
+ mwheel-scroll-left-function
+ mwheel-scroll-right-function) 1))
+ ((eq button mouse-wheel-down-event)
(condition-case nil (funcall mwheel-scroll-down-function amt)
;; Make sure we do indeed scroll to the beginning of
;; the buffer.
@@ -290,7 +293,11 @@ non-Windows systems."
;; for a reason that escapes me. This problem seems
;; to only affect scroll-down. --Stef
(set-window-start (selected-window) (point-min))))))
- ((eq button mouse-wheel-up-event)
+ ((and (eq amt 'hscroll) (eq button mouse-wheel-up-event))
+ (funcall (if mouse-wheel-flip-direction
+ mwheel-scroll-right-function
+ mwheel-scroll-left-function) 1))
+ ((eq button mouse-wheel-up-event)
(condition-case nil (funcall mwheel-scroll-up-function amt)
;; Make sure we do indeed scroll to the end of the buffer.
(end-of-buffer (while t (funcall mwheel-scroll-up-function)))))
@@ -349,16 +356,39 @@ non-Windows systems."
(text-scale-decrease 1)))
(select-window selected-window))))
-(defvar mwheel-installed-bindings nil)
-(defvar mwheel-installed-text-scale-bindings nil)
+(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'."
+ (global-set-key key fun)
+ (push (cons key fun) mouse-wheel--installed-bindings-alist))
-(defun mouse-wheel--remove-bindings (bindings funs)
- "Remove key BINDINGS if they're bound to any function in FUNS.
-BINDINGS is a list of key bindings, FUNS is a list of functions.
+(defun mouse-wheel--remove-bindings ()
+ "Remove all mouse wheel key bindings.
This is a helper function for `mouse-wheel-mode'."
- (dolist (key bindings)
- (when (memq (lookup-key (current-global-map) key) funs)
- (global-unset-key key))))
+ (dolist (binding mouse-wheel--installed-bindings-alist)
+ (let ((key (car binding))
+ (fun (cdr binding)))
+ (when (eq (lookup-key (current-global-map) key) fun)
+ (global-unset-key key))))
+ (setq mouse-wheel--installed-bindings-alist nil))
+
+(defun mouse-wheel--create-scroll-keys (binding event)
+ "Return list of key vectors for BINDING and EVENT.
+BINDING is an element in `mouse-wheel-scroll-amount'. EVENT is
+an event used for scrolling, such as `mouse-wheel-down-event'."
+ (let ((prefixes (list 'left-margin 'right-margin
+ 'left-fringe 'right-fringe
+ 'vertical-scroll-bar 'horizontal-scroll-bar
+ 'mode-line 'header-line)))
+ (if (consp binding)
+ ;; With modifiers, bind only the buffer area (no prefix).
+ (list `[(,@(car binding) ,event)])
+ ;; No modifier: bind also some non-buffer areas of the screen.
+ (cons (vector event)
+ (mapcar (lambda (prefix) (vector prefix event)) prefixes)))))
(define-minor-mode mouse-wheel-mode
"Toggle mouse wheel support (Mouse Wheel mode)."
@@ -371,12 +401,7 @@ This is a helper function for `mouse-wheel-mode'."
:global t
:group 'mouse
;; Remove previous bindings, if any.
- (mouse-wheel--remove-bindings mwheel-installed-bindings
- '(mwheel-scroll))
- (mouse-wheel--remove-bindings mwheel-installed-text-scale-bindings
- '(mouse-wheel-text-scale))
- (setq mwheel-installed-bindings nil)
- (setq mwheel-installed-text-scale-bindings nil)
+ (mouse-wheel--remove-bindings)
;; Setup bindings as needed.
(when mouse-wheel-mode
(dolist (binding mouse-wheel-scroll-amount)
@@ -384,16 +409,16 @@ This is a helper function for `mouse-wheel-mode'."
;; Bindings for changing font size.
((and (consp binding) (eq (cdr binding) 'text-scale))
(dolist (event (list mouse-wheel-down-event mouse-wheel-up-event))
- (let ((key `[,(list (caar binding) event)]))
- (global-set-key key 'mouse-wheel-text-scale)
- (push key mwheel-installed-text-scale-bindings))))
+ (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-right-event mouse-wheel-left-event))
- (let ((key `[(,@(if (consp binding) (car binding)) ,event)]))
- (global-set-key key 'mwheel-scroll)
- (push key mwheel-installed-bindings))))))))
+ mouse-wheel-left-event mouse-wheel-right-event))
+ (dolist (key (mouse-wheel--create-scroll-keys binding event))
+ (mouse-wheel--add-binding key 'mwheel-scroll))))))))
+
+;;; Obsolete.
;;; Compatibility entry point
;; preloaded ;;;###autoload
@@ -402,6 +427,12 @@ This is a helper function for `mouse-wheel-mode'."
(declare (obsolete mouse-wheel-mode "27.1"))
(mouse-wheel-mode (if uninstall -1 1)))
+(defvar mwheel-installed-bindings nil)
+(make-obsolete-variable 'mwheel-installed-bindings nil "28.1")
+
+(defvar mwheel-installed-text-scale-bindings nil)
+(make-obsolete-variable 'mwheel-installed-text-scale-bindings nil "28.1")
+
(provide 'mwheel)
;;; mwheel.el ends here
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 92ed98b2a89..0cb8d7cb837 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -838,7 +838,7 @@ If nil, prompt the user for a password."
"If non-nil, regexp matching hosts on which `dir' command lists directory."
:group 'ange-ftp
:type '(choice (const :tag "Default" nil)
- string))
+ regexp))
(defcustom ange-ftp-binary-file-name-regexp ""
"If a file matches this regexp then it is transferred in binary mode."
@@ -4169,8 +4169,7 @@ directory, so that Emacs will know its current contents."
(if (file-directory-p file)
(ange-ftp-delete-directory file recursive trash)
(delete-file file trash)))
- ;; We do not want to delete "." and "..".
- (directory-files dir 'full (rx (or (not ".") "...")))))
+ (directory-files dir 'full directory-files-no-dot-files-regexp)))
(if parsed
(let* ((host (nth 0 parsed))
(user (nth 1 parsed))
@@ -4739,7 +4738,8 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
(setq ange-ftp-ls-cache-file nil) ;Stop confusing Dired.
0)
-(defun ange-ftp-set-file-modes (filename mode)
+(defun ange-ftp-set-file-modes (filename mode &optional flag)
+ flag ;; FIXME: Support 'nofollow'.
(ange-ftp-call-chmod (list (format "%o" mode) filename)))
(defun ange-ftp-make-symbolic-link (&rest _arguments)
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 25aabf6d61d..e7dad48cf4a 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -1,4 +1,4 @@
-;;; browse-url.el --- pass a URL to a WWW browser
+;;; browse-url.el --- pass a URL to a WWW browser -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
@@ -39,7 +39,6 @@
;; browse-url-chrome Chrome 47.0.2526.111
;; browse-url-chromium Chromium 3.0
;; browse-url-epiphany Epiphany Don't know
-;; browse-url-conkeror Conkeror Don't know
;; browse-url-w3 w3 0
;; browse-url-text-* Any text browser 0
;; browse-url-generic arbitrary
@@ -114,9 +113,23 @@
;; To always save modified buffers before displaying the file in a browser:
;; (setq browse-url-save-file t)
-;; To invoke different browsers for different URLs:
-;; (setq browse-url-browser-function '(("^mailto:" . browse-url-mail)
-;; ("." . browse-url-firefox)))
+;; To invoke different browsers/tools for different URLs, customize
+;; `browse-url-handlers'. In earlier versions of Emacs, the same
+;; could be done by setting `browse-url-browser-function' to an alist
+;; but this usage is deprecated now.
+
+;; All browser functions provided by here have a
+;; `browse-url-browser-kind' symbol property set to either `internal'
+;; or `external' which determines if they browse the given URL inside
+;; Emacs or spawn an external application with it. Some parts of
+;; Emacs make use of that, e.g., when an URL is dragged into Emacs, it
+;; is not sensible to invoke an external browser with it, so here only
+;; internal browsers are considered. Therefore, it is advised to put
+;; that property also on custom browser functions.
+;; (function-put 'my-browse-url-in-emacs 'browse-url-browser-kind
+;; 'internal)
+;; (function-put 'my-browse-url-externally 'browse-url-browser-kind
+;; 'external)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Code:
@@ -140,7 +153,6 @@
(function-item :tag "Google Chrome" :value browse-url-chrome)
(function-item :tag "Chromium" :value browse-url-chromium)
(function-item :tag "Epiphany" :value browse-url-epiphany)
- (function-item :tag "Conkeror" :value browse-url-conkeror)
(function-item :tag "Text browser in an xterm window"
:value browse-url-text-xterm)
(function-item :tag "Text browser in an Emacs window"
@@ -157,7 +169,9 @@
:value browse-url-default-browser)
(function :tag "Your own function")
(alist :tag "Regexp/function association list"
- :key-type regexp :value-type function)))
+ :key-type regexp :value-type function
+ :format "%{%t%}\n%d%v\n"
+ :doc "Deprecated. Use `browse-url-handlers' instead.")))
;;;###autoload
(defcustom browse-url-browser-function 'browse-url-default-browser
@@ -165,13 +179,8 @@
This is used by the `browse-url-at-point', `browse-url-at-mouse', and
`browse-url-of-file' commands.
-If the value is not a function it should be a list of pairs
-\(REGEXP . FUNCTION). In this case the function called will be the one
-associated with the first REGEXP which matches the current URL. The
-function is passed the URL and any other args of `browse-url'. The last
-regexp should probably be \".\" to specify a default browser.
-
-Also see `browse-url-secondary-browser-function'."
+Also see `browse-url-secondary-browser-function' and
+`browse-url-handlers'."
:type browse-url--browser-defcustom-type
:version "24.1")
@@ -216,7 +225,7 @@ be used instead."
"\\(?:"
;; Match paired parentheses, e.g. in Wikipedia URLs:
;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com
- "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)"
+ "[" chars punct "]+" "(" "[" chars punct "]+" ")"
"\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?"
"\\|"
"[" chars punct "]+" "[" chars "]"
@@ -385,6 +394,8 @@ If non-nil, then open the URL in a new buffer rather than a new window if
:version "25.1"
:type 'boolean)
+(make-obsolete-variable 'browse-url-conkeror-new-window-is-buffer nil "28.1")
+
(defcustom browse-url-galeon-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
@@ -414,35 +425,20 @@ Passing an interactive argument to \\[browse-url], or specific browser
commands reverses the effect of this variable."
:type 'boolean)
-(defcustom browse-url-mosaic-program "xmosaic"
- "The name by which to invoke Mosaic (or mMosaic)."
- :type 'string
- :version "20.3")
-
-(make-obsolete-variable 'browse-url-mosaic-program nil "25.1")
-
-(defcustom browse-url-mosaic-arguments nil
- "A list of strings to pass to Mosaic as arguments."
- :type '(repeat (string :tag "Argument")))
-
-(make-obsolete-variable 'browse-url-mosaic-arguments nil "25.1")
-
-(defcustom browse-url-mosaic-pidfile "~/.mosaicpid"
- "The name of the pidfile created by Mosaic."
- :type 'string)
-
-(make-obsolete-variable 'browse-url-mosaic-pidfile nil "25.1")
-
(defcustom browse-url-conkeror-program "conkeror"
"The name by which to invoke Conkeror."
:type 'string
:version "25.1")
+(make-obsolete-variable 'browse-url-conkeror-program nil "28.1")
+
(defcustom browse-url-conkeror-arguments nil
"A list of strings to pass to Conkeror as arguments."
:version "25.1"
:type '(repeat (string :tag "Argument")))
+(make-obsolete-variable 'browse-url-conkeror-arguments nil "28.1")
+
(defcustom browse-url-filename-alist
`(("^/\\(ftp@\\|anonymous@\\)?\\([^:/]+\\):/*" . "ftp://\\2/")
;; The above loses the username to avoid the browser prompting for
@@ -483,22 +479,6 @@ Used by the `browse-url-of-file' command."
"Hook run after `browse-url-of-file' has asked a browser to load a file."
:type 'hook)
-(defcustom browse-url-CCI-port 3003
- "Port to access XMosaic via CCI.
-This can be any number between 1024 and 65535 but must correspond to
-the value set in the browser."
- :type 'integer)
-
-(make-obsolete-variable 'browse-url-CCI-port nil "25.1")
-
-(defcustom browse-url-CCI-host "localhost"
- "Host to access XMosaic via CCI.
-This should be the host name of the machine running XMosaic with CCI
-enabled. The port number should be set in `browse-url-CCI-port'."
- :type 'string)
-
-(make-obsolete-variable 'browse-url-CCI-host nil "25.1")
-
(defvar browse-url-temp-file-name nil)
(make-variable-buffer-local 'browse-url-temp-file-name)
@@ -595,6 +575,116 @@ down (this *won't* always work)."
"Wrapper command prepended to the Elinks command-line."
:type '(repeat (string :tag "Wrapper")))
+(defun browse-url--browser-kind (function url)
+ "Return the browser kind of a browser FUNCTION for URL.
+The browser kind is either `internal' (the browser runs inside
+Emacs), `external' (the browser is spawned in an external
+process), or nil (we don't know)."
+ (let ((kind (if (symbolp function)
+ (get function 'browse-url-browser-kind))))
+ (if (functionp kind)
+ (funcall kind url)
+ kind)))
+
+(defun browse-url--mailto (url &rest args)
+ "Call `browse-url-mailto-function' with URL and ARGS."
+ (funcall browse-url-mailto-function url args))
+
+(defun browse-url--browser-kind-mailto (url)
+ (browse-url--browser-kind browse-url-mailto-function url))
+(function-put 'browse-url--mailto 'browse-url-browser-kind
+ #'browse-url--browser-kind-mailto)
+
+(defun browse-url--man (url &rest args)
+ "Call `browse-url-man-function' with URL and ARGS."
+ (funcall browse-url-man-function url args))
+
+(defun browse-url--browser-kind-man (url)
+ (browse-url--browser-kind browse-url-man-function url))
+(function-put 'browse-url--man 'browse-url-browser-kind
+ #'browse-url--browser-kind-man)
+
+(defun browse-url--browser (url &rest args)
+ "Call `browse-url-browser-function' with URL and ARGS."
+ (funcall browse-url-browser-function url args))
+
+(defun browse-url--browser-kind-browser (url)
+ (browse-url--browser-kind browse-url-browser-function url))
+(function-put 'browse-url--browser 'browse-url-browser-kind
+ #'browse-url--browser-kind-browser)
+
+(defun browse-url--non-html-file-url-p (url)
+ "Return non-nil if URL is a file:// URL of a non-HTML file."
+ (and (string-match-p "\\`file://" url)
+ (not (string-match-p "\\`file://.*\\.html?\\b" url))))
+
+;;;###autoload
+(defvar browse-url-default-handlers
+ '(("\\`mailto:" . browse-url--mailto)
+ ("\\`man:" . browse-url--man)
+ (browse-url--non-html-file-url-p . browse-url-emacs))
+ "Like `browse-url-handlers' but populated by Emacs and packages.
+
+Emacs and external packages capable of browsing certain URLs
+should place their entries in this alist rather than
+`browse-url-handlers' which is reserved for the user.")
+
+(defcustom browse-url-handlers nil
+ "An alist with elements of the form (REGEXP-OR-PREDICATE . HANDLER).
+Each REGEXP-OR-PREDICATE is matched against the URL to be opened
+in turn and the first match's HANDLER is invoked with the URL.
+
+A HANDLER must be a function with the same arguments as
+`browse-url'.
+
+If no REGEXP-OR-PREDICATE matches, the same procedure is
+performed with the value of `browse-url-default-handlers'. If
+there is also no match, the URL is opened using the value of
+`browse-url-browser-function'."
+ :type '(alist :key-type (choice
+ (regexp :tag "Regexp")
+ (function :tag "Predicate"))
+ :value-type (function :tag "Handler"))
+ :version "28.1")
+
+;;;###autoload
+(defun browse-url-select-handler (url &optional kind)
+ "Return a handler of suitable for browsing URL.
+This searches `browse-url-handlers', and
+`browse-url-default-handlers' for a matching handler. Return nil
+if no handler is found.
+
+If KIND is given, the search is restricted to handlers whose
+function symbol has the symbol-property `browse-url-browser-kind'
+set to KIND.
+
+Currently, it also consults `browse-url-browser-function' first
+if it is set to an alist, although this usage is deprecated since
+Emacs 28.1 and will be removed in a future release."
+ (catch 'custom-url-handler
+ (dolist (rxpred-handler
+ (append
+ ;; The alist choice of browse-url-browser-function
+ ;; is deprecated since 28.1, so the (unless ...)
+ ;; can be removed at some point in time.
+ (when (and (consp browse-url-browser-function)
+ (not (functionp browse-url-browser-function)))
+ (lwarn 'browse-url :warning
+ "Having `browse-url-browser-function' set to an
+alist is deprecated. Use `browse-url-handlers' instead.")
+ browse-url-browser-function)
+ browse-url-handlers
+ browse-url-default-handlers))
+ (let ((rx-or-pred (car rxpred-handler))
+ (handler (cdr rxpred-handler)))
+ (when (and (or (null kind)
+ (eq kind (browse-url--browser-kind
+ handler url)))
+ (if (functionp rx-or-pred)
+ (funcall rx-or-pred url)
+ (string-match-p rx-or-pred url)))
+ (throw 'custom-url-handler handler))))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL encoding
@@ -729,8 +819,8 @@ narrowed."
(browse-url-of-file file-name))))
(defun browse-url-delete-temp-file (&optional temp-file-name)
- ;; Delete browse-url-temp-file-name from the file system
- ;; If optional arg TEMP-FILE-NAME is non-nil, delete it instead
+ "Delete `browse-url-temp-file-name' from the file system.
+If optional arg TEMP-FILE-NAME is non-nil, delete it instead."
(let ((file-name (or temp-file-name browse-url-temp-file-name)))
(if (and file-name (file-exists-p file-name))
(delete-file file-name))))
@@ -768,16 +858,18 @@ narrowed."
"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.
-The variable `browse-url-browser-function' says which browser function to
-use. If the URL is a mailto: URL, consult `browse-url-mailto-function'
-first, if that exists.
-
-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 significance of ARGS (most of the functions
-ignore it).
-If ARGS are omitted, the default is to pass `browse-url-new-window-flag'
-as ARGS."
+
+The variables `browse-url-browser-function',
+`browse-url-handlers', and `browse-url-default-handlers'
+determine which browser function to use.
+
+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
+significance of ARGS (most of the functions ignore it).
+
+If ARGS are omitted, the default is to pass
+`browse-url-new-window-flag' as ARGS."
(interactive (browse-url-interactive-arg "URL: "))
(unless (called-interactively-p 'interactive)
(setq args (or args (list browse-url-new-window-flag))))
@@ -786,12 +878,9 @@ as ARGS."
(not (string-match "\\`[a-z]+:" url)))
(setq url (expand-file-name url)))
(let ((process-environment (copy-sequence process-environment))
- (function (or (and (string-match "\\`mailto:" url)
- browse-url-mailto-function)
- (and (string-match "\\`man:" url)
- browse-url-man-function)
- browse-url-browser-function))
- ;; Ensure that `default-directory' exists and is readable (b#6077).
+ (function (or (browse-url-select-handler url)
+ browse-url-browser-function))
+ ;; Ensure that `default-directory' exists and is readable (bug#6077).
(default-directory (or (unhandled-file-name-directory default-directory)
(expand-file-name "~/"))))
;; When connected to various displays, be careful to use the display of
@@ -799,20 +888,9 @@ as ARGS."
;; which may not even exist any more.
(if (stringp (frame-parameter nil 'display))
(setenv "DISPLAY" (frame-parameter nil 'display)))
- (if (and (consp function)
- (not (functionp function)))
- ;; The `function' can be an alist; look down it for first match
- ;; and apply the function (which might be a lambda).
- (catch 'done
- (dolist (bf function)
- (when (string-match (car bf) url)
- (apply (cdr bf) url args)
- (throw 'done t)))
- (error "No browse-url-browser-function matching URL %s"
- url))
- ;; Unbound symbols go down this leg, since void-function from
- ;; apply is clearer than wrong-type-argument from dolist.
- (apply function url args))))
+ (if (functionp function)
+ (apply function url args)
+ (error "No suitable browser for URL %s" url))))
;;;###autoload
(defun browse-url-at-point (&optional arg)
@@ -829,6 +907,34 @@ Optional prefix argument ARG non-nil inverts the value of the option
(error "No URL found"))))
;;;###autoload
+(defun browse-url-with-browser-kind (kind url &optional arg)
+ "Browse URL with a browser of the given browser KIND.
+KIND is either `internal' or `external'.
+
+When called interactively, the default browser kind is the
+opposite of the browser kind of `browse-url-browser-function'."
+ (interactive
+ (let* ((url-arg (browse-url-interactive-arg "URL: "))
+ ;; Default to the inverse kind of the default browser.
+ (default (if (eq (browse-url--browser-kind
+ browse-url-browser-function (car url-arg))
+ 'internal)
+ 'external
+ 'internal))
+ (k (intern (completing-read
+ (format-prompt "Browser kind" default)
+ '(internal external)
+ nil t nil nil
+ default))))
+ (cons k url-arg)))
+ (let ((function (browse-url-select-handler url kind)))
+ (unless function
+ (setq function (if (eq kind 'external)
+ #'browse-url-default-browser
+ #'eww)))
+ (funcall function url arg)))
+
+;;;###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
@@ -875,12 +981,18 @@ The optional NEW-WINDOW argument is not used."
(url-unhex-string url)
url)))))
+(function-put 'browse-url-default-windows-browser 'browse-url-browser-kind
+ 'external)
+
(defun browse-url-default-macosx-browser (url &optional _new-window)
"Invoke the macOS system's default Web browser.
The optional NEW-WINDOW argument is not used."
(interactive (browse-url-interactive-arg "URL: "))
(start-process (concat "open " url) nil "open" url))
+(function-put 'browse-url-default-macosx-browser 'browse-url-browser-kind
+ 'external)
+
;; --- Netscape ---
(defun browse-url-process-environment ()
@@ -928,8 +1040,6 @@ instead of `browse-url-new-window-flag'."
;;; ((executable-find browse-url-galeon-program) 'browse-url-galeon)
((executable-find browse-url-kde-program) 'browse-url-kde)
;;; ((executable-find browse-url-netscape-program) 'browse-url-netscape)
-;;; ((executable-find browse-url-mosaic-program) 'browse-url-mosaic)
- ((executable-find browse-url-conkeror-program) 'browse-url-conkeror)
((executable-find browse-url-chrome-program) 'browse-url-chrome)
((executable-find browse-url-xterm-program) 'browse-url-text-xterm)
((locate-library "w3") 'browse-url-w3)
@@ -937,6 +1047,10 @@ instead of `browse-url-new-window-flag'."
(lambda (&rest _ignore) (error "No usable browser found"))))
url args))
+(function-put 'browse-url-default-browser 'browse-url-browser-kind
+ ;; Well, most probably external if we ignore w3.
+ 'external)
+
(defun browse-url-can-use-xdg-open ()
"Return non-nil if the \"xdg-open\" program can be used.
xdg-open is a desktop utility that calls your preferred web browser."
@@ -956,6 +1070,8 @@ The optional argument IGNORED is not used."
(interactive (browse-url-interactive-arg "URL: "))
(call-process "xdg-open" nil 0 nil url))
+(function-put 'browse-url-xdg-open 'browse-url-browser-kind 'external)
+
;;;###autoload
(defun browse-url-netscape (url &optional new-window)
"Ask the Netscape WWW browser to load URL.
@@ -999,6 +1115,8 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-netscape-sentinel process ,url)))))
+(function-put 'browse-url-netscape 'browse-url-browser-kind 'external)
+
(defun browse-url-netscape-sentinel (process url)
"Handle a change to the process communicating with Netscape."
(declare (obsolete nil "25.1"))
@@ -1069,6 +1187,8 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-mozilla-sentinel process ,url)))))
+(function-put 'browse-url-mozilla 'browse-url-browser-kind 'external)
+
(defun browse-url-mozilla-sentinel (process url)
"Handle a change to the process communicating with Mozilla."
(or (eq (process-exit-status process) 0)
@@ -1109,6 +1229,8 @@ instead of `browse-url-new-window-flag'."
'("-new-window")))
(list url)))))
+(function-put 'browse-url-firefox 'browse-url-browser-kind 'external)
+
;;;###autoload
(defun browse-url-chromium (url &optional _new-window)
"Ask the Chromium WWW browser to load URL.
@@ -1126,6 +1248,8 @@ The optional argument NEW-WINDOW is not used."
browse-url-chromium-arguments
(list url)))))
+(function-put 'browse-url-chromium 'browse-url-browser-kind 'external)
+
(defun browse-url-chrome (url &optional _new-window)
"Ask the Google Chrome WWW browser to load URL.
Default to the URL around or before point. The strings in
@@ -1142,6 +1266,8 @@ The optional argument NEW-WINDOW is not used."
browse-url-chrome-arguments
(list url)))))
+(function-put 'browse-url-chrome 'browse-url-browser-kind 'external)
+
;;;###autoload
(defun browse-url-galeon (url &optional new-window)
"Ask the Galeon WWW browser to load URL.
@@ -1179,6 +1305,8 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-galeon-sentinel process ,url)))))
+(function-put 'browse-url-galeon 'browse-url-browser-kind 'external)
+
(defun browse-url-galeon-sentinel (process url)
"Handle a change to the process communicating with Galeon."
(declare (obsolete nil "25.1"))
@@ -1225,6 +1353,8 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-epiphany-sentinel process ,url)))))
+(function-put 'browse-url-epiphany 'browse-url-browser-kind 'external)
+
(defun browse-url-epiphany-sentinel (process url)
"Handle a change to the process communicating with Epiphany."
(or (eq (process-exit-status process) 0)
@@ -1249,6 +1379,8 @@ currently selected window instead."
file-name-handler-alist)))
(if same-window (find-file url) (find-file-other-window url))))
+(function-put 'browse-url-emacs 'browse-url-browser-kind 'internal)
+
;;;###autoload
(defun browse-url-gnome-moz (url &optional new-window)
"Ask Mozilla/Netscape to load URL via the GNOME program `gnome-moz-remote'.
@@ -1273,88 +1405,7 @@ used instead of `browse-url-new-window-flag'."
'("--newwin"))
(list "--raise" url))))
-;; --- Mosaic ---
-
-;;;###autoload
-(defun browse-url-mosaic (url &optional new-window)
- "Ask the XMosaic WWW browser to load URL.
-
-Default to the URL around or before point. The strings in variable
-`browse-url-mosaic-arguments' are also passed to Mosaic and the
-program is invoked according to the variable
-`browse-url-mosaic-program'.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Mosaic window, otherwise use a
-random existing one. A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-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 "Mosaic URL: "))
- (let ((pidfile (expand-file-name browse-url-mosaic-pidfile))
- pid)
- (if (file-readable-p pidfile)
- (with-temp-buffer
- (insert-file-contents pidfile)
- (setq pid (read (current-buffer)))))
- (if (and (integerp pid) (zerop (signal-process pid 0))) ; Mosaic running
- (progn
- (with-temp-buffer
- (insert (if (browse-url-maybe-new-window new-window)
- "newwin\n"
- "goto\n")
- url "\n")
- (with-file-modes ?\700
- (if (file-exists-p
- (setq pidfile (format "/tmp/Mosaic.%d" pid)))
- (delete-file pidfile))
- ;; https://debbugs.gnu.org/17428. Use O_EXCL.
- (write-region nil nil pidfile nil 'silent nil 'excl)))
- ;; Send signal SIGUSR to Mosaic
- (message "Signaling Mosaic...")
- (signal-process pid 'SIGUSR1)
- ;; Or you could try:
- ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid))
- (message "Signaling Mosaic...done"))
- ;; Mosaic not running - start it
- (message "Starting %s..." browse-url-mosaic-program)
- (apply 'start-process "xmosaic" nil browse-url-mosaic-program
- (append browse-url-mosaic-arguments (list url)))
- (message "Starting %s...done" browse-url-mosaic-program))))
-
-;; --- Mosaic using CCI ---
-
-;;;###autoload
-(defun browse-url-cci (url &optional new-window)
- "Ask the XMosaic WWW browser to load URL.
-Default to the URL around or before point.
-
-This function only works for XMosaic version 2.5 or later. You must
-select `CCI' from XMosaic's File menu, set the CCI Port Address to the
-value of variable `browse-url-CCI-port', and enable `Accept requests'.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new browser window, otherwise use a
-random existing one. A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-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 "Mosaic URL: "))
- (open-network-stream "browse-url" " *browse-url*"
- browse-url-CCI-host browse-url-CCI-port)
- ;; Todo: start browser if fails
- (process-send-string "browse-url"
- (concat "get url (" url ") output "
- (if (browse-url-maybe-new-window new-window)
- "new"
- "current")
- "\r\n"))
- (process-send-string "browse-url" "disconnect\r\n")
- (delete-process "browse-url"))
+(function-put 'browse-url-gnome-moz 'browse-url-browser-kind 'external)
;; --- Conkeror ---
;;;###autoload
@@ -1375,6 +1426,7 @@ new window, load it in a new buffer in an existing window instead.
When called non-interactively, use optional second argument
NEW-WINDOW instead of `browse-url-new-window-flag'."
+ (declare (obsolete nil "28.1"))
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment)))
@@ -1392,6 +1444,9 @@ NEW-WINDOW instead of `browse-url-new-window-flag'."
"window")
"buffer")
url))))))
+
+(function-put 'browse-url-conkeror 'browse-url-browser-kind 'external)
+
;; --- W3 ---
;; External.
@@ -1415,6 +1470,8 @@ used instead of `browse-url-new-window-flag'."
(w3-fetch-other-window url)
(w3-fetch url)))
+(function-put 'browse-url-w3 'browse-url-browser-kind 'internal)
+
;;;###autoload
(defun browse-url-w3-gnudoit (url &optional _new-window)
;; new-window ignored
@@ -1429,6 +1486,8 @@ The `browse-url-gnudoit-program' program is used with options given by
(list (concat "(w3-fetch \"" url "\")")
"(raise-frame)"))))
+(function-put 'browse-url-w3-gnudoit 'browse-url-browser-kind 'internal)
+
;; --- Lynx in an xterm ---
;;;###autoload
@@ -1446,6 +1505,8 @@ The optional argument NEW-WINDOW is not used."
,@browse-url-xterm-args "-e" ,browse-url-text-browser
,url)))
+(function-put 'browse-url-text-xterm 'browse-url-browser-kind 'external)
+
;; --- Lynx in an Emacs "term" window ---
(declare-function term-char-mode "term" ())
@@ -1520,6 +1581,8 @@ used instead of `browse-url-new-window-flag'."
url
"\r")))))
+(function-put 'browse-url-text-emacs 'browse-url-browser-kind 'internal)
+
;; --- mailto ---
(autoload 'rfc2368-parse-mailto-url "rfc2368")
@@ -1567,6 +1630,8 @@ used instead of `browse-url-new-window-flag'."
(unless (bolp)
(insert "\n"))))))))
+(function-put 'browse-url-mail 'browse-url-browser-kind 'internal)
+
;; --- man ---
(defvar manual-program)
@@ -1578,7 +1643,9 @@ used instead of `browse-url-new-window-flag'."
(setq url (replace-regexp-in-string "\\`man:" "" url))
(cond
((executable-find manual-program) (man url))
- (t (woman (replace-regexp-in-string "([[:alnum:]]+)" "" url)))))
+ (t (woman (replace-regexp-in-string "([[:alnum:]]+)" "" url)))))
+
+(function-put 'browse-url-man 'browse-url-browser-kind 'internal)
;; --- Random browser ---
@@ -1597,6 +1664,8 @@ don't offer a form of remote control."
0 nil
(append browse-url-generic-args (list url))))
+(function-put 'browse-url-generic 'browse-url-browser-kind 'external)
+
;;;###autoload
(defun browse-url-kde (url &optional _new-window)
"Ask the KDE WWW browser to load URL.
@@ -1607,6 +1676,8 @@ The optional argument NEW-WINDOW is not used."
(apply #'start-process (concat "KDE " url) nil browse-url-kde-program
(append browse-url-kde-args (list url))))
+(function-put 'browse-url-kde 'browse-url-browser-kind 'external)
+
(defun browse-url-elinks-new-window (url)
"Ask the Elinks WWW browser to load URL in a new window."
(let ((process-environment (browse-url-process-environment)))
@@ -1616,6 +1687,9 @@ The optional argument NEW-WINDOW is not used."
browse-url-elinks-wrapper
(list "elinks" url)))))
+(function-put 'browse-url-elinks-new-window 'browse-url-browser-kind
+ 'external)
+
;;;###autoload
(defun browse-url-elinks (url &optional new-window)
"Ask the Elinks WWW browser to load URL.
@@ -1637,6 +1711,8 @@ from `browse-url-elinks-wrapper'."
`(lambda (process change)
(browse-url-elinks-sentinel process ,url))))))
+(function-put 'browse-url-elinks 'browse-url-browser-kind 'external)
+
(defun browse-url-elinks-sentinel (process url)
"Determines if Elinks is running or a new one has to be started."
;; Try to determine if an instance is running or if we have to
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index cafbfa73c15..48712a9c3d8 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -51,11 +51,16 @@
(unless (boundp 'dbus-debug)
(defvar dbus-debug nil))
-;; Pacify byte compiler.
-(eval-when-compile (require 'cl-lib))
-
+(require 'cl-lib)
+(require 'seq)
+(require 'subr-x)
(require 'xml)
+;;; D-Bus constants.
+
+(defconst dbus-compound-types '(:array :variant :struct :dict-entry)
+ "D-Bus compound types, represented as list.")
+
(defconst dbus-service-dbus "org.freedesktop.DBus"
"The bus name used to talk to the bus itself.")
@@ -65,7 +70,8 @@
(defconst dbus-path-local (concat dbus-path-dbus "/Local")
"The object path used in local/in-process-generated messages.")
-;; Default D-Bus interfaces.
+
+;;; Default D-Bus interfaces.
(defconst dbus-interface-dbus "org.freedesktop.DBus"
"The interface exported by the service `dbus-service-dbus'.")
@@ -139,6 +145,17 @@ See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#standard-inter
;; </signal>
;; </interface>
+(defconst dbus-interface-monitoring (concat dbus-interface-dbus ".Monitoring")
+ "The monitoring interface.
+See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#bus-messages-become-monitor'.")
+
+;; <interface name="org.freedesktop.DBus.Monitoring">
+;; <method name="BecomeMonitor">
+;; <arg name="rule" type="as" direction="in"/>
+;; <arg name="flags" type="u" direction="in"/> ;; Not used, must be 0.
+;; </method>
+;; </interface>
+
(defconst dbus-interface-local (concat dbus-interface-dbus ".Local")
"An interface whose methods can only be invoked by the local implementation.")
@@ -148,7 +165,60 @@ See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#standard-inter
;; </signal>
;; </interface>
-;; Emacs defaults.
+(defconst dbus-annotation-deprecated (concat dbus-interface-dbus ".Deprecated")
+ "An annotation indicating a deprecated interface, method, signal, or property.")
+
+
+;;; Default D-Bus errors.
+
+(defgroup dbus nil
+ "Elisp bindings for D-Bus."
+ :group 'comm
+ :link '(custom-manual "(dbus)Top")
+ :version "28.1")
+
+(defconst dbus-error-dbus "org.freedesktop.DBus.Error"
+ "The namespace for default error names.
+See /usr/include/dbus-1.0/dbus/dbus-protocol.h.")
+
+(defconst dbus-error-access-denied (concat dbus-error-dbus ".AccessDenied")
+ "Security restrictions don't allow doing what you're trying to do.")
+
+(defconst dbus-error-disconnected (concat dbus-error-dbus ".Disconnected")
+ "The connection is disconnected and you're trying to use it.")
+
+(defconst dbus-error-failed (concat dbus-error-dbus ".Failed")
+ "A generic error; \"something went wrong\" - see the error message for more.")
+
+(defconst dbus-error-invalid-args (concat dbus-error-dbus ".InvalidArgs")
+ "Invalid arguments passed to a method call.")
+
+(defconst dbus-error-no-reply (concat dbus-error-dbus ".NoReply")
+ "No reply to a message expecting one, usually means a timeout occurred.")
+
+(defconst dbus-error-property-read-only
+ (concat dbus-error-dbus ".PropertyReadOnly")
+ "Property you tried to set is read-only.")
+
+(defconst dbus-error-service-unknown (concat dbus-error-dbus ".ServiceUnknown")
+ "The bus doesn't know how to launch a service to supply the bus name you wanted.")
+
+(defconst dbus-error-unknown-interface
+ (concat dbus-error-dbus ".UnknownInterface")
+ "Interface you invoked a method on isn't known by the object.")
+
+(defconst dbus-error-unknown-method (concat dbus-error-dbus ".UnknownMethod")
+ "Method name you invoked isn't known by the object you invoked it on.")
+
+(defconst dbus-error-unknown-object (concat dbus-error-dbus ".UnknownObject")
+ "Object you invoked a method on isn't known.")
+
+(defconst dbus-error-unknown-property (concat dbus-error-dbus ".UnknownProperty")
+ "Property you tried to access isn't known by the object.")
+
+
+;;; Emacs defaults.
+
(defconst dbus-service-emacs "org.gnu.Emacs"
"The well known service name of Emacs.")
@@ -160,7 +230,8 @@ shall be subdirectories of this path.")
(defconst dbus-interface-emacs "org.gnu.Emacs"
"The interface namespace used by Emacs.")
-;; D-Bus constants.
+
+;;; Basic D-Bus message functions.
(defmacro dbus-ignore-errors (&rest body)
"Execute BODY; signal D-Bus error when `dbus-debug' is non-nil.
@@ -169,22 +240,16 @@ Otherwise, return result of last form in BODY, or all other errors."
`(condition-case err
(progn ,@body)
(dbus-error (when dbus-debug (signal (car err) (cdr err))))))
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<dbus-ignore-errors\\>"))
-(define-obsolete-variable-alias 'dbus-event-error-hooks
- 'dbus-event-error-functions "24.3")
(defvar dbus-event-error-functions '(dbus-notice-synchronous-call-errors)
"Functions to be called when a D-Bus error happens in the event handler.
Every function must accept two arguments, the event and the error variable
caught in `condition-case' by `dbus-error'.")
-
-;;; Basic D-Bus message functions.
-
-(defvar dbus-return-values-table (make-hash-table :test 'equal)
+(defvar dbus-return-values-table (make-hash-table :test #'equal)
"Hash table for temporarily storing arguments of reply messages.
A key in this hash table is a list (:serial BUS SERIAL), like in
-`dbus-registered-objects-table'. BUS is either a Lisp symbol,
+`dbus-registered-objects-table'. BUS is either a Lisp keyword,
`:system' or `:session', or a string denoting the bus address.
SERIAL is the serial number of the reply message.
@@ -218,8 +283,8 @@ The result will be made available in `dbus-return-values-table'."
(defun dbus-call-method (bus service path interface method &rest args)
"Call METHOD on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name to be used. PATH is the D-Bus
object path SERVICE is registered at. INTERFACE is an interface
@@ -240,8 +305,8 @@ converted into D-Bus types via the following rules:
string => DBUS_TYPE_STRING
list => DBUS_TYPE_ARRAY
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
+All arguments can be preceded by a type keyword. For details
+about type keywords, see Info node `(dbus)Type Conversion'.
`dbus-call-method' returns the resulting values of METHOD as a list of
Lisp objects. The type conversion happens the other direction as for
@@ -286,7 +351,8 @@ object is returned instead of a list containing this single Lisp object.
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
@@ -301,8 +367,8 @@ object is returned instead of a list containing this single Lisp object.
(check-interval 0.001)
(key
(apply
- 'dbus-message-internal dbus-message-type-method-call
- bus service path interface method 'dbus-call-method-handler args))
+ #'dbus-message-internal dbus-message-type-method-call
+ bus service path interface method #'dbus-call-method-handler args))
(result (cons :pending nil)))
;; Wait until `dbus-call-method-handler' has put the result into
@@ -319,35 +385,32 @@ object is returned instead of a list containing this single Lisp object.
(puthash key result dbus-return-values-table)
(unwind-protect
- (progn
- (with-timeout ((if timeout (/ timeout 1000.0) 25)
- (signal 'dbus-error (list "call timed out")))
- (while (eq (car result) :pending)
- (let ((event (let ((inhibit-redisplay t) unread-command-events)
- (read-event nil nil check-interval))))
- (when event
- (if (ignore-errors (dbus-check-event event))
- (setf result (gethash key dbus-return-values-table))
- (setf unread-command-events
- (nconc unread-command-events
- (cons event nil)))))
- (when (< check-interval 1)
- (setf check-interval (* check-interval 1.05))))))
- (when (eq (car result) :error)
- (signal (cadr result) (cddr result)))
- (cdr result))
+ (progn
+ (with-timeout
+ ((if timeout (/ timeout 1000.0) 25)
+ (signal 'dbus-error `(,dbus-error-no-reply "Call timed out")))
+ (while (eq (car result) :pending)
+ (let ((event (let ((inhibit-redisplay t) unread-command-events)
+ (read-event nil nil check-interval))))
+ (when event
+ (if (ignore-errors (dbus-check-event event))
+ (setf result (gethash key dbus-return-values-table))
+ (setf unread-command-events
+ (nconc unread-command-events
+ (cons event nil)))))
+ (when (< check-interval 1)
+ (setf check-interval (* check-interval 1.05))))))
+ (when (eq (car result) :error)
+ (signal (cadr result) (cddr result)))
+ (cdr result))
(remhash key dbus-return-values-table))))
-;; `dbus-call-method' works non-blocking now.
-(defalias 'dbus-call-method-non-blocking 'dbus-call-method)
-(make-obsolete 'dbus-call-method-non-blocking 'dbus-call-method "24.3")
-
(defun dbus-call-method-asynchronously
(bus service path interface method handler &rest args)
"Call METHOD on the D-Bus BUS asynchronously.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name to be used. PATH is the D-Bus
object path SERVICE is registered at. INTERFACE is an interface
@@ -372,8 +435,8 @@ converted into D-Bus types via the following rules:
string => DBUS_TYPE_STRING
list => DBUS_TYPE_ARRAY
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
+All arguments can be preceded by a type keyword. For details
+about type keywords, see Info node `(dbus)Type Conversion'.
If HANDLER is a Lisp function, the function returns a key into the
hash table `dbus-registered-objects-table'. The corresponding entry
@@ -384,7 +447,7 @@ Example:
\(dbus-call-method-asynchronously
:system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
- \"org.freedesktop.Hal.Device\" \"GetPropertyString\" \\='message
+ \"org.freedesktop.Hal.Device\" \"GetPropertyString\" #\\='message
\"system.kernel.machine\")
-| i686
@@ -393,7 +456,8 @@ Example:
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
@@ -406,15 +470,15 @@ Example:
(or (null handler) (functionp handler)
(signal 'wrong-type-argument (list 'functionp handler)))
- (apply 'dbus-message-internal dbus-message-type-method-call
+ (apply #'dbus-message-internal dbus-message-type-method-call
bus service path interface method handler args))
(defun dbus-send-signal (bus service path interface signal &rest args)
"Send signal SIGNAL on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. The signal is sent from the D-Bus object
-Emacs is registered at BUS.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address. The signal is sent from the
+D-Bus object Emacs is registered at BUS.
SERVICE is the D-Bus name SIGNAL is sent to. It can be either a known
name or a unique name. If SERVICE is nil, the signal is sent as
@@ -432,8 +496,8 @@ converted into D-Bus types via the following rules:
string => DBUS_TYPE_STRING
list => DBUS_TYPE_ARRAY
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
+All arguments can be preceded by a type keyword. For details
+about type keywords, see Info node `(dbus)Type Conversion'.
Example:
@@ -443,7 +507,8 @@ Example:
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (null service) (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
@@ -454,7 +519,7 @@ Example:
(or (stringp signal)
(signal 'wrong-type-argument (list 'stringp signal)))
- (apply 'dbus-message-internal dbus-message-type-signal
+ (apply #'dbus-message-internal dbus-message-type-signal
bus service path interface signal args))
(defun dbus-method-return-internal (bus service serial &rest args)
@@ -463,31 +528,50 @@ This is an internal function, it shall not be used outside dbus.el."
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
(or (natnump serial)
(signal 'wrong-type-argument (list 'natnump serial)))
- (apply 'dbus-message-internal dbus-message-type-method-return
+ (apply #'dbus-message-internal dbus-message-type-method-return
bus service serial args))
-(defun dbus-method-error-internal (bus service serial &rest args)
+(defun dbus-method-error-internal (bus service serial error-name &rest args)
"Return error message for message SERIAL on the D-Bus BUS.
+ERROR-NAME must belong to the \"org.freedesktop.DBus.Error\" namespace.
This is an internal function, it shall not be used outside dbus.el."
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
(or (natnump serial)
(signal 'wrong-type-argument (list 'natnump serial)))
- (apply 'dbus-message-internal dbus-message-type-error
- bus service serial args))
+ (apply #'dbus-message-internal dbus-message-type-error
+ bus service serial error-name args))
+
+(defun dbus-check-arguments (bus service &rest args)
+ "Check arguments ARGS by side effect.
+BUS, SERVICE and ARGS have the same format as in `dbus-call-method'.
+Any wrong argument triggers a D-Bus error. Otherwise, return t.
+This is an internal function, it shall not be used outside dbus.el."
+
+ (or (featurep 'dbusbind)
+ (signal 'dbus-error (list "Emacs not compiled with dbus support")))
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
+ (signal 'wrong-type-argument (list 'keywordp bus)))
+ (or (stringp service)
+ (signal 'wrong-type-argument (list 'stringp service)))
+
+ (apply #'dbus-message-internal dbus-message-type-invalid bus service args))
;;; Hash table of registered functions.
@@ -506,8 +590,9 @@ hash table."
(defun dbus-setenv (bus variable value)
"Set the value of the BUS environment variable named VARIABLE to VALUE.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. Both VARIABLE and VALUE should be strings.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address. Both VARIABLE and VALUE should
+be strings.
Normally, services inherit the environment of the BUS daemon. This
function adds to or modifies that environment when activating services.
@@ -521,8 +606,8 @@ Some bus instances, such as `:system', may disable setting the environment."
(defun dbus-register-service (bus service &rest flags)
"Register known name SERVICE on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name that should be registered. It must
be a known name.
@@ -553,12 +638,13 @@ placed in the queue.
;; Add Peer handler.
(dbus-register-method
- bus service nil dbus-interface-peer "Ping" 'dbus-peer-handler 'dont-register)
+ bus service nil dbus-interface-peer "Ping"
+ #'dbus-peer-handler 'dont-register)
;; Add ObjectManager handler.
(dbus-register-method
bus service nil dbus-interface-objectmanager "GetManagedObjects"
- 'dbus-managed-objects-handler 'dont-register)
+ #'dbus-managed-objects-handler 'dont-register)
(let ((arg 0)
reply)
@@ -582,8 +668,9 @@ placed in the queue.
(defun dbus-unregister-service (bus service)
"Unregister all objects related to SERVICE from D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. SERVICE must be a known service name.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address. SERVICE must be a known service
+name.
The function returns a keyword, indicating the result of the
operation. One of the following keywords is returned:
@@ -597,7 +684,7 @@ queue of this service."
(maphash
(lambda (key value)
- (unless (equal :serial (car key))
+ (unless (eq :serial (car key))
(dolist (elt value)
(ignore-errors
(when (and (equal bus (cadr key)) (string-equal service (cadr elt)))
@@ -618,8 +705,8 @@ queue of this service."
(bus service path interface signal handler &rest args)
"Register for a signal on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name used by the sending D-Bus object.
It can be either a known name or the unique name of the D-Bus object
@@ -662,7 +749,7 @@ Example:
\(dbus-register-signal
:system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\"
- \"org.freedesktop.Hal.Manager\" \"DeviceAdded\" \\='my-signal-handler)
+ \"org.freedesktop.Hal.Manager\" \"DeviceAdded\" #\\='my-signal-handler)
=> ((:signal :system \"org.freedesktop.Hal.Manager\" \"DeviceAdded\")
(\"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\" my-signal-handler))
@@ -681,7 +768,7 @@ Example:
(if (and (stringp service)
(not (zerop (length service)))
(not (string-equal service dbus-service-dbus))
- (not (string-match "^:" service)))
+ (/= (string-to-char service) ?:))
(setq uname (dbus-get-name-owner bus service))
(setq uname service))
@@ -710,7 +797,7 @@ Example:
;; `:arg0' .. `:arg63', `:path0' .. `:path63'.
((and (keywordp key)
(string-match
- "^:\\(arg\\|path\\)\\([[:digit:]]+\\)$"
+ "\\`:\\(arg\\|path\\)\\([[:digit:]]+\\)\\'"
(symbol-name key)))
(setq counter (match-string 2 (symbol-name key))
args (cdr args)
@@ -726,9 +813,7 @@ Example:
"path" "")
value))
;; `:arg-namespace', `:path-namespace'.
- ((and (keywordp key)
- (string-match
- "^:\\(arg\\|path\\)-namespace$" (symbol-name key)))
+ ((memq key '(:arg-namespace :path-namespace))
(setq args (cdr args)
value (car args))
(unless (stringp value)
@@ -736,8 +821,7 @@ Example:
(list "Wrong argument" key value)))
(format
",%s='%s'"
- (if (string-equal (match-string 1 (symbol-name key)) "path")
- "path_namespace" "arg0namespace")
+ (if (eq key :path-namespace) "path_namespace" "arg0namespace")
value))
;; `:eavesdrop'.
((eq key :eavesdrop)
@@ -751,11 +835,11 @@ Example:
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
"AddMatch" rule)
(dbus-error
- (if (not (string-match "eavesdrop" rule))
+ (if (not (string-match-p "eavesdrop" rule))
(signal (car err) (cdr err))
;; The D-Bus spec says we shall fall back to a rule without eavesdrop.
(when dbus-debug (message "Removing eavesdrop from rule %s" rule))
- (setq rule (replace-regexp-in-string ",eavesdrop='true'" "" rule))
+ (setq rule (replace-regexp-in-string ",eavesdrop='true'" "" rule t t))
(dbus-call-method
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
"AddMatch" rule))))
@@ -776,8 +860,8 @@ Example:
(bus service path interface method handler &optional dont-register-service)
"Register METHOD on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name of the D-Bus object METHOD is
registered for. It must be a known name (see discussion of
@@ -788,10 +872,18 @@ discussion of DONT-REGISTER-SERVICE below). INTERFACE is the
interface offered by SERVICE. It must provide METHOD.
HANDLER is a Lisp function to be called when a method call is
-received. It must accept the input arguments of METHOD. The return
-value of HANDLER is used for composing the returning D-Bus message.
-If HANDLER returns a reply message with an empty argument list,
-HANDLER must return the symbol `:ignore'.
+received. It must accept the input arguments of METHOD. The
+return value of HANDLER is used for composing the returning D-Bus
+message. If HANDLER returns a reply message with an empty
+argument list, HANDLER must return the keyword `:ignore' in order
+to distinguish it from nil (the boolean false).
+
+If HANDLER detects an error, it shall return the list `(:error
+ERROR-NAME ERROR-MESSAGE)'. ERROR-NAME is a namespaced string
+which characterizes the error type, and ERROR-MESSAGE is a free
+text string. Alternatively, any Emacs signal `dbus-error' in
+HANDLER raises a D-Bus error message with the error name
+\"org.freedesktop.DBus.Error.Failed\".
When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not
registered. This means that other D-Bus clients have no way of
@@ -869,16 +961,19 @@ association to the service from D-Bus."
(progn
(maphash
(lambda (k v)
- (dolist (e v)
- (ignore-errors
- (and
- ;; Bus.
- (equal bus (cadr k))
- ;; Service.
- (string-equal service (cadr e))
- ;; Non-empty object path.
- (nth 2 e)
- (throw :found t)))))
+ (when (consp v)
+ (dolist (e v)
+ (ignore-errors
+ (and
+ ;; Type.
+ (eq type (car k))
+ ;; Bus.
+ (equal bus (cadr k))
+ ;; Service.
+ (string-equal service (cadr e))
+ ;; Non-empty object path.
+ (nth 2 e)
+ (throw :found t))))))
dbus-registered-objects-table)
nil))))
(dbus-unregister-service bus service))
@@ -893,9 +988,7 @@ association to the service from D-Bus."
STRING shall be UTF-8 coded."
(if (zerop (length string))
'(:array :signature "y")
- (let (result)
- (dolist (elt (string-to-list string) (append '(:array) result))
- (setq result (append result (list :byte elt)))))))
+ (cons :array (mapcan (lambda (c) (list :byte c)) string))))
(defun dbus-byte-array-to-string (byte-array &optional multibyte)
"Transform BYTE-ARRAY into UTF-8 coded string.
@@ -903,12 +996,9 @@ BYTE-ARRAY must be a list of structure (c1 c2 ...), or a byte
array as produced by `dbus-string-to-byte-array'. The resulting
string is unibyte encoded, unless MULTIBYTE is non-nil."
(apply
- (if multibyte 'string 'unibyte-string)
- (if (equal byte-array '(:array :signature "y"))
- nil
- (let (result)
- (dolist (elt byte-array result)
- (when (characterp elt) (setq result (append result `(,elt)))))))))
+ (if multibyte #'string #'unibyte-string)
+ (unless (equal byte-array '(:array :signature "y"))
+ (seq-filter #'characterp byte-array))))
(defun dbus-escape-as-identifier (string)
"Escape an arbitrary STRING so it follows the rules for a C identifier.
@@ -930,9 +1020,9 @@ telepathy-glib's `tp_escape_as_identifier'."
(if (zerop (length string))
"_"
(replace-regexp-in-string
- "^[0-9]\\|[^A-Za-z0-9]"
+ "\\`[0-9]\\|[^A-Za-z0-9]"
(lambda (x) (format "_%2x" (aref x 0)))
- string)))
+ string nil t)))
(defun dbus-unescape-from-identifier (string)
"Retrieve the original string from the encoded STRING as unibyte string.
@@ -942,7 +1032,7 @@ STRING must have been encoded with `dbus-escape-as-identifier'."
(replace-regexp-in-string
"_.."
(lambda (x) (byte-to-string (string-to-number (substring x 1) 16)))
- string)))
+ string nil t)))
;;; D-Bus events.
@@ -951,26 +1041,37 @@ STRING must have been encoded with `dbus-escape-as-identifier'."
"Check whether EVENT is a well formed D-Bus event.
EVENT is a list which starts with symbol `dbus-event':
- (dbus-event BUS TYPE SERIAL SERVICE PATH INTERFACE MEMBER HANDLER &rest ARGS)
+ (dbus-event BUS TYPE SERIAL SERVICE DESTINATION PATH
+ INTERFACE MEMBER HANDLER &rest ARGS)
BUS identifies the D-Bus the message is coming from. It is
-either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. TYPE is the D-Bus message type which
-has caused the event, SERIAL is the serial number of the received
-D-Bus message. SERVICE and PATH are the unique name and the
-object path of the D-Bus object emitting the message. INTERFACE
-and MEMBER denote the message which has been sent. HANDLER is
-the function which has been registered for this message. ARGS
-are the arguments passed to HANDLER, when it is called during
-event handling in `dbus-handle-event'.
+either a Lisp keyword, `:system', `:session', `:systemp-private'
+or `:session-private', or a string denoting the bus address.
+
+TYPE is the D-Bus message type which has caused the event, SERIAL
+is the serial number of the received D-Bus message when TYPE is
+equal `dbus-message-type-method-return' or `dbus-message-type-error'.
+
+SERVICE and PATH are the unique name and the object path of the
+D-Bus object emitting the message. DESTINATION is the D-Bus name
+the message is dedicated to, or nil in case the message is a
+broadcast signal.
+
+INTERFACE and MEMBER denote the message which has been sent.
+When TYPE is `dbus-message-type-error', MEMBER is the error name.
+
+HANDLER is the function which has been registered for this
+message. ARGS are the typed arguments as returned from the
+message. They are passed to HANDLER without type information,
+when it is called during event handling in `dbus-handle-event'.
This function signals a `dbus-error' if the event is not well
formed."
(when dbus-debug (message "DBus-Event %s" event))
(unless (and (listp event)
(eq (car event) 'dbus-event)
- ;; Bus symbol.
- (or (symbolp (nth 1 event))
+ ;; Bus keyword.
+ (or (keywordp (nth 1 event))
(stringp (nth 1 event)))
;; Type.
(and (natnump (nth 2 event))
@@ -982,54 +1083,103 @@ formed."
(= dbus-message-type-error (nth 2 event))
(or (stringp (nth 4 event))
(null (nth 4 event))))
- ;; Object path.
+ ;; Destination.
(or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event))
- (stringp (nth 5 event)))
- ;; Interface.
+ (or (stringp (nth 5 event))
+ (null (nth 5 event))))
+ ;; Object path.
(or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event))
(stringp (nth 6 event)))
- ;; Member.
+ ;; Interface.
(or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event))
(stringp (nth 7 event)))
+ ;; Member.
+ (or (= dbus-message-type-method-return (nth 2 event))
+ (stringp (nth 8 event)))
;; Handler.
- (functionp (nth 8 event)))
+ (functionp (nth 9 event))
+ ;; Arguments.
+ (listp (nthcdr 10 event)))
(signal 'dbus-error (list "Not a valid D-Bus event" event))))
+(defun dbus-delete-types (&rest args)
+ "Delete type information from arguments retrieved via `dbus-handle-event'.
+Basic type arguments (TYPE VALUE) will be transformed into VALUE, and
+compound type arguments (TYPE VALUE) will be transformed into (VALUE)."
+ (car
+ (mapcar
+ (lambda (elt)
+ (cond
+ ((atom elt) elt)
+ ((memq (car elt) dbus-compound-types)
+ (mapcar #'dbus-delete-types (cdr elt)))
+ (t (cadr elt))))
+ args)))
+
+(defun dbus-flatten-types (arg)
+ "Flatten type information from argument retrieved via `dbus-handle-event'.
+Basic type arguments (TYPE VALUE) will be transformed into TYPE VALUE, and
+compound type arguments (TYPE VALUE) will be kept as is."
+ (let (result)
+ (dolist (elt arg)
+ (cond
+ ((atom elt) (push elt result))
+ ((and (not (memq (car elt) dbus-compound-types)))
+ (push (car elt) result)
+ (push (cadr elt) result))
+ (t
+ (push (cons (car elt) (dbus-flatten-types (cdr elt))) result))))
+ (nreverse result)))
+
;;;###autoload
(defun dbus-handle-event (event)
"Handle events from the D-Bus.
EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being
-part of the event, is called with arguments ARGS.
+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."
(interactive "e")
(condition-case err
- (let (result)
+ (let (monitor args result)
;; We ignore not well-formed events.
(dbus-check-event event)
- ;; Error messages must be propagated.
- (when (= dbus-message-type-error (nth 2 event))
- (signal 'dbus-error (nthcdr 9 event)))
- ;; Apply the handler.
- (setq result (apply (nth 8 event) (nthcdr 9 event)))
- ;; Return a message when it is a message call.
- (when (= dbus-message-type-method-call (nth 2 event))
- (dbus-ignore-errors
- (if (eq result :ignore)
- (dbus-method-return-internal
- (nth 1 event) (nth 4 event) (nth 3 event))
- (apply 'dbus-method-return-internal
- (nth 1 event) (nth 4 event) (nth 3 event)
- (if (consp result) result (list result)))))))
+ ;; Remove type information.
+ (setq args (mapcar #'dbus-delete-types (nthcdr 10 event)))
+ (setq monitor
+ (gethash
+ (list :monitor (nth 1 event)) dbus-registered-objects-table))
+ (if monitor
+ ;; A monitor event shall not trigger other operations, and
+ ;; it shall not trigger D-Bus errors.
+ (setq result (dbus-ignore-errors (apply (nth 9 event) args)))
+ ;; Error messages must be propagated. The error name is in
+ ;; the member slot.
+ (when (= dbus-message-type-error (nth 2 event))
+ (signal 'dbus-error (cons (nth 8 event) args)))
+ ;; Apply the handler.
+ (setq result (apply (nth 9 event) args))
+ ;; Return an (error) message when it is a message call.
+ (when (= dbus-message-type-method-call (nth 2 event))
+ (dbus-ignore-errors
+ (if (eq (car-safe result) :error)
+ (apply #'dbus-method-error-internal
+ (nth 1 event) (nth 4 event) (nth 3 event) (cdr result))
+ (if (eq result :ignore)
+ (dbus-method-return-internal
+ (nth 1 event) (nth 4 event) (nth 3 event))
+ (apply #'dbus-method-return-internal
+ (nth 1 event) (nth 4 event) (nth 3 event)
+ (if (consp result) result (list result)))))))))
;; Error handling.
(dbus-error
;; Return an error message when it is a message call.
(when (= dbus-message-type-method-call (nth 2 event))
(dbus-ignore-errors
(dbus-method-error-internal
- (nth 1 event) (nth 4 event) (nth 3 event) (cadr err))))
+ (nth 1 event) (nth 4 event) (nth 3 event) dbus-error-failed
+ (error-message-string err))))
;; Propagate D-Bus error messages.
(run-hook-with-args 'dbus-event-error-functions event err)
(when dbus-debug
@@ -1037,8 +1187,8 @@ If the HANDLER returns a `dbus-error', it is propagated as return message."
(defun dbus-event-bus-name (event)
"Return the bus name the event is coming from.
-The result is either a Lisp symbol, `:system' or `:session', or a
-string denoting the bus address. EVENT is a D-Bus event, see
+The result is either a Lisp keyword, `:system' or `:session', or
+a string denoting the bus address. EVENT is a D-Bus event, see
`dbus-check-event'. This function signals a `dbus-error' if the
event is not well formed."
(dbus-check-event event)
@@ -1069,13 +1219,21 @@ formed."
(dbus-check-event event)
(nth 4 event))
+(defun dbus-event-destination-name (event)
+ "Return the name of the D-Bus object the event is dedicated to.
+The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
+This function signals a `dbus-error' if the event is not well
+formed."
+ (dbus-check-event event)
+ (nth 5 event))
+
(defun dbus-event-path-name (event)
"Return the object path of the D-Bus object the event is coming from.
The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
This function signals a `dbus-error' if the event is not well
formed."
(dbus-check-event event)
- (nth 5 event))
+ (nth 6 event))
(defun dbus-event-interface-name (event)
"Return the interface name of the D-Bus object the event is coming from.
@@ -1083,15 +1241,32 @@ The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
This function signals a `dbus-error' if the event is not well
formed."
(dbus-check-event event)
- (nth 6 event))
+ (nth 7 event))
(defun dbus-event-member-name (event)
"Return the member name the event is coming from.
-It is either a signal name or a method name. The result is a
-string. EVENT is a D-Bus event, see `dbus-check-event'. This
-function signals a `dbus-error' if the event is not well formed."
+It is either a signal name, a method name or an error name. The
+result is a string. EVENT is a D-Bus event, see
+`dbus-check-event'. This function signals a `dbus-error' if the
+event is not well formed."
(dbus-check-event event)
- (nth 7 event))
+ (nth 8 event))
+
+(defun dbus-event-handler (event)
+ "Return the handler the event is applied with.
+The result is a function. EVENT is a D-Bus event, see
+`dbus-check-event'. This function signals a `dbus-error' if the
+event is not well formed."
+ (dbus-check-event event)
+ (nth 9 event))
+
+(defun dbus-event-arguments (event)
+ "Return the arguments the event is carrying on.
+The result is a list of arguments. EVENT is a D-Bus event, see
+`dbus-check-event'. This function signals a `dbus-error' if the
+event is not well formed."
+ (dbus-check-event event)
+ (nthcdr 10 event))
;;; D-Bus registered names.
@@ -1101,10 +1276,11 @@ function signals a `dbus-error' if the event is not well formed."
BUS defaults to `:system' when nil or omitted. The result is a
list of strings, which is nil when there are no activatable
service names at all."
- (dbus-ignore-errors
- (dbus-call-method
- (or bus :system) dbus-service-dbus
- dbus-path-dbus dbus-interface-dbus "ListActivatableNames")))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ (or bus :system) dbus-service-dbus
+ dbus-path-dbus dbus-interface-dbus "ListActivatableNames"))))
(defun dbus-list-names (bus)
"Return the service names registered at D-Bus BUS.
@@ -1112,34 +1288,36 @@ The result is a list of strings, which is nil when there are no
registered service names at all. Well known names are strings
like \"org.freedesktop.DBus\". Names starting with \":\" are
unique names for services."
- (dbus-ignore-errors
- (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames")))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames"))))
(defun dbus-list-known-names (bus)
"Retrieve all services which correspond to a known name in BUS.
A service has a known name if it doesn't start with \":\"."
- (let (result)
- (dolist (name (dbus-list-names bus) (nreverse result))
- (unless (string-equal ":" (substring name 0 1))
- (push name result)))))
+ (seq-remove (lambda (name)
+ (= (string-to-char name) ?:))
+ (dbus-list-names bus)))
(defun dbus-list-queued-owners (bus service)
"Return the unique names registered at D-Bus BUS and queued for SERVICE.
The result is a list of strings, or nil when there are no queued
name owner service names at all."
- (dbus-ignore-errors
- (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus
- dbus-interface-dbus "ListQueuedOwners" service)))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus
+ dbus-interface-dbus "ListQueuedOwners" service))))
(defun dbus-get-name-owner (bus service)
"Return the name owner of SERVICE registered at D-Bus BUS.
The result is either a string, or nil if there is no name owner."
- (dbus-ignore-errors
- (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus
- dbus-interface-dbus "GetNameOwner" service)))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus
+ dbus-interface-dbus "GetNameOwner" service))))
(defun dbus-ping (bus service &optional timeout)
"Check whether SERVICE is registered for D-Bus BUS.
@@ -1167,7 +1345,8 @@ check whether SERVICE is already running, you can instead write
"Default handler for the \"org.freedesktop.DBus.Peer\" interface.
It will be registered for all objects created by `dbus-register-service'."
(let* ((last-input-event last-input-event)
- (method (dbus-event-member-name last-input-event)))
+ (method (dbus-event-member-name last-input-event))
+ (path (dbus-event-path-name last-input-event)))
(cond
;; "Ping" does not return an output parameter.
((string-equal method "Ping")
@@ -1177,37 +1356,62 @@ It will be registered for all objects created by `dbus-register-service'."
(signal
'dbus-error
(list
- (format "%s.GetMachineId not implemented" dbus-interface-peer)))))))
+ (format "%s.GetMachineId not implemented" dbus-interface-peer))))
+ (t `(:error ,dbus-error-unknown-method
+ ,(format-message
+ "No such method \"%s.%s\" at path \"%s\""
+ dbus-interface-peer method path))))))
;;; D-Bus introspection.
+(defsubst dbus--introspect-names (object tag)
+ "Return the names of the children of OBJECT with TAG."
+ (mapcar (lambda (elt)
+ (dbus-introspect-get-attribute elt "name"))
+ (xml-get-children object tag)))
+
+(defsubst dbus--introspect-name (object tag name)
+ "Return the first child of OBJECT with TAG, whose name is NAME."
+ (seq-find (lambda (elt)
+ (string-equal (dbus-introspect-get-attribute elt "name") name))
+ (xml-get-children object tag)))
+
(defun dbus-introspect (bus service path)
"Return all interfaces and sub-nodes of SERVICE,
registered at object path PATH at bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. SERVICE must be a known service name,
-and PATH must be a valid object path. The last two parameters
-are strings. The result, the introspection data, is a string in
-XML format."
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address. SERVICE must be a known service
+name, and PATH must be a valid object path. The last two
+parameters are strings. The result, the introspection data, is a
+string in XML format."
;; We don't want to raise errors.
- (dbus-ignore-errors
- (dbus-call-method
- bus service path dbus-interface-introspectable "Introspect"
- :timeout 1000)))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus service path dbus-interface-introspectable "Introspect"
+ :timeout 1000))))
+
+(defalias 'dbus--parse-xml-buffer
+ (if (libxml-available-p)
+ (lambda ()
+ (xml-remove-comments (point-min) (point-max))
+ (libxml-parse-xml-region (point-min) (point-max)))
+ (lambda ()
+ (car (xml-parse-region (point-min) (point-max)))))
+ "Compatibility shim for `libxml-parse-xml-region'.")
(defun dbus-introspect-xml (bus service path)
"Return the introspection data of SERVICE in D-Bus BUS at object path PATH.
The data are a parsed list. The root object is a \"node\",
representing the object path PATH. The root object can contain
\"interface\" and further \"node\" objects."
- ;; We don't want to raise errors.
- (xml-node-name
- (ignore-errors
- (with-temp-buffer
- (insert (dbus-introspect bus service path))
- (xml-parse-region (point-min) (point-max))))))
+ (with-temp-buffer
+ ;; We don't want to raise errors.
+ (ignore-errors
+ (insert (dbus-introspect bus service path))
+ (dbus--parse-xml-buffer))))
(defun dbus-introspect-get-attribute (object attribute)
"Return the ATTRIBUTE value of D-Bus introspection OBJECT.
@@ -1219,21 +1423,15 @@ the D-Bus specification."
"Return all node names of SERVICE in D-Bus BUS at object path PATH.
It returns a list of strings. The node names stand for further
object paths of the D-Bus service."
- (let ((object (dbus-introspect-xml bus service path))
- result)
- (dolist (elt (xml-get-children object 'node) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names (dbus-introspect-xml bus service path) 'node))
(defun dbus-introspect-get-all-nodes (bus service path)
"Return all node names of SERVICE in D-Bus BUS at object path PATH.
It returns a list of strings, which are further object paths of SERVICE."
- (let ((result (list path)))
- (dolist (elt
- (dbus-introspect-get-node-names bus service path)
- result)
- (setq elt (expand-file-name elt path))
- (setq result
- (append result (dbus-introspect-get-all-nodes bus service elt))))))
+ (cons path (mapcan (lambda (elt)
+ (setq elt (expand-file-name elt path))
+ (dbus-introspect-get-all-nodes bus service elt))
+ (dbus-introspect-get-node-names bus service path))))
(defun dbus-introspect-get-interface-names (bus service path)
"Return all interface names of SERVICE in D-Bus BUS at object path PATH.
@@ -1244,10 +1442,7 @@ always present. Another default interface is
\"org.freedesktop.DBus.Properties\". If present, \"interface\"
objects can also have \"property\" objects as children, beside
\"method\" and \"signal\" objects."
- (let ((object (dbus-introspect-xml bus service path))
- result)
- (dolist (elt (xml-get-children object 'interface) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names (dbus-introspect-xml bus service path) 'interface))
(defun dbus-introspect-get-interface (bus service path interface)
"Return the INTERFACE of SERVICE in D-Bus BUS at object path PATH.
@@ -1256,22 +1451,14 @@ and a member of the list returned by
`dbus-introspect-get-interface-names'. The resulting
\"interface\" object can contain \"method\", \"signal\",
\"property\" and \"annotation\" children."
- (let ((elt (xml-get-children
- (dbus-introspect-xml bus service path) 'interface)))
- (while (and elt
- (not (string-equal
- interface
- (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name (dbus-introspect-xml bus service path)
+ 'interface interface))
(defun dbus-introspect-get-method-names (bus service path interface)
"Return a list of strings of all method names of INTERFACE.
SERVICE is a service of D-Bus BUS at object path PATH."
- (let ((object (dbus-introspect-get-interface bus service path interface))
- result)
- (dolist (elt (xml-get-children object 'method) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names
+ (dbus-introspect-get-interface bus service path interface) 'method))
(defun dbus-introspect-get-method (bus service path interface method)
"Return method METHOD of interface INTERFACE as an XML object.
@@ -1279,22 +1466,15 @@ It must be located at SERVICE in D-Bus BUS at object path PATH.
METHOD must be a string and a member of the list returned by
`dbus-introspect-get-method-names'. The resulting \"method\"
object can contain \"arg\" and \"annotation\" children."
- (let ((elt (xml-get-children
- (dbus-introspect-get-interface bus service path interface)
- 'method)))
- (while (and elt
- (not (string-equal
- method (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name
+ (dbus-introspect-get-interface bus service path interface)
+ 'method method))
(defun dbus-introspect-get-signal-names (bus service path interface)
"Return a list of strings of all signal names of INTERFACE.
SERVICE is a service of D-Bus BUS at object path PATH."
- (let ((object (dbus-introspect-get-interface bus service path interface))
- result)
- (dolist (elt (xml-get-children object 'signal) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names
+ (dbus-introspect-get-interface bus service path interface) 'signal))
(defun dbus-introspect-get-signal (bus service path interface signal)
"Return signal SIGNAL of interface INTERFACE as an XML object.
@@ -1302,22 +1482,15 @@ It must be located at SERVICE in D-Bus BUS at object path PATH.
SIGNAL must be a string, element of the list returned by
`dbus-introspect-get-signal-names'. The resulting \"signal\"
object can contain \"arg\" and \"annotation\" children."
- (let ((elt (xml-get-children
- (dbus-introspect-get-interface bus service path interface)
- 'signal)))
- (while (and elt
- (not (string-equal
- signal (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name
+ (dbus-introspect-get-interface bus service path interface)
+ 'signal signal))
(defun dbus-introspect-get-property-names (bus service path interface)
"Return a list of strings of all property names of INTERFACE.
SERVICE is a service of D-Bus BUS at object path PATH."
- (let ((object (dbus-introspect-get-interface bus service path interface))
- result)
- (dolist (elt (xml-get-children object 'property) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names
+ (dbus-introspect-get-interface bus service path interface) 'property))
(defun dbus-introspect-get-property (bus service path interface property)
"Return PROPERTY of INTERFACE as an XML object.
@@ -1325,15 +1498,9 @@ It must be located at SERVICE in D-Bus BUS at object path PATH.
PROPERTY must be a string and a member of the list returned by
`dbus-introspect-get-property-names'. The resulting PROPERTY
object can contain \"annotation\" children."
- (let ((elt (xml-get-children
- (dbus-introspect-get-interface bus service path interface)
- 'property)))
- (while (and elt
- (not (string-equal
- property
- (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name
+ (dbus-introspect-get-interface bus service path interface)
+ 'property property))
(defun dbus-introspect-get-annotation-names
(bus service path interface &optional name)
@@ -1341,15 +1508,13 @@ object can contain \"annotation\" children."
If NAME is nil, the annotations are children of INTERFACE,
otherwise NAME must be a \"method\", \"signal\", or \"property\"
object, where the annotations belong to."
- (let ((object
- (if name
- (or (dbus-introspect-get-method bus service path interface name)
- (dbus-introspect-get-signal bus service path interface name)
- (dbus-introspect-get-property bus service path interface name))
- (dbus-introspect-get-interface bus service path interface)))
- result)
- (dolist (elt (xml-get-children object 'annotation) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names
+ (if name
+ (or (dbus-introspect-get-method bus service path interface name)
+ (dbus-introspect-get-signal bus service path interface name)
+ (dbus-introspect-get-property bus service path interface name))
+ (dbus-introspect-get-interface bus service path interface))
+ 'annotation))
(defun dbus-introspect-get-annotation
(bus service path interface name annotation)
@@ -1357,22 +1522,13 @@ object, where the annotations belong to."
If NAME is nil, ANNOTATION is a child of INTERFACE, otherwise
NAME must be the name of a \"method\", \"signal\", or
\"property\" object, where the ANNOTATION belongs to."
- (let ((elt (xml-get-children
- (if name
- (or (dbus-introspect-get-method
- bus service path interface name)
- (dbus-introspect-get-signal
- bus service path interface name)
- (dbus-introspect-get-property
- bus service path interface name))
- (dbus-introspect-get-interface bus service path interface))
- 'annotation)))
- (while (and elt
- (not (string-equal
- annotation
- (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name
+ (if name
+ (or (dbus-introspect-get-method bus service path interface name)
+ (dbus-introspect-get-signal bus service path interface name)
+ (dbus-introspect-get-property bus service path interface name))
+ (dbus-introspect-get-interface bus service path interface))
+ 'annotation annotation))
(defun dbus-introspect-get-argument-names (bus service path interface name)
"Return a list of all argument names as a list of strings.
@@ -1380,61 +1536,55 @@ NAME must be a \"method\" or \"signal\" object.
Argument names are optional, the function can return nil
therefore, even if the method or signal has arguments."
- (let ((object
- (or (dbus-introspect-get-method bus service path interface name)
- (dbus-introspect-get-signal bus service path interface name)))
- result)
- (dolist (elt (xml-get-children object 'arg) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names
+ (or (dbus-introspect-get-method bus service path interface name)
+ (dbus-introspect-get-signal bus service path interface name))
+ 'arg))
(defun dbus-introspect-get-argument (bus service path interface name arg)
"Return argument ARG as XML object.
NAME must be a \"method\" or \"signal\" object. ARG must be a
string and a member of the list returned by
`dbus-introspect-get-argument-names'."
- (let ((elt (xml-get-children
- (or (dbus-introspect-get-method bus service path interface name)
- (dbus-introspect-get-signal bus service path interface name))
- 'arg)))
- (while (and elt
- (not (string-equal
- arg (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name
+ (or (dbus-introspect-get-method bus service path interface name)
+ (dbus-introspect-get-signal bus service path interface name))
+ 'arg arg))
(defun dbus-introspect-get-signature
(bus service path interface name &optional direction)
- "Return signature of a `method' or `signal' represented by NAME as a string.
+ "Return signature of a `method', `property' or `signal' represented by NAME.
If NAME is a `method', DIRECTION can be either \"in\" or \"out\".
If DIRECTION is nil, \"in\" is assumed.
-If NAME is a `signal', and DIRECTION is non-nil, DIRECTION must
-be \"out\"."
+If NAME is a `signal' or a `property', DIRECTION is ignored."
;; For methods, we use "in" as default direction.
(let ((object (or (dbus-introspect-get-method
bus service path interface name)
(dbus-introspect-get-signal
+ bus service path interface name)
+ (dbus-introspect-get-property
bus service path interface name))))
- (when (and (string-equal
- "method" (dbus-introspect-get-attribute object "name"))
- (not (stringp direction)))
+ (when (and (eq 'method (car object)) (not (stringp direction)))
(setq direction "in"))
;; In signals, no direction is given.
- (when (string-equal "signal" (dbus-introspect-get-attribute object "name"))
+ (when (eq 'signal (car object))
(setq direction nil))
;; Collect the signatures.
- (mapconcat
- (lambda (x)
- (let ((arg (dbus-introspect-get-argument
- bus service path interface name x)))
- (if (or (not (stringp direction))
- (string-equal
- direction
- (dbus-introspect-get-attribute arg "direction")))
- (dbus-introspect-get-attribute arg "type")
- "")))
- (dbus-introspect-get-argument-names bus service path interface name)
- "")))
+ (if (eq 'property (car object))
+ (dbus-introspect-get-attribute object "type")
+ (mapconcat
+ (lambda (x)
+ (let ((arg (dbus-introspect-get-argument
+ bus service path interface name x)))
+ (if (or (not (stringp direction))
+ (string-equal
+ direction
+ (dbus-introspect-get-attribute arg "direction")))
+ (dbus-introspect-get-attribute arg "type")
+ "")))
+ (dbus-introspect-get-argument-names bus service path interface name)
+ ""))))
;;; D-Bus properties.
@@ -1442,52 +1592,58 @@ be \"out\"."
(defun dbus-get-property (bus service path interface property)
"Return the value of PROPERTY of INTERFACE.
It will be checked at BUS, SERVICE, PATH. The result can be any
-valid D-Bus value, or nil if there is no PROPERTY."
- (dbus-ignore-errors
- ;; "Get" returns a variant, so we must use the `car'.
- (car
- (dbus-call-method
- bus service path dbus-interface-properties
- "Get" :timeout 500 interface property))))
-
-(defun dbus-set-property (bus service path interface property value)
- "Set value of PROPERTY of INTERFACE to VALUE.
-It will be checked at BUS, SERVICE, PATH. When the value is
-successfully set return VALUE. Otherwise, return nil."
- (dbus-ignore-errors
- ;; "Set" requires a variant.
+valid D-Bus value, or nil if there is no PROPERTY, or PROPERTY cannot be read."
+ ;; "Get" returns a variant, so we must use the `car'.
+ (car
(dbus-call-method
bus service path dbus-interface-properties
- "Set" :timeout 500 interface property (list :variant value))
- ;; Return VALUE.
- (dbus-get-property bus service path interface property)))
+ "Get" :timeout 500 interface property)))
+
+(defun dbus-set-property (bus service path interface property &rest args)
+ "Set value of PROPERTY of INTERFACE to VALUE.
+It will be checked at BUS, SERVICE, PATH. VALUE can be preceded
+by a TYPE keyword. When the value is successfully set, and the
+property's access type is not `:write', return VALUE. Otherwise,
+return nil.
+
+\(dbus-set-property BUS SERVICE PATH INTERFACE PROPERTY [TYPE] VALUE)"
+ ;; "Set" requires a variant.
+ (dbus-call-method
+ bus service path dbus-interface-properties
+ "Set" :timeout 500 interface property (cons :variant args))
+ ;; Return VALUE.
+ (condition-case err
+ (dbus-get-property bus service path interface property)
+ (dbus-error
+ (if (string-equal dbus-error-access-denied (cadr err))
+ (car args)
+ (signal (car err) (cdr err))))))
(defun dbus-get-all-properties (bus service path interface)
"Return all properties of INTERFACE at BUS, SERVICE, PATH.
The result is a list of entries. Every entry is a cons of the
name of the property, and its value. If there are no properties,
nil is returned."
- (dbus-ignore-errors
- ;; "GetAll" returns "a{sv}".
- (let (result)
- (dolist (dict
- (dbus-call-method
- bus service path dbus-interface-properties
- "GetAll" :timeout 500 interface)
- (nreverse result))
- (push (cons (car dict) (cl-caadr dict)) result)))))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ ;; "GetAll" returns "a{sv}".
+ (mapcar (lambda (dict)
+ (cons (car dict) (caadr dict)))
+ (dbus-call-method bus service path dbus-interface-properties
+ "GetAll" :timeout 500 interface)))))
(defun dbus-get-this-registered-property (bus _service path interface property)
"Return PROPERTY entry of `dbus-registered-objects-table'.
Filter out not matching PATH."
;; Remove entries not belonging to this case.
- (seq-remove
+ (seq-filter
(lambda (item)
- (not (string-equal path (nth 2 item))))
+ (string-equal path (nth 2 item)))
(gethash (list :property bus interface property)
dbus-registered-objects-table)))
-(defun dbus-get-other-registered-property (bus _service path interface property)
+(defun dbus-get-other-registered-properties
+ (bus _service path interface property)
"Return PROPERTY entry of `dbus-registered-objects-table'.
Filter out matching PATH."
;; Remove matching entries.
@@ -1498,12 +1654,11 @@ Filter out matching PATH."
dbus-registered-objects-table)))
(defun dbus-register-property
- (bus service path interface property access value
- &optional emits-signal dont-register-service)
+ (bus service path interface property access &rest args)
"Register PROPERTY on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name of the D-Bus. It must be a
known name (see discussion of DONT-REGISTER-SERVICE below).
@@ -1513,14 +1668,16 @@ discussion of DONT-REGISTER-SERVICE below). INTERFACE is the
name of the interface used at PATH, PROPERTY is the name of the
property of INTERFACE. ACCESS indicates, whether the property
can be changed by other services via D-Bus. It must be either
-the symbol `:read' or `:readwrite'. VALUE is the initial value
-of the property, it can be of any valid type (see
-`dbus-call-method' for details).
+the keyword `:read', `:write' or `:readwrite'.
+
+VALUE is the initial value of the property, it can be of any
+valid type (see `dbus-call-method' for details). VALUE can be
+preceded by a TYPE keyword.
If PROPERTY already exists on PATH, it will be overwritten. For
properties with access type `:read' this is the only way to
-change their values. Properties with access type `:readwrite'
-can be changed by `dbus-set-property'.
+change their values. Properties with access type `:write' or
+`:readwrite' can be changed by `dbus-set-property'.
The interface \"org.freedesktop.DBus.Properties\" is added to
PATH, including a default handler for the \"Get\", \"GetAll\" and
@@ -1533,116 +1690,165 @@ not registered. This means that other D-Bus clients have no way
of noticing the newly registered property. When interfaces are
constructed incrementally by adding single methods or properties
at a time, DONT-REGISTER-SERVICE can be used to prevent other
-clients from discovering the still incomplete interface."
- (unless (member access '(:read :readwrite))
- (signal 'wrong-type-argument (list "Access type invalid" access)))
-
- ;; Add handlers for the three property-related methods.
- (dbus-register-method
- bus service path dbus-interface-properties "Get"
- 'dbus-property-handler 'dont-register)
- (dbus-register-method
- bus service path dbus-interface-properties "GetAll"
- 'dbus-property-handler 'dont-register)
- (dbus-register-method
- bus service path dbus-interface-properties "Set"
- 'dbus-property-handler 'dont-register)
-
- ;; Register SERVICE.
- (unless (or dont-register-service (member service (dbus-list-names bus)))
- (dbus-register-service bus service))
-
- ;; Send the PropertiesChanged signal.
- (when emits-signal
- (dbus-send-signal
- bus service path dbus-interface-properties "PropertiesChanged"
- `((:dict-entry ,property (:variant ,value)))
- '(:array)))
-
- ;; Create a hash table entry. We use nil for the unique name,
- ;; because the property might be accessed from anybody.
- (let ((key (list :property bus interface property))
- (val
- (cons
- (list
- nil service path
- (cons
- (if emits-signal (list access :emits-signal) (list access))
- value))
- (dbus-get-other-registered-property
- bus service path interface property))))
- (puthash key val dbus-registered-objects-table)
-
- ;; Return the object.
- (list key (list service path))))
+clients from discovering the still incomplete interface.
+
+\(dbus-register-property BUS SERVICE PATH INTERFACE PROPERTY ACCESS \
+[TYPE] VALUE &optional EMITS-SIGNAL DONT-REGISTER-SERVICE)"
+ (let (;; Read basic type keyword.
+ (type (when (keywordp (car args)) (pop args)))
+ (value (pop args))
+ (emits-signal (pop args))
+ (dont-register-service (pop args)))
+ (unless (member access '(:read :write :readwrite))
+ (signal 'wrong-type-argument (list "Access type invalid" access)))
+ (unless (or type (consp value))
+ (setq type
+ (cond
+ ((memq value '(t nil)) :boolean)
+ ((natnump value) :uint32)
+ ((fixnump value) :int32)
+ ((floatp value) :double)
+ ((stringp value) :string)
+ (t
+ (signal 'wrong-type-argument (list "Value type invalid" value))))))
+ (unless (consp value)
+ (setq value (list type value)))
+ (setq value (if (member (car value) dbus-compound-types)
+ (list :variant value) (cons :variant value)))
+ (dbus-check-arguments bus service value)
+
+ ;; Add handlers for the three property-related methods.
+ (dbus-register-method
+ bus service path dbus-interface-properties "Get"
+ #'dbus-property-handler 'dont-register)
+ (dbus-register-method
+ bus service path dbus-interface-properties "GetAll"
+ #'dbus-property-handler 'dont-register)
+ (dbus-register-method
+ bus service path dbus-interface-properties "Set"
+ #'dbus-property-handler 'dont-register)
+
+ ;; Register SERVICE.
+ (unless (or dont-register-service (member service (dbus-list-names bus)))
+ (dbus-register-service bus service))
+
+ ;; Send the PropertiesChanged signal.
+ (when emits-signal
+ (dbus-send-signal
+ bus service path dbus-interface-properties "PropertiesChanged"
+ ;; changed_properties.
+ (if (eq access :write)
+ '(:array: :signature "{sv}")
+ `(:array (:dict-entry ,property ,value)))
+ ;; invalidated_properties.
+ (if (eq access :write)
+ `(:array ,property)
+ '(:array))))
+
+ ;; Create a hash table entry. We use nil for the unique name,
+ ;; because the property might be accessed from anybody.
+ (let ((key (list :property bus interface property))
+ (val
+ (cons
+ (list nil service path (list access emits-signal value))
+ (dbus-get-other-registered-properties
+ bus service path interface property))))
+ (puthash key val dbus-registered-objects-table)
+
+ ;; Return the object.
+ (list key (list service path)))))
(defun dbus-property-handler (&rest args)
"Default handler for the \"org.freedesktop.DBus.Properties\" interface.
It will be registered for all objects created by `dbus-register-property'."
- (let ((bus (dbus-event-bus-name last-input-event))
- (service (dbus-event-service-name last-input-event))
- (path (dbus-event-path-name last-input-event))
- (method (dbus-event-member-name last-input-event))
- (interface (car args))
- (property (cadr args)))
+ (let* ((last-input-event last-input-event)
+ (bus (dbus-event-bus-name last-input-event))
+ (service (dbus-event-service-name last-input-event))
+ (path (dbus-event-path-name last-input-event))
+ (method (dbus-event-member-name last-input-event))
+ (interface (car args))
+ (property (cadr args)))
(cond
;; "Get" returns a variant.
((string-equal method "Get")
- (let ((entry (dbus-get-this-registered-property
- bus service path interface property)))
- (when (string-equal path (nth 2 (car entry)))
- `((:variant ,(cdar (last (car entry))))))))
-
- ;; "Set" expects a variant.
+ (let* ((entry (dbus-get-this-registered-property
+ bus service path interface property))
+ (object (car (last (car entry)))))
+ (cond
+ ((not (consp object))
+ `(:error ,dbus-error-unknown-property
+ ,(format-message
+ "No such property \"%s\" at path \"%s\"" property path)))
+ ((eq :write (car object))
+ `(:error ,dbus-error-access-denied
+ ,(format-message
+ "Property \"%s\" at path \"%s\" is not readable" property path)))
+ ;; Return the result. Since variant is a list, we must embed
+ ;; it into another list.
+ (t (list (nth 2 object))))))
+
+ ;; "Set" needs the third typed argument from `last-input-event'.
((string-equal method "Set")
- (let* ((value (caar (cddr args)))
+ (let* ((value (dbus-flatten-types (nth 12 last-input-event)))
(entry (dbus-get-this-registered-property
bus service path interface property))
- ;; The value of the hash table is a list; in case of
- ;; properties it contains just one element (UNAME SERVICE
- ;; PATH OBJECT). OBJECT is a cons cell of a list, which
- ;; contains a list of annotations (like :read,
- ;; :read-write, :emits-signal), and the value of the
- ;; property.
(object (car (last (car entry)))))
- (unless (consp object)
- (signal 'dbus-error
- (list "Property not registered at path" property path)))
- (unless (member :readwrite (car object))
- (signal 'dbus-error
- (list "Property not writable at path" property path)))
- (puthash (list :property bus interface property)
- (cons (append (butlast (car entry))
- (list (cons (car object) value)))
- (dbus-get-other-registered-property
- bus service path interface property))
- dbus-registered-objects-table)
- ;; Send the "PropertiesChanged" signal.
- (when (member :emits-signal (car object))
- (dbus-send-signal
- bus service path dbus-interface-properties "PropertiesChanged"
- `((:dict-entry ,property (:variant ,value)))
- '(:array)))
- ;; Return empty reply.
- :ignore))
+ (cond
+ ((not (consp object))
+ `(:error ,dbus-error-unknown-property
+ ,(format-message
+ "No such property \"%s\" at path \"%s\"" property path)))
+ ((eq :read (car object))
+ `(:error ,dbus-error-property-read-only
+ ,(format-message
+ "Property \"%s\" at path \"%s\" is not writable" property path)))
+ (t (puthash (list :property bus interface property)
+ (cons (append
+ (butlast (car entry))
+ ;; Reuse ACCESS and EMITS-SIGNAL.
+ (list (append (butlast object) (list value))))
+ (dbus-get-other-registered-properties
+ bus service path interface property))
+ dbus-registered-objects-table)
+ ;; Send the "PropertiesChanged" signal.
+ (when (nth 1 object)
+ (dbus-send-signal
+ bus service path dbus-interface-properties "PropertiesChanged"
+ ;; changed_properties.
+ (if (eq :write (car object))
+ '(:array: :signature "{sv}")
+ `(:array (:dict-entry ,property ,value)))
+ ;; invalidated_properties.
+ (if (eq :write (car object))
+ `(:array ,property)
+ '(:array))))
+ ;; Return empty reply.
+ :ignore))))
;; "GetAll" returns "a{sv}".
((string-equal method "GetAll")
(let (result)
(maphash
(lambda (key val)
- (dolist (item val)
- (when (and (equal (butlast key) (list :property bus interface))
- (string-equal path (nth 2 item))
- (not (functionp (car (last item)))))
- (push
- (list :dict-entry
- (car (last key))
- (list :variant (cdar (last item))))
- result))))
+ (when (consp val)
+ (dolist (item val)
+ (let ((object (car (last item))))
+ (when (and (equal (butlast key) (list :property bus interface))
+ (string-equal path (nth 2 item))
+ (consp object)
+ (not (eq :write (car object))))
+ (push
+ (list :dict-entry (car (last key)) (nth 2 object))
+ result))))))
dbus-registered-objects-table)
- ;; Return the result, or an empty array.
- (list :array (or result '(:signature "{sv}"))))))))
+ ;; Return the result, or an empty array. An array must be
+ ;; embedded in a list.
+ (list (cons :array (or result '(:signature "{sv}"))))))
+
+ (t `(:error ,dbus-error-unknown-method
+ ,(format-message
+ "No such method \"%s.%s\" at path \"%s\""
+ dbus-interface-properties method path))))))
;;; D-Bus object manager.
@@ -1682,10 +1888,11 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow."
(let ((result
;; Direct call. Fails, if the target does not support the
;; object manager interface.
- (dbus-ignore-errors
- (dbus-call-method
- bus service path dbus-interface-objectmanager
- "GetManagedObjects" :timeout 1000))))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus service path dbus-interface-objectmanager
+ "GetManagedObjects" :timeout 1000)))))
(if result
;; Massage the returned structure.
@@ -1698,7 +1905,7 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow."
(if (cadr entry2)
;; "sv".
(dolist (entry3 (cadr entry2))
- (setcdr entry3 (cl-caadr entry3)))
+ (setcdr entry3 (caadr entry3)))
(setcdr entry2 nil)))))
;; Fallback: collect the information. Slooow!
@@ -1729,7 +1936,7 @@ It will be registered for all objects created by `dbus-register-service'."
;; Check for object path wildcard interfaces.
(maphash
(lambda (key val)
- (when (and (equal (butlast key 2) (list :method bus))
+ (when (and (equal (butlast key 2) (list :property bus))
(null (nth 2 (car-safe val))))
(push (nth 2 key) interfaces)))
dbus-registered-objects-table)
@@ -1738,7 +1945,7 @@ It will be registered for all objects created by `dbus-register-service'."
(maphash
(lambda (key val)
(let ((object (or (nth 2 (car-safe val)) "")))
- (when (and (equal (butlast key 2) (list :method bus))
+ (when (and (equal (butlast key 2) (list :property bus))
(string-prefix-p path object))
(dolist (interface (cons (nth 2 key) interfaces))
(unless (assoc object result)
@@ -1755,7 +1962,7 @@ It will be registered for all objects created by `dbus-register-service'."
(append
(butlast last-input-event 4)
(list object dbus-interface-properties
- "GetAll" 'dbus-property-handler))))
+ "GetAll" #'dbus-property-handler))))
(dbus-property-handler interface))))
(cdr (assoc object result)))))))))
dbus-registered-objects-table)
@@ -1772,13 +1979,195 @@ It will be registered for all objects created by `dbus-register-service'."
result)
'(:signature "{oa{sa{sv}}}"))))))
+(cl-defun dbus-register-monitor
+ (bus &optional handler &key type sender destination path interface member)
+ "Register HANDLER for monitor events on the D-Bus BUS.
+
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
+
+HANDLER is the function to be called when a monitor event
+arrives. It is called with the `args' slot of the monitor event,
+which are stripped off the type keywords. If HANDLER is nil, the
+default handler `dbus-monitor-handler' is applied.
+
+The other arguments are keyword-value pairs. `:type TYPE'
+defines the message type to be monitored. If given, it must be
+equal one of the strings \"method_call\", \"method_return\",
+\"error\" or \"signal\".
+
+`:sender SENDER' and `:destination DESTINATION' are D-Bus names.
+They can be unique names, or well-known service names.
+
+`:path PATH' is the D-Bus object to be monitored. `:interface
+INTERFACE' is the name of an interface, and `:member MEMBER' is
+either a method name, a signal name, or an error name."
+ (let ((bus-private (if (eq bus :system) :system-private
+ (if (eq bus :session) :session-private bus)))
+ rule key key1 value)
+ (unless handler (setq handler #'dbus-monitor-handler))
+ ;; Compose rule.
+ (setq rule
+ (string-join
+ (delq nil (mapcar
+ (lambda (item)
+ (when (cdr item)
+ (format "%s='%s'" (car item) (cdr item))))
+ `(("type" . ,type) ("sender" . ,sender)
+ ("destination" . ,destination) ("path" . ,path)
+ ("interface" . ,interface) ("member" . ,member))))
+ ",")
+ rule (or rule ""))
+
+ (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)
+
+ (when dbus-debug (message "Matching rule \"%s\" created" rule))
+
+ ;; Create a hash table entry.
+ (setq key (list :monitor bus-private)
+ key1 (list nil nil nil handler rule)
+ value (gethash key dbus-registered-objects-table))
+ (unless (member key1 value)
+ (puthash key (cons key1 value) dbus-registered-objects-table))
+
+ (when dbus-debug (message "%s" dbus-registered-objects-table))
+
+ ;; Return the object.
+ (list key key1)))
+
+(defconst dbus-monitor-method-call
+ (propertize "method-call" 'face 'font-lock-function-name-face)
+ "Text to be inserted for D-Bus method-call in monitor.")
+
+(defconst dbus-monitor-method-return
+ (propertize "method-return" 'face 'font-lock-function-name-face)
+ "Text to be inserted for D-Bus method-return in monitor.")
+
+(defconst dbus-monitor-error (propertize "error" 'face 'font-lock-warning-face)
+ "Text to be inserted for D-Bus error in monitor.")
+
+(defconst dbus-monitor-signal
+ (propertize "signal" 'face 'font-lock-type-face)
+ "Text to be inserted for D-Bus signal in monitor.")
+
+(defun dbus-monitor-goto-serial ()
+ "Goto D-Bus message with the same serial number."
+ (interactive)
+ (when (mouse-event-p last-input-event) (mouse-set-point last-input-event))
+ (when-let ((point (get-text-property (point) 'dbus-serial)))
+ (goto-char point)))
+
+(defun dbus-monitor-handler (&rest _args)
+ "Default handler for the \"org.freedesktop.DBus.Monitoring.BecomeMonitor\" interface.
+It will be applied for all objects created by `dbus-register-monitor'
+which don't declare an own handler. The printed timestamps do
+not reflect the time the D-Bus message has passed the D-Bus
+daemon, it is rather the timestamp the corresponding D-Bus event
+has been handled by this function."
+ (with-current-buffer (get-buffer-create "*D-Bus Monitor*")
+ (special-mode)
+ ;; Move forward and backward between messages.
+ (local-set-key [?n] #'forward-paragraph)
+ (local-set-key [?p] #'backward-paragraph)
+ ;; Follow serial links.
+ (local-set-key (kbd "RET") #'dbus-monitor-goto-serial)
+ (local-set-key [mouse-2] #'dbus-monitor-goto-serial)
+ (let* ((inhibit-read-only t)
+ (text-quoting-style 'grave)
+ (point (point))
+ (eobp (eobp))
+ (event last-input-event)
+ (type (dbus-event-message-type event))
+ (sender (dbus-event-service-name event))
+ (destination (dbus-event-destination-name event))
+ (serial (dbus-event-serial-number event))
+ (path (dbus-event-path-name event))
+ (interface (dbus-event-interface-name event))
+ (member (dbus-event-member-name event))
+ (arguments (dbus-event-arguments event))
+ (time (time-to-seconds (current-time))))
+ (save-excursion
+ ;; Check for matching method-call.
+ (goto-char (point-max))
+ (when (and (or (= type dbus-message-type-method-return)
+ (= type dbus-message-type-error))
+ (re-search-backward
+ (format
+ (concat
+ "^method-call time=\\(\\S-+\\) "
+ ".*sender=%s .*serial=\\(%d\\) ")
+ destination serial)
+ nil 'noerror))
+ (setq serial
+ (propertize
+ (match-string 2) 'dbus-serial (match-beginning 0)
+ 'help-echo "RET, mouse-1, mouse-2: goto method-call"
+ 'face 'link 'follow-link 'mouse-face 'mouse-face 'highlight)
+ time (format "%f (%f)" time (- time (read (match-string 1)))))
+ (set-text-properties
+ (match-beginning 2) (match-end 2)
+ `(dbus-serial ,(point-max)
+ help-echo
+ ,(format
+ "RET, mouse-1, mouse-2: goto %s"
+ (if (= type dbus-message-type-error) "error" "method-return"))
+ face link follow-link mouse-face mouse-face highlight)))
+ ;; Insert D-Bus message.
+ (goto-char (point-max))
+ (insert
+ (format
+ (concat
+ "%s time=%s sender=%s -> destination=%s serial=%s "
+ "path=%s interface=%s member=%s\n")
+ (cond
+ ((= type dbus-message-type-method-call) dbus-monitor-method-call)
+ ((= type dbus-message-type-method-return) dbus-monitor-method-return)
+ ((= type dbus-message-type-error) dbus-monitor-error)
+ ((= type dbus-message-type-signal) dbus-monitor-signal))
+ time sender destination serial path interface member))
+ (dolist (arg arguments)
+ (pp (dbus-flatten-types arg) (current-buffer)))
+ (insert "\n")
+ ;; Show byte arrays as string.
+ (goto-char point)
+ (while (re-search-forward
+ "(:array\\( :byte [[:digit:]]+\\)+)" nil 'noerror)
+ (put-text-property
+ (match-beginning 0) (match-end 0)
+ 'help-echo (dbus-byte-array-to-string (read (match-string 0)))))
+ ;; Show fixed numbers.
+ (goto-char point)
+ (while (re-search-forward
+ (concat
+ (regexp-opt
+ '(":int16" ":uint16" ":int32" ":uint32" ":int64" ":uint64"))
+ " \\([-+[:digit:]]+\\)")
+ nil 'noerror)
+ (put-text-property
+ (match-beginning 1) (match-end 1)
+ 'help-echo
+ (format
+ "#o%o, #x%X" (read (match-string 1)) (read (match-string 1)))))
+ ;; Show floating numbers.
+ (goto-char point)
+ (while (re-search-forward ":double \\([-+.[:digit:]]+\\)" nil 'noerror)
+ (put-text-property
+ (match-beginning 1) (match-end 1)
+ 'help-echo (format "%e" (read (match-string 1))))))
+ (when eobp
+ (goto-char (point-max))))))
+
(defun dbus-handle-bus-disconnect ()
"React to a bus disconnection.
BUS is the bus that disconnected. This routine unregisters all
handlers on the given bus and causes all synchronous calls
pending at the time of disconnect to fail."
(let ((bus (dbus-event-bus-name last-input-event))
- (keys-to-remove))
+ keys-to-remove)
(maphash
(lambda (key value)
(when (and (eq (nth 0 key) :serial)
@@ -1788,13 +2177,14 @@ pending at the time of disconnect to fail."
(list 'dbus-event
bus
dbus-message-type-error
- (nth 2 key)
- nil
- nil
- nil
- nil
- value)
- (list 'dbus-error "Bus disconnected" bus))
+ (nth 2 key) ; serial
+ nil ; service
+ nil ; destination
+ nil ; path
+ nil ; interface
+ nil ; member
+ value) ; handler
+ (list 'dbus-error dbus-error-disconnected "Bus disconnected" bus))
(push key keys-to-remove)))
dbus-registered-objects-table)
(dolist (key keys-to-remove)
@@ -1803,10 +2193,11 @@ pending at the time of disconnect to fail."
(defun dbus-init-bus (bus &optional private)
"Establish the connection to D-Bus BUS.
-BUS can be either the symbol `:system' or the symbol `:session', or it
-can be a string denoting the address of the corresponding bus. For
-the system and session buses, this function is called when loading
-`dbus.el', there is no need to call it again.
+BUS can be either the keyword `:system' or the keyword
+`:session', or it can be a string denoting the address of the
+corresponding bus. For the system and session buses, this
+function is called when loading `dbus.el', there is no need to
+call it again.
The function returns the number of connections this Emacs session
has established to the BUS under the same unique name (see
@@ -1816,13 +2207,13 @@ example, if Emacs is linked with the GTK+ toolkit, and it runs in
a GTK+-aware environment like GNOME, another connection might
already be established.
-When PRIVATE is non-nil, a new connection is established instead of
-reusing an existing one. It results in a new unique name at the bus.
-This can be used, if it is necessary to distinguish from another
-connection used in the same Emacs process, like the one established by
-GTK+. It should be used with care for at least the `:system' and
-`:session' buses, because other Emacs Lisp packages might already use
-this connection to those buses."
+When PRIVATE is non-nil, a new connection is established instead
+of reusing an existing one. It results in a new unique name at
+the bus. This can be used, if it is necessary to distinguish
+from another connection used in the same Emacs process, like the
+one established by GTK+. If BUS is the keyword `:system' or the
+keyword `:session', the new connection is identified by the
+keywords `:system-private' or `:session-private', respectively."
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
(prog1
@@ -1847,5 +2238,9 @@ this connection to those buses."
;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and
;; org.freedesktop.DBus.ObjectManager.InterfacesRemoved.
+;;
+;; * Cache introspection data.
+;;
+;; * Run handlers in own threads.
;;; dbus.el ends here
diff --git a/lisp/net/dig.el b/lisp/net/dig.el
index 852d8ae0491..f36999119f2 100644
--- a/lisp/net/dig.el
+++ b/lisp/net/dig.el
@@ -1,4 +1,4 @@
-;;; dig.el --- Domain Name System dig interface
+;;; dig.el --- Domain Name System dig interface -*- lexical-binding:t -*-
;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
@@ -42,15 +42,13 @@
(defcustom dig-program "dig"
"Name of dig (domain information groper) binary."
- :type 'file
- :group 'dig)
+ :type 'file)
(defcustom dig-dns-server nil
"DNS server to query.
If nil, use system defaults."
:type '(choice (const :tag "System defaults")
- string)
- :group 'dig)
+ string))
(defcustom dig-font-lock-keywords
'(("^;; [A-Z]+ SECTION:" 0 font-lock-keyword-face)
@@ -58,8 +56,7 @@ If nil, use system defaults."
("^; <<>>.*" 0 font-lock-type-face)
("^;.*" 0 font-lock-function-name-face))
"Default expressions to highlight in dig mode."
- :type 'sexp
- :group 'dig)
+ :type 'sexp)
(defun dig-invoke (domain &optional
query-type query-class query-option
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index cefe0851f03..c368cd773c2 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -1,4 +1,4 @@
-;;; dns.el --- Domain Name Service lookups
+;;; dns.el --- Domain Name Service lookups -*- lexical-binding:t -*-
;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
@@ -24,6 +24,8 @@
;;; Code:
+(require 'cl-lib)
+
(defvar dns-timeout 5
"How many seconds to wait when doing DNS queries.")
@@ -73,7 +75,7 @@ updated. Set this variable to t to disable the check.")
(defun dns-write-bytes (value &optional length)
(let (bytes)
- (dotimes (i (or length 1))
+ (dotimes (_ (or length 1))
(push (% value 256) bytes)
(setq value (/ value 256)))
(dolist (byte bytes)
@@ -81,7 +83,7 @@ updated. Set this variable to t to disable the check.")
(defun dns-read-bytes (length)
(let ((value 0))
- (dotimes (i length)
+ (dotimes (_ length)
(setq value (logior (* value 256) (following-char)))
(forward-char 1))
value))
@@ -138,7 +140,7 @@ updated. Set this variable to t to disable the check.")
(defun dns-write (spec &optional tcp-p)
"Write a DNS packet according to SPEC.
-If TCP-P, the first two bytes of the package with be the length field."
+If TCP-P, the first two bytes of the packet will be the length field."
(with-temp-buffer
(set-buffer-multibyte nil)
(dns-write-bytes (dns-get 'id spec) 2)
@@ -189,13 +191,15 @@ If TCP-P, the first two bytes of the package with be the length field."
(dns-write-bytes (buffer-size) 2))
(buffer-string)))
-(defun dns-read (packet)
+(defun dns-read (packet &optional tcp-p)
(with-temp-buffer
(set-buffer-multibyte nil)
(let ((spec nil)
queries answers authorities additionals)
(insert packet)
- (goto-char (point-min))
+ ;; When using TCP we have a 2 byte length field to ignore.
+ (goto-char (+ (point-min)
+ (if tcp-p 2 0)))
(push (list 'id (dns-read-bytes 2)) spec)
(let ((byte (dns-read-bytes 1)))
(push (list 'response-p (if (zerop (logand byte (ash 1 7))) nil t))
@@ -227,7 +231,7 @@ If TCP-P, the first two bytes of the package with be the length field."
(setq authorities (dns-read-bytes 2))
(setq additionals (dns-read-bytes 2))
(let ((qs nil))
- (dotimes (i queries)
+ (dotimes (_ queries)
(push (list (dns-read-name)
(list 'type (dns-inverse-get (dns-read-bytes 2)
dns-query-types))
@@ -235,33 +239,36 @@ If TCP-P, the first two bytes of the package with be the length field."
dns-classes)))
qs))
(push (list 'queries qs) spec))
- (dolist (slot '(answers authorities additionals))
- (let ((qs nil)
- type)
- (dotimes (i (symbol-value slot))
- (push (list (dns-read-name)
- (list 'type
- (setq type (dns-inverse-get (dns-read-bytes 2)
- dns-query-types)))
- (list 'class (dns-inverse-get (dns-read-bytes 2)
- dns-classes))
- (list 'ttl (dns-read-bytes 4))
- (let ((length (dns-read-bytes 2)))
- (list 'data
- (dns-read-type
- (buffer-substring
- (point)
- (progn (forward-char length) (point)))
- type))))
- qs))
- (push (list slot qs) spec)))
+ (cl-loop for (slot length) in `((answers ,answers)
+ (authorities ,authorities)
+ (additionals ,additionals))
+ do (let ((qs nil)
+ type)
+ (dotimes (_ length)
+ (push (list (dns-read-name)
+ (list 'type
+ (setq type (dns-inverse-get
+ (dns-read-bytes 2)
+ dns-query-types)))
+ (list 'class (dns-inverse-get
+ (dns-read-bytes 2)
+ dns-classes))
+ (list 'ttl (dns-read-bytes 4))
+ (let ((length (dns-read-bytes 2)))
+ (list 'data
+ (dns-read-type
+ (buffer-substring
+ (point)
+ (progn (forward-char length)
+ (point)))
+ type))))
+ qs))
+ (push (list slot qs) spec)))
(nreverse spec))))
(defun dns-read-int32 ()
- ;; Full 32 bit Integers can't be handled by 32-bit Emacsen. If we
- ;; use floats, it works.
- (format "%.0f" (+ (* (dns-read-bytes 1) 16777216.0)
- (dns-read-bytes 3))))
+ (declare (obsolete nil "28.1"))
+ (number-to-string (dns-read-bytes 4)))
(defun dns-read-type (string type)
(let ((buffer (current-buffer))
@@ -274,23 +281,23 @@ If TCP-P, the first two bytes of the package with be the length field."
(cond
((eq type 'A)
(let ((bytes nil))
- (dotimes (i 4)
+ (dotimes (_ 4)
(push (dns-read-bytes 1) bytes))
(mapconcat 'number-to-string (nreverse bytes) ".")))
((eq type 'AAAA)
(let (hextets)
- (dotimes (i 8)
+ (dotimes (_ 8)
(push (dns-read-bytes 2) hextets))
(mapconcat (lambda (n) (format "%x" n))
(nreverse hextets) ":")))
((eq type 'SOA)
(list (list 'mname (dns-read-name buffer))
(list 'rname (dns-read-name buffer))
- (list 'serial (dns-read-int32))
- (list 'refresh (dns-read-int32))
- (list 'retry (dns-read-int32))
- (list 'expire (dns-read-int32))
- (list 'minimum (dns-read-int32))))
+ (list 'serial (dns-read-bytes 4))
+ (list 'refresh (dns-read-bytes 4))
+ (list 'retry (dns-read-bytes 4))
+ (list 'expire (dns-read-bytes 4))
+ (list 'minimum (dns-read-bytes 4))))
((eq type 'SRV)
(list (list 'priority (dns-read-bytes 2))
(list 'weight (dns-read-bytes 2))
@@ -309,16 +316,14 @@ If TCP-P, the first two bytes of the package with be the length field."
"Return false if we need to recheck the list of DNS servers."
(and dns-servers
(or (eq dns-servers-valid-for-interfaces t)
- ;; `network-interface-list' was introduced in Emacs 22.1.
- (not (fboundp 'network-interface-list))
(equal dns-servers-valid-for-interfaces
(network-interface-list)))))
(defun dns-set-servers ()
"Set `dns-servers' to a list of DNS servers or nil if none are found.
Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
+ (setq dns-servers nil)
(or (when (file-exists-p "/etc/resolv.conf")
- (setq dns-servers nil)
(with-temp-buffer
(insert-file-contents "/etc/resolv.conf")
(goto-char (point-min))
@@ -329,11 +334,10 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
(with-temp-buffer
(call-process "nslookup" nil t nil "localhost")
(goto-char (point-min))
- (re-search-forward
- "^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
- (setq dns-servers (list (match-string 1))))))
- (when (fboundp 'network-interface-list)
- (setq dns-servers-valid-for-interfaces (network-interface-list))))
+ (when (re-search-forward
+ "^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\|[[:xdigit:]:]*\\)" nil t)
+ (setq dns-servers (list (match-string 1)))))))
+ (setq dns-servers-valid-for-interfaces (network-interface-list)))
(defun dns-read-txt (string)
(if (> (length string) 1)
@@ -355,23 +359,6 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
result))
;;; Interface functions.
-(defmacro dns-make-network-process (server)
- `(let ((server ,server)
- (coding-system-for-read 'binary)
- (coding-system-for-write 'binary))
- (if (fboundp 'make-network-process)
- (make-network-process
- :name "dns"
- :coding 'binary
- :buffer (current-buffer)
- :host server
- :service "domain"
- :type 'datagram)
- ;; Older versions of Emacs doesn't have
- ;; `make-network-process', so we fall back on opening a TCP
- ;; connection to the DNS server.
- (open-network-stream "dns" (current-buffer) server "domain"))))
-
(defvar dns-cache (make-vector 4096 0))
(defun dns-query-cached (name &optional type fullp reversep)
@@ -384,64 +371,141 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
(set (intern key dns-cache) result)
result))))
-;; The old names `query-dns' and `query-dns-cached' weren't used in Emacs 23
-;; yet, so no alias are provided. --rsteib
-
-(defun dns-query (name &optional type fullp reversep)
+(defun dns-query-asynchronous (name callback &optional type full reverse)
"Query a DNS server for NAME of TYPE.
-If FULLP, return the entire record returned.
-If REVERSEP, look up an IP address."
+CALLBACK will be called with a single parameter: The result.
+
+If there's no result, or `dns-timeout' has passed, CALLBACK will
+be called with nil as the parameter.
+
+If FULL, return the entire record.
+If REVERSE, look up an IP address."
(setq type (or type 'A))
(unless (dns-servers-up-to-date-p)
(dns-set-servers))
- (when reversep
+ (when reverse
(setq name (concat
(mapconcat 'identity (nreverse (split-string name "\\.")) ".")
".in-addr.arpa")
type 'PTR))
(if (not dns-servers)
- (message "No DNS server configuration found")
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (let ((process (condition-case ()
- (dns-make-network-process (car dns-servers))
- (error
- (message
- "dns: Got an error while trying to talk to %s"
- (car dns-servers))
- nil)))
- (step 100)
- (times (* dns-timeout 1000))
- (id (random 65000)))
- (when process
- (process-send-string
- process
- (dns-write `((id ,id)
- (opcode query)
- (queries ((,name (type ,type))))
- (recursion-desired-p t))))
- (while (and (zerop (buffer-size))
- (> times 0))
- (let ((step-sec (/ step 1000.0)))
- (sit-for step-sec)
- (accept-process-output process step-sec))
- (setq times (- times step)))
- (condition-case nil
- (delete-process process)
- (error nil))
- (when (and (>= (buffer-size) 2)
- ;; We had a time-out.
- (> times 0))
- (let ((result (dns-read (buffer-string))))
- (if fullp
- result
- (let ((answer (car (dns-get 'answers result))))
- (when (eq type (dns-get 'type answer))
- (if (eq type 'TXT)
- (dns-get-txt-answer (dns-get 'answers result))
- (dns-get 'data answer))))))))))))
+ (progn
+ (message "No DNS server configuration found")
+ nil)
+ (dns--lookup name callback type full)))
+
+(defun dns--lookup (name callback type full)
+ (with-current-buffer (generate-new-buffer " *dns*")
+ (set-buffer-multibyte nil)
+ (let* ((tcp nil)
+ (process
+ (condition-case ()
+ (let ((server (car dns-servers))
+ (coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (if (featurep 'make-network-process '(:type datagram))
+ (make-network-process
+ :name "dns"
+ :coding 'binary
+ :buffer (current-buffer)
+ :host server
+ :service "domain"
+ :type 'datagram)
+ ;; On MS-Windows datagram sockets are not
+ ;; supported, so we fall back on opening a TCP
+ ;; connection to the DNS server.
+ (progn
+ (setq tcp t)
+ (open-network-stream "dns" (current-buffer)
+ server "domain"))))
+ (error
+ (message
+ "dns: Got an error while trying to talk to %s"
+ (car dns-servers))
+ nil)))
+ (triggered nil)
+ (buffer (current-buffer))
+ timer)
+ (if (not process)
+ (progn
+ (kill-buffer buffer)
+ (funcall callback nil))
+ ;; Call the callback if we don't get any response at all.
+ (setq timer (run-at-time dns-timeout nil
+ (lambda ()
+ (unless triggered
+ (setq triggered t)
+ (delete-process process)
+ (kill-buffer buffer)
+ (funcall callback nil)))))
+ (process-send-string
+ process
+ (dns-write `((id ,(random 65000))
+ (opcode query)
+ (queries ((,name (type ,type))))
+ (recursion-desired-p t))
+ tcp))
+ (set-process-filter
+ process
+ (lambda (process string)
+ (with-current-buffer (process-buffer process)
+ (goto-char (point-max))
+ (insert string)
+ (goto-char (point-min))
+ ;; If this is DNS, then we always get the full data in
+ ;; one packet. If it's TCP, we may only get part of the
+ ;; data, but the first two bytes says how long the data
+ ;; is supposed to be.
+ (when (or (not tcp)
+ (>= (buffer-size) (dns-read-bytes 2)))
+ (setq triggered t)
+ (cancel-timer timer)
+ (dns--filter process callback type full tcp)))))
+ ;; In case we the process is deleted for some reason, then do
+ ;; a failure callback.
+ (set-process-sentinel
+ process
+ (lambda (_ state)
+ (when (and (eq state 'deleted)
+ ;; Ensure we don't trigger this callback twice.
+ (not triggered))
+ (setq triggered t)
+ (cancel-timer timer)
+ (kill-buffer buffer)
+ (funcall callback nil))))))))
+
+(defun dns--filter (process callback type full tcp)
+ (let ((message (buffer-string)))
+ (when (process-live-p process)
+ (delete-process process))
+ (kill-buffer (current-buffer))
+ (when (>= (length message) 2)
+ (let ((result (dns-read message tcp)))
+ (funcall callback
+ (if full
+ result
+ (let ((answer (car (dns-get 'answers result))))
+ (when (eq type (dns-get 'type answer))
+ (if (eq type 'TXT)
+ (dns-get-txt-answer (dns-get 'answers result))
+ (dns-get 'data answer))))))))))
+
+(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))
+ (car result)))
(provide 'dns)
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index 20a5c5f6075..bb6682520ae 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -1,4 +1,4 @@
-;;; eudc-bob.el --- Binary Objects Support for EUDC
+;;; eudc-bob.el --- Binary Objects Support for EUDC -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -39,19 +39,41 @@
(require 'eudc)
-(defvar eudc-bob-generic-keymap nil
+(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)
+ map)
"Keymap for multimedia objects.")
-(defvar eudc-bob-image-keymap nil
+(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)
+ map)
"Keymap for inline images.")
-(defvar eudc-bob-sound-keymap nil
+(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)
+ map)
"Keymap for inline sounds.")
-(defvar eudc-bob-url-keymap nil
+(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)
+ map)
"Keymap for inline urls.")
-(defvar eudc-bob-mail-keymap nil
+(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)
+ map)
"Keymap for inline e-mail addresses.")
(defvar eudc-bob-generic-menu
@@ -71,16 +93,9 @@
`("EUDC Sound Menu"
["---" nil nil]
["Play sound" eudc-bob-play-sound-at-point
- (fboundp 'play-sound)]
+ (fboundp 'play-sound-internal)]
,@(cdr (cdr eudc-bob-generic-menu))))
-(defun eudc-jump-to-event (event)
- "Jump to the window and point where EVENT occurred."
- (if (fboundp 'event-closest-point)
- (goto-char (event-closest-point event))
- (set-buffer (window-buffer (posn-window (event-start event))))
- (goto-char (posn-point (event-start event)))))
-
(defun eudc-bob-get-overlay-prop (prop)
"Get property PROP from one of the overlays around."
(let ((overlays (append (overlays-at (1- (point)))
@@ -197,7 +212,7 @@ display a button."
(let (sound)
(if (null (setq sound (eudc-bob-get-overlay-prop 'object-data)))
(error "No sound data available here")
- (unless (fboundp 'play-sound)
+ (unless (fboundp 'play-sound-internal)
(error "Playing sounds not supported on this system"))
(play-sound (list 'sound :data sound)))))
@@ -205,44 +220,30 @@ display a button."
"Play the sound data contained in the button where EVENT occurred."
(interactive "e")
(save-excursion
- (eudc-jump-to-event event)
+ (mouse-set-point event)
(eudc-bob-play-sound-at-point)))
-(defun eudc-bob-save-object ()
+(defun eudc-bob-save-object (filename)
"Save the object data of the button at point."
- (interactive)
+ (interactive "fWrite file: ")
(let ((data (eudc-bob-get-overlay-prop 'object-data))
- (buffer (generate-new-buffer "*eudc-tmp*")))
- (save-excursion
- (if (fboundp 'set-buffer-file-coding-system)
- (set-buffer-file-coding-system 'binary))
- (set-buffer buffer)
- (set-buffer-multibyte nil)
- (insert data)
- (save-buffer))
- (kill-buffer buffer)))
+ (coding-system-for-write 'binary)) ;Inhibit EOL conversion.
+ (write-region data nil filename)))
-(defun eudc-bob-pipe-object-to-external-program ()
+(defun eudc-bob-pipe-object-to-external-program (program)
"Pipe the object data of the button at point to an external program."
- (interactive)
+ (interactive (list (completing-read "Viewer: " eudc-external-viewers)))
(let ((data (eudc-bob-get-overlay-prop 'object-data))
- (buffer (generate-new-buffer "*eudc-tmp*"))
- program
- viewer)
- (condition-case nil
- (save-excursion
- (if (fboundp 'set-buffer-file-coding-system)
- (set-buffer-file-coding-system 'binary))
- (set-buffer buffer)
- (insert data)
- (setq program (completing-read "Viewer: " eudc-external-viewers))
- (if (setq viewer (assoc program eudc-external-viewers))
- (call-process-region (point-min) (point-max)
- (car (cdr viewer))
- (cdr (cdr viewer)))
- (call-process-region (point-min) (point-max) program)))
- (error
- (kill-buffer buffer)))))
+ (viewer (assoc program eudc-external-viewers)))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert data)
+ (let ((coding-system-for-write 'binary)) ;Inhibit EOL conversion
+ (if viewer
+ (call-process-region (point-min) (point-max)
+ (car (cdr viewer))
+ (cdr (cdr viewer)))
+ (call-process-region (point-min) (point-max) program))))))
(defun eudc-bob-menu ()
"Retrieve the menu attached to a binary object."
@@ -252,47 +253,8 @@ display a button."
"Pop-up a menu of EUDC multimedia commands."
(interactive "@e")
(run-hooks 'activate-menubar-hook)
- (eudc-jump-to-event event)
- (let ((result (x-popup-menu t (eudc-bob-menu)))
- command)
- (if result
- (progn
- (setq command (lookup-key (eudc-bob-menu)
- (apply 'vector result)))
- (command-execute command)))))
-
-(setq 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)
- map))
-
-(setq eudc-bob-image-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map "t" 'eudc-bob-toggle-inline-display)
- map))
-
-(setq eudc-bob-sound-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [return] 'eudc-bob-play-sound-at-point)
- (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse)
- map))
-
-(setq eudc-bob-url-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [return] 'browse-url-at-point)
- (define-key map [down-mouse-2] 'browse-url-at-mouse)
- map))
-
-(setq eudc-bob-mail-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [return] 'goto-address-at-point)
- (define-key map [down-mouse-2] 'goto-address-at-point)
- map))
-
-(set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap)
-(set-keymap-parent eudc-bob-sound-keymap eudc-bob-generic-keymap)
+ (mouse-set-point event)
+ (popup-menu (eudc-bob-menu) event))
;; If the first arguments can be nil here, then these 3 can be
;; defconsts once more.
diff --git a/lisp/net/eudcb-macos-contacts.el b/lisp/net/eudcb-macos-contacts.el
new file mode 100644
index 00000000000..3c0d88fc23f
--- /dev/null
+++ b/lisp/net/eudcb-macos-contacts.el
@@ -0,0 +1,123 @@
+;;; eudcb-macos-contacts.el --- EUDC - macOS Contacts backend
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Alexander Adolf
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; This library provides an interface to the macOS Contacts app as
+;; an EUDC data source. It uses AppleScript to interface with the
+;; Contacts app on localhost, so no 3rd party tools are needed.
+
+;;; Usage:
+;; (require 'eudcb-macos-contacts)
+;; (eudc-macos-contacts-set-server "localhost")
+
+;;; Code:
+
+(require 'eudc)
+(require 'executable)
+
+;;{{{ Internal cooking
+
+(defvar eudc-macos-contacts-conversion-alist nil)
+
+;; hook ourselves into the EUDC framework
+(eudc-protocol-set 'eudc-query-function
+ 'eudc-macos-contacts-query-internal
+ 'macos-contacts)
+(eudc-protocol-set 'eudc-list-attributes-function
+ nil
+ 'macos-contacts)
+(eudc-protocol-set 'eudc-macos-contacts-conversion-alist
+ nil
+ 'macos-contacts)
+(eudc-protocol-set 'eudc-protocol-has-default-query-attributes
+ nil
+ 'macos-contacts)
+
+(defun eudc-macos-contacts-search-helper (str)
+ "Helper function to query the Contacts app via AppleScript.
+Searches for all persons with a case-insensitive substring match
+of STR in any of their name fields (first, middle, or last)."
+ (if (executable-find "osascript")
+ (call-process "osascript" nil t nil
+ "-e"
+ (format "
+set results to {}
+tell application \"Address Book\"
+ set pList to every person whose (name contains \"%s\")
+ repeat with pers in pList
+ repeat with emailAddr in emails of pers
+ set results to results & {name of pers & \":\" & value ¬
+ of emailAddr & \"\n\"}
+ end repeat
+ end repeat
+ get results as text
+end tell" str))
+ (message (concat "[eudc] Error in macOS Contacts backend: "
+ "`osascript' executable not found. "
+ "Is this is a macOS 10.0 or later system?"))))
+
+(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.
+RETURN-ATTRS is a list of attributes to return, defaulting to
+`eudc-default-return-attributes'."
+ (let ((macos-contacts-buffer (get-buffer-create " *macOS Contacts*"))
+ result)
+ (with-current-buffer macos-contacts-buffer
+ (erase-buffer)
+ (dolist (term query)
+ (eudc-macos-contacts-search-helper (cdr term)))
+ (delete-duplicate-lines (point-min) (point-max))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (not (equal (line-beginning-position) (line-end-position)))
+ (let* ((args (split-string (buffer-substring
+ (point) (line-end-position))
+ ":"))
+ (name (nth 0 args))
+ (email (nth 1 args)))
+ (setq result (cons `((name . ,name)
+ (email . ,email))
+ result))))
+ (forward-line))
+ result)))
+
+;;}}}
+
+;;{{{ High-level interfaces (interactive functions)
+
+(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
+running on the local host."
+ (interactive)
+ (eudc-set-server dummy 'macos-contacts)
+ (message "[eudc] macOS Contacts app server selected"))
+
+;;}}}
+
+(eudc-register-protocol 'macos-contacts)
+
+(provide 'eudcb-macos-contacts)
+
+;;; eudcb-macos-contacts.el ends here
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 449618bd672..fd9fe98439d 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -25,14 +25,15 @@
;;; Code:
(require 'cl-lib)
-(require 'format-spec)
+(require 'mm-url)
+(require 'puny)
(require 'shr)
+(require 'text-property-search)
+(require 'thingatpt)
(require 'url)
(require 'url-queue)
-(require 'thingatpt)
-(require 'mm-url)
-(require 'puny)
-(eval-when-compile (require 'subr-x)) ;; for string-trim
+(require 'xdg)
+(eval-when-compile (require 'subr-x))
(defgroup eww nil
"Emacs Web Wowser"
@@ -55,11 +56,24 @@
:group 'eww
:type 'string)
-(defcustom eww-download-directory "~/Downloads/"
- "Directory where files will downloaded."
- :version "24.4"
+(defun erc--download-directory ()
+ "Return the name of the download directory.
+If ~/Downloads/ exists, that will be used, and if not, the
+DOWNLOAD XDG user directory will be returned. If that's
+undefined, ~/Downloads/ is returned anyway."
+ (or (and (file-exists-p "~/Downloads/")
+ "~/Downloads/")
+ (when-let ((dir (xdg-user-dir "DOWNLOAD")))
+ (file-name-as-directory dir))
+ "~/Downloads/"))
+
+(defcustom eww-download-directory 'erc--download-directory
+ "Directory where files will downloaded.
+This should either be a directory name or a function (called with
+no parameters) that returns a directory name."
+ :version "28.1"
:group 'eww
- :type 'directory)
+ :type '(choice directory function))
;;;###autoload
(defcustom eww-suggest-uris
@@ -120,6 +134,15 @@ The string will be passed through `substitute-command-keys'."
:type '(choice (const :tag "Unlimited" nil)
integer))
+(defcustom eww-retrieve-command nil
+ "Command to retrieve an URL via an external program.
+If nil, `url-retrieve' is used to download the data. If non-nil,
+this should be a list where the first item is the program, and
+the rest are the arguments."
+ :version "28.1"
+ :type '(choice (const :tag "Use `url-retrieve'" nil)
+ (repeat string)))
+
(defcustom eww-use-external-browser-for-content-type
"\\`\\(video/\\|audio/\\|application/ogg\\)"
"Always use external browser for specified content-type."
@@ -263,19 +286,40 @@ This list can be customized via `eww-suggest-uris'."
(nreverse uris)))
;;;###autoload
-(defun eww (url &optional arg)
+(defun eww-browse ()
+ "Function to be run to parse command line URLs.
+This is meant to be used for MIME handlers or command line use.
+
+Setting the handler for \"text/x-uri;\" to
+\"emacs -f eww-browse %u\" will then start up Emacs and call eww
+to browse the url.
+
+This can also be used on the command line directly:
+
+ emacs -f eww-browse https://gnu.org
+
+will start Emacs and browse the GNU web site."
+ (interactive)
+ (eww (pop command-line-args-left)))
+
+
+;;;###autoload
+(defun eww (url &optional arg buffer)
"Fetch URL and render the page.
If the input doesn't look like an URL or a domain name, the
word(s) will be searched for via `eww-search-prefix'.
If called with a prefix ARG, use a new buffer instead of reusing
-the default EWW buffer."
+the default EWW buffer.
+
+If BUFFER, the data to be rendered is in that buffer. In that
+case, this function doesn't actually fetch URL. BUFFER will be
+killed after rendering."
(interactive
- (let* ((uris (eww-suggested-uris))
- (prompt (concat "Enter URL or keywords"
- (if uris (format " (default %s)" (car uris)) "")
- ": ")))
- (list (read-string prompt nil 'eww-prompt-history uris)
+ (let ((uris (eww-suggested-uris)))
+ (list (read-string (format-prompt "Enter URL or keywords"
+ (and uris (car uris)))
+ nil 'eww-prompt-history uris)
(prefix-numeric-value current-prefix-arg))))
(setq url (eww--dwim-expand-url url))
(pop-to-buffer-same-window
@@ -307,8 +351,39 @@ the default EWW buffer."
(insert (format "Loading %s..." url))
(goto-char (point-min)))
(let ((url-mime-accept-string eww-accept-content-types))
- (url-retrieve url 'eww-render
- (list url nil (current-buffer)))))
+ (if buffer
+ (let ((eww-buffer (current-buffer)))
+ (with-current-buffer buffer
+ (eww-render nil url nil eww-buffer)))
+ (eww-retrieve url #'eww-render
+ (list url nil (current-buffer))))))
+
+(defun eww-retrieve (url callback cbargs)
+ (if (null eww-retrieve-command)
+ (url-retrieve url #'eww-render
+ (list url nil (current-buffer)))
+ (let ((buffer (generate-new-buffer " *eww retrieve*"))
+ (error-buffer (generate-new-buffer " *eww error*")))
+ (with-current-buffer buffer
+ (set-buffer-multibyte nil)
+ (make-process
+ :name "*eww fetch*"
+ :buffer (current-buffer)
+ :stderr error-buffer
+ :command (append eww-retrieve-command (list url))
+ :sentinel (lambda (process _)
+ (unless (process-live-p process)
+ (when (buffer-live-p error-buffer)
+ (when (get-buffer-process error-buffer)
+ (delete-process (get-buffer-process error-buffer) ))
+ (kill-buffer error-buffer))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (insert "Content-type: text/html; charset=utf-8\n\n")
+ (apply #'funcall callback nil cbargs))))))))))
+
+(function-put 'eww 'browse-url-browser-kind 'internal)
(defun eww--dwim-expand-url (url)
(setq url (string-trim url))
@@ -359,7 +434,19 @@ the default EWW buffer."
(eww (concat "file://"
(and (memq system-type '(windows-nt ms-dos))
"/")
- (expand-file-name file))))
+ (expand-file-name file))
+ nil
+ ;; The file name may be a non-local Tramp file. The URL
+ ;; library doesn't understand these file names, so use the
+ ;; normal Emacs machinery to load the file.
+ (with-current-buffer (generate-new-buffer " *eww file*")
+ (set-buffer-multibyte nil)
+ (insert "Content-type: " (or (mailcap-extension-to-mime
+ (url-file-extension file))
+ "application/octet-stream")
+ "\n\n")
+ (insert-file-contents file)
+ (current-buffer))))
;;;###autoload
(defun eww-search-words ()
@@ -373,8 +460,8 @@ for the search engine used."
(let ((region-string (buffer-substring (region-beginning) (region-end))))
(if (not (string-match-p "\\`[ \n\t\r\v\f]*\\'" region-string))
(eww region-string)
- (call-interactively 'eww)))
- (call-interactively 'eww)))
+ (call-interactively #'eww)))
+ (call-interactively #'eww)))
(defun eww-open-in-new-buffer ()
"Fetch link at point in a new EWW buffer."
@@ -541,10 +628,10 @@ Currently this means either text/html or application/xhtml+xml."
(goto-char point))
(shr-target-id
(goto-char (point-min))
- (let ((point (next-single-property-change
- (point-min) 'shr-target-id)))
- (when point
- (goto-char point))))
+ (let ((match (text-property-search-forward
+ 'shr-target-id shr-target-id t)))
+ (when match
+ (goto-char (prop-match-beginning match)))))
(t
(goto-char (point-min))
;; Don't leave point inside forms, because the normal eww
@@ -614,25 +701,81 @@ Currently this means either text/html or application/xhtml+xml."
eww-image-link-keymap
eww-link-keymap))))
+(defun eww--limit-string-pixelwise (string pixels)
+ (if (not pixels)
+ string
+ (with-temp-buffer
+ (insert string)
+ (if (< (eww--pixel-column) pixels)
+ string
+ ;; Iterate to find appropriate length.
+ (while (and (> (eww--pixel-column) pixels)
+ (not (bobp)))
+ (forward-char -1))
+ ;; Return at least one character.
+ (buffer-substring (point-min) (max (point)
+ (1+ (point-min))))))))
+
+(defun eww--pixel-column ()
+ (if (not (get-buffer-window (current-buffer)))
+ (save-window-excursion
+ ;; Avoid errors if the selected window is a dedicated one,
+ ;; and they just want to insert a document into it.
+ (set-window-dedicated-p nil nil)
+ (set-window-buffer nil (current-buffer))
+ (car (window-text-pixel-size nil (line-beginning-position) (point))))
+ (car (window-text-pixel-size nil (line-beginning-position) (point)))))
+
(defun eww-update-header-line-format ()
(setq header-line-format
(and eww-header-line-format
- (let ((title (plist-get eww-data :title))
- (peer (plist-get eww-data :peer)))
- (when (zerop (length title))
- (setq title "[untitled]"))
- ;; This connection has is https.
+ (let ((peer (plist-get eww-data :peer))
+ (url (plist-get eww-data :url))
+ (title (propertize
+ (if (zerop (length (plist-get eww-data :title)))
+ "[untitled]"
+ (plist-get eww-data :title))
+ 'face 'variable-pitch)))
+ ;; This connection is https.
(when peer
- (setq title
- (propertize title 'face
- (if (plist-get peer :warnings)
- 'eww-invalid-certificate
- 'eww-valid-certificate))))
+ (add-face-text-property 0 (length title)
+ (if (plist-get peer :warnings)
+ 'eww-invalid-certificate
+ 'eww-valid-certificate)
+ t title))
+ ;; Limit the length of the title so that the host name
+ ;; of the URL is always visible.
+ (when url
+ (setq url (propertize url 'face 'variable-pitch))
+ (let* ((parsed (url-generic-parse-url url))
+ (host-length (shr-string-pixel-width
+ (propertize
+ (format "%s://%s" (url-type parsed)
+ (url-host parsed))
+ 'face 'variable-pitch)))
+ (width (window-width nil t)))
+ (cond
+ ;; The host bit is wider than the window, so nix
+ ;; the title.
+ ((> (+ host-length (shr-string-pixel-width "xxxxx")) width)
+ (setq title ""))
+ ;; Trim the title.
+ ((> (+ (shr-string-pixel-width (concat title "xx"))
+ host-length)
+ width)
+ (setq title
+ (concat
+ (eww--limit-string-pixelwise
+ title (- width host-length
+ (shr-string-pixel-width
+ (propertize "...: " 'face
+ 'variable-pitch))))
+ (propertize "..." 'face 'variable-pitch)))))))
(replace-regexp-in-string
"%" "%%"
(format-spec
eww-header-line-format
- `((?u . ,(or (plist-get eww-data :url) ""))
+ `((?u . ,(or url ""))
(?t . ,title))))))))
(defun eww-tag-title (dom)
@@ -1011,7 +1154,7 @@ just re-display the HTML already fetched."
(eww-display-html 'utf-8 url (plist-get eww-data :dom)
(point) (current-buffer)))
(let ((url-mime-accept-string eww-accept-content-types))
- (url-retrieve url 'eww-render
+ (eww-retrieve url #'eww-render
(list url (point) (current-buffer) encode))))))
;; Form support.
@@ -1060,6 +1203,8 @@ just re-display the HTML already fetched."
(defvar eww-select-map
(let ((map (make-sparse-keymap)))
(define-key map "\r" 'eww-change-select)
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map [mouse-2] 'eww-change-select)
(define-key map [(control c) (control c)] 'eww-submit)
map))
@@ -1111,11 +1256,13 @@ just re-display the HTML already fetched."
(defun eww-form-submit (dom)
(let ((start (point))
(value (dom-attr dom 'value)))
- (setq value
- (if (zerop (length value))
- "Submit"
- value))
- (insert value)
+ (if (null value)
+ (shr-generic dom)
+ (insert value))
+ ;; If the contents of the <button>...</button> turns out to be
+ ;; empty, or the value was blank, default to this:
+ (when (= (point) start)
+ (insert "Submit"))
(add-face-text-property start (point) 'eww-form-submit)
(put-text-property start (point) 'eww-form
(list :eww-form eww-form
@@ -1256,7 +1403,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(defun eww-tag-textarea (dom)
(let ((start (point))
- (value (or (dom-attr dom 'value) ""))
+ (value (or (dom-text dom) ""))
(lines (string-to-number (or (dom-attr dom 'rows) "10")))
(width (string-to-number (or (dom-attr dom 'cols) "10")))
end)
@@ -1325,16 +1472,15 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(options nil)
(start (point))
(max 0))
- (dolist (elem (dom-non-text-children dom))
- (when (eq (dom-tag elem) 'option)
- (when (dom-attr elem 'selected)
- (nconc menu (list :value (dom-attr elem 'value))))
- (let ((display (dom-text elem)))
- (setq max (max max (length display)))
- (push (list 'item
- :value (dom-attr elem 'value)
- :display display)
- options))))
+ (dolist (elem (dom-by-tag dom 'option))
+ (when (dom-attr elem 'selected)
+ (nconc menu (list :value (dom-attr elem 'value))))
+ (let ((display (dom-text elem)))
+ (setq max (max max (length display)))
+ (push (list 'item
+ :value (dom-attr elem 'value)
+ :display display)
+ options)))
(when options
(setq options (nreverse options))
;; If we have no selected values, default to the first value.
@@ -1361,25 +1507,30 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(setq display (plist-get (cdr elem) :display))))
display))
-(defun eww-change-select ()
+(defun eww--form-items (form)
+ (cl-loop for elem in form
+ when (and (consp elem)
+ (eq (car elem) 'item))
+ collect (cdr elem)))
+
+(defun eww-change-select (event)
"Change the value of the select drop-down menu under point."
- (interactive)
- (let* ((input (get-text-property (point) 'eww-form))
- (completion-ignore-case t)
- (options
- (delq nil
- (mapcar (lambda (elem)
- (and (consp elem)
- (eq (car elem) 'item)
- (cons (plist-get (cdr elem) :display)
- (plist-get (cdr elem) :value))))
- input)))
- (display
- (completing-read "Change value: " options nil 'require-match))
- (inhibit-read-only t))
- (plist-put input :value (cdr (assoc-string display options t)))
- (goto-char
- (eww-update-field display))))
+ (interactive (list last-nonmenu-event))
+ (mouse-set-point event)
+ (let ((input (get-text-property (point) 'eww-form)))
+ (popup-menu
+ (cons
+ "Change Value"
+ (mapcar
+ (lambda (elem)
+ (vector (plist-get elem :display)
+ (lambda ()
+ (interactive)
+ (plist-put input :value (plist-get elem :value))
+ (goto-char (eww-update-field (plist-get elem :display))))
+ t))
+ (eww--form-items input)))
+ event)))
(defun eww-update-field (string &optional offset)
(unless offset
@@ -1483,7 +1634,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(cond
((member (plist-get input :type) '("checkbox" "radio"))
(when (plist-get input :checked)
- (push (cons name (plist-get input :value))
+ (push (cons name (or (plist-get input :value) "on"))
values)))
((equal (plist-get input :type) "file")
(when-let ((file (plist-get input :filename)))
@@ -1572,8 +1723,10 @@ If EXTERNAL is double prefix, browse in new buffer."
(cond
((not url)
(message "No link under point"))
- ((string-match "^mailto:" url)
- (browse-url-mail url))
+ ((string-match-p "\\`mailto:" url)
+ ;; This respects the user options `browse-url-handlers'
+ ;; and `browse-url-mailto-function'.
+ (browse-url url))
((and (consp external) (<= (car external) 4))
(funcall browse-url-secondary-browser-function url)
(shr--blink-link))
@@ -1606,20 +1759,23 @@ Differences in #targets are ignored."
"Download URL to `eww-download-directory'.
Use link at point if there is one, else the current page's URL."
(interactive)
- (access-file eww-download-directory "Download failed")
- (let ((url (or (get-text-property (point) 'shr-url)
- (eww-current-url))))
- (if (not url)
- (message "No URL under point")
- (url-retrieve url 'eww-download-callback (list url)))))
-
-(defun eww-download-callback (status url)
+ (let ((dir (if (stringp eww-download-directory)
+ eww-download-directory
+ (funcall eww-download-directory))))
+ (access-file dir "Download failed")
+ (let ((url (or (get-text-property (point) 'shr-url)
+ (eww-current-url))))
+ (if (not url)
+ (message "No URL under point")
+ (url-retrieve url #'eww-download-callback (list url dir))))))
+
+(defun eww-download-callback (status url dir)
(unless (plist-get status :error)
(let* ((obj (url-generic-parse-url url))
(path (directory-file-name (car (url-path-and-query obj))))
(file (eww-make-unique-file-name
(eww-decode-url-file-name (file-name-nondirectory path))
- eww-download-directory)))
+ dir)))
(goto-char (point-min))
(re-search-forward "\r?\n\r?\n")
(let ((coding-system-for-write 'no-conversion))
@@ -1735,28 +1891,30 @@ If CHARSET is nil then use UTF-8."
(defun eww-write-bookmarks ()
(with-temp-file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)
- (insert ";; Auto-generated file; don't edit\n")
+ (insert ";; Auto-generated file; don't edit -*- mode: lisp-data -*-\n")
(pp eww-bookmarks (current-buffer))))
-(defun eww-read-bookmarks ()
+(defun eww-read-bookmarks (&optional error-out)
+ "Read bookmarks from `eww-bookmarks'.
+If ERROR-OUT, signal user-error if there are no bookmarks."
(let ((file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)))
(setq eww-bookmarks
(unless (zerop (or (file-attribute-size (file-attributes file)) 0))
(with-temp-buffer
(insert-file-contents file)
- (read (current-buffer)))))))
+ (read (current-buffer)))))
+ (when (and error-out (not eww-bookmarks))
+ (user-error "No bookmarks are defined"))))
;;;###autoload
(defun eww-list-bookmarks ()
"Display the bookmarks."
(interactive)
+ (eww-read-bookmarks t)
(pop-to-buffer "*eww bookmarks*")
(eww-bookmark-prepare))
(defun eww-bookmark-prepare ()
- (eww-read-bookmarks)
- (unless eww-bookmarks
- (user-error "No bookmarks are defined"))
(set-buffer (get-buffer-create "*eww bookmarks*"))
(eww-bookmark-mode)
(let* ((width (/ (window-width) 2))
@@ -1824,6 +1982,7 @@ If CHARSET is nil then use UTF-8."
bookmark)
(unless (get-buffer "*eww bookmarks*")
(setq first t)
+ (eww-read-bookmarks t)
(eww-bookmark-prepare))
(with-current-buffer (get-buffer "*eww bookmarks*")
(when (and (not first)
@@ -1842,6 +2001,7 @@ If CHARSET is nil then use UTF-8."
bookmark)
(unless (get-buffer "*eww bookmarks*")
(setq first t)
+ (eww-read-bookmarks t)
(eww-bookmark-prepare))
(with-current-buffer (get-buffer "*eww bookmarks*")
(if first
@@ -2124,12 +2284,12 @@ entries (if any) will be removed from the list.
Only the properties listed in `eww-desktop-data-save' are included.
Generally, the list should not include the (usually overly large)
:dom, :source and :text properties."
- (let ((history (mapcar 'eww-desktop-data-1
- (cons eww-data eww-history))))
- (list :history (if eww-desktop-remove-duplicates
- (cl-remove-duplicates
- history :test 'eww-desktop-history-duplicate)
- history))))
+ (let ((history (mapcar #'eww-desktop-data-1
+ (cons eww-data eww-history))))
+ (list :history (if eww-desktop-remove-duplicates
+ (cl-remove-duplicates
+ history :test #'eww-desktop-history-duplicate)
+ history))))
(defun eww-restore-desktop (file-name buffer-name misc-data)
"Restore an eww buffer from its desktop file record.
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 5212bf6a3f6..8ad721964dd 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -170,8 +170,9 @@ Third arg HOST is the name of the host to connect to, or its IP address.
Fourth arg SERVICE is the name of the service desired, or an integer
specifying a port number to connect to.
Fifth arg PARAMETERS is an optional list of keyword/value pairs.
-Only :client-certificate and :nowait keywords are recognized, and
-have the same meaning as for `open-network-stream'.
+Only :client-certificate, :nowait, and :coding keywords are
+recognized, and have the same meaning as for
+`open-network-stream'.
For historical reasons PARAMETERS can also be a symbol, which is
interpreted the same as passing a list containing :nowait and the
value of that symbol.
@@ -209,7 +210,8 @@ trust and key files, and priority string."
(gnutls-boot-parameters
:type 'gnutls-x509pki
:keylist keylist
- :hostname (puny-encode-domain host)))))))
+ :hostname (puny-encode-domain host))))
+ :coding (plist-get parameters :coding))))
(if nowait
process
(gnutls-negotiate :process process
@@ -346,8 +348,11 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
(t nil))))
(min-prime-bits (or min-prime-bits gnutls-min-prime-bits)))
- (when verify-hostname-error
- (push :hostname verify-error))
+ ;; Only add :hostname if `verify-error' is not t, since t
+ ;; means "include :hostname" Bug#38602.
+ (and verify-hostname-error
+ (not (eq verify-error t))
+ (push :hostname verify-error))
`(:priority ,priority-string
:hostname ,hostname
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index 9436f45aa32..43bea76a6bc 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -280,6 +280,16 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
(widen)
(goto-address-unfontify (point-min) (point-max)))))
+(defun goto-addr-mode--turn-on ()
+ (when (not goto-address-mode)
+ (goto-address-mode 1)))
+
+;;;###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."
diff --git a/lisp/net/hmac-md5.el b/lisp/net/hmac-md5.el
index 92efb6ba275..974ee0d3691 100644
--- a/lisp/net/hmac-md5.el
+++ b/lisp/net/hmac-md5.el
@@ -1,4 +1,4 @@
-;;; hmac-md5.el --- Compute HMAC-MD5.
+;;; hmac-md5.el --- Compute HMAC-MD5. -*- lexical-binding:t -*-
;; Copyright (C) 1999, 2001, 2007-2020 Free Software Foundation, Inc.
@@ -22,42 +22,8 @@
;;; Commentary:
-;; Test cases from RFC 2202, "Test Cases for HMAC-MD5 and HMAC-SHA-1".
-;;
-;; (encode-hex-string (hmac-md5 "Hi There" (make-string 16 ?\x0b)))
-;; => "9294727a3638bb1c13f48ef8158bfc9d"
-;;
-;; (encode-hex-string (hmac-md5 "what do ya want for nothing?" "Jefe"))
-;; => "750c783e6ab0b503eaa86e310a5db738"
-;;
-;; (encode-hex-string (hmac-md5 (make-string 50 ?\xdd) (make-string 16 ?\xaa)))
-;; => "56be34521d144c88dbb8c733f0e8b3f6"
-;;
-;; (encode-hex-string
-;; (hmac-md5
-;; (make-string 50 ?\xcd)
-;; (decode-hex-string "0102030405060708090a0b0c0d0e0f10111213141516171819")))
-;; => "697eaf0aca3a3aea3a75164746ffaa79"
-;;
-;; (encode-hex-string
-;; (hmac-md5 "Test With Truncation" (make-string 16 ?\x0c)))
-;; => "56461ef2342edc00f9bab995690efd4c"
-;;
-;; (encode-hex-string
-;; (hmac-md5-96 "Test With Truncation" (make-string 16 ?\x0c)))
-;; => "56461ef2342edc00f9bab995"
-;;
-;; (encode-hex-string
-;; (hmac-md5
-;; "Test Using Larger Than Block-Size Key - Hash Key First"
-;; (make-string 80 ?\xaa)))
-;; => "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd"
-;;
-;; (encode-hex-string
-;; (hmac-md5
-;; "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"
-;; (make-string 80 ?\xaa)))
-;; => "6f630fad67cda0ee1fb1f562db3aa53e"
+;; Test cases from RFC 2202, "Test Cases for HMAC-MD5 and HMAC-SHA-1",
+;; moved to lisp/test/net/hmac-md5-tests.el
;;; Code:
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index aa10f0291fd..22b59084004 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -134,9 +134,9 @@
;;
;;; Code:
+;;; Dependencies
(eval-when-compile (require 'cl-lib))
-(require 'format-spec)
(require 'utf7)
(require 'rfc2104)
;; Hmm... digest-md5 is not part of Emacs.
@@ -146,7 +146,7 @@
(declare-function digest-md5-digest-uri "ext:digest-md5")
(declare-function digest-md5-challenge "ext:digest-md5")
-;; User variables.
+;;; User variables
(defgroup imap nil
"Low-level IMAP issues."
@@ -258,7 +258,7 @@ Shorter values mean quicker response, but is more CPU intensive."
:group 'imap
:type 'boolean)
-;; Various variables.
+;;; Various variables
(defvar imap-fetch-data-hook nil
"Hooks called after receiving each FETCH response.")
@@ -317,7 +317,9 @@ the value of this variable will be bound to a certain value to which
an application program that uses this module specifies on a per-server
basis.")
-;; Internal constants. Change these and die.
+;;; Internal constants
+
+;; Change these and die.
(defconst imap-default-port 143)
(defconst imap-default-ssl-port 993)
@@ -349,7 +351,7 @@ basis.")
(defconst imap-log-buffer "*imap-log*")
(defconst imap-debug-buffer "*imap-debug*")
-;; Internal variables.
+;;; Internal variables
(defvar imap-stream nil)
(defvar imap-auth nil)
@@ -438,7 +440,7 @@ This variable is set to t automatically per server if the
canonical form fails.")
-;; Utility functions:
+;;; Utility functions
(defun imap-remassoc (key alist)
"Delete by side effect any elements of ALIST whose car is `equal' to KEY.
@@ -490,7 +492,8 @@ sure of changing the value of `foo'."
(nth 3 (car imap-failed-tags))))
-;; Server functions; stream stuff:
+;;; Server functions
+;;;; Stream functions
(defun imap-log (string-or-buffer)
(when imap-log
@@ -517,12 +520,9 @@ sure of changing the value of `foo'."
(process-connection-type imap-process-connection-type)
(process (start-process
name buffer shell-file-name shell-command-switch
- (format-spec
- cmd
- (format-spec-make
- ?s server
- ?p (number-to-string port)
- ?l imap-default-user))))
+ (format-spec cmd `((?s . ,server)
+ (?p . ,(number-to-string port))
+ (?l . ,imap-default-user)))))
response)
(when process
(with-current-buffer buffer
@@ -583,12 +583,9 @@ sure of changing the value of `foo'."
(process-connection-type imap-process-connection-type)
(process (start-process
name buffer shell-file-name shell-command-switch
- (format-spec
- cmd
- (format-spec-make
- ?s server
- ?p (number-to-string port)
- ?l imap-default-user))))
+ (format-spec cmd `((?s . ,server)
+ (?p . ,(number-to-string port))
+ (?l . ,imap-default-user)))))
response)
(when process
(with-current-buffer buffer
@@ -701,13 +698,10 @@ sure of changing the value of `foo'."
(process-connection-type imap-process-connection-type)
(process (start-process
name buffer shell-file-name shell-command-switch
- (format-spec
- cmd
- (format-spec-make
- ?s server
- ?g imap-shell-host
- ?p (number-to-string port)
- ?l imap-default-user)))))
+ (format-spec cmd `((?s . ,server)
+ (?g . ,imap-shell-host)
+ (?p . ,(number-to-string port))
+ (?l . ,imap-default-user))))))
(when process
(while (and (memq (process-status process) '(open run))
(set-buffer buffer) ;; XXX "blue moon" nntp.el bug
@@ -757,7 +751,7 @@ sure of changing the value of `foo'."
(message "imap: Connecting with STARTTLS...%s" (if done "done" "failed"))
done))
-;; Server functions; authenticator stuff:
+;;;; Authenticator functions
(defun imap-interactive-login (buffer loginfunc)
"Login to server in BUFFER.
@@ -881,7 +875,7 @@ t if it successfully authenticates, nil otherwise."
(concat "LOGIN anonymous \"" (concat (user-login-name) "@"
(system-name)) "\"")))))
-;;; Compiler directives.
+;;; Compiler directives
(defvar imap-sasl-client)
(defvar imap-sasl-step)
@@ -979,7 +973,7 @@ t if it successfully authenticates, nil otherwise."
(imap-send-command-1 "")
(imap-ok-p (imap-wait-for-tag tag)))))))
-;; Server functions:
+;;; Server functions
(defun imap-open-1 (buffer)
(with-current-buffer buffer
@@ -1238,7 +1232,7 @@ If BUFFER is nil, the current buffer is assumed."
(imap-send-command-wait "LOGOUT" buffer)))
-;; Mailbox functions:
+;;; Mailbox functions
(defun imap-mailbox-put (propname value &optional mailbox buffer)
(with-current-buffer (or buffer (current-buffer))
@@ -1530,7 +1524,7 @@ or `unseen'. The IMAP command tag is returned."
identifier))))))
-;; Message functions:
+;;; Message functions
(defun imap-current-message (&optional buffer)
(with-current-buffer (or buffer (current-buffer))
@@ -1842,7 +1836,7 @@ on failure."
(if (aref from 0) ">"))))
-;; Internal functions.
+;;; Internal functions
(defun imap-add-callback (tag func)
(setq imap-callbacks (append (list (cons tag func)) imap-callbacks)))
@@ -1979,7 +1973,7 @@ Return nil if no complete line has arrived."
(delete-region (point-min) (point-max)))))))))
-;; Imap parser.
+;;; Imap parser
(defsubst imap-forward ()
(or (eobp) (forward-char)))
@@ -2860,6 +2854,8 @@ Return nil if no complete line has arrived."
(imap-forward)
(nreverse body)))))
+;;; Debug
+
(when imap-debug ; (untrace-all)
(require 'trace)
(buffer-disable-undo (get-buffer-create imap-debug-buffer))
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index e42a7655ef3..700653250fb 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -727,7 +727,7 @@ an alist of attribute/value pairs."
(setq record nil)
(skip-chars-forward " \t\n")
(message "Parsing results... %d" numres)
- (1+ numres))
+ (setq numres (1+ numres)))
(message "Parsing results... done")
(nreverse result)))))
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 5fe5b4d3a54..94cd9e21566 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -29,6 +29,7 @@
;;; Code:
+(require 'cl-lib)
(autoload 'mail-header-parse-content-type "mail-parse")
(defgroup mailcap nil
@@ -268,11 +269,6 @@ is consulted."
(viewer . "display %s")
(type . "image/*")
(test . (eq window-system 'x))
- ("needsx11"))
- (".*"
- (viewer . "ee %s")
- (type . "image/*")
- (test . (eq window-system 'x))
("needsx11")))
("text"
("plain"
@@ -337,6 +333,10 @@ is a string or list of strings, it represents a shell command to run
to return a true or false shell value for the validity.")
(put 'mailcap-mime-data 'risky-local-variable t)
+(defvar mailcap--computed-mime-data nil
+ "Computed version of the mailcap data incorporating all sources.
+Same format as `mailcap-mime-data'.")
+
(defcustom mailcap-download-directory nil
"Directory to which `mailcap-save-binary-file' downloads files by default.
nil means your home directory."
@@ -422,7 +422,13 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
(when (or (not mailcap-parsed-p)
force)
;; Clear out all old data.
- (setq mailcap-mime-data nil)
+ (setq mailcap--computed-mime-data nil)
+ ;; Add the Emacs-distributed defaults (which will be used as
+ ;; fallbacks). Do it this way instead of just copying the list,
+ ;; since entries are destructively modified.
+ (cl-loop for (major . minors) in mailcap-mime-data
+ do (cl-loop for (minor . entry) in minors
+ do (mailcap-add-mailcap-entry major minor entry)))
(cond
(path nil)
((getenv "MAILCAPS")
@@ -709,10 +715,13 @@ to supply to the test."
(push (list otest result) mailcap-viewer-test-cache)
result))))
-(defun mailcap-add-mailcap-entry (major minor info)
- (let ((old-major (assoc major mailcap-mime-data)))
+(defun mailcap-add-mailcap-entry (major minor info &optional storage)
+ (let* ((storage (or storage 'mailcap--computed-mime-data))
+ (old-major (assoc major (symbol-value storage))))
(if (null old-major) ; New major area
- (push (cons major (list (cons minor info))) mailcap-mime-data)
+ (set storage
+ (cons (cons major (list (cons minor info)))
+ (symbol-value storage)))
(let ((cur-minor (assoc minor old-major)))
(cond
((or (null cur-minor) ; New minor area, or
@@ -736,11 +745,15 @@ If TEST is not given, it defaults to t."
(when (or (not (car tl))
(not (cadr tl)))
(error "%s is not a valid MIME type" type))
- (mailcap-add-mailcap-entry
- (car tl) (cadr tl)
- `((viewer . ,viewer)
- (test . ,(if test test t))
- (type . ,type)))))
+ (let ((entry
+ `((viewer . ,viewer)
+ (test . ,(if test test t))
+ (type . ,type))))
+ ;; Store it.
+ (mailcap-add-mailcap-entry (car tl) (cadr tl) entry
+ 'mailcap-user-mime-data)
+ ;; Make it available for usage.
+ (mailcap-add-mailcap-entry (car tl) (cadr tl) entry))))
;;;
;;; The main whabbo
@@ -791,13 +804,13 @@ If NO-DECODE is non-nil, don't decode STRING."
;; NO-DECODE avoids calling `mail-header-parse-content-type' from
;; `mail-parse.el'
(let (
- major ; Major encoding (text, etc)
- minor ; Minor encoding (html, etc)
- info ; Other info
- major-info ; (assoc major mailcap-mime-data)
- viewers ; Possible viewers
- passed ; Viewers that passed the test
- viewer ; The one and only viewer
+ major ; Major encoding (text, etc)
+ minor ; Minor encoding (html, etc)
+ info ; Other info
+ major-info ; (assoc major mailcap--computed-mime-data)
+ viewers ; Possible viewers
+ passed ; Viewers that passed the test
+ viewer ; The one and only viewer
ctl)
(save-excursion
(setq ctl
@@ -809,12 +822,12 @@ If NO-DECODE is non-nil, don't decode STRING."
(if viewer
(setq passed (list viewer))
;; None found, so heuristically select some applicable viewer
- ;; from `mailcap-mime-data'.
+ ;; from `mailcap--computed-mime-data'.
(mailcap-parse-mailcaps nil t)
(setq major (split-string (car ctl) "/"))
(setq minor (cadr major)
major (car major))
- (when (setq major-info (cdr (assoc major mailcap-mime-data)))
+ (when (setq major-info (cdr (assoc major mailcap--computed-mime-data)))
(when (setq viewers (mailcap-possible-viewers major-info minor))
(setq info (mapcar (lambda (a)
(cons (symbol-name (car a)) (cdr a)))
@@ -847,7 +860,7 @@ If NO-DECODE is non-nil, don't decode STRING."
((eq request 'all)
passed)
(t
- ;; MUST make a copy *sigh*, else we modify mailcap-mime-data
+ ;; MUST make a copy *sigh*, else we modify mailcap--computed-mime-data
(setq viewer (copy-sequence viewer))
(let ((view (assq 'viewer viewer))
(test (assq 'test viewer)))
@@ -1057,7 +1070,7 @@ For instance, \"foo.png\" will result in \"image/png\"."
(nconc
(mapcar 'cdr mailcap-mime-extensions)
(let (res type)
- (dolist (data mailcap-mime-data)
+ (dolist (data mailcap--computed-mime-data)
(dolist (info (cdr data))
(setq type (cdr (assq 'type (cdr info))))
(unless (string-match-p "\\*" type)
@@ -1117,14 +1130,18 @@ For instance, \"foo.png\" will result in \"image/png\"."
(defun mailcap-view-mime (type)
"View the data in the current buffer that has MIME type TYPE.
-`mailcap-mime-data' determines the method to use."
+`mailcap--computed-mime-data' determines the method to use."
(let ((method (mailcap-mime-info type)))
(if (stringp method)
- (shell-command-on-region (point-min) (point-max)
- ;; Use stdin as the "%s".
- (format method "-")
- (current-buffer)
- t)
+ (let ((file (make-temp-file "emacs-mailcap" nil
+ (cadr (split-string type "/")))))
+ (unwind-protect
+ (let ((coding-system-for-write 'binary))
+ (write-region (point-min) (point-max) file nil 'silent)
+ (delete-region (point-min) (point-max))
+ (shell-command (format method file)))
+ (when (file-exists-p file)
+ (delete-file file))))
(funcall method))))
(provide 'mailcap)
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index ef3651b0335..8c7d33a67d4 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -771,7 +771,7 @@ This command uses `smbclient-program' to connect to HOST."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Full list is available at:
-;; http://www.iana.org/assignments/port-numbers
+;; https://www.iana.org/assignments/port-numbers
(defvar network-connection-service-alist
(list
(cons 'echo 7)
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index e99d7a372c0..e86426d4664 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -113,6 +113,10 @@ values:
`ssl' -- Equivalent to `tls'.
`shell' -- A shell connection.
+:coding is a symbol or a cons used to specify the coding systems
+used to decode and encode the data which the process reads and
+writes. See `make-network-process' for details.
+
:return-list specifies this function's return value.
If omitted or nil, return a process object. A non-nil means to
return (PROC . PROPS), where PROC is a process object and PROPS
@@ -135,7 +139,10 @@ values:
:capability-command specifies a command used to query the HOST
for its capabilities. For instance, for IMAP this should be
- \"1 CAPABILITY\\r\\n\".
+ \"1 CAPABILITY\\r\\n\". This can either be a string (which will
+ then be sent verbatim to the server), or a function (called with
+ a single parameter; the \"greeting\" from the server when connecting),
+ and should return a string to send to the server.
:starttls-function specifies a function for handling STARTTLS.
This function should take one parameter, the response to the
@@ -166,8 +173,8 @@ a greeting from the server.
:nowait, if non-nil, says the connection should be made
asynchronously, if possible.
-:shell-command is a format-spec string that can be used if :type
-is `shell'. It has two specs, %s for host and %p for port
+:shell-command is a `format-spec' string that can be used if
+:type is `shell'. It has two specs, %s for host and %p for port
number. Example: \"ssh gateway nc %s %p\".
:tls-parameters is a list that should be supplied if you're
@@ -189,7 +196,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
:host (puny-encode-domain host) :service service
:nowait (plist-get parameters :nowait)
:tls-parameters
- (plist-get parameters :tls-parameters))
+ (plist-get parameters :tls-parameters)
+ :coding (plist-get parameters :coding))
(let ((work-buffer (or buffer
(generate-new-buffer " *stream buffer*")))
(fun (cond ((and (eq type 'plain)
@@ -249,7 +257,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
(stream (make-network-process :name name :buffer buffer
:host (puny-encode-domain host)
:service service
- :nowait (plist-get parameters :nowait))))
+ :nowait (plist-get parameters :nowait)
+ :coding (plist-get parameters :coding))))
(when (plist-get parameters :warn-unless-encrypted)
(setq stream (nsm-verify-connection stream host service nil t)))
(list stream
@@ -270,11 +279,15 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
;; Return (STREAM GREETING CAPABILITIES RESULTING-TYPE)
(stream (make-network-process :name name :buffer buffer
:host (puny-encode-domain host)
- :service service))
+ :service service
+ :coding (plist-get parameters :coding)))
(greeting (and (not (plist-get parameters :nogreeting))
(network-stream-get-response stream start eoc)))
- (capabilities (network-stream-command stream capability-command
- eo-capa))
+ (capabilities
+ (network-stream-command
+ stream
+ (network-stream--capability-command capability-command greeting)
+ eo-capa))
(resulting-type 'plain)
starttls-available starttls-command error)
@@ -322,7 +335,10 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
;; Requery capabilities for protocols that require it; i.e.,
;; EHLO for SMTP.
(when (plist-get parameters :always-query-capabilities)
- (network-stream-command stream capability-command eo-capa)))
+ (network-stream-command
+ stream
+ (network-stream--capability-command capability-command greeting)
+ eo-capa)))
(when (let ((response
(network-stream-command stream starttls-command eoc)))
(and response (string-match success-string response)))
@@ -350,14 +366,18 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
(setq stream
(make-network-process :name name :buffer buffer
:host (puny-encode-domain host)
- :service service))
+ :service service
+ :coding (plist-get parameters :coding)))
(network-stream-get-response stream start eoc)))
(unless (process-live-p stream)
(error "Unable to negotiate a TLS connection with %s/%s"
host service))
;; Re-get the capabilities, which may have now changed.
(setq capabilities
- (network-stream-command stream capability-command eo-capa))))
+ (network-stream-command
+ stream
+ (network-stream--capability-command capability-command greeting)
+ eo-capa))))
;; If TLS is mandatory, close the connection if it's unencrypted.
(when (and require-tls
@@ -420,7 +440,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
parameters)
(require 'tls)
(open-tls-stream name buffer host service)))
- (eoc (plist-get parameters :end-of-command)))
+ (eoc (plist-get parameters :end-of-command))
+ greeting)
(if (plist-get parameters :nowait)
(list stream nil nil 'tls)
;; Check certificate validity etc.
@@ -432,42 +453,58 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
;; openssl/gnutls-cli.
(when (and (not (gnutls-available-p))
eoc)
- (network-stream-get-response stream start eoc)
+ (setq greeting (network-stream-get-response stream start eoc))
(goto-char (point-min))
(when (re-search-forward eoc nil t)
(goto-char (match-beginning 0))
(delete-region (point-min) (line-beginning-position))))
- (let ((capability-command (plist-get parameters :capability-command))
+ (let ((capability-command
+ (plist-get parameters :capability-command))
(eo-capa (or (plist-get parameters :end-of-capability)
eoc)))
(list stream
(network-stream-get-response stream start eoc)
- (network-stream-command stream capability-command eo-capa)
+ (network-stream-command
+ stream
+ (network-stream--capability-command
+ capability-command greeting)
+ eo-capa)
'tls)))))))
-(declare-function format-spec "format-spec" (format spec))
-(declare-function format-spec-make "format-spec" (&rest pairs))
-
(defun network-stream-open-shell (name buffer host service parameters)
- (require 'format-spec)
(let* ((capability-command (plist-get parameters :capability-command))
(eoc (plist-get parameters :end-of-command))
(start (with-current-buffer buffer (point)))
+ (coding (plist-get parameters :coding))
(stream (let ((process-connection-type nil))
(start-process name buffer shell-file-name
shell-command-switch
(format-spec
(plist-get parameters :shell-command)
- (format-spec-make
- ?s host
- ?p service))))))
+ `((?s . ,host)
+ (?p . ,service))))))
+ greeting)
+ (when coding (if (consp coding)
+ (set-process-coding-system stream
+ (car coding)
+ (cdr coding))
+ (set-process-coding-system stream
+ coding
+ coding)))
(list stream
- (network-stream-get-response stream start eoc)
- (network-stream-command stream capability-command
- (or (plist-get parameters :end-of-capability)
- eoc))
+ (setq greeting (network-stream-get-response stream start eoc))
+ (network-stream-command
+ stream
+ (network-stream--capability-command capability-command greeting)
+ (or (plist-get parameters :end-of-capability)
+ eoc))
'plain)))
+(defun network-stream--capability-command (command greeting)
+ (if (functionp command)
+ (funcall command greeting)
+ command))
+
(provide 'network-stream)
;;; network-stream.el ends here
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index eb61d7a6796..f45abf780f7 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -68,9 +68,6 @@ 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
'(
- ;; 2017/12: no response.
-;;; ("CNET News.com"
-;;; "http://export.cnet.com/export/feeds/news/rss/1,11176,,00.xml")
("Debian Security Advisories"
"http://www.debian.org/security/dsa.en.rdf")
("Debian Security Advisories - Long format"
@@ -81,11 +78,6 @@ considered to be running if the newsticker timer list is not empty."
3600)
("LWN (Linux Weekly News)"
"https://lwn.net/headlines/rss")
- ;; Not updated since 2010.
-;;; ("NY Times: Technology"
-;;; "http://www.nytimes.com/services/xml/rss/userland/Technology.xml")
-;;; ("NY Times"
-;;; "http://www.nytimes.com/services/xml/rss/userland/HomePage.xml")
("Quote of the day"
"http://feeds.feedburner.com/quotationspage/qotd"
"07:00"
@@ -363,7 +355,7 @@ description are marked as immortal."
(const :tag "Title" title)
(const :tag "Description" description)
(const :tag "All" all))
- (string :tag "Regexp")))))
+ (regexp :tag "Regexp")))))
:group 'newsticker-headline-processing)
;; ======================================================================
@@ -898,7 +890,7 @@ Argument BUFFER is the buffer of the retrieval process."
;; Atom 1.0 feed.
;; (and (eq 'feed (xml-node-name topnode))
- ;; (string= "http://www.w3.org/2005/Atom"
+ ;; (string= "https://www.w3.org/2005/Atom"
;; (xml-get-attribute topnode 'xmlns)))
(setq image-url (newsticker--get-logo-url-atom-1.0 topnode))
(setq icon-url (newsticker--get-icon-url-atom-1.0 topnode))
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index 1bed61f3e7d..ff8a447c7c1 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -131,14 +131,6 @@ groupcontent := feedname | groupdefinition)
Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\")
\"feed3\")")
-(defcustom newsticker-groups-filename
- nil
- "Name of the newsticker groups settings file."
- :version "25.1" ; changed default value to nil
- :type '(choice (const nil) string)
- :group 'newsticker-treeview)
-(make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1")
-
;; ======================================================================
;;; internal variables
;; ======================================================================
@@ -1265,29 +1257,9 @@ Note: does not update the layout."
(defun newsticker--treeview-load ()
"Load treeview settings."
(let* ((coding-system-for-read 'utf-8)
- (filename
- (or (and newsticker-groups-filename
- (not (string=
- (expand-file-name newsticker-groups-filename)
- (expand-file-name (concat newsticker-dir "/groups"))))
- (file-exists-p newsticker-groups-filename)
- (y-or-n-p
- (format-message
- (concat "Obsolete variable `newsticker-groups-filename' "
- "points to existing file \"%s\".\n"
- "Read it? ")
- newsticker-groups-filename))
- newsticker-groups-filename)
- (concat newsticker-dir "/groups")))
+ (filename (concat newsticker-dir "/groups"))
(buf (and (file-exists-p filename)
(find-file-noselect filename))))
- (and newsticker-groups-filename
- (file-exists-p newsticker-groups-filename)
- (y-or-n-p (format-message
- (concat "Delete the file \"%s\",\nto which the obsolete "
- "variable `newsticker-groups-filename' points ? ")
- newsticker-groups-filename))
- (delete-file newsticker-groups-filename))
(when buf
(set-buffer buf)
(goto-char (point-min))
diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el
index 6329e7660f7..535122a31fb 100644
--- a/lisp/net/newsticker.el
+++ b/lisp/net/newsticker.el
@@ -54,7 +54,7 @@
;; as well as the following Atom formats:
;; * Atom 0.3
;; * Atom 1.0
-;; (see http://www.ietf.org/internet-drafts/draft-ietf-atompub-format-11.txt)
+;; (see https://www.ietf.org/internet-drafts/draft-ietf-atompub-format-11.txt)
;; That makes Newsticker.el an "Atom aggregator, "RSS reader", "RSS
;; aggregator", and "Feed Reader".
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index f84c1b3094f..2b300401650 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -311,9 +311,9 @@ See also: `network-security-protocol-checks' and `nsm-noninteractive'"
(map-values results)
"\n")
"\n")
- "\n* ")))))
- (delete-process process)
- (setq process nil)))
+ "\n* "))))))
+ (delete-process process)
+ (setq process nil))
(run-hook-with-args 'nsm-tls-post-check-functions
host port status settings results)))
process)
@@ -371,7 +371,7 @@ Reference:
Sheffer, Holz, Saint-Andre (May 2015). \"Recommendations for Secure
Use of Transport Layer Security (TLS) and Datagram Transport Layer
Security (DTLS)\", \"(4.1. General Guidelines)\"
-`https://tools.ietf.org/html/rfc7525\#section-4.1'"
+`https://tools.ietf.org/html/rfc7525#section-4.1'"
(let ((kx (plist-get status :key-exchange)))
(and (string-match "^\\bRSA\\b" kx)
(format-message
@@ -468,7 +468,7 @@ Reference:
GnuTLS authors (2018). \"GnuTLS Manual 4.3.3 Anonymous
authentication\",
-`https://www.gnutls.org/manual/gnutls.html\#Anonymous-authentication'"
+`https://www.gnutls.org/manual/gnutls.html#Anonymous-authentication'"
(let ((kx (plist-get status :key-exchange)))
(and (string-match "\\bANON\\b" kx)
(format-message
@@ -603,7 +603,7 @@ References:
full SHA-1\", `https://shattered.io/static/shattered.pdf'
[2]: Chromium Security Education TLS/SSL. \"Deprecated and Removed
Features (SHA-1 Certificate Signatures)\",
-`https://www.chromium.org/Home/chromium-security/education/tls\#TOC-SHA-1-Certificate-Signatures'
+`https://www.chromium.org/Home/chromium-security/education/tls#TOC-SHA-1-Certificate-Signatures'
[3]: Jones J.C (2017). \"The end of SHA-1 on the Public Web\",
`https://blog.mozilla.org/security/2017/02/23/the-end-of-sha-1-on-the-public-web/'
[4]: Apple Support (2017). \"Move to SHA-256 signed certificates to
@@ -964,6 +964,7 @@ protocol."
(defun nsm-write-settings ()
(with-temp-file nsm-settings-file
+ (insert ";;;; -*- mode: lisp-data -*-\n")
(insert "(\n")
(dolist (setting nsm-permanent-host-settings)
(insert " ")
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index ebcd21948bf..9401430799c 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -69,7 +69,6 @@
(require 'md4)
(require 'hmac-md5)
-(require 'calc)
(defgroup ntlm nil
"NTLM (NT LanManager) authentication."
@@ -133,32 +132,27 @@ is not given."
domain ;buffer field
))))
-(defun ntlm-compute-timestamp ()
- "Compute an NTLMv2 timestamp.
+(defun ntlm--time-to-timestamp (time)
+ "Convert TIME to an NTLMv2 timestamp.
Return a unibyte string representing the number of tenths of a
microsecond since January 1, 1601 as a 64-bit little-endian
-signed integer."
- ;; FIXME: This can likely be significantly simplified using the new
- ;; bignums support!
- (let* ((s-to-tenths-of-us "mul(add(lsh($1,16),$2),10000000)")
- (us-to-tenths-of-us "mul($3,10)")
- (ps-to-tenths-of-us "idiv($4,100000)")
- (tenths-of-us-since-jan-1-1601
- (apply #'calc-eval (concat "add(add(add("
- s-to-tenths-of-us ","
- us-to-tenths-of-us "),"
- ps-to-tenths-of-us "),"
- ;; tenths of microseconds between
- ;; 1601-01-01 and 1970-01-01
- "116444736000000000)")
- 'rawnum (time-convert nil 'list)))
- result-bytes)
- (dotimes (_byte 8)
- (push (calc-eval "and($1,16#FF)" 'rawnum tenths-of-us-since-jan-1-1601)
- result-bytes)
- (setq tenths-of-us-since-jan-1-1601
- (calc-eval "rsh($1,8,64)" 'rawnum tenths-of-us-since-jan-1-1601)))
- (apply #'unibyte-string (nreverse result-bytes))))
+signed integer. TIME must be on the form (HIGH LOW USEC PSEC)."
+ (let* ((s (+ (ash (nth 0 time) 16) (nth 1 time)))
+ (us (nth 2 time))
+ (ps (nth 3 time))
+ (tenths-of-us-since-jan-1-1601
+ (+ (* s 10000000) (* us 10) (/ ps 100000)
+ ;; tenths of microseconds between 1601-01-01 and 1970-01-01
+ 116444736000000000)))
+ (apply #'unibyte-string
+ (mapcar (lambda (i)
+ (logand (ash tenths-of-us-since-jan-1-1601 (* i -8))
+ #xff))
+ (number-sequence 0 7)))))
+
+(defun ntlm-compute-timestamp ()
+ "Current time as an NTLMv2 timestamp, as a unibyte string."
+ (ntlm--time-to-timestamp (time-convert nil 'list)))
(defun ntlm-generate-nonce ()
"Generate a random nonce, not to be used more than once.
diff --git a/lisp/net/puny.el b/lisp/net/puny.el
index 60a6c12e6c7..5c58fe02cbf 100644
--- a/lisp/net/puny.el
+++ b/lisp/net/puny.el
@@ -1,4 +1,4 @@
-;;; puny.el --- translate non-ASCII domain names to ASCII
+;;; puny.el --- translate non-ASCII domain names to ASCII -*- lexical-binding:t -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
@@ -23,7 +23,7 @@
;;; Commentary:
;; Written by looking at
-;; http://stackoverflow.com/questions/183485/can-anyone-recommend-a-good-free-javascript-for-punycode-to-unicode-conversion
+;; https://stackoverflow.com/questions/183485/can-anyone-recommend-a-good-free-javascript-for-punycode-to-unicode-conversion
;;; Code:
@@ -35,7 +35,7 @@
For instance, \"fśf.org\" => \"xn--ff-2sa.org\"."
;; The vast majority of domain names are not IDNA domain names, so
;; add a check first to avoid doing unnecessary work.
- (if (string-match "\\'[[:ascii:]]+\\'" domain)
+ (if (string-match "\\`[[:ascii:]]+\\'" domain)
domain
(mapconcat 'puny-encode-string (split-string domain "[.]") ".")))
@@ -196,12 +196,12 @@ For instance \"xn--bcher-kva\" => \"bücher\"."
(cl-incf i)))
(buffer-string)))
-;; http://www.unicode.org/reports/tr39/#Restriction_Level_Detection
-;; http://www.unicode.org/reports/tr31/#Table_Candidate_Characters_for_Inclusion_in_Identifiers
+;; https://www.unicode.org/reports/tr39/#Restriction_Level_Detection
+;; https://www.unicode.org/reports/tr31/#Table_Candidate_Characters_for_Inclusion_in_Identifiers
(defun puny-highly-restrictive-string-p (string)
"Say whether STRING is \"highly restrictive\" in the Unicode IDNA sense.
-See http://www.unicode.org/reports/tr39/#Restriction_Level_Detection
+See https://www.unicode.org/reports/tr39/#Restriction_Level_Detection
for details. The main idea is that if you're mixing
scripts (like latin and cyrillic), you may confuse the user by
using homographs."
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index fff640bb675..f296ae3afe1 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -254,7 +254,7 @@ Examples:
(\"bitlbee\" bitlbee \"robert\" \"sekrit\")
(\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\")
(\"quakenet.org\" quakenet \"bobby\" \"sekrit\"))"
- :type '(alist :key-type (string :tag "Server")
+ :type '(alist :key-type (regexp :tag "Server")
:value-type (choice (list :tag "NickServ"
(const nickserv)
(string :tag "Nick")
@@ -359,9 +359,9 @@ If VAL is a coding system, it is used for both decoding and encoding
messages.
If VAL is a cons of coding systems, the car part is used for decoding,
and the cdr part is used for encoding."
- :type '(alist :key-type (choice (string :tag "Channel Regexp")
- (cons (string :tag "Channel Regexp")
- (string :tag "Server Regexp")))
+ :type '(alist :key-type (choice (regexp :tag "Channel Regexp")
+ (cons (regexp :tag "Channel Regexp")
+ (regexp :tag "Server Regexp")))
:value-type (choice coding-system
(cons (coding-system :tag "Decode")
(coding-system :tag "Encode")))))
@@ -625,7 +625,7 @@ SERVER-PLIST is the property list for the server."
(default (or (plist-get server-plist :encryption)
"plain")))
(intern
- (completing-read (format "Encryption (default %s): " default)
+ (completing-read (format-prompt "Encryption" default)
choices nil t nil nil default))))
(defun rcirc-keepalive ()
@@ -2421,7 +2421,7 @@ keywords when no KEYWORD is given."
(concat
"\\(?:"
;; Match paired parentheses, e.g. in Wikipedia URLs:
- "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]"
+ "[" chars punct "]+" "(" "[" chars punct "]+" ")" "[" chars "]"
"\\|"
"[" chars punct "]+" "[" chars "]"
"\\)"))
@@ -2626,12 +2626,16 @@ the only argument."
(and ;; nickserv
(string= sender "NickServ")
(string= target rcirc-nick)
- (member message
- (list
- (format "You are now identified for \C-b%s\C-b." rcirc-nick)
- (format "You are successfully identified as \C-b%s\C-b." rcirc-nick)
- "Password accepted - you are now recognized."
- )))
+ (cl-member
+ message
+ (list
+ (format "You are now identified for \C-b%s\C-b." rcirc-nick)
+ (format "You are successfully identified as \C-b%s\C-b."
+ rcirc-nick)
+ "Password accepted - you are now recognized.")
+ ;; The nick may have a different case, so match
+ ;; case-insensitively (Bug#39345).
+ :test #'cl-equalp))
(and ;; quakenet
(string= sender "Q")
(string= target rcirc-nick)
diff --git a/lisp/net/sasl-scram-sha256.el b/lisp/net/sasl-scram-sha256.el
new file mode 100644
index 00000000000..e50a032c233
--- /dev/null
+++ b/lisp/net/sasl-scram-sha256.el
@@ -0,0 +1,59 @@
+;;; sasl-scram-sha256.el --- SCRAM-SHA-256 module for the SASL client framework -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+;; Package: sasl
+
+;; 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:
+
+;; Implement the SCRAM-SHA-256 mechanism from RFC 7677.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'sasl)
+(require 'hex-util)
+(require 'rfc2104)
+(require 'sasl-scram-rfc)
+
+;;; SCRAM-SHA-256
+
+(defconst sasl-scram-sha-256-steps
+ '(sasl-scram-client-first-message
+ sasl-scram-sha-256-client-final-message
+ sasl-scram-sha-256-authenticate-server))
+
+(defun sasl-scram-sha256 (object &optional start end binary)
+ (secure-hash 'sha256 object start end binary))
+
+(defun sasl-scram-sha-256-client-final-message (client step)
+ (sasl-scram--client-final-message
+ ;; HMAC-SHA256 uses block length 64 and hash length 32; see RFC 4634.
+ 'sasl-scram-sha256 64 32 client step))
+
+(defun sasl-scram-sha-256-authenticate-server (client step)
+ (sasl-scram--authenticate-server
+ 'sasl-scram-sha256 64 32 client step))
+
+(put 'sasl-scram-sha256 'sasl-mechanism
+ (sasl-make-mechanism "SCRAM-SHA-256" sasl-scram-sha-256-steps))
+
+(provide 'sasl-scram-sha256)
+
+;;; sasl-scram-sha256.el ends here
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index 4405c904cd3..ab118e1f982 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -35,8 +35,8 @@
;;; Code:
(defvar sasl-mechanisms
- '("SCRAM-SHA-1" "CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"
- "NTLM"))
+ '("SCRAM-SHA-256" "SCRAM-SHA-1" "CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN"
+ "ANONYMOUS" "NTLM"))
(defvar sasl-mechanism-alist
'(("CRAM-MD5" sasl-cram)
@@ -45,6 +45,7 @@
("LOGIN" sasl-login)
("ANONYMOUS" sasl-anonymous)
("NTLM" sasl-ntlm)
+ ("SCRAM-SHA-256" sasl-scram-sha256)
("SCRAM-SHA-1" sasl-scram-rfc)))
(defvar sasl-unique-id-function #'sasl-unique-id-function)
diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el
index 10d061fba20..dc1b468a118 100644
--- a/lisp/net/secrets.el
+++ b/lisp/net/secrets.el
@@ -23,7 +23,7 @@
;;; Commentary:
;; This package provides an implementation of the Secret Service API
-;; <http://www.freedesktop.org/wiki/Specifications/secret-storage-spec>.
+;; <https://www.freedesktop.org/wiki/Specifications/secret-storage-spec>.
;; This API is meant to make GNOME-Keyring- and KWallet-like daemons
;; available under a common D-BUS interface and thus increase
;; interoperability between GNOME, KDE and other applications having
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 241180d471a..88e691752ab 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -95,15 +95,31 @@ If nil, don't draw horizontal table lines."
:type 'character)
(defcustom shr-width nil
- "Frame width to use for rendering.
+ "Window width to use for HTML rendering.
May either be an integer specifying a fixed width in characters,
-or nil, meaning that the full width of the window should be used.
-If `shr-use-fonts' is set, the mean character width is used to
-compute the pixel width, which is used instead."
+or nil, meaning use the full width of the window.
+If `shr-use-fonts' is set, the value is interpreted as a multiple
+of the mean character width of the default face's font.
+
+Also see `shr-max-width'."
:version "25.1"
:type '(choice (integer :tag "Fixed width in characters")
(const :tag "Use the width of the window" nil)))
+(defcustom shr-max-width 120
+ "Maximum text width to use for HTML rendering.
+May either be an integer specifying a fixed width in characters,
+or nil, meaning that there is no width limit.
+
+If `shr-use-fonts' is set, the value of this variable is
+interpreted as a multiple of the mean character width of the
+default face's font.
+
+If `shr-width' is non-nil, it overrides this variable."
+ :version "28.1"
+ :type '(choice (integer :tag "Fixed width in characters")
+ (const :tag "No width limit" nil)))
+
(defcustom shr-bullet "* "
"Bullet used for unordered lists.
Alternative suggestions are:
@@ -135,7 +151,7 @@ same domain as the main data."
This is used for cid: URLs, and the function is called with the
cid: URL as the argument.")
-(defvar shr-put-image-function 'shr-put-image
+(defvar shr-put-image-function #'shr-put-image
"Function called to put image and alt string.")
(defface shr-strike-through '((t :strike-through t))
@@ -185,13 +201,15 @@ and other things:
(defvar shr-depth 0)
(defvar shr-warning nil)
(defvar shr-ignore-cache nil)
-(defvar shr-target-id nil)
(defvar shr-table-separator-length 1)
(defvar shr-table-separator-pixel-width 0)
(defvar shr-table-id nil)
(defvar shr-current-font nil)
(defvar shr-internal-bullet nil)
+(defvar shr-target-id nil
+ "Target fragment identifier anchor.")
+
(defvar shr-map
(let ((map (make-sparse-keymap)))
(define-key map "a" 'shr-show-alt-text)
@@ -265,30 +283,37 @@ DOM should be a parse tree as generated by
(shr-table-separator-pixel-width (shr-string-pixel-width "-"))
(shr-internal-bullet (cons shr-bullet
(shr-string-pixel-width shr-bullet)))
- (shr-internal-width (or (and shr-width
- (if (not shr-use-fonts)
- shr-width
- (* shr-width (frame-char-width))))
- ;; We need to adjust the available
- ;; width for when the user disables
- ;; the fringes, which will cause the
- ;; display engine usurp one column for
- ;; the continuation glyph.
- (if (not shr-use-fonts)
- (- (window-body-width) 1
- (if (and (null shr-width)
- (not (shr--have-one-fringe-p)))
- 0
- 1))
- (- (window-body-width nil t)
- (* 2 (frame-char-width))
- (if (and (null shr-width)
- (not (shr--have-one-fringe-p)))
- (* (frame-char-width) 2)
- 0)
- 1))))
+ (shr-internal-width
+ (if shr-width
+ ;; Specified width; use it.
+ (if (not shr-use-fonts)
+ shr-width
+ (* shr-width (frame-char-width)))
+ ;; Compute the width based on the window width. We need to
+ ;; adjust the available width for when the user disables
+ ;; the fringes, which will cause the display engine usurp
+ ;; one column for the continuation glyph.
+ (if (not shr-use-fonts)
+ (- (window-body-width) 1
+ (if (shr--have-one-fringe-p)
+ 1
+ 0))
+ (- (window-body-width nil t)
+ (* 2 (frame-char-width))
+ (if (shr--have-one-fringe-p)
+ 0
+ (* (frame-char-width) 2))
+ 1))))
(max-specpdl-size max-specpdl-size)
bidi-display-reordering)
+ ;; Adjust for max width specification.
+ (when (and shr-max-width
+ (not shr-width))
+ (setq shr-internal-width
+ (min shr-internal-width
+ (if shr-use-fonts
+ (* shr-max-width (frame-char-width))
+ shr-max-width))))
;; If the window was hscrolled for some reason, shr-fill-lines
;; below will misbehave, because it silently assumes that it
;; starts with a non-hscrolled window (vertical-motion will move
@@ -365,25 +390,20 @@ If the URL is already at the front of the kill ring act like
(shr-copy-url url)))
(defun shr--current-link-region ()
- (let ((current (get-text-property (point) 'shr-url))
- start)
- (save-excursion
- ;; Go to the beginning.
- (while (and (not (bobp))
- (equal (get-text-property (point) 'shr-url) current))
- (forward-char -1))
- (unless (equal (get-text-property (point) 'shr-url) current)
- (forward-char 1))
- (setq start (point))
- ;; Go to the end.
- (while (and (not (eobp))
- (equal (get-text-property (point) 'shr-url) current))
- (forward-char 1))
- (list start (point)))))
+ "Return the start and end positions of the URL at point, if any.
+Value is a pair of positions (START . END) if there is a non-nil
+`shr-url' text property at point; otherwise nil."
+ (when (get-text-property (point) 'shr-url)
+ (let* ((end (or (next-single-property-change (point) 'shr-url)
+ (point-max)))
+ (beg (or (previous-single-property-change end 'shr-url)
+ (point-min))))
+ (cons beg end))))
(defun shr--blink-link ()
- (let* ((region (shr--current-link-region))
- (overlay (make-overlay (car region) (cadr region))))
+ "Briefly fontify URL at point with the face `shr-selected-link'."
+ (when-let* ((region (shr--current-link-region))
+ (overlay (make-overlay (car region) (cdr region))))
(overlay-put overlay 'face 'shr-selected-link)
(run-at-time 1 nil (lambda ()
(delete-overlay overlay)))))
@@ -437,7 +457,7 @@ the URL of the image to the kill buffer instead."
(if (not url)
(message "No image under point")
(message "Inserting %s..." url)
- (url-retrieve url 'shr-image-fetched
+ (url-retrieve url #'shr-image-fetched
(list (current-buffer) (1- (point)) (point-marker))
t))))
@@ -463,7 +483,7 @@ size, and full-buffer size."
(when (> (- (point) start) 2)
(delete-region start (1- (point)))))
(message "Inserting %s..." url)
- (url-retrieve url 'shr-image-fetched
+ (url-retrieve url #'shr-image-fetched
(list (current-buffer) (1- (point)) (point-marker)
(list (cons 'size
(cond ((or (eq size 'default)
@@ -493,7 +513,7 @@ size, and full-buffer size."
((fboundp function)
(apply function dom args))
(t
- (apply 'shr-generic dom args)))))
+ (apply #'shr-generic dom args)))))
(defun shr-descend (dom)
(let ((function
@@ -531,13 +551,16 @@ size, and full-buffer size."
(funcall function dom))
(t
(shr-generic dom)))
- (when (and shr-target-id
- (equal (dom-attr dom 'id) shr-target-id))
+ (when-let* ((id (dom-attr dom 'id)))
;; If the element was empty, we don't have anything to put the
;; anchor on. So just insert a dummy character.
(when (= start (point))
- (insert "*"))
- (put-text-property start (1+ start) 'shr-target-id shr-target-id))
+ (if (not (bolp))
+ (insert ? )
+ (insert ? )
+ (shr-mark-fill start))
+ (put-text-property (1- (point)) (point) 'display ""))
+ (put-text-property start (1+ start) 'shr-target-id id))
;; If style is set, then this node has set the color.
(when style
(shr-colorize-region
@@ -655,8 +678,11 @@ size, and full-buffer size."
(goto-char start)
(when (looking-at "[ \t\n\r]+")
(replace-match "" t t))
- (while (re-search-forward "[ \t\n\r]+" nil t)
+ (while (re-search-forward "[\t\n\r]+" nil t)
(replace-match " " t t))
+ (goto-char start)
+ (while (re-search-forward " +" nil t)
+ (replace-match " " t t))
(shr--translate-insertion-chars)
(goto-char (point-max)))
;; We may have removed everything we inserted if it was just
@@ -694,7 +720,8 @@ size, and full-buffer size."
(forward-char 1))))
(defun shr-fill-line ()
- (let ((shr-indentation (get-text-property (point) 'shr-indentation))
+ (let ((shr-indentation (or (get-text-property (point) 'shr-indentation)
+ shr-indentation))
(continuation (get-text-property
(point) 'shr-continuation-indentation))
start)
@@ -730,10 +757,11 @@ size, and full-buffer size."
(let ((gap-start (point))
(face (get-text-property (point) 'face)))
;; Extend the background to the end of the line.
- (if face
- (insert (propertize "\n" 'face (shr-face-background face)))
- (insert "\n"))
+ (insert ?\n)
(shr-indent)
+ (when face
+ (put-text-property gap-start (point)
+ 'face (shr-face-background face)))
(when (and (> (1- gap-start) (point-min))
(get-text-property (point) 'shr-url)
;; The link on both sides of the newline are the
@@ -838,7 +866,7 @@ size, and full-buffer size."
;; Always chop off anchors.
(when (string-match "#.*" url)
(setq url (substring url 0 (match-beginning 0))))
- ;; NB: <base href="" > URI may itself be relative to the document s URI
+ ;; NB: <base href=""> URI may itself be relative to the document's URI.
(setq url (shr-expand-url url))
(let* ((parsed (url-generic-parse-url url))
(local (url-filename parsed)))
@@ -911,6 +939,22 @@ size, and full-buffer size."
(looking-at " *$")))
;; We're already at a new paragraph; do nothing.
)
+ ((and (not (bolp))
+ (save-excursion
+ (beginning-of-line)
+ (looking-at " *$"))
+ (save-excursion
+ (forward-line -1)
+ (looking-at " *$"))
+ ;; Check all chars on the current line and see whether
+ ;; they're all placeholders.
+ (cl-loop for pos from (line-beginning-position) upto (1- (point))
+ unless (get-text-property pos 'shr-target-id)
+ return nil
+ finally return t))
+ ;; We have some invisible markers from <div id="foo"></div>;
+ ;; do nothing.
+ )
((and prefix
(= prefix (- (point) (line-beginning-position))))
;; Do nothing; we're at the start of a <li>.
@@ -935,12 +979,11 @@ size, and full-buffer size."
(defun shr-indent ()
(when (> shr-indentation 0)
- (insert
- (if (not shr-use-fonts)
- (make-string shr-indentation ?\s)
- (propertize " "
- 'display
- `(space :width (,shr-indentation)))))))
+ (if (not shr-use-fonts)
+ (insert-char ?\s shr-indentation)
+ (insert ?\s)
+ (put-text-property (1- (point)) (point)
+ 'display `(space :width (,shr-indentation))))))
(defun shr-fontize-dom (dom &rest types)
(let ((start (point)))
@@ -987,16 +1030,11 @@ the mouse click event."
(cond
((not url)
(message "No link under point"))
- ((string-match "^mailto:" url)
- (browse-url-mail url))
+ (external
+ (funcall browse-url-secondary-browser-function url)
+ (shr--blink-link))
(t
- (if external
- (progn
- (funcall browse-url-secondary-browser-function url)
- (shr--blink-link))
- (browse-url url (if new-window
- (not browse-url-new-window-flag)
- browse-url-new-window-flag)))))))
+ (browse-url url (xor new-window browse-url-new-window-flag))))))
(defun shr-save-contents (directory)
"Save the contents from URL in a file."
@@ -1005,7 +1043,7 @@ the mouse click event."
(if (not url)
(message "No link under point")
(url-retrieve (shr-encode-url url)
- 'shr-store-contents (list url directory)))))
+ #'shr-store-contents (list url directory)))))
(defun shr-store-contents (status url directory)
(unless (plist-get status :error)
@@ -1156,7 +1194,6 @@ width/height instead."
;; url-cache-extract autoloads url-cache.
(declare-function url-cache-create-filename "url-cache" (url))
-(autoload 'browse-url-mail "browse-url")
(defun shr-get-image-data (url)
"Get image data for URL.
@@ -1195,25 +1232,8 @@ Return a string with image data."
;; that are non-ASCII.
(shr-dom-to-xml
(libxml-parse-xml-region (point) (point-max)) 'utf-8)))
- ;; SVG images often do not have a specified foreground/background
- ;; color, so wrap them in styles.
- (when (and (display-images-p)
- (eq content-type 'image/svg+xml))
- (setq data (svg--wrap-svg data)))
(list data content-type)))
-(defun svg--wrap-svg (data)
- "Add a default foreground colour to SVG images."
- (let ((size (image-size (create-image data nil t :scaling 1) t)))
- (with-temp-buffer
- (insert
- (format
- "<svg xmlns:xlink=\"http://www.w3.org/1999/xlink\" xmlns:xi=\"http://www.w3.org/2001/XInclude\" style=\"color: %s;\" viewBox=\"0 0 %d %d\"> <xi:include href=\"data:image/svg+xml;base64,%s\"></xi:include></svg>"
- (face-foreground 'default)
- (car size) (cdr size)
- (base64-encode-string data t)))
- (buffer-string))))
-
(defun shr-image-displayer (content-function)
"Return a function to display an image.
CONTENT-FUNCTION is a function to retrieve an image for a cid url that
@@ -1230,7 +1250,7 @@ START, and END. Note that START and END should be markers."
(funcall shr-put-image-function
image (buffer-substring start end))
(delete-region (point) end))))
- (url-retrieve url 'shr-image-fetched
+ (url-retrieve url #'shr-image-fetched
(list (current-buffer) start end)
t t)))))
@@ -1265,7 +1285,9 @@ START, and END. Note that START and END should be markers."
(format "%s (%s)" iri title)
iri))
'follow-link t
- 'mouse-face 'highlight))
+ ;; Make separate regions not `eq' so that they'll get
+ ;; separate mouse highlights.
+ 'mouse-face (list 'highlight)))
;; Don't overwrite any keymaps that are already in the buffer (i.e.,
;; image keymaps).
(while (and start
@@ -1316,7 +1338,7 @@ ones, in case fg and bg are nil."
t))
(when bg
(add-face-text-property start end
- (list :background (car new-colors))
+ (list :background (car new-colors) :extend t)
t)))
new-colors)))
@@ -1438,7 +1460,7 @@ ones, in case fg and bg are nil."
(shr-fontize-dom dom 'underline))
(defun shr-tag-code (dom)
- (let ((shr-current-font 'default))
+ (let ((shr-current-font 'fixed-pitch))
(shr-generic dom)))
(defun shr-tag-tt (dom)
@@ -1495,14 +1517,13 @@ ones, in case fg and bg are nil."
(start (point))
shr-start)
(shr-generic dom)
- (when (and shr-target-id
- (equal (dom-attr dom 'name) shr-target-id))
- ;; We have a zero-length <a name="foo"> element, so just
- ;; insert... something.
+ (when-let* ((id (unless (dom-attr dom 'id) ; Handled by `shr-descend'.
+ (dom-attr dom 'name)))) ; Obsolete since HTML5.
+ ;; We have an empty element, so just insert... something.
(when (= start (point))
- (shr-ensure-newline)
- (insert " "))
- (put-text-property start (1+ start) 'shr-target-id shr-target-id))
+ (insert ?\s)
+ (put-text-property (1- (point)) (point) 'display ""))
+ (put-text-property start (1+ start) 'shr-target-id id))
(when url
(shr-urlify (or shr-start start) (shr-expand-url url) title))))
@@ -1677,7 +1698,7 @@ The preference is a float determined from `shr-prefer-media-type'."
(or alt "")))
(insert " ")
(url-queue-retrieve
- (shr-encode-url url) 'shr-image-fetched
+ (shr-encode-url url) #'shr-image-fetched
(list (current-buffer) start (set-marker (make-marker) (point))
(list :width width :height height))
t
@@ -2004,12 +2025,11 @@ BASE is the URL of the HTML being rendered."
(cond
((null tbodies)
dom)
- ((= (length tbodies) 1)
+ ((null (cdr tbodies))
(car tbodies))
(t
;; Table with multiple tbodies. Convert into a single tbody.
- `(tbody nil ,@(cl-reduce 'append
- (mapcar 'dom-non-text-children tbodies)))))))
+ `(tbody nil ,@(mapcan #'dom-non-text-children tbodies))))))
(defun shr--fix-tbody (tbody)
(nconc (list 'tbody (dom-attributes tbody))
@@ -2253,7 +2273,7 @@ flags that control whether to collect or render objects."
(not background))
(setq background (cadr elem))))
(and background
- (list :background background))))))
+ (list :background background :extend t))))))
(defun shr-expand-alignments (start end)
(while (< (setq start (next-single-property-change
@@ -2309,8 +2329,8 @@ flags that control whether to collect or render objects."
(dolist (column row)
(aset natural-widths i (max (aref natural-widths i) column))
(setq i (1+ i)))))
- (let ((extra (- (apply '+ (append suggested-widths nil))
- (apply '+ (append widths nil))
+ (let ((extra (- (apply #'+ (append suggested-widths nil))
+ (apply #'+ (append widths nil))
(* shr-table-separator-pixel-width (1+ (length widths)))))
(expanded-columns 0))
;; We have extra, unused space, so divide this space amongst the
@@ -2585,12 +2605,28 @@ flags that control whether to collect or render objects."
i))
(defun shr-max-columns (dom)
- (let ((max 0))
+ (let ((max 0)
+ (this 0)
+ (rowspans nil))
(dolist (row (dom-children dom))
(when (and (not (stringp row))
(eq (dom-tag row) 'tr))
- (setq max (max max (+ (shr-count row 'td)
- (shr-count row 'th))))))
+ (setq this 0)
+ (dolist (column (dom-children row))
+ (when (and (not (stringp column))
+ (memq (dom-tag column) '(td th)))
+ (setq this (+ 1 this (length rowspans)))
+ ;; We have a rowspan, which we emulate later in rendering
+ ;; by adding an extra column to the following rows.
+ (when-let* ((span (dom-attr column 'rowspan)))
+ (push (string-to-number span) rowspans))))
+ (setq max (max max this)))
+ ;; Count down the rowspans in effect.
+ (let ((new nil))
+ (dolist (span rowspans)
+ (when (> span 1)
+ (push (1- span) new)))
+ (setq rowspans new)))
max))
(provide 'shr)
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index e3c38052a51..241ce9efcb3 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -5,7 +5,7 @@
;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com>
;; Author: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Created: December, 2009
-;; Version: 3.1.5
+;; Version: 3.2.0
;; Keywords: soap, web-services, comm, hypermedia
;; Package: soap-client
;; Homepage: https://github.com/alex-hhh/emacs-soap-client
@@ -551,30 +551,77 @@ This is a specialization of `soap-encode-value' for
(soap-validate-xs-basic-type value-string type)
(insert value-string)))))
-;; Inspired by rng-xsd-convert-date-time.
-(defun soap-decode-date-time (date-time-string datatype)
+(defun soap-decode-date-time (date-time-string &optional datatype)
"Decode DATE-TIME-STRING as DATATYPE.
DATE-TIME-STRING should be in ISO 8601 basic or extended format.
-DATATYPE is one of dateTime, time, date, gYearMonth, gYear,
-gMonthDay, gDay or gMonth.
-
-Return a list in a format (SEC MINUTE HOUR DAY MONTH YEAR
-SEC-FRACTION DATATYPE ZONE). This format is meant to be similar
-to that returned by `decode-time' (and compatible with
-`encode-time'). The differences are the SEC (seconds)
-field is always an integer, the DOW (day-of-week) field
-is replaced with SEC-FRACTION, a float representing the
-fractional seconds, and the DST (daylight savings time) field is
-replaced with DATATYPE, a symbol representing the XSD primitive
-datatype. This symbol can be used to determine which fields
-apply and which don't when it's not already clear from context.
-For example a datatype of `time' means the year, month and day
+DATATYPE can be omitted, or one of the symbols dateTime, time,
+date, gYearMonth, gYear, gMonthDay, gDay, or gMonth. If Emacs is
+a version that supports fractional seconds, DATATYPE can also be
+dateTime-subsecond, or time-subsecond. On older versions of
+Emacs (prior to 27.1), which do not support fractional seconds,
+leaving DATATYPE nil means that subseconds in DATE-TIME-STRING
+will be ignored.
+
+Return a list in a format identical or similar to that returned
+by `decode-time'. The returned format is always compatible with
+`encode-time'. If DATATYPE is omitted or nil, this function will
+return a list that has exactly the same format as that returned
+by `decode-time'.
+
+Note that on versions of Emacs that predate support for
+fractional seconds, `encode-time' will not notice the SUBSECOND
+field so it must be handled specially.
+
+The formats returned by this function are as follows, where _
+means \"should be ignored\":
+
+ DATATYPE | Return format
+------------+----------------------------------------------------------------
+ nil | (SECOND MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF)
+ dateTime | (SECOND MINUTE HOUR DAY MONTH YEAR SUBSECOND dateTime UTCOFF)
+ time | (SECOND MINUTE HOUR _ _ _ SUBSECOND time _)
+ date | (_ _ _ DAY MONTH YEAR _ date _)
+ gYearMonth | (_ _ _ _ MONTH YEAR _ gYearMonth _)
+ gYear | (_ _ _ _ _ YEAR _ gYear _)
+ gMonthDay | (_ _ _ DAY MONTH _ _ gMonthDay _)
+ gDay | (_ _ _ DAY _ _ _ gDay _)
+ gMonth | (_ _ _ _ MONTH _ _ gMonth _)
+
+When DATATYPE is dateTime or time, the DOW (day-of-week) field is
+replaced with SUBSECOND, a float representing the fractional
+seconds, and the DST (daylight savings time) field is replaced
+with DATATYPE, a symbol representing the XSD primitive datatype.
+This symbol can be used to determine which fields apply and which
+do not, when it is not already clear from context. For example a
+datatype of `time' means the year, month, day and time zone
fields should be ignored.
-This function will throw an error if DATE-TIME-STRING represents
-a leap second, since the XML Schema 1.1 standard explicitly
-disallows them."
- (let* ((datetime-regexp (cadr (get datatype 'rng-xsd-convert)))
+New code that depends on Emacs 27.1 or newer anyway, and that
+wants dateTime or time but with the first argument with subsecond
+resolution, i.e., (TICKS . HZ), can set DATATYPE to
+dateTime-subsecond or time-subsecond respectively. This function
+throws an error if dateTime-subsecond or time-subsecond is
+specified when Emacs does not support subsecond resolution.
+
+This function throws an error if DATE-TIME-STRING represents a
+leap second, since the XML Schema 1.1 standard does not support
+representing leap seconds."
+ (let* ((new-decode-time (condition-case nil
+ (not (null
+ (with-no-warnings (decode-time nil nil t))))
+ (wrong-number-of-arguments)))
+ (new-decode-time-second nil)
+ (no-support "This Emacs version does not support %s")
+ (datetime-regexp-type
+ (cl-case datatype
+ ((dateTime-subsecond time-subsecond)
+ (if new-decode-time
+ (intern (replace-regexp-in-string
+ "-subsecond" "" (symbol-name datatype)))
+ (error (format no-support (symbol-name datatype)))))
+ ((nil) 'dateTime)
+ (otherwise datatype)))
+ (datetime-regexp (cadr (get datetime-regexp-type 'rng-xsd-convert)))
(year-sign (progn
(string-match datetime-regexp date-time-string)
(match-string 1 date-time-string)))
@@ -585,6 +632,7 @@ disallows them."
(minute (match-string 6 date-time-string))
(second (match-string 7 date-time-string))
(second-fraction (match-string 8 date-time-string))
+ (time-zone nil)
(has-time-zone (match-string 9 date-time-string))
(time-zone-sign (match-string 10 date-time-string))
(time-zone-hour (match-string 11 date-time-string))
@@ -605,11 +653,28 @@ disallows them."
(if hour (string-to-number hour) 0))
(setq minute
(if minute (string-to-number minute) 0))
+ (when new-decode-time
+ (setq new-decode-time-second
+ (if second
+ (if second-fraction
+ (let* ((second-fraction-significand
+ (replace-regexp-in-string "\\." "" second-fraction))
+ (hertz
+ (expt 10 (length second-fraction-significand)))
+ (ticks (+ (* hertz (string-to-number second))
+ (string-to-number
+ second-fraction-significand))))
+ (cons ticks hertz))
+ (cons second 1)))))
(setq second
(if second (string-to-number second) 0))
(setq second-fraction
(if second-fraction
- (float (string-to-number second-fraction))
+ (progn
+ (when (and (not datatype) (not new-decode-time))
+ (message
+ "soap-decode-date-time: Discarding fractional seconds"))
+ (float (string-to-number second-fraction)))
0.0))
(setq has-time-zone (and has-time-zone t))
(setq time-zone-sign
@@ -618,6 +683,14 @@ disallows them."
(if time-zone-hour (string-to-number time-zone-hour) 0))
(setq time-zone-minute
(if time-zone-minute (string-to-number time-zone-minute) 0))
+ (setq time-zone (if has-time-zone
+ (* (rng-xsd-time-to-seconds
+ time-zone-hour
+ time-zone-minute
+ 0)
+ time-zone-sign)
+ ;; UTC.
+ 0))
(unless (and
;; XSD does not allow year 0.
(> year 0)
@@ -635,18 +708,22 @@ disallows them."
(>= time-zone-minute 0)
(<= time-zone-minute 59))
(error "Invalid or unsupported time: %s" date-time-string))
- ;; Return a value in a format similar to that returned by decode-time, and
- ;; suitable for (apply #'encode-time ...).
- ;; FIXME: Nobody uses this idiosyncratic value. Perhaps stop returning it?
- (list second minute hour day month year second-fraction datatype
- (if has-time-zone
- (* (rng-xsd-time-to-seconds
- time-zone-hour
- time-zone-minute
- 0)
- time-zone-sign)
- ;; UTC.
- 0))))
+ ;; Return a value in a format identical or similar to that
+ ;; returned by decode-time, and always suitable for (apply
+ ;; #'encode-time ...).
+ (if datatype
+ (list (if (memq datatype '(dateTime-subsecond time-subsecond))
+ new-decode-time-second
+ second)
+ minute hour day month year second-fraction datatype time-zone)
+ (let ((time
+ (apply
+ #'encode-time (list
+ (if new-decode-time new-decode-time-second second)
+ minute hour day month year nil nil time-zone))))
+ (if new-decode-time
+ (with-no-warnings (decode-time time nil t))
+ (decode-time time))))))
(defun soap-decode-xs-basic-type (type node)
"Use TYPE, a `soap-xs-basic-type', to decode the contents of NODE.
@@ -1716,6 +1793,7 @@ This is a specialization of `soap-encode-value' for
((and (not (eq indicator 'choice))
(= instance-count 0)
(not (soap-xs-element-optional? element))
+ (not (soap-xs-complex-type-optional? type))
(and (soap-xs-complex-type-p element-type)
(not (soap-xs-complex-type-optional-p
element-type))))
@@ -2000,7 +2078,7 @@ This is a specialization of `soap-decode-type' for
soap-headers ; list of (message part use)
soap-body ; message parts present in the body
use ; 'literal or 'encoded, see
- ; http://www.w3.org/TR/wsdl#_soap:body
+ ; https://www.w3.org/TR/wsdl#_soap:body
)
(cl-defstruct (soap-binding (:include soap-element))
@@ -2033,6 +2111,8 @@ This is a specialization of `soap-decode-type' for
;; Add the XSD types to the wsdl document
(let ((ns (soap-make-xs-basic-types
+ ;; The following string is a name and not an URL, so
+ ;; the "http:" should not be changed.
"http://www.w3.org/2001/XMLSchema" "xsd")))
(soap-wsdl-add-namespace ns wsdl)
(soap-wsdl-add-alias "xsd" (soap-namespace-name ns) wsdl))
@@ -2918,8 +2998,6 @@ reference multiRef parts which are external to RESPONSE-NODE."
;;;; SOAP type encoding
-;; FIXME: Use `cl-defmethod' (but this requires Emacs-25).
-
(defun soap-encode-attributes (value type)
"Encode XML attributes for VALUE according to TYPE.
This is a generic function which determines the attribute encoder
diff --git a/lisp/net/telnet.el b/lisp/net/telnet.el
index e8c0c1bbdf4..29c415e6a65 100644
--- a/lisp/net/telnet.el
+++ b/lisp/net/telnet.el
@@ -149,7 +149,7 @@ rejecting one login and prompting again for a username and password.")
((string-match "passw" string)
(telnet-filter proc string)
(setq telnet-count 0)
- (process-send-string proc (concat (comint-read-noecho "Password: " t)
+ (process-send-string proc (concat (read-passwd "Password: ")
telnet-new-line))
(clear-this-command-keys))
(t (telnet-check-software-type-initialize string)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 0efe055b084..49ecaa58ee8 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -57,15 +57,27 @@ It is used for TCP/IP devices."
"When this method name is used, forward all calls to Android Debug Bridge.")
;;;###tramp-autoload
-(defcustom tramp-adb-prompt
- "^[[:digit:]]*|?[[:alnum:]\e;[]*@?[[:alnum:]]*[^#\\$]*[#\\$][[:space:]]"
+(defcustom tramp-adb-prompt "^[^#$\n\r]*[#$][[:space:]]"
"Regexp used as prompt in almquist shell."
:type 'regexp
- :version "24.4"
+ :version "28.1"
:group 'tramp)
+(eval-and-compile
+ (defconst tramp-adb-ls-date-year-regexp
+ "[[:digit:]]\\{4\\}-[[:digit:]]\\{2\\}-[[:digit:]]\\{2\\}"
+ "Regexp for date year format in ls output."))
+
+(eval-and-compile
+ (defconst tramp-adb-ls-date-time-regexp
+ "[[:digit:]]\\{2\\}:[[:digit:]]\\{2\\}"
+ "Regexp for date time format in ls output."))
+
(defconst tramp-adb-ls-date-regexp
- "[[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]][0-9][0-9]:[0-9][0-9][[:space:]]"
+ (concat
+ "[[:space:]]" tramp-adb-ls-date-year-regexp
+ "[[:space:]]" tramp-adb-ls-date-time-regexp
+ "[[:space:]]")
"Regexp for date format in ls output.")
(defconst tramp-adb-ls-toolbox-regexp
@@ -75,7 +87,8 @@ It is used for TCP/IP devices."
"[[:space:]]*\\([^[:space:]]+\\)" ; \2 username
"[[:space:]]+\\([^[:space:]]+\\)" ; \3 group
"[[:space:]]+\\([[:digit:]]+\\)" ; \4 size
- "[[:space:]]+\\([-[:digit:]]+[[:space:]][:[:digit:]]+\\)" ; \5 date
+ "[[:space:]]+\\(" tramp-adb-ls-date-year-regexp
+ "[[:space:]]" tramp-adb-ls-date-time-regexp "\\)" ; \5 date
"[[:space:]]\\(.*\\)$") ; \6 filename
"Regexp for ls output.")
@@ -83,8 +96,10 @@ It is used for TCP/IP devices."
(tramp--with-startup
(add-to-list 'tramp-methods
`(,tramp-adb-method
- (tramp-tmpdir "/data/local/tmp")
- (tramp-default-port 5555)))
+ (tramp-login-program ,tramp-adb-program)
+ (tramp-login-args (("shell")))
+ (tramp-tmpdir "/data/local/tmp")
+ (tramp-default-port 5555)))
(add-to-list 'tramp-default-host-alist `(,tramp-adb-method nil ""))
@@ -138,7 +153,7 @@ It is used for TCP/IP devices."
(file-selinux-context . tramp-handle-file-selinux-context)
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-adb-handle-file-system-info)
- (file-truename . tramp-adb-handle-file-truename)
+ (file-truename . tramp-handle-file-truename)
(file-writable-p . tramp-adb-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `get-file-buffer' performed by default handler.
@@ -162,6 +177,8 @@ It is used for TCP/IP devices."
(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)
(vc-registered . ignore)
@@ -183,10 +200,9 @@ It is used for TCP/IP devices."
"Invoke the ADB handler for OPERATION.
First arg specifies the OPERATION, second arg is a list of
ARGUMENTS to pass to the OPERATION."
- (let ((fn (assoc operation tramp-adb-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) arguments))
- (tramp-run-real-handler operation arguments))))
+ (if-let ((fn (assoc operation tramp-adb-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) arguments))
+ (tramp-run-real-handler operation arguments)))
;;;###tramp-autoload
(tramp--with-startup
@@ -216,11 +232,10 @@ ARGUMENTS to pass to the OPERATION."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (eval-when-compile
- (concat "[[:space:]]*[^[:space:]]+"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)")))
+ (concat "[[:space:]]*[^[:space:]]+"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"))
;; The values are given as 1k numbers, so we must change
;; them to number of bytes.
(list (* 1024 (string-to-number (match-string 1)))
@@ -230,105 +245,6 @@ ARGUMENTS to pass to the OPERATION."
(string-to-number (match-string 2))))
(* 1024 (string-to-number (match-string 3)))))))))
-;; This is derived from `tramp-sh-handle-file-truename'. Maybe the
-;; code could be shared?
-(defun tramp-adb-handle-file-truename (filename)
- "Like `file-truename' for Tramp files."
- ;; Preserve trailing "/".
- (funcall
- (if (tramp-compat-directory-name-p filename)
- #'file-name-as-directory #'identity)
- ;; Quote properly.
- (funcall
- (if (tramp-compat-file-name-quoted-p filename)
- #'tramp-compat-file-name-quote #'identity)
- (with-parsed-tramp-file-name
- (tramp-compat-file-name-unquote (expand-file-name filename)) nil
- (tramp-make-tramp-file-name
- v
- (with-tramp-file-property v localname "file-truename"
- (let (result) ; result steps in reverse order
- (tramp-message v 4 "Finding true name for `%s'" filename)
- (let* ((steps (split-string localname "/" 'omit))
- (localnamedir (tramp-run-real-handler
- 'file-name-as-directory (list localname)))
- (is-dir (string= localname localnamedir))
- (thisstep nil)
- (numchase 0)
- ;; Don't make the following value larger than
- ;; necessary. People expect an error message in a
- ;; timely fashion when something is wrong; otherwise
- ;; they might think that Emacs is hung. Of course,
- ;; correctness has to come first.
- (numchase-limit 20)
- symlink-target)
- (while (and steps (< numchase numchase-limit))
- (setq thisstep (pop steps))
- (tramp-message
- v 5 "Check %s"
- (string-join
- (append '("") (reverse result) (list thisstep)) "/"))
- (setq symlink-target
- (tramp-compat-file-attribute-type
- (file-attributes
- (tramp-make-tramp-file-name
- v
- (string-join
- (append
- '("") (reverse result) (list thisstep)) "/")))))
- (cond ((string= "." thisstep)
- (tramp-message v 5 "Ignoring step `.'"))
- ((string= ".." thisstep)
- (tramp-message v 5 "Processing step `..'")
- (pop result))
- ((stringp symlink-target)
- ;; It's a symlink, follow it.
- (tramp-message v 5 "Follow symlink to %s" symlink-target)
- (setq numchase (1+ numchase))
- (when (file-name-absolute-p symlink-target)
- (setq result nil))
- ;; If the symlink was absolute, we'll get a string
- ;; like "/user@host:/some/target"; extract the
- ;; "/some/target" part from it.
- (when (tramp-tramp-file-p symlink-target)
- (unless (tramp-equal-remote filename symlink-target)
- (tramp-error
- v 'file-error
- "Symlink target `%s' on wrong host" symlink-target))
- (setq symlink-target localname))
- (setq steps
- (append (split-string symlink-target "/" 'omit)
- steps)))
- (t
- ;; It's a file.
- (setq result (cons thisstep result)))))
- (when (>= numchase numchase-limit)
- (tramp-error
- v 'file-error
- "Maximum number (%d) of symlinks exceeded" numchase-limit))
- (setq result (reverse result))
- ;; Combine list to form string.
- (setq result
- (if result
- (string-join (cons "" result) "/")
- "/"))
- (when (and is-dir (or (string-empty-p result)
- (not (string= (substring result -1) "/"))))
- (setq result (concat result "/"))))
-
- ;; Detect cycle.
- (when (and (file-symlink-p filename)
- (string-equal result localname))
- (tramp-error
- v 'file-error
- "Apparent cycle of symbolic links for %s" filename))
- ;; If the resulting localname looks remote, we must quote it
- ;; for security reasons.
- (when (file-remote-p result)
- (setq result (tramp-compat-file-name-quote result 'top)))
- (tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result)))))))
-
(defun tramp-adb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
@@ -372,7 +288,9 @@ ARGUMENTS to pass to the OPERATION."
(if (eq id-format 'integer) 0 uid)
(if (eq id-format 'integer) 0 gid)
tramp-time-dont-know ; atime
- (date-to-time date) ; mtime
+ ;; `date-to-time' checks `iso8601-parse', which might fail.
+ (let (signal-hook-function)
+ (date-to-time date)) ; mtime
tramp-time-dont-know ; ctime
size
mod-string
@@ -451,21 +369,6 @@ ARGUMENTS to pass to the OPERATION."
"ls --color=never")
(t "ls"))))
-(defun tramp-adb--gnu-switches-to-ash (switches)
- "Almquist shell can't handle multiple arguments.
-Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"."
- (split-string
- (apply #'concat
- (mapcar (lambda (s)
- (replace-regexp-in-string
- "\\(.\\)" " -\\1" (replace-regexp-in-string "^-" "" s)))
- ;; FIXME: Warning about removed switches (long and non-dash).
- (delq nil
- (mapcar
- (lambda (s)
- (and (not (string-match-p "\\(^--\\|^[^-]\\)" s)) s))
- switches))))))
-
(defun tramp-adb-sh-fix-ls-output (&optional sort-by-time)
"Insert dummy 0 in empty size columns.
Android's \"ls\" command doesn't insert size column for directories:
@@ -475,10 +378,16 @@ Emacs dired can't find files."
(goto-char (point-min))
(while
(search-forward-regexp
- "[[:space:]]\\([[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]]\\)" nil t)
+ (eval-when-compile
+ (concat
+ "[[:space:]]"
+ "\\([[:space:]]" tramp-adb-ls-date-year-regexp "[[:space:]]\\)"))
+ nil t)
(replace-match "0\\1" "\\1" nil)
;; Insert missing "/".
- (when (looking-at-p "[0-9][0-9]:[0-9][0-9][[:space:]]+$")
+ (when (looking-at-p
+ (eval-when-compile
+ (concat tramp-adb-ls-date-time-regexp "[[:space:]]+$")))
(end-of-line)
(insert "/")))
;; Sort entries.
@@ -589,9 +498,10 @@ Emacs dired can't find files."
(with-tramp-progress-reporter
v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
;; "adb pull ..." does not always return an error code.
- (when (or (tramp-adb-execute-adb-command
- v "pull" (tramp-compat-file-name-unquote localname) tmpfile)
- (not (file-exists-p tmpfile)))
+ (unless
+ (and (tramp-adb-execute-adb-command
+ v "pull" (tramp-compat-file-name-unquote localname) tmpfile)
+ (file-exists-p tmpfile))
(ignore-errors (delete-file tmpfile))
(tramp-error
v 'file-error "Cannot make local copy of file `%s'" filename))
@@ -644,8 +554,8 @@ But handle the case, if the \"test\" command is not available."
v 3 (format-message
"Moving tmp file `%s' to `%s'" tmpfile filename)
(unwind-protect
- (when (tramp-adb-execute-adb-command
- v "push" tmpfile (tramp-compat-file-name-unquote localname))
+ (unless (tramp-adb-execute-adb-command
+ v "push" tmpfile (tramp-compat-file-name-unquote localname))
(tramp-error v 'file-error "Cannot write: `%s'" filename))
(delete-file tmpfile)))
@@ -670,13 +580,16 @@ But handle the case, if the \"test\" command is not available."
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook))))
-(defun tramp-adb-handle-set-file-modes (filename mode &optional _flag)
+(defun tramp-adb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
- (tramp-adb-send-command-and-check v (format "chmod %o %s" mode localname))))
+ ;; ADB shell does not support "chmod -h".
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-flush-file-properties v localname)
+ (tramp-adb-send-command-and-check
+ v (format "chmod %o %s" mode (tramp-shell-quote-argument localname))))))
-(defun tramp-adb-handle-set-file-times (filename &optional time _flag)
+(defun tramp-adb-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
@@ -685,21 +598,23 @@ But handle the case, if the \"test\" command is not available."
(tramp-compat-time-equal-p time tramp-time-dont-know))
(current-time)
time))
+ (nofollow (if (eq flag 'nofollow) "-h" ""))
(quoted-name (tramp-shell-quote-argument localname)))
;; Older versions of toybox 'touch' mishandle nanoseconds and/or
;; trailing "Z", so fall back on plain seconds if nanoseconds+Z
;; fails. Also, fall back on old POSIX 'touch -t' if 'touch -d'
;; (introduced in POSIX.1-2008) fails.
(tramp-adb-send-command-and-check
- v (format (concat "touch -d %s %s 2>/dev/null || "
- "touch -d %s %s 2>/dev/null || "
- "touch -t %s %s")
- (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t)
- quoted-name
- (format-time-string "%Y-%m-%dT%H:%M:%S" time t)
- quoted-name
- (format-time-string "%Y%m%d%H%M.%S" time t)
- quoted-name)))))
+ v (format
+ (concat "touch -d %s %s %s 2>/dev/null || "
+ "touch -d %s %s %s 2>/dev/null || "
+ "touch -t %s %s %s")
+ (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t)
+ nofollow quoted-name
+ (format-time-string "%Y-%m-%dT%H:%M:%S" time t)
+ nofollow quoted-name
+ (format-time-string "%Y%m%d%H%M.%S" time t)
+ nofollow quoted-name)))))
(defun tramp-adb-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -722,7 +637,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
@@ -742,46 +657,45 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(tramp-shell-quote-argument l2))
"Error copying %s to %s" filename newname))
- (let ((tmpfile (file-local-copy filename)))
-
- (if tmpfile
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Remote newname.
- (when (and (file-directory-p newname)
- (tramp-compat-directory-name-p newname))
- (setq newname
- (expand-file-name
- (file-name-nondirectory filename) newname)))
-
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
-
- ;; We must also flush the cache of the directory,
- ;; because `file-attributes' reads the values from
- ;; there.
- (tramp-flush-file-properties v localname)
- (when (tramp-adb-execute-adb-command
+ (if-let ((tmpfile (file-local-copy filename)))
+ ;; Remote filename.
+ (condition-case err
+ (rename-file tmpfile newname ok-if-already-exists)
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Remote newname.
+ (when (and (file-directory-p newname)
+ (directory-name-p newname))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory filename) newname)))
+
+ (with-parsed-tramp-file-name newname nil
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+
+ ;; We must also flush the cache of the directory,
+ ;; because `file-attributes' reads the values from
+ ;; there.
+ (tramp-flush-file-properties v localname)
+ (unless (tramp-adb-execute-adb-command
v "push"
(tramp-compat-file-name-unquote filename)
(tramp-compat-file-name-unquote localname))
- (tramp-error
- v 'file-error
- "Cannot copy `%s' `%s'" filename newname)))))))))
+ (tramp-error
+ v 'file-error
+ "Cannot copy `%s' `%s'" filename newname))))))))
;; KEEP-DATE handling.
(when keep-date
- (set-file-times
+ (tramp-compat-set-file-times
newname
(tramp-compat-file-attribute-modification-time
- (file-attributes filename))))))
+ (file-attributes filename))
+ (unless ok-if-already-exists 'nofollow)))))
(defun tramp-adb-handle-rename-file
(filename newname &optional ok-if-already-exists)
@@ -804,7 +718,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
@@ -973,164 +887,168 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; The complete STDERR buffer is available only when the process has
;; terminated.
(defun tramp-adb-handle-make-process (&rest args)
- "Like `make-process' for Tramp files."
- (when args
- (with-parsed-tramp-file-name (expand-file-name default-directory) nil
- (let ((name (plist-get args :name))
- (buffer (plist-get args :buffer))
- (command (plist-get args :command))
- (coding (plist-get args :coding))
- (noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
- (filter (plist-get args :filter))
- (sentinel (plist-get args :sentinel))
- (stderr (plist-get args :stderr)))
- (unless (stringp name)
- (signal 'wrong-type-argument (list #'stringp name)))
- (unless (or (null buffer) (bufferp buffer) (stringp buffer))
- (signal 'wrong-type-argument (list #'stringp buffer)))
- (unless (consp command)
- (signal 'wrong-type-argument (list #'consp command)))
- (unless (or (null coding)
- (and (symbolp coding) (memq coding coding-system-list))
- (and (consp coding)
- (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)))
- (signal 'wrong-type-argument (list #'symbolp connection-type)))
- (unless (or (null filter) (functionp filter))
- (signal 'wrong-type-argument (list #'functionp filter)))
- (unless (or (null sentinel) (functionp sentinel))
- (signal 'wrong-type-argument (list #'functionp sentinel)))
- (unless (or (null stderr) (bufferp stderr) (stringp stderr))
- (signal 'wrong-type-argument (list #'stringp stderr)))
- (when (and (stringp stderr) (tramp-tramp-file-p stderr)
- (not (tramp-equal-remote default-directory stderr)))
- (signal 'file-error (list "Wrong stderr" stderr)))
-
- (let* ((buffer
- (if buffer
- (get-buffer-create buffer)
- ;; BUFFER can be nil. We use a temporary buffer.
- (generate-new-buffer tramp-temp-buffer-name)))
- ;; 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))))
- (remote-tmpstderr
- (and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
- (program (car command))
- (args (cdr command))
- (command
- (format "cd %s && exec %s %s"
- (tramp-shell-quote-argument localname)
- (if tmpstderr (format "2>'%s'" tmpstderr) "")
- (mapconcat #'tramp-shell-quote-argument
- (cons program args) " ")))
- (tramp-process-connection-type
- (or (null program) tramp-process-connection-type))
- (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
- (name1 name)
- (i 0))
-
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- (setq name name1)
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
-
- (with-current-buffer (tramp-get-connection-buffer v)
- (unwind-protect
- ;; We catch this event. Otherwise, `make-process'
- ;; could be called on the local host.
- (save-excursion
- (save-restriction
- ;; Activate narrowing in order to save BUFFER
- ;; contents. Clear also the modification time;
- ;; otherwise we might be interrupted by
- ;; `verify-visited-file-modtime'.
- (let ((buffer-undo-list t)
- (inhibit-read-only t))
- (clear-visited-file-modtime)
- (narrow-to-region (point-max) (point-max))
- ;; We call `tramp-adb-maybe-open-connection', in
- ;; order to cleanup the prompt afterwards.
- (tramp-adb-maybe-open-connection v)
- (delete-region (point-min) (point-max))
- ;; Send the command.
- (let* ((p (tramp-get-connection-process v)))
- (tramp-adb-send-command v command nil t) ; nooutput
- ;; Set sentinel and filter.
- (when sentinel
- (set-process-sentinel p sentinel))
- (when filter
- (set-process-filter p filter))
- ;; Set query flag and process marker for this
- ;; process. We ignore errors, because the
- ;; process could have finished already.
- (ignore-errors
- (set-process-query-on-exit-flag p (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))))
- ;; Read initial output. Remove the first line,
- ;; which is the command echo.
- (while
- (progn
- (goto-char (point-min))
- (not (re-search-forward "[\n]" nil t)))
- (tramp-accept-process-output p 0))
- (delete-region (point-min) (point))
- ;; 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.
- (when (bufferp stderr)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr 'visit))
- ;; Delete tmpstderr file.
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr 'visit nil nil 'replace))
- (delete-file remote-tmpstderr))))
- ;; Return process.
- p))))
-
- ;; Save exit.
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
- (ignore-errors
- (set-process-buffer (tramp-get-connection-process v) nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer"))))))))
+ "Like `make-process' for Tramp files.
+If connection property \"direct-async-process\" is non-nil, an
+alternative implementation will be used."
+ (if (tramp-direct-async-process-p args)
+ (apply #'tramp-handle-make-process args)
+ (when args
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
+ (let ((name (plist-get args :name))
+ (buffer (plist-get args :buffer))
+ (command (plist-get args :command))
+ (coding (plist-get args :coding))
+ (noquery (plist-get args :noquery))
+ (connection-type (plist-get args :connection-type))
+ (filter (plist-get args :filter))
+ (sentinel (plist-get args :sentinel))
+ (stderr (plist-get args :stderr)))
+ (unless (stringp name)
+ (signal 'wrong-type-argument (list #'stringp name)))
+ (unless (or (null buffer) (bufferp buffer) (stringp buffer))
+ (signal 'wrong-type-argument (list #'stringp buffer)))
+ (unless (consp command)
+ (signal 'wrong-type-argument (list #'consp command)))
+ (unless (or (null coding)
+ (and (symbolp coding) (memq coding coding-system-list))
+ (and (consp coding)
+ (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)))
+ (signal 'wrong-type-argument (list #'symbolp connection-type)))
+ (unless (or (null filter) (functionp filter))
+ (signal 'wrong-type-argument (list #'functionp filter)))
+ (unless (or (null sentinel) (functionp sentinel))
+ (signal 'wrong-type-argument (list #'functionp sentinel)))
+ (unless (or (null stderr) (bufferp stderr) (stringp stderr))
+ (signal 'wrong-type-argument (list #'stringp stderr)))
+ (when (and (stringp stderr) (tramp-tramp-file-p stderr)
+ (not (tramp-equal-remote default-directory stderr)))
+ (signal 'file-error (list "Wrong stderr" stderr)))
+
+ (let* ((buffer
+ (if buffer
+ (get-buffer-create buffer)
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (generate-new-buffer tramp-temp-buffer-name)))
+ ;; 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))))
+ (remote-tmpstderr
+ (and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
+ (program (car command))
+ (args (cdr command))
+ (command
+ (format "cd %s && exec %s %s"
+ (tramp-shell-quote-argument localname)
+ (if tmpstderr (format "2>'%s'" tmpstderr) "")
+ (mapconcat #'tramp-shell-quote-argument
+ (cons program args) " ")))
+ (tramp-process-connection-type
+ (or (null program) tramp-process-connection-type))
+ (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
+ (name1 name)
+ (i 0))
+
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ (setq name name1)
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ ;; We catch this event. Otherwise, `make-process'
+ ;; could be called on the local host.
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save BUFFER
+ ;; contents. Clear also the modification time;
+ ;; otherwise we might be interrupted by
+ ;; `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t))
+ (clear-visited-file-modtime)
+ (narrow-to-region (point-max) (point-max))
+ ;; We call `tramp-adb-maybe-open-connection',
+ ;; in order to cleanup the prompt afterwards.
+ (tramp-adb-maybe-open-connection v)
+ (delete-region (point-min) (point-max))
+ ;; Send the command.
+ (let* ((p (tramp-get-connection-process v)))
+ (tramp-adb-send-command v command nil t) ; nooutput
+ ;; Set sentinel and filter.
+ (when sentinel
+ (set-process-sentinel p sentinel))
+ (when filter
+ (set-process-filter p filter))
+ ;; Set query flag and process marker for
+ ;; this process. We ignore errors, because
+ ;; the process could have finished already.
+ (ignore-errors
+ (set-process-query-on-exit-flag p (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))))
+ ;; Read initial output. Remove the first
+ ;; line, which is the command echo.
+ (while
+ (progn
+ (goto-char (point-min))
+ (not (re-search-forward "[\n]" nil t)))
+ (tramp-accept-process-output p 0))
+ (delete-region (point-min) (point))
+ ;; 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.
+ (when (bufferp stderr)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr 'visit))
+ ;; Delete tmpstderr file.
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr 'visit nil nil 'replace))
+ (delete-file remote-tmpstderr))))
+ ;; Return process.
+ p))))
+
+ ;; Save exit.
+ (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (ignore-errors
+ (set-process-buffer (tramp-get-connection-process v) nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp))
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")))))))))
(defun tramp-adb-handle-exec-path ()
"Like `exec-path' for Tramp files."
(append
(with-parsed-tramp-file-name default-directory nil
- (with-tramp-connection-property v "remote-path"
+ (with-tramp-connection-property (tramp-get-process v) "remote-path"
(tramp-adb-send-command v "echo \\\"$PATH\\\"")
(split-string
(with-current-buffer (tramp-get-connection-buffer v)
@@ -1145,11 +1063,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
"Return full host name from VEC to be used in shell execution.
E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
a host name \"R38273882DE\" returns \"R38273882DE\"."
- ;; Sometimes this is called before there is a connection process
- ;; yet. In order to work with the connection cache, we flush all
- ;; unwanted entries first.
- (tramp-flush-connection-properties nil)
- (with-tramp-connection-property (tramp-get-connection-process vec) "device"
+ (with-tramp-connection-property (tramp-get-process vec) "device"
(let* ((host (tramp-file-name-host vec))
(port (tramp-file-name-port-or-default vec))
(devices (mapcar #'cadr (tramp-adb-parse-device-names nil))))
@@ -1167,10 +1081,10 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
;; Try to connect device.
((and tramp-adb-connect-if-not-connected
(not (zerop (length host)))
- (not (tramp-adb-execute-adb-command
- vec "connect"
- (replace-regexp-in-string
- tramp-prefix-port-format ":" host))))
+ (tramp-adb-execute-adb-command
+ vec "connect"
+ (replace-regexp-in-string
+ tramp-prefix-port-format ":" host)))
;; When new device connected, running other adb command (e.g.
;; adb shell) immediately will fail. To get around this
;; problem, add sleep 0.1 second here.
@@ -1180,18 +1094,18 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
vec 'file-error "Could not find device %s" host)))))))
(defun tramp-adb-execute-adb-command (vec &rest args)
- "Return nil on success error-output on failure."
+ "Execute an adb command.
+Insert the result into the connection buffer. Return nil on
+error and non-nil on success."
(when (and (> (length (tramp-file-name-host vec)) 0)
;; The -s switch is only available for ADB device commands.
(not (member (car args) '("connect" "disconnect"))))
(setq args (append (list "-s" (tramp-adb-get-device vec)) args)))
- (with-temp-buffer
- (prog1
- (unless
- (zerop
- (apply #'tramp-call-process vec tramp-adb-program nil t nil args))
- (buffer-string))
- (tramp-message vec 6 "%s" (buffer-string)))))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; Clean up the buffer. We cannot call `erase-buffer' because
+ ;; narrowing might be in effect.
+ (let ((inhibit-read-only t)) (delete-region (point-min) (point-max)))
+ (zerop (apply #'tramp-call-process vec tramp-adb-program nil t nil args))))
(defun tramp-adb-find-test-command (vec)
"Check whether the ash has a builtin \"test\" command.
@@ -1203,25 +1117,30 @@ This happens for Android >= 4.0."
(defun tramp-adb-send-command (vec command &optional neveropen nooutput)
"Send the COMMAND to connection VEC."
- (unless neveropen (tramp-adb-maybe-open-connection vec))
- (tramp-message vec 6 "%s" command)
- (tramp-send-string vec command)
- (unless nooutput
- ;; FIXME: Race condition.
- (tramp-adb-wait-for-output (tramp-get-connection-process vec))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (save-excursion
- (goto-char (point-min))
- ;; We can't use stty to disable echo of command. stty is said
- ;; to be added to toybox 0.7.6. busybox shall have it, but this
- ;; isn't used any longer for Android.
- (delete-matching-lines (regexp-quote command))
- ;; When the local machine is W32, there are still trailing ^M.
- ;; There must be a better solution by setting the correct coding
- ;; system, but this requires changes in core Tramp.
- (goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" nil nil))))))
+ (if (string-match-p "[[:multibyte:]]" command)
+ ;; Multibyte codepoints with four bytes are not supported at
+ ;; least by toybox.
+ (tramp-adb-execute-adb-command vec "shell" command)
+
+ (unless neveropen (tramp-adb-maybe-open-connection vec))
+ (tramp-message vec 6 "%s" command)
+ (tramp-send-string vec command)
+ (unless nooutput
+ ;; FIXME: Race condition.
+ (tramp-adb-wait-for-output (tramp-get-connection-process vec))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (save-excursion
+ (goto-char (point-min))
+ ;; We can't use stty to disable echo of command. stty is said
+ ;; to be added to toybox 0.7.6. busybox shall have it, but this
+ ;; isn't used any longer for Android.
+ (delete-matching-lines (regexp-quote command))
+ ;; When the local machine is W32, there are still trailing ^M.
+ ;; There must be a better solution by setting the correct coding
+ ;; system, but this requires changes in core Tramp.
+ (goto-char (point-min))
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" nil nil)))))))
(defun tramp-adb-send-command-and-check (vec command &optional exit-status)
"Run COMMAND and check its exit status.
@@ -1236,7 +1155,7 @@ the exit status."
(format "%s; echo tramp_exit_status $?" command)
"echo tramp_exit_status $?"))
(with-current-buffer (tramp-get-connection-buffer vec)
- (unless (tramp-search-regexp "tramp_exit_status [0-9]+")
+ (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
(tramp-error
vec 'file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
@@ -1340,12 +1259,24 @@ connection if a previous connection has died for some reason."
(tramp-adb-send-command
vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
+ ;; Disable line editing.
+ (tramp-adb-send-command
+ vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs")
+
+ ;; Dump option settings in the traces.
+ (when (>= tramp-verbose 9)
+ (tramp-adb-send-command vec "set -o"))
+
;; Check whether the properties have been changed. If
;; yes, this is a strong indication that we must expire all
;; connection properties. We start again.
(tramp-message vec 5 "Checking system information")
(tramp-adb-send-command
- vec "echo \\\"`getprop ro.product.model` `getprop ro.product.version` `getprop ro.build.version.release`\\\"")
+ vec
+ (concat
+ "echo \\\"`getprop ro.product.model` "
+ "`getprop ro.product.version` "
+ "`getprop ro.build.version.release`\\\""))
(let ((old-getprop
(tramp-get-connection-property vec "getprop" nil))
(new-getprop
@@ -1369,7 +1300,8 @@ connection if a previous connection has died for some reason."
(tramp-adb-send-command vec (format "su %s" user))
(unless (tramp-adb-send-command-and-check vec nil)
(delete-process p)
- (tramp-flush-file-property vec "" "su-command-p")
+ ;; Do not flush, we need the nil value.
+ (tramp-set-file-property vec "" "su-command-p" nil)
(tramp-error
vec 'file-error "Cannot switch to user `%s'" user)))
@@ -1403,4 +1335,9 @@ connection if a previous connection has died for some reason."
(provide 'tramp-adb)
+;;; TODO:
+;;
+;; * Support file names with multibyte codepoints. Use as fallback
+;; "adb shell COMMAND".
+;;
;;; tramp-adb.el ends here
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 611247ef2cb..9502cc35300 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -279,7 +279,9 @@ It must be supported by libarchive(3).")
(start-file-process . tramp-archive-handle-not-implemented)
;; `substitute-in-file-name' performed by default handler.
(temporary-file-directory . tramp-archive-handle-temporary-file-directory)
- ;; `tramp-set-file-uid-gid' performed by default handler.
+ (tramp-get-remote-gid . ignore)
+ (tramp-get-remote-uid . ignore)
+ (tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
@@ -353,7 +355,7 @@ arguments to pass to the OPERATION."
(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))))
+ (put #'tramp-archive-autoload-file-name-handler 'safe-magic t))))
;;;###autoload
(progn
@@ -369,7 +371,7 @@ arguments to pass to the OPERATION."
(tramp-register-archive-file-name-handler)
;; Mark `operations' the handler is responsible for.
-(put 'tramp-archive-file-name-handler 'operations
+(put #'tramp-archive-file-name-handler 'operations
(mapcar #'car tramp-archive-file-name-handler-alist))
;; `tramp-archive-file-name-handler' must be placed before `url-file-handler'.
@@ -520,13 +522,16 @@ offered."
(declare (debug (form symbolp body))
(indent 2))
(let ((bindings
- (mapcar (lambda (elem)
- `(,(if var (intern (format "%s-%s" var elem)) elem)
- (,(intern (format "tramp-file-name-%s" elem))
- ,(or var 'v))))
- `,(cons
- 'archive
- (delete 'hop (tramp-compat-tramp-file-name-slots))))))
+ (mapcar
+ (lambda (elem)
+ `(,(if var (intern (format "%s-%s" var elem)) elem)
+ (,(intern (format "tramp-file-name-%s" elem))
+ ,(or var 'v))))
+ (cons
+ 'archive
+ (delete
+ 'hop
+ (cdr (mapcar #'car (cl-struct-slot-info 'tramp-file-name))))))))
`(let* ((,(or var 'v) (tramp-archive-dissect-file-name ,filename))
,@bindings)
;; We don't know which of those vars will be used, so we bind them all,
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 0f2d7a1800f..970e2eea0ac 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -31,13 +31,13 @@
;; a process, has a unique cache. We distinguish 4 kind of caches,
;; depending on the key:
;;
-;; - localname is NIL. This are reusable properties. Examples:
+;; - localname is nil. These are reusable properties. Examples:
;; "remote-shell" identifies the POSIX shell to be called on the
;; remote host, or "perl" is the command to be called on the remote
;; host when starting a Perl script. These properties are saved in
;; the file `tramp-persistency-file-name'.
;;
-;; - localname is a string. This are temporary properties, which are
+;; - localname is a string. These are temporary properties, which are
;; related to the file localname is referring to. Examples:
;; "file-exists-p" is t or nil, depending on the file existence, or
;; "file-attributes" caches the result of the function
@@ -45,21 +45,32 @@
;; expire after `remote-file-name-inhibit-cache' seconds if this
;; variable is set.
;;
-;; - The key is a process. This are temporary properties related to
+;; - The key is a process. These are temporary properties related to
;; 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.
;;
-;; - The key is nil. This are temporary properties related to the
+;; - The key is nil. These are temporary properties related to the
;; local machine. Examples: "parse-passwd" and "parse-group" keep
;; the results of parsing "/etc/passwd" and "/etc/group",
;; "{uid,gid}-{integer,string}" are the local uid and gid, and
;; "locale" is the used shell locale.
+;;
+;; - The key is `tramp-cache-undefined'. All functions return the
+;; expected values, but nothing is cached.
;; Some properties are handled special:
;;
;; - "process-name", "process-buffer" and "first-password-request" are
-;; not saved in the file `tramp-persistency-file-name'.
+;; not saved in the file `tramp-persistency-file-name', although
+;; being connection properties related to a `tramp-file-name'
+;; structure.
+;;
+;; - Reusable properties, which should not be saved, are kept in the
+;; 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).
;;; Code:
@@ -96,25 +107,31 @@ details see the info pages."
(defvar tramp-cache-data-changed nil
"Whether persistent cache data have been changed.")
+;;;###tramp-autoload
+(defconst tramp-cache-undefined 'undef
+ "The symbol marking undefined hash keys and values.")
+
(defun tramp-get-hash-table (key)
"Return the hash table for KEY.
If it doesn't exist yet, it is created and initialized with
-matching entries of `tramp-connection-properties'."
- (or (gethash key tramp-cache-data)
- (let ((hash
- (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
- (or (nth 0 elt) "")
- (tramp-make-tramp-file-name key 'noloc 'nohop))
- (tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
- hash)))
+matching entries of `tramp-connection-properties'.
+If KEY is `tramp-cache-undefined', don't create anything, and return nil."
+ (unless (eq key tramp-cache-undefined)
+ (or (gethash key tramp-cache-data)
+ (let ((hash
+ (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
+ (or (nth 0 elt) "")
+ (tramp-make-tramp-file-name key 'noloc 'nohop))
+ (tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
+ hash))))
;;;###tramp-autoload
(defun tramp-get-file-property (key file property default)
"Get the PROPERTY of FILE from the cache context of KEY.
-Returns DEFAULT if not set."
+Return DEFAULT if not set."
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
key (copy-tramp-file-name key))
@@ -122,31 +139,32 @@ Returns DEFAULT if not set."
(tramp-run-real-handler #'directory-file-name (list file))
(tramp-file-name-hop key) nil)
(let* ((hash (tramp-get-hash-table key))
- (value (when (hash-table-p hash) (gethash property hash))))
- (if ;; We take the value only if there is any, and
- ;; `remote-file-name-inhibit-cache' indicates that it is still
- ;; valid. Otherwise, DEFAULT is set.
- (and (consp value)
+ (cached (and (hash-table-p hash) (gethash property hash)))
+ (cached-at (and (consp cached) (format-time-string "%T" (car cached))))
+ (value default)
+ cache-used)
+
+ (when ;; We take the value only if there is any, and
+ ;; `remote-file-name-inhibit-cache' indicates that it is
+ ;; still valid. Otherwise, DEFAULT is set.
+ (and (consp cached)
(or (null remote-file-name-inhibit-cache)
(and (integerp remote-file-name-inhibit-cache)
(time-less-p
- ;; `current-time' can be nil once we get rid of Emacs 24.
- (current-time)
- (time-add
- (car value)
- ;; `seconds-to-time' can be removed once we get
- ;; rid of Emacs 24.
- (seconds-to-time remote-file-name-inhibit-cache))))
+ nil
+ (time-add (car cached) remote-file-name-inhibit-cache)))
(and (consp remote-file-name-inhibit-cache)
(time-less-p
- remote-file-name-inhibit-cache (car value)))))
- (setq value (cdr value))
- (setq value default))
+ remote-file-name-inhibit-cache (car cached)))))
+ (setq value (cdr cached)
+ cache-used t))
- (tramp-message key 8 "%s %s %s" file property value)
+ (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)
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-get-count-" property)))
- (val (or (bound-and-true-p var)
+ (val (or (numberp (bound-and-true-p var))
(progn
(add-hook 'tramp-cache-unload-hook
(lambda () (makunbound var)))
@@ -157,7 +175,7 @@ Returns DEFAULT if not set."
;;;###tramp-autoload
(defun tramp-set-file-property (key file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
-Returns VALUE."
+Return VALUE."
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
key (copy-tramp-file-name key))
@@ -170,7 +188,7 @@ Returns VALUE."
(tramp-message key 8 "%s %s %s" file property value)
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-set-count-" property)))
- (val (or (bound-and-true-p var)
+ (val (or (numberp (bound-and-true-p var))
(progn
(add-hook 'tramp-cache-unload-hook
(lambda () (makunbound var)))
@@ -202,13 +220,11 @@ Returns VALUE."
key (copy-tramp-file-name key))
(setf (tramp-file-name-localname key) file
(tramp-file-name-hop key) nil)
- (maphash
- (lambda (property _value)
- (when (string-match-p
- "^\\(directory-\\|file-name-all-completions\\|file-entries\\)"
- property)
- (tramp-flush-file-property key file property)))
- (tramp-get-hash-table key)))))
+ (dolist (property (hash-table-keys (tramp-get-hash-table key)))
+ (when (string-match-p
+ "^\\(directory-\\|file-name-all-completions\\|file-entries\\)"
+ property)
+ (tramp-flush-file-property key file property))))))
;;;###tramp-autoload
(defun tramp-flush-file-properties (key file)
@@ -239,14 +255,12 @@ Remove also properties of all files in subdirectories."
#'directory-file-name (list directory)))
(truename (tramp-get-file-property key directory "file-truename" nil)))
(tramp-message key 8 "%s" directory)
- (maphash
- (lambda (key _value)
- (when (and (tramp-file-name-p key)
- (stringp (tramp-file-name-localname key))
- (string-match-p (regexp-quote directory)
- (tramp-file-name-localname key)))
- (remhash key tramp-cache-data)))
- tramp-cache-data)
+ (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)))
+ (remhash key tramp-cache-data)))
;; Remove file properties of symlinks.
(when (and (stringp truename)
(not (string-equal directory (directory-file-name truename))))
@@ -292,8 +306,9 @@ This is suppressed for temporary buffers."
"Get the named PROPERTY for the connection.
KEY identifies the connection, it is either a process or a
`tramp-file-name' structure. A special case is nil, which is
-used to cache connection properties of the local machine. If the
-value is not set for the connection, returns DEFAULT."
+used to cache connection properties of the local machine.
+If KEY is `tramp-cache-undefined', or if the value is not set for
+the connection, return DEFAULT."
;; Unify key by removing localname and hop from `tramp-file-name'
;; structure. Work with a copy in order to avoid side effects.
(when (tramp-file-name-p key)
@@ -301,15 +316,19 @@ value is not set for the connection, returns DEFAULT."
(setf (tramp-file-name-localname key) nil
(tramp-file-name-hop key) nil))
(let* ((hash (tramp-get-hash-table key))
- (value
- ;; If the key is an auxiliary process object, check whether
- ;; the process is still alive.
- (if (and (processp key) (not (process-live-p key)))
- default
- (if (hash-table-p hash)
- (gethash property hash default)
- default))))
- (tramp-message key 7 "%s %s" property value)
+ (cached (if (hash-table-p hash)
+ (gethash property hash tramp-cache-undefined)
+ tramp-cache-undefined))
+ (value default)
+ cache-used)
+
+ (when (and (not (eq cached tramp-cache-undefined))
+ ;; If the key is an auxiliary process object, check
+ ;; whether the process is still alive.
+ (not (and (processp key) (not (process-live-p key)))))
+ (setq value cached
+ cache-used t))
+ (tramp-message key 7 "%s %s; cache used: %s" property value cache-used)
value))
;;;###tramp-autoload
@@ -317,19 +336,22 @@ value is not set for the connection, returns DEFAULT."
"Set the named PROPERTY of a connection to VALUE.
KEY identifies the connection, it is either a process or a
`tramp-file-name' structure. A special case is nil, which is
-used to cache connection properties of the local machine.
-PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
+used to cache connection properties of the local machine. If KEY
+is `tramp-cache-undefined', nothing is set.
+PROPERTY is set persistent when KEY is a `tramp-file-name' structure.
+Return VALUE."
;; Unify key by removing localname and hop from `tramp-file-name'
;; structure. Work with a copy in order to avoid side effects.
(when (tramp-file-name-p key)
(setq key (copy-tramp-file-name key))
(setf (tramp-file-name-localname key) nil
(tramp-file-name-hop key) nil))
- (let ((hash (tramp-get-hash-table key)))
- (puthash property value hash)
- (setq tramp-cache-data-changed t)
- (tramp-message key 7 "%s %s" property value)
- value))
+ (when-let ((hash (tramp-get-hash-table key)))
+ (puthash property value hash))
+ (setq tramp-cache-data-changed
+ (or tramp-cache-data-changed (tramp-file-name-p key)))
+ (tramp-message key 7 "%s %s" property value)
+ value)
;;;###tramp-autoload
(defun tramp-connection-property-p (key property)
@@ -337,7 +359,8 @@ PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
KEY identifies the connection, it is either a process or a
`tramp-file-name' structure. A special case is nil, which is
used to cache connection properties of the local machine."
- (not (eq (tramp-get-connection-property key property 'undef) 'undef)))
+ (not (eq (tramp-get-connection-property key property tramp-cache-undefined)
+ tramp-cache-undefined)))
;;;###tramp-autoload
(defun tramp-flush-connection-property (key property)
@@ -352,8 +375,10 @@ PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
(setq key (copy-tramp-file-name key))
(setf (tramp-file-name-localname key) nil
(tramp-file-name-hop key) nil))
- (remhash property (tramp-get-hash-table key))
- (setq tramp-cache-data-changed t)
+ (when-let ((hash (tramp-get-hash-table key)))
+ (remhash property hash))
+ (setq tramp-cache-data-changed
+ (or tramp-cache-data-changed (tramp-file-name-p key)))
(tramp-message key 7 "%s" property))
;;;###tramp-autoload
@@ -370,12 +395,10 @@ used to cache connection properties of the local machine."
(tramp-file-name-hop key) nil))
(tramp-message
key 7 "%s %s" key
- (let ((hash (gethash key tramp-cache-data))
- properties)
- (when (hash-table-p hash)
- (maphash (lambda (x _y) (push x properties)) hash))
- properties))
- (setq tramp-cache-data-changed t)
+ (when-let ((hash (gethash key tramp-cache-data)))
+ (hash-table-keys hash)))
+ (setq tramp-cache-data-changed
+ (or tramp-cache-data-changed (tramp-file-name-p key)))
(remhash key tramp-cache-data))
;;;###tramp-autoload
@@ -386,20 +409,15 @@ used to cache connection properties of the local machine."
(maphash
(lambda (key value)
;; Remove text properties from KEY and VALUE.
- ;; `cl-struct-slot-*' functions exist since Emacs 25 only; we
- ;; ignore errors.
(when (tramp-file-name-p key)
- ;; (dolist
- ;; (slot
- ;; (mapcar #'car (cdr (cl-struct-slot-info 'tramp-file-name))))
- ;; (when (stringp (cl-struct-slot-value 'tramp-file-name slot key))
- ;; (setf (cl-struct-slot-value 'tramp-file-name slot key)
- ;; (substring-no-properties
- ;; (cl-struct-slot-value 'tramp-file-name slot key))))))
- (dotimes (i (length key))
- (when (stringp (elt key i))
- (setf (elt key i) (substring-no-properties (elt key i))))))
- (when (stringp key)
+ (dolist
+ (slot
+ (mapcar #'car (cdr (cl-struct-slot-info 'tramp-file-name))))
+ (when (stringp (cl-struct-slot-value 'tramp-file-name slot key))
+ (setf (cl-struct-slot-value 'tramp-file-name slot key)
+ (substring-no-properties
+ (cl-struct-slot-value 'tramp-file-name slot key))))))
+ (when (stringp key)
(setq key (substring-no-properties key)))
(when (stringp value)
(setq value (substring-no-properties value)))
@@ -421,18 +439,18 @@ used to cache connection properties of the local machine."
;;;###tramp-autoload
(defun tramp-list-connections ()
"Return all known `tramp-file-name' structs according to `tramp-cache'."
- (let (result tramp-verbose)
- (maphash
- (lambda (key _value)
- (when (and (tramp-file-name-p key)
- (null (tramp-file-name-localname key))
- (tramp-connection-property-p key "process-buffer"))
- (push key result)))
- tramp-cache-data)
- result))
+ (let ((tramp-verbose 0))
+ (delq nil (mapcar
+ (lambda (key)
+ (and (tramp-file-name-p key)
+ (null (tramp-file-name-localname key))
+ (tramp-connection-property-p key "process-buffer")
+ key))
+ (hash-table-keys tramp-cache-data)))))
(defun tramp-dump-connection-properties ()
- "Write persistent connection properties into file `tramp-persistency-file-name'."
+ "Write persistent connection properties into file \
+`tramp-persistency-file-name'."
;; We shouldn't fail, otherwise Emacs might not be able to be closed.
(ignore-errors
(when (and (hash-table-p tramp-cache-data)
@@ -464,15 +482,10 @@ used to cache connection properties of the local machine."
;; Dump it.
(with-temp-file tramp-persistency-file-name
(insert
- ";; -*- emacs-lisp -*-"
- ;; `time-stamp-string' might not exist in all Emacs flavors.
- (condition-case nil
- (progn
- (format
- " <%s %s>\n"
- (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
- tramp-persistency-file-name))
- (error "\n"))
+ ;; Starting with Emacs 28, we could use `lisp-data'.
+ (format ";; -*- emacs-lisp -*- <%s %s>\n"
+ (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
+ tramp-persistency-file-name)
";; Tramp connection history. Don't change this file.\n"
";; Run `M-x tramp-cleanup-all-connections' instead.\n\n"
(with-output-to-string
@@ -490,17 +503,14 @@ used to cache connection properties of the local machine."
"Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function'
for all methods. Resulting data are derived from connection history."
- (let (res)
- (maphash
- (lambda (key _value)
- (if (and (tramp-file-name-p key)
- (string-equal method (tramp-file-name-method key))
- (not (tramp-file-name-localname key)))
- (push (list (tramp-file-name-user key)
- (tramp-file-name-host key))
- res)))
- tramp-cache-data)
- res))
+ (mapcar
+ (lambda (key)
+ (and (tramp-file-name-p key)
+ (string-equal method (tramp-file-name-method key))
+ (not (tramp-file-name-localname key))
+ (list (tramp-file-name-user key)
+ (tramp-file-name-host key))))
+ (hash-table-keys tramp-cache-data)))
;; When "emacs -Q" has been called, both variables are nil. We do not
;; load the persistency file then, in order to have a clean test environment.
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index b4dca2321c1..827d5f60a2b 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -74,11 +74,13 @@ SYNTAX can be one of the symbols `default' (default),
Each function is called with the current vector as argument.")
;;;###tramp-autoload
-(defun tramp-cleanup-connection (vec &optional keep-debug keep-password)
+(defun tramp-cleanup-connection
+ (vec &optional keep-debug keep-password keep-processes)
"Flush all connection related objects.
This includes password cache, file cache, connection cache,
-buffers. KEEP-DEBUG non-nil preserves the debug buffer.
-KEEP-PASSWORD non-nil preserves the password cache.
+buffers, processes. KEEP-DEBUG non-nil preserves the debug
+buffer. KEEP-PASSWORD non-nil preserves the password cache.
+KEEP-PROCESSES non-nil preserves the asynchronous processes.
When called interactively, a Tramp connection has to be selected."
(interactive
;; When interactive, select the Tramp remote identification.
@@ -107,21 +109,21 @@ When called interactively, a Tramp connection has to be selected."
;; suppressed.
(setq tramp-current-connection nil)
- ;; Flush file cache.
- (tramp-flush-directory-properties vec "")
-
- ;; Flush connection cache.
- (when (processp (tramp-get-connection-process vec))
- (tramp-flush-connection-properties (tramp-get-connection-process vec))
- (delete-process (tramp-get-connection-process vec)))
- (tramp-flush-connection-properties vec)
-
;; Cancel timer.
(dolist (timer timer-list)
(when (and (eq (timer--function timer) 'tramp-timeout-session)
(tramp-file-name-equal-p vec (car (timer--args timer))))
(cancel-timer timer)))
+ ;; Delete processes.
+ (dolist (key (hash-table-keys tramp-cache-data))
+ (when (and (processp key)
+ (tramp-file-name-equal-p (process-get key 'vector) vec)
+ (or (not keep-processes)
+ (eq key (tramp-get-process vec))))
+ (tramp-flush-connection-properties key)
+ (delete-process key)))
+
;; Remove buffers.
(dolist
(buf (list (get-buffer (tramp-buffer-name vec))
@@ -130,6 +132,12 @@ When called interactively, a Tramp connection has to be selected."
(tramp-get-connection-property vec "process-buffer" nil)))
(when (bufferp buf) (kill-buffer buf)))
+ ;; Flush file cache.
+ (tramp-flush-directory-properties vec "")
+
+ ;; Flush connection cache.
+ (tramp-flush-connection-properties vec)
+
;; The end.
(run-hook-with-args 'tramp-cleanup-connection-hook vec)))
@@ -176,8 +184,9 @@ This includes password cache, file cache, connection cache, buffers."
;; Cancel timers.
(cancel-function-timers 'tramp-timeout-session)
- ;; Remove buffers.
+ ;; Remove processes and buffers.
(dolist (name (tramp-list-tramp-buffers))
+ (when (processp (get-buffer-process name)) (delete-process name))
(when (bufferp (get-buffer name)) (kill-buffer name)))
;; The end.
@@ -350,9 +359,8 @@ The remote connection identified by SOURCE is flushed by
(or (setq target (tramp-default-rename-file source))
(tramp-user-error
nil
- (eval-when-compile
- (concat "There is no target specified. "
- "Check `tramp-default-rename-alist' for a proper entry.")))))
+ (concat "There is no target specified. "
+ "Check `tramp-default-rename-alist' for a proper entry."))))
(when (tramp-equal-remote source target)
(tramp-user-error nil "Source and target must have different remote."))
@@ -474,9 +482,7 @@ For details, see `tramp-rename-files'."
(defun tramp-bug ()
"Submit a bug report to the Tramp developers."
(interactive)
- (let ((reporter-prompt-for-summary-p t)
- ;; In rare cases, it could contain the password. So we make it nil.
- tramp-password-save-function)
+ (let ((reporter-prompt-for-summary-p t))
(reporter-submit-bug-report
tramp-bug-report-address ; to-address
(format "tramp (%s %s/%s)" ; package name and version
@@ -484,10 +490,11 @@ For details, see `tramp-rename-files'."
(sort
(delq nil (mapcar
(lambda (x)
- (and x (boundp x) (cons x 'tramp-reporter-dump-variable)))
+ (and x (boundp x) (not (get x 'tramp-suppress-trace))
+ (cons x 'tramp-reporter-dump-variable)))
(append
(mapcar #'intern (all-completions "tramp-" obarray #'boundp))
- ;; Non-tramp variables of interest.
+ ;; Non-Tramp variables of interest.
'(shell-prompt-pattern
backup-by-copying
backup-by-copying-when-linked
@@ -544,11 +551,11 @@ buffer in your bug report.
(string-match-p
(concat "[^" (bound-and-true-p mm-7bit-chars) "]") val))
(with-current-buffer reporter-eval-buffer
- (set
- varsym
- (format
- "(decode-coding-string (base64-decode-string \"%s\") 'raw-text)"
- (base64-encode-string (encode-coding-string val 'raw-text)))))))
+ (set varsym
+ `(decode-coding-string
+ (base64-decode-string
+ ,(base64-encode-string (encode-coding-string val 'raw-text)))
+ 'raw-text)))))
;; Dump variable.
(reporter-dump-variable varsym mailbuf)
@@ -557,11 +564,10 @@ buffer in your bug report.
;; Remove string quotation.
(forward-line -1)
(when (looking-at
- (eval-when-compile
- (concat "\\(^.*\\)" "\"" ;; \1 "
- "\\((base64-decode-string \\)" "\\\\" ;; \2 \
- "\\(\".*\\)" "\\\\" ;; \3 \
- "\\(\")\\)" "\"$"))) ;; \4 "
+ (concat "\\(^.*\\)" "\"" ;; \1 "
+ "\\((base64-decode-string \\)" "\\\\" ;; \2 \
+ "\\(\".*\\)" "\\\\" ;; \3 \
+ "\\(\")\\)" "\"$")) ;; \4 "
(replace-match "\\1\\2\\3\\4")
(beginning-of-line)
(insert " ;; Variable encoded due to non-printable characters.\n"))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index b7a7cc4f003..c554a8d0c2d 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -23,15 +23,15 @@
;;; Commentary:
-;; Tramp's main Emacs version for development is Emacs 27. This
-;; package provides compatibility functions for Emacs 24, Emacs 25 and
-;; Emacs 26.
+;; Tramp's main Emacs version for development is Emacs 28. This
+;; package provides compatibility functions for Emacs 25, Emacs 26 and
+;; Emacs 27.
;;; Code:
-;; In Emacs 24 and 25, `tramp-unload-file-name-handlers' is not
-;; autoloaded. So we declare it here in order to avoid recursive
-;; load. This will be overwritten in tramp.el.
+;; In Emacs 25, `tramp-unload-file-name-handlers' is not autoloaded.
+;; So we declare it here in order to avoid recursive load. This will
+;; be overwritten in tramp.el.
(defun tramp-unload-file-name-handlers () ".")
(require 'auth-source)
@@ -43,6 +43,7 @@
;; `temporary-file-directory' as function is introduced with Emacs 26.1.
(declare-function tramp-handle-temporary-file-directory "tramp")
+(defvar tramp-temp-name-prefix)
(defconst tramp-compat-emacs-compiled-version (eval-when-compile emacs-version)
"The Emacs version used for compilation.")
@@ -60,6 +61,8 @@
`(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'."
@@ -67,15 +70,19 @@ It is the default value of `temporary-file-directory'."
;; into an infloop.
(eval (car (get 'temporary-file-directory 'standard-value))))
+(defsubst tramp-compat-make-temp-name ()
+ "Generate a local temporary file name (compat function)."
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix (tramp-compat-temporary-file-directory))))
+
(defsubst tramp-compat-make-temp-file (f &optional dir-flag)
"Create a local temporary file (compat function).
Add the extension of F, if existing."
- (let* (file-name-handler-alist
- (prefix (expand-file-name
- (symbol-value 'tramp-temp-name-prefix)
- (tramp-compat-temporary-file-directory)))
- (extension (file-name-extension f t)))
- (make-temp-file prefix dir-flag extension)))
+ (make-temp-file
+ (expand-file-name
+ tramp-temp-name-prefix (tramp-compat-temporary-file-directory))
+ dir-flag (file-name-extension f t)))
;; `temporary-file-directory' as function is introduced with Emacs 26.1.
(defalias 'tramp-compat-temporary-file-directory-function
@@ -83,31 +90,7 @@ Add the extension of F, if existing."
#'temporary-file-directory
#'tramp-handle-temporary-file-directory))
-(defun tramp-compat-process-running-p (process-name)
- "Return t if system process PROCESS-NAME is running for `user-login-name'."
- (when (stringp process-name)
- (cond
- ;; GNU Emacs 22 on w32.
- ((fboundp 'w32-window-exists-p)
- (tramp-compat-funcall 'w32-window-exists-p process-name process-name))
-
- ;; GNU Emacs 23+.
- ((and (fboundp 'list-system-processes) (fboundp 'process-attributes))
- (let (result)
- (dolist (pid (tramp-compat-funcall 'list-system-processes) result)
- (let ((attributes (process-attributes pid)))
- (when (and (string-equal
- (cdr (assoc 'user attributes)) (user-login-name))
- (let ((comm (cdr (assoc 'comm attributes))))
- ;; The returned command name could be truncated
- ;; to 15 characters. Therefore, we cannot check
- ;; for `string-equal'.
- (and comm (string-match-p
- (concat "^" (regexp-quote comm))
- process-name))))
- (setq result t)))))))))
-
-;; `file-attribute-*' are introduced in Emacs 25.1.
+;; `file-attribute-*' are introduced in Emacs 26.1.
(defalias 'tramp-compat-file-attribute-type
(if (fboundp 'file-attribute-type)
@@ -189,31 +172,13 @@ and later, and is a float in Emacs 26 and earlier."
This is a string of ten letters or dashes as in ls -l."
(nth 8 attributes))))
-;; `format-message' is new in Emacs 25.1.
-(unless (fboundp 'format-message)
- (defalias 'format-message #'format))
-
-;; `directory-name-p' is new in Emacs 25.1.
-(defalias 'tramp-compat-directory-name-p
- (if (fboundp 'directory-name-p)
- #'directory-name-p
- (lambda (name)
- "Return non-nil if NAME ends with a directory separator character."
- (let ((len (length name))
- (lastc ?.))
- (if (> len 0)
- (setq lastc (aref name (1- len))))
- (or (= lastc ?/)
- (and (memq system-type '(windows-nt ms-dos))
- (= lastc ?\\)))))))
-
;; `file-missing' is introduced in Emacs 26.1.
(defconst tramp-file-missing
(if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
"The error symbol for the `file-missing' error.")
;; `file-local-name', `file-name-quoted-p', `file-name-quote' and
-;; `file-name-unquote' are introduced in Emacs 26.
+;; `file-name-unquote' are introduced in Emacs 26.1.
(defalias 'tramp-compat-file-local-name
(if (fboundp 'file-local-name)
#'file-local-name
@@ -223,7 +188,8 @@ It returns a file name which can be used directly as argument of
`process-file', `start-file-process', or `shell-command'."
(or (file-remote-p name 'localname) name))))
-;; `file-name-quoted-p' got a second argument in Emacs 27.1.
+;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' got
+;; a second argument in Emacs 27.1.
(defalias 'tramp-compat-file-name-quoted-p
(if (and
(fboundp 'file-name-quoted-p)
@@ -265,7 +231,7 @@ NAME is unquoted."
localname (if (= (length localname) 2) "/" (substring localname 2))))
(concat (file-remote-p name) localname)))))
-;; `tramp-syntax' has changed its meaning in Emacs 26. We still
+;; `tramp-syntax' has changed its meaning in Emacs 26.1. We still
;; support old settings.
(defsubst tramp-compat-tramp-syntax ()
"Return proper value of `tramp-syntax'."
@@ -274,13 +240,6 @@ NAME is unquoted."
((eq tramp-syntax 'sep) 'separate)
(t tramp-syntax)))
-;; `cl-struct-slot-info' has been introduced with Emacs 25.
-(defmacro tramp-compat-tramp-file-name-slots ()
- "Return a list of slot names."
- (if (fboundp 'cl-struct-slot-info)
- '(cdr (mapcar #'car (cl-struct-slot-info 'tramp-file-name)))
- '(cdr (mapcar #'car (get 'tramp-file-name 'cl-struct-slots)))))
-
;; The signature of `tramp-make-tramp-file-name' has been changed.
;; Therefore, we cannot use `url-tramp-convert-url-to-tramp' prior
;; Emacs 26.1. We use `temporary-file-directory' as indicator.
@@ -293,10 +252,9 @@ NAME is unquoted."
#'exec-path
(lambda ()
"List of directories to search programs to run in remote subprocesses."
- (let ((handler (find-file-name-handler default-directory 'exec-path)))
- (if handler
- (funcall handler 'exec-path)
- exec-path)))))
+ (if-let ((handler (find-file-name-handler default-directory 'exec-path)))
+ (funcall handler 'exec-path)
+ exec-path))))
;; `time-equal-p' has appeared in Emacs 27.1.
(defalias 'tramp-compat-time-equal-p
@@ -331,16 +289,38 @@ A nil value for either argument stands for the current time."
(lambda (reporter &optional value _suffix)
(progress-reporter-update reporter value))))
+;; `file-modes', `set-file-modes' and `set-file-times' got argument
+;; FLAG in Emacs 28.1.
+(defalias 'tramp-compat-file-modes
+ (if (equal (tramp-compat-funcall 'func-arity #'file-modes) '(1 . 2))
+ #'file-modes
+ (lambda (filename &optional _flag)
+ (file-modes filename))))
+
+(defalias 'tramp-compat-set-file-modes
+ (if (equal (tramp-compat-funcall 'func-arity #'set-file-modes) '(2 . 3))
+ #'set-file-modes
+ (lambda (filename mode &optional _flag)
+ (set-file-modes filename mode))))
+
+(defalias 'tramp-compat-set-file-times
+ (if (equal (tramp-compat-funcall 'func-arity #'set-file-times) '(1 . 3))
+ #'set-file-times
+ (lambda (filename &optional timestamp _flag)
+ (set-file-times filename timestamp))))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-loaddefs 'force)
(unload-feature 'tramp-compat 'force)))
+(provide 'tramp-compat)
+
;;; TODO:
;;
-;; * Starting with Emacs 25.1, replace `tramp-message-show-message' by
-;; the reverse of `inhibit-message'.
-
-(provide 'tramp-compat)
+;; * `func-arity' exists since Emacs 26.1.
+;;
+;; * Starting with Emacs 27.1, there's no need to escape open
+;; parentheses with a backslash in docstrings anymore.
;;; tramp-compat.el ends here
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
new file mode 100644
index 00000000000..3e96daa7b1f
--- /dev/null
+++ b/lisp/net/tramp-crypt.el
@@ -0,0 +1,838 @@
+;;; tramp-crypt.el --- Tramp crypt utilities -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 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:
+
+;; Access functions for crypted remote files. It uses encfs to
+;; encrypt / decrypt the files on a remote directory. A remote
+;; directory, which shall include crypted files, must be declared in
+;; `tramp-crypt-directories' via command `tramp-crypt-add-directory'.
+;; All files in that directory, including all subdirectories, are
+;; stored there encrypted. This includes file names and directory
+;; names.
+
+;; This package is just responsible for the encryption part. Copying
+;; of the crypted files is still the responsibility of the remote file
+;; name handlers.
+
+;; A password protected encfs configuration file is created the very
+;; first time you access a crypted remote directory. It is kept in
+;; your user directory "~/.emacs.d/" with the url-encoded directory
+;; name as part of the basename, and ".encfs6.xml" as suffix. Do not
+;; loose this file and the corresponding password; otherwise there is
+;; no way to decrypt your crypted files.
+
+;; If the user option `tramp-crypt-save-encfs-config-remote' is
+;; non-nil (the default), the encfs configuration file ".encfs6.xml"
+;; is also kept in the crypted remote directory. It depends on you,
+;; whether you regard the password protection of this file as
+;; sufficient.
+
+;; If you use a remote file name with a quoted localname part, this
+;; localname and the corresponding file will not be encrypted/
+;; decrypted. For example, if you have a crypted remote directory
+;; "/nextcloud:user@host:/crypted_dir", the command
+;;
+;; C-x d /nextcloud:user@host:/crypted_dir
+;;
+;; will show the directory listing with the plain file names, and the
+;; command
+;;
+;; C-x d /nextcloud:user@host:/:/crypted_dir
+;;
+;; will show the directory with the encrypted file names, and visiting
+;; a file will show its crypted contents. However, it is highly
+;; discouraged to mix crypted and not crypted files in the same
+;; directory.
+
+;; If a remote directory shall not include crypted files anymore, it
+;; must be indicated by the command `tramp-crypt-remove-directory'.
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(require 'tramp)
+
+(autoload 'prop-match-beginning "text-property-search")
+(autoload 'prop-match-end "text-property-search")
+(autoload 'text-property-search-forward "text-property-search")
+
+(defconst tramp-crypt-method "crypt"
+ "Method name for crypted remote directories.")
+
+(defcustom tramp-crypt-encfs-program "encfs"
+ "Name of the encfs program."
+ :group 'tramp
+ :version "28.1"
+ :type 'string)
+
+(defcustom tramp-crypt-encfsctl-program "encfsctl"
+ "Name of the encfsctl program."
+ :group 'tramp
+ :version "28.1"
+ :type 'string)
+
+(defcustom tramp-crypt-encfs-option "--standard"
+ "Configuration option for encfs.
+This could be either \"--standard\" or \"--paranoia\". The file
+name IV chaining mode mode will always be disabled when
+initializing a new crypted remote directory."
+ :group 'tramp
+ :version "28.1"
+ :type '(choice (const "--standard")
+ (const "--paranoia")))
+
+;; We check only for encfs, assuming that encfsctl will be available
+;; as well. The autoloaded value is nil, the check will run when
+;; tramp-crypt.el is loaded by `tramp-crypt-add-directory'. It is a
+;; common technique to let-bind this variable to nil in order to
+;; suppress the file name operation of this package.
+;;;###tramp-autoload
+(defvar tramp-crypt-enabled nil
+ "Non-nil when encryption support is available.")
+(setq tramp-crypt-enabled (executable-find tramp-crypt-encfs-program))
+
+;;;###tramp-autoload
+(defconst tramp-crypt-encfs-config ".encfs6.xml"
+ "Encfs configuration file name.")
+
+(defcustom tramp-crypt-save-encfs-config-remote t
+ "Whether to keep the encfs configuration file in the crypted remote directory."
+ :group 'tramp
+ :version "28.1"
+ :type 'boolean)
+
+;;;###tramp-autoload
+(defvar tramp-crypt-directories nil
+ "List of crypted remote directories.")
+
+;; 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-crypt-file-name-p (name)
+ "Return the crypted remote directory NAME belongs to.
+If NAME doesn't belong to a crypted remote directory, retun nil."
+ (catch 'crypt-file-name-p
+ (and tramp-crypt-enabled (stringp name)
+ (not (tramp-compat-file-name-quoted-p name))
+ (not (string-suffix-p tramp-crypt-encfs-config name))
+ (dolist (dir tramp-crypt-directories)
+ (and (string-prefix-p
+ dir (file-name-as-directory (expand-file-name name)))
+ (throw 'crypt-file-name-p dir))))))
+
+
+;; New handlers should be added here.
+;;;###tramp-autoload
+(defconst tramp-crypt-file-name-handler-alist
+ '((access-file . tramp-crypt-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-crypt-handle-copy-file)
+ (delete-directory . tramp-crypt-handle-delete-directory)
+ (delete-file . tramp-crypt-handle-delete-file)
+ ;; `diff-latest-backup-file' performed by default handler.
+ ;; `directory-file-name' performed by default handler.
+ (directory-files . tramp-crypt-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 . ignore)
+ ;; `expand-file-name' performed by default handler.
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-acl . ignore)
+ (file-attributes . tramp-crypt-handle-file-attributes)
+ (file-directory-p . tramp-handle-file-directory-p)
+ (file-equal-p . tramp-handle-file-equal-p)
+ (file-executable-p . tramp-crypt-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-modes . tramp-handle-file-modes)
+ (file-name-all-completions . tramp-crypt-handle-file-name-all-completions)
+ ;; `file-name-as-directory' performed by default handler.
+ (file-name-case-insensitive-p . ignore)
+ (file-name-completion . tramp-handle-file-name-completion)
+ ;; `file-name-directory' performed by default handler.
+ ;; `file-name-nondirectory' performed by default handler.
+ ;; `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 . tramp-crypt-handle-file-ownership-preserved-p)
+ (file-readable-p . tramp-crypt-handle-file-readable-p)
+ (file-regular-p . tramp-handle-file-regular-p)
+ ;; `file-remote-p' performed by default handler.
+ (file-selinux-context . ignore)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-crypt-handle-file-system-info)
+ ;; `file-truename' performed by default handler.
+ (file-writable-p . tramp-crypt-handle-file-writable-p)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ ;; `get-file-buffer' performed by default handler.
+ (insert-directory . tramp-crypt-handle-insert-directory)
+ ;; `insert-file-contents' performed by default handler.
+ (load . tramp-handle-load)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
+ (make-directory . tramp-crypt-handle-make-directory)
+ (make-directory-internal . ignore)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
+ (make-process . ignore)
+ (make-symbolic-link . tramp-handle-make-symbolic-link)
+ (process-file . ignore)
+ (rename-file . tramp-crypt-handle-rename-file)
+ (set-file-acl . ignore)
+ (set-file-modes . tramp-crypt-handle-set-file-modes)
+ (set-file-selinux-context . ignore)
+ (set-file-times . tramp-crypt-handle-set-file-times)
+ (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
+ (shell-command . ignore)
+ (start-file-process . ignore)
+ ;; `substitute-in-file-name' performed by default handler.
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
+ ;; `tramp-get-remote-gid' performed by default handler.
+ ;; `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)
+ (vc-registered . ignore)
+ (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+ (write-region . tramp-handle-write-region))
+ "Alist of handler functions for crypt method.
+Operations not mentioned here will be handled by the default Emacs primitives.")
+
+(defsubst tramp-crypt-file-name-for-operation (operation &rest args)
+ "Like `tramp-file-name-for-operation', but for crypted remote files."
+ (let ((tfnfo (apply #'tramp-file-name-for-operation operation args)))
+ ;; `tramp-file-name-for-operation' returns already the first argument
+ ;; if it is remote. So we check a possible second argument.
+ (unless (tramp-crypt-file-name-p tfnfo)
+ (setq tfnfo (apply
+ #'tramp-file-name-for-operation operation
+ (cons (tramp-compat-temporary-file-directory) (cdr args)))))
+ tfnfo))
+
+(defun tramp-crypt-run-real-handler (operation args)
+ "Invoke normal file name handler for OPERATION.
+First arg specifies the OPERATION, second arg ARGS is a list of
+arguments to pass to the OPERATION."
+ (let* ((inhibit-file-name-handlers
+ `(tramp-crypt-file-name-handler
+ .
+ ,(and (eq inhibit-file-name-operation operation)
+ inhibit-file-name-handlers)))
+ (inhibit-file-name-operation operation))
+ (apply operation args)))
+
+;;;###tramp-autoload
+(defun tramp-crypt-file-name-handler (operation &rest args)
+ "Invoke the crypted remote file related OPERATION.
+First arg specifies the OPERATION, second arg ARGS is a list of
+arguments to pass to the OPERATION."
+ (if-let ((filename
+ (apply #'tramp-crypt-file-name-for-operation operation args))
+ (fn (and (tramp-crypt-file-name-p filename)
+ (assoc operation tramp-crypt-file-name-handler-alist))))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-crypt-run-real-handler operation args)))
+
+;;;###tramp-autoload
+(progn (defun tramp-register-crypt-file-name-handler ()
+ "Add crypt file name handler to `file-name-handler-alist'."
+ (when (and tramp-crypt-enabled tramp-crypt-directories)
+ (add-to-list 'file-name-handler-alist
+ (cons tramp-file-name-regexp #'tramp-crypt-file-name-handler))
+ (put #'tramp-crypt-file-name-handler 'safe-magic t))))
+
+(tramp-register-file-name-handlers)
+
+;; Mark `operations' the handler is responsible for.
+(put #'tramp-crypt-file-name-handler 'operations
+ (mapcar #'car tramp-crypt-file-name-handler-alist))
+
+
+;; File name conversions.
+
+(defun tramp-crypt-config-file-name (vec)
+ "Return the encfs config file name for VEC."
+ (expand-file-name
+ (concat "tramp-" (tramp-file-name-host vec) tramp-crypt-encfs-config)
+ user-emacs-directory))
+
+(defun tramp-crypt-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."
+ ;; For password handling, 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)))
+
+ ;; The following operations must be performed w/o
+ ;; `tramp-crypt-file-name-handler'.
+ (let* (tramp-crypt-enabled
+ ;; Don't check for a proper method.
+ (non-essential t)
+ (remote-config
+ (expand-file-name
+ tramp-crypt-encfs-config (tramp-crypt-get-remote-dir vec)))
+ (local-config (tramp-crypt-config-file-name vec)))
+ ;; There is no local encfs6 config file.
+ (when (not (file-exists-p local-config))
+ (if (and tramp-crypt-save-encfs-config-remote
+ (file-exists-p remote-config))
+ ;; Copy remote encfs6 config file if possible.
+ (copy-file remote-config local-config 'ok 'keep)
+
+ ;; Create local encfs6 config file otherwise.
+ (let* ((default-directory (tramp-compat-temporary-file-directory))
+ (tmpdir1 (file-name-as-directory
+ (tramp-compat-make-temp-file " .crypt" 'dir-flag)))
+ (tmpdir2 (file-name-as-directory
+ (tramp-compat-make-temp-file " .nocrypt" 'dir-flag))))
+ ;; Enable `auth-source', unless "emacs -Q" has been called.
+ (tramp-set-connection-property
+ vec "first-password-request" tramp-cache-read-persistent-data)
+ (with-temp-buffer
+ (insert
+ (tramp-read-passwd
+ (tramp-get-connection-process vec)
+ (format
+ "New EncFS Password for %s " (tramp-crypt-get-remote-dir vec))))
+ (when
+ (zerop
+ (tramp-call-process-region
+ vec (point-min) (point-max)
+ tramp-crypt-encfs-program nil (tramp-get-connection-buffer vec)
+ nil tramp-crypt-encfs-option "--extpass=cat" tmpdir1 tmpdir2))
+ ;; Save the password.
+ (ignore-errors
+ (and (functionp tramp-password-save-function)
+ (funcall tramp-password-save-function)))))
+
+ ;; Write local config file. Suppress file name IV chaining mode.
+ (with-temp-file local-config
+ (insert-file-contents
+ (expand-file-name tramp-crypt-encfs-config tmpdir1))
+ (when (search-forward
+ "<chainedNameIV>1</chainedNameIV>" nil 'noerror)
+ (replace-match "<chainedNameIV>0</chainedNameIV>")))
+
+ ;; Unmount encfs. Delete temporary directories.
+ (tramp-call-process
+ vec tramp-crypt-encfs-program nil nil nil
+ "--unmount" tmpdir1 tmpdir2)
+ (delete-directory tmpdir1 'recursive)
+ (delete-directory tmpdir2)
+
+ ;; Copy local encfs6 config file to remote.
+ (when tramp-crypt-save-encfs-config-remote
+ (copy-file local-config remote-config 'ok 'keep)))))))
+
+(defun tramp-crypt-send-command (vec &rest args)
+ "Send encfsctl command to connection VEC.
+ARGS are the arguments. It returns t if ran successful, and nil otherwise."
+ (tramp-crypt-maybe-open-connection vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (erase-buffer)
+ (set-buffer-multibyte nil))
+ (with-temp-buffer
+ (let* (;; Don't check for a proper method.
+ (non-essential t)
+ (default-directory (tramp-compat-temporary-file-directory))
+ ;; We cannot add it to `process-environment', because
+ ;; `tramp-call-process-region' doesn't use it.
+ (encfs-config
+ (format "ENCFS6_CONFIG=%s" (tramp-crypt-config-file-name vec)))
+ (args (delq nil args)))
+ ;; Enable `auth-source', unless "emacs -Q" has been called.
+ (tramp-set-connection-property
+ vec "first-password-request" tramp-cache-read-persistent-data)
+ (insert
+ (tramp-read-passwd
+ (tramp-get-connection-process vec)
+ (format "EncFS Password for %s " (tramp-crypt-get-remote-dir vec))))
+ (when (zerop
+ (apply
+ #'tramp-call-process-region vec (point-min) (point-max)
+ "env" nil (tramp-get-connection-buffer vec)
+ nil encfs-config tramp-crypt-encfsctl-program
+ (car args) "--extpass=cat" (cdr args)))
+ ;; Save the password.
+ (ignore-errors
+ (and (functionp tramp-password-save-function)
+ (funcall tramp-password-save-function)))
+ t))))
+
+(defun tramp-crypt-do-encrypt-or-decrypt-file-name (op name)
+ "Return encrypted / decrypted NAME if NAME belongs to a crypted directory.
+OP must be `encrypt' or `decrypt'. Raise an error if this fails.
+Otherwise, return NAME."
+ (if-let ((tramp-crypt-enabled t)
+ (dir (tramp-crypt-file-name-p name))
+ ;; It must be absolute for the cache.
+ (localname (substring name (1- (length dir))))
+ (crypt-vec (tramp-crypt-dissect-file-name dir)))
+ ;; Preserve trailing "/".
+ (funcall
+ (if (directory-name-p name) #'file-name-as-directory #'identity)
+ (concat
+ dir
+ (unless (string-equal localname "/")
+ (with-tramp-file-property
+ crypt-vec localname (concat (symbol-name op) "-file-name")
+ (unless (tramp-crypt-send-command
+ crypt-vec (if (eq op 'encrypt) "encode" "decode")
+ (tramp-compat-temporary-file-directory) localname)
+ (tramp-error
+ crypt-vec 'file-error "%s of file name %s failed."
+ (if (eq op 'encrypt) "Encoding" "Decoding") name))
+ (with-current-buffer (tramp-get-connection-buffer crypt-vec)
+ (goto-char (point-min))
+ (buffer-substring (point-min) (point-at-eol)))))))
+ ;; Nothing to do.
+ name))
+
+(defsubst tramp-crypt-encrypt-file-name (name)
+ "Return encrypted NAME if NAME belongs to a crypted directory.
+Otherwise, return NAME."
+ (tramp-crypt-do-encrypt-or-decrypt-file-name 'encrypt name))
+
+(defsubst tramp-crypt-decrypt-file-name (name)
+ "Return decrypted NAME if NAME belongs to a crypted directory.
+Otherwise, return NAME."
+ (tramp-crypt-do-encrypt-or-decrypt-file-name 'decrypt name))
+
+(defun tramp-crypt-do-encrypt-or-decrypt-file (op root infile outfile)
+ "Encrypt / decrypt file INFILE to OUTFILE according to crypted directory ROOT.
+Both files must be local files. OP must be `encrypt' or `decrypt'.
+If OP ist `decrypt', the basename of INFILE must be an encrypted file name.
+Raise an error if this fails."
+ (when-let ((tramp-crypt-enabled t)
+ (dir (tramp-crypt-file-name-p root))
+ (crypt-vec (tramp-crypt-dissect-file-name dir)))
+ (let ((coding-system-for-read
+ (if (eq op 'decrypt) 'binary coding-system-for-read))
+ (coding-system-for-write
+ (if (eq op 'encrypt) 'binary coding-system-for-write)))
+ (unless (tramp-crypt-send-command
+ crypt-vec "cat" (and (eq op 'encrypt) "--reverse")
+ (file-name-directory infile)
+ (concat "/" (file-name-nondirectory infile)))
+ (tramp-error
+ crypt-vec 'file-error "%s of file %s failed."
+ (if (eq op 'encrypt) "Encrypting" "Decrypting") infile))
+ (with-current-buffer (tramp-get-connection-buffer crypt-vec)
+ (write-region nil nil outfile)))))
+
+(defsubst tramp-crypt-encrypt-file (root infile outfile)
+ "Encrypt file INFILE to OUTFILE according to crypted directory ROOT.
+See `tramp-crypt-do-encrypt-or-decrypt-file'."
+ (tramp-crypt-do-encrypt-or-decrypt-file 'encrypt root infile outfile))
+
+(defsubst tramp-crypt-decrypt-file (root infile outfile)
+ "Decrypt file INFILE to OUTFILE according to crypted directory ROOT.
+See `tramp-crypt-do-encrypt-or-decrypt-file'."
+ (tramp-crypt-do-encrypt-or-decrypt-file 'decrypt root infile outfile))
+
+;;;###tramp-autoload
+(defun tramp-crypt-add-directory (name)
+ "Mark remote directory NAME for encryption.
+Files in that directory and all subdirectories will be encrypted
+before copying to, and decrypted after copying from that
+directory. File names will be also encrypted."
+ (interactive "DRemote directory name: ")
+ (unless tramp-crypt-enabled
+ (tramp-user-error nil "Feature is not enabled."))
+ (unless (and (tramp-tramp-file-p name) (file-directory-p name))
+ (tramp-user-error nil "%s must be an existing remote directory." name))
+ (when (tramp-compat-file-name-quoted-p name)
+ (tramp-user-error nil "%s must not be quoted." name))
+ (setq name (file-name-as-directory (expand-file-name name)))
+ (unless (member name tramp-crypt-directories)
+ (setq tramp-crypt-directories (cons name tramp-crypt-directories)))
+ (tramp-register-file-name-handlers))
+
+(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."
+ (interactive "DRemote directory name: ")
+ (unless tramp-crypt-enabled
+ (tramp-user-error nil "Feature is not enabled."))
+ (setq name (file-name-as-directory (expand-file-name name)))
+ (when (and (member name tramp-crypt-directories)
+ (delete
+ tramp-crypt-encfs-config
+ (directory-files name nil directory-files-no-dot-files-regexp))
+ (yes-or-no-p
+ "There exist encrypted files, do you want to continue? "))
+ (setq tramp-crypt-directories (delete name tramp-crypt-directories))
+ (tramp-register-file-name-handlers)))
+
+;; `auth-source' requires a user.
+(defun tramp-crypt-dissect-file-name (name)
+ "Return a `tramp-file-name' structure for NAME.
+The structure consists of the `tramp-crypt-method' method, the
+local user name, the hexlified directory NAME as host, and the
+localname."
+ (save-match-data
+ (if-let ((dir (tramp-crypt-file-name-p name)))
+ (make-tramp-file-name
+ :method tramp-crypt-method :user (user-login-name)
+ :host (url-hexify-string dir))
+ (tramp-user-error nil "Not a crypted remote directory: \"%s\"" name))))
+
+(defun tramp-crypt-get-remote-dir (vec)
+ "Return the name of the crypted remote directory to be used for encfs."
+ (url-unhex-string (tramp-file-name-host vec)))
+
+
+;; File name primitives.
+
+(defun tramp-crypt-handle-access-file (filename string)
+ "Like `access-file' for Tramp files."
+ (let* ((encrypt-filename (tramp-crypt-encrypt-file-name filename))
+ (encrypt-regexp (concat (regexp-quote encrypt-filename) "\\'"))
+ tramp-crypt-enabled)
+ (condition-case err
+ (access-file encrypt-filename string)
+ (error
+ (when (and (eq (car err) 'file-missing) (stringp (cadr err))
+ (string-match-p encrypt-regexp (cadr err)))
+ (setcar
+ (cdr err)
+ (replace-regexp-in-string encrypt-regexp filename (cadr err))))
+ (signal (car err) (cdr err))))))
+
+(defun tramp-crypt-do-copy-or-rename-file
+ (op filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ "Copy or rename a remote file.
+OP must be `copy' or `rename' and indicates the operation to perform.
+FILENAME specifies the file to copy or rename, NEWNAME is the name of
+the new file (for copy) or the new name of the file (for rename).
+OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
+KEEP-DATE means to make sure that NEWNAME has the same timestamp
+as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
+the uid and gid if both files are on the same host.
+PRESERVE-EXTENDED-ATTRIBUTES is ignored.
+
+This function is invoked by `tramp-crypt-handle-copy-file' and
+`tramp-crypt-handle-rename-file'. It is an error if OP is
+neither of `copy' and `rename'. FILENAME and NEWNAME must be
+absolute file names."
+ (unless (memq op '(copy rename))
+ (error "Unknown operation `%s', must be `copy' or `rename'" op))
+
+ (setq filename (file-truename filename))
+ (let ((t1 (tramp-crypt-file-name-p filename))
+ (t2 (tramp-crypt-file-name-p newname))
+ (encrypt-filename (tramp-crypt-encrypt-file-name filename))
+ (encrypt-newname (tramp-crypt-encrypt-file-name newname))
+ (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
+
+ (if (file-directory-p filename)
+ (progn
+ (copy-directory filename newname keep-date t)
+ (when (eq op 'rename)
+ (delete-directory filename 'recursive)))
+
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (unless (file-exists-p filename)
+ (tramp-error
+ v tramp-file-missing
+ "%s file" msg-operation "No such file or directory" filename))
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (if (and t1 t2 (string-equal t1 t2))
+ ;; Both files are on the same crypted remote directory.
+ (let (tramp-crypt-enabled)
+ (if (eq op 'copy)
+ (copy-file
+ encrypt-filename encrypt-newname ok-if-already-exists
+ keep-date preserve-uid-gid preserve-extended-attributes)
+ (rename-file
+ encrypt-filename encrypt-newname ok-if-already-exists)))
+
+ (let* ((tmpdir (tramp-compat-make-temp-file filename 'dir))
+ (tmpfile1
+ (expand-file-name
+ (file-name-nondirectory encrypt-filename) tmpdir))
+ (tmpfile2
+ (expand-file-name
+ (file-name-nondirectory encrypt-newname) tmpdir))
+ tramp-crypt-enabled)
+ (cond
+ ;; Source and target file are on a crypted remote directory.
+ ((and t1 t2)
+ (if (eq op 'copy)
+ (copy-file
+ encrypt-filename encrypt-newname ok-if-already-exists
+ keep-date preserve-uid-gid preserve-extended-attributes)
+ (rename-file
+ encrypt-filename encrypt-newname ok-if-already-exists)))
+ ;; Source file is on a crypted remote directory.
+ (t1
+ (if (eq op 'copy)
+ (copy-file
+ encrypt-filename tmpfile1 t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file encrypt-filename tmpfile1 t))
+ (tramp-crypt-decrypt-file t1 tmpfile1 tmpfile2)
+ (rename-file tmpfile2 newname ok-if-already-exists))
+ ;; Target file is on a crypted remote directory.
+ (t2
+ (if (eq op 'copy)
+ (copy-file
+ filename tmpfile1 t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file filename tmpfile1 t))
+ (tramp-crypt-encrypt-file t2 tmpfile1 tmpfile2)
+ (rename-file tmpfile2 encrypt-newname ok-if-already-exists)))
+ (delete-directory tmpdir 'recursive))))))
+
+ (when (and t1 (eq op 'rename))
+ (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)))))
+
+(defun tramp-crypt-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))
+ ;; At least one file a Tramp file?
+ (if (or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-crypt-do-copy-or-rename-file
+ 'copy filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ (tramp-run-real-handler
+ #'copy-file
+ (list filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes))))
+
+(defun tramp-crypt-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)
+ (let (tramp-crypt-enabled)
+ (delete-directory
+ (tramp-crypt-encrypt-file-name directory) recursive trash))))
+
+(defun tramp-crypt-handle-delete-file (filename &optional trash)
+ "Like `delete-file' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-flush-file-properties v localname)
+ (let (tramp-crypt-enabled)
+ (delete-file (tramp-crypt-encrypt-file-name filename) trash))))
+
+(defun tramp-crypt-handle-directory-files (directory &optional full match nosort)
+ "Like `directory-files' for Tramp files."
+ (unless (file-exists-p directory)
+ (tramp-error
+ (tramp-dissect-file-name directory) tramp-file-missing
+ "No such file or directory" directory))
+ (when (file-directory-p directory)
+ (setq directory (file-name-as-directory (expand-file-name directory)))
+ (let* (tramp-crypt-enabled
+ (result
+ (directory-files (tramp-crypt-encrypt-file-name directory) 'full)))
+ (setq result
+ (mapcar (lambda (x) (tramp-crypt-decrypt-file-name x)) result))
+ (when match
+ (setq result
+ (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (when (string-match-p match (substring x (length directory)))
+ x))
+ result))))
+ (unless full
+ (setq result
+ (mapcar
+ (lambda (x)
+ (replace-regexp-in-string
+ (concat "^" (regexp-quote directory)) "" x))
+ result)))
+ (if nosort result (sort result #'string<)))))
+
+(defun tramp-crypt-handle-file-attributes (filename &optional id-format)
+ "Like `file-attributes' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-attributes (tramp-crypt-encrypt-file-name filename) id-format)))
+
+(defun tramp-crypt-handle-file-executable-p (filename)
+ "Like `file-executable-p' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-executable-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
+ filename
+ (let* (completion-regexp-list
+ tramp-crypt-enabled
+ (directory (file-name-as-directory directory))
+ (enc-dir (tramp-crypt-encrypt-file-name directory)))
+ (mapcar
+ (lambda (x)
+ (substring
+ (tramp-crypt-decrypt-file-name (concat enc-dir x))
+ (length directory)))
+ (file-name-all-completions "" enc-dir)))))
+
+(defun tramp-crypt-handle-file-readable-p (filename)
+ "Like `file-readable-p' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-readable-p (tramp-crypt-encrypt-file-name filename))))
+
+(defun tramp-crypt-handle-file-ownership-preserved-p (filename &optional group)
+ "Like `file-ownership-preserved-p' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-ownership-preserved-p (tramp-crypt-encrypt-file-name filename) group)))
+
+(defun tramp-crypt-handle-file-system-info (filename)
+ "Like `file-system-info' for Tramp files."
+ (let (tramp-crypt-enabled)
+ ;; `file-system-info' exists since Emacs 27.1.
+ (tramp-compat-funcall
+ 'file-system-info (tramp-crypt-encrypt-file-name filename))))
+
+(defun tramp-crypt-handle-file-writable-p (filename)
+ "Like `file-writable-p' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-writable-p (tramp-crypt-encrypt-file-name filename))))
+
+(defun tramp-crypt-handle-insert-directory
+ (filename switches &optional wildcard full-directory-p)
+ "Like `insert-directory' for Tramp files.
+WILDCARD is not supported."
+ ;; This package has been added to Emacs 27.1.
+ (when (load "text-property-search" 'noerror 'nomessage)
+ (let (tramp-crypt-enabled)
+ (tramp-handle-insert-directory
+ (tramp-crypt-encrypt-file-name filename)
+ switches wildcard full-directory-p)
+ (let* ((filename (file-name-as-directory filename))
+ (enc (tramp-crypt-encrypt-file-name filename))
+ match string)
+ (goto-char (point-min))
+ (while (setq match (text-property-search-forward 'dired-filename t t))
+ (setq string
+ (buffer-substring
+ (prop-match-beginning match) (prop-match-end match))
+ string (if (file-name-absolute-p string)
+ (tramp-crypt-decrypt-file-name string)
+ (substring
+ (tramp-crypt-decrypt-file-name (concat enc string))
+ (length filename))))
+ (delete-region (prop-match-beginning match) (prop-match-end match))
+ (insert (propertize string 'dired-filename t)))))))
+
+(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
+ (when (and (null parents) (file-exists-p dir))
+ (tramp-error v 'file-already-exists "Directory already exists %s" dir))
+ (let (tramp-crypt-enabled)
+ (make-directory (tramp-crypt-encrypt-file-name dir) parents))
+ ;; When PARENTS is non-nil, DIR could be a chain of non-existent
+ ;; directories a/b/c/... Instead of checking, we simply flush the
+ ;; whole cache.
+ (tramp-flush-directory-properties
+ v (if parents "/" (file-name-directory localname)))))
+
+(defun tramp-crypt-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))
+ ;; At least one file a Tramp file?
+ (if (or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-crypt-do-copy-or-rename-file
+ '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))))
+
+(defun tramp-crypt-handle-set-file-modes (filename mode &optional flag)
+ "Like `set-file-modes' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v localname)
+ (let (tramp-crypt-enabled)
+ (tramp-compat-set-file-modes
+ (tramp-crypt-encrypt-file-name filename) mode flag))))
+
+(defun tramp-crypt-handle-set-file-times (filename &optional time flag)
+ "Like `set-file-times' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v localname)
+ (let (tramp-crypt-enabled)
+ (tramp-compat-set-file-times
+ (tramp-crypt-encrypt-file-name filename) time flag))))
+
+(defun tramp-crypt-handle-set-file-uid-gid (filename &optional uid gid)
+ "Like `tramp-set-file-uid-gid' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v localname)
+ (let (tramp-crypt-enabled)
+ (tramp-set-file-uid-gid
+ (tramp-crypt-encrypt-file-name filename) uid gid))))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-crypt 'force)))
+
+(provide 'tramp-crypt)
+
+;;; TODO:
+
+;; * I suggest having a feature where the user can specify to always
+;; use encryption for certain host names. So if you specify a host
+;; name which is on that list (of names, or perhaps regexps?), tramp
+;; would modify the request so as to do the encryption. (Richard Stallman)
+
+;;; tramp-crypt.el ends here
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index 95ae1569dc9..996a92454f1 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -31,8 +31,7 @@
(require 'tramp)
;; Pacify byte-compiler.
-(eval-when-compile
- (require 'custom))
+(eval-when-compile (require 'custom))
(defvar ange-ftp-ftp-name-arg)
(defvar ange-ftp-ftp-name-res)
(defvar ange-ftp-name-format)
@@ -79,9 +78,9 @@ present for backward compatibility."
;;; This regexp recognizes absolute filenames with only one component
;;; on Windows, for the sake of hostname completion.
(and (memq system-type '(ms-dos windows-nt))
- (or (assoc "^[a-zA-Z]:/[^/:]*\\'" file-name-handler-alist)
+ (or (assoc "^[[:alpha:]]:/[^/:]*\\'" file-name-handler-alist)
(setq file-name-handler-alist
- (cons '("^[a-zA-Z]:/[^/:]*\\'" .
+ (cons '("^[:alpha:]]:/[^/:]*\\'" .
ange-ftp-completion-hook-function)
file-name-handler-alist)))))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index ddb535fea6e..6467d8f88b4 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -49,11 +49,15 @@
;; The user option `tramp-gvfs-methods' contains the list of supported
;; connection methods. Per default, these are "afp", "dav", "davs",
-;; "gdrive", "nextcloud" and "sftp".
+;; "gdrive", "media", "nextcloud" and "sftp".
;; "gdrive" and "nextcloud" connection methods require a respective
;; account in GNOME Online Accounts, with enabled "Files" service.
+;; The "media" connection method is responsible for media devices,
+;; like cell phones, tablets, cameras etc. The device must already be
+;; connected via USB, before accessing it.
+
;; Other possible connection methods are "ftp", "http", "https" and
;; "smb". When one of these methods is added to the list, the remote
;; access for that method is performed via GVFS instead of the native
@@ -104,8 +108,7 @@
(require 'url-util)
;; Pacify byte-compiler.
-(eval-when-compile
- (require 'custom))
+(eval-when-compile (require 'custom))
(declare-function zeroconf-init "zeroconf")
(declare-function zeroconf-list-service-types "zeroconf")
@@ -124,16 +127,16 @@
(or ;; Until Emacs 25, `process-attributes' could crash Emacs
;; for some processes. Better we don't check.
(<= emacs-major-version 25)
- (tramp-compat-process-running-p "gvfs-fuse-daemon")
- (tramp-compat-process-running-p "gvfsd-fuse"))))
+ (tramp-process-running-p "gvfs-fuse-daemon")
+ (tramp-process-running-p "gvfsd-fuse"))))
"Non-nil when GVFS is available.")
;;;###tramp-autoload
(defcustom tramp-gvfs-methods
- '("afp" "dav" "davs" "gdrive" "nextcloud" "sftp")
+ '("afp" "dav" "davs" "gdrive" "media" "nextcloud" "sftp")
"List of methods for remote files, accessed with GVFS."
:group 'tramp
- :version "27.1"
+ :version "28.1"
:type '(repeat (choice (const "afp")
(const "dav")
(const "davs")
@@ -141,10 +144,12 @@
(const "gdrive")
(const "http")
(const "https")
+ (const "media")
(const "nextcloud")
(const "sftp")
(const "smb"))))
+;;;###tramp-autoload
(defconst tramp-goa-methods '("gdrive" "nextcloud")
"List of methods which require registration at GNOME Online Accounts.")
@@ -154,15 +159,23 @@
(dolist (method tramp-goa-methods)
(setq tramp-gvfs-methods (delete method tramp-gvfs-methods))))
-;; Add defaults for `tramp-default-user-alist' and `tramp-default-host-alist'.
;;;###tramp-autoload
-(tramp--with-startup
- (when (string-match "\\(.+\\)@\\(\\(?:gmail\\|googlemail\\)\\.com\\)"
- user-mail-address)
- (add-to-list 'tramp-default-user-alist
- `("\\`gdrive\\'" nil ,(match-string 1 user-mail-address)))
- (add-to-list 'tramp-default-host-alist
- '("\\`gdrive\\'" nil ,(match-string 2 user-mail-address)))))
+(defvar tramp-media-methods '("afc" "gphoto2" "mtp")
+ "List of GVFS methods which are covered by the \"media\" method.
+They are checked during start up via
+`tramp-gvfs-interface-remotevolumemonitor'.")
+
+(defsubst tramp-gvfs-service-volumemonitor (method)
+ "Return the well known name of the volume monitor responsible for METHOD."
+ (symbol-value
+ (intern-soft (format "tramp-gvfs-service-%s-volumemonitor" method))))
+
+;; Remove media methods if not supported.
+(when tramp-gvfs-enabled
+ (dolist (method tramp-media-methods)
+ (unless (member (tramp-gvfs-service-volumemonitor method)
+ (dbus-list-known-names :session))
+ (setq tramp-media-methods (delete method tramp-media-methods)))))
;;;###tramp-autoload
(defcustom tramp-gvfs-zeroconf-domain "local"
@@ -172,13 +185,15 @@
:type 'string)
;; Add the methods to `tramp-methods', in order to allow minibuffer
-;; completion.
+;; completion. Add defaults for `tramp-default-host-alist'.
;;;###tramp-autoload
(when (featurep 'dbusbind)
(tramp--with-startup
- (dolist (elt tramp-gvfs-methods)
- (unless (assoc elt tramp-methods)
- (add-to-list 'tramp-methods (cons elt nil))))))
+ (dolist (method tramp-gvfs-methods)
+ (unless (assoc method tramp-methods)
+ (add-to-list 'tramp-methods `(,method)))
+ (when (member method tramp-goa-methods)
+ (add-to-list 'tramp-default-host-alist `(,method nil ""))))))
(defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp")
"The preceding object path for own objects.")
@@ -460,8 +475,209 @@ It has been changed in GVFS 1.14.")
;; </interface>
;; The basic structure for GNOME Online Accounts. We use a list :type,
-;; in order to be compatible with Emacs 24 and 25.
-(cl-defstruct (tramp-goa-name (:type list) :named) method user host port)
+;; in order to be compatible with Emacs 25.
+(cl-defstruct (tramp-goa-account (:type list) :named) method user host port)
+
+;;;###tramp-autoload
+(defconst tramp-gvfs-service-afc-volumemonitor "org.gtk.vfs.AfcVolumeMonitor"
+ "The well known name of the AFC volume monitor.")
+
+;; This one is not needed yet.
+(defconst tramp-gvfs-service-goa-volumemonitor "org.gtk.vfs.GoaVolumeMonitor"
+ "The well known name of the GOA volume monitor.")
+
+;;;###tramp-autoload
+(defconst tramp-gvfs-service-gphoto2-volumemonitor
+ "org.gtk.vfs.GPhoto2VolumeMonitor"
+ "The well known name of the GPhoto2 volume monitor.")
+
+;;;###tramp-autoload
+(defconst tramp-gvfs-service-mtp-volumemonitor "org.gtk.vfs.MTPVolumeMonitor"
+ "The well known name of the MTP volume monitor.")
+
+(defconst tramp-gvfs-path-remotevolumemonitor
+ "/org/gtk/Private/RemoteVolumeMonitor"
+ "The object path of the remote volume monitor.")
+
+(defconst tramp-gvfs-interface-remotevolumemonitor
+ "org.gtk.Private.RemoteVolumeMonitor"
+ "The volume monitor interface.")
+
+;; <interface name='org.gtk.Private.RemoteVolumeMonitor'>
+;; <method name="IsSupported">
+;; <arg type='b' name='is_supported' direction='out'/>
+;; </method>
+;; <method name="List">
+;; <arg type='a(ssssbbbbbbbbuasa{ss}sa{sv})' name='drives' direction='out'/>
+;; <arg type='a(ssssssbbssa{ss}sa{sv})' name='volumes' direction='out'/>
+;; <arg type='a(ssssssbsassa{sv})' name='mounts' direction='out'/>
+;; </method>
+;; <method name="CancelOperation">
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='b' name='was_cancelled' direction='out'/>
+;; </method>
+;; <method name="MountUnmount">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='u' name='unmount_flags' direction='in'/>
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; </method>
+;; <method name="VolumeMount">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='u' name='mount_flags' direction='in'/>
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; </method>
+;; <method name="DriveEject">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='u' name='unmount_flags' direction='in'/>
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; </method>
+;; <method name="DrivePollForMedia">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; </method>
+;; <method name="DriveStart">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='u' name='flags' direction='in'/>
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; </method>
+;; <method name="DriveStop">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='u' name='unmount_flags' direction='in'/>
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; </method>
+;; <method name="MountOpReply">
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; <arg type='i' name='result' direction='in'/>
+;; <arg type='s' name='user_name' direction='in'/>
+;; <arg type='s' name='domain' direction='in'/>
+;; <arg type='s' name='encoded_password' direction='in'/>
+;; <arg type='i' name='password_save' direction='in'/>
+;; <arg type='i' name='choice' direction='in'/>
+;; <arg type='b' name='anonymous' direction='in'/>
+;; </method>
+;; <signal name="DriveChanged">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/>
+;; </signal>
+;; <signal name="DriveConnected">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/>
+;; </signal>
+;; <signal name="DriveDisconnected">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/>
+;; </signal>
+;; <signal name="DriveEjectButton">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/>
+;; </signal>
+;; <signal name="DriveStopButton">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/>
+;; </signal>
+;; <signal name="VolumeChanged">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbbssa{ss}sa{sv})' name='volume'/>
+;; </signal>
+;; <signal name="VolumeAdded">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbbssa{ss}sa{sv})' name='volume'/>
+;; </signal>
+;; <signal name="VolumeRemoved">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbbssa{ss}sa{sv})' name='volume'/>
+;; </signal>
+;; <signal name="MountChanged">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbsassa{sv})' name='mount'/>
+;; </signal>
+;; <signal name="MountAdded">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbsassa{sv})' name='mount'/>
+;; </signal>
+;; <signal name="MountPreUnmount">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbsassa{sv})' name='mount'/>
+;; </signal>
+;; <signal name="MountRemoved">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbsassa{sv})' name='mount'/>
+;; </signal>
+;; <signal name="MountOpAskPassword">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='s' name='message_to_show'/>
+;; <arg type='s' name='default_user'/>
+;; <arg type='s' name='default_domain'/>
+;; <arg type='u' name='flags'/>
+;; </signal>
+;; <signal name="MountOpAskQuestion">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='s' name='message_to_show'/>
+;; <arg type='as' name='choices'/>
+;; </signal>
+;; <signal name="MountOpShowProcesses">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='s' name='message_to_show'/>
+;; <arg type='ai' name='pid'/>
+;; <arg type='as' name='choices'/>
+;; </signal>
+;; <signal name="MountOpShowUnmountProgress">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='s' name='message_to_show'/>
+;; <arg type='x' name='time_left'/>
+;; <arg type='x' name='bytes_left'/>
+;; </signal>
+;; <signal name="MountOpAborted">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; </signal>
+;; </interface>
+
+;; STRUCT volume
+;; STRING id
+;; STRING name
+;; STRING gicon_data
+;; STRING symbolic_gicon_data
+;; STRING uuid
+;; STRING activation_uri
+;; BOOLEAN can-mount
+;; BOOLEAN should-automount
+;; STRING drive-id
+;; STRING mount-id
+;; ARRAY identifiers
+;; DICT
+;; STRING key (unix-device, class, uuid, ...)
+;; STRING value
+;; STRING sort_key
+;; ARRAY expansion
+;; DICT
+;; STRING key (always-call-mount, is-removable, ...)
+;; VARIANT value (boolean?)
+
+;; The basic structure for media devices. We use a list :type, in
+;; order to be compatible with Emacs 25.
+(cl-defstruct (tramp-media-device (:type list) :named) method host port)
;; "gvfs-<command>" utilities have been deprecated in GVFS 1.31.1. We
;; must use "gio <command>" tool instead.
@@ -473,38 +689,41 @@ It has been changed in GVFS 1.14.")
("gvfs-monitor-file" . "monitor")
("gvfs-mount" . "mount")
("gvfs-move" . "move")
+ ("gvfs-rename" . "rename")
("gvfs-rm" . "remove")
("gvfs-set-attribute" . "set")
("gvfs-trash" . "trash"))
"List of cons cells, mapping \"gvfs-<command>\" to \"gio <command>\".")
;; <http://www.pygtk.org/docs/pygobject/gio-constants.html>
-(defconst tramp-gvfs-file-attributes
- '("name"
- "type"
- "standard::display-name"
- "standard::symlink-target"
- "standard::is-volatile"
- "unix::nlink"
- "unix::uid"
- "owner::user"
- "unix::gid"
- "owner::group"
- "time::access"
- "time::modified"
- "time::changed"
- "standard::size"
- "unix::mode"
- "access::can-read"
- "access::can-write"
- "access::can-execute"
- "unix::inode"
- "unix::device")
- "GVFS file attributes.")
-
-(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
- (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)")
- "Regexp to parse GVFS file attributes with `gvfs-ls'.")
+(eval-and-compile
+ (defconst tramp-gvfs-file-attributes
+ '("name"
+ "type"
+ "standard::display-name"
+ "standard::symlink-target"
+ "standard::is-volatile"
+ "unix::nlink"
+ "unix::uid"
+ "owner::user"
+ "unix::gid"
+ "owner::group"
+ "time::access"
+ "time::modified"
+ "time::changed"
+ "standard::size"
+ "unix::mode"
+ "access::can-read"
+ "access::can-write"
+ "access::can-execute"
+ "unix::inode"
+ "unix::device")
+ "GVFS file attributes."))
+
+(eval-and-compile
+ (defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
+ (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)")
+ "Regexp to parse GVFS file attributes with `gvfs-ls'."))
(defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp
(concat "^[[:blank:]]*"
@@ -603,6 +822,8 @@ It has been changed in GVFS 1.14.")
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-remote-gid . tramp-gvfs-handle-get-remote-gid)
+ (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)
(vc-registered . ignore)
@@ -628,10 +849,9 @@ First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
(unless tramp-gvfs-enabled
(tramp-user-error nil "Package `tramp-gvfs' not supported"))
- (let ((fn (assoc operation tramp-gvfs-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
+ (if-let ((fn (assoc operation tramp-gvfs-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
;;;###tramp-autoload
(when (featurep 'dbusbind)
@@ -645,20 +865,19 @@ pass to the OPERATION."
(defun tramp-gvfs-dbus-string-to-byte-array (string)
"Like `dbus-string-to-byte-array' but add trailing \\0 if needed."
(dbus-string-to-byte-array
- (if (string-match "^(aya{sv})" tramp-gvfs-mountlocation-signature)
+ (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature)
(concat string (string 0)) string)))
(defun tramp-gvfs-dbus-byte-array-to-string (byte-array)
"Like `dbus-byte-array-to-string' but remove trailing \\0 if exists.
Return nil for null BYTE-ARRAY."
;; The byte array could be a variant. Take care.
- (let ((byte-array
- (if (and (consp byte-array) (atom (car byte-array)))
- byte-array (car byte-array))))
- (and byte-array
- (dbus-byte-array-to-string
- (if (and (consp byte-array) (zerop (car (last byte-array))))
- (butlast byte-array) byte-array)))))
+ (when-let ((byte-array
+ (if (and (consp byte-array) (atom (car byte-array)))
+ byte-array (car byte-array))))
+ (dbus-byte-array-to-string
+ (if (and (consp byte-array) (zerop (car (last byte-array))))
+ (butlast byte-array) byte-array))))
(defun tramp-gvfs-stringify-dbus-message (message)
"Convert a D-Bus MESSAGE into readable UTF8 strings, used for traces."
@@ -683,6 +902,8 @@ The call will be traced by Tramp with trace level 6."
(tramp-message vec 6 "%s" result(tramp-gvfs-stringify-dbus-message result))
result))
+(put #'tramp-dbus-function 'tramp-suppress-trace t)
+
(defmacro with-tramp-dbus-call-method
(vec synchronous bus service path interface method &rest args)
"Apply a D-Bus call on bus BUS.
@@ -692,14 +913,15 @@ it is an asynchronous call, with `ignore' as callback function.
The other arguments have the same meaning as with `dbus-call-method'
or `dbus-call-method-asynchronously'."
+ (declare (indent 2) (debug t))
`(let ((func (if ,synchronous
#'dbus-call-method #'dbus-call-method-asynchronously))
(args (append (list ,bus ,service ,path ,interface ,method)
(if ,synchronous (list ,@args) (list 'ignore ,@args)))))
- (tramp-dbus-function ,vec func args)))
+ ;; We use `dbus-ignore-errors', because this macro is also called
+ ;; when loading.
+ (dbus-ignore-errors (tramp-dbus-function ,vec func args))))
-(put 'with-tramp-dbus-call-method 'lisp-indent-function 2)
-(put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body))
(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>"))
(defmacro with-tramp-dbus-get-all-properties
@@ -707,6 +929,7 @@ or `dbus-call-method-asynchronously'."
"Return all properties of INTERFACE.
The call will be traced by Tramp with trace level 6."
;; Check, that interface exists at object path. Retrieve properties.
+ (declare (indent 1) (debug t))
`(when (member
,interface
(tramp-dbus-function
@@ -715,8 +938,6 @@ The call will be traced by Tramp with trace level 6."
(tramp-dbus-function
,vec #'dbus-get-all-properties (list ,bus ,service ,path ,interface))))
-(put 'with-tramp-dbus-get-all-properties 'lisp-indent-function 1)
-(put 'with-tramp-dbus-get-all-properties 'edebug-form-spec '(form symbolp body))
(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-get-all-properties\\>"))
(defvar tramp-gvfs-dbus-event-vector nil
@@ -731,10 +952,10 @@ is no information where to trace the message.")
(tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err))))
(add-hook 'dbus-event-error-functions #'tramp-gvfs-dbus-event-error)
-(add-hook
- 'tramp-gvfs-unload-hook
- (lambda ()
- (remove-hook 'dbus-event-error-functions #'tramp-gvfs-dbus-event-error)))
+(add-hook 'tramp-gvfs-unload-hook
+ (lambda ()
+ (remove-hook 'dbus-event-error-functions
+ #'tramp-gvfs-dbus-event-error)))
;; File name primitives.
@@ -765,11 +986,15 @@ file names."
(copy-directory filename newname keep-date t)
(when (eq op 'rename) (delete-directory filename 'recursive)))
- (let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname))
- (equal-remote (tramp-equal-remote filename newname))
- (gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move"))
- (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
+ (let* ((t1 (tramp-tramp-file-p filename))
+ (t2 (tramp-tramp-file-p newname))
+ (equal-remote (tramp-equal-remote filename newname))
+ (gvfs-operation
+ (cond
+ ((eq op 'copy) "gvfs-copy")
+ (equal-remote "gvfs-rename")
+ (t "gvfs-move")))
+ (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
@@ -779,7 +1004,7 @@ file names."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(if (or (and equal-remote
@@ -840,8 +1065,8 @@ file names."
(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))
- (setq newname (expand-file-name newname))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -957,10 +1182,11 @@ file names."
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(while (looking-at
- (concat "^\\(.+\\)[[:blank:]]"
- "\\([[:digit:]]+\\)[[:blank:]]"
- "(\\(.+?\\))"
- tramp-gvfs-file-attributes-with-gvfs-ls-regexp))
+ (eval-when-compile
+ (concat "^\\(.+\\)[[:blank:]]"
+ "\\([[:digit:]]+\\)[[:blank:]]"
+ "(\\(.+?\\))"
+ tramp-gvfs-file-attributes-with-gvfs-ls-regexp)))
(let ((item (list (cons "type" (match-string 3))
(cons "standard::size" (match-string 2))
(cons "name" (match-string 1)))))
@@ -1061,8 +1287,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::uid" attributes))
- (eval-when-compile
- (format "%s" tramp-unknown-id-integer))))
+ (eval-when-compile (format "%s" tramp-unknown-id-integer))))
(or (cdr (assoc "owner::user" attributes))
(cdr (assoc "unix::uid" attributes))
tramp-unknown-id-string)))
@@ -1070,8 +1295,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::gid" attributes))
- (eval-when-compile
- (format "%s" tramp-unknown-id-integer))))
+ (eval-when-compile (format "%s" tramp-unknown-id-integer))))
(or (cdr (assoc "owner::group" attributes))
(cdr (assoc "unix::gid" attributes))
tramp-unknown-id-string)))
@@ -1251,11 +1475,11 @@ If FILE-SYSTEM is non-nil, return file system attributes."
;; File names are returned as URL paths. We must convert them.
(when (string-match ddu file)
(setq file (replace-match dd nil nil file)))
- (while (string-match-p "%\\([0-9A-F]\\{2\\}\\)" file)
+ (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" file)
(setq file (url-unhex-string file)))
(when (string-match ddu (or file1 ""))
(setq file1 (replace-match dd nil nil file1)))
- (while (string-match-p "%\\([0-9A-F]\\{2\\}\\)" (or file1 ""))
+ (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" (or file1 ""))
(setq file1 (url-unhex-string file1)))
;; Remove watch when file or directory to be watched is deleted.
(when (and (member action '(moved deleted))
@@ -1288,7 +1512,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
;; If the user is different from what we guess to be
;; the user, we don't know. Let's check, whether
;; access is restricted explicitly.
- (and (/= (tramp-gvfs-get-remote-uid v 'integer)
+ (and (/= (tramp-get-remote-uid v 'integer)
(tramp-compat-file-attribute-user-id
(file-attributes filename 'integer)))
(not
@@ -1338,8 +1562,8 @@ If FILE-SYSTEM is non-nil, return file system attributes."
"Like `rename-file' for Tramp files."
;; Check if both files are local -- invoke normal rename-file.
;; Otherwise, use Tramp from local system.
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -1349,78 +1573,110 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(tramp-run-real-handler
#'rename-file (list filename newname ok-if-already-exists))))
-(defun tramp-gvfs-handle-set-file-modes (filename mode &optional _flag)
+(defun tramp-gvfs-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(tramp-gvfs-send-command
- v "gvfs-set-attribute" "-t" "uint32"
- (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v))
- "unix::mode" (number-to-string mode))))
+ v "gvfs-set-attribute" (if (eq flag 'nofollow) "-nt" "-t") "uint32"
+ (tramp-gvfs-url-file-name filename) "unix::mode" (number-to-string mode))))
-(defun tramp-gvfs-handle-set-file-times (filename &optional time _flag)
+(defun tramp-gvfs-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
- (let ((time
- (if (or (null time)
+ (tramp-gvfs-send-command
+ v "gvfs-set-attribute" (if (eq flag 'nofollow) "-nt" "-t") "uint64"
+ (tramp-gvfs-url-file-name filename) "time::modified"
+ (format-time-string
+ "%s" (if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
(tramp-compat-time-equal-p time tramp-time-dont-know))
(current-time)
- time)))
- (tramp-gvfs-send-command
- v "gvfs-set-attribute" "-t" "uint64"
- (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v))
- "time::modified" (format-time-string "%s" time)))))
+ time)))))
+
+(defun tramp-gvfs-handle-get-remote-uid (vec id-format)
+ "The uid of the remote connection VEC, in ID-FORMAT.
+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)))
+ (tramp-compat-file-attribute-user-id
+ (file-attributes
+ (tramp-make-tramp-file-name vec localname) id-format)))))
+
+(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)))
+ (tramp-compat-file-attribute-group-id
+ (file-attributes
+ (tramp-make-tramp-file-name vec localname) id-format))))
-(defun tramp-gvfs-set-file-uid-gid (filename &optional uid gid)
+(defun tramp-gvfs-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(when (natnump uid)
(tramp-gvfs-send-command
v "gvfs-set-attribute" "-t" "uint32"
- (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v))
- "unix::uid" (number-to-string uid)))
+ (tramp-gvfs-url-file-name filename) "unix::uid" (number-to-string uid)))
(when (natnump gid)
(tramp-gvfs-send-command
v "gvfs-set-attribute" "-t" "uint32"
- (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v))
+ (tramp-gvfs-url-file-name filename)
"unix::gid" (number-to-string gid)))))
;; File name conversions.
+(defun tramp-gvfs-activation-uri (filename)
+ "Return activation URI to be used in gio commands."
+ (if (tramp-tramp-file-p filename)
+ (with-parsed-tramp-file-name filename nil
+ ;; Ensure that media devices are cached.
+ (when (string-equal method "media")
+ (tramp-get-media-device v))
+ (with-tramp-connection-property v "activation-uri"
+ (setq localname "/")
+ (when (string-equal "gdrive" method)
+ (setq method "google-drive"))
+ (when (string-equal "nextcloud" method)
+ (setq method "davs"
+ localname
+ (concat (tramp-gvfs-get-remote-prefix v) localname)))
+ (when (string-equal "media" method)
+ (when-let
+ ((media (tramp-get-connection-property v "media-device" nil)))
+ (setq method (tramp-media-device-method media)
+ host (tramp-media-device-host media)
+ port (tramp-media-device-port media))))
+ (when (and user domain)
+ (setq user (concat domain ";" user)))
+ (url-recreate-url
+ (url-parse-make-urlobj
+ method (and user (url-hexify-string user))
+ nil (and host (url-hexify-string host))
+ (if (stringp port) (string-to-number port) port)
+ localname nil nil t))))
+ ;; Local URI.
+ (url-recreate-url
+ (url-parse-make-urlobj "file" nil nil nil nil nil nil nil t))))
+
(defun tramp-gvfs-url-file-name (filename)
"Return FILENAME in URL syntax."
- ;; "/" must NOT be hexified.
(setq filename (tramp-compat-file-name-unquote filename))
- (let ((url-unreserved-chars (cons ?/ url-unreserved-chars))
- result)
- (setq
- result
- (url-recreate-url
- (if (tramp-tramp-file-p filename)
- (with-parsed-tramp-file-name filename nil
- (when (string-equal "gdrive" method)
- (setq method "google-drive"))
- (when (string-equal "nextcloud" method)
- (setq method "davs"
- localname
- (concat (tramp-gvfs-get-remote-prefix v) localname)))
- (when (and user domain)
- (setq user (concat domain ";" user)))
- (url-parse-make-urlobj
- method (and user (url-hexify-string user))
- nil (and host (url-hexify-string host))
- (if (stringp port) (string-to-number port) port)
- (and localname (url-hexify-string localname)) nil nil t))
- (url-parse-make-urlobj
- "file" nil nil nil nil
- (url-hexify-string (file-truename filename)) nil nil t))))
+ (let* (;; "/" must NOT be hexified.
+ (url-unreserved-chars (cons ?/ url-unreserved-chars))
+ (result
+ (concat (substring (tramp-gvfs-activation-uri filename) 0 -1)
+ (url-hexify-string (tramp-file-local-name filename)))))
(when (tramp-tramp-file-p filename)
- (with-parsed-tramp-file-name filename nil
- (tramp-message v 10 "remote file `%s' is URL `%s'" filename result)))
+ (tramp-message
+ (tramp-dissect-file-name filename) 10
+ "remote file `%s' is URL `%s'" filename result))
result))
(defun tramp-gvfs-object-path (filename)
@@ -1432,6 +1688,14 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(dbus-unescape-from-identifier
(replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path)))
+(defun tramp-gvfs-url-host (url)
+ "Return the host name part of URL, a string.
+We cannot use `url-host', because `url-generic-parse-url' returns
+a downcased host name only."
+ (and (stringp url)
+ (string-match "^[[:alnum:]]+://\\([^/:]+\\)" url)
+ (match-string 1 url)))
+
;; D-Bus GVFS functions.
@@ -1498,8 +1762,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(list
t ;; handled.
nil ;; no abort of D-Bus.
- (with-tramp-connection-property
- (tramp-get-connection-process v) message
+ (with-tramp-connection-property (tramp-get-process v) message
;; In theory, there can be several choices.
;; Until now, there is only the question whether
;; to accept an unknown host signature or certificate.
@@ -1572,11 +1835,22 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(when (string-equal "google-drive" method)
(setq method "gdrive"))
(when (and (string-equal "http" method) (stringp uri))
- (setq uri (url-generic-parse-url uri)
+ (setq host (tramp-gvfs-url-host uri)
+ uri (url-generic-parse-url uri)
method (url-type uri)
user (url-user uri)
- host (url-host uri)
port (url-portspec uri)))
+ (when (member method tramp-media-methods)
+ ;; Ensure that media devices are cached.
+ (tramp-get-media-devices nil)
+ (let ((v (tramp-get-connection-property
+ (make-tramp-media-device
+ :method method :host host :port port)
+ "vector" nil)))
+ (when v
+ (setq method (tramp-file-name-method v)
+ host (tramp-file-name-host v)
+ port (tramp-file-name-port v)))))
(when (member method tramp-gvfs-methods)
(with-parsed-tramp-file-name
(tramp-make-tramp-file-name method user domain host port "") nil
@@ -1662,11 +1936,22 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(when (string-equal "google-drive" method)
(setq method "gdrive"))
(when (and (string-equal "http" method) (stringp uri))
- (setq uri (url-generic-parse-url uri)
+ (setq host (tramp-gvfs-url-host uri)
+ uri (url-generic-parse-url uri)
method (url-type uri)
user (url-user uri)
- host (url-host uri)
port (url-portspec uri)))
+ (when (member method tramp-media-methods)
+ ;; Ensure that media devices are cached.
+ (tramp-get-media-devices vec)
+ (let ((v (tramp-get-connection-property
+ (make-tramp-media-device
+ :method method :host host :port port)
+ "vector" nil)))
+ (when v
+ (setq method (tramp-file-name-method v)
+ host (tramp-file-name-host v)
+ port (tramp-file-name-port v)))))
(when (and
(string-equal method (tramp-file-name-method vec))
(string-equal user (tramp-file-name-user vec))
@@ -1691,8 +1976,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(tramp-gvfs-url-file-name (tramp-make-tramp-file-name vec))))
(while (tramp-gvfs-connection-mounted-p vec)
(read-event nil nil 0.1))
- (tramp-flush-connection-properties vec)
- (tramp-flush-connection-properties (tramp-get-connection-process vec)))
+ (tramp-cleanup-connection vec 'keep-debug 'keep-password))
(defun tramp-gvfs-mount-spec-entry (key value)
"Construct a mount-spec entry to be used in a mount_spec.
@@ -1704,11 +1988,16 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
(defun tramp-gvfs-mount-spec (vec)
"Return a mount-spec for \"org.gtk.vfs.MountTracker.mountLocation\"."
- (let* ((method (tramp-file-name-method vec))
+ (let* ((media (tramp-get-media-device vec))
+ (method (if media
+ (tramp-media-device-method media)
+ (tramp-file-name-method vec)))
(user (tramp-file-name-user vec))
(domain (tramp-file-name-domain vec))
- (host (tramp-file-name-host vec))
- (port (tramp-file-name-port vec))
+ (host (if media
+ (tramp-media-device-host media) (tramp-file-name-host vec)))
+ (port (if media
+ (tramp-media-device-port media) (tramp-file-name-port vec)))
(localname (tramp-file-name-unquote-localname vec))
(share (when (string-match "^/?\\([^/]+\\)" localname)
(match-string 1 localname)))
@@ -1759,42 +2048,41 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
;; Return.
`(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec)))
+(defun tramp-gvfs-handler-volumeadded-volumeremoved (_dbus-name _id volume)
+ "Signal handler for the \"org.gtk.Private.RemoteVolumeMonitor.VolumeAdded\" \
+and \"org.gtk.Private.RemoteVolumeMonitor.VolumeRemoved\" signals."
+ (ignore-errors
+ (let* ((signal-name (dbus-event-member-name last-input-event))
+ (uri (url-generic-parse-url (nth 5 volume)))
+ (method (url-type uri))
+ (vec (make-tramp-file-name
+ :method "media"
+ ;; A host name cannot contain spaces.
+ :host (replace-regexp-in-string " " "_" (nth 1 volume))))
+ (media (make-tramp-media-device
+ :method method
+ :host (tramp-gvfs-url-host (nth 5 volume))
+ :port (and (url-portspec uri)))))
+ (when (member method tramp-media-methods)
+ (tramp-message
+ vec 6 "%s %s" signal-name (tramp-gvfs-stringify-dbus-message volume))
+ (tramp-flush-connection-properties vec)
+ (tramp-flush-connection-properties media)
+ (tramp-get-media-devices nil)))))
+
+(when tramp-gvfs-enabled
+ (dbus-register-signal
+ :session nil tramp-gvfs-path-remotevolumemonitor
+ tramp-gvfs-interface-remotevolumemonitor "VolumeAdded"
+ #'tramp-gvfs-handler-volumeadded-volumeremoved)
+ (dbus-register-signal
+ :session nil tramp-gvfs-path-remotevolumemonitor
+ tramp-gvfs-interface-remotevolumemonitor "VolumeRemoved"
+ #'tramp-gvfs-handler-volumeadded-volumeremoved))
+
;; Connection functions.
-(defun tramp-gvfs-get-remote-uid (vec id-format)
- "The uid of the remote connection VEC, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "uid-%s" id-format)
- (let ((user (tramp-file-name-user vec))
- (localname
- (tramp-get-connection-property vec "default-location" nil)))
- (cond
- ((and (equal id-format 'string) user))
- (localname
- (tramp-compat-file-attribute-user-id
- (file-attributes
- (tramp-make-tramp-file-name vec localname) id-format)))
- ((equal id-format 'integer) tramp-unknown-id-integer)
- ((equal id-format 'string) tramp-unknown-id-string)))))
-
-(defun tramp-gvfs-get-remote-gid (vec id-format)
- "The gid of the remote connection VEC, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "gid-%s" id-format)
- (let ((localname
- (tramp-get-connection-property vec "default-location" nil)))
- (cond
- (localname
- (tramp-compat-file-attribute-group-id
- (file-attributes
- (tramp-make-tramp-file-name vec localname) id-format)))
- ((equal id-format 'integer) tramp-unknown-id-integer)
- ((equal id-format 'string) tramp-unknown-id-string)))))
-
-(defvar tramp-gvfs-get-remote-uid-gid-in-progress nil
- "Indication, that remote uid and gid determination is in progress.")
-
(defun tramp-gvfs-get-remote-prefix (vec)
"The prefix of the remote connection VEC.
This is relevant for GNOME Online Accounts."
@@ -1802,7 +2090,7 @@ This is relevant for GNOME Online Accounts."
;; Ensure that GNOME Online Accounts are cached.
(when (member (tramp-file-name-method vec) tramp-goa-methods)
(tramp-get-goa-accounts vec))
- (tramp-get-connection-property (tramp-make-goa-name vec) "prefix" "/")))
+ (tramp-get-connection-property (tramp-get-goa-account vec) "prefix" "/")))
(defun tramp-gvfs-maybe-open-connection (vec)
"Maybe open a connection VEC.
@@ -1851,7 +2139,7 @@ connection if a previous connection has died for some reason."
;; Ensure that GNOME Online Accounts are cached.
(tramp-get-goa-accounts vec)
(when (tramp-get-connection-property
- (tramp-make-goa-name vec) "FilesDisabled" t)
+ (tramp-get-goa-account vec) "FilesDisabled" t)
(tramp-user-error
vec "There is no Online Account `%s'"
(tramp-make-tramp-file-name vec 'noloc))))
@@ -1934,16 +2222,7 @@ connection if a previous connection has died for some reason."
;; 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.
- (unless tramp-gvfs-get-remote-uid-gid-in-progress
- (let ((tramp-gvfs-get-remote-uid-gid-in-progress t))
- (tramp-gvfs-get-remote-uid vec 'integer)
- (tramp-gvfs-get-remote-gid vec 'integer)
- (tramp-gvfs-get-remote-uid vec 'string)
- (tramp-gvfs-get-remote-gid vec 'string))))
+ (tramp-get-connection-process vec) "connected" t)))))
(defun tramp-gvfs-gio-tool-p (vec)
"Check, whether the gio tool is available."
@@ -1976,12 +2255,12 @@ is applied, and it returns t if the return code is zero."
(and (tramp-flush-file-properties vec "/") nil)))))
-;; D-Bus GNOME Online Accounts functions.
+;; GNOME Online Accounts functions.
-(defun tramp-make-goa-name (vec)
- "Transform VEC into a `tramp-goa-name' structure."
+(defun tramp-get-goa-account (vec)
+ "Transform VEC into a `tramp-goa-account' structure."
(when (tramp-file-name-p vec)
- (make-tramp-goa-name
+ (make-tramp-goa-account
:method (tramp-file-name-method vec)
:user (tramp-file-name-user vec)
:host (tramp-file-name-host vec)
@@ -1989,12 +2268,12 @@ is applied, and it returns t if the return code is zero."
(defun tramp-get-goa-accounts (vec)
"Retrieve GNOME Online Accounts, and cache them.
-The hash key is a `tramp-goa-name' structure. The value is an
+The hash key is a `tramp-goa-account' structure. The value is an
alist of the properties of `tramp-goa-interface-account' and
-`tramp-goa-interface-files' of the corresponding GNOME online
-account. Additionally, a property \"prefix\" is added.
+`tramp-goa-interface-files' of the corresponding GNOME Online
+Account. Additionally, a property \"prefix\" is added.
VEC is used only for traces."
- (with-tramp-connection-property (tramp-make-goa-name vec) "goa-accounts"
+ (with-tramp-connection-property nil "goa-accounts"
(dolist
(object-path
(mapcar
@@ -2020,15 +2299,15 @@ VEC is used only for traces."
(cdr (assoc "ProviderType" account-properties))
'("google" "owncloud"))
(string-match tramp-goa-identity-regexp identity))
- (setq key (make-tramp-goa-name
+ (setq key (make-tramp-goa-account
:method (cdr (assoc "ProviderType" account-properties))
:user (match-string 1 identity)
:host (match-string 2 identity)
:port (match-string 3 identity)))
- (when (string-equal (tramp-goa-name-method key) "google")
- (setf (tramp-goa-name-method key) "gdrive"))
- (when (string-equal (tramp-goa-name-method key) "owncloud")
- (setf (tramp-goa-name-method key) "nextcloud"))
+ (when (string-equal (tramp-goa-account-method key) "google")
+ (setf (tramp-goa-account-method key) "gdrive"))
+ (when (string-equal (tramp-goa-account-method key) "owncloud")
+ (setf (tramp-goa-account-method key) "nextcloud"))
;; Cache all properties.
(dolist (prop (nconc account-properties files-properties))
(tramp-set-connection-property key (car prop) (cdr prop)))
@@ -2044,6 +2323,80 @@ VEC is used only for traces."
;; Mark, that goa accounts have been cached.
"cached"))
+(defun tramp-parse-goa-accounts (service)
+ "Return a list of (user host) tuples allowed to access.
+It checks for registered GNOME Online Accounts."
+ ;; SERVICE might be encoded as a DNS-SD service.
+ (and (string-match tramp-dns-sd-service-regexp service)
+ (setq service (match-string 1 service)))
+ (mapcar
+ (lambda (key)
+ (and (tramp-goa-account-p key)
+ (string-equal service (tramp-goa-account-method key))
+ (list (tramp-goa-account-user key)
+ (tramp-goa-account-host key))))
+ (hash-table-keys tramp-cache-data)))
+
+
+;; Media devices functions.
+
+(defun tramp-get-media-device (vec)
+ "Transform VEC into a `tramp-media-device' structure.
+Check, that respective cache values do exist."
+ (if-let ((media (tramp-get-connection-property vec "media-device" nil))
+ (prop (tramp-get-connection-property media "vector" nil)))
+ media
+ (tramp-get-media-devices vec)
+ (tramp-get-connection-property vec "media-device" nil)))
+
+(defun tramp-get-media-devices (vec)
+ "Retrieve media devices, and cache them.
+The hash key is a `tramp-media-device' structure.
+VEC is used only for traces."
+ (let (devices)
+ (dolist (method tramp-media-methods)
+ (dolist (volume (cadr (with-tramp-dbus-call-method vec t
+ :session (tramp-gvfs-service-volumemonitor method)
+ tramp-gvfs-path-remotevolumemonitor
+ tramp-gvfs-interface-remotevolumemonitor "List")))
+ (let* ((uri (url-generic-parse-url (nth 5 volume)))
+ (vec (make-tramp-file-name
+ :method "media"
+ ;; A host name cannot contain spaces.
+ :host (replace-regexp-in-string " " "_" (nth 1 volume))))
+ (media (make-tramp-media-device
+ :method method
+ :host (tramp-gvfs-url-host (nth 5 volume))
+ :port (and (url-portspec uri)
+ (number-to-string (url-portspec uri))))))
+ (push (tramp-file-name-host vec) devices)
+ (tramp-set-connection-property vec "activation-uri" (nth 5 volume))
+ (tramp-set-connection-property vec "media-device" media)
+ (tramp-set-connection-property media "vector" vec))))
+
+ ;; Adapt default host name, supporting /media:: when possible.
+ (setq tramp-default-host-alist
+ (append
+ `(("media" nil ,(if (= (length devices) 1) (car devices) "")))
+ (delete
+ (assoc "media" tramp-default-host-alist)
+ tramp-default-host-alist)))))
+
+(defun tramp-parse-media-names (service)
+ "Return a list of (user host) tuples allowed to access.
+It checks for mounted media devices."
+ ;; SERVICE might be encoded as a DNS-SD service.
+ (and (string-match tramp-dns-sd-service-regexp service)
+ (setq service (match-string 1 service)))
+ (mapcar
+ (lambda (key)
+ (and (tramp-media-device-p key)
+ (string-equal service (tramp-media-device-method key))
+ (tramp-get-connection-property key "vector" nil)
+ (list nil (tramp-file-name-host
+ (tramp-get-connection-property key "vector" nil)))))
+ (hash-table-keys tramp-cache-data)))
+
;; D-Bus zeroconf functions.
@@ -2088,39 +2441,62 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
(list user host)))
result))))
-;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods.
(when tramp-gvfs-enabled
- ;; Suppress D-Bus error messages.
- (let (tramp-gvfs-dbus-event-vector)
+ ;; Suppress D-Bus error messages and Tramp traces.
+ (let ((tramp-verbose 0)
+ tramp-gvfs-dbus-event-vector fun)
+ ;; Add completion functions for services announced by DNS-SD.
+ ;; See <http://www.dns-sd.org/ServiceTypes.html> for valid service types.
(zeroconf-init tramp-gvfs-zeroconf-domain)
- (if (zeroconf-list-service-types)
- (progn
- (tramp-set-completion-function
- "afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp")))
- (tramp-set-completion-function
- "dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
- (tramp-set-completion-function
- "davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
- (tramp-set-completion-function
- "sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp")
- (tramp-zeroconf-parse-device-names "_workstation._tcp")))
- (when (member "smb" tramp-gvfs-methods)
- (tramp-set-completion-function
- "smb" '((tramp-zeroconf-parse-device-names "_smb._tcp")))))
-
- (when (executable-find "avahi-browse")
+ (when (setq fun (or (and (zeroconf-list-service-types)
+ #'tramp-zeroconf-parse-device-names)
+ (and (executable-find "avahi-browse")
+ #'tramp-gvfs-parse-device-names)))
+ (when (member "afp" tramp-gvfs-methods)
+ (tramp-set-completion-function
+ "afp" `((,fun "_afpovertcp._tcp"))))
+ (when (member "dav" tramp-gvfs-methods)
+ (tramp-set-completion-function
+ "dav" `((,fun "_webdav._tcp")
+ (,fun "_webdavs._tcp"))))
+ (when (member "davs" tramp-gvfs-methods)
+ (tramp-set-completion-function
+ "davs" `((,fun "_webdav._tcp")
+ (,fun "_webdavs._tcp"))))
+ (when (member "ftp" tramp-gvfs-methods)
(tramp-set-completion-function
- "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp")))
+ "ftp" `((,fun "_ftp._tcp"))))
+ (when (member "http" tramp-gvfs-methods)
(tramp-set-completion-function
- "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
+ "http" `((,fun "_http._tcp")
+ (,fun "_https._tcp"))))
+ (when (member "https" tramp-gvfs-methods)
(tramp-set-completion-function
- "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
+ "https" `((,fun "_http._tcp")
+ (,fun "_https._tcp"))))
+ (when (member "sftp" tramp-gvfs-methods)
(tramp-set-completion-function
- "sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp")
- (tramp-gvfs-parse-device-names "_workstation._tcp")))
- (when (member "smb" tramp-gvfs-methods)
- (tramp-set-completion-function
- "smb" '((tramp-gvfs-parse-device-names "_smb._tcp"))))))))
+ "sftp" `((,fun "_sftp-ssh._tcp")
+ (,fun "_ssh._tcp")
+ (,fun "_workstation._tcp"))))
+ (when (member "smb" tramp-gvfs-methods)
+ (tramp-set-completion-function
+ "smb" `((,fun "_smb._tcp")))))
+
+ ;; Add completion functions for GNOME Online Accounts.
+ (tramp-get-goa-accounts nil)
+ (dolist (method tramp-goa-methods)
+ (when (member method tramp-gvfs-methods)
+ (tramp-set-completion-function
+ method `((tramp-parse-goa-accounts ,(format "_%s._tcp" method))))))
+
+ ;; Add completion functions for media devices.
+ (tramp-get-media-devices nil)
+ (tramp-set-completion-function
+ "media"
+ (mapcar
+ (lambda (method) `(tramp-parse-media-names ,(format "_%s._tcp" method)))
+ tramp-media-methods))))
(add-hook 'tramp-unload-hook
(lambda ()
@@ -2133,7 +2509,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
;; * (Customizable) unmount when exiting Emacs. See tramp-archive.el.
;;
;; * Host name completion for existing mount points (afp-server,
-;; smb-server, google-drive, nextcloud) or via smb-network or network.
+;; smb-server) or via smb-network or network.
;;
;; * Check, how two shares of the same SMB server can be mounted in
;; parallel.
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index fcbd2010a26..3701bfc22c9 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -135,6 +135,8 @@
(start-file-process . ignore)
(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)
(vc-registered . ignore)
@@ -157,10 +159,9 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
"Invoke the rclone handler for OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
- (let ((fn (assoc operation tramp-rclone-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
+ (if-let ((fn (assoc operation tramp-rclone-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
;;;###tramp-autoload
(tramp--with-startup
@@ -220,7 +221,7 @@ file names."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(if (or (and t1 (not (tramp-rclone-file-name-p filename)))
@@ -271,8 +272,8 @@ file names."
(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))
- (setq newname (expand-file-name newname))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -429,8 +430,8 @@ file names."
(defun tramp-rclone-handle-rename-file
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -458,7 +459,7 @@ file names."
;; to cache a nil result.
(or (tramp-get-connection-property
(tramp-get-connection-process vec) "mounted" nil)
- (let* ((default-directory temporary-file-directory)
+ (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)
@@ -484,7 +485,8 @@ file names."
;; crash Emacs for some processes. So we use
;; "pidof", which might not work everywhere.
(if (<= emacs-major-version 25)
- (let ((default-directory temporary-file-directory))
+ (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
(mapcar
#'string-to-number
(split-string
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 7adfb49a858..15eab0a4de5 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -91,10 +91,10 @@ the default storage location, e.g. \"$HOME/.sh_history\"."
(string :tag "Redirect to a file")))
;;;###tramp-autoload
-(defconst tramp-display-escape-sequence-regexp "\e[[;0-9]+m"
+(defconst tramp-display-escape-sequence-regexp "\e[[:digit:];[]+m"
"Terminal control escape sequences for display attributes.")
-(defconst tramp-device-escape-sequence-regexp "\e[[0-9]+n"
+(defconst tramp-device-escape-sequence-regexp "\e[[:digit:][]+n"
"Terminal control escape sequences for device status.")
;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for
@@ -118,7 +118,9 @@ detected as prompt when being sent on echoing hosts, therefore.")
;;;###tramp-autoload
(defcustom tramp-use-ssh-controlmaster-options t
- "Whether to use `tramp-ssh-controlmaster-options'."
+ "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"
:type 'boolean)
@@ -482,6 +484,7 @@ The string is used in `tramp-methods'.")
;; 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"
@@ -492,8 +495,8 @@ The string is used in `tramp-methods'.")
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.
+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
@@ -1039,6 +1042,8 @@ of command line.")
(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 . tramp-sh-handle-get-remote-gid)
+ (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)
(vc-registered . tramp-sh-handle-vc-registered)
@@ -1116,8 +1121,7 @@ component is used as the target of the symlink."
"Like `file-truename' for Tramp files."
;; Preserve trailing "/".
(funcall
- (if (tramp-compat-directory-name-p filename)
- #'file-name-as-directory #'identity)
+ (if (directory-name-p filename) #'file-name-as-directory #'identity)
;; Quote properly.
(funcall
(if (tramp-compat-file-name-quoted-p filename)
@@ -1154,59 +1158,9 @@ component is used as the target of the symlink."
(tramp-shell-quote-argument localname)))))
;; Do it yourself.
- (t (let ((steps (split-string localname "/" 'omit))
- (thisstep nil)
- (numchase 0)
- ;; Don't make the following value larger than
- ;; necessary. People expect an error message in a
- ;; timely fashion when something is wrong;
- ;; otherwise they might think that Emacs is hung.
- ;; Of course, correctness has to come first.
- (numchase-limit 20)
- symlink-target)
- (while (and steps (< numchase numchase-limit))
- (setq thisstep (pop steps))
- (tramp-message
- v 5 "Check %s"
- (string-join
- (append '("") (reverse result) (list thisstep)) "/"))
- (setq symlink-target
- (tramp-compat-file-attribute-type
- (file-attributes
- (tramp-make-tramp-file-name
- v
- (string-join
- (append
- '("") (reverse result) (list thisstep)) "/")
- 'nohop))))
- (cond ((string= "." thisstep)
- (tramp-message v 5 "Ignoring step `.'"))
- ((string= ".." thisstep)
- (tramp-message v 5 "Processing step `..'")
- (pop result))
- ((stringp symlink-target)
- ;; It's a symlink, follow it.
- (tramp-message
- v 5 "Follow symlink to %s" symlink-target)
- (setq numchase (1+ numchase))
- (when (file-name-absolute-p symlink-target)
- (setq result nil))
- (setq steps
- (append
- (split-string symlink-target "/" 'omit)
- steps)))
- (t
- ;; It's a file.
- (setq result (cons thisstep result)))))
- (when (>= numchase numchase-limit)
- (tramp-error
- v 'file-error
- "Maximum number (%d) of symlinks exceeded" numchase-limit))
- (setq result (reverse result))
- ;; Combine list to form string.
- (setq result
- (if result (string-join (cons "" result) "/") "/"))
- (when (string-empty-p result) (setq result "/")))))
+ (t (setq
+ result
+ (tramp-file-local-name (tramp-handle-file-truename filename)))))
;; Detect cycle.
(when (and (file-symlink-p filename)
@@ -1378,13 +1332,12 @@ component is used as the target of the symlink."
(tramp-send-command-and-read
vec
(format
- (eval-when-compile
- (concat
- ;; Apostrophes in the stat output are masked as
- ;; `tramp-stat-marker', in order to make a proper shell escape
- ;; of them in file names.
- "(%s -c '((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' %s |"
- " sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g')"))
+ (concat
+ ;; Apostrophes in the stat output are masked as
+ ;; `tramp-stat-marker', in order to make a proper shell escape of
+ ;; them in file names.
+ "(%s -c '((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' %s |"
+ " sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g')")
(tramp-get-remote-stat vec)
tramp-stat-marker tramp-stat-marker
(if (eq id-format 'integer)
@@ -1474,17 +1427,24 @@ of."
;; only if that agrees with the buffer's record.
(t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist)))))))))
-(defun tramp-sh-handle-set-file-modes (filename mode &optional _flag)
+(defun tramp-sh-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
- ;; FIXME: extract the proper text from chmod's stderr.
- (tramp-barf-unless-okay
- v
- (format "chmod %o %s" mode (tramp-shell-quote-argument localname))
- "Error while changing file's mode %s" filename)))
+ ;; We need "chmod -h" when the flag is set.
+ (when (or (not (eq flag 'nofollow))
+ (not (file-symlink-p filename))
+ (tramp-get-remote-chmod-h v))
+ (tramp-flush-file-properties v localname)
+ ;; FIXME: extract the proper text from chmod's stderr.
+ (tramp-barf-unless-okay
+ v
+ (format
+ "chmod %s %o %s"
+ (if (and (eq flag 'nofollow) (tramp-get-remote-chmod-h v)) "-h" "")
+ mode (tramp-shell-quote-argument localname))
+ "Error while changing file's mode %s" filename))))
-(defun tramp-sh-handle-set-file-times (filename &optional time _flag)
+(defun tramp-sh-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(when (tramp-get-remote-touch v)
@@ -1497,13 +1457,34 @@ of."
time)))
(tramp-send-command-and-check
v (format
- "env TZ=UTC %s %s %s"
+ "env TZ=UTC %s %s %s %s"
(tramp-get-remote-touch v)
(if (tramp-get-connection-property v "touch-t" nil)
(format "-t %s" (format-time-string "%Y%m%d%H%M.%S" time t))
"")
+ (if (eq flag 'nofollow) "-h" "")
(tramp-shell-quote-argument localname)))))))
+(defun tramp-sh-handle-get-remote-uid (vec id-format)
+ "The uid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (ignore-errors
+ (cond
+ ((tramp-get-remote-id vec) (tramp-get-remote-uid-with-id vec id-format))
+ ((tramp-get-remote-perl vec) (tramp-get-remote-uid-with-perl vec id-format))
+ ((tramp-get-remote-python vec)
+ (tramp-get-remote-uid-with-python vec id-format)))))
+
+(defun tramp-sh-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'."
+ (ignore-errors
+ (cond
+ ((tramp-get-remote-id vec) (tramp-get-remote-gid-with-id vec id-format))
+ ((tramp-get-remote-perl vec) (tramp-get-remote-gid-with-perl vec id-format))
+ ((tramp-get-remote-python vec)
+ (tramp-get-remote-gid-with-python vec id-format)))))
+
(defun tramp-sh-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
;; Modern Unices allow chown only for root. So we might need
@@ -1527,7 +1508,7 @@ of."
(defun tramp-remote-selinux-p (vec)
"Check, whether SELINUX is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec) "selinux-p"
+ (with-tramp-connection-property (tramp-get-process vec) "selinux-p"
(tramp-send-command-and-check vec "selinuxenabled")))
(defun tramp-sh-handle-file-selinux-context (filename)
@@ -1535,9 +1516,8 @@ of."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-selinux-context"
(let ((context '(nil nil nil nil))
- (regexp (eval-when-compile
- (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):"
- "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)"))))
+ (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):"
+ "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)")))
(when (and (tramp-remote-selinux-p v)
(tramp-send-command-and-check
v (format
@@ -1576,7 +1556,7 @@ of."
(defun tramp-remote-acl-p (vec)
"Check, whether ACL is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p"
+ (with-tramp-connection-property (tramp-get-process vec) "acl-p"
(tramp-send-command-and-check vec "getfacl /")))
(defun tramp-sh-handle-file-acl (filename)
@@ -1706,8 +1686,10 @@ of."
(defun tramp-sh-handle-file-ownership-preserved-p (filename &optional group)
"Like `file-ownership-preserved-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-ownership-preserved-p"
- (let ((attributes (file-attributes filename)))
+ (with-tramp-file-property
+ v localname
+ (format "file-ownership-preserved-p%s" (if group "-group" ""))
+ (let ((attributes (file-attributes filename 'integer)))
;; Return t if the file doesn't exist, since it's true that no
;; information would be lost by an (attempted) delete and create.
(or (null attributes)
@@ -1785,21 +1767,19 @@ of."
(tramp-send-command-and-read
vec
(format
- (eval-when-compile
- (concat
- ;; We must care about file names with spaces, or starting with
- ;; "-"; this would confuse xargs. "ls -aQ" might be a
- ;; solution, but it does not work on all remote systems.
- ;; Therefore, we use \000 as file separator.
- ;; `tramp-sh--quoting-style-options' do not work for file names
- ;; with spaces piped to "xargs".
- ;; Apostrophes in the stat output are masked as
- ;; `tramp-stat-marker', in order to make a proper shell escape
- ;; of them in file names.
- "cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | "
- "xargs -0 %s -c "
- "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
- "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\""))
+ (concat
+ ;; We must care about file names with spaces, or starting with
+ ;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
+ ;; but it does not work on all remote systems. Therefore, we use
+ ;; \000 as file separator. `tramp-sh--quoting-style-options' do
+ ;; not work for file names with spaces piped to "xargs".
+ ;; Apostrophes in the stat output are masked as
+ ;; `tramp-stat-marker', in order to make a proper shell escape of
+ ;; them in file names.
+ "cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | "
+ "xargs -0 %s -c "
+ "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
+ "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
;; On systems which have no quoting style, file names with special
@@ -1840,13 +1820,12 @@ of."
(format "tramp_perl_file_name_all_completions %s"
(tramp-shell-quote-argument localname)))
- (format (eval-when-compile
- (concat
- "(cd %s 2>&1 && %s -a 2>/dev/null"
- " | while IFS= read f; do"
- " if %s -d \"$f\" 2>/dev/null;"
- " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
- " && \\echo ok) || \\echo fail"))
+ (format (concat
+ "(cd %s 2>&1 && %s -a 2>/dev/null"
+ " | while IFS= read f; do"
+ " if %s -d \"$f\" 2>/dev/null;"
+ " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
+ " && \\echo ok) || \\echo fail")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command v)
(tramp-get-test-command v))))
@@ -1954,7 +1933,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
;; scp or rsync DTRT.
(progn
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-already-exists newname))
(setq dirname (directory-file-name (expand-file-name dirname))
newname (directory-file-name (expand-file-name newname)))
@@ -1967,7 +1946,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
(unless (file-directory-p (file-name-directory newname))
(make-directory (file-name-directory newname) parents))
(tramp-do-copy-or-rename-file-out-of-band
- 'copy dirname newname keep-date))
+ 'copy dirname newname 'ok-if-already-exists keep-date))
;; We must do it file-wise.
(tramp-run-real-handler
@@ -1984,8 +1963,8 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
"Like `rename-file' for Tramp files."
;; Check if both files are local -- invoke normal rename-file.
;; Otherwise, use Tramp from local system.
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -2036,7 +2015,7 @@ file names."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
@@ -2063,7 +2042,7 @@ file names."
(tramp-method-out-of-band-p v1 length)
(tramp-method-out-of-band-p v2 length))
(tramp-do-copy-or-rename-file-out-of-band
- op filename newname keep-date))
+ op filename newname ok-if-already-exists keep-date))
;; No shortcut was possible. So we copy the file
;; first. If the operation was `rename', we go back
@@ -2076,7 +2055,7 @@ file names."
;; source and target file.
(t
(tramp-do-copy-or-rename-file-via-buffer
- op filename newname keep-date))))))
+ op filename newname ok-if-already-exists keep-date))))))
;; One file is a Tramp file, the other one is local.
((or t1 t2)
@@ -2091,11 +2070,11 @@ file names."
;; corresponding copy-program can be invoked.
((tramp-method-out-of-band-p v length)
(tramp-do-copy-or-rename-file-out-of-band
- op filename newname keep-date))
+ op filename newname ok-if-already-exists keep-date))
;; Use the inline method via a Tramp buffer.
(t (tramp-do-copy-or-rename-file-via-buffer
- op filename newname keep-date))))
+ op filename newname ok-if-already-exists keep-date))))
(t
;; One of them must be a Tramp file.
@@ -2117,7 +2096,8 @@ file names."
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname))))))))
-(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
+(defun tramp-do-copy-or-rename-file-via-buffer
+ (op filename newname ok-if-already-exists keep-date)
"Use an Emacs buffer to copy or rename a file.
First arg OP is either `copy' or `rename' and indicates the operation.
FILENAME is the source file, NEWNAME the target file.
@@ -2145,10 +2125,11 @@ KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
(insert-file-contents-literally filename)))
;; KEEP-DATE handling.
(when keep-date
- (set-file-times
+ (tramp-compat-set-file-times
newname
(tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
+ (file-attributes filename))
+ (unless ok-if-already-exists 'nofollow)))
;; Set the mode.
(set-file-modes newname (tramp-default-file-modes filename))
;; If the operation was `rename', delete the original file.
@@ -2302,10 +2283,12 @@ the uid and gid from FILENAME."
;; Set the time and mode. Mask possible errors.
(ignore-errors
(when keep-date
- (set-file-times newname file-times)
+ (tramp-compat-set-file-times
+ newname file-times (unless ok-if-already-exists 'nofollow))
(set-file-modes newname file-modes))))))
-(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
+(defun tramp-do-copy-or-rename-file-out-of-band
+ (op filename newname ok-if-already-exists keep-date)
"Invoke `scp' program to copy.
The method used must be an out-of-band method."
(let* ((t1 (tramp-tramp-file-p filename))
@@ -2328,9 +2311,9 @@ The method used must be an out-of-band method."
(unwind-protect
(progn
(tramp-do-copy-or-rename-file-out-of-band
- op filename tmpfile keep-date)
+ op filename tmpfile ok-if-already-exists keep-date)
(tramp-do-copy-or-rename-file-out-of-band
- 'rename tmpfile newname keep-date))
+ 'rename tmpfile newname ok-if-already-exists keep-date))
;; Save exit.
(ignore-errors
(if dir-flag
@@ -2504,10 +2487,11 @@ The method used must be an out-of-band method."
;; Handle KEEP-DATE argument.
(when (and keep-date (not copy-keep-date))
- (set-file-times
+ (tramp-compat-set-file-times
newname
(tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
+ (file-attributes filename))
+ (unless ok-if-already-exists 'nofollow)))
;; Set the mode.
(unless (and keep-date copy-keep-date)
@@ -2720,7 +2704,7 @@ The method used must be an out-of-band method."
(when (file-symlink-p filename)
(goto-char (search-backward "->" beg 'noerror)))
(search-backward
- (if (tramp-compat-directory-name-p filename)
+ (if (directory-name-p filename)
"."
(file-name-nondirectory filename))
beg 'noerror)
@@ -2730,12 +2714,11 @@ The method used must be an out-of-band method."
(goto-char (point-min))
;; First find the line to put it on.
(when (re-search-forward "^\\([[:space:]]*total\\)" nil t)
- (let ((available (get-free-disk-space ".")))
- (when available
- ;; Replace "total" with "total used", to avoid confusion.
- (replace-match "\\1 used in directory")
- (end-of-line)
- (insert " available " available))))
+ (when-let ((available (get-free-disk-space ".")))
+ ;; Replace "total" with "total used", to avoid confusion.
+ (replace-match "\\1 used in directory")
+ (end-of-line)
+ (insert " available " available)))
(goto-char (point-max)))))))
@@ -2806,223 +2789,232 @@ the result will be a local, non-Tramp, file name."
;; terminated.
(defun tramp-sh-handle-make-process (&rest args)
"Like `make-process' for Tramp files.
-STDERR can also be a file name."
- (when args
- (with-parsed-tramp-file-name (expand-file-name default-directory) nil
- (let ((name (plist-get args :name))
- (buffer (plist-get args :buffer))
- (command (plist-get args :command))
- (coding (plist-get args :coding))
- (noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
- (filter (plist-get args :filter))
- (sentinel (plist-get args :sentinel))
- (stderr (plist-get args :stderr)))
- (unless (stringp name)
- (signal 'wrong-type-argument (list #'stringp name)))
- (unless (or (null buffer) (bufferp buffer) (stringp buffer))
- (signal 'wrong-type-argument (list #'stringp buffer)))
- (unless (consp command)
- (signal 'wrong-type-argument (list #'consp command)))
- (unless (or (null coding)
- (and (symbolp coding) (memq coding coding-system-list))
- (and (consp coding)
- (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)))
- (signal 'wrong-type-argument (list #'symbolp connection-type)))
- (unless (or (null filter) (functionp filter))
- (signal 'wrong-type-argument (list #'functionp filter)))
- (unless (or (null sentinel) (functionp sentinel))
- (signal 'wrong-type-argument (list #'functionp sentinel)))
- (unless (or (null stderr) (bufferp stderr) (stringp stderr))
- (signal 'wrong-type-argument (list #'stringp stderr)))
- (when (and (stringp stderr) (tramp-tramp-file-p stderr)
- (not (tramp-equal-remote default-directory stderr)))
- (signal 'file-error (list "Wrong stderr" stderr)))
-
- (let* ((buffer
- (if buffer
- (get-buffer-create buffer)
- ;; BUFFER can be nil. We use a temporary buffer.
- (generate-new-buffer tramp-temp-buffer-name)))
- ;; 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))))
- (remote-tmpstderr
- (and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
- (program (car command))
- (args (cdr command))
- ;; When PROGRAM matches "*sh", and the first arg is
- ;; "-c", it might be that the arguments exceed the
- ;; command line length. Therefore, we modify the
- ;; command.
- (heredoc (and (stringp program)
- (string-match-p "sh$" program)
- (string-equal "-c" (car args))
- (= (length args) 2)))
- ;; When PROGRAM is nil, we just provide a tty.
- (args (if (not heredoc) args
- (let ((i 250))
- (while (and (< i (length (cadr args)))
- (string-match " " (cadr args) i))
- (setcdr
- args
- (list
- (replace-match " \\\\\n" nil nil (cadr args))))
- (setq i (+ i 250))))
- (cdr args)))
- ;; Use a human-friendly prompt, for example for
- ;; `shell'. We discard hops, if existing, that's why
- ;; we cannot use `file-remote-p'.
- (prompt (format "PS1=%s %s"
- (tramp-make-tramp-file-name v nil 'nohop)
- tramp-initial-end-of-output))
- ;; We use as environment the difference to toplevel
- ;; `process-environment'.
- env uenv
- (env (dolist (elt (cons prompt process-environment) env)
- (or (member
- elt (default-toplevel-value 'process-environment))
- (if (string-match-p "=" 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)))))))
- (command
- (when (stringp program)
- (format "cd %s && %s exec %s %s env %s %s"
- (tramp-shell-quote-argument localname)
- (if uenv
- (format
- "unset %s &&"
- (mapconcat
- #'tramp-shell-quote-argument uenv " "))
- "")
- (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "")
- (if tmpstderr (format "2>'%s'" tmpstderr) "")
- (mapconcat #'tramp-shell-quote-argument env " ")
- (if heredoc
- (format "%s\n(\n%s\n) </dev/tty\n%s"
- program (car args) tramp-end-of-heredoc)
- (mapconcat #'tramp-shell-quote-argument
- (cons program args) " ")))))
- (tramp-process-connection-type
- (or (null program) tramp-process-connection-type))
- (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
- (name1 name)
- (i 0)
- ;; We do not want to raise an error when `make-process'
- ;; has been started several times in `eshell' and
- ;; friends.
- tramp-current-connection
- p)
-
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- (setq name name1)
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
-
- (with-current-buffer (tramp-get-connection-buffer v)
- (unwind-protect
- ;; We catch this event. Otherwise, `make-process' could
- ;; be called on the local host.
- (save-excursion
- (save-restriction
- ;; Activate narrowing in order to save BUFFER
- ;; contents. Clear also the modification time;
- ;; otherwise we might be interrupted by
- ;; `verify-visited-file-modtime'.
- (let ((buffer-undo-list t)
- (inhibit-read-only t)
- (mark (point-max)))
- (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 $$")))
- (process-put p 'remote-pid pid)
- (tramp-set-connection-property p "remote-pid" pid))
- ;; `tramp-maybe-open-connection' and
- ;; `tramp-send-command-and-read' could have
- ;; trashed the connection buffer. Remove this.
- (widen)
- (delete-region mark (point-max))
+STDERR can also be a file name. If connection property
+\"direct-async-process\" is non-nil, an alternative
+implementation will be used."
+ (if (tramp-direct-async-process-p args)
+ (apply #'tramp-handle-make-process args)
+ (when args
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
+ (let ((name (plist-get args :name))
+ (buffer (plist-get args :buffer))
+ (command (plist-get args :command))
+ (coding (plist-get args :coding))
+ (noquery (plist-get args :noquery))
+ (connection-type (plist-get args :connection-type))
+ (filter (plist-get args :filter))
+ (sentinel (plist-get args :sentinel))
+ (stderr (plist-get args :stderr)))
+ (unless (stringp name)
+ (signal 'wrong-type-argument (list #'stringp name)))
+ (unless (or (null buffer) (bufferp buffer) (stringp buffer))
+ (signal 'wrong-type-argument (list #'stringp buffer)))
+ (unless (consp command)
+ (signal 'wrong-type-argument (list #'consp command)))
+ (unless (or (null coding)
+ (and (symbolp coding) (memq coding coding-system-list))
+ (and (consp coding)
+ (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)))
+ (signal 'wrong-type-argument (list #'symbolp connection-type)))
+ (unless (or (null filter) (functionp filter))
+ (signal 'wrong-type-argument (list #'functionp filter)))
+ (unless (or (null sentinel) (functionp sentinel))
+ (signal 'wrong-type-argument (list #'functionp sentinel)))
+ (unless (or (null stderr) (bufferp stderr) (stringp stderr))
+ (signal 'wrong-type-argument (list #'stringp stderr)))
+ (when (and (stringp stderr) (tramp-tramp-file-p stderr)
+ (not (tramp-equal-remote default-directory stderr)))
+ (signal 'file-error (list "Wrong stderr" stderr)))
+
+ (let* ((buffer
+ (if buffer
+ (get-buffer-create buffer)
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (generate-new-buffer tramp-temp-buffer-name)))
+ ;; 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))))
+ (remote-tmpstderr
+ (and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
+ (program (car command))
+ (args (cdr command))
+ ;; When PROGRAM matches "*sh", and the first arg is
+ ;; "-c", it might be that the arguments exceed the
+ ;; command line length. Therefore, we modify the
+ ;; command.
+ (heredoc (and (stringp program)
+ (string-match-p "sh$" program)
+ (string-equal "-c" (car args))
+ (= (length args) 2)))
+ ;; When PROGRAM is nil, we just provide a tty.
+ (args (if (not heredoc) args
+ (let ((i 250))
+ (while (and (< i (length (cadr args)))
+ (string-match " " (cadr args) i))
+ (setcdr
+ args
+ (list
+ (replace-match " \\\\\n" nil nil (cadr args))))
+ (setq i (+ i 250))))
+ (cdr args)))
+ ;; Use a human-friendly prompt, for example for
+ ;; `shell'. We discard hops, if existing, that's why
+ ;; we cannot use `file-remote-p'.
+ (prompt (format "PS1=%s %s"
+ (tramp-make-tramp-file-name v nil 'nohop)
+ tramp-initial-end-of-output))
+ ;; We use as environment the difference to toplevel
+ ;; `process-environment'.
+ env uenv
+ (env (dolist (elt (cons prompt process-environment) env)
+ (or (member
+ elt (default-toplevel-value 'process-environment))
+ (if (string-match-p "=" 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)))))))
+ (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
+ (format
+ "unset %s &&"
+ (mapconcat
+ #'tramp-shell-quote-argument uenv " "))
+ "")
+ (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "")
+ (if tmpstderr (format "2>'%s'" tmpstderr) "")
+ (mapconcat #'tramp-shell-quote-argument env " ")
+ (if heredoc
+ (format "%s\n(\n%s\n) </dev/tty\n%s"
+ program (car args) tramp-end-of-heredoc)
+ (mapconcat #'tramp-shell-quote-argument
+ (cons program args) " ")))))
+ (tramp-process-connection-type
+ (or (null program) tramp-process-connection-type))
+ (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
+ (name1 name)
+ (i 0)
+ ;; We do not want to raise an error when
+ ;; `make-process' has been started several times in
+ ;; `eshell' and friends.
+ tramp-current-connection
+ p)
+
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ (setq name name1)
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ ;; We catch this event. Otherwise, `make-process'
+ ;; could be called on the local host.
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save BUFFER
+ ;; contents. Clear also the modification time;
+ ;; otherwise we might be interrupted by
+ ;; `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (mark (point-max)))
+ (clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
- ;; Now do it.
- (if command
- ;; Send the command.
- (tramp-send-command v command nil t) ; nooutput
- ;; Check, whether a pty is associated.
- (unless (process-get p 'remote-tty)
- (tramp-error
- v 'file-error
- "pty association is not supported for `%s'"
- name))))
- ;; Set sentinel and filter.
- (when sentinel
- (set-process-sentinel p sentinel))
- (when filter
- (set-process-filter p filter))
- ;; Set query flag and process marker for this
- ;; process. We ignore errors, because the
- ;; process could have finished already.
- (ignore-errors
- (set-process-query-on-exit-flag p (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.
- (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))
- (delete-file remote-tmpstderr)))))
- ;; Return process.
- p)))
+ ;; 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 $$")))
+ (process-put p 'remote-pid pid)
+ (tramp-set-connection-property p "remote-pid" pid))
+ ;; `tramp-maybe-open-connection' and
+ ;; `tramp-send-command-and-read' could have
+ ;; trashed the connection buffer. Remove this.
+ (widen)
+ (delete-region mark (point-max))
+ (narrow-to-region (point-max) (point-max))
+ ;; Now do it.
+ (if command
+ ;; Send the command.
+ (tramp-send-command v command nil t) ; nooutput
+ ;; Check, whether a pty is associated.
+ (unless (process-get p 'remote-tty)
+ (tramp-error
+ v 'file-error
+ "pty association is not supported for `%s'"
+ name))))
+ ;; Set sentinel and filter.
+ (when sentinel
+ (set-process-sentinel p sentinel))
+ (when filter
+ (set-process-filter p filter))
+ ;; Set query flag and process marker for this
+ ;; process. We ignore errors, because the
+ ;; process could have finished already.
+ (ignore-errors
+ (set-process-query-on-exit-flag p (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.
+ (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))
+ (delete-file remote-tmpstderr)))))
+ ;; Return process.
+ p)))
- ;; Save exit.
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
- (ignore-errors
- (set-process-buffer p nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer"))))))))
+ ;; Save exit.
+ (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (ignore-errors
+ (set-process-buffer p nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp))
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")))))))))
(defun tramp-sh-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
@@ -3103,6 +3095,11 @@ STDERR can also be a file name."
(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)
(when env
(setq command
(format
@@ -3331,7 +3328,8 @@ STDERR can also be a file name."
#'write-region
(list start end localname append 'no-message lockname))
- (let* ((modes (save-excursion (tramp-default-file-modes filename)))
+ (let* ((modes (tramp-default-file-modes
+ filename (and (eq mustbenew 'excl) 'nofollow)))
;; We use this to save the value of
;; `last-coding-system-used' after writing the tmp
;; file. At the end of the function, we set
@@ -3450,9 +3448,8 @@ STDERR can also be a file name."
loc-enc tmpfile t))
(tramp-error
v 'file-error
- (eval-when-compile
- (concat "Cannot write to `%s', "
- "local encoding command `%s' failed"))
+ (concat "Cannot write to `%s', "
+ "local encoding command `%s' failed")
filename loc-enc))))
;; Send buffer into remote decoding command which
@@ -3497,9 +3494,8 @@ STDERR can also be a file name."
(buffer-string))))
(tramp-error
v 'file-error
- (eval-when-compile
- (concat "Couldn't write region to `%s',"
- " decode using `%s' failed"))
+ (concat "Couldn't write region to `%s',"
+ " decode using `%s' failed")
filename rem-dec)))))
;; Save exit.
@@ -3509,9 +3505,8 @@ STDERR can also be a file name."
(t
(tramp-error
v 'file-error
- (eval-when-compile
- (concat "Method `%s' should specify both encoding and "
- "decoding command or an scp program"))
+ (concat "Method `%s' should specify both encoding and "
+ "decoding command or an scp program")
method))))
;; Make `last-coding-system-used' have the right value.
@@ -3564,8 +3559,7 @@ STDERR can also be a file name."
(defun tramp-sh-handle-vc-registered (file)
"Like `vc-registered' for Tramp files."
(when vc-handled-backends
- (let ((tramp-message-show-message
- (and (not revert-buffer-in-progress-p) tramp-message-show-message))
+ (let ((inhibit-message (or revert-buffer-in-progress-p inhibit-message))
(temp-message (unless revert-buffer-in-progress-p "")))
(with-temp-message temp-message
(with-parsed-tramp-file-name file nil
@@ -3624,27 +3618,30 @@ STDERR can also be a file name."
;; calls shall be answered from the file cache. We unset
;; `process-file-side-effects' and `remote-file-name-inhibit-cache'
;; in order to keep the cache.
- (let ((vc-handled-backends vc-handled-backends)
+ (let ((vc-handled-backends (copy-sequence vc-handled-backends))
remote-file-name-inhibit-cache process-file-side-effects)
;; Reduce `vc-handled-backends' in order to minimize
;; process calls.
- (when (and (memq 'Bzr vc-handled-backends)
- (boundp 'vc-bzr-program)
+ (when (and
+ (memq 'Bzr vc-handled-backends)
+ (or (not (require 'vc-bzr nil 'noerror))
(not (with-tramp-connection-property v vc-bzr-program
(tramp-find-executable
- v vc-bzr-program (tramp-get-remote-path v)))))
+ v vc-bzr-program (tramp-get-remote-path v))))))
(setq vc-handled-backends (remq 'Bzr vc-handled-backends)))
- (when (and (memq 'Git vc-handled-backends)
- (boundp 'vc-git-program)
+ (when (and
+ (memq 'Git vc-handled-backends)
+ (or (not (require 'vc-git nil 'noerror))
(not (with-tramp-connection-property v vc-git-program
(tramp-find-executable
- v vc-git-program (tramp-get-remote-path v)))))
+ v vc-git-program (tramp-get-remote-path v))))))
(setq vc-handled-backends (remq 'Git vc-handled-backends)))
- (when (and (memq 'Hg vc-handled-backends)
- (boundp 'vc-hg-program)
+ (when (and
+ (memq 'Hg vc-handled-backends)
+ (or (not (require 'vc-hg nil 'noerror))
(not (with-tramp-connection-property v vc-hg-program
(tramp-find-executable
- v vc-hg-program (tramp-get-remote-path v)))))
+ v vc-hg-program (tramp-get-remote-path v))))))
(setq vc-handled-backends (remq 'Hg vc-handled-backends)))
;; Run.
(tramp-with-demoted-errors
@@ -3655,10 +3652,17 @@ STDERR can also be a file name."
(defun tramp-sh-file-name-handler (operation &rest args)
"Invoke remote-shell Tramp file name handler.
Fall back to normal file name handler if no Tramp handler exists."
- (let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
+ (if-let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
+
+;;;###tramp-autoload
+(defun tramp-sh-file-name-handler-p (vec)
+ "Whether VEC uses a method from `tramp-sh-file-name-handler'."
+ (and (assoc (tramp-file-name-method vec) tramp-methods)
+ (eq (tramp-find-foreign-file-name-handler
+ (tramp-make-tramp-file-name vec nil 'nohop))
+ 'tramp-sh-file-name-handler)))
;; This must be the last entry, because `identity' always matches.
;;;###tramp-autoload
@@ -3710,13 +3714,11 @@ Fall back to normal file name handler if no Tramp handler exists."
events
(cond
((and (memq 'change flags) (memq 'attribute-change flags))
- (eval-when-compile
- (concat "create,modify,move,moved_from,moved_to,move_self,"
- "delete,delete_self,attrib,ignored")))
+ (concat "create,modify,move,moved_from,moved_to,move_self,"
+ "delete,delete_self,attrib,ignored"))
((memq 'change flags)
- (eval-when-compile
- (concat "create,modify,move,moved_from,moved_to,move_self,"
- "delete,delete_self,ignored")))
+ (concat "create,modify,move,moved_from,moved_to,move_self,"
+ "delete,delete_self,ignored"))
((memq 'attribute-change flags) "attrib,ignored"))
sequence `(,command "-mq" "-e" ,events ,localname)
;; Make events a list of symbols.
@@ -3858,12 +3860,11 @@ Fall back to normal file name handler if no Tramp handler exists."
"ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
(while (string-match
- (eval-when-compile
- (concat "^[\n\r]*"
- "Directory Monitor Event:[\n\r]+"
- "Child = \\([^\n\r]+\\)[\n\r]+"
- "\\(Other = \\([^\n\r]+\\)[\n\r]+\\)?"
- "Event = \\([^[:blank:]]+\\)[\n\r]+"))
+ (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))
@@ -3899,10 +3900,9 @@ Fall back to normal file name handler if no Tramp handler exists."
(dolist (line (split-string string "[\n\r]+" 'omit))
;; Check, whether there is a problem.
(unless (string-match
- (eval-when-compile
- (concat "^[^[:blank:]]+"
- "[[:blank:]]+\\([^[:blank:]]+\\)"
- "\\([[:blank:]]+\\([^\n\r]+\\)\\)?"))
+ (concat "^[^[:blank:]]+"
+ "[[:blank:]]+\\([^[:blank:]]+\\)"
+ "\\([[:blank:]]+\\([^\n\r]+\\)\\)?")
line)
(tramp-error proc 'file-notify-error "%s" line))
@@ -3938,11 +3938,10 @@ Fall back to normal file name handler if no Tramp handler exists."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (eval-when-compile
- (concat "\\(?:^/[^[:space:]]*[[:space:]]\\)?"
- "[[:space:]]*\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)")))
+ (concat "\\(?:^/[^[:space:]]*[[:space:]]\\)?"
+ "[[:space:]]*\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"))
(mapcar
(lambda (d)
(* d (tramp-get-connection-property v "df-blocksize" 0)))
@@ -4011,13 +4010,16 @@ hosts, or files, disagree."
(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.")
+
(defun tramp-find-executable
(vec progname dirlist &optional ignore-tilde ignore-path)
"Search for PROGNAME in $PATH and all directories mentioned in DIRLIST.
First arg VEC specifies the connection, PROGNAME is the program
to search for, and DIRLIST gives the list of directories to
search. If IGNORE-TILDE is non-nil, directory names starting
-with `~' will be ignored. If IGNORE-PATH is non-nil, searches
+with \"~\" will be ignored. If IGNORE-PATH is non-nil, searches
only in DIRLIST.
Returns the absolute file name of PROGNAME, if found, and nil otherwise.
@@ -4032,7 +4034,7 @@ This function expects to be in the right *tramp* buffer."
;; therefore.
(unless (or ignore-path
(string-match-p
- (eval-when-compile (regexp-opt '("SunOS 5.10" "SunOS 5.11")))
+ tramp-sunos-unames
(tramp-get-connection-property vec "uname" "")))
(tramp-send-command vec (format "which \\%s | wc -w" progname))
(goto-char (point-min))
@@ -4043,19 +4045,18 @@ This function expects to be in the right *tramp* buffer."
;; Remove all ~/foo directories from dirlist.
(let (newdl d)
(while dirlist
- (setq d (car dirlist))
- (setq dirlist (cdr dirlist))
+ (setq d (car dirlist)
+ dirlist (cdr dirlist))
(unless (char-equal ?~ (aref d 0))
(setq newdl (cons d newdl))))
(setq dirlist (nreverse newdl))))
(tramp-send-command
vec
- (format (eval-when-compile
- (concat "while read d; "
- "do if test -x $d/%s && test -f $d/%s; "
- "then echo tramp_executable $d/%s; "
- "break; fi; done <<'%s'\n"
- "%s\n%s"))
+ (format (concat "while read d; "
+ "do if test -x $d/%s && test -f $d/%s; "
+ "then echo tramp_executable $d/%s; "
+ "break; fi; done <<'%s'\n"
+ "%s\n%s")
progname progname progname
tramp-end-of-heredoc
(string-join dirlist "\n")
@@ -4096,7 +4097,7 @@ variable PATH."
chunk (substring command 0 chunksize)
command (substring command chunksize))
(tramp-send-command vec (format
- "echo -n %s >>%s"
+ "printf \"%%b\" \"$*\" %s >>%s"
(tramp-shell-quote-argument chunk)
(tramp-shell-quote-argument tmpfile))))
(tramp-send-command vec (format ". %s" tmpfile))
@@ -4193,12 +4194,11 @@ file exists and nonzero exit status otherwise."
;; our initial probes to ensure the remote shell is usable.)
(tramp-send-command
vec (format
- (eval-when-compile
- (concat
- "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' "
- "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s"))
+ (concat
+ "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' "
+ "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s")
tramp-terminal-type
- emacs-version tramp-version ; INSIDE_EMACS
+ (or (getenv "INSIDE_EMACS") emacs-version) tramp-version
(or (getenv-internal "ENV" tramp-remote-process-environment) "")
(if (stringp tramp-histfile-override)
(format "HISTFILE=%s"
@@ -4226,45 +4226,45 @@ file exists and nonzero exit status otherwise."
(defun tramp-find-shell (vec)
"Open a shell on the remote host which groks tilde expansion."
- (with-current-buffer (tramp-get-buffer vec)
- (let ((default-shell (tramp-get-method-parameter vec 'tramp-remote-shell))
- shell)
- (setq shell
- (with-tramp-connection-property vec "remote-shell"
- ;; CCC: "root" does not exist always, see my QNAP TS-459.
- ;; Which check could we apply instead?
- (tramp-send-command vec "echo ~root" t)
- (if (or (string-match-p "^~root$" (buffer-string))
- ;; The default shell (ksh93) of OpenSolaris and
- ;; Solaris is buggy. We've got reports for
- ;; "SunOS 5.10" and "SunOS 5.11" so far.
- (string-match-p
- (eval-when-compile
- (regexp-opt '("SunOS 5.10" "SunOS 5.11")))
- (tramp-get-connection-property vec "uname" "")))
-
- (or (tramp-find-executable
- vec "bash" (tramp-get-remote-path vec) t t)
- (tramp-find-executable
- vec "ksh" (tramp-get-remote-path vec) t t)
- ;; Maybe it works at least for some other commands.
- (prog1
- default-shell
- (tramp-message
- vec 2
- (eval-when-compile
+ ;; If we are in `make-process', we don't need another shell.
+ (unless (tramp-get-connection-property vec "process-name" nil)
+ (with-current-buffer (tramp-get-buffer vec)
+ (let ((default-shell (tramp-get-method-parameter vec 'tramp-remote-shell))
+ shell)
+ (setq shell
+ (with-tramp-connection-property vec "remote-shell"
+ ;; CCC: "root" does not exist always, see my QNAP
+ ;; TS-459. Which check could we apply instead?
+ (tramp-send-command vec "echo ~root" t)
+ (if (or (string-match-p "^~root$" (buffer-string))
+ ;; The default shell (ksh93) of OpenSolaris
+ ;; and Solaris is buggy. We've got reports
+ ;; for "SunOS 5.10" and "SunOS 5.11" so far.
+ (string-match-p
+ tramp-sunos-unames
+ (tramp-get-connection-property vec "uname" "")))
+
+ (or (tramp-find-executable
+ vec "bash" (tramp-get-remote-path vec) t t)
+ (tramp-find-executable
+ vec "ksh" (tramp-get-remote-path vec) t t)
+ ;; Maybe it works at least for some other commands.
+ (prog1
+ default-shell
+ (tramp-message
+ vec 2
(concat
"Couldn't find a remote shell which groks tilde "
- "expansion, using `%s'"))
- default-shell)))
+ "expansion, using `%s'")
+ default-shell)))
- default-shell)))
+ default-shell)))
- ;; Open a new shell if needed.
- (unless (string-equal shell default-shell)
- (tramp-message
- vec 5 "Starting remote shell `%s' for tilde expansion" shell)
- (tramp-open-shell vec shell)))))
+ ;; Open a new shell if needed.
+ (unless (string-equal shell default-shell)
+ (tramp-message
+ vec 5 "Starting remote shell `%s' for tilde expansion" shell)
+ (tramp-open-shell vec shell))))))
;; Utility functions.
@@ -4326,11 +4326,15 @@ process to set up. VEC specifies the connection."
;; connection properties. We start again with
;; `tramp-maybe-open-connection', it will be caught there.
(tramp-message vec 5 "Checking system information")
- (let ((old-uname (tramp-get-connection-property vec "uname" nil))
- (uname
- (tramp-set-connection-property
- vec "uname"
- (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
+ (let* ((old-uname (tramp-get-connection-property vec "uname" nil))
+ (uname
+ ;; If we are in `make-process', we don't need to recompute.
+ (if (and old-uname
+ (tramp-get-connection-property vec "process-name" nil))
+ old-uname
+ (tramp-set-connection-property
+ vec "uname"
+ (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))))
(when (and (stringp old-uname) (not (string-equal old-uname uname)))
(tramp-message
vec 3
@@ -4404,7 +4408,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
- ;; <http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
+ ;; <https://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
(when (string-match-p "^IRIX64" uname)
(tramp-send-command vec "set +H" t))
@@ -4550,8 +4554,8 @@ Goes through the list `tramp-local-coding-commands' and
(catch 'wont-work-local
(let ((format (nth 0 litem))
(remote-commands tramp-remote-coding-commands))
- (setq loc-enc (nth 1 litem))
- (setq loc-dec (nth 2 litem))
+ (setq loc-enc (nth 1 litem)
+ loc-dec (nth 2 litem))
;; If the local encoder or decoder is a string, the
;; corresponding command has to work locally.
(if (not (stringp loc-enc))
@@ -4573,9 +4577,9 @@ Goes through the list `tramp-local-coding-commands' and
(setq ritem (pop remote-commands))
(catch 'wont-work-remote
(when (equal format (nth 0 ritem))
- (setq rem-enc (nth 1 ritem))
- (setq rem-dec (nth 2 ritem))
- (setq rem-test (nth 3 ritem))
+ (setq rem-enc (nth 1 ritem)
+ rem-dec (nth 2 ritem)
+ rem-test (nth 3 ritem))
;; Check the remote test command if exists.
(when (stringp rem-test)
(tramp-message
@@ -4645,11 +4649,7 @@ Goes through the list `tramp-local-coding-commands' and
?o (tramp-get-remote-od vec)))
value (replace-regexp-in-string "%" "%%" value)))
(when (string-match-p "\\(^\\|[^%]\\)%t" value)
- (setq tmpfile
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-get-remote-tmpdir vec)))
+ (setq tmpfile (tramp-make-tramp-temp-name vec)
value
(format-spec
value
@@ -4672,9 +4672,9 @@ Goes through the list `tramp-local-coding-commands' and
(throw 'wont-work-remote nil)))
;; `rem-enc' and `rem-dec' could be a string meanwhile.
- (setq rem-enc (nth 1 ritem))
- (setq rem-dec (nth 2 ritem))
- (setq found t)))))))
+ (setq rem-enc (nth 1 ritem)
+ rem-dec (nth 2 ritem)
+ found t)))))))
(when found
;; Set connection properties. Since the commands are risky
@@ -4787,99 +4787,6 @@ Goes through the list `tramp-inline-compress-commands'."
(tramp-message
vec 2 "Couldn't find an inline transfer compress command")))))
-(defun tramp-compute-multi-hops (vec)
- "Expands VEC according to `tramp-default-proxies-alist'."
- (let ((saved-tdpa tramp-default-proxies-alist)
- (target-alist `(,vec))
- (hops (or (tramp-file-name-hop vec) ""))
- (item vec)
- choices proxy)
-
- ;; Ad-hoc proxy definitions.
- (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit)))
- (let* ((host-port (tramp-file-name-host-port item))
- (user-domain (tramp-file-name-user-domain item))
- (proxy (concat
- tramp-prefix-format proxy tramp-postfix-host-format))
- (entry
- (list (and (stringp host-port)
- (concat "^" (regexp-quote host-port) "$"))
- (and (stringp user-domain)
- (concat "^" (regexp-quote user-domain) "$"))
- (propertize proxy 'tramp-ad-hoc t))))
- (tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry)
- ;; Add the hop.
- (add-to-list 'tramp-default-proxies-alist entry)
- (setq item (tramp-dissect-file-name proxy))))
- ;; Save the new value.
- (when (and hops tramp-save-ad-hoc-proxies)
- (customize-save-variable
- 'tramp-default-proxies-alist tramp-default-proxies-alist))
-
- ;; Look for proxy hosts to be passed.
- (setq choices tramp-default-proxies-alist)
- (while choices
- (setq item (pop choices)
- proxy (eval (nth 2 item)))
- (when (and
- ;; Host.
- (string-match-p
- (or (eval (nth 0 item)) "")
- (or (tramp-file-name-host-port (car target-alist)) ""))
- ;; User.
- (string-match-p
- (or (eval (nth 1 item)) "")
- (or (tramp-file-name-user-domain (car target-alist)) "")))
- (if (null proxy)
- ;; No more hops needed.
- (setq choices nil)
- ;; Replace placeholders.
- (setq proxy
- (format-spec
- proxy
- (format-spec-make
- ?u (or (tramp-file-name-user (car target-alist)) "")
- ?h (or (tramp-file-name-host (car target-alist)) ""))))
- (with-parsed-tramp-file-name proxy l
- ;; Add the hop.
- (push l target-alist)
- ;; Start next search.
- (setq choices tramp-default-proxies-alist)))))
-
- ;; Foreign and out-of-band methods are not supported for multi-hops.
- (when (cdr target-alist)
- (setq choices target-alist)
- (while (setq item (pop choices))
- (when (or (not (tramp-get-method-parameter item 'tramp-login-program))
- (tramp-get-method-parameter item 'tramp-copy-program))
- (setq tramp-default-proxies-alist saved-tdpa)
- (tramp-user-error
- vec "Method `%s' is not supported for multi-hops."
- (tramp-file-name-method item)))))
-
- ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the
- ;; host name in their command template. In this case, the remote
- ;; file name must use either a local host name (first hop), or a
- ;; host name matching the previous hop.
- (let ((previous-host (or tramp-local-host-regexp "")))
- (setq choices target-alist)
- (while (setq item (pop choices))
- (let ((host (tramp-file-name-host item)))
- (unless
- (or
- ;; The host name is used for the remote shell command.
- (member
- '("%h") (tramp-get-method-parameter item 'tramp-login-args))
- ;; The host name must match previous hop.
- (string-match-p previous-host host))
- (setq tramp-default-proxies-alist saved-tdpa)
- (tramp-user-error
- vec "Host name `%s' does not match `%s'" host previous-host))
- (setq previous-host (concat "^" (regexp-quote host) "$")))))
-
- ;; Result.
- target-alist))
-
(defun tramp-ssh-controlmaster-options (vec)
"Return the Control* arguments of the local ssh."
(cond
@@ -4938,7 +4845,7 @@ If there is just some editing, retry it after 5 seconds."
(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)))
+ (tramp-cleanup-connection vec 'keep-debug nil 'keep-processes)))
(defun tramp-maybe-open-connection (vec)
"Maybe open a connection VEC.
@@ -4959,11 +4866,8 @@ connection if a previous connection has died for some reason."
(not (tramp-file-name-equal-p
vec (car tramp-current-connection)))
(time-less-p
- ;; `current-time' can be removed once we get rid of Emacs 24.
- (time-since (or (cdr tramp-current-connection) (current-time)))
- ;; `seconds-to-time' can be removed once we get rid
- ;; of Emacs 24.
- (seconds-to-time (or tramp-connection-min-time-diff 0))))
+ (time-since (cdr tramp-current-connection))
+ (or tramp-connection-min-time-diff 0)))
(throw 'suppress 'suppress))
;; If too much time has passed since last command was sent, look
@@ -4974,11 +4878,9 @@ connection if a previous connection has died for some reason."
;; try to send a command from time to time, then look again
;; whether the process is really alive.
(condition-case nil
- ;; `seconds-to-time' can be removed once we get rid of Emacs 24.
- (when (and (time-less-p (seconds-to-time 60)
- (time-since
- (tramp-get-connection-property
- p "last-cmd-time" (seconds-to-time 0))))
+ (when (and (time-less-p
+ 60 (time-since
+ (tramp-get-connection-property p "last-cmd-time" 0)))
(process-live-p p))
(tramp-send-command vec "echo are you awake" t t)
(unless (and (process-live-p p)
@@ -5092,11 +4994,8 @@ connection if a previous connection has died for some reason."
;; we cannot use `tramp-get-connection-process'.
(tmpfile
(with-tramp-connection-property
- (get-process (tramp-buffer-name vec)) "temp-file"
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory)))))
+ (tramp-get-process vec) "temp-file"
+ (tramp-compat-make-temp-name)))
spec r-shell)
;; Add arguments for asynchronous processes.
@@ -5276,7 +5175,7 @@ the exit status."
"echo tramp_exit_status $?"
(if subshell " )" "")))
(with-current-buffer (tramp-get-connection-buffer vec)
- (unless (tramp-search-regexp "tramp_exit_status [0-9]+")
+ (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
(tramp-error
vec 'file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
@@ -5472,7 +5371,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-connection-process vec)
+ (tramp-get-process vec)
vec)
"remote-path"
(let* ((remote-path (copy-tree tramp-remote-path))
@@ -5680,8 +5579,7 @@ Nonexistent directories are removed from spec."
;; stat on Solaris is buggy. We've got reports for "SunOS 5.10"
;; and "SunOS 5.11" so far.
(unless (string-match-p
- (eval-when-compile (regexp-opt '("SunOS 5.10" "SunOS 5.11")))
- (tramp-get-connection-property vec "uname" ""))
+ tramp-sunos-unames (tramp-get-connection-property vec "uname" ""))
(tramp-message vec 5 "Finding a suitable `stat' command")
(let ((result (tramp-find-executable
vec "stat" (tramp-get-remote-path vec)))
@@ -5727,10 +5625,7 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
(tramp-message vec 5 "Finding a suitable `touch' command")
(let ((result (tramp-find-executable
vec "touch" (tramp-get-remote-path vec)))
- (tmpfile
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))))
+ (tmpfile (tramp-make-tramp-temp-name vec)))
;; Busyboxes do support the "-t" option only when they have been
;; built with the DESKTOP config option. Let's check it.
(when result
@@ -5845,27 +5740,6 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
"import os; print (os.getuid())"
"import os, pwd; print ('\\\"' + pwd.getpwuid(os.getuid())[0] + '\\\"')"))))
-(defun tramp-get-remote-uid (vec id-format)
- "The uid of the remote connection VEC, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "uid-%s" id-format)
- (let ((res
- (ignore-errors
- (cond
- ((tramp-get-remote-id vec)
- (tramp-get-remote-uid-with-id vec id-format))
- ((tramp-get-remote-perl vec)
- (tramp-get-remote-uid-with-perl vec id-format))
- ((tramp-get-remote-python vec)
- (tramp-get-remote-uid-with-python vec id-format))))))
- ;; Ensure there is a valid result.
- (cond
- ((and (equal id-format 'integer) (not (integerp res)))
- tramp-unknown-id-integer)
- ((and (equal id-format 'string) (not (stringp res)))
- tramp-unknown-id-string)
- (t res)))))
-
(defun tramp-get-remote-gid-with-id (vec id-format)
"Implement `tramp-get-remote-gid' for Tramp files using `id'."
(tramp-send-command-and-read
@@ -5896,27 +5770,6 @@ ID-FORMAT valid values are `string' and `integer'."
"import os; print (os.getgid())"
"import os, grp; print ('\\\"' + grp.getgrgid(os.getgid())[0] + '\\\"')"))))
-(defun tramp-get-remote-gid (vec id-format)
- "The gid of the remote connection VEC, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "gid-%s" id-format)
- (let ((res
- (ignore-errors
- (cond
- ((tramp-get-remote-id vec)
- (tramp-get-remote-gid-with-id vec id-format))
- ((tramp-get-remote-perl vec)
- (tramp-get-remote-gid-with-perl vec id-format))
- ((tramp-get-remote-python vec)
- (tramp-get-remote-gid-with-python vec id-format))))))
- ;; Ensure there is a valid result.
- (cond
- ((and (equal id-format 'integer) (not (integerp res)))
- tramp-unknown-id-integer)
- ((and (equal id-format 'string) (not (stringp res)))
- tramp-unknown-id-string)
- (t res)))))
-
(defun tramp-get-remote-busybox (vec)
"Determine remote `busybox' command."
(with-tramp-connection-property vec "busybox"
@@ -5958,6 +5811,19 @@ ID-FORMAT valid values are `string' and `integer'."
vec (concat command " -A n </dev/null"))
command)))))
+(defun tramp-get-remote-chmod-h (vec)
+ "Check whether remote `chmod' supports nofollow argument."
+ (with-tramp-connection-property vec "chmod-h"
+ (tramp-message vec 5 "Finding a suitable `chmod' command with nofollow")
+ (let ((tmpfile (tramp-make-tramp-temp-name vec)))
+ (prog1
+ (tramp-send-command-and-check
+ vec
+ (format
+ "ln -s foo %s && chmod -h %s 0777"
+ (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"
@@ -5975,10 +5841,9 @@ the length of the file to be compressed.
If no corresponding command is found, nil is returned."
(when (and (integerp tramp-inline-compress-start-size)
(> size tramp-inline-compress-start-size))
- (with-tramp-connection-property (tramp-get-connection-process vec) prop
+ (with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-compress vec)
- (tramp-get-connection-property
- (tramp-get-connection-process vec) prop nil))))
+ (tramp-get-connection-property (tramp-get-process vec) prop nil))))
(defun tramp-get-inline-coding (vec prop size)
"Return the coding command related to PROP.
@@ -5996,11 +5861,9 @@ function cell is returned to be applied on a buffer."
;; no inline coding is found.
(ignore-errors
(let ((coding
- (with-tramp-connection-property
- (tramp-get-connection-process vec) prop
+ (with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-encoding vec)
- (tramp-get-connection-property
- (tramp-get-connection-process vec) prop nil)))
+ (tramp-get-connection-property (tramp-get-process vec) prop nil)))
(prop1 (if (string-match-p "encoding" prop)
"inline-compress" "inline-decompress"))
compress)
@@ -6078,9 +5941,6 @@ function cell is returned to be applied on a buffer."
;; likely to produce long command lines, and some shells choke on
;; long command lines.
;;
-;; * Don't search for perl5 and perl. Instead, only search for perl and
-;; then look if it's the right version (with `perl -v').
-;;
;; * When editing a remote CVS controlled file as a different user, VC
;; gets confused about the file locking status. Try to find out why
;; the workaround doesn't work.
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 902fcf4b6e3..1b6af2a2e33 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -90,7 +90,7 @@ For example, if the deprecated SMB1 protocol shall be used, add to
this variable (\"client min protocol=NT1\") ."
:group 'tramp
:type '(repeat string)
- :version "27.2")
+ :version "28.1")
(defvar tramp-smb-version nil
"Version string of the SMB client.")
@@ -293,6 +293,8 @@ See `tramp-actions-before-shell' for more info.")
(start-file-process . tramp-smb-handle-start-file-process)
(substitute-in-file-name . tramp-smb-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)
(vc-registered . ignore)
@@ -341,10 +343,9 @@ This can be used to disable echo etc."
"Invoke the SMB related OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
- (let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
+ (if-let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
;;;###tramp-autoload
(unless (memq system-type '(cygwin windows-nt))
@@ -432,16 +433,12 @@ pass to the OPERATION."
v tramp-file-missing
"Copying directory" "No such file or directory" dirname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-already-exists newname))
(cond
;; We must use a local temporary directory.
((and t1 t2)
- (let ((tmpdir
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory)))))
+ (let ((tmpdir (tramp-compat-make-temp-name)))
(unwind-protect
(progn
(make-directory tmpdir)
@@ -469,10 +466,7 @@ pass to the OPERATION."
(localname (file-name-as-directory
(replace-regexp-in-string
"\\\\" "/" (tramp-smb-get-localname v))))
- (tmpdir (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory))))
+ (tmpdir (tramp-compat-make-temp-name))
(args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options))
@@ -556,10 +550,11 @@ pass to the OPERATION."
;; Handle KEEP-DATE argument.
(when keep-date
- (set-file-times
+ (tramp-compat-set-file-times
newname
(tramp-compat-file-attribute-modification-time
- (file-attributes dirname))))
+ (file-attributes dirname))
+ (unless ok-if-already-exists 'nofollow)))
;; Set the mode.
(unless keep-date
@@ -598,47 +593,47 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
tramp-file-missing
"Copying file" "No such file or directory" filename))
- (let ((tmpfile (file-local-copy filename)))
- (if tmpfile
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Remote newname.
+ (if-let ((tmpfile (file-local-copy filename)))
+ ;; Remote filename.
+ (condition-case err
+ (rename-file tmpfile newname ok-if-already-exists)
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Remote newname.
+ (when (and (file-directory-p newname)
+ (directory-name-p newname))
+ (setq newname
+ (expand-file-name (file-name-nondirectory filename) newname)))
+
+ (with-parsed-tramp-file-name newname nil
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (tramp-compat-directory-name-p newname))
- (setq newname
- (expand-file-name (file-name-nondirectory filename) newname)))
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname)
- (unless (tramp-smb-get-share v)
- (tramp-error
- v 'file-error "Target `%s' must contain a share name" newname))
- (unless (tramp-smb-send-command
- v (format "put \"%s\" \"%s\""
- (tramp-compat-file-name-unquote filename)
- (tramp-smb-get-localname v)))
- (tramp-error
- v 'file-error "Cannot copy `%s' to `%s'" filename newname))))))
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v localname)
+ (unless (tramp-smb-get-share v)
+ (tramp-error
+ v 'file-error "Target `%s' must contain a share name" newname))
+ (unless (tramp-smb-send-command
+ v (format "put \"%s\" \"%s\""
+ (tramp-compat-file-name-unquote filename)
+ (tramp-smb-get-localname v)))
+ (tramp-error
+ v 'file-error "Cannot copy `%s' to `%s'" filename newname)))))
;; KEEP-DATE handling.
(when keep-date
- (set-file-times
+ (tramp-compat-set-file-times
newname
(tramp-compat-file-attribute-modification-time
- (file-attributes filename))))))
+ (file-attributes filename))
+ (unless ok-if-already-exists 'nofollow)))))
(defun tramp-smb-handle-delete-directory (directory &optional recursive _trash)
"Like `delete-directory' for Tramp files."
@@ -709,11 +704,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(delete nil
(mapcar (lambda (x) (when (string-match-p match x) x))
result))))
- ;; Append directory.
+ ;; Prepend directory.
(when full
(setq result
(mapcar
- (lambda (x) (format "%s/%s" directory x))
+ (lambda (x) (format "%s/%s" (directory-file-name directory) x))
result)))
;; Sort them if necessary.
(unless nosort (setq result (sort result #'string-lessp)))
@@ -880,23 +875,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(while (not (eobp))
(cond
((looking-at
- "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)")
+ (concat
+ "Size:\\s-+\\([[:digit:]]+\\)\\s-+"
+ "Blocks:\\s-+[[:digit:]]+\\s-+\\(\\w+\\)"))
(setq size (string-to-number (match-string 1))
id (if (string-equal "directory" (match-string 2)) t
(if (string-equal "symbolic" (match-string 2)) ""))))
((looking-at
- "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)")
+ "Inode:\\s-+\\([[:digit:]]+\\)\\s-+Links:\\s-+\\([[:digit:]]+\\)")
(setq inode (string-to-number (match-string 1))
link (string-to-number (match-string 2))))
((looking-at
- "Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)")
+ (concat
+ "Access:\\s-+([[:digit:]]+/\\(\\S-+\\))\\s-+"
+ "Uid:\\s-+\\([[:digit:]]+\\)\\s-+"
+ "Gid:\\s-+\\([[:digit:]]+\\)"))
(setq mode (match-string 1)
uid (if (equal id-format 'string) (match-string 2)
(string-to-number (match-string 2)))
gid (if (equal id-format 'string) (match-string 3)
(string-to-number (match-string 3)))))
((looking-at
- "Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
+ (concat
+ "Access:\\s-+"
+ "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+"
+ "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)"))
(setq atime
(encode-time
(string-to-number (match-string 6)) ;; sec
@@ -906,7 +909,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(string-to-number (match-string 2)) ;; month
(string-to-number (match-string 1))))) ;; year
((looking-at
- "Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
+ (concat
+ "Modify:\\s-+"
+ "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+"
+ "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)"))
(setq mtime
(encode-time
(string-to-number (match-string 6)) ;; sec
@@ -916,7 +922,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(string-to-number (match-string 2)) ;; month
(string-to-number (match-string 1))))) ;; year
((looking-at
- "Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
+ (concat
+ "Change:\\s-+"
+ "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+"
+ "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)"))
(setq ctime
(encode-time
(string-to-number (match-string 6)) ;; sec
@@ -992,10 +1001,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (eval-when-compile
- (concat "[[:space:]]*\\([[:digit:]]+\\)"
- " blocks of size \\([[:digit:]]+\\)"
- "\\. \\([[:digit:]]+\\) blocks available")))
+ (concat "[[:space:]]*\\([[:digit:]]+\\)"
+ " blocks of size \\([[:digit:]]+\\)"
+ "\\. \\([[:digit:]]+\\) blocks available"))
(setq blocksize (string-to-number (match-string 2))
total (* blocksize (string-to-number (match-string 1)))
avail (* blocksize (string-to-number (match-string 3)))))
@@ -1025,7 +1033,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq filename (expand-file-name filename))
(unless switches (setq switches ""))
;; Mark trailing "/".
- (when (and (tramp-compat-directory-name-p filename)
+ (when (and (directory-name-p filename)
(not full-directory-p))
(setq switches (concat switches "F")))
(if full-directory-p
@@ -1377,7 +1385,7 @@ component is used as the target of the symlink."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
@@ -1479,7 +1487,7 @@ component is used as the target of the symlink."
;; This is meant for traces, and returning from the
;; function. No error is propagated outside, due to
;; the `ignore-errors' closure.
- (unless (tramp-search-regexp "tramp_exit_status [0-9]+")
+ (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
(tramp-error
v 'file-error
"Couldn't find exit status of `%s'" tramp-smb-acl-program))
@@ -1493,15 +1501,17 @@ component is used as the target of the symlink."
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")))))))
-(defun tramp-smb-handle-set-file-modes (filename mode &optional _flag)
+(defun tramp-smb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (when (tramp-smb-get-cifs-capabilities v)
- (tramp-flush-file-properties v localname)
- (unless (tramp-smb-send-command
- v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
- (tramp-error
- v 'file-error "Error while changing file's mode %s" filename)))))
+ ;; smbclient chmod does not support nofollow.
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (when (tramp-smb-get-cifs-capabilities v)
+ (tramp-flush-file-properties v localname)
+ (unless (tramp-smb-send-command
+ v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
+ (tramp-error
+ v 'file-error "Error while changing file's mode %s" filename))))))
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
@@ -1722,21 +1732,21 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
;; Entries provided by smbclient DIR aren't fully regular.
;; They should have the format
;;
-;; \s-\{2,2} - leading spaces
+;; \s-\{2,2\} - leading spaces
;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound
;; \s-+[ADHRSV]* - permissions, 7 chars, right bound
;; \s- - space delimiter
-;; \s-+[0-9]+ - size, 8 chars, right bound
+;; \s-+[[:digit:]]+ - size, 8 chars, right bound
;; \s-\{2,2\} - space delimiter
;; \w\{3,3\} - weekday
;; \s- - space delimiter
;; \w\{3,3\} - month
;; \s- - space delimiter
-;; [ 12][0-9] - day
+;; [ 12][[:digit:]] - day
;; \s- - space delimiter
-;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
+;; [[:digit:]]\{2,2\}:[[:digit:]]\{2,2\}:[[:digit:]]\{2,2\} - time
;; \s- - space delimiter
-;; [0-9]\{4,4\} - year
+;; [[:digit:]]\{4,4\} - year
;;
;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
;; has function display_finfo:
@@ -1784,13 +1794,14 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
(cl-block nil
;; year.
- (if (string-match "\\([0-9]+\\)$" line)
+ (if (string-match "\\([[:digit:]]+\\)$" line)
(setq year (string-to-number (match-string 1 line))
line (substring line 0 -5))
(cl-return))
;; time.
- (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line)
+ (if (string-match
+ "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)$" line)
(setq hour (string-to-number (match-string 1 line))
min (string-to-number (match-string 2 line))
sec (string-to-number (match-string 3 line))
@@ -1798,7 +1809,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
(cl-return))
;; day.
- (if (string-match "\\([0-9]+\\)$" line)
+ (if (string-match "\\([[:digit:]]+\\)$" line)
(setq day (string-to-number (match-string 1 line))
line (substring line 0 -3))
(cl-return))
@@ -1815,7 +1826,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
(cl-return))
;; size.
- (if (string-match "\\([0-9]+\\)$" line)
+ (if (string-match "\\([[:digit:]]+\\)$" line)
(let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
(setq size (string-to-number (match-string 1 line)))
(when (string-match
@@ -1870,7 +1881,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
(if (and (process-live-p (tramp-get-connection-process vec))
(tramp-get-connection-property vec "posix" t))
(with-tramp-connection-property
- (tramp-get-connection-process vec) "cifs-capabilities"
+ (tramp-get-process vec) "cifs-capabilities"
(save-match-data
(when (tramp-smb-send-command vec "posix")
(with-current-buffer (tramp-get-connection-buffer vec)
@@ -1887,8 +1898,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
;; When we are not logged in yet, we return nil.
(if (and (tramp-smb-get-share vec)
(process-live-p (tramp-get-connection-process vec)))
- (with-tramp-connection-property
- (tramp-get-connection-process vec) "stat-capability"
+ (with-tramp-connection-property (tramp-get-process vec) "stat-capability"
(tramp-smb-send-command vec "stat \"/\""))))
@@ -1950,11 +1960,9 @@ If ARGUMENT is non-nil, use it as argument for
;; connection timeout.
(with-current-buffer buf
(goto-char (point-min))
- ;; `seconds-to-time' can be removed once we get rid of Emacs 24.
- (when (and (time-less-p (seconds-to-time 60)
- (time-since
- (tramp-get-connection-property
- p "last-cmd-time" (seconds-to-time 0))))
+ (when (and (time-less-p
+ 60 (time-since
+ (tramp-get-connection-property p "last-cmd-time" 0)))
(process-live-p p)
(re-search-forward tramp-smb-errors nil t))
(delete-process p)
@@ -2025,7 +2033,7 @@ If ARGUMENT is non-nil, use it as argument for
(set-process-query-on-exit-flag p nil)
(condition-case err
- (let (tramp-message-show-message)
+ (let ((inhibit-message t))
;; Play login scenario.
(tramp-process-actions
p vec nil
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 4af58618a6a..98727dc4a87 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -132,6 +132,8 @@ See `tramp-actions-before-shell' for more info.")
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-remote-gid . tramp-sudoedit-handle-get-remote-gid)
+ (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)
(vc-registered . ignore)
@@ -153,10 +155,9 @@ See `tramp-actions-before-shell' for more info.")
"Invoke the SUDOEDIT handler for OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
- (let ((fn (assoc operation tramp-sudoedit-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
+ (if-let ((fn (assoc operation tramp-sudoedit-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
;;;###tramp-autoload
(tramp--with-startup
@@ -248,7 +249,7 @@ absolute file names."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(if (or (and (file-remote-p filename) (not t1))
@@ -282,7 +283,8 @@ absolute file names."
;; Set the time and mode. Mask possible errors.
(when keep-date
(ignore-errors
- (set-file-times newname file-times)
+ (tramp-compat-set-file-times
+ newname file-times (unless ok-if-already-exists 'nofollow))
(set-file-modes newname file-modes)))
;; Handle `preserve-extended-attributes'. We ignore possible
@@ -303,8 +305,8 @@ absolute file names."
(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))
- (setq newname (expand-file-name newname))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -373,7 +375,7 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-remote-acl-p (vec)
"Check, whether ACL is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p"
+ (with-tramp-connection-property (tramp-get-process vec) "acl-p"
(zerop (tramp-call-process vec "getfacl" nil nil nil "/"))))
(defun tramp-sudoedit-handle-file-acl (filename)
@@ -464,19 +466,21 @@ the result will be a local, non-Tramp, file name."
(tramp-sudoedit-send-command
v "test" "-r" (tramp-compat-file-name-unquote localname)))))
-(defun tramp-sudoedit-handle-set-file-modes (filename mode &optional _flag)
+(defun tramp-sudoedit-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
- (unless (tramp-sudoedit-send-command
- v "chmod" (format "%o" mode)
- (tramp-compat-file-name-unquote localname))
- (tramp-error
- v 'file-error "Error while changing file's mode %s" filename))))
+ ;; It is unlikely that "chmod -h" works.
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-flush-file-properties v localname)
+ (unless (tramp-sudoedit-send-command
+ v "chmod" (format "%o" mode)
+ (tramp-compat-file-name-unquote localname))
+ (tramp-error
+ v 'file-error "Error while changing file's mode %s" filename)))))
(defun tramp-sudoedit-remote-selinux-p (vec)
"Check, whether SELINUX is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec) "selinux-p"
+ (with-tramp-connection-property (tramp-get-process vec) "selinux-p"
(zerop (tramp-call-process vec "selinuxenabled"))))
(defun tramp-sudoedit-handle-file-selinux-context (filename)
@@ -484,9 +488,8 @@ the result will be a local, non-Tramp, file name."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-selinux-context"
(let ((context '(nil nil nil nil))
- (regexp (eval-when-compile
- (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):"
- "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)"))))
+ (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):"
+ "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)")))
(when (and (tramp-sudoedit-remote-selinux-p v)
(tramp-sudoedit-send-command
v "ls" "-d" "-Z"
@@ -511,10 +514,9 @@ the result will be a local, non-Tramp, file name."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (eval-when-compile
- (concat "[[:space:]]*\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)")))
+ (concat "[[:space:]]*\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"))
(list (string-to-number (match-string 1))
;; The second value is the used size. We need the
;; free size.
@@ -522,7 +524,7 @@ the result will be a local, non-Tramp, file name."
(string-to-number (match-string 2)))
(string-to-number (match-string 3)))))))))
-(defun tramp-sudoedit-handle-set-file-times (filename &optional time _flag)
+(defun tramp-sudoedit-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
@@ -535,14 +537,14 @@ the result will be a local, non-Tramp, file name."
(tramp-sudoedit-send-command
v "env" "TZ=UTC" "touch" "-t"
(format-time-string "%Y%m%d%H%M.%S" time t)
+ (if (eq flag 'nofollow) "-h" "")
(tramp-compat-file-name-unquote localname)))))
(defun tramp-sudoedit-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
;; Preserve trailing "/".
(funcall
- (if (tramp-compat-directory-name-p filename)
- #'file-name-as-directory #'identity)
+ (if (directory-name-p filename) #'file-name-as-directory #'identity)
;; Quote properly.
(funcall
(if (tramp-compat-file-name-quoted-p filename)
@@ -642,8 +644,8 @@ component is used as the target of the symlink."
(defun tramp-sudoedit-handle-rename-file
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -687,21 +689,19 @@ component is used as the target of the symlink."
(tramp-flush-file-property v localname "file-selinux-context"))
t)))))
-(defun tramp-sudoedit-get-remote-uid (vec id-format)
+(defun tramp-sudoedit-handle-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "uid-%s" id-format)
- (if (equal id-format 'integer)
- (tramp-sudoedit-send-command-and-read vec "id" "-u")
- (tramp-sudoedit-send-command-string vec "id" "-un"))))
+ (if (equal id-format 'integer)
+ (tramp-sudoedit-send-command-and-read vec "id" "-u")
+ (tramp-sudoedit-send-command-string vec "id" "-un")))
-(defun tramp-sudoedit-get-remote-gid (vec id-format)
+(defun tramp-sudoedit-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'."
- (with-tramp-connection-property vec (format "gid-%s" id-format)
- (if (equal id-format 'integer)
- (tramp-sudoedit-send-command-and-read vec "id" "-g")
- (tramp-sudoedit-send-command-string vec "id" "-gn"))))
+ (if (equal id-format 'integer)
+ (tramp-sudoedit-send-command-and-read vec "id" "-g")
+ (tramp-sudoedit-send-command-string vec "id" "-gn")))
(defun tramp-sudoedit-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
@@ -709,21 +709,22 @@ ID-FORMAT valid values are `string' and `integer'."
(tramp-sudoedit-send-command
v "chown"
(format "%d:%d"
- (or uid (tramp-sudoedit-get-remote-uid v 'integer))
- (or gid (tramp-sudoedit-get-remote-gid v 'integer)))
+ (or uid (tramp-get-remote-uid v 'integer))
+ (or gid (tramp-get-remote-gid v 'integer)))
(tramp-unquote-file-local-name filename))))
(defun tramp-sudoedit-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (let ((uid (or (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer))
- (tramp-sudoedit-get-remote-uid v 'integer)))
- (gid (or (tramp-compat-file-attribute-group-id
- (file-attributes filename 'integer))
- (tramp-sudoedit-get-remote-gid v 'integer)))
- (modes (tramp-default-file-modes filename)))
+ (let* ((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)))
+ (flag (and (eq mustbenew 'excl) 'nofollow))
+ (modes (tramp-default-file-modes filename flag)))
(prog1
(tramp-handle-write-region
start end filename append visit lockname mustbenew)
@@ -737,7 +738,7 @@ ID-FORMAT valid values are `string' and `integer'."
(file-attributes filename 'integer))
gid))
(tramp-set-file-uid-gid filename uid gid))
- (set-file-modes filename modes)))))
+ (tramp-compat-set-file-modes filename modes flag)))))
;; Internal functions.
@@ -782,14 +783,7 @@ connection if a previous connection has died for some reason."
(tramp-set-connection-local-variables vec)
;; Mark it as connected.
- (tramp-set-connection-property p "connected" t))
-
- ;; In `tramp-check-cached-permissions', the connection properties
- ;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
- (tramp-sudoedit-get-remote-uid vec 'integer)
- (tramp-sudoedit-get-remote-gid vec 'integer)
- (tramp-sudoedit-get-remote-uid vec 'string)
- (tramp-sudoedit-get-remote-gid vec 'string)))
+ (tramp-set-connection-property p "connected" t))))
(defun tramp-sudoedit-send-command (vec &rest args)
"Send commands ARGS to connection VEC.
diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el
index 6a044e58840..f368f72a8dc 100644
--- a/lisp/net/tramp-uu.el
+++ b/lisp/net/tramp-uu.el
@@ -94,8 +94,3 @@
(provide 'tramp-uu)
;;; tramp-uu.el ends here
-
-;; Local Variables:
-;; mode: Emacs-Lisp
-;; coding: utf-8
-;; End:
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 2e6fbe1c767..6d44ad23ad7 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -7,8 +7,8 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.4.5-pre
-;; Package-Requires: ((emacs "24.4"))
+;; Version: 2.5.0-pre
+;; Package-Requires: ((emacs "25.1"))
;; Package-Type: multi
;; URL: https://savannah.gnu.org/projects/tramp
@@ -64,6 +64,7 @@
;; Pacify byte-compiler.
(require 'cl-lib)
+(declare-function file-notify-rm-watch "filenotify")
(declare-function netrc-parse "netrc")
(defvar auto-save-file-name-transforms)
@@ -79,6 +80,7 @@
(eval-and-compile ;; So it's also available in tramp-loaddefs.el!
(defvar tramp--startup-hook nil
"Forms to be executed at the end of tramp.el.")
+ (put 'tramp--startup-hook 'tramp-suppress-trace t)
(defmacro tramp--with-startup (&rest body)
"Schedule BODY to be executed at the end of tramp.el."
@@ -247,6 +249,10 @@ pair of the form (KEY VALUE). The following KEYs are defined:
parameters to suppress diagnostic messages, in order not to
tamper the process output.
+ * `tramp-direct-async-args'
+ An additional argument when a direct asynchronous process is
+ started. Used so far only in the \"mock\" method of tramp-tests.el.
+
* `tramp-copy-program'
This specifies the name of the program to use for remotely copying
the file; this might be the absolute filename of scp or the name of
@@ -559,7 +565,7 @@ Sometimes the prompt is reported to look like \"login as:\"."
;; Allow also [] style prompts. They can appear only during
;; connection initialization; Tramp redefines the prompt afterwards.
(concat "\\(?:^\\|\r\\)"
- "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
+ "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[[:digit:];]*[[:alpha:]] *\\)*")
"Regexp to match prompts from remote shell.
Normally, Tramp expects you to configure `shell-prompt-pattern'
correctly, but sometimes it happens that you are connecting to a
@@ -578,6 +584,11 @@ This regexp must match both `tramp-initial-end-of-output' and
"Regexp matching password-like prompts.
The regexp should match at end of buffer.
+This variable is, by default, initialised from
+`password-word-equivalents' when Tramp is loaded, and it is
+usually more convenient to add new passphrases to that variable
+instead of altering this variable.
+
The `sudo' program appears to insert a `^@' character into the prompt."
:version "24.4"
:type 'regexp)
@@ -600,7 +611,7 @@ The `sudo' program appears to insert a `^@' character into the prompt."
"\\|"
"^.*\\("
;; Here comes a list of regexes, separated by \\|
- "Received signal [0-9]+"
+ "Received signal [[:digit:]]+"
"\\).*")
"Regexp matching a `login failed' message.
The regexp should match at end of buffer."
@@ -745,7 +756,7 @@ to be set, depending on VALUE."
tramp-postfix-host-format (tramp-build-postfix-host-format)
tramp-postfix-host-regexp (tramp-build-postfix-host-regexp)
tramp-remote-file-name-spec-regexp
- (tramp-build-remote-file-name-spec-regexp)
+ (tramp-build-remote-file-name-spec-regexp)
tramp-file-name-structure (tramp-build-file-name-structure)
tramp-file-name-regexp (tramp-build-file-name-regexp)
tramp-completion-file-name-regexp
@@ -796,9 +807,9 @@ Used in `tramp-make-tramp-file-name'.")
Should always start with \"^\". Derived from `tramp-prefix-format'.")
(defconst tramp-method-regexp-alist
- '((default . "[a-zA-Z0-9-]+")
+ '((default . "[[:alnum:]-]+")
(simplified . "")
- (separate . "[a-zA-Z0-9-]*"))
+ (separate . "[[:alnum:]-]*"))
"Alist mapping Tramp syntax to regexps matching methods identifiers.")
(defun tramp-build-method-regexp ()
@@ -842,7 +853,7 @@ Derived from `tramp-postfix-method-format'.")
"Regexp matching delimiter between user and domain names.
Derived from `tramp-prefix-domain-format'.")
-(defconst tramp-domain-regexp "[a-zA-Z0-9_.-]+"
+(defconst tramp-domain-regexp "[[:alnum:]_.-]+"
"Regexp matching domain names.")
(defconst tramp-user-with-domain-regexp
@@ -859,7 +870,7 @@ Used in `tramp-make-tramp-file-name'.")
"Regexp matching delimiter between user and host names.
Derived from `tramp-postfix-user-format'.")
-(defconst tramp-host-regexp "[a-zA-Z0-9_.%-]+"
+(defconst tramp-host-regexp "[[:alnum:]_.%-]+"
"Regexp matching host names.")
(defconst tramp-prefix-ipv6-format-alist
@@ -887,7 +898,7 @@ Derived from `tramp-prefix-ipv6-format'.")
;; The following regexp is a bit sloppy. But it shall serve our
;; purposes. It covers also IPv4 mapped IPv6 addresses, like in
;; "::ffff:192.168.0.1".
-(defconst tramp-ipv6-regexp "\\(?:[a-zA-Z0-9]*:\\)+[a-zA-Z0-9.]+"
+(defconst tramp-ipv6-regexp "\\(?:[[:alnum:]]*:\\)+[[:alnum:].]+"
"Regexp matching IPv6 addresses.")
(defconst tramp-postfix-ipv6-format-alist
@@ -919,7 +930,7 @@ Derived from `tramp-postfix-ipv6-format'.")
"Regexp matching delimiter between host names and port numbers.
Derived from `tramp-prefix-port-format'.")
-(defconst tramp-port-regexp "[0-9]+"
+(defconst tramp-port-regexp "[[:digit:]]+"
"Regexp matching port numbers.")
(defconst tramp-host-with-port-regexp
@@ -1236,6 +1247,7 @@ the (optional) timestamp of last activity on this connection.")
"Password save function.
Will be called once the password has been verified by successful
authentication.")
+(put 'tramp-password-save-function 'tramp-suppress-trace t)
(defconst tramp-completion-file-name-handler-alist
'((file-name-all-completions
@@ -1259,7 +1271,7 @@ calling HANDLER.")
;; data structure.
;; The basic structure for remote file names. We use a list :type,
-;; in order to be compatible with Emacs 24 and 25.
+;; in order to be compatible with Emacs 25.
(cl-defstruct (tramp-file-name (:type list) :named)
method user domain host port localname hop)
@@ -1285,7 +1297,7 @@ If nil, return `tramp-default-port'."
(or (tramp-file-name-port vec)
(tramp-get-method-parameter vec 'tramp-default-port)))
-;; Comparision of file names is performed by `tramp-equal-remote'.
+;; 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'."
(and (tramp-file-name-p vec1) (tramp-file-name-p vec2)
@@ -1307,9 +1319,10 @@ entry does not exist, return nil."
;; We use the cached property.
(tramp-get-connection-property vec hash-entry nil)
;; Use the static value from `tramp-methods'.
- (let ((methods-entry
- (assoc param (assoc (tramp-file-name-method vec) tramp-methods))))
- (when methods-entry (cadr methods-entry))))))
+ (when-let ((methods-entry
+ (assoc
+ param (assoc (tramp-file-name-method vec) tramp-methods))))
+ (cadr methods-entry)))))
;; The localname can be quoted with "/:". Extract this.
(defun tramp-file-name-unquote-localname (vec)
@@ -1369,8 +1382,8 @@ This is METHOD, if non-nil. Otherwise, do a lookup in
(setq item (pop choices))
(when (and (string-match-p (or (nth 0 item) "") (or host ""))
(string-match-p (or (nth 1 item) "") (or user "")))
- (setq lmethod (nth 2 item))
- (setq choices nil)))
+ (setq lmethod (nth 2 item)
+ choices nil)))
lmethod)
tramp-default-method)))
;; We must mark, whether a default value has been used.
@@ -1390,8 +1403,8 @@ This is USER, if non-nil. Otherwise, do a lookup in
(setq item (pop choices))
(when (and (string-match-p (or (nth 0 item) "") (or method ""))
(string-match-p (or (nth 1 item) "") (or host "")))
- (setq luser (nth 2 item))
- (setq choices nil)))
+ (setq luser (nth 2 item)
+ choices nil)))
luser)
tramp-default-user)))
;; We must mark, whether a default value has been used.
@@ -1411,8 +1424,8 @@ This is HOST, if non-nil. Otherwise, do a lookup in
(setq item (pop choices))
(when (and (string-match-p (or (nth 0 item) "") (or method ""))
(string-match-p (or (nth 1 item) "") (or user "")))
- (setq lhost (nth 2 item))
- (setq choices nil)))
+ (setq lhost (nth 2 item)
+ choices nil)))
lhost)
tramp-default-host)))
;; We must mark, whether a default value has been used.
@@ -1474,16 +1487,13 @@ default values are used."
:method method :user user :domain domain :host host
:port port :localname localname :hop hop))
;; The method must be known.
- (unless (or nodefault (tramp-completion-mode-p)
+ (unless (or nodefault non-essential
(string-equal method tramp-default-method-marker)
(assoc method tramp-methods))
(tramp-user-error
v "Method `%s' is not known." method))
;; Only some methods from tramp-sh.el do support multi-hops.
- (when (and
- hop
- (or (not (tramp-get-method-parameter v 'tramp-login-program))
- (tramp-get-method-parameter v 'tramp-copy-program)))
+ (unless (or (null hop) nodefault non-essential (tramp-multi-hop-p v))
(tramp-user-error
v "Method `%s' is not supported for multi-hops." method)))))))
@@ -1497,8 +1507,7 @@ See `tramp-dissect-file-name' for details."
tramp-postfix-host-format name))
nodefault)))
;; Only some methods from tramp-sh.el do support multi-hops.
- (when (or (not (tramp-get-method-parameter v 'tramp-login-program))
- (tramp-get-method-parameter v 'tramp-copy-program))
+ (unless (or nodefault non-essential (tramp-multi-hop-p v))
(tramp-user-error
v "Method `%s' is not supported for multi-hops."
(tramp-file-name-method v)))
@@ -1631,6 +1640,15 @@ from the default one."
(or (tramp-get-connection-property vec "process-name" nil)
(tramp-buffer-name vec)))
+(defun tramp-get-process (vec-or-proc)
+ "Get the default connection process to be used for VEC-OR-PROC.
+Return `tramp-cache-undefined' in case it doesn't exist."
+ (or (and (tramp-file-name-p vec-or-proc)
+ (get-buffer-process (tramp-buffer-name vec-or-proc)))
+ (and (processp vec-or-proc)
+ (tramp-get-process (process-get vec-or-proc 'vector)))
+ tramp-cache-undefined))
+
(defun tramp-get-connection-process (vec)
"Get the connection process to be used for VEC.
In case a second asynchronous communication has been started, it is different
@@ -1673,11 +1691,10 @@ version, the function does nothing."
(format "*debug tramp/%s %s*" method host-port))))
(defconst tramp-debug-outline-regexp
- (eval-when-compile
- (concat
- "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ " ;; Timestamp.
- "\\(?:\\(#<thread .+>\\) \\)?" ;; Thread.
- "[a-z0-9-]+ (\\([0-9]+\\)) #")) ;; Function name, verbosity.
+ (concat
+ "[[:digit:]]+:[[:digit:]]+:[[:digit:]]+\\.[[:digit:]]+ " ;; Timestamp.
+ "\\(?:\\(#<thread .+>\\) \\)?" ;; Thread.
+ "[[:alnum:]-]+ (\\([[:digit:]]+\\)) #") ;; Function name, verbosity.
"Used for highlighting Tramp debug buffers in `outline-mode'.")
(defconst tramp-debug-font-lock-keywords
@@ -1750,29 +1767,10 @@ ARGUMENTS to actually emit the message (if applicable)."
(setq btf (nth 1 (backtrace-frame btn)))
(if (not btf)
(setq fn "")
- (when (symbolp btf)
- (setq fn (symbol-name btf))
- (unless
- (and
- (string-match-p "^tramp" fn)
- (not
- (string-match-p
- (eval-when-compile
- (concat
- "^"
- (regexp-opt
- '("tramp-backtrace"
- "tramp-compat-funcall"
- "tramp-debug-message"
- "tramp-error"
- "tramp-error-with-buffer"
- "tramp-message"
- "tramp-signal-hook-function"
- "tramp-user-error")
- t)
- "$"))
- fn)))
- (setq fn nil)))
+ (and (symbolp btf) (setq fn (symbol-name btf))
+ (or (not (string-match-p "^tramp" fn))
+ (get btf 'tramp-suppress-trace))
+ (setq fn nil))
(setq btn (1+ btn))))
;; The following code inserts filename and line number. Should
;; be inactive by default, because it is time consuming.
@@ -1787,11 +1785,11 @@ ARGUMENTS to actually emit the message (if applicable)."
;; The message.
(insert (apply #'format-message fmt-string arguments))))
-(defvar tramp-message-show-message (null noninteractive)
- "Show Tramp message in the minibuffer.
-This variable is used to suppress progress reporter output, and
-to disable messages from `tramp-error'. Those messages are
-visible anyway, because an error is raised.")
+(put #'tramp-debug-message 'tramp-suppress-trace t)
+
+(defvar tramp-inhibit-progress-reporter nil
+ "Show Tramp progress reporter in the minibuffer.
+This variable is used to disable concurrent progress reporter messages.")
(defsubst tramp-message (vec-or-proc level fmt-string &rest arguments)
"Emit a message depending on verbosity level.
@@ -1808,8 +1806,9 @@ control string and the remaining ARGUMENTS to actually emit the message (if
applicable)."
(ignore-errors
(when (<= level tramp-verbose)
- ;; Display only when there is a minimum level.
- (when (and tramp-message-show-message (<= level 3))
+ ;; Display only when there is a minimum level, and the progress
+ ;; reporter doesn't suppress further messages.
+ (when (and (<= level 3) (null tramp-inhibit-progress-reporter))
(apply #'message
(concat
(cond
@@ -1841,6 +1840,8 @@ applicable)."
(concat (format "(%d) # " level) fmt-string)
arguments))))))
+(put #'tramp-message 'tramp-suppress-trace t)
+
(defsubst tramp-backtrace (&optional vec-or-proc)
"Dump a backtrace into the debug buffer.
If VEC-OR-PROC is nil, the buffer *debug tramp* is used. This
@@ -1851,13 +1852,16 @@ function is meant for debugging purposes."
vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
(with-output-to-temp-buffer "*debug tramp*" (backtrace)))))
+(put #'tramp-backtrace 'tramp-suppress-trace t)
+
(defsubst 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
`tramp-message'. Finally, signal SIGNAL is raised with
FMT-STRING and ARGUMENTS."
- (let (tramp-message-show-message signal-hook-function)
+ (let ((inhibit-message t)
+ signal-hook-function)
(tramp-backtrace vec-or-proc)
(unless arguments
;; FMT-STRING could be just a file name, as in
@@ -1875,6 +1879,8 @@ FMT-STRING and ARGUMENTS."
(signal signal (list (substring-no-properties
(apply #'format-message fmt-string arguments))))))
+(put #'tramp-error 'tramp-suppress-trace t)
+
(defsubst tramp-error-with-buffer
(buf vec-or-proc signal fmt-string &rest arguments)
"Emit an error, and show BUF.
@@ -1892,13 +1898,13 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(apply #'tramp-error vec-or-proc signal fmt-string arguments)
;; Save exit.
(when (and buf
- tramp-message-show-message
(not (zerop tramp-verbose))
;; Do not show when flagged from outside.
- (not (tramp-completion-mode-p))
+ (not non-essential)
;; Show only when Emacs has started already.
(current-message))
- (let ((enable-recursive-minibuffers t))
+ (let ((enable-recursive-minibuffers t)
+ inhibit-message)
;; `tramp-error' does not show messages. So we must do it
;; ourselves.
(apply #'message fmt-string arguments)
@@ -1910,19 +1916,21 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(when (tramp-file-name-equal-p vec (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
+(put #'tramp-error-with-buffer 'tramp-suppress-trace t)
+
;; We must make it a defun, because it is used earlier already.
(defun tramp-user-error (vec-or-proc fmt-string &rest arguments)
"Signal a user error (or \"pilot error\")."
(unwind-protect
(apply #'tramp-error vec-or-proc 'user-error fmt-string arguments)
;; Save exit.
- (when (and tramp-message-show-message
- (not (zerop tramp-verbose))
+ (when (and (not (zerop tramp-verbose))
;; Do not show when flagged from outside.
- (not (tramp-completion-mode-p))
+ (not non-essential)
;; Show only when Emacs has started already.
(current-message))
- (let ((enable-recursive-minibuffers t))
+ (let ((enable-recursive-minibuffers t)
+ inhibit-message)
;; `tramp-error' does not show messages. So we must do it ourselves.
(apply #'message fmt-string arguments)
(discard-input)
@@ -1932,18 +1940,21 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(tramp-file-name-equal-p vec-or-proc (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
+(put #'tramp-user-error 'tramp-suppress-trace t)
+
(defmacro tramp-with-demoted-errors (vec-or-proc format &rest body)
"Execute BODY while redirecting the error message to `tramp-message'.
BODY is executed like wrapped by `with-demoted-errors'. FORMAT
is a format-string containing a %-sequence meaning to substitute
the resulting error message."
- (declare (debug (symbolp body))
- (indent 2))
+ (declare (indent 2) (debug (symbolp form body)))
(let ((err (make-symbol "err")))
`(condition-case-unless-debug ,err
(progn ,@body)
(error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
+(put #'tramp-with-demoted-errors 'tramp-suppress-trace t)
+
;; This function provides traces in case of errors not triggered by
;; Tramp functions.
(defun tramp-signal-hook-function (error-symbol data)
@@ -1955,6 +1966,8 @@ the resulting error message."
(car tramp-current-connection) error-symbol
"%s" (mapconcat (lambda (x) (format "%s" x)) data " "))))
+(put #'tramp-signal-hook-function 'tramp-suppress-trace t)
+
(defmacro with-parsed-tramp-file-name (filename var &rest body)
"Parse a Tramp filename and make components available in the body.
@@ -1971,12 +1984,14 @@ Remaining args are Lisp expressions to be evaluated (inside an implicit
If VAR is nil, then we bind `v' to the structure and `method', `user',
`domain', `host', `port', `localname', `hop' to the components."
+ (declare (indent 2) (debug (form symbolp body)))
(let ((bindings
- (mapcar (lambda (elem)
- `(,(if var (intern (format "%s-%s" var elem)) elem)
- (,(intern (format "tramp-file-name-%s" elem))
- ,(or var 'v))))
- `,(tramp-compat-tramp-file-name-slots))))
+ (mapcar
+ (lambda (elem)
+ `(,(if var (intern (format "%s-%s" var elem)) elem)
+ (,(intern (format "tramp-file-name-%s" elem))
+ ,(or var 'v))))
+ (cdr (mapcar #'car (cl-struct-slot-info 'tramp-file-name))))))
`(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
,@bindings)
;; We don't know which of those vars will be used, so we bind them all,
@@ -1985,8 +2000,6 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
(ignore ,@(mapcar #'car bindings))
,@body)))
-(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
-(put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
(defun tramp-progress-reporter-update (reporter &optional value suffix)
@@ -1997,25 +2010,30 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
(tramp-compat-progress-reporter-update reporter value suffix))))
(defmacro with-tramp-progress-reporter (vec level message &rest body)
- "Execute BODY, spinning a progress reporter with MESSAGE.
+ "Execute BODY, spinning a progress reporter with MESSAGE in interactive mode.
If LEVEL does not fit for visible messages, there are only traces
without a visible progress reporter."
(declare (indent 3) (debug t))
- `(progn
+ `(if (or noninteractive inhibit-message)
+ (progn ,@body)
(tramp-message ,vec ,level "%s..." ,message)
(let ((cookie "failed")
(tm
;; We start a pulsing progress reporter after 3 seconds.
- (when (and tramp-message-show-message
- ;; Display only when there is a minimum level.
- (<= ,level (min tramp-verbose 3)))
- (let ((pr (make-progress-reporter ,message nil nil)))
- (when pr
- (run-at-time
- 3 0.1 #'tramp-progress-reporter-update pr))))))
+ ;; Start only when there is no other progress reporter
+ ;; running, and when there is a minimum level.
+ (when-let ((pr (and (null tramp-inhibit-progress-reporter)
+ (<= ,level (min tramp-verbose 3))
+ (make-progress-reporter ,message nil nil))))
+ (run-at-time 3 0.1 #'tramp-progress-reporter-update pr))))
(unwind-protect
;; Execute the body.
- (prog1 (progn ,@body) (setq cookie "done"))
+ (prog1
+ ;; Suppress concurrent progress reporter messages.
+ (let ((tramp-inhibit-progress-reporter
+ (or tramp-inhibit-progress-reporter tm)))
+ ,@body)
+ (setq cookie "done"))
;; Stop progress reporter.
(if tm (cancel-timer tm))
(tramp-message ,vec ,level "%s...%s" ,message cookie)))))
@@ -2026,6 +2044,7 @@ without a visible progress reporter."
(defmacro with-tramp-file-property (vec file property &rest body)
"Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
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)
@@ -2037,12 +2056,11 @@ FILE must be a local file name on a connection identified via VEC."
value)
,@body))
-(put 'with-tramp-file-property 'lisp-indent-function 3)
-(put 'with-tramp-file-property 'edebug-form-spec t)
(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-file-property\\>"))
(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
@@ -2052,8 +2070,6 @@ FILE must be a local file name on a connection identified via VEC."
(tramp-set-connection-property ,key ,property value))
value))
-(put 'with-tramp-connection-property 'lisp-indent-function 2)
-(put 'with-tramp-connection-property 'edebug-form-spec t)
(font-lock-add-keywords
'emacs-lisp-mode '("\\<with-tramp-connection-property\\>"))
@@ -2066,12 +2082,15 @@ letter into the file name. This function removes it."
(save-match-data
(let ((quoted (tramp-compat-file-name-quoted-p name 'top))
(result (tramp-compat-file-name-unquote name 'top)))
- (setq result (if (string-match "\\`[a-zA-Z]:/" result)
+ (setq result (if (string-match "\\`[[:alpha:]]:/" result)
(replace-match "/" nil t result) result))
(if quoted (tramp-compat-file-name-quote result 'top) result))))
;;; Config Manipulation Functions:
+(defconst tramp-dns-sd-service-regexp "^_[-[:alnum:]]+\\._tcp$"
+ "DNS-SD service regexp.")
+
(defun tramp-set-completion-function (method function-list)
"Set the list of completion functions for METHOD.
FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
@@ -2104,10 +2123,10 @@ Example:
(zerop
(tramp-call-process
v "reg" nil nil nil "query" (nth 1 (car v))))))
- ;; Zeroconf service type.
+ ;; DNS-SD service type.
((string-match-p
- "^_[[:alpha:]]+\\._[[:alpha:]]+$" (nth 1 (car v))))
- ;; Configuration file.
+ tramp-dns-sd-service-regexp (nth 1 (car v))))
+ ;; Configuration file or empty string.
(t (file-exists-p (nth 1 (car v))))))
(setq r (delete (car v) r)))
(setq v (cdr v)))
@@ -2145,11 +2164,13 @@ For definition of that list see `tramp-set-completion-function'."
(defvar tramp-devices 0
"Keeps virtual device numbers.")
-(defun tramp-default-file-modes (filename)
+(defun tramp-default-file-modes (filename &optional flag)
"Return file modes of FILENAME as integer.
-If the file modes of FILENAME cannot be determined, return the
-value of `default-file-modes', without execute permissions."
- (or (file-modes filename)
+If optional FLAG is ‘nofollow’, do not follow FILENAME if it is a
+symbolic link. If the file modes of FILENAME cannot be
+determined, return the value of `default-file-modes', without
+execute permissions."
+ (or (tramp-compat-file-modes filename flag)
(logand (default-file-modes) #o0666)))
(defun tramp-replace-environment-variables (filename)
@@ -2180,6 +2201,7 @@ arguments to pass to the OPERATION."
tramp-vc-file-name-handler
tramp-completion-file-name-handler
tramp-archive-file-name-handler
+ tramp-crypt-file-name-handler
cygwin-mount-name-hook-function
cygwin-mount-map-drive-hook-function
.
@@ -2245,7 +2267,7 @@ Must be handled by the callers."
file-newer-than-file-p rename-file))
(cond
((tramp-tramp-file-p (nth 0 args)) (nth 0 args))
- ((tramp-tramp-file-p (nth 1 args)) (nth 1 args))
+ ((file-name-absolute-p (nth 1 args)) (nth 1 args))
(t default-directory)))
;; FILE DIRECTORY resp FILE1 FILE2.
((eq operation 'expand-file-name)
@@ -2273,13 +2295,13 @@ Must be handled by the callers."
exec-path make-process))
default-directory)
;; PROC.
- ((member operation
- '(file-notify-rm-watch
- ;; Emacs 25+ only.
- file-notify-valid-p))
+ ((member operation '(file-notify-rm-watch file-notify-valid-p))
(when (processp (nth 0 args))
(with-current-buffer (process-buffer (nth 0 args))
default-directory)))
+ ;; VEC.
+ ((member operation '(tramp-get-remote-gid tramp-get-remote-uid))
+ (tramp-make-tramp-file-name (nth 0 args)))
;; Unknown file primitive.
(t (error "Unknown file I/O primitive: %s" operation))))
@@ -2396,7 +2418,7 @@ Fall back to normal file name handler if no Tramp file name handler exists."
(cons operation args))
(tramp-run-real-handler operation args))
((eq result 'suppress)
- (let (tramp-message-show-message)
+ (let ((inhibit-message t))
(tramp-message
v 1 "Suppress received in operation %s"
(cons operation args))
@@ -2425,18 +2447,21 @@ Fall back to normal file name handler if no Tramp file name handler exists."
(defun tramp-completion-file-name-handler (operation &rest args)
"Invoke Tramp file name completion handler for OPERATION and ARGS.
Falls back to normal file name handler if no Tramp file name handler exists."
- (let ((fn (assoc operation tramp-completion-file-name-handler-alist)))
- (if (and fn tramp-mode)
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
+ (if-let
+ ((fn (and tramp-mode
+ (assoc operation tramp-completion-file-name-handler-alist))))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
;;;###autoload
(progn (defun tramp-autoload-file-name-handler (operation &rest args)
"Load Tramp file name handler, and perform OPERATION."
(tramp-unload-file-name-handlers)
- (if tramp-mode
- (let ((default-directory temporary-file-directory))
- (load "tramp" 'noerror 'nomessage)))
+ (when tramp-mode
+ ;; We cannot use `tramp-compat-temporary-file-directory' here due
+ ;; to autoload.
+ (let ((default-directory temporary-file-directory))
+ (load "tramp" 'noerror 'nomessage)))
(apply operation args)))
;; `tramp-autoload-file-name-handler' must be registered before
@@ -2448,7 +2473,7 @@ Falls back to normal file name handler if no Tramp file name handler exists."
(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)))
+ (put #'tramp-autoload-file-name-handler 'safe-magic t)))
;;;###autoload (tramp-register-autoload-file-name-handlers)
@@ -2484,34 +2509,36 @@ remote file names."
(tramp-unload-file-name-handlers)
;; Add the handlers. We do not add anything to the `operations'
- ;; property of `tramp-file-name-handler' and
- ;; `tramp-archive-file-name-handler', this shall be done by the
+ ;; property of `tramp-file-name-handler',
+ ;; `tramp-archive-file-name-handler' and
+ ;; `tramp-crypt-file-name-handler', this shall be done by the
;; respective foreign handlers.
(add-to-list 'file-name-handler-alist
(cons tramp-file-name-regexp #'tramp-file-name-handler))
- (put 'tramp-file-name-handler 'safe-magic t)
+ (put #'tramp-file-name-handler 'safe-magic t)
+
+ (tramp-register-crypt-file-name-handler)
(add-to-list 'file-name-handler-alist
(cons tramp-completion-file-name-regexp
#'tramp-completion-file-name-handler))
- (put 'tramp-completion-file-name-handler 'safe-magic t)
+ (put #'tramp-completion-file-name-handler 'safe-magic t)
;; Mark `operations' the handler is responsible for.
- (put 'tramp-completion-file-name-handler 'operations
+ (put #'tramp-completion-file-name-handler 'operations
(mapcar #'car tramp-completion-file-name-handler-alist))
(when (bound-and-true-p tramp-archive-enabled)
(add-to-list 'file-name-handler-alist
(cons tramp-archive-file-name-regexp
#'tramp-archive-file-name-handler))
- (put 'tramp-archive-file-name-handler 'safe-magic t))
+ (put #'tramp-archive-file-name-handler 'safe-magic t))
;; If jka-compr or epa-file are already loaded, move them to the
;; front of `file-name-handler-alist'.
(dolist (fnh '(epa-file-handler jka-compr-handler))
- (let ((entry (rassoc fnh file-name-handler-alist)))
- (when entry
- (setq file-name-handler-alist
- (cons entry (delete entry file-name-handler-alist)))))))
+ (when-let ((entry (rassoc fnh file-name-handler-alist)))
+ (setq file-name-handler-alist
+ (cons entry (delete entry file-name-handler-alist))))))
(tramp--with-startup (tramp-register-file-name-handlers))
@@ -2523,7 +2550,7 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'."
(add-to-list
'tramp-foreign-file-name-handler-alist `(,func . ,handler) append)
;; Mark `operations' the handler is responsible for.
- (put 'tramp-file-name-handler
+ (put #'tramp-file-name-handler
'operations
(delete-dups
(append
@@ -2564,24 +2591,11 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'."
;;; File name handler functions for completion mode:
-;;;###autoload
-(defvar tramp-completion-mode nil
- "If non-nil, external packages signal that they are in file name completion.")
-(make-obsolete-variable 'tramp-completion-mode 'non-essential "26.1")
-
-(defun tramp-completion-mode-p ()
- "Check, whether method / user name / host name completion is active."
- (or
- ;; Signal from outside.
- non-essential
- ;; This variable has been obsoleted in Emacs 26.
- tramp-completion-mode))
-
(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
not in completion mode."
- (let (tramp-verbose
+ (let ((tramp-verbose 0)
(vec
(cond
((tramp-file-name-p vec-or-filename) vec-or-filename)
@@ -2591,7 +2605,7 @@ not in completion mode."
;; `tramp-buffer-name'; otherwise `start-file-process'
;; wouldn't run ever when `non-essential' is non-nil.
(and vec (process-live-p (get-process (tramp-buffer-name vec))))
- (not (tramp-completion-mode-p)))))
+ (not non-essential))))
;; Method, host name and user name completion.
;; `tramp-completion-dissect-file-name' returns a list of
@@ -2882,7 +2896,7 @@ Either user or host may be nil."
(defun tramp-parse-rhosts-group ()
"Return a (user host) tuple allowed to access.
Either user or host may be nil."
- (let ((result)
+ (let (result
(regexp
(concat
"^\\(" tramp-host-regexp "\\)"
@@ -2932,7 +2946,7 @@ User is always nil."
"Return a list of (user host) tuples allowed to access.
User is always nil."
(tramp-parse-shostkeys-sknownhosts
- dirname (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$")))
+ dirname (concat "^key_[[:digit:]]+_\\(" tramp-host-regexp "\\)\\.pub$")))
(defun tramp-parse-sknownhosts (dirname)
"Return a list of (user host) tuples allowed to access.
@@ -2967,7 +2981,7 @@ Host is always \"localhost\"."
(defun tramp-parse-passwd-group ()
"Return a (user host) tuple allowed to access.
Host is always \"localhost\"."
- (let ((result)
+ (let (result
(regexp (concat "^\\(" tramp-user-regexp "\\):")))
(when (re-search-forward regexp (point-at-eol) t)
(setq result (list (match-string 1) "localhost")))
@@ -2989,7 +3003,7 @@ Host is always \"localhost\"."
(defun tramp-parse-etc-group-group ()
"Return a (group host) tuple allowed to access.
Host is always \"localhost\"."
- (let ((result)
+ (let (result
(split (split-string (buffer-substring (point) (point-at-eol)) ":")))
(when (member (user-login-name) (split-string (nth 3 split) "," 'omit))
(setq result (list (nth 0 split) "localhost")))
@@ -3026,7 +3040,7 @@ User is always nil."
(defun tramp-parse-putty-group (registry)
"Return a (user host) tuple allowed to access.
User is always nil."
- (let ((result)
+ (let (result
(regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
(when (re-search-forward regexp (point-at-eol) t)
(setq result (list nil (match-string 1))))
@@ -3205,12 +3219,13 @@ User is always nil."
(copy-file filename tmpfile 'ok-if-already-exists 'keep-time)
tmpfile)))
-(defun tramp-handle-file-modes (filename &optional _flag)
+(defun tramp-handle-file-modes (filename &optional flag)
"Like `file-modes' for Tramp files."
- ;; Starting with Emacs 25.1, `when-let' can be used.
- (let ((attrs (file-attributes (or (file-truename filename) filename))))
- (when attrs
- (tramp-mode-string-to-int (tramp-compat-file-attribute-modes attrs)))))
+ (when-let ((attrs (file-attributes filename))
+ (mode-string (tramp-compat-file-attribute-modes attrs)))
+ (if (and (not (eq flag 'nofollow)) (eq ?l (aref mode-string 0)))
+ (file-modes (file-truename filename))
+ (tramp-mode-string-to-int mode-string))))
;; Localname manipulation functions that grok Tramp localnames...
(defun tramp-handle-file-name-as-directory (file)
@@ -3248,12 +3263,13 @@ User is always nil."
(let ((candidate
(tramp-compat-file-name-unquote
(directory-file-name filename)))
+ case-fold-search
tmpfile)
;; Check, whether we find an existing file with
;; lower case letters. This avoids us to create a
;; temporary file.
(while (and (string-match-p
- "[a-z]" (tramp-file-local-name candidate))
+ "[[:lower:]]" (tramp-file-local-name candidate))
(not (file-exists-p candidate)))
(setq candidate
(directory-file-name
@@ -3262,8 +3278,8 @@ User is always nil."
;; for comparison. `make-nearby-temp-file' is added
;; to Emacs 26+ like `file-name-case-insensitive-p',
;; so there is no compatibility problem calling it.
- (unless
- (string-match-p "[a-z]" (tramp-file-local-name candidate))
+ (unless (string-match-p
+ "[[:lower:]]" (tramp-file-local-name candidate))
(setq tmpfile
(let ((default-directory
(file-name-directory filename)))
@@ -3328,21 +3344,18 @@ User is always nil."
(cond
((not (file-exists-p file1)) nil)
((not (file-exists-p file2)) t)
- (t (time-less-p (tramp-compat-file-attribute-modification-time
- (file-attributes file2))
- (tramp-compat-file-attribute-modification-time
- (file-attributes file1))))))
+ (t (time-less-p
+ (tramp-compat-file-attribute-modification-time (file-attributes file2))
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes file1))))))
(defun tramp-handle-file-regular-p (filename)
"Like `file-regular-p' for Tramp files."
(and (file-exists-p filename)
;; Sometimes, `file-attributes' does not return a proper value
;; even if `file-exists-p' does.
- (ignore-errors
- (eq ?-
- (aref
- (tramp-compat-file-attribute-modes (file-attributes filename))
- 0)))))
+ (when-let ((attr (file-attributes filename)))
+ (eq ?- (aref (tramp-compat-file-attribute-modes attr) 0)))))
(defun tramp-handle-file-remote-p (filename &optional identification connected)
"Like `file-remote-p' for Tramp files."
@@ -3381,8 +3394,7 @@ User is always nil."
"Like `file-truename' for Tramp files."
;; Preserve trailing "/".
(funcall
- (if (tramp-compat-directory-name-p filename)
- #'file-name-as-directory #'identity)
+ (if (directory-name-p filename) #'file-name-as-directory #'identity)
;; Quote properly.
(funcall
(if (tramp-compat-file-name-quoted-p filename)
@@ -3394,6 +3406,8 @@ User is always nil."
;; something is wrong; otherwise they might think that Emacs
;; is hung. Of course, correctness has to come first.
(numchase-limit 20)
+ ;; Unquoting could enable encryption.
+ tramp-crypt-enabled
symlink-target)
(with-parsed-tramp-file-name result v1
;; We cache only the localname.
@@ -3453,7 +3467,7 @@ User is always nil."
"Like `insert-directory' for Tramp files."
(unless switches (setq switches ""))
;; Mark trailing "/".
- (when (and (tramp-compat-directory-name-p filename)
+ (when (and (directory-name-p filename)
(not full-directory-p))
(setq switches (concat switches "F")))
;; Check, whether directory is accessible.
@@ -3463,7 +3477,7 @@ User is always nil."
(with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
(let (ls-lisp-use-insert-directory-program start)
;; Silence byte compiler.
- ls-lisp-use-insert-directory-program
+ (ignore ls-lisp-use-insert-directory-program)
(tramp-run-real-handler
#'insert-directory
(list filename switches wildcard full-directory-p))
@@ -3512,10 +3526,10 @@ User is always nil."
;; When we shall insert only a part of the file, we
;; copy this part. This works only for the shell file
- ;; name handlers.
+ ;; name handlers. It doesn't work for crypted files.
(when (and (or beg end)
- (tramp-get-method-parameter
- v 'tramp-login-program))
+ (tramp-sh-file-name-handler-p v)
+ (null tramp-crypt-enabled))
(setq remote-copy (tramp-make-tramp-temp-file v))
;; This is defined in tramp-sh.el. Let's assume
;; this is loaded already.
@@ -3587,8 +3601,8 @@ User is always nil."
;; Save exit.
(progn
(when visit
- (setq buffer-file-name filename)
- (setq buffer-read-only (not (file-writable-p filename)))
+ (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)
@@ -3622,7 +3636,8 @@ User is always nil."
v tramp-file-missing "Cannot load nonexistent file `%s'" file))
(if (not (file-exists-p file))
nil
- (let ((tramp-message-show-message (not nomessage)))
+ (let ((signal-hook-function (unless noerror signal-hook-function))
+ (inhibit-message (or inhibit-message nomessage)))
(with-tramp-progress-reporter v 0 (format "Loading %s" file)
(let ((local-copy (file-local-copy file)))
(unwind-protect
@@ -3630,6 +3645,222 @@ User is always nil."
(delete-file local-copy)))))
t)))
+(defun tramp-multi-hop-p (vec)
+ "Whether the method of VEC is capable of multi-hops."
+ (and (tramp-sh-file-name-handler-p vec)
+ (not (tramp-get-method-parameter vec 'tramp-copy-program))))
+
+(defun tramp-compute-multi-hops (vec)
+ "Expands VEC according to `tramp-default-proxies-alist'."
+ (let ((saved-tdpa tramp-default-proxies-alist)
+ (target-alist `(,vec))
+ (hops (or (tramp-file-name-hop vec) ""))
+ (item vec)
+ choices proxy)
+
+ ;; Ad-hoc proxy definitions.
+ (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit)))
+ (let* ((host-port (tramp-file-name-host-port item))
+ (user-domain (tramp-file-name-user-domain item))
+ (proxy (concat
+ tramp-prefix-format proxy tramp-postfix-host-format))
+ (entry
+ (list (and (stringp host-port)
+ (concat "^" (regexp-quote host-port) "$"))
+ (and (stringp user-domain)
+ (concat "^" (regexp-quote user-domain) "$"))
+ (propertize proxy 'tramp-ad-hoc t))))
+ (tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry)
+ ;; Add the hop.
+ (add-to-list 'tramp-default-proxies-alist entry)
+ (setq item (tramp-dissect-file-name proxy))))
+ ;; Save the new value.
+ (when (and hops tramp-save-ad-hoc-proxies)
+ (customize-save-variable
+ 'tramp-default-proxies-alist tramp-default-proxies-alist))
+
+ ;; Look for proxy hosts to be passed.
+ (setq choices tramp-default-proxies-alist)
+ (while choices
+ (setq item (pop choices)
+ proxy (eval (nth 2 item)))
+ (when (and
+ ;; Host.
+ (string-match-p
+ (or (eval (nth 0 item)) "")
+ (or (tramp-file-name-host-port (car target-alist)) ""))
+ ;; User.
+ (string-match-p
+ (or (eval (nth 1 item)) "")
+ (or (tramp-file-name-user-domain (car target-alist)) "")))
+ (if (null proxy)
+ ;; No more hops needed.
+ (setq choices nil)
+ ;; Replace placeholders.
+ (setq proxy
+ (format-spec
+ proxy
+ (format-spec-make
+ ?u (or (tramp-file-name-user (car target-alist)) "")
+ ?h (or (tramp-file-name-host (car target-alist)) ""))))
+ (with-parsed-tramp-file-name proxy l
+ ;; Add the hop.
+ (push l target-alist)
+ ;; Start next search.
+ (setq choices tramp-default-proxies-alist)))))
+
+ ;; Foreign and out-of-band methods are not supported for multi-hops.
+ (when (cdr target-alist)
+ (setq choices target-alist)
+ (while (setq item (pop choices))
+ (unless (tramp-multi-hop-p item)
+ (setq tramp-default-proxies-alist saved-tdpa)
+ (tramp-user-error
+ vec "Method `%s' is not supported for multi-hops."
+ (tramp-file-name-method item)))))
+
+ ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the
+ ;; host name in their command template. In this case, the remote
+ ;; file name must use either a local host name (first hop), or a
+ ;; host name matching the previous hop.
+ (let ((previous-host (or tramp-local-host-regexp "")))
+ (setq choices target-alist)
+ (while (setq item (pop choices))
+ (let ((host (tramp-file-name-host item)))
+ (unless
+ (or
+ ;; The host name is used for the remote shell command.
+ (member
+ '("%h") (tramp-get-method-parameter item 'tramp-login-args))
+ ;; The host name must match previous hop.
+ (string-match-p previous-host host))
+ (setq tramp-default-proxies-alist saved-tdpa)
+ (tramp-user-error
+ vec "Host name `%s' does not match `%s'" host previous-host))
+ (setq previous-host (concat "^" (regexp-quote host) "$")))))
+
+ ;; Result.
+ target-alist))
+
+(defun tramp-direct-async-process-p (&rest args)
+ "Whether direct async `make-process' can be called."
+ (let ((v (tramp-dissect-file-name default-directory))
+ (buffer (plist-get args :buffer))
+ (stderr (plist-get args :stderr)))
+ (and ;; It has been indicated.
+ (tramp-get-connection-property v "direct-async-process" nil)
+ ;; There's no multi-hop.
+ (or (not (tramp-multi-hop-p v))
+ (= (length (tramp-compute-multi-hops v)) 1))
+ ;; There's no remote stdout or stderr file.
+ (or (not (stringp buffer)) (not (tramp-tramp-file-p buffer)))
+ (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'."
+ (when args
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
+ (let ((default-directory (tramp-compat-temporary-file-directory))
+ (name (plist-get args :name))
+ (buffer (plist-get args :buffer))
+ (command (plist-get args :command))
+ (coding (plist-get args :coding))
+ (noquery (plist-get args :noquery))
+ (connection-type (plist-get args :connection-type))
+ (filter (plist-get args :filter))
+ (sentinel (plist-get args :sentinel))
+ (stderr (plist-get args :stderr)))
+ (unless (stringp name)
+ (signal 'wrong-type-argument (list #'stringp name)))
+ (unless (or (null buffer) (bufferp buffer) (stringp buffer))
+ (signal 'wrong-type-argument (list #'stringp buffer)))
+ (unless (consp command)
+ (signal 'wrong-type-argument (list #'consp command)))
+ (unless (or (null coding)
+ (and (symbolp coding) (memq coding coding-system-list))
+ (and (consp coding)
+ (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)))
+ (signal 'wrong-type-argument (list #'symbolp connection-type)))
+ (unless (or (null filter) (functionp filter))
+ (signal 'wrong-type-argument (list #'functionp filter)))
+ (unless (or (null sentinel) (functionp sentinel))
+ (signal 'wrong-type-argument (list #'functionp sentinel)))
+ (unless (or (null stderr) (bufferp stderr))
+ (signal 'wrong-type-argument (list #'stringp stderr)))
+
+ (let* ((buffer
+ (if buffer
+ (get-buffer-create buffer)
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (generate-new-buffer tramp-temp-buffer-name)))
+ (command
+ (mapconcat
+ #'identity (append `("cd" ,localname "&&") command) " ")))
+
+ ;; Check for `tramp-sh-file-name-handler', because something
+ ;; is different between tramp-adb.el and tramp-sh.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))
+ (direct-async-args
+ (tramp-get-method-parameter v 'tramp-direct-async-args))
+ ;; We don't create the temporary file. In fact, it
+ ;; is just a prefix for the ControlPath option of
+ ;; ssh; the real temporary file has another name, and
+ ;; it is created and protected by ssh. It is also
+ ;; removed by ssh when the connection is closed. The
+ ;; temporary file name is cached in the main
+ ;; connection process, therefore we cannot use
+ ;; `tramp-get-connection-process'.
+ (tmpfile
+ (when sh-file-name-handler-p
+ (with-tramp-connection-property
+ (tramp-get-process v) "temp-file"
+ (tramp-compat-make-temp-name))))
+ (options
+ (when sh-file-name-handler-p
+ (tramp-compat-funcall
+ 'tramp-ssh-controlmaster-options v)))
+ spec p)
+
+ ;; Replace `login-args' place holders.
+ (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 direct-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))
+ p (make-process
+ :name name :buffer buffer
+ :command (append `(,login-program) login-args `(,command))
+ :coding coding :noquery noquery :connection-type connection-type
+ :filter filter :sentinel sentinel :stderr stderr))
+
+ (tramp-message v 6 "%s" (string-join (process-command p) " "))
+ p))))))
+
(defun tramp-handle-make-symbolic-link
(target linkname &optional ok-if-already-exists)
"Like `make-symbolic-link' for Tramp files.
@@ -3664,9 +3895,12 @@ support symbolic links."
(setq current-buffer-p t)
(current-buffer))
(t (get-buffer-create
+ ;; These variables have been introduced with Emacs 28.1.
(if asynchronous
- "*Async Shell Command*"
- "*Shell Command Output*")))))
+ (or (bound-and-true-p shell-command-buffer-name-async)
+ "*Async Shell Command*")
+ (or (bound-and-true-p shell-command-buffer-name)
+ "*Shell Command Output*"))))))
(error-buffer
(cond
((bufferp error-buffer) error-buffer)
@@ -3800,7 +4034,8 @@ support symbolic links."
(defun tramp-handle-start-file-process (name buffer program &rest args)
"Like `start-file-process' for Tramp files.
BUFFER might be a list, in this case STDERR is separated."
- ;; `make-process' knows the `:file-handler' argument since Emacs 27.1 only.
+ ;; `make-process' knows the `:file-handler' argument since Emacs
+ ;; 27.1 only. Therefore, we invoke it via `tramp-file-name-handler'.
(tramp-file-name-handler
'make-process
:name name
@@ -3908,7 +4143,14 @@ of."
(tramp-error v 'file-already-exists filename))
(let ((tmpfile (tramp-compat-make-temp-file filename))
- (modes (save-excursion (tramp-default-file-modes filename))))
+ (modes (tramp-default-file-modes
+ filename (and (eq mustbenew 'excl) 'nofollow)))
+ (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))))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
;; The permissions of the temporary file should be set. If
@@ -3927,15 +4169,18 @@ of."
(error
(delete-file tmpfile)
(tramp-error
- v 'file-error "Couldn't write region to `%s'" filename))))
+ v 'file-error "Couldn't write region to `%s'" filename)))
- (tramp-flush-file-properties v localname)
+ (tramp-flush-file-properties v localname)
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
+ ;; Set file modification time.
+ (when (or (eq visit t) (stringp visit))
+ (set-visited-file-modtime
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))))
+
+ ;; Set the ownership.
+ (tramp-set-file-uid-gid filename uid gid))
;; The end.
(when (and (null noninteractive)
@@ -3989,7 +4234,7 @@ of."
"Call `file-notify-rm-watch'."
(unless (process-live-p proc)
(tramp-message proc 5 "Sentinel called: `%S' `%s'" proc event)
- (tramp-compat-funcall 'file-notify-rm-watch proc)))
+ (file-notify-rm-watch proc)))
;;; Functions for establishing connection:
@@ -4131,9 +4376,9 @@ See `tramp-process-actions' for the format of ACTIONS."
(while (tramp-accept-process-output proc 0))
(setq todo actions)
(while todo
- (setq item (pop todo))
- (setq pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item))))
- (setq action (nth 1 item))
+ (setq item (pop todo)
+ pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item)))
+ action (nth 1 item))
(tramp-message
vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
(when (tramp-check-for-regexp proc pattern)
@@ -4183,9 +4428,8 @@ performed successfully. Any other value means an error."
(catch 'tramp-action
(tramp-process-one-action proc vec actions)))))
(while (not exit)
- (setq exit
- (catch 'tramp-action
- (tramp-process-one-action proc vec actions)))))
+ (setq exit (catch 'tramp-action
+ (tramp-process-one-action proc vec actions)))))
(with-current-buffer (tramp-get-connection-buffer vec)
(widen)
(tramp-message vec 6 "\n%s" (buffer-string)))
@@ -4206,10 +4450,9 @@ performed successfully. Any other value means an error."
(tramp-get-connection-buffer vec)))
((eq exit 'process-died)
(substitute-command-keys
- (eval-when-compile
- (concat
- "Tramp failed to connect. If this happens repeatedly, try\n"
- " `\\[tramp-cleanup-this-connection]'"))))
+ (concat
+ "Tramp failed to connect. If this happens repeatedly, try\n"
+ " `\\[tramp-cleanup-this-connection]'")))
((eq exit 'timeout)
(format-message
"Timeout reached, see buffer `%s' for details"
@@ -4224,18 +4467,21 @@ performed successfully. Any other value means an error."
(defun tramp-accept-process-output (proc &optional timeout)
"Like `accept-process-output' for Tramp processes.
This is needed in order to hide `last-coding-system-used', which is set
-for process communication also."
+for process communication also.
+If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'."
(with-current-buffer (process-buffer proc)
(let ((inhibit-read-only t)
last-coding-system-used
result)
- ;; JUST-THIS-ONE is set due to Bug#12145.
- (tramp-message
- proc 10 "%s %s %s %s\n%s"
- proc timeout (process-status proc)
- (with-local-quit
- (setq result (accept-process-output proc timeout nil t)))
- (buffer-string))
+ ;; JUST-THIS-ONE is set due to Bug#12145. `with-local-quit'
+ ;; returns t in order to report success.
+ (if (with-local-quit
+ (setq result (accept-process-output proc timeout nil t)) t)
+ (tramp-message
+ proc 10 "%s %s %s %s\n%s"
+ proc timeout (process-status proc) result (buffer-string))
+ ;; Propagate quit.
+ (keyboard-quit))
result)))
(defun tramp-search-regexp (regexp)
@@ -4393,7 +4639,7 @@ If it doesn't exist, generate a new one."
(with-tramp-connection-property (tramp-get-connection-process vec) "device"
(cons -1 (setq tramp-devices (1+ tramp-devices)))))
-;; Comparision of vectors is performed by `tramp-file-name-equal-p'.
+;; Comparison of vectors is performed by `tramp-file-name-equal-p'.
(defun tramp-equal-remote (file1 file2)
"Check, whether the remote parts of FILE1 and FILE2 are identical.
The check depends on method, user and host name of the files. If
@@ -4503,9 +4749,9 @@ This is used to map a mode number to a permission string.")
(suid (> (logand (ash mode -9) 4) 0))
(sgid (> (logand (ash mode -9) 2) 0))
(sticky (> (logand (ash mode -9) 1) 0)))
- (setq user (tramp-file-mode-permissions user suid "s"))
- (setq group (tramp-file-mode-permissions group sgid "s"))
- (setq other (tramp-file-mode-permissions other sticky "t"))
+ (setq user (tramp-file-mode-permissions user suid "s")
+ group (tramp-file-mode-permissions group sgid "s")
+ other (tramp-file-mode-permissions other sticky "t"))
(concat type user group other)))
(defun tramp-file-mode-permissions (perm suid suid-text)
@@ -4535,16 +4781,15 @@ If FILENAME is remote, a file name handler is called."
(when (and modes (not (zerop (logand modes #o2000))))
(setq gid (tramp-compat-file-attribute-group-id (file-attributes dir)))))
- (let ((handler (find-file-name-handler filename 'tramp-set-file-uid-gid)))
- (if handler
- (funcall handler #'tramp-set-file-uid-gid filename uid gid)
- ;; On W32 systems, "chown" does not work.
- (unless (memq system-type '(ms-dos windows-nt))
- (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer)))
- (gid (or (and (natnump gid) gid) (tramp-get-local-gid 'integer))))
- (tramp-call-process
- nil "chown" nil nil nil (format "%d:%d" uid gid)
- (tramp-unquote-shell-quote-argument filename)))))))
+ (if-let ((handler (find-file-name-handler filename 'tramp-set-file-uid-gid)))
+ (funcall handler #'tramp-set-file-uid-gid filename uid gid)
+ ;; On W32 systems, "chown" does not work.
+ (unless (memq system-type '(ms-dos windows-nt))
+ (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer)))
+ (gid (or (and (natnump gid) gid) (tramp-get-local-gid 'integer))))
+ (tramp-call-process
+ nil "chown" nil nil nil (format "%d:%d" uid gid)
+ (tramp-unquote-shell-quote-argument filename))))))
(defun tramp-get-local-uid (id-format)
"The uid of the local user, in ID-FORMAT.
@@ -4610,12 +4855,8 @@ be granted."
(concat "file-attributes-" suffix) nil)
(file-attributes
(tramp-make-tramp-file-name vec) (intern suffix))))
- (remote-uid
- (tramp-get-connection-property
- vec (concat "uid-" suffix) nil))
- (remote-gid
- (tramp-get-connection-property
- vec (concat "gid-" suffix) nil))
+ (remote-uid (tramp-get-remote-uid vec (intern suffix)))
+ (remote-gid (tramp-get-remote-gid vec (intern suffix)))
(unknown-id
(if (string-equal suffix "string")
tramp-unknown-id-string tramp-unknown-id-integer)))
@@ -4649,6 +4890,32 @@ be granted."
(tramp-compat-file-attribute-group-id
file-attr))))))))))))
+(defun tramp-get-remote-uid (vec id-format)
+ "The uid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (with-tramp-connection-property vec (format "uid-%s" id-format)
+ (or (when-let
+ ((handler
+ (find-file-name-handler
+ (tramp-make-tramp-file-name vec) 'tramp-get-remote-uid)))
+ (funcall handler #'tramp-get-remote-uid vec id-format))
+ ;; Ensure there is a valid result.
+ (and (equal id-format 'integer) tramp-unknown-id-integer)
+ (and (equal id-format 'string) tramp-unknown-id-string))))
+
+(defun tramp-get-remote-gid (vec id-format)
+ "The gid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (with-tramp-connection-property vec (format "gid-%s" id-format)
+ (or (when-let
+ ((handler
+ (find-file-name-handler
+ (tramp-make-tramp-file-name vec) 'tramp-get-remote-uid)))
+ (funcall handler #'tramp-get-remote-gid vec id-format))
+ ;; Ensure there is a valid result.
+ (and (equal id-format 'integer) tramp-unknown-id-integer)
+ (and (equal id-format 'string) tramp-unknown-id-string))))
+
(defun tramp-local-host-p (vec)
"Return t if this points to the local host, nil otherwise.
This handles also chrooted environments, which are not regarded as local."
@@ -4662,16 +4929,16 @@ This handles also chrooted environments, which are not regarded as local."
;; The method shall be applied to one of the shell file name
;; handlers. `tramp-local-host-p' is also called for "smb" and
;; alike, where it must fail.
- (tramp-get-method-parameter vec 'tramp-login-program)
+ (tramp-sh-file-name-handler-p vec)
+ ;; Direct actions aren't possible for crypted directories.
+ (null tramp-crypt-enabled)
;; The local temp directory must be writable for the other user.
(file-writable-p
(tramp-make-tramp-file-name
vec (tramp-compat-temporary-file-directory) 'nohop))
;; On some systems, chown runs only for root.
(or (zerop (user-uid))
- ;; This is defined in tramp-sh.el. Let's assume this is
- ;; loaded already.
- (zerop (tramp-compat-funcall 'tramp-get-remote-uid vec 'integer))))))
+ (zerop (tramp-get-remote-uid vec 'integer))))))
(defun tramp-get-remote-tmpdir (vec)
"Return directory for temporary files on the remote host identified by VEC."
@@ -4684,18 +4951,21 @@ This handles also chrooted environments, which are not regarded as local."
(tramp-error vec 'file-error "Directory %s not accessible" dir))
dir)))
+(defun tramp-make-tramp-temp-name (vec)
+ "Generate a temporary file name on the remote host identified by VEC."
+ (make-temp-name
+ (expand-file-name tramp-temp-name-prefix (tramp-get-remote-tmpdir vec))))
+
(defun tramp-make-tramp-temp-file (vec)
"Create a temporary file on the remote host identified by VEC.
Return the local name of the temporary file."
- (let ((prefix (expand-file-name
- tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))
- result)
+ (let (result)
(while (not result)
;; `make-temp-file' would be the natural choice for
;; implementation. But it calls `write-region' internally,
;; which also needs a temporary file - we would end in an
;; infinite loop.
- (setq result (make-temp-name prefix))
+ (setq result (tramp-make-tramp-temp-name vec))
(if (file-exists-p result)
(setq result nil)
;; This creates the file by side effect.
@@ -4868,6 +5138,19 @@ verbosity of 6."
(tramp-message vec 6 "%s" result)
result))
+(defun tramp-process-running-p (process-name)
+ "Return t if system process PROCESS-NAME is running for `user-login-name'."
+ (when (stringp process-name)
+ (catch 'result
+ (dolist (pid (list-system-processes))
+ (when-let ((attributes (process-attributes pid))
+ (comm (cdr (assoc 'comm attributes))))
+ (and (string-equal (cdr (assoc 'user attributes)) (user-login-name))
+ ;; The returned command name could be truncated to 15
+ ;; characters. Therefore, we cannot check for `string-equal'.
+ (string-prefix-p comm process-name)
+ (throw 'result t)))))))
+
(defun tramp-read-passwd (proc &optional prompt)
"Read a password from user (compat function).
Consults the auth-source package.
@@ -5089,16 +5372,5 @@ name of a process or buffer, or nil to default to the current buffer."
;; and friends, for most of the handlers this is the major
;; difference between the different backends. Other handlers but
;; *-process-file would profit from this as well.
-;;
-;; * Get rid of `shell-command'. In its primary implementation, it
-;; uses `process-file-shell-command' and
-;; `start-file-process-shell-command', which is sufficient due to
-;; connection-local `shell-file-name'.
-
;;; tramp.el ends here
-
-;; Local Variables:
-;; mode: Emacs-Lisp
-;; coding: utf-8
-;; End:
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 4aed8abd9b3..8d21133b3b1 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -35,11 +35,8 @@
;; Emacs version check is defined in macro AC_EMACS_INFO of
;; aclocal.m4; should be changed only there.
-;; Needed for Emacs 24.
-(defvar inhibit-message)
-
;;;###tramp-autoload
-(defconst tramp-version "2.4.5-pre"
+(defconst tramp-version "2.5.0-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -73,9 +70,9 @@
"The repository revision of the Tramp sources.")
;; Check for Emacs version.
-(let ((x (if (not (string-lessp emacs-version "24.4"))
+(let ((x (if (not (string-lessp emacs-version "25.1"))
"ok"
- (format "Tramp 2.4.5-pre is not fit for %s"
+ (format "Tramp 2.5.0-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
@@ -104,8 +101,3 @@
(provide 'trampver)
;;; trampver.el ends here
-
-;; Local Variables:
-;; mode: Emacs-Lisp
-;; coding: utf-8
-;; End:
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index 6edd03c39cc..8bb156199c5 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -1,4 +1,4 @@
-;;; webjump.el --- programmable Web hotlist
+;;; webjump.el --- programmable Web hotlist -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1997, 2001-2020 Free Software Foundation, Inc.
@@ -323,8 +323,7 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke
(defun webjump-read-url-choice (what urls &optional default)
;; Note: Convert this to use `webjump-read-choice' someday.
- (let* ((completions (mapcar (function (lambda (n) (cons n n)))
- urls))
+ (let* ((completions (mapcar (lambda (n) (cons n n)) urls))
(input (completing-read (concat what
;;(if default " (RET for default)" "")
": ")
diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el
index bf16fb25cd0..b1448e72e86 100644
--- a/lisp/obsolete/complete.el
+++ b/lisp/obsolete/complete.el
@@ -431,6 +431,8 @@ of `minibuffer-completion-table' and the minibuffer contents.")
(let ((result (try-completion string alist predicate)))
(if (eq result t) string result)))
+(defvar completion-base-size)
+
;; TODO document MODE magic...
(defun PC-do-completion (&optional mode beg end goto-end)
"Internal function to do the work of partial completion.
diff --git a/lisp/obsolete/cust-print.el b/lisp/obsolete/cust-print.el
index fbf80692037..40532ea5b9d 100644
--- a/lisp/obsolete/cust-print.el
+++ b/lisp/obsolete/cust-print.el
@@ -156,10 +156,7 @@ If nil, printing proceeds recursively and may lead to
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.
-
-There is no way to read this representation in standard Emacs,
-but if you need to do so, try the cl-read.el package."
+where N is a positive decimal integer."
:type 'boolean
:group 'cust-print)
diff --git a/lisp/erc/erc-compat.el b/lisp/obsolete/erc-compat.el
index c77d5abf2e4..7ef30d822ff 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/obsolete/erc-compat.el
@@ -5,6 +5,7 @@
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
;; URL: https://www.emacswiki.org/emacs/ERC
+;; Obsolete-since: 28.1
;; This file is part of GNU Emacs.
@@ -43,12 +44,12 @@ Return the same string, if the encoding operation is trivial.
See `erc-encoding-coding-alist'."
(encode-coding-string s coding-system t))
-(defalias 'erc-propertize 'propertize)
-(defalias 'erc-view-mode-enter 'view-mode-enter)
+(define-obsolete-function-alias 'erc-propertize #'propertize "28.1")
+(define-obsolete-function-alias 'erc-view-mode-enter #'view-mode-enter "28.1")
(autoload 'help-function-arglist "help-fns")
-(defalias 'erc-function-arglist 'help-function-arglist)
-(defalias 'erc-delete-dups 'delete-dups)
-(defalias 'erc-replace-regexp-in-string 'replace-regexp-in-string)
+(define-obsolete-function-alias 'erc-function-arglist #'help-function-arglist "28.1")
+(define-obsolete-function-alias 'erc-delete-dups #'delete-dups "28.1")
+(define-obsolete-function-alias 'erc-replace-regexp-in-string #'replace-regexp-in-string "28.1")
(defun erc-set-write-file-functions (new-val)
(set (make-local-variable 'write-file-functions) new-val))
@@ -79,10 +80,12 @@ START is the beginning position of the last match (see `match-beginning').
See `replace-match' for explanations of FIXEDCASE and LITERAL."
(replace-match newtext fixedcase literal string subexp))
-(defalias 'erc-with-selected-window 'with-selected-window)
-(defalias 'erc-cancel-timer 'cancel-timer)
-(defalias 'erc-make-obsolete 'make-obsolete)
-(defalias 'erc-make-obsolete-variable 'make-obsolete-variable)
+(define-obsolete-function-alias 'erc-with-selected-window
+ #'with-selected-window "28.1")
+(define-obsolete-function-alias 'erc-cancel-timer #'cancel-timer "28.1")
+(define-obsolete-function-alias 'erc-make-obsolete #'make-obsolete "28.1")
+(define-obsolete-function-alias 'erc-make-obsolete-variable
+ #'make-obsolete-variable "28.1")
;; Provide a simpler replacement for `member-if'
(defun erc-member-if (predicate list)
diff --git a/lisp/obsolete/erc-hecomplete.el b/lisp/obsolete/erc-hecomplete.el
index 8f554282aed..cd26edeaa24 100644
--- a/lisp/obsolete/erc-hecomplete.el
+++ b/lisp/obsolete/erc-hecomplete.el
@@ -4,7 +4,7 @@
;; Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion
+;; URL: https://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion
;; Obsolete-since: 24.1
;; This file is part of GNU Emacs.
diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el
index 350eabdb0c1..96b063be701 100644
--- a/lisp/obsolete/iswitchb.el
+++ b/lisp/obsolete/iswitchb.el
@@ -1393,7 +1393,7 @@ Copied from `icomplete-tidy'."
"Move the summaries to the end of the list.
This is an example function which can be hooked on to
`iswitchb-make-buflist-hook'. Any buffer matching the regexps
-`Summary' or `output\*$'are put to the end of the list."
+`Summary' or `output\\*$'are put to the end of the list."
(let ((summaries (delq nil
(mapcar
(lambda (x)
diff --git a/lisp/obsolete/ledit.el b/lisp/obsolete/ledit.el
deleted file mode 100644
index c99a06de570..00000000000
--- a/lisp/obsolete/ledit.el
+++ /dev/null
@@ -1,157 +0,0 @@
-;;; ledit.el --- Emacs side of ledit interface
-
-;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
-
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: languages
-;; Obsolete-since: 24.3
-
-;; 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 is a major mode for editing Liszt.
-
-;;; Code:
-
-;;; To do:
-;;; o lisp -> emacs side of things (grind-definition and find-definition)
-
-(defvar ledit-mode-map nil)
-
-(defconst ledit-zap-file
- (expand-file-name (concat (user-login-name) ".l1") temporary-file-directory)
- "File name for data sent to Lisp by Ledit.")
-(defconst ledit-read-file
- (expand-file-name (concat (user-login-name) ".l2") temporary-file-directory)
- "File name for data sent to Ledit by Lisp.")
-(defconst ledit-compile-file
- (expand-file-name (concat (user-login-name) ".l4") temporary-file-directory)
- "File name for data sent to Lisp compiler by Ledit.")
-(defconst ledit-buffer "*LEDIT*"
- "Name of buffer in which Ledit accumulates data to send to Lisp.")
-
-;;;###autoload
-(defconst ledit-save-files t "\
-*Non-nil means Ledit should save files before transferring to Lisp.")
-;;;###autoload
-(defconst ledit-go-to-lisp-string "%?lisp" "\
-*Shell commands to execute to resume Lisp job.")
-;;;###autoload
-(defconst ledit-go-to-liszt-string "%?liszt" "\
-*Shell commands to execute to resume Lisp compiler job.")
-
-(defun ledit-save-defun ()
- "Save the current defun in the ledit buffer."
- (interactive)
- (save-excursion
- (end-of-defun)
- (let ((end (point)))
- (beginning-of-defun)
- (append-to-buffer ledit-buffer (point) end))
- (message "Current defun saved for Lisp")))
-
-(defun ledit-save-region (beg end)
- "Save the current region in the ledit buffer"
- (interactive "r")
- (append-to-buffer ledit-buffer beg end)
- (message "Region saved for Lisp"))
-
-(defun ledit-zap-defun-to-lisp ()
- "Carry the current defun to Lisp."
- (interactive)
- (ledit-save-defun)
- (ledit-go-to-lisp))
-
-(defun ledit-zap-defun-to-liszt ()
- "Carry the current defun to liszt."
- (interactive)
- (ledit-save-defun)
- (ledit-go-to-liszt))
-
-(defun ledit-zap-region-to-lisp (beg end)
- "Carry the current region to Lisp."
- (interactive "r")
- (ledit-save-region beg end)
- (ledit-go-to-lisp))
-
-(defun ledit-go-to-lisp ()
- "Suspend Emacs and restart a waiting Lisp job."
- (interactive)
- (if ledit-save-files
- (save-some-buffers))
- (if (get-buffer ledit-buffer)
- (with-current-buffer ledit-buffer
- (goto-char (point-min))
- (write-region (point-min) (point-max) ledit-zap-file)
- (erase-buffer)))
- (suspend-emacs ledit-go-to-lisp-string)
- (load ledit-read-file t t))
-
-(defun ledit-go-to-liszt ()
- "Suspend Emacs and restart a waiting Liszt job."
- (interactive)
- (if ledit-save-files
- (save-some-buffers))
- (if (get-buffer ledit-buffer)
- (with-current-buffer ledit-buffer
- (goto-char (point-min))
- (insert "(declare (macros t))\n")
- (write-region (point-min) (point-max) ledit-compile-file)
- (erase-buffer)))
- (suspend-emacs ledit-go-to-liszt-string)
- (load ledit-read-file t t))
-
-(defun ledit-setup ()
- "Set up key bindings for the Lisp/Emacs interface."
- (unless ledit-mode-map
- (setq ledit-mode-map (make-sparse-keymap))
- (set-keymap-parent ledit-mode-map lisp-mode-shared-map))
- (define-key ledit-mode-map "\e\^d" 'ledit-save-defun)
- (define-key ledit-mode-map "\e\^r" 'ledit-save-region)
- (define-key ledit-mode-map "\^xz" 'ledit-go-to-lisp)
- (define-key ledit-mode-map "\e\^c" 'ledit-go-to-liszt))
-
-(ledit-setup)
-
-;;;###autoload
-(defun ledit-mode ()
- "\\<ledit-mode-map>Major mode for editing text and stuffing it to a Lisp job.
-Like Lisp mode, plus these special commands:
- \\[ledit-save-defun] -- record defun at or after point
- for later transmission to Lisp job.
- \\[ledit-save-region] -- record region for later transmission to Lisp job.
- \\[ledit-go-to-lisp] -- transfer to Lisp job and transmit saved text.
- \\[ledit-go-to-liszt] -- transfer to Liszt (Lisp compiler) job
- and transmit saved text.
-
-\\{ledit-mode-map}
-To make Lisp mode automatically change to Ledit mode,
-do (setq lisp-mode-hook 'ledit-from-lisp-mode)"
- (interactive)
- (delay-mode-hooks (lisp-mode))
- (ledit-from-lisp-mode))
-
-;;;###autoload
-(defun ledit-from-lisp-mode ()
- (use-local-map ledit-mode-map)
- (setq mode-name "Ledit")
- (setq major-mode 'ledit-mode)
- (run-mode-hooks 'ledit-mode-hook))
-
-(provide 'ledit)
-
-;;; ledit.el ends here
diff --git a/lisp/obsolete/levents.el b/lisp/obsolete/levents.el
deleted file mode 100644
index 2ae1ca48d16..00000000000
--- a/lisp/obsolete/levents.el
+++ /dev/null
@@ -1,292 +0,0 @@
-;;; levents.el --- emulate the Lucid event data type and associated functions
-
-;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
-
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: emulations
-;; Obsolete-since: 23.2
-
-;; 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:
-
-;; Things we cannot emulate in Lisp:
-;; It is not possible to emulate current-mouse-event as a variable,
-;; though it is not hard to obtain the data from (this-command-keys).
-
-;; We do not have a variable unread-command-event;
-;; instead, we have the more general unread-command-events.
-
-;; Our read-key-sequence and read-char are not precisely
-;; compatible with those in Lucid Emacs, but they should work ok.
-
-;;; Code:
-
-(defun next-command-event (event)
- (error "You must rewrite to use `read-command-event' instead of `next-command-event'"))
-
-(defun next-event (event)
- (error "You must rewrite to use `read-event' instead of `next-event'"))
-
-(defun dispatch-event (event)
- (error "`dispatch-event' not supported"))
-
-;; Make events of type eval, menu and timeout
-;; execute properly.
-
-(define-key global-map [menu] 'execute-eval-event)
-(define-key global-map [timeout] 'execute-eval-event)
-(define-key global-map [eval] 'execute-eval-event)
-
-(defun execute-eval-event (event)
- (interactive "e")
- (funcall (nth 1 event) (nth 2 event)))
-
-(put 'eval 'event-symbol-elements '(eval))
-(put 'menu 'event-symbol-elements '(eval))
-(put 'timeout 'event-symbol-elements '(eval))
-
-(defun allocate-event ()
- "Return an empty event structure.
-In this emulation, it returns nil."
- nil)
-
-(defun button-press-event-p (obj)
- "True if the argument is a mouse-button-press event object."
- (and (consp obj) (symbolp (car obj))
- (memq 'down (get (car obj) 'event-symbol-elements))))
-
-(defun button-release-event-p (obj)
- "True if the argument is a mouse-button-release event object."
- (and (consp obj) (symbolp (car obj))
- (or (memq 'click (get (car obj) 'event-symbol-elements))
- (memq 'drag (get (car obj) 'event-symbol-elements)))))
-
-(defun button-event-p (obj)
- "True if the argument is a mouse-button press or release event object."
- (and (consp obj) (symbolp (car obj))
- (or (memq 'click (get (car obj) 'event-symbol-elements))
- (memq 'down (get (car obj) 'event-symbol-elements))
- (memq 'drag (get (car obj) 'event-symbol-elements)))))
-
-(defun mouse-event-p (obj)
- "True if the argument is a mouse-button press or release event object."
- (and (consp obj) (symbolp (car obj))
- (or (eq (car obj) 'mouse-movement)
- (memq 'click (get (car obj) 'event-symbol-elements))
- (memq 'down (get (car obj) 'event-symbol-elements))
- (memq 'drag (get (car obj) 'event-symbol-elements)))))
-
-(defun character-to-event (ch &optional event)
- "Converts a numeric ASCII value to an event structure, replete with
-bucky bits. The character is the first argument, and the event to fill
-in is the second. This function contains knowledge about what the codes
-mean -- for example, the number 9 is converted to the character Tab,
-not the distinct character Control-I.
-
-Beware that character-to-event and event-to-character are not strictly
-inverse functions, since events contain much more information than the
-ASCII character set can encode."
- ch)
-
-(defun copy-event (event1 &optional event2)
- "Make a copy of the given event object.
-In this emulation, `copy-event' just returns its argument."
- event1)
-
-(defun deallocate-event (event)
- "Allow the given event structure to be reused.
-In actual Lucid Emacs, you MUST NOT use this event object after
-calling this function with it. You will lose. It is not necessary to
-call this function, as event objects are garbage- collected like all
-other objects; however, it may be more efficient to explicitly
-deallocate events when you are sure that this is safe.
-
-This emulation does not actually deallocate or reuse events
-except via garbage collection and `cons'."
- nil)
-
-(defun enqueue-eval-event: (function object)
- "Add an eval event to the back of the queue.
-It will be the next event read after all pending events."
- (setq unread-command-events
- (nconc unread-command-events
- (list (list 'eval function object)))))
-
-(defun eval-event-p (obj)
- "True if the argument is an eval or menu event object."
- (eq (car-safe obj) 'eval))
-
-(defun event-button (event)
- "Return the button-number of the given mouse-button-press event."
- (let ((sym (car (get (car event) 'event-symbol-elements))))
- (cdr (assq sym '((mouse-1 . 1) (mouse-2 . 2) (mouse-3 . 3)
- (mouse-4 . 4) (mouse-5 . 5))))))
-
-(defun event-function (event)
- "Return the callback function of the given timeout, menu, or eval event."
- (nth 1 event))
-
-(defun event-key (event)
- "Return the KeySym of the given key-press event.
-The value is an ASCII printing character (not upper case) or a symbol."
- (if (symbolp event)
- (car (get event 'event-symbol-elements))
- (let ((base (logand event (1- (ash 1 18)))))
- (downcase (if (< base 32) (logior base 64) base)))))
-
-(defun event-object (event)
- "Return the function argument of the given timeout, menu, or eval event."
- (nth 2 event))
-
-(defun event-point (event)
- "Return the character position of the given mouse-related event.
-If the event did not occur over a window, or did
-not occur over text, then this returns nil. Otherwise, it returns an index
-into the buffer visible in the event's window."
- (posn-point (event-end event)))
-
-;; Return position of start of line LINE in WINDOW.
-;; If LINE is nil, return the last position
-;; visible in WINDOW.
-(defun event-closest-point-1 (window &optional line)
- (let* ((total (- (window-height window)
- (if (window-minibuffer-p window)
- 0 1)))
- (distance (or line total)))
- (save-excursion
- (goto-char (window-start window))
- (if (= (vertical-motion distance) distance)
- (if (not line)
- (forward-char -1)))
- (point))))
-
-(defun event-closest-point (event &optional start-window)
- "Return the nearest position to where EVENT ended its motion.
-This is computed for the window where EVENT's motion started,
-or for window WINDOW if that is specified."
- (or start-window (setq start-window (posn-window (event-start event))))
- (if (eq start-window (posn-window (event-end event)))
- (if (eq (event-point event) 'vertical-line)
- (event-closest-point-1 start-window
- (cdr (posn-col-row (event-end event))))
- (if (eq (event-point event) 'mode-line)
- (event-closest-point-1 start-window)
- (event-point event)))
- ;; EVENT ended in some other window.
- (let* ((end-w (posn-window (event-end event)))
- (end-w-top)
- (w-top (nth 1 (window-edges start-window))))
- (setq end-w-top
- (if (windowp end-w)
- (nth 1 (window-edges end-w))
- (/ (cdr (posn-x-y (event-end event)))
- (frame-char-height end-w))))
- (if (>= end-w-top w-top)
- (event-closest-point-1 start-window)
- (window-start start-window)))))
-
-(defun event-process (event)
- "Return the process of the given process-output event."
- (nth 1 event))
-
-(defun event-timestamp (event)
- "Return the timestamp of the given event object.
-In Lucid Emacs, this works for any kind of event.
-In this emulation, it returns nil for non-mouse-related events."
- (and (listp event)
- (posn-timestamp (event-end event))))
-
-(defun event-to-character (event &optional lenient)
- "Return the closest ASCII approximation to the given event object.
-If the event isn't a keypress, this returns nil.
-If the second argument is non-nil, then this is lenient in its
-translation; it will ignore modifier keys other than control and meta,
-and will ignore the shift modifier on those characters which have no
-shifted ASCII equivalent (Control-Shift-A for example, will be mapped to
-the same ASCII code as Control-A.) If the second arg is nil, then nil
-will be returned for events which have no direct ASCII equivalent."
- (if (symbolp event)
- (and lenient
- (cdr (assq event '((backspace . 8) (delete . 127) (tab . 9)
- (return . 10) (enter . 10)))))
- ;; Our interpretation is, ASCII means anything a number can represent.
- (if (integerp event)
- event nil)))
-
-(defun event-window (event)
- "Return the window of the given mouse-related event object."
- (posn-window (event-end event)))
-
-(defun event-x (event)
- "Return the X position in characters of the given mouse-related event."
- (/ (car (posn-col-row (event-end event)))
- (frame-char-width (window-frame (event-window event)))))
-
-(defun event-x-pixel (event)
- "Return the X position in pixels of the given mouse-related event."
- (car (posn-col-row (event-end event))))
-
-(defun event-y (event)
- "Return the Y position in characters of the given mouse-related event."
- (/ (cdr (posn-col-row (event-end event)))
- (frame-char-height (window-frame (event-window event)))))
-
-(defun event-y-pixel (event)
- "Return the Y position in pixels of the given mouse-related event."
- (cdr (posn-col-row (event-end event))))
-
-(defun key-press-event-p (obj)
- "True if the argument is a keyboard event object."
- (or (integerp obj)
- (and (symbolp obj)
- (get obj 'event-symbol-elements))))
-
-(defun menu-event-p (obj)
- "True if the argument is a menu event object."
- (eq (car-safe obj) 'menu))
-
-(defun motion-event-p (obj)
- "True if the argument is a mouse-motion event object."
- (eq (car-safe obj) 'mouse-movement))
-
-(defun read-command-event ()
- "Return the next keyboard or mouse event; execute other events.
-This is similar to the function `next-command-event' of Lucid Emacs,
-but different in that it returns the event rather than filling in
-an existing event object."
- (let (event)
- (while (progn
- (setq event (read-event))
- (not (or (key-press-event-p event)
- (button-press-event-p event)
- (button-release-event-p event)
- (menu-event-p event))))
- (let ((type (car-safe event)))
- (cond ((eq type 'eval)
- (funcall (nth 1 event) (nth 2 event)))
- ((eq type 'switch-frame)
- (select-frame (nth 1 event))))))
- event))
-
-(defun process-event-p (obj)
- "True if the argument is a process-output event object.
-GNU Emacs 19 does not currently generate process-output events."
- (eq (car-safe obj) 'process))
-
-(provide 'levents)
-
-;;; levents.el ends here
diff --git a/lisp/obsolete/lmenu.el b/lisp/obsolete/lmenu.el
deleted file mode 100644
index 678481924b2..00000000000
--- a/lisp/obsolete/lmenu.el
+++ /dev/null
@@ -1,445 +0,0 @@
-;;; lmenu.el --- emulate Lucid's menubar support
-
-;; Copyright (C) 1992-1994, 1997, 2001-2020 Free Software Foundation,
-;; Inc.
-
-;; Keywords: emulations obsolete
-;; Obsolete-since: 23.3
-
-;; 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 has been obsolete since Emacs 23.3.
-
-;;; Code:
-
-
-;; First, emulate the Lucid menubar support in GNU Emacs 19.
-
-;; Arrange to use current-menubar to set up part of the menu bar.
-
-(defvar current-menubar)
-(defvar lucid-menubar-map)
-(defvar lucid-failing-menubar)
-
-(defvar recompute-lucid-menubar 'recompute-lucid-menubar)
-(defun recompute-lucid-menubar ()
- (define-key lucid-menubar-map [menu-bar]
- (condition-case nil
- (make-lucid-menu-keymap "menu-bar" current-menubar)
- (error (message "Invalid data in current-menubar moved to lucid-failing-menubar")
- (sit-for 1)
- (setq lucid-failing-menubar current-menubar
- current-menubar nil))))
- (setq lucid-menu-bar-dirty-flag nil))
-
-(defvar lucid-menubar-map (make-sparse-keymap))
-(or (assq 'current-menubar minor-mode-map-alist)
- (setq minor-mode-map-alist
- (cons (cons 'current-menubar lucid-menubar-map)
- minor-mode-map-alist)))
-
-;; XEmacs compatibility
-(defun set-menubar-dirty-flag ()
- (force-mode-line-update)
- (setq lucid-menu-bar-dirty-flag t))
-
-(defvar add-menu-item-count 0)
-
-;; This is a variable whose value is always nil.
-(defvar make-lucid-menu-keymap-disable nil)
-
-;; Return a menu keymap corresponding to a Lucid-style menu list
-;; MENU-ITEMS, and with name MENU-NAME.
-(defun make-lucid-menu-keymap (menu-name menu-items)
- (let ((menu (make-sparse-keymap menu-name)))
- ;; Process items in reverse order,
- ;; since the define-key loop reverses them again.
- (setq menu-items (reverse menu-items))
- (while menu-items
- (let ((item (car menu-items))
- command name callback)
- (cond ((stringp item)
- (setq command nil)
- (setq name (if (string-match "^-+$" item) "" item)))
- ((consp item)
- (setq command (make-lucid-menu-keymap (car item) (cdr item)))
- (setq name (car item)))
- ((vectorp item)
- (setq command (make-symbol (format "menu-function-%d"
- add-menu-item-count))
- add-menu-item-count (1+ add-menu-item-count)
- name (aref item 0)
- callback (aref item 1))
- (if (symbolp callback)
- (fset command callback)
- (fset command (list 'lambda () '(interactive) callback)))
- (put command 'menu-alias t)
- (let ((i 2))
- (while (< i (length item))
- (cond
- ((eq (aref item i) ':active)
- (put command 'menu-enable
- (or (aref item (1+ i))
- 'make-lucid-menu-keymap-disable))
- (setq i (+ 2 i)))
- ((eq (aref item i) ':suffix)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((eq (aref item i) ':keys)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((eq (aref item i) ':style)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((eq (aref item i) ':selected)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((and (symbolp (aref item i))
- (= ?: (string-to-char (symbol-name (aref item i)))))
- (error "Unrecognized menu item keyword: %S"
- (aref item i)))
- ((= i 2)
- ;; old-style format: active-p &optional suffix
- (put command 'menu-enable
- (or (aref item i) 'make-lucid-menu-keymap-disable))
- ;; suffix is unimplemented
- (setq i (length item)))
- (t
- (error "Unexpected menu item value: %S"
- (aref item i))))))))
- (if (null command)
- ;; Handle inactive strings specially--allow any number
- ;; of identical ones.
- (setcdr menu (cons (list nil name) (cdr menu)))
- (if name
- (define-key menu (vector (intern name)) (cons name command)))))
- (setq menu-items (cdr menu-items)))
- menu))
-
-(declare-function x-popup-dialog "menu.c" (position contents &optional header))
-
-;; XEmacs compatibility function
-(defun popup-dialog-box (data)
- "Pop up a dialog box.
-A dialog box description is a list.
-
- - The first element of the list is a string to display in the dialog box.
- - The rest of the elements are descriptions of the dialog box's buttons.
- Each one is a vector of three elements:
- - The first element is the text of the button.
- - The second element is the `callback'.
- - The third element is t or nil, whether this button is selectable.
-
-If the `callback' of a button is a symbol, then it must name a command.
-It will be invoked with `call-interactively'. If it is a list, then it is
-evaluated with `eval'.
-
-One (and only one) of the buttons may be nil. This marker means that all
-following buttons should be flushright instead of flushleft.
-
-The syntax, more precisely:
-
- form := <something to pass to `eval'>
- command := <a symbol or string, to pass to `call-interactively'>
- callback := command | form
- active-p := <t, nil, or a form to evaluate to decide whether this
- button should be selectable>
- name := <string>
- partition := `nil'
- button := `[' name callback active-p `]'
- dialog := `(' name [ button ]+ [ partition [ button ]+ ] `)'"
- (let ((name (car data))
- (tail (cdr data))
- converted
- choice meaning)
- (while tail
- (if (null (car tail))
- (setq converted (cons nil converted))
- (let ((item (aref (car tail) 0))
- (callback (aref (car tail) 1))
- (enable (aref (car tail) 2)))
- (setq converted
- (cons (if enable (cons item callback) item)
- converted))))
- (setq tail (cdr tail)))
- (setq choice (x-popup-dialog t (cons name (nreverse converted))))
- (if choice
- (if (symbolp choice)
- (call-interactively choice)
- (eval choice)))))
-
-;; This is empty because the usual elements of the menu bar
-;; are provided by menu-bar.el instead.
-;; It would not make sense to duplicate them here.
-(defconst default-menubar nil)
-
-;; XEmacs compatibility
-(defun set-menubar (menubar)
- "Set the default menubar to be menubar."
- (setq-default current-menubar (copy-sequence menubar))
- (set-menubar-dirty-flag))
-
-;; XEmacs compatibility
-(defun set-buffer-menubar (menubar)
- "Set the buffer-local menubar to be menubar."
- (make-local-variable 'current-menubar)
- (setq current-menubar (copy-sequence menubar))
- (set-menubar-dirty-flag))
-
-
-;;; menu manipulation functions
-
-;; XEmacs compatibility
-(defun find-menu-item (menubar item-path-list &optional parent)
- "Searches MENUBAR for item given by ITEM-PATH-LIST.
-Returns (ITEM . PARENT), where PARENT is the immediate parent of
- the item found.
-Signals an error if the item is not found."
- (or parent (setq item-path-list (mapcar 'downcase item-path-list)))
- (if (not (consp menubar))
- nil
- (let ((rest menubar)
- result)
- (while rest
- (if (and (car rest)
- (equal (car item-path-list)
- (downcase (if (vectorp (car rest))
- (aref (car rest) 0)
- (if (stringp (car rest))
- (car rest)
- (car (car rest)))))))
- (setq result (car rest) rest nil)
- (setq rest (cdr rest))))
- (if (cdr item-path-list)
- (if (consp result)
- (find-menu-item (cdr result) (cdr item-path-list) result)
- (if result
- (signal 'error (list "not a submenu" result))
- (signal 'error (list "no such submenu" (car item-path-list)))))
- (cons result parent)))))
-
-
-;; XEmacs compatibility
-(defun disable-menu-item (path)
- "Make the named menu item be unselectable.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (cdr pair)))
- (or item
- (signal 'error (list (if menu "No such menu item" "No such menu")
- path)))
- (if (consp item) (error "can't disable menus, only menu items"))
- (aset item 2 nil)
- (set-menubar-dirty-flag)
- item))
-
-
-;; XEmacs compatibility
-(defun enable-menu-item (path)
- "Make the named menu item be selectable.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (cdr pair)))
- (or item
- (signal 'error (list (if menu "No such menu item" "No such menu")
- path)))
- (if (consp item) (error "%S is a menu, not a menu item" path))
- (aset item 2 t)
- (set-menubar-dirty-flag)
- item))
-
-
-(defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before)
- (if before (setq before (downcase before)))
- (let* ((menubar current-menubar)
- (menu (condition-case ()
- (car (find-menu-item menubar menu-path))
- (error nil)))
- (item (if (listp menu)
- (car (find-menu-item (cdr menu) (list item-name)))
- (signal 'error (list "not a submenu" menu-path)))))
- (or menu
- (let ((rest menu-path)
- (so-far menubar))
- (while rest
-;;; (setq menu (car (find-menu-item (cdr so-far) (list (car rest)))))
- (setq menu
- (if (eq so-far menubar)
- (car (find-menu-item so-far (list (car rest))))
- (car (find-menu-item (cdr so-far) (list (car rest))))))
- (or menu
- (let ((rest2 so-far))
- (or rest2
- (error "Trying to modify a menu that doesn't exist"))
- (while (and (cdr rest2) (car (cdr rest2)))
- (setq rest2 (cdr rest2)))
- (setcdr rest2
- (nconc (list (setq menu (list (car rest))))
- (cdr rest2)))))
- (setq so-far menu)
- (setq rest (cdr rest)))))
- (or menu (setq menu menubar))
- (if item
- nil ; it's already there
- (if item-p
- (setq item (vector item-name item-data enabled-p))
- (setq item (cons item-name item-data)))
- ;; if BEFORE is specified, try to add it there.
- (if before
- (setq before (car (find-menu-item menu (list before)))))
- (let ((rest menu)
- (added-before nil))
- (while rest
- (if (eq before (car (cdr rest)))
- (progn
- (setcdr rest (cons item (cdr rest)))
- (setq rest nil added-before t))
- (setq rest (cdr rest))))
- (if (not added-before)
- ;; adding before the first item on the menubar itself is harder
- (if (and (eq menu menubar) (eq before (car menu)))
- (setq menu (cons item menu)
- current-menubar menu)
- ;; otherwise, add the item to the end.
- (nconc menu (list item))))))
- (if item-p
- (progn
- (aset item 1 item-data)
- (aset item 2 (not (null enabled-p))))
- (setcar item item-name)
- (setcdr item item-data))
- (set-menubar-dirty-flag)
- item))
-
-;; XEmacs compatibility
-(defun add-menu-item (menu-path item-name function enabled-p &optional before)
- "Add a menu item to some menu, creating the menu first if necessary.
-If the named item exists already, it is changed.
-MENU-PATH identifies the menu under which the new menu item should be inserted.
- It is a list of strings; for example, (\"File\") names the top-level \"File\"
- menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
-ITEM-NAME is the string naming the menu item to be added.
-FUNCTION is the command to invoke when this menu item is selected.
- If it is a symbol, then it is invoked with `call-interactively', in the same
- way that functions bound to keys are invoked. If it is a list, then the
- list is simply evaluated.
-ENABLED-P controls whether the item is selectable or not.
-BEFORE, if provided, is the name of a menu item before which this item should
- be added, if this item is not on the menu already. If the item is already
- present, it will not be moved."
- (or menu-path (error "must specify a menu path"))
- (or item-name (error "must specify an item name"))
- (add-menu-item-1 t menu-path item-name function enabled-p before))
-
-
-;; XEmacs compatibility
-(defun delete-menu-item (path)
- "Remove the named menu item from the menu hierarchy.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (or (cdr pair) menubar)))
- (if (not item)
- nil
- ;; the menubar is the only special case, because other menus begin
- ;; with their name.
- (if (eq menu current-menubar)
- (setq current-menubar (delq item menu))
- (delq item menu))
- (set-menubar-dirty-flag)
- item)))
-
-
-;; XEmacs compatibility
-(defun relabel-menu-item (path new-name)
- "Change the string of the specified menu item.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\".
-NEW-NAME is the string that the menu item will be printed as from now on."
- (or (stringp new-name)
- (setq new-name (signal 'wrong-type-argument (list 'stringp new-name))))
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (cdr pair)))
- (or item
- (signal 'error (list (if menu "No such menu item" "No such menu")
- path)))
- (if (and (consp item)
- (stringp (car item)))
- (setcar item new-name)
- (aset item 0 new-name))
- (set-menubar-dirty-flag)
- item))
-
-;; XEmacs compatibility
-(defun add-menu (menu-path menu-name menu-items &optional before)
- "Add a menu to the menubar or one of its submenus.
-If the named menu exists already, it is changed.
-MENU-PATH identifies the menu under which the new menu should be inserted.
- It is a list of strings; for example, (\"File\") names the top-level \"File\"
- menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
- If MENU-PATH is nil, then the menu will be added to the menubar itself.
-MENU-NAME is the string naming the menu to be added.
-MENU-ITEMS is a list of menu item descriptions.
- Each menu item should be a vector of three elements:
- - a string, the name of the menu item;
- - a symbol naming a command, or a form to evaluate;
- - and a form whose value determines whether this item is selectable.
-BEFORE, if provided, is the name of a menu before which this menu should
- be added, if this menu is not on its parent already. If the menu is already
- present, it will not be moved."
- (or menu-name (error "must specify a menu name"))
- (or menu-items (error "must specify some menu items"))
- (add-menu-item-1 nil menu-path menu-name menu-items t before))
-
-
-
-(defvar put-buffer-names-in-file-menu t)
-
-
-;; Don't unconditionally enable menu bars; leave that up to the user.
-;;(let ((frames (frame-list)))
-;; (while frames
-;; (modify-frame-parameters (car frames) '((menu-bar-lines . 1)))
-;; (setq frames (cdr frames))))
-;;(or (assq 'menu-bar-lines default-frame-alist)
-;; (setq default-frame-alist
-;; (cons '(menu-bar-lines . 1) default-frame-alist)))
-
-(set-menubar default-menubar)
-
-(provide 'lmenu)
-
-;;; lmenu.el ends here
diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el
index 2fba49f402d..cbe453aa6bf 100644
--- a/lisp/obsolete/longlines.el
+++ b/lisp/obsolete/longlines.el
@@ -37,6 +37,7 @@
;; Special thanks to Rod Smith for many useful bug reports.
;;; Code:
+;;; Options
(defgroup longlines nil
"Automatic wrapping of long lines when loading files."
@@ -76,7 +77,7 @@ This is used when `longlines-show-hard-newlines' is on."
:group 'longlines
:type 'string)
-;; Internal variables
+;;; Internal variables
(defvar longlines-wrap-beg nil)
(defvar longlines-wrap-end nil)
@@ -90,7 +91,7 @@ This is used when `longlines-show-hard-newlines' is on."
(make-variable-buffer-local 'longlines-showing)
(make-variable-buffer-local 'longlines-decoded)
-;; Mode
+;;; Mode
(defvar message-indent-citation-function)
@@ -210,7 +211,7 @@ This function exists to be called by `change-major-mode-hook' when the
major mode changes."
(longlines-mode 0))
-;; Showing the effect of hard newlines in the buffer
+;;; Showing the effect of hard newlines in the buffer
(defun longlines-show-hard-newlines (&optional arg)
"Make hard newlines visible by adding a face.
@@ -252,7 +253,7 @@ With optional argument ARG, make the hard newlines invisible again."
(setq pos (text-property-not-all (1+ pos) (point-max) 'hard nil)))
(restore-buffer-modified-p mod)))
-;; Wrapping the paragraphs.
+;;; Wrapping the paragraphs
(defun longlines-wrap-region (beg end)
"Wrap each successive line, starting with the line before BEG.
@@ -402,7 +403,7 @@ Hard newlines are left intact."
(setq pos (string-match "\n" str (1+ pos))))
str))
-;; Auto wrap
+;;; Auto wrap
(defun longlines-auto-wrap (&optional arg)
"Toggle automatic line wrapping.
@@ -457,7 +458,7 @@ This is called by `window-configuration-change-hook'."
(setq fill-column (- (window-width) dw))
(longlines-wrap-region (point-min) (point-max)))))
-;; Isearch
+;;; Isearch
(defun longlines-search-function ()
(cond
@@ -477,7 +478,7 @@ This is called by `window-configuration-change-hook'."
(let ((search-spaces-regexp " *[ \n]"))
(re-search-forward string bound noerror count)))
-;; Loading and saving
+;;; Loading and saving
(defun longlines-before-revert-hook ()
(add-hook 'after-revert-hook 'longlines-after-revert-hook nil t)
@@ -492,7 +493,7 @@ This is called by `window-configuration-change-hook'."
(list 'longlines "Automatically wrap long lines." nil nil
'longlines-encode-region t nil))
-;; Unloading
+;;; Unloading
(defun longlines-unload-function ()
"Unload the longlines library."
diff --git a/lisp/obsolete/lucid.el b/lisp/obsolete/lucid.el
deleted file mode 100644
index 817cc9cfaaa..00000000000
--- a/lisp/obsolete/lucid.el
+++ /dev/null
@@ -1,211 +0,0 @@
-;;; lucid.el --- emulate some Lucid Emacs functions
-
-;; Copyright (C) 1993, 1995, 2001-2020 Free Software Foundation, Inc.
-
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: emulations
-;; Obsolete-since: 23.2
-
-;; 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:
-
-;; XEmacs autoloads CL so we might as well make use of it.
-(require 'cl)
-
-(defalias 'current-time-seconds 'current-time)
-
-(defun real-path-name (name &optional default)
- (file-truename (expand-file-name name default)))
-
-;; It's not clear what to return if the mouse is not in FRAME.
-(defun read-mouse-position (frame)
- (let ((pos (mouse-position)))
- (if (eq (car pos) frame)
- (cdr pos))))
-
-(defun switch-to-other-buffer (arg)
- "Switch to the previous buffer.
-With a numeric arg N, switch to the Nth most recent buffer.
-With an arg of 0, buries the current buffer at the
-bottom of the buffer stack."
- (interactive "p")
- (if (eq arg 0)
- (bury-buffer (current-buffer)))
- (switch-to-buffer
- (if (<= arg 1) (other-buffer (current-buffer))
- (nth arg
- (apply 'nconc
- (mapcar
- (lambda (buf)
- (if (= ?\ (string-to-char (buffer-name buf)))
- nil
- (list buf)))
- (buffer-list)))))))
-
-(defun device-class (&optional device)
- "Return the class (color behavior) of DEVICE.
-This will be one of `color', `grayscale', or `mono'.
-This function exists for compatibility with XEmacs."
- (cond
- ((display-color-p device) 'color)
- ((display-grayscale-p device) 'grayscale)
- (t 'mono)))
-
-(defalias 'find-face 'facep)
-(defalias 'get-face 'facep)
-;; internal-try-face-font was removed from faces.el in rev 1.139, 1999/07/21.
-;;;(defalias 'try-face-font 'internal-try-face-font)
-
-(defalias 'exec-to-string 'shell-command-to-string)
-
-
-;; Buffer context
-
-(defun buffer-syntactic-context (&optional buffer)
- "Syntactic context at point in BUFFER.
-Either of `string', `comment' or nil.
-This is an XEmacs compatibility function."
- (with-current-buffer (or buffer (current-buffer))
- (let ((state (syntax-ppss (point))))
- (cond
- ((nth 3 state) 'string)
- ((nth 4 state) 'comment)))))
-
-
-(defun buffer-syntactic-context-depth (&optional buffer)
- "Syntactic parenthesis depth at point in BUFFER.
-This is an XEmacs compatibility function."
- (with-current-buffer (or buffer (current-buffer))
- (nth 0 (syntax-ppss (point)))))
-
-
-;; Extents
-(defun make-extent (beg end &optional buffer)
- (make-overlay beg end buffer))
-
-(defun extent-properties (extent) (overlay-properties extent))
-(unless (fboundp 'extent-property) (defalias 'extent-property 'overlay-get))
-
-(defun extent-at (pos &optional object property before)
- (with-current-buffer (or object (current-buffer))
- (let ((overlays (overlays-at pos 'sorted)))
- (when property
- (let (filtered)
- (while overlays
- (if (overlay-get (car overlays) property)
- (setq filtered (cons (car overlays) filtered)))
- (setq overlays (cdr overlays)))
- (setq overlays filtered)))
- (if before
- (nth 1 (memq before overlays))
- (car overlays)))))
-
-(defun set-extent-property (extent prop value)
- ;; Make sure that separate adjacent extents
- ;; with the same mouse-face value
- ;; do not run together as one extent.
- (and (eq prop 'mouse-face)
- (symbolp value)
- (setq value (list value)))
- (if (eq prop 'duplicable)
- (cond ((and value (not (overlay-get extent prop)))
- ;; If becoming duplicable, copy all overlayprops to text props.
- (add-text-properties (overlay-start extent)
- (overlay-end extent)
- (overlay-properties extent)
- (overlay-buffer extent)))
- ;; If becoming no longer duplicable, remove these text props.
- ((and (not value) (overlay-get extent prop))
- (remove-text-properties (overlay-start extent)
- (overlay-end extent)
- (overlay-properties extent)
- (overlay-buffer extent))))
- ;; If extent is already duplicable, put this property
- ;; on the text as well as on the overlay.
- (if (overlay-get extent 'duplicable)
- (put-text-property (overlay-start extent)
- (overlay-end extent)
- prop value (overlay-buffer extent))))
- (overlay-put extent prop value))
-
-(defun set-extent-face (extent face)
- (set-extent-property extent 'face face))
-
-(defun set-extent-end-glyph (extent glyph)
- (set-extent-property extent 'after-string glyph))
-
-(defun delete-extent (extent)
- (set-extent-property extent 'duplicable nil)
- (delete-overlay extent))
-
-;; Support the Lucid names with `screen' instead of `frame'.
-
-(defalias 'current-screen-configuration 'current-frame-configuration)
-(defalias 'delete-screen 'delete-frame)
-(defalias 'find-file-new-screen 'find-file-other-frame)
-(defalias 'find-file-read-only-new-screen 'find-file-read-only-other-frame)
-(defalias 'find-tag-new-screen 'find-tag-other-frame)
-;;(defalias 'focus-screen 'focus-frame)
-(defalias 'iconify-screen 'iconify-frame)
-(defalias 'mail-new-screen 'mail-other-frame)
-(defalias 'make-screen-invisible 'make-frame-invisible)
-(defalias 'make-screen-visible 'make-frame-visible)
-;; (defalias 'minibuffer-screen-list 'minibuffer-frame-list)
-(defalias 'modify-screen-parameters 'modify-frame-parameters)
-(defalias 'next-screen 'next-frame)
-;; (defalias 'next-multiscreen-window 'next-multiframe-window)
-;; (defalias 'previous-multiscreen-window 'previous-multiframe-window)
-;; (defalias 'redirect-screen-focus 'redirect-frame-focus)
-(defalias 'redraw-screen 'redraw-frame)
-;; (defalias 'screen-char-height 'frame-char-height)
-;; (defalias 'screen-char-width 'frame-char-width)
-;; (defalias 'screen-configuration-to-register 'frame-configuration-to-register)
-;; (defalias 'screen-focus 'frame-focus)
-(defalias 'screen-list 'frame-list)
-;; (defalias 'screen-live-p 'frame-live-p)
-(defalias 'screen-parameters 'frame-parameters)
-(defalias 'screen-pixel-height 'frame-pixel-height)
-(defalias 'screen-pixel-width 'frame-pixel-width)
-(defalias 'screen-root-window 'frame-root-window)
-(defalias 'screen-selected-window 'frame-selected-window)
-(defalias 'lower-screen 'lower-frame)
-(defalias 'raise-screen 'raise-frame)
-(defalias 'screen-visible-p 'frame-visible-p)
-(defalias 'screenp 'framep)
-(defalias 'select-screen 'select-frame)
-(defalias 'selected-screen 'selected-frame)
-;; (defalias 'set-screen-configuration 'set-frame-configuration)
-;; (defalias 'set-screen-height 'set-frame-height)
-(defalias 'set-screen-position 'set-frame-position)
-(defalias 'set-screen-size 'set-frame-size)
-;; (defalias 'set-screen-width 'set-frame-width)
-(defalias 'switch-to-buffer-new-screen 'switch-to-buffer-other-frame)
-;; (defalias 'unfocus-screen 'unfocus-frame)
-(defalias 'visible-screen-list 'visible-frame-list)
-(defalias 'window-screen 'window-frame)
-(defalias 'x-create-screen 'x-create-frame)
-(defalias 'x-new-screen 'make-frame)
-
-(provide 'lucid)
-
-;; Local Variables:
-;; byte-compile-warnings: (not cl-functions)
-;; End:
-
-;;; lucid.el ends here
diff --git a/lisp/mail/metamail.el b/lisp/obsolete/metamail.el
index 0e407ea060e..d6ab4a3d0cf 100644
--- a/lisp/mail/metamail.el
+++ b/lisp/obsolete/metamail.el
@@ -4,6 +4,7 @@
;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
;; Keywords: mail, news, mime, multimedia
+;; Obsolete-since: 28.1
;; This file is part of GNU Emacs.
diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el
deleted file mode 100644
index 95010c00200..00000000000
--- a/lisp/obsolete/old-whitespace.el
+++ /dev/null
@@ -1,801 +0,0 @@
-;;; whitespace.el --- warn about and clean bogus whitespaces in the file
-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
-
-;; Author: Rajesh Vaidheeswarran <rv@gnu.org>
-;; Keywords: convenience
-;; Obsolete-since: 23.1
-
-;; 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:
-
-;; URL: http://www.dsmit.com/lisp/
-;;
-;; The whitespace library is intended to find and help fix five different types
-;; of whitespace problems that commonly exist in source code.
-;;
-;; 1. Leading space (empty lines at the top of a file).
-;; 2. Trailing space (empty lines at the end of a file).
-;; 3. Indentation space (8 or more spaces at beginning of line, that should be
-;; replaced with TABS).
-;; 4. Spaces followed by a TAB. (Almost always, we never want that).
-;; 5. Spaces or TABS at the end of a line.
-;;
-;; Whitespace errors are reported in a buffer, and on the mode line.
-;;
-;; Mode line will show a W:<x>!<y> to denote a particular type of whitespace,
-;; where `x' and `y' can be one (or more) of:
-;;
-;; e - End-of-Line whitespace.
-;; i - Indentation whitespace.
-;; l - Leading whitespace.
-;; s - Space followed by Tab.
-;; t - Trailing whitespace.
-;;
-;; If any of the whitespace checks is turned off, the mode line will display a
-;; !<y>.
-;;
-;; (since (3) is the most controversial one, here is the rationale: Most
-;; terminal drivers and printer drivers have TAB configured or even
-;; hardcoded to be 8 spaces. (Some of them allow configuration, but almost
-;; always they default to 8.)
-;;
-;; Changing `tab-width' to other than 8 and editing will cause your code to
-;; look different from within Emacs, and say, if you cat it or more it, or
-;; even print it.
-;;
-;; Almost all the popular programming modes let you define an offset (like
-;; c-basic-offset or perl-indent-level) to configure the offset, so you
-;; should never have to set your `tab-width' to be other than 8 in all
-;; these modes. In fact, with an indent level of say, 4, 2 TABS will cause
-;; Emacs to replace your 8 spaces with one \t (try it). If vi users in
-;; your office complain, tell them to use vim, which distinguishes between
-;; tabstop and shiftwidth (vi equivalent of our offsets), and also ask them
-;; to set smarttab.)
-;;
-;; All the above have caused (and will cause) unwanted codeline integration and
-;; merge problems.
-;;
-;; whitespace.el will complain if it detects whitespaces on opening a file, and
-;; warn you on closing a file also (in case you had inserted any
-;; whitespaces during the process of your editing).
-;;
-;; Exported functions:
-;;
-;; `whitespace-buffer' - To check the current buffer for whitespace problems.
-;; `whitespace-cleanup' - To cleanup all whitespaces in the current buffer.
-;; `whitespace-region' - To check between point and mark for whitespace
-;; problems.
-;; `whitespace-cleanup-region' - To cleanup all whitespaces between point
-;; and mark in the current buffer.
-
-;;; Code:
-
-(defvar whitespace-version "3.5" "Version of the whitespace library.")
-
-(defvar whitespace-all-buffer-files nil
- "An associated list of buffers and files checked for whitespace cleanliness.
-
-This is to enable periodic checking of whitespace cleanliness in the files
-visited by the buffers.")
-
-(defvar whitespace-rescan-timer nil
- "Timer object used to rescan the files in buffers that have been modified.")
-
-;; Tell Emacs about this new kind of minor mode
-(defvar whitespace-mode nil
- "Non-nil when Whitespace mode (a minor mode) is enabled.")
-(make-variable-buffer-local 'whitespace-mode)
-
-(defvar whitespace-mode-line nil
- "String to display in the mode line for Whitespace mode.")
-(make-variable-buffer-local 'whitespace-mode-line)
-
-(defvar whitespace-check-buffer-leading nil
- "Test leading whitespace for file in current buffer if t.")
-(make-variable-buffer-local 'whitespace-check-buffer-leading)
-;;;###autoload(put 'whitespace-check-buffer-leading 'safe-local-variable 'booleanp)
-
-(defvar whitespace-check-buffer-trailing nil
- "Test trailing whitespace for file in current buffer if t.")
-(make-variable-buffer-local 'whitespace-check-buffer-trailing)
-;;;###autoload(put 'whitespace-check-buffer-trailing 'safe-local-variable 'booleanp)
-
-(defvar whitespace-check-buffer-indent nil
- "Test indentation whitespace for file in current buffer if t.")
-(make-variable-buffer-local 'whitespace-check-buffer-indent)
-;;;###autoload(put 'whitespace-check-buffer-indent 'safe-local-variable 'booleanp)
-
-(defvar whitespace-check-buffer-spacetab nil
- "Test Space-followed-by-TABS whitespace for file in current buffer if t.")
-(make-variable-buffer-local 'whitespace-check-buffer-spacetab)
-;;;###autoload(put 'whitespace-check-buffer-spacetab 'safe-local-variable 'booleanp)
-
-(defvar whitespace-check-buffer-ateol nil
- "Test end-of-line whitespace for file in current buffer if t.")
-(make-variable-buffer-local 'whitespace-check-buffer-ateol)
-;;;###autoload(put 'whitespace-check-buffer-ateol 'safe-local-variable 'booleanp)
-
-(defvar whitespace-highlighted-space nil
- "The variable to store the extent to highlight.")
-(make-variable-buffer-local 'whitespace-highlighted-space)
-
-(defalias 'whitespace-make-overlay
- (if (featurep 'xemacs) 'make-extent 'make-overlay))
-(defalias 'whitespace-overlay-put
- (if (featurep 'xemacs) 'set-extent-property 'overlay-put))
-(defalias 'whitespace-delete-overlay
- (if (featurep 'xemacs) 'delete-extent 'delete-overlay))
-(defalias 'whitespace-overlay-start
- (if (featurep 'xemacs) 'extent-start 'overlay-start))
-(defalias 'whitespace-overlay-end
- (if (featurep 'xemacs) 'extent-end 'overlay-end))
-(defalias 'whitespace-mode-line-update
- (if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update))
-
-(defgroup whitespace nil
- "Check for and fix five different types of whitespaces in source code."
- :version "21.1"
- :link '(emacs-commentary-link "whitespace.el")
- ;; Since XEmacs doesn't have a 'convenience group, use the next best group
- ;; which is 'editing?
- :group (if (featurep 'xemacs) 'editing 'convenience))
-
-(defcustom whitespace-check-leading-whitespace t
- "Flag to check leading whitespace. This is the global for the system.
-It can be overridden by setting a buffer local variable
-`whitespace-check-buffer-leading'."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-check-trailing-whitespace t
- "Flag to check trailing whitespace. This is the global for the system.
-It can be overridden by setting a buffer local variable
-`whitespace-check-buffer-trailing'."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-check-spacetab-whitespace t
- "Flag to check space followed by a TAB. This is the global for the system.
-It can be overridden by setting a buffer local variable
-`whitespace-check-buffer-spacetab'."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-spacetab-regexp "[ ]+\t"
- "Regexp to match one or more spaces followed by a TAB."
- :type 'regexp
- :group 'whitespace)
-
-(defcustom whitespace-check-indent-whitespace indent-tabs-mode
- "Flag to check indentation whitespace. This is the global for the system.
-It can be overridden by setting a buffer local variable
-`whitespace-check-buffer-indent'."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-indent-regexp "^\t*\\( \\)+"
- "Regexp to match multiples of eight spaces near line beginnings.
-The default value ignores leading TABs."
- :type 'regexp
- :group 'whitespace)
-
-(defcustom whitespace-check-ateol-whitespace t
- "Flag to check end-of-line whitespace. This is the global for the system.
-It can be overridden by setting a buffer local variable
-`whitespace-check-buffer-ateol'."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-ateol-regexp "[ \t]+$"
- "Regexp to match one or more TABs or spaces at line ends."
- :type 'regexp
- :group 'whitespace)
-
-(defcustom whitespace-errbuf "*Whitespace Errors*"
- "The name of the buffer where whitespace related messages will be logged."
- :type 'string
- :group 'whitespace)
-
-(defcustom whitespace-clean-msg "clean."
- "If non-nil, this message will be displayed after a whitespace check
-determines a file to be clean."
- :type 'string
- :group 'whitespace)
-
-(defcustom whitespace-abort-on-error nil
- "While writing a file, abort if the file is unclean.
-If `whitespace-auto-cleanup' is set, that takes precedence over
-this variable."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-auto-cleanup nil
- "Cleanup a buffer automatically on finding it whitespace unclean."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-silent nil
- "All whitespace errors will be shown only in the mode line when t.
-
-Note that setting this may cause all whitespaces introduced in a file to go
-unnoticed when the buffer is killed, unless the user visits the `*Whitespace
-Errors*' buffer before opening (or closing) another file."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-modes '(ada-mode asm-mode autoconf-mode awk-mode
- c-mode c++-mode cc-mode
- change-log-mode cperl-mode
- electric-nroff-mode emacs-lisp-mode
- f90-mode fortran-mode html-mode
- html3-mode java-mode jde-mode
- ksh-mode latex-mode LaTeX-mode
- lisp-mode m4-mode makefile-mode
- modula-2-mode nroff-mode objc-mode
- pascal-mode perl-mode prolog-mode
- python-mode scheme-mode sgml-mode
- sh-mode shell-script-mode simula-mode
- tcl-mode tex-mode texinfo-mode
- vrml-mode xml-mode)
-
- "Major modes in which we turn on whitespace checking.
-
-These are mostly programming and documentation modes. But you may add other
-modes that you want whitespaces checked in by adding something like the
-following to your `.emacs':
-
-\(setq whitespace-modes (cons \\='my-mode (cons \\='my-other-mode
- whitespace-modes))\)
-
-Or, alternately, you can use the Emacs `customize' command to set this."
- :type '(repeat symbol)
- :group 'whitespace)
-
-(defcustom whitespace-rescan-timer-time 600
- "Period in seconds to rescan modified buffers for whitespace creep.
-
-This is the period after which the timer will fire causing
-`whitespace-rescan-files-in-buffers' to check for whitespace creep in
-modified buffers.
-
-To disable timer scans, set this to zero."
- :type 'integer
- :group 'whitespace)
-
-(defcustom whitespace-display-in-modeline t
- "Display whitespace errors on the modeline."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-display-spaces-in-color t
- "Display the bogus whitespaces by coloring them with the face
-`whitespace-highlight'."
- :type 'boolean
- :group 'whitespace)
-
-(defface whitespace-highlight '((((class color) (background light))
- (:background "green1"))
- (((class color) (background dark))
- (:background "sea green"))
- (((class grayscale mono)
- (background light))
- (:background "black"))
- (((class grayscale mono)
- (background dark))
- (:background "white")))
- "Face used for highlighting the bogus whitespaces that exist in the buffer."
- :group 'whitespace)
-
-(if (not (assoc 'whitespace-mode minor-mode-alist))
- (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line)
- minor-mode-alist)))
-
-(set-default 'whitespace-check-buffer-leading
- whitespace-check-leading-whitespace)
-(set-default 'whitespace-check-buffer-trailing
- whitespace-check-trailing-whitespace)
-(set-default 'whitespace-check-buffer-indent
- whitespace-check-indent-whitespace)
-(set-default 'whitespace-check-buffer-spacetab
- whitespace-check-spacetab-whitespace)
-(set-default 'whitespace-check-buffer-ateol
- whitespace-check-ateol-whitespace)
-
-(defun whitespace-check-whitespace-mode (&optional arg)
- "Test and set the whitespace-mode in qualifying buffers."
- (if (null whitespace-mode)
- (setq whitespace-mode
- (if (or arg (member major-mode whitespace-modes))
- t
- nil))))
-
-;;;###autoload
-(defun whitespace-toggle-leading-check ()
- "Toggle the check for leading space in the local buffer."
- (interactive)
- (let ((current-val whitespace-check-buffer-leading))
- (setq whitespace-check-buffer-leading (not current-val))
- (message "Will%s check for leading space in buffer."
- (if whitespace-check-buffer-leading "" " not"))
- (if whitespace-check-buffer-leading (whitespace-buffer-leading))))
-
-;;;###autoload
-(defun whitespace-toggle-trailing-check ()
- "Toggle the check for trailing space in the local buffer."
- (interactive)
- (let ((current-val whitespace-check-buffer-trailing))
- (setq whitespace-check-buffer-trailing (not current-val))
- (message "Will%s check for trailing space in buffer."
- (if whitespace-check-buffer-trailing "" " not"))
- (if whitespace-check-buffer-trailing (whitespace-buffer-trailing))))
-
-;;;###autoload
-(defun whitespace-toggle-indent-check ()
- "Toggle the check for indentation space in the local buffer."
- (interactive)
- (let ((current-val whitespace-check-buffer-indent))
- (setq whitespace-check-buffer-indent (not current-val))
- (message "Will%s check for indentation space in buffer."
- (if whitespace-check-buffer-indent "" " not"))
- (if whitespace-check-buffer-indent
- (whitespace-buffer-search whitespace-indent-regexp))))
-
-;;;###autoload
-(defun whitespace-toggle-spacetab-check ()
- "Toggle the check for space-followed-by-TABs in the local buffer."
- (interactive)
- (let ((current-val whitespace-check-buffer-spacetab))
- (setq whitespace-check-buffer-spacetab (not current-val))
- (message "Will%s check for space-followed-by-TABs in buffer."
- (if whitespace-check-buffer-spacetab "" " not"))
- (if whitespace-check-buffer-spacetab
- (whitespace-buffer-search whitespace-spacetab-regexp))))
-
-
-;;;###autoload
-(defun whitespace-toggle-ateol-check ()
- "Toggle the check for end-of-line space in the local buffer."
- (interactive)
- (let ((current-val whitespace-check-buffer-ateol))
- (setq whitespace-check-buffer-ateol (not current-val))
- (message "Will%s check for end-of-line space in buffer."
- (if whitespace-check-buffer-ateol "" " not"))
- (if whitespace-check-buffer-ateol
- (whitespace-buffer-search whitespace-ateol-regexp))))
-
-
-;;;###autoload
-(defun whitespace-buffer (&optional quiet)
- "Find five different types of white spaces in buffer.
-These are:
-1. Leading space \(empty lines at the top of a file\).
-2. Trailing space \(empty lines at the end of a file\).
-3. Indentation space \(8 or more spaces, that should be replaced with TABS\).
-4. Spaces followed by a TAB. \(Almost always, we never want that\).
-5. Spaces or TABS at the end of a line.
-
-Check for whitespace only if this buffer really contains a non-empty file
-and:
-1. the major mode is one of the whitespace-modes, or
-2. `whitespace-buffer' was explicitly called with a prefix argument."
- (interactive)
- (let ((whitespace-error nil))
- (whitespace-check-whitespace-mode current-prefix-arg)
- (if (and buffer-file-name (> (buffer-size) 0) whitespace-mode)
- (progn
- (whitespace-check-buffer-list (buffer-name) buffer-file-name)
- (whitespace-tickle-timer)
- (overlay-recenter (point-max))
- (remove-overlays nil nil 'face 'whitespace-highlight)
- (if whitespace-auto-cleanup
- (if buffer-read-only
- (if (not quiet)
- (message "Can't cleanup: %s is read-only" (buffer-name)))
- (whitespace-cleanup-internal))
- (let ((whitespace-leading (if whitespace-check-buffer-leading
- (whitespace-buffer-leading)
- nil))
- (whitespace-trailing (if whitespace-check-buffer-trailing
- (whitespace-buffer-trailing)
- nil))
- (whitespace-indent (if whitespace-check-buffer-indent
- (whitespace-buffer-search
- whitespace-indent-regexp)
- nil))
- (whitespace-spacetab (if whitespace-check-buffer-spacetab
- (whitespace-buffer-search
- whitespace-spacetab-regexp)
- nil))
- (whitespace-ateol (if whitespace-check-buffer-ateol
- (whitespace-buffer-search
- whitespace-ateol-regexp)
- nil))
- (whitespace-errmsg nil)
- (whitespace-filename buffer-file-name)
- (whitespace-this-modeline ""))
-
- ;; Now let's complain if we found any of the above.
- (setq whitespace-error (or whitespace-leading whitespace-indent
- whitespace-spacetab whitespace-ateol
- whitespace-trailing))
-
- (if whitespace-error
- (progn
- (setq whitespace-errmsg
- (concat whitespace-filename " contains:\n"
- (if whitespace-leading
- "Leading whitespace\n")
- (if whitespace-indent
- (concat "Indentation whitespace"
- whitespace-indent "\n"))
- (if whitespace-spacetab
- (concat "Space followed by Tab"
- whitespace-spacetab "\n"))
- (if whitespace-ateol
- (concat "End-of-line whitespace"
- whitespace-ateol "\n"))
- (if whitespace-trailing
- "Trailing whitespace\n")
- "\ntype `M-x whitespace-cleanup' to "
- "cleanup the file."))
- (setq whitespace-this-modeline
- (concat (if whitespace-ateol "e")
- (if whitespace-indent "i")
- (if whitespace-leading "l")
- (if whitespace-spacetab "s")
- (if whitespace-trailing "t")))))
- (whitespace-update-modeline whitespace-this-modeline)
- (if (get-buffer whitespace-errbuf)
- (kill-buffer whitespace-errbuf))
- (with-current-buffer (get-buffer-create whitespace-errbuf)
- (if whitespace-errmsg
- (progn
- (insert whitespace-errmsg)
- (if (not (or quiet whitespace-silent))
- (display-buffer (current-buffer) t))
- (if (not quiet)
- (message "Whitespaces: [%s%s] in %s"
- whitespace-this-modeline
- (let ((whitespace-unchecked
- (whitespace-unchecked-whitespaces)))
- (if whitespace-unchecked
- (concat "!" whitespace-unchecked)
- ""))
- whitespace-filename)))
- (if (and (not quiet) (not (equal whitespace-clean-msg "")))
- (message "%s %s" whitespace-filename
- whitespace-clean-msg))))))))
- whitespace-error))
-
-;;;###autoload
-(defun whitespace-region (s e)
- "Check the region for whitespace errors."
- (interactive "r")
- (save-excursion
- (save-restriction
- (narrow-to-region s e)
- (whitespace-buffer))))
-
-;;;###autoload
-(defun whitespace-cleanup ()
- "Cleanup the five different kinds of whitespace problems.
-It normally applies to the whole buffer, but in Transient Mark mode
-when the mark is active it applies to the region.
-See `whitespace-buffer' docstring for a summary of the problems."
- (interactive)
- (if (and transient-mark-mode mark-active)
- (whitespace-cleanup-region (region-beginning) (region-end))
- (whitespace-cleanup-internal)))
-
-(defun whitespace-cleanup-internal (&optional region-only)
- ;; If this buffer really contains a file, then run, else quit.
- (whitespace-check-whitespace-mode current-prefix-arg)
- (if (and buffer-file-name whitespace-mode)
- (let ((whitespace-any nil)
- (whitespace-tabwidth 8)
- (whitespace-tabwidth-saved tab-width))
-
- ;; since all printable TABS should be 8, irrespective of how
- ;; they are displayed.
- (setq tab-width whitespace-tabwidth)
-
- (if (and whitespace-check-buffer-leading
- (whitespace-buffer-leading))
- (progn
- (whitespace-buffer-leading-cleanup)
- (setq whitespace-any t)))
-
- (if (and whitespace-check-buffer-trailing
- (whitespace-buffer-trailing))
- (progn
- (whitespace-buffer-trailing-cleanup)
- (setq whitespace-any t)))
-
- (if (and whitespace-check-buffer-indent
- (whitespace-buffer-search whitespace-indent-regexp))
- (progn
- (whitespace-indent-cleanup)
- (setq whitespace-any t)))
-
- (if (and whitespace-check-buffer-spacetab
- (whitespace-buffer-search whitespace-spacetab-regexp))
- (progn
- (whitespace-buffer-cleanup whitespace-spacetab-regexp "\t")
- (setq whitespace-any t)))
-
- (if (and whitespace-check-buffer-ateol
- (whitespace-buffer-search whitespace-ateol-regexp))
- (progn
- (whitespace-buffer-cleanup whitespace-ateol-regexp "")
- (setq whitespace-any t)))
-
- ;; Call this recursively till everything is taken care of
- (if whitespace-any
- (whitespace-cleanup-internal region-only)
- ;; if we are done, talk to the user
- (progn
- (unless whitespace-silent
- (if region-only
- (message "The region is now clean")
- (message "%s is now clean" buffer-file-name)))
- (whitespace-update-modeline)))
- (setq tab-width whitespace-tabwidth-saved))))
-
-;;;###autoload
-(defun whitespace-cleanup-region (s e)
- "Whitespace cleanup on the region."
- (interactive "r")
- (save-excursion
- (save-restriction
- (narrow-to-region s e)
- (whitespace-cleanup-internal t))
- (whitespace-buffer t)))
-
-(defun whitespace-buffer-leading ()
- "Return t if the current buffer has leading newline characters.
-If highlighting is enabled, highlight these characters."
- (save-excursion
- (goto-char (point-min))
- (skip-chars-forward "\n")
- (unless (bobp)
- (whitespace-highlight-the-space (point-min) (point))
- t)))
-
-(defun whitespace-buffer-leading-cleanup ()
- "Remove any leading newline characters from current buffer."
- (save-excursion
- (goto-char (point-min))
- (skip-chars-forward "\n")
- (delete-region (point-min) (point))))
-
-(defun whitespace-buffer-trailing ()
- "Return t if the current buffer has extra trailing newline characters.
-If highlighting is enabled, highlight these characters."
- (save-excursion
- (goto-char (point-max))
- (skip-chars-backward "\n")
- (forward-line)
- (unless (eobp)
- (whitespace-highlight-the-space (point) (point-max))
- t)))
-
-(defun whitespace-buffer-trailing-cleanup ()
- "Remove extra trailing newline characters from current buffer."
- (save-excursion
- (goto-char (point-max))
- (skip-chars-backward "\n")
- (unless (eobp)
- (forward-line)
- (delete-region (point) (point-max)))))
-
-(defun whitespace-buffer-search (regexp)
- "Search for any given whitespace REGEXP."
- (with-local-quit
- (let (whitespace-retval)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (whitespace-highlight-the-space (match-beginning 0) (match-end 0))
- (push (match-beginning 0) whitespace-retval)))
- (when whitespace-retval
- (format " %s" (nreverse whitespace-retval))))))
-
-(defun whitespace-buffer-cleanup (regexp newregexp)
- "Search for any given whitespace REGEXP and replace it with the NEWREGEXP."
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (replace-match newregexp))))
-
-(defun whitespace-indent-cleanup ()
- "Search for 8/more spaces at the start of a line and replace it with tabs."
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward whitespace-indent-regexp nil t)
- (let ((column (current-column))
- (indent-tabs-mode t))
- (delete-region (match-beginning 0) (point))
- (indent-to column)))))
-
-(defun whitespace-unchecked-whitespaces ()
- "Return the list of whitespaces whose testing has been suppressed."
- (let ((unchecked-spaces
- (concat (if (not whitespace-check-buffer-ateol) "e")
- (if (not whitespace-check-buffer-indent) "i")
- (if (not whitespace-check-buffer-leading) "l")
- (if (not whitespace-check-buffer-spacetab) "s")
- (if (not whitespace-check-buffer-trailing) "t"))))
- (if (not (equal unchecked-spaces ""))
- unchecked-spaces
- nil)))
-
-(defun whitespace-update-modeline (&optional whitespace-err)
- "Update mode line with whitespace errors.
-Also with whitespaces whose testing has been turned off."
- (if whitespace-display-in-modeline
- (progn
- (setq whitespace-mode-line nil)
- ;; Whitespace errors
- (if (and whitespace-err (not (equal whitespace-err "")))
- (setq whitespace-mode-line whitespace-err))
- ;; Whitespace suppressed errors
- (let ((whitespace-unchecked (whitespace-unchecked-whitespaces)))
- (if whitespace-unchecked
- (setq whitespace-mode-line
- (concat whitespace-mode-line "!" whitespace-unchecked))))
- ;; Add the whitespace modeline prefix
- (setq whitespace-mode-line (if whitespace-mode-line
- (concat " W:" whitespace-mode-line)
- nil))
- (whitespace-mode-line-update))))
-
-(defun whitespace-highlight-the-space (b e)
- "Highlight the current line, unhighlighting a previously jumped to line."
- (if whitespace-display-spaces-in-color
- (let ((ol (whitespace-make-overlay b e)))
- (whitespace-overlay-put ol 'face 'whitespace-highlight))))
-
-(defun whitespace-unhighlight-the-space()
- "Unhighlight the currently highlight line."
- (if (and whitespace-display-spaces-in-color whitespace-highlighted-space)
- (progn
- (mapc 'whitespace-delete-overlay whitespace-highlighted-space)
- (setq whitespace-highlighted-space nil))))
-
-(defun whitespace-check-buffer-list (buf-name buf-file)
- "Add a buffer and its file to the whitespace monitor list.
-
-The buffer named BUF-NAME and its associated file BUF-FILE are now monitored
-periodically for whitespace."
- (if (and whitespace-mode (not (member (list buf-file buf-name)
- whitespace-all-buffer-files)))
- (add-to-list 'whitespace-all-buffer-files (list buf-file buf-name))))
-
-(defun whitespace-tickle-timer ()
- "Tickle timer to periodically to scan qualifying files for whitespace creep.
-
-If timer is not set, then set it to scan the files in
-`whitespace-all-buffer-files' periodically (defined by
-`whitespace-rescan-timer-time') for whitespace creep."
- (if (and whitespace-rescan-timer-time
- (/= whitespace-rescan-timer-time 0)
- (not whitespace-rescan-timer))
- (setq whitespace-rescan-timer
- (add-timeout whitespace-rescan-timer-time
- 'whitespace-rescan-files-in-buffers nil
- whitespace-rescan-timer-time))))
-
-(defun whitespace-rescan-files-in-buffers (&optional arg)
- "Check monitored files for whitespace creep since last scan."
- (let ((whitespace-all-my-files whitespace-all-buffer-files)
- buffile bufname thiselt buf)
- (if (not whitespace-all-my-files)
- (progn
- (disable-timeout whitespace-rescan-timer)
- (setq whitespace-rescan-timer nil))
- (while whitespace-all-my-files
- (setq thiselt (car whitespace-all-my-files))
- (setq whitespace-all-my-files (cdr whitespace-all-my-files))
- (setq buffile (car thiselt))
- (setq bufname (cadr thiselt))
- (setq buf (get-buffer bufname))
- (if (buffer-live-p buf)
- (with-current-buffer bufname
- ;;(message "buffer %s live" bufname)
- (if whitespace-mode
- (progn
- ;;(message "checking for whitespace in %s" bufname)
- (if whitespace-auto-cleanup
- (progn
- ;;(message "cleaning up whitespace in %s" bufname)
- (whitespace-cleanup-internal))
- (progn
- ;;(message "whitespace-buffer %s." (buffer-name))
- (whitespace-buffer t))))
- ;;(message "Removing %s from refresh list" bufname)
- (whitespace-refresh-rescan-list buffile bufname)))
- ;;(message "Removing %s from refresh list" bufname)
- (whitespace-refresh-rescan-list buffile bufname))))))
-
-(defun whitespace-refresh-rescan-list (buffile bufname)
- "Refresh the list of files to be rescanned for whitespace creep."
- (if whitespace-all-buffer-files
- (setq whitespace-all-buffer-files
- (delete (list buffile bufname) whitespace-all-buffer-files))
- (when whitespace-rescan-timer
- (disable-timeout whitespace-rescan-timer)
- (setq whitespace-rescan-timer nil))))
-
-;;;###autoload
-(defalias 'global-whitespace-mode 'whitespace-global-mode)
-
-;;;###autoload
-(define-minor-mode whitespace-global-mode
- "Toggle using Whitespace mode in new buffers.
-
-When this mode is active, `whitespace-buffer' is added to
-`find-file-hook' and `kill-buffer-hook'."
- :global t
- :group 'whitespace
- (if whitespace-global-mode
- (progn
- (add-hook 'find-file-hook 'whitespace-buffer)
- (add-hook 'write-file-functions 'whitespace-write-file-hook nil t)
- (add-hook 'kill-buffer-hook 'whitespace-buffer))
- (remove-hook 'find-file-hook 'whitespace-buffer)
- (remove-hook 'write-file-functions 'whitespace-write-file-hook t)
- (remove-hook 'kill-buffer-hook 'whitespace-buffer)))
-
-;;;###autoload
-(defun whitespace-write-file-hook ()
- "Hook function to be called on the buffer when whitespace check is enabled.
-This is meant to be added buffer-locally to `write-file-functions'."
- (let ((werr nil))
- (if whitespace-auto-cleanup
- (whitespace-cleanup-internal)
- (setq werr (whitespace-buffer)))
- (if (and whitespace-abort-on-error werr)
- (error "Abort write due to whitespaces in %s"
- buffer-file-name)))
- nil)
-
-(defun whitespace-unload-function ()
- "Unload the whitespace library."
- (if (unintern "whitespace-unload-hook" obarray)
- ;; if whitespace-unload-hook is defined, let's get rid of it
- ;; and recursively call `unload-feature'
- (progn (unload-feature 'whitespace) t)
- ;; this only happens in the recursive call
- (whitespace-global-mode -1)
- (save-current-buffer
- (dolist (buf (buffer-list))
- (set-buffer buf)
- (remove-hook 'write-file-functions 'whitespace-write-file-hook t)))
- ;; continue standard unloading
- nil))
-
-(defun whitespace-unload-hook ()
- (remove-hook 'find-file-hook 'whitespace-buffer)
- (remove-hook 'write-file-functions 'whitespace-write-file-hook t)
- (remove-hook 'kill-buffer-hook 'whitespace-buffer))
-
-(add-hook 'whitespace-unload-hook 'whitespace-unload-hook)
-
-(provide 'whitespace)
-
-;;; whitespace.el ends here
diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el
index 5ef8be20d98..6d95b7136b1 100644
--- a/lisp/obsolete/rcompile.el
+++ b/lisp/obsolete/rcompile.el
@@ -89,7 +89,7 @@ nil means use the value returned by \\[user-login-name]."
"Command to run before compilation.
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.
+\(tcsh) and .bash_profile \(bash) are not run.
nil means run no commands."
:type '(choice string (const nil))
:group 'remote-compile)
diff --git a/lisp/obsolete/sb-image.el b/lisp/obsolete/sb-image.el
new file mode 100644
index 00000000000..fd8884738d4
--- /dev/null
+++ b/lisp/obsolete/sb-image.el
@@ -0,0 +1,46 @@
+;;; sb-image --- Image management for speedbar
+
+;; Copyright (C) 1999-2003, 2005-2019 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; Keywords: file, tags, tools
+;; Obsolete-since: 28.1
+
+;; 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 is obsolete.
+;;
+;; Supporting Image display for Emacs 20 and less, Emacs 21, and XEmacs,
+;; is a challenging task, which doesn't take kindly to being byte compiled.
+;; When sharing speedbar.elc between these three applications, the Image
+;; support can get lost.
+;;
+;; By splitting out that hard part into this file, and avoiding byte
+;; compilation, one copy speedbar can support all these platforms together.
+;;
+;; This file requires the `image' package if it is available.
+
+(require 'ezimage)
+
+;;; Code:
+
+(defalias 'defimage-speedbar 'defezimage)
+
+(provide 'sb-image)
+
+;;; sb-image.el ends here
diff --git a/lisp/obsolete/tls.el b/lisp/obsolete/tls.el
index cd091c0108e..d1b215cbfb8 100644
--- a/lisp/obsolete/tls.el
+++ b/lisp/obsolete/tls.el
@@ -47,9 +47,6 @@
(require 'gnutls)
-(autoload 'format-spec "format-spec")
-(autoload 'format-spec-make "format-spec")
-
(defgroup tls nil
"Transport Layer Security (TLS) parameters."
:group 'comm)
@@ -224,14 +221,11 @@ Fourth arg PORT is an integer specifying a port to connect to."
(while (and (not done) (setq cmd (pop cmds)))
(let ((process-connection-type tls-process-connection-type)
(formatted-cmd
- (format-spec
- cmd
- (format-spec-make
- ?t (car (gnutls-trustfiles))
- ?h host
- ?p (if (integerp port)
- (int-to-string port)
- port)))))
+ (format-spec cmd `((?t . ,(car (gnutls-trustfiles)))
+ (?h . ,host)
+ (?p . ,(if (integerp port)
+ (number-to-string port)
+ port))))))
(message "Opening TLS connection with `%s'..." formatted-cmd)
(setq process (start-process
name buffer shell-file-name shell-command-switch
diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el
index d71f79c87be..0de7aa096d6 100644
--- a/lisp/obsolete/tpu-edt.el
+++ b/lisp/obsolete/tpu-edt.el
@@ -287,14 +287,6 @@
;;;
;;; User Configurable Variables
;;;
-(defcustom tpu-have-ispell t
- "Non-nil means `tpu-spell-check' uses `ispell-region' for spell checking.
-Otherwise, use `spell-region'."
- :type 'boolean
- :group 'tpu)
-(make-obsolete-variable 'tpu-have-ispell "the `spell' package is obsolete."
- "23.1")
-
(defcustom tpu-kill-buffers-silently nil
"If non-nil, TPU-edt kills modified buffers without asking."
:type 'boolean
@@ -315,7 +307,6 @@ Otherwise, use `spell-region'."
;;; Global Keymaps
;;;
-(define-obsolete-variable-alias 'GOLD-map 'tpu-gold-map "23.1")
(defvar tpu-gold-map
(let ((map (make-keymap)))
;; Previously we used escape sequences here. We now instead presume
@@ -892,8 +883,7 @@ With argument, fill and justify."
if no region is selected."
(interactive)
(let ((m (tpu-mark)))
- (apply (if tpu-have-ispell 'ispell-region
- 'spell-region)
+ (apply 'ispell-region
(if m
(if (> m (point)) (list (point) m)
(list m (point)))
diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el
index bcdefac5187..93bd991eb3a 100644
--- a/lisp/obsolete/vc-arch.el
+++ b/lisp/obsolete/vc-arch.el
@@ -597,20 +597,21 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
(unless (file-writable-p rl-dir)
(error "No writable revlib directory found"))
(message "Revlib at %s" rl-dir)
- (let* ((archives (directory-files rl-dir 'full (rx (or (not ".") "..."))))
+ (let* ((archives (directory-files rl-dir 'full
+ directory-files-no-dot-files-regexp))
(categories
(apply 'append
(mapcar (lambda (dir)
(when (file-directory-p dir)
- (directory-files dir 'full
- (rx (or (not ".") "...")))))
+ (directory-files
+ dir 'full directory-files-no-dot-files-regexp)))
archives)))
(branches
(apply 'append
(mapcar (lambda (dir)
(when (file-directory-p dir)
- (directory-files dir 'full
- (rx (or (not ".") "...")))))
+ (directory-files
+ dir 'full directory-files-no-dot-files-regexp)))
categories)))
(versions
(apply 'append
diff --git a/lisp/obsolete/vi.el b/lisp/obsolete/vi.el
index df5ddfdbcf9..eee00b43a26 100644
--- a/lisp/obsolete/vi.el
+++ b/lisp/obsolete/vi.el
@@ -1225,7 +1225,7 @@ SPECIAL FEATURE: char argument can be used to specify shift amount(1-9)."
(defun vi-end-of-blank-delimited-word (count)
"Forward to the end of the COUNT'th blank-delimited word."
(interactive "p")
- (if (re-search-forward "[^ \t\n\']+[ \t\n\']" nil t count)
+ (if (re-search-forward "[^ \t\n']+[ \t\n']" nil t count)
(if (not (eobp)) (backward-char 2))))
(defun vi-home-window-line (arg)
diff --git a/lisp/obsolete/vip.el b/lisp/obsolete/vip.el
index 4a9b8fff264..37defd1c5a4 100644
--- a/lisp/obsolete/vip.el
+++ b/lisp/obsolete/vip.el
@@ -80,7 +80,7 @@
(defvar vip-current-major-mode nil
"vip-current-major-mode is the major-mode vi considers it is now.
-\(buffer specific\)")
+\(buffer specific)")
(make-variable-buffer-local 'vip-current-major-mode)
@@ -1510,7 +1510,7 @@ used. This behavior is controlled by the sign of prefix numeric value."
(* (/ (point-max) 100) arg)
(/ (* (point-max) arg) 100)))
(back-to-indentation))
- (cond ((looking-at "[\(\[{]")
+ (cond ((looking-at "[([{]")
(if com (move-marker vip-com-point (point)))
(forward-sexp 1)
(if com
@@ -1719,7 +1719,7 @@ STRING. Search will be forward if FORWARD, otherwise backward."
(let (buffer)
(setq buffer
(read-buffer
- (format "switch to buffer \(%s\): "
+ (format "switch to buffer (%s): "
(buffer-name (other-buffer (current-buffer))))))
(switch-to-buffer buffer)
(vip-change-mode-to-vi)))
@@ -1730,7 +1730,7 @@ STRING. Search will be forward if FORWARD, otherwise backward."
(let (buffer)
(setq buffer
(read-buffer
- (format "Switch to buffer \(%s\): "
+ (format "Switch to buffer (%s): "
(buffer-name (other-buffer (current-buffer))))))
(switch-to-buffer-other-window buffer)
(vip-change-mode-to-vi)))
@@ -1741,7 +1741,7 @@ STRING. Search will be forward if FORWARD, otherwise backward."
(let (buffer buffer-name)
(setq buffer-name
(read-buffer
- (format "Kill buffer \(%s\): "
+ (format "Kill buffer (%s): "
(buffer-name (current-buffer)))))
(setq buffer
(if (null buffer-name)
@@ -2162,7 +2162,7 @@ is a command.")
(defun vip-get-ex-token ()
"get an ex-token which is either an address or a command.
-a token has type \(command, address, end-mark\) and value."
+a token has type \(command, address, end-mark) and value."
(with-current-buffer " *ex-working-space*"
(skip-chars-forward " \t")
(cond ((looking-at "[k#]")
@@ -2668,7 +2668,7 @@ a token has type \(command, address, end-mark\) and value."
"ex-edit"
(vip-get-ex-file)
(if (and (not ex-variant) (buffer-modified-p) buffer-file-name)
- (error "No write since last change \(:e! overrides\)"))
+ (error "No write since last change (:e! overrides)"))
(vip-change-mode-to-emacs)
(set-buffer
(find-file-noselect (concat default-directory ex-file)))
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index 7654c7ebe41..fe9af1ce602 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -2437,7 +2437,7 @@ INFO may provide the values of these header arguments (in the
(when location
(save-excursion
(goto-char location)
- (when (looking-at (concat org-babel-result-regexp ".*$"))
+ (when (looking-at org-babel-result-regexp)
(delete-region
(if keep-keyword (line-beginning-position 2)
(save-excursion
@@ -3053,9 +3053,8 @@ of `org-babel-temporary-directory'."
(if (eq t (car (file-attributes file)))
(delete-directory file)
(delete-file file)))
- ;; We do not want to delete "." and "..".
(directory-files org-babel-temporary-directory 'full
- (rx (or (not ".") "..."))))
+ directory-files-no-dot-files-regexp))
(delete-directory org-babel-temporary-directory))
(error
(message "Failed to remove temporary Org-babel directory %s"
diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el
index 154465f28e1..149058f05f4 100644
--- a/lisp/org/ob-fortran.el
+++ b/lisp/org/ob-fortran.el
@@ -106,7 +106,7 @@ its header arguments."
(defun org-babel-fortran-ensure-main-wrap (body params)
"Wrap body in a \"program ... end program\" block if none exists."
- (if (string-match "^[ \t]*program[ \t]*.*" (capitalize body))
+ (if (string-match "^[ \t]*program\\>" (capitalize body))
(let ((vars (org-babel--get-vars params)))
(when vars (error "Cannot use :vars if `program' statement is present"))
body)
diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el
index 5bf9e2beee4..49886e292e5 100644
--- a/lisp/org/ob-plantuml.el
+++ b/lisp/org/ob-plantuml.el
@@ -26,7 +26,7 @@
;; Org-Babel support for evaluating plantuml script.
;;
;; Inspired by Ian Yang's org-export-blocks-format-plantuml
-;; http://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el
+;; https://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el
;;; Requirements:
diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el
index 90956271cf5..1b8088eaee4 100644
--- a/lisp/org/ob-ruby.el
+++ b/lisp/org/ob-ruby.el
@@ -30,10 +30,10 @@
;; - ruby and irb executables :: http://www.ruby-lang.org/
;;
;; - ruby-mode :: Can be installed through ELPA, or from
-;; http://github.com/eschulte/rinari/raw/master/util/ruby-mode.el
+;; https://github.com/eschulte/rinari/raw/master/util/ruby-mode.el
;;
;; - inf-ruby mode :: Can be installed through ELPA, or from
-;; http://github.com/eschulte/rinari/raw/master/util/inf-ruby.el
+;; https://github.com/eschulte/rinari/raw/master/util/inf-ruby.el
;;; Code:
(require 'ob)
diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el
index 60c081dcb38..c101574696c 100644
--- a/lisp/org/ob-sass.el
+++ b/lisp/org/ob-sass.el
@@ -35,7 +35,7 @@
;;; Requirements:
-;; - sass-mode :: http://github.com/nex3/haml/blob/master/extra/sass-mode.el
+;; - sass-mode :: https://github.com/nex3/haml/blob/master/extra/sass-mode.el
;;; Code:
(require 'ob)
diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el
index ad00ee070d4..837c18f8407 100644
--- a/lisp/org/ob-screen.el
+++ b/lisp/org/ob-screen.el
@@ -126,7 +126,7 @@ The terminal should shortly flicker."
;; XXX: need to find a better way to do the following
(while (not (file-readable-p tmpfile))
;; do something, otherwise this will be optimized away
- (format "org-babel-screen: File not readable yet."))
+ (sit-for 0.1))
(setq tmp-string (with-temp-buffer
(insert-file-contents-literally tmpfile)
(buffer-substring (point-min) (point-max))))
diff --git a/lisp/org/ob-stan.el b/lisp/org/ob-stan.el
index c563a6c3e55..678047c8008 100644
--- a/lisp/org/ob-stan.el
+++ b/lisp/org/ob-stan.el
@@ -41,7 +41,7 @@
;; For more information and usage examples, visit
;; https://orgmode.org/worg/org-contrib/babel/languages/ob-doc-stan.html
;;
-;; [1] http://mc-stan.org/
+;; [1] https://mc-stan.org/
;;; Code:
(require 'ob)
diff --git a/lisp/org/ol-gnus.el b/lisp/org/ol-gnus.el
index 99472315f67..71d55cd7c8d 100644
--- a/lisp/org/ol-gnus.el
+++ b/lisp/org/ol-gnus.el
@@ -34,7 +34,7 @@
(require 'gnus-sum)
(require 'gnus-util)
(require 'nnheader)
-(require 'nnir)
+(require 'nnselect)
(require 'ol)
@@ -140,9 +140,9 @@ If `org-store-link' was called with a prefix arg the meaning of
(`(nnvirtual . ,_)
(save-excursion
(car (nnvirtual-map-article (gnus-summary-article-number)))))
- (`(nnir . ,_)
+ (`(nnselect . ,_)
(save-excursion
- (nnir-article-group (gnus-summary-article-number))))
+ (nnselect-article-group (gnus-summary-article-number))))
(_ gnus-newsgroup-name)))
(header (if (eq major-mode 'gnus-article-mode)
;; When in an article, first move to summary
diff --git a/lisp/org/ol.el b/lisp/org/ol.el
index baed23bc9a4..c9e4da598ff 100644
--- a/lisp/org/ol.el
+++ b/lisp/org/ol.el
@@ -845,8 +845,8 @@ E.g. \"%C3%B6\" becomes the german o-Umlaut."
(insert link)
(insert (make-string (- (skip-chars-backward "\\\\"))
?\\))
- (while (search-backward "\]" nil t)
- (when (looking-at-p "\\]\\(?:[][]\\|\\'\\)")
+ (while (search-backward "]" nil t)
+ (when (looking-at-p "]\\(?:[][]\\|\\'\\)")
(insert (make-string (1+ (- (skip-chars-backward "\\\\")))
?\\))))
(buffer-string)))
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 4f89ea54500..689d134627e 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -1883,7 +1883,7 @@ Nil means don't hide any tags."
:group 'org-agenda-line-format
:type '(choice
(const :tag "Hide none" nil)
- (string :tag "Regexp ")))
+ (regexp :tag "Regexp ")))
(defvaralias 'org-agenda-remove-tags-when-in-prefix
'org-agenda-remove-tags)
@@ -1980,7 +1980,7 @@ category, you can use:
(\"Emacs\" \\='(space . (:width (16))))"
:group 'org-agenda-line-format
:version "24.1"
- :type '(alist :key-type (string :tag "Regexp matching category")
+ :type '(alist :key-type (regexp :tag "Regexp matching category")
:value-type (choice (list :tag "Icon"
(string :tag "File or data")
(symbol :tag "Type")
@@ -2995,7 +2995,8 @@ Agenda views are separated by `org-agenda-block-separator'."
(erase-buffer)
(insert (eval-when-compile
(let ((header
- "Press key for an agenda command:
+ (copy-sequence
+ "Press key for an agenda command:
-------------------------------- < Buffer, subtree/region restriction
a Agenda for current week or day > Remove restriction
t List of all TODO entries e Export agenda views
@@ -3004,7 +3005,7 @@ s Search for keywords M Like m, but only TODO entries
/ Multi-occur S Like s, but only TODO entries
? Find :FLAGGED: entries C Configure custom agenda commands
* Toggle sticky agenda views # List stuck projects (!=configure)
-")
+"))
(start 0))
(while (string-match
"\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)"
@@ -8981,7 +8982,6 @@ fold drawers."
(narrow-to-region (org-entry-beginning-position)
(org-entry-end-position))
(org-show-all '(drawers))))
- (when arg )
(setq org-agenda-show-window (selected-window)))
(select-window win)))
diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el
index 003cbef1fdf..ace51270175 100644
--- a/lisp/org/org-capture.el
+++ b/lisp/org/org-capture.el
@@ -1021,7 +1021,7 @@ Store them in the capture property list."
(apply #'encode-time 0 0
org-extend-today-until
(cl-cdddr (decode-time prompt-time))))
- ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)"
+ ((string-match "\\([^ ]+\\)-[^ ]+[ ]+\\(.*\\)"
org-read-date-final-answer)
;; Replace any time range by its start.
(apply #'encode-time
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index 4b5f9a19e6d..be74dfdbeff 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -4892,7 +4892,7 @@ with `org-element--cache-compare'. This cache is used in
A request is a vector with the following pattern:
- \[NEXT BEG END OFFSET PARENT PHASE]
+ [NEXT BEG END OFFSET PARENT PHASE]
Processing a synchronization request consists of three phases:
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index 0ff0e401d27..55a534d0dcd 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -278,7 +278,7 @@ This should be a single regexp string."
:group 'org-protocol
:version "24.4"
:package-version '(Org . "8.0")
- :type 'string)
+ :type 'regexp)
;;; Helper functions:
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index 49765472558..5c37cb1af52 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -198,7 +198,7 @@ Other options offered by the customize interface are more restrictive."
"^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][[:xdigit:].]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$")
(const :tag "Very General Number-Like, including hex and Calc radix, allows comma as decimal mark"
"^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][[:xdigit:].]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$")
- (string :tag "Regexp:")))
+ (regexp :tag "Regexp:")))
(defcustom org-table-number-fraction 0.5
"Fraction of numbers in a column required to make the column align right.
@@ -2005,7 +2005,7 @@ the table and kill the editing buffer."
text)
(goto-char (point-min))
(while (re-search-forward "^#.*\n?" nil t) (replace-match ""))
- (while (re-search-forward "\\([ \t]*\n[ \t]*\\)+" nil t)
+ (while (re-search-forward "[ \t]*\n[ \t\n]*" nil t)
(replace-match " "))
(setq text (org-trim (buffer-string)))
(set-window-configuration cw)
@@ -3099,7 +3099,7 @@ function assumes the table is already analyzed (i.e., using
(let ((lhs (car e))
(rhs (cdr e)))
(cond
- ((string-match-p "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs)
+ ((string-match-p "\\`@[-+0-9]+\\$-?[0-9]+\\'" lhs)
;; This just refers to one fixed field.
(push e res))
((string-match-p "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs)
@@ -6122,7 +6122,7 @@ which will prompt for the width."
;; Here are two examples of different styles.
;; Unicode block characters are used to give a smooth effect.
-;; See http://en.wikipedia.org/wiki/Block_Elements
+;; See https://en.wikipedia.org/wiki/Block_Elements
;; Use one of those drawing functions
;; - orgtbl-ascii-draw (the default ascii)
;; - orgtbl-uc-draw-grid (unicode with a grid effect)
@@ -6136,7 +6136,7 @@ which will prompt for the width."
It is a variant of orgtbl-ascii-draw with Unicode block
characters, for a smooth display. Bars appear as grids (to the
extent the font allows)."
- ;; http://en.wikipedia.org/wiki/Block_Elements
+ ;; https://en.wikipedia.org/wiki/Block_Elements
;; best viewed with the "DejaVu Sans Mono" font.
(orgtbl-ascii-draw value min max width
" \u258F\u258E\u258D\u258C\u258B\u258A\u2589"))
diff --git a/lisp/org/org.el b/lisp/org/org.el
index a7502d188e2..7733198c588 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -460,7 +460,7 @@ Matched keyword is in group 1.")
org-clock-string)
t)
"\\)?"
- " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]"
+ " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*[]>]"
"\\|"
"<%%([^\r\n>]*>\\)")
"Matches a timestamp, possibly preceded by a keyword.")
@@ -564,14 +564,14 @@ Effort estimates given in this property need to have the format H:MM.")
;;;; Timestamp
-(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>"
+(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*\\)>"
"Regular expression for fast time stamp matching.")
(defconst org-ts-regexp-inactive
- "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)\\]"
+ "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*\\)\\]"
"Regular expression for fast inactive time stamp matching.")
-(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]"
+(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*\\)[]>]"
"Regular expression for fast time stamp matching.")
(defconst org-ts-regexp0
@@ -11410,8 +11410,8 @@ D Show deadlines and scheduled items between a date range."
(setq type (or type org-sparse-tree-default-date-type))
(setq org-ts-type type)
(message "Sparse tree: [r]egexp [t]odo [T]odo-kwd [m]atch [p]roperty
- \[d]eadlines [b]efore-date [a]fter-date [D]ates range
- \[c]ycle through date types: %s"
+ [d]eadlines [b]efore-date [a]fter-date [D]ates range
+ [c]ycle through date types: %s"
(cl-case type
(all "all timestamps")
(scheduled "only scheduled")
diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el
index edb3150796f..2f61abad9cc 100644
--- a/lisp/org/ox-latex.el
+++ b/lisp/org/ox-latex.el
@@ -1239,7 +1239,7 @@ calling `org-latex-compile'."
:package-version '(Org . "8.3")
:type '(repeat
(cons
- (string :tag "Regexp")
+ (regexp :tag "Regexp")
(string :tag "Message"))))
diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el
index 51cb42a49a5..a1486318a7d 100644
--- a/lisp/org/ox-odt.el
+++ b/lisp/org/ox-odt.el
@@ -940,7 +940,7 @@ See `org-odt--build-date-styles' for implementation details."
(has-time-p (or (not timestamp)
(org-timestamp-has-time-p timestamp)))
(iso-date (let ((format (if has-time-p "%Y-%m-%dT%H:%M:%S"
- "%Y-%m-%dT%H:%M:%S")))
+ "%Y-%m-%d")))
(funcall format-timestamp timestamp format end))))
(if iso-date-p iso-date
(let* ((style (if has-time-p "OrgDate2" "OrgDate1"))
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index 797efb90b79..2f8fd0c645b 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -5459,7 +5459,7 @@ transcoding it."
(apostrophe :utf-8 "’" :html "&rsquo;"))
("da"
;; one may use: »...«, "...", ›...‹, or '...'.
- ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/
+ ;; https://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/
;; LaTeX quotes require Babel!
(primary-opening
:utf-8 "»" :html "&raquo;" :latex ">>" :texinfo "@guillemetright{}")
@@ -5553,7 +5553,7 @@ transcoding it."
(secondary-closing :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
(apostrophe :utf-8 "’" :html "&rsquo;"))
("ru"
- ;; http://ru.wikipedia.org/wiki/%D0%9A%D0%B0%D0%B2%D1%8B%D1%87%D0%BA%D0%B8#.D0.9A.D0.B0.D0.B2.D1.8B.D1.87.D0.BA.D0.B8.2C_.D0.B8.D1.81.D0.BF.D0.BE.D0.BB.D1.8C.D0.B7.D1.83.D0.B5.D0.BC.D1.8B.D0.B5_.D0.B2_.D1.80.D1.83.D1.81.D1.81.D0.BA.D0.BE.D0.BC_.D1.8F.D0.B7.D1.8B.D0.BA.D0.B5
+ ;; https://ru.wikipedia.org/wiki/%D0%9A%D0%B0%D0%B2%D1%8B%D1%87%D0%BA%D0%B8#.D0.9A.D0.B0.D0.B2.D1.8B.D1.87.D0.BA.D0.B8.2C_.D0.B8.D1.81.D0.BF.D0.BE.D0.BB.D1.8C.D0.B7.D1.83.D0.B5.D0.BC.D1.8B.D0.B5_.D0.B2_.D1.80.D1.83.D1.81.D1.81.D0.BA.D0.BE.D0.BC_.D1.8F.D0.B7.D1.8B.D0.BA.D0.B5
;; http://www.artlebedev.ru/kovodstvo/sections/104/
(primary-opening :utf-8 "«" :html "&laquo;" :latex "{}<<"
:texinfo "@guillemetleft{}")
diff --git a/lisp/outline.el b/lisp/outline.el
index 28ea8a86e6f..6158ed594e9 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -289,12 +289,19 @@ Turning on outline mode calls the value of `text-mode-hook' and then of
(list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0)))
(add-hook 'change-major-mode-hook 'outline-show-all nil t))
+(defvar outline-minor-mode-map)
+
(defcustom outline-minor-mode-prefix "\C-c@"
"Prefix key to use for Outline commands in Outline minor mode.
The value of this variable is checked as part of loading Outline mode.
After that, changing the prefix key requires manipulating keymaps."
- :type 'string
- :group 'outlines)
+ :type 'key-sequence
+ :group 'outlines
+ :initialize 'custom-initialize-default
+ :set (lambda (sym val)
+ (define-key outline-minor-mode-map outline-minor-mode-prefix nil)
+ (define-key outline-minor-mode-map val outline-mode-prefix-map)
+ (set-default sym val)))
;;;###autoload
(define-minor-mode outline-minor-mode
diff --git a/lisp/password-cache.el b/lisp/password-cache.el
index 5e5f3240bc3..2443f374a84 100644
--- a/lisp/password-cache.el
+++ b/lisp/password-cache.el
@@ -31,7 +31,8 @@
;; ;; Minibuffer prompt for password.
;; => "foo"
;;
-;; (password-cache-add "test" "foo")
+;; (password-cache-add "test" (read-passwd "Password? "))
+;; ;; Minibuffer prompt from read-passwd, which returns "foo".
;; => nil
;; (password-read "Password? " "test")
@@ -93,22 +94,6 @@ The variable `password-cache' control whether the cache is used."
(or (password-read-from-cache key)
(read-passwd prompt)))
-(defun password-read-and-add (prompt &optional key)
- "Read password, for use with KEY, from user, or from cache if wanted.
-Then store the password in the cache. Uses `password-read' and
-`password-cache-add'. Custom variables `password-cache' and
-`password-cache-expiry' regulate cache behavior.
-
-Warning: the password is cached without checking that it is
-correct. It is better to check the password before caching. If
-you must use this function, take care to check passwords and
-remove incorrect ones from the cache."
- (declare (obsolete password-read "23.1"))
- (let ((password (password-read prompt key)))
- (when (and password key)
- (password-cache-add key password))
- password))
-
(defun password-cache-remove (key)
"Remove password indexed by KEY from password cache.
This is typically run by a timer setup from `password-cache-add',
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
index 098aa3d5fe1..d7c5b381d29 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -118,7 +118,7 @@
Return the new list."
(goto-char (point-min))
(while (re-search-forward
- "^\\s-*\\([^\n#%.$][^:=\n]*\\)\\s-*:[^=]" nil t)
+ "^\\([^\t\n#%.$][^:=\n]*\\)\\s-*:[^=]" nil t)
(setq targets (nconc (split-string (match-string-no-properties 1))
targets)))
targets)
diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el
index 6e036434ef2..df9d24507a0 100644
--- a/lisp/pcmpl-linux.el
+++ b/lisp/pcmpl-linux.el
@@ -1,4 +1,4 @@
-;;; pcmpl-linux.el --- functions for dealing with GNU/Linux completions
+;;; pcmpl-linux.el --- functions for dealing with GNU/Linux completions -*- lexical-binding: t -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -65,18 +65,22 @@
(pcomplete-opt "hVanfFrsvwt(pcmpl-linux-fs-types)o?L?U?")
(while (pcomplete-here (pcomplete-entries) nil 'identity)))
+(defconst pcmpl-linux-fs-modules-path-format "/lib/modules/%s/kernel/fs/")
+
(defun pcmpl-linux-fs-types ()
"Return a list of available fs modules on GNU/Linux systems."
(let ((kernel-ver (pcomplete-process-result "uname" "-r")))
(directory-files
- (concat "/lib/modules/" kernel-ver "/kernel/fs/"))))
+ (format pcmpl-linux-fs-modules-path-format kernel-ver))))
+
+(defconst pcmpl-linux-mtab-file "/etc/mtab")
(defun pcmpl-linux-mounted-directories ()
"Return a list of mounted directory names."
(let (points)
- (when (file-readable-p "/etc/mtab")
+ (when (file-readable-p pcmpl-linux-mtab-file)
(with-temp-buffer
- (insert-file-contents-literally "/etc/mtab")
+ (insert-file-contents-literally pcmpl-linux-mtab-file)
(while (not (eobp))
(let* ((line (buffer-substring (point) (line-end-position)))
(args (split-string line " ")))
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index f1c8725afea..13de4b65e5b 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -1,4 +1,4 @@
-;;; pcmpl-unix.el --- standard UNIX completions
+;;; pcmpl-unix.el --- standard UNIX completions -*- lexical-binding:t -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -82,10 +82,14 @@ being via `pcmpl-ssh-known-hosts-file'."
;;;###autoload
(defun pcomplete/xargs ()
"Completion for `xargs'."
- (pcomplete-here (funcall pcomplete-command-completion-function))
+ ;; FIXME: Add completion of xargs-specific arguments.
+ (funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
+;; FIXME: Add completion of sudo-specific arguments.
+(defalias 'pcomplete/sudo #'pcomplete/xargs)
+
;;;###autoload
(defalias 'pcomplete/time 'pcomplete/xargs)
@@ -144,7 +148,7 @@ documentation), this function returns nil."
;; ssh support by Phil Hagelberg.
-;; http://www.emacswiki.org/cgi-bin/wiki/pcmpl-ssh.el
+;; https://www.emacswiki.org/cgi-bin/wiki/pcmpl-ssh.el
(defun pcmpl-ssh-known-hosts ()
"Return a list of hosts found in `pcmpl-ssh-known-hosts-file'."
@@ -155,12 +159,14 @@ documentation), this function returns nil."
(let ((host-re "\\(?:\\([-.[:alnum:]]+\\)\\|\\[\\([-.[:alnum:]]+\\)\\]:[0-9]+\\)[, ]")
ssh-hosts-list)
(while (re-search-forward (concat "^ *" host-re) nil t)
- (add-to-list 'ssh-hosts-list (concat (match-string 1)
- (match-string 2)))
+ (push (concat (match-string 1)
+ (match-string 2))
+ ssh-hosts-list)
(while (and (eq (char-before) ?,)
(re-search-forward host-re (line-end-position) t))
- (add-to-list 'ssh-hosts-list (concat (match-string 1)
- (match-string 2)))))
+ (push (concat (match-string 1)
+ (match-string 2))
+ ssh-hosts-list)))
ssh-hosts-list))))
(defun pcmpl-ssh-config-hosts ()
@@ -173,7 +179,7 @@ documentation), this function returns nil."
(case-fold-search t))
(while (re-search-forward "^ *host\\(name\\)? +\\([-.[:alnum:]]+\\)"
nil t)
- (add-to-list 'ssh-hosts-list (match-string 2)))
+ (push (match-string 2) ssh-hosts-list))
ssh-hosts-list))))
(defun pcmpl-ssh-hosts ()
@@ -181,7 +187,7 @@ documentation), this function returns nil."
Uses both `pcmpl-ssh-config-file' and `pcmpl-ssh-known-hosts-file'."
(let ((hosts (pcmpl-ssh-known-hosts)))
(dolist (h (pcmpl-ssh-config-hosts))
- (add-to-list 'hosts h))
+ (push h hosts))
hosts))
;;;###autoload
@@ -215,6 +221,29 @@ Includes files as well as host names followed by a colon."
(pcmpl-ssh-hosts)))))))
(complete-with-action action table string pred))))))
+(defsubst pcmpl-unix-complete-hostname ()
+ "Complete a command that wants a hostname for an argument."
+ (pcomplete-here (pcomplete-read-host-names)))
+
+(defalias 'pcomplete/ftp 'pcmpl-unix-complete-hostname)
+(defalias 'pcomplete/ncftp 'pcmpl-unix-complete-hostname)
+(defalias 'pcomplete/ping 'pcmpl-unix-complete-hostname)
+(defalias 'pcomplete/rlogin 'pcmpl-unix-complete-hostname)
+
+;;;###autoload
+(defun pcomplete/telnet ()
+ (pcomplete-opt "xl(pcmpl-unix-user-names)")
+ (pcmpl-unix-complete-hostname))
+
+;;;###autoload
+(defun pcomplete/rsh ()
+ "Complete `rsh', which, after the user and hostname, is like xargs."
+ (pcomplete-opt "l(pcmpl-unix-user-names)")
+ (pcmpl-unix-complete-hostname)
+ (pcomplete-here (funcall pcomplete-command-completion-function))
+ (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
+ pcomplete-default-completion-function)))
+
(provide 'pcmpl-unix)
;;; pcmpl-unix.el ends here
diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el
index 5244ada5231..6e96a67b7b2 100644
--- a/lisp/pcmpl-x.el
+++ b/lisp/pcmpl-x.el
@@ -286,5 +286,37 @@ long options."
(pcmpl-x-ag-options))))
(pcomplete-here* (pcomplete-dirs-or-entries)))))
+;;;###autoload
+(defun pcomplete/bcc32 ()
+ "Completion function for Borland's C++ compiler."
+ (let ((cur (pcomplete-arg 0)))
+ (cond
+ ((string-match "\\`-w\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
+ (pcomplete-here
+ '("ali" "amb" "amp" "asc" "asm" "aus" "bbf" "bei" "big" "ccc"
+ "cln" "cod" "com" "cpt" "csu" "def" "dig" "dpu" "dsz" "dup"
+ "eas" "eff" "ext" "hch" "hid" "ias" "ibc" "ifr" "ill" "nil"
+ "lin" "lvc" "mcs" "mes" "mpc" "mpd" "msg" "nak" "ncf" "nci"
+ "ncl" "nfd" "ngu" "nin" "nma" "nmu" "nod" "nop" "npp" "nsf"
+ "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)))
+ ((string-match "\\`-[LIn]\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
+ (pcomplete-here (pcomplete-dirs) (match-string 2 cur)))
+ ((string-match "\\`-[Ee]\\(.*\\)\\'" cur)
+ (pcomplete-here (pcomplete-dirs-or-entries "\\.[Ee][Xx][Ee]\\'")
+ (match-string 1 cur)))
+ ((string-match "\\`-o\\(.*\\)\\'" cur)
+ (pcomplete-here (pcomplete-dirs-or-entries "\\.[Oo][Bb][Jj]\\'")
+ (match-string 1 cur)))
+ (t
+ (pcomplete-opt "3456ABCDEHIKLMNOPRSTUVXabcdefgijklnoptuvwxyz"))))
+ (while (pcomplete-here
+ (pcomplete-dirs-or-entries "\\.[iCc]\\([Pp][Pp]\\)?\\'"))))
+
+;;;###autoload
+(defalias 'pcomplete/bcc 'pcomplete/bcc32)
+
(provide 'pcmpl-x)
;;; pcmpl-x.el ends here
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 32e61e84e0d..014f9628b99 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -325,6 +325,10 @@ already terminated by a character, this variable should be locally
modified to be an empty string, or the desired separation string."
:type 'string)
+(defcustom pcomplete-hosts-file "/etc/hosts"
+ "The name of the /etc/hosts file."
+ :type '(choice (const :tag "No hosts file" nil) file))
+
;;; Internal Variables:
;; for cycling completion support
@@ -1289,6 +1293,46 @@ If specific documentation can't be given, be generic."
(skip-chars-backward "\n")
(buffer-substring (point-min) (point))))
+;; hostname completion
+
+(defvar pcomplete--host-name-cache nil
+ "A cache the names of frequently accessed hosts.")
+
+(defvar pcomplete--host-name-cache-timestamp nil
+ "A timestamp of when the hosts file was read.")
+
+(defun pcomplete-read-hosts-file (filename)
+ "Read in the hosts from FILENAME, default `pcomplete-hosts-file'."
+ (let (hosts)
+ (with-temp-buffer
+ (insert-file-contents (or filename pcomplete-hosts-file))
+ (goto-char (point-min))
+ (while (re-search-forward
+ ;; "^ \t\\([^# \t\n]+\\)[ \t]+\\([^ \t\n]+\\)\\([ \t]*\\([^ \t\n]+\\)\\)?"
+ "^[ \t]*\\([^# \t\n]+\\)[ \t]+\\([^ \t\n].+\\)" nil t)
+ (push (cons (match-string 1)
+ (split-string (match-string 2)))
+ hosts)))
+ (nreverse hosts)))
+
+(defun pcomplete-read-hosts (file result-var timestamp-var)
+ "Read the contents of /etc/hosts for host names."
+ (if (or (not (symbol-value result-var))
+ (not (symbol-value timestamp-var))
+ (time-less-p
+ (symbol-value timestamp-var)
+ (file-attribute-modification-time (file-attributes file))))
+ (progn
+ (set result-var (apply #'nconc (pcomplete-read-hosts-file file)))
+ (set timestamp-var (current-time))))
+ (symbol-value result-var))
+
+(defun pcomplete-read-host-names ()
+ "Read the contents of /etc/hosts for host names."
+ (if pcomplete-hosts-file
+ (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
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 7c4941e7256..3d4843a39c6 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -582,7 +582,7 @@ Solutions are sorted from least to greatest Hamming weight."
(math-sub dest org))))
;; transferm is the transfer matrix, ie it is the 25x25
- ;; matrix applied everytime a flip is carried out where a
+ ;; matrix applied every time a flip is carried out where a
;; flip is defined by a 25x1 Dirac vector --- ie all zeros
;; but 1 in the position that is flipped.
(transferm
diff --git a/lisp/play/animate.el b/lisp/play/animate.el
index ff464b68049..8dec55178b1 100644
--- a/lisp/play/animate.el
+++ b/lisp/play/animate.el
@@ -1,4 +1,4 @@
-;;; animate.el --- make text dance
+;;; animate.el --- make text dance -*- lexical-binding:t -*-
;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
@@ -84,7 +84,7 @@
(defun animate-place-char (char vpos hpos)
(goto-char (window-start))
(let (abbrev-mode)
- (dotimes (i vpos)
+ (dotimes (_ vpos)
(end-of-line)
(if (= (forward-line 1) 1)
(insert "\n"))))
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el
index 6842cb06302..d512a718b48 100644
--- a/lisp/play/bubbles.el
+++ b/lisp/play/bubbles.el
@@ -28,7 +28,7 @@
;; possible in as few moves as possible.
;; Bubbles is an implementation of the "Same Game", similar to "Same
-;; GNOME" and many others, see <http://en.wikipedia.org/wiki/SameGame>.
+;; GNOME" and many others, see <https://en.wikipedia.org/wiki/SameGame>.
;; Installation
;; ------------
@@ -80,6 +80,7 @@
;;; Code:
(defconst bubbles-version "0.5" "Version number of bubbles.el.")
+(make-obsolete-variable 'bubbles-version nil "28.1")
(require 'gamegrid)
@@ -975,16 +976,14 @@ Set `bubbles--col-offset' and `bubbles--row-offset'."
(* image-vert-size (bubbles--grid-height)))
2)))))
-(defun bubbles--remove-overlays ()
- "Remove all overlays."
- (if (fboundp 'remove-overlays)
- (remove-overlays)))
+(define-obsolete-function-alias 'bubbles--remove-overlays
+ 'remove-overlays "28.1")
(defun bubbles--initialize ()
"Initialize Bubbles game."
(bubbles--initialize-faces)
(bubbles--initialize-images)
- (bubbles--remove-overlays)
+ (remove-overlays)
(switch-to-buffer (get-buffer-create "*bubbles*"))
(bubbles--compute-offsets)
@@ -1408,7 +1407,7 @@ Return t if new char is non-empty."
(defun bubbles--show-images ()
"Update images in the bubbles buffer."
- (bubbles--remove-overlays)
+ (remove-overlays)
(if (and (display-images-p)
bubbles--images-ok
(not (eq bubbles-graphics-theme 'ascii)))
diff --git a/lisp/play/dissociate.el b/lisp/play/dissociate.el
index 3768a14ad82..9a6300c0fd2 100644
--- a/lisp/play/dissociate.el
+++ b/lisp/play/dissociate.el
@@ -1,4 +1,4 @@
-;;; dissociate.el --- scramble text amusingly for Emacs
+;;; dissociate.el --- scramble text amusingly for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index f0132135fd9..74e6c2d034d 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -265,12 +265,7 @@ format."
(set-face-foreground face color)
(set-face-background face color)
(gamegrid-set-font face)
- (condition-case nil
- (set-face-background-pixmap face [nothing]);; XEmacs
- (error nil))
- (condition-case nil
- (set-face-background-pixmap face nil);; Emacs
- (error nil)))
+ (set-face-background-pixmap face nil))
(defun gamegrid-make-mono-tty-face ()
(let ((face (make-face 'gamegrid-mono-tty-face)))
@@ -640,6 +635,8 @@ FILE is created there."
(save-excursion
(setq file (expand-file-name file (or directory
temporary-file-directory)))
+ (unless (file-exists-p (file-name-directory file))
+ (make-directory (file-name-directory file) t))
(find-file-other-window file)
(setq buffer-read-only nil)
(goto-char (point-max))
diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el
index aa99b553244..a9417e9e0ac 100644
--- a/lisp/play/gametree.el
+++ b/lisp/play/gametree.el
@@ -121,8 +121,8 @@ Has to contain \"%d\" to output the actual number."
:group 'gametree)
(defcustom gametree-make-heading-function
- (function (lambda (level)
- (insert (make-string level ?*))))
+ (lambda (level)
+ (insert (make-string level ?*)))
"A function of one numeric argument, LEVEL, to insert a heading at point.
You should change this if you change `outline-regexp'."
:type 'function
@@ -324,7 +324,7 @@ This value is simply the outline heading level of the current line."
(defun gametree-hack-file-layout ()
(save-excursion
(goto-char (point-min))
- (if (looking-at "[^\n]*-*-[^\n]*gametree-local-layout: \\([^;\n]*\\);")
+ (if (looking-at "[^\n]*-[^\n]*gametree-local-layout: \\([^;\n]*\\);")
(progn
(goto-char (match-beginning 1))
(delete-region (point) (match-end 1))
diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
index 6e0061d461a..403398672b1 100644
--- a/lisp/play/gomoku.el
+++ b/lisp/play/gomoku.el
@@ -110,8 +110,8 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces."
(define-key map "u" 'gomoku-move-ne) ; u
(define-key map "b" 'gomoku-move-sw) ; b
(define-key map "n" 'gomoku-move-se) ; n
- (define-key map "h" 'backward-char) ; h
- (define-key map "l" 'forward-char) ; l
+ (define-key map "h" 'gomoku-move-left) ; h
+ (define-key map "l" 'gomoku-move-right) ; l
(define-key map "j" 'gomoku-move-down) ; j
(define-key map "k" 'gomoku-move-up) ; k
@@ -119,11 +119,13 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces."
(define-key map [kp-9] 'gomoku-move-ne)
(define-key map [kp-1] 'gomoku-move-sw)
(define-key map [kp-3] 'gomoku-move-se)
- (define-key map [kp-4] 'backward-char)
- (define-key map [kp-6] 'forward-char)
+ (define-key map [kp-4] 'gomoku-move-left)
+ (define-key map [kp-6] 'gomoku-move-right)
(define-key map [kp-2] 'gomoku-move-down)
(define-key map [kp-8] 'gomoku-move-up)
+ (define-key map "\C-b" 'gomoku-move-left) ; C-b
+ (define-key map "\C-f" 'gomoku-move-right) ; C-f
(define-key map "\C-n" 'gomoku-move-down) ; C-n
(define-key map "\C-p" 'gomoku-move-up) ; C-p
@@ -146,6 +148,10 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces."
(define-key map [mouse-2] 'gomoku-mouse-play)
(define-key map [drag-mouse-2] 'gomoku-mouse-play)
+ (define-key map [remap backward-char] 'gomoku-move-left)
+ (define-key map [remap left-char] 'gomoku-move-left)
+ (define-key map [remap forward-char] 'gomoku-move-right)
+ (define-key map [remap right-char] 'gomoku-move-right)
(define-key map [remap previous-line] 'gomoku-move-up)
(define-key map [remap next-line] 'gomoku-move-down)
(define-key map [remap move-beginning-of-line] 'gomoku-beginning-of-line)
@@ -954,6 +960,11 @@ If the game is finished, this command requests for another game."
;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line !
gomoku-square-height)))
+(defun gomoku-point-x ()
+ "Return the board column where point is."
+ (1+ (/ (- (current-column) gomoku-x-offset)
+ gomoku-square-width)))
+
(defun gomoku-point-y ()
"Return the board row where point is."
(1+ (/ (- (count-lines (point-min) (point))
@@ -1143,13 +1154,28 @@ If the game is finished, this command requests for another game."
(skip-chars-forward gomoku--intangible-chars)
(when (eobp)
(skip-chars-backward gomoku--intangible-chars)
- (forward-char -1)))
+ (gomoku-move-left)))
(skip-chars-backward gomoku--intangible-chars)
(if (bobp)
(skip-chars-forward gomoku--intangible-chars)
- (forward-char -1))))
+ (gomoku-move-left))))
(setq gomoku--last-pos (point)))
+;; forward-char and backward-char don't always move the right number
+;; of characters. Also, these functions check if you're on the edge of
+;; the screen.
+(defun gomoku-move-right ()
+ "Move point right one column on the Gomoku board."
+ (interactive)
+ (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)
+ (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."
@@ -1171,25 +1197,25 @@ If the game is finished, this command requests for another game."
"Move point North East on the Gomoku board."
(interactive)
(gomoku-move-up)
- (forward-char))
+ (gomoku-move-right))
(defun gomoku-move-se ()
"Move point South East on the Gomoku board."
(interactive)
(gomoku-move-down)
- (forward-char))
+ (gomoku-move-right))
(defun gomoku-move-nw ()
"Move point North West on the Gomoku board."
(interactive)
(gomoku-move-up)
- (backward-char))
+ (gomoku-move-left))
(defun gomoku-move-sw ()
"Move point South West on the Gomoku board."
(interactive)
(gomoku-move-down)
- (backward-char))
+ (gomoku-move-left))
(defun gomoku-beginning-of-line ()
"Move point to first square on the Gomoku board row."
diff --git a/lisp/play/life.el b/lisp/play/life.el
index 06d5b4082ff..56ecc5273da 100644
--- a/lisp/play/life.el
+++ b/lisp/play/life.el
@@ -1,4 +1,4 @@
-;;; life.el --- John Horton Conway's `Life' game for GNU Emacs
+;;; life.el --- John Horton Conway's Game of Life -*- lexical-binding:t -*-
;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc.
@@ -29,6 +29,15 @@
;;; Code:
+(defgroup life nil
+ "Conway's Game of Life."
+ :group 'games)
+
+(defcustom life-step-time 0.5
+ "Time to sleep between steps (generations)."
+ :type 'number
+ :version "28.1")
+
(defvar life-patterns
[("@@@" " @@" "@@@")
("@@@ @@@" "@@ @@ " "@@@ @@@")
@@ -54,6 +63,7 @@
" @@")
("@@@@@@@@@" "@ @ @" "@ @@@@@ @" "@ @ @ @" "@@@ @@@"
"@ @ @ @" "@ @@@@@ @" "@ @ @" "@@@@@@@@@")
+ ;; Glider Gun (infinite, Bill Gosper, 1970)
(" @ "
" @ @ "
" @@ @@ @@"
@@ -74,7 +84,26 @@
" @@"
" @@ @"
"@ @ @")
- ("@@@@@@@@ @@@@@ @@@ @@@@@@@ @@@@@")]
+ ("@@@@@@@@ @@@@@ @@@ @@@@@@@ @@@@@")
+ ;; Pentadecathlon (period 15, John Conway, 1970)
+ (" @ @ "
+ "@@ @@@@ @@"
+ " @ @ ")
+ ;; Queen Bee Shuttle (period 30, Bill Gosper, 1970)
+ (" @ "
+ " @ @ "
+ " @ @ "
+ "@@ @ @ @@"
+ "@@ @ @ @@"
+ " @ @ "
+ " @ ")
+ ;; 2x Figure eight (period 8, Simon Norton, 1970)
+ ("@@@ @@@ "
+ "@@@ @@@ "
+ "@@@ @@@ "
+ " @@@ @@@"
+ " @@@ @@@"
+ " @@@ @@@")]
"Vector of rectangles containing some Life startup patterns.")
;; Macros are used macros for manifest constants instead of variables
@@ -106,28 +135,45 @@
;; (scroll-up) and (scroll-down) when trying to center the display.
(defvar life-window-start nil)
+(defvar life--max-width nil
+ "If non-nil, restrict width to this positive integer. ")
+
+(defvar life--max-height nil
+ "If non-nil, restrict height to this positive integer. ")
+
;; For mode line
(defvar life-current-generation nil)
;; Sadly, mode-line-format won't display numbers.
(defvar life-generation-string nil)
+(defun life--tick ()
+ "Game tick for `life'."
+ (let ((inhibit-quit t)
+ (inhibit-read-only t))
+ (life-grim-reaper)
+ (life-expand-plane-if-needed)
+ (life-increment-generation)))
+
;;;###autoload
-(defun life (&optional sleeptime)
+(defun life (&optional step-time)
"Run Conway's Life simulation.
-The starting pattern is randomly selected. Prefix arg (optional first
-arg non-nil from a program) is the number of seconds to sleep between
-generations (this defaults to 1)."
- (interactive "p")
- (or sleeptime (setq sleeptime 1))
+The starting pattern is randomly selected from `life-patterns'.
+
+Prefix arg is the number of tenths of a second to sleep between
+generations (the default is `life-step-time').
+
+When called from Lisp, optional argument STEP-TIME is the time to
+sleep in seconds."
+ (interactive "P")
+ (setq step-time (or (and step-time (/ (if (consp step-time)
+ (car step-time)
+ step-time) 10.0))
+ life-step-time))
(life-setup)
(catch 'life-exit
(while t
- (let ((inhibit-quit t)
- (inhibit-read-only t))
- (life-display-generation sleeptime)
- (life-grim-reaper)
- (life-expand-plane-if-needed)
- (life-increment-generation)))))
+ (life-display-generation step-time)
+ (life--tick))))
(define-derived-mode life-mode special-mode "Life"
"Major mode for the buffer of `life'."
@@ -138,16 +184,17 @@ generations (this defaults to 1)."
(setq-local life-generation-string "0")
(setq-local mode-line-buffer-identification '("Life: generation "
life-generation-string))
- (setq-local fill-column (1- (window-width)))
+ (setq-local fill-column (min (or life--max-width most-positive-fixnum)
+ (1- (window-width))))
(setq-local life-window-start 1)
(buffer-disable-undo))
(defun life-setup ()
(switch-to-buffer (get-buffer-create "*Life*") t)
- (erase-buffer)
- (life-mode)
;; stuff in the random pattern
(let ((inhibit-read-only t))
+ (erase-buffer)
+ (life-mode)
(life-insert-random-pattern)
;; make sure (life-life-char) is used throughout
(goto-char (point-min))
@@ -160,7 +207,8 @@ generations (this defaults to 1)."
(indent-to n)
(forward-line)))
;; center the pattern vertically
- (let ((n (/ (- (1- (window-height))
+ (let ((n (/ (- (min (or life--max-height most-positive-fixnum)
+ (1- (window-height)))
(count-lines (point-min) (point-max)))
2)))
(goto-char (point-min))
@@ -276,12 +324,12 @@ generations (this defaults to 1)."
(insert ?\n)
(setq life-window-start (+ life-window-start fill-column 1)))))
-(defun life-display-generation (sleeptime)
+(defun life-display-generation (step-time)
(goto-char life-window-start)
(recenter 0)
;; Redisplay; if the user has hit a key, exit the loop.
- (or (and (sit-for sleeptime) (< 0 sleeptime))
+ (or (and (sit-for step-time) (< 0 step-time))
(not (input-pending-p))
(throw 'life-exit nil)))
diff --git a/lisp/play/pong.el b/lisp/play/pong.el
index d5723344a0d..4e6d73b6e94 100644
--- a/lisp/play/pong.el
+++ b/lisp/play/pong.el
@@ -1,4 +1,4 @@
-;;; pong.el --- classical implementation of pong
+;;; pong.el --- classical implementation of pong -*- lexical-binding:t -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -33,88 +33,72 @@
;;; Customization
(defgroup pong nil
- "Emacs-Lisp implementation of the classical game pong."
+ "Emacs Lisp implementation of the classical game pong."
:tag "Pong"
:group 'games)
(defcustom pong-buffer-name "*Pong*"
"Name of the buffer used to play."
- :group 'pong
:type '(string))
(defcustom pong-width 50
"Width of the playfield."
- :group 'pong
:type '(integer))
(defcustom pong-height (min 30 (- (frame-height) 6))
"Height of the playfield."
- :group 'pong
:type '(integer))
(defcustom pong-bat-width 3
"Width of the bats for pong."
- :group 'pong
:type '(integer))
(defcustom pong-blank-color "black"
"Color used for background."
- :group 'pong
:type 'color)
(defcustom pong-bat-color "yellow"
"Color used for bats."
- :group 'pong
:type 'color)
(defcustom pong-ball-color "red"
"Color used for the ball."
- :group 'pong
:type 'color)
(defcustom pong-border-color "white"
"Color used for pong borders."
- :group 'pong
:type 'color)
(defcustom pong-left-key "4"
"Alternate key to press for bat 1 to go up (primary one is [left])."
- :group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-right-key "6"
"Alternate key to press for bat 1 to go down (primary one is [right])."
- :group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-up-key "8"
"Alternate key to press for bat 2 to go up (primary one is [up])."
- :group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-down-key "2"
"Alternate key to press for bat 2 to go down (primary one is [down])."
- :group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-quit-key "q"
"Key to press to quit pong."
- :group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-pause-key "p"
"Key to press to pause pong."
- :group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-resume-key "p"
"Key to press to resume pong."
- :group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-timer-delay 0.1
"Time to wait between every cycle."
- :group 'pong
:type 'number)
diff --git a/lisp/play/snake.el b/lisp/play/snake.el
index d7c0683a05f..8ea214d8025 100644
--- a/lisp/play/snake.el
+++ b/lisp/play/snake.el
@@ -1,4 +1,4 @@
-;;; snake.el --- implementation of Snake for Emacs
+;;; snake.el --- implementation of Snake for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
@@ -192,6 +192,7 @@ and then start moving it leftwards.")
(defvar snake-null-map
(let ((map (make-sparse-keymap 'snake-null-map)))
(define-key map "n" 'snake-start-game)
+ (define-key map "q" 'quit-window)
map)
"Keymap for finished Snake games.")
@@ -278,7 +279,7 @@ and then start moving it leftwards.")
snake-velocity-queue nil)
(let ((x snake-initial-x)
(y snake-initial-y))
- (dotimes (i snake-length)
+ (dotimes (_ snake-length)
(gamegrid-set-cell x y snake-snake)
(setq snake-positions (cons (vector x y) snake-positions))
(cl-incf x snake-velocity-x)
diff --git a/lisp/play/spook.el b/lisp/play/spook.el
index 8e69cd971bb..ed91dadcbca 100644
--- a/lisp/play/spook.el
+++ b/lisp/play/spook.el
@@ -1,4 +1,4 @@
-;;; spook.el --- spook phrase utility for overloading the NSA line eater
+;;; spook.el --- spook phrase utility for overloading the NSA line eater -*- lexical-binding:t -*-
;; Copyright (C) 1988, 1993, 2001-2020 Free Software Foundation, Inc.
@@ -45,13 +45,11 @@
(defcustom spook-phrases-file (expand-file-name "spook.lines" data-directory)
"Keep your favorite phrases here."
- :type 'file
- :group 'spook)
+ :type 'file)
(defcustom spook-phrase-default-count 15
"Default number of phrases to insert."
- :type 'integer
- :group 'spook)
+ :type 'integer)
;;;###autoload
(defun spook ()
diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el
index 97979b5b6b6..e25cacbb722 100644
--- a/lisp/play/tetris.el
+++ b/lisp/play/tetris.el
@@ -1,4 +1,4 @@
-;;; tetris.el --- implementation of Tetris for Emacs
+;;; tetris.el --- implementation of Tetris for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/printing.el b/lisp/printing.el
index 0c564237da6..90ef02fe7b1 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -5,7 +5,7 @@
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, print, PostScript
;; Version: 6.9.3
-;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
+;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
(defconst pr-version "6.9.3"
"printing.el, v 6.9.3 <2007/12/09 vinicius>
@@ -64,7 +64,7 @@ Please send all bug fixes and enhancements to
;; interface to ps-print package and it also provides some extra stuff.
;;
;; To download the latest ps-print package see
-;; `http://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage'.
+;; `https://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage'.
;; Please, see README file for ps-print installation instructions.
;;
;; `printing' was inspired by:
@@ -944,8 +944,8 @@ Please send all bug fixes and enhancements to
;;
;; * For `printing' package:
;;
-;; printing `http://www.emacswiki.org/cgi-bin/emacs/download/printing.el'
-;; ps-print `http://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage'
+;; printing `https://www.emacswiki.org/cgi-bin/emacs/download/printing.el'
+;; ps-print `https://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage'
;;
;; * For GNU or Unix system:
;;
@@ -5284,22 +5284,18 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-interactive-n-up (mess)
- (or (stringp mess) (setq mess "*"))
- (save-match-data
- (let* ((fmt-prompt "%s[%s] N-up printing (default 1): ")
- (prompt "")
- (str (read-string (format fmt-prompt prompt mess) nil nil "1"))
- int)
- (while (if (string-match "^\\s *[0-9]+$" str)
- (setq int (string-to-number str)
- prompt (cond ((< int 1) "Integer below 1; ")
- ((> int 100) "Integer above 100; ")
- (t nil)))
- (setq prompt "Invalid integer syntax; "))
- (ding)
- (setq str
- (read-string (format fmt-prompt prompt mess) str nil "1")))
- int)))
+ (unless (stringp mess)
+ (setq mess "*"))
+ (let (int)
+ (while (or (< (setq int (read-number (format "[%s] N-up printing:" mess) 1))
+ 0)
+ (> int 100))
+ (if (< int 0)
+ (message "Integer below 1")
+ (message "Integer above 100"))
+ (sit-for 1)
+ (ding))
+ int))
(defun pr-interactive-dir (mess)
@@ -5323,7 +5319,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-interactive-regexp (mess)
- (read-string (format "[%s] File regexp to print: " mess) nil nil ""))
+ (read-string (format "[%s] File regexp to print: " mess)))
(defun pr-interactive-dir-args (mess)
@@ -5622,8 +5618,6 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
;; header
(let ((versions (concat "printing v" pr-version
" ps-print v" ps-print-version)))
- ;; to keep compatibility with Emacs 20 & 21:
- ;; DO NOT REPLACE `?\ ' BY `?\s'
(widget-insert (make-string (- 79 (length versions)) ?\ ) versions))
(pr-insert-italic "\nCurrent Directory : " 1)
(pr-insert-italic default-directory)
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 3243e6432f2..bf8aacccc37 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -305,7 +305,7 @@ Optional argument MODE means only check for the specified mode (cpu or mem)."
(let ((fun-map (make-hash-table :test 'profiler-function-equal))
(parent-map (make-hash-table :test 'eq))
(leftover-tree (profiler-make-calltree
- :entry (intern "...") :parent tree)))
+ :entry '... :parent tree)))
(push leftover-tree (profiler-calltree-children tree))
(maphash
(lambda (backtrace _count)
@@ -816,7 +816,7 @@ 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."
(interactive
(list (if (not (fboundp 'profiler-cpu-start)) 'mem
- (intern (completing-read "Mode (default cpu): "
+ (intern (completing-read (format-prompt "Mode" "cpu")
'("cpu" "mem" "cpu+mem")
nil t nil nil "cpu")))))
(cl-ecase mode
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index e63e4d65fb5..00fcb804d43 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -695,7 +695,7 @@ imenu."
(define-key map "\e\C-e" 'antlr-end-of-rule)
(define-key map "\C-c\C-a" 'antlr-beginning-of-body)
(define-key map "\C-c\C-e" 'antlr-end-of-body)
- (define-key map "\C-c\C-f" 'c-forward-into-nomenclature)
+ (define-key map "\C-c\C-f" 'subword-forward)
(define-key map "\C-c\C-b" 'c-backward-into-nomenclature)
(define-key map "\C-c\C-c" 'comment-region)
(define-key map "\C-c\C-v" 'antlr-hide-actions)
@@ -720,9 +720,8 @@ imenu."
"Major mode menu."
`("Antlr"
,@(if (cond-emacs-xemacs
- :EMACS (and antlr-options-use-submenus
- (>= emacs-major-version 21))
- :XEMACS antlr-options-use-submenus)
+ :EMACS antlr-options-use-submenus
+ :XEMACS antlr-options-use-submenus)
`(("Insert File Option"
:filter ,(lambda (x) (antlr-options-menu-filter 1 x)))
("Insert Grammar Option"
@@ -745,7 +744,7 @@ imenu."
["Backward Statement" c-beginning-of-statement t]
["Forward Statement" c-end-of-statement t]
["Backward Into Nomencl." c-backward-into-nomenclature t]
- ["Forward Into Nomencl." c-forward-into-nomenclature t])
+ ["Forward Into Nomencl." subword-forward t])
["Indent Region" indent-region
:active (and (not buffer-read-only) (c-region-is-active-p))]
["Comment Out Region" comment-region
diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el
index 5d5811b47d1..d12bed7e27d 100644
--- a/lisp/progmodes/autoconf.el
+++ b/lisp/progmodes/autoconf.el
@@ -1,4 +1,4 @@
-;;; autoconf.el --- mode for editing Autoconf configure.ac files
+;;; autoconf.el --- mode for editing Autoconf configure.ac files -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el
index 87e88163ac7..98e58be2303 100644
--- a/lisp/progmodes/bat-mode.el
+++ b/lisp/progmodes/bat-mode.el
@@ -42,7 +42,7 @@
;; See documentation of function `bat-mode'.
;;
;; Separate package `dos-indent' (Matthew Fidler) provides rudimentary
-;; indentation, see http://www.emacswiki.org/emacs/dos-indent.el.
+;; indentation, see https://www.emacswiki.org/emacs/dos-indent.el.
;;
;; Acknowledgements:
;;
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 75ebc29710c..c52331f84fa 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -72,7 +72,7 @@ so that it is considered safe, see `enable-local-variables'.")
"\\([Bb]ug ?#?\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z+-]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
"Regular expression matching bug references.
The second subexpression should match the bug reference (usually a number)."
- :type 'string
+ :type 'regexp
:version "24.3" ; previously defconst
:group 'bug-reference)
@@ -139,12 +139,312 @@ 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)
+ (when (string-match url-rx url)
+ (setq-local bug-reference-bug-regexp bug-rx)
+ (setq-local bug-reference-url-format
+ (let (groups)
+ (dotimes (i (/ (length (match-data)) 2))
+ (push (match-string i url) groups))
+ (funcall bug-url-fmt (nreverse groups))))))
+
+(defvar bug-reference-setup-from-vc-alist
+ `(;;
+ ;; GNU projects on savannah.
+ ;;
+ ;; Not all of them use debbugs but that doesn't really matter
+ ;; because the auto-setup is only performed if
+ ;; `bug-reference-url-format' and `bug-reference-bug-regexp'
+ ;; aren't set already.
+ ("git\\.\\(?:sv\\|savannah\\)\\.gnu\\.org:"
+ "\\<\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\>"
+ ,(lambda (_) "https://debbugs.gnu.org/%s"))
+ ;;
+ ;; GitHub projects.
+ ;;
+ ;; Here #17 may refer to either an issue or a pull request but
+ ;; visiting the issue/17 web page will automatically redirect to
+ ;; the pull/17 page if 17 is a PR. Explicit user/project#17 links
+ ;; to possibly different projects are also supported.
+ ("[/@]github.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
+ "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
+ ,(lambda (groups)
+ (let ((ns-project (nth 1 groups)))
+ (lambda ()
+ (concat "https://github.com/"
+ (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
+ ;; namespace/project#18 or namespace/project!17 references to
+ ;; possibly different projects are also supported.
+ ("[/@]gitlab.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
+ "\\(?1:[.A-Za-z0-9_/-]+\\)?\\(?3:[#!]\\)\\(?2:[0-9]+\\)\\>"
+ ,(lambda (groups)
+ (let ((ns-project (nth 1 groups)))
+ (lambda ()
+ (concat "https://gitlab.com/"
+ (or (match-string 1)
+ ns-project)
+ "/-/"
+ (if (string= (match-string 3) "#")
+ "issues/"
+ "merge_requests/")
+ (match-string 2)))))))
+ "An alist for setting up `bug-reference-mode' based on VC URL.
+
+Each element has the form (URL-REGEXP BUG-REGEXP URL-FORMAT-FN).
+
+URL-REGEXP is matched against the version control URL of the
+current buffer's file. If it matches, BUG-REGEXP is set as
+`bug-reference-bug-regexp'. URL-FORMAT-FN is a function of one
+argument that receives a list of the groups 0 to N of matching
+URL-REGEXP against the VCS URL and returns the value to be set as
+`bug-reference-url-format'.")
+
+(defun bug-reference-try-setup-from-vc ()
+ "Try setting up `bug-reference-mode' based on VC information.
+Test each configuration in `bug-reference-setup-from-vc-alist'
+and apply it if applicable."
+ (let ((file-or-dir (or buffer-file-name
+ ;; Catches modes such as vc-dir and Magit.
+ default-directory)))
+ (when file-or-dir
+ (let* ((backend (vc-responsible-backend file-or-dir t))
+ (url
+ (or (ignore-errors
+ (vc-call-backend backend 'repository-url "upstream"))
+ (ignore-errors
+ (vc-call-backend backend 'repository-url)))))
+ (when url
+ (catch 'found
+ (dolist (config bug-reference-setup-from-vc-alist)
+ (when (apply #'bug-reference--maybe-setup-from-vc
+ url config)
+ (throw 'found t)))))))))
+
+(defvar bug-reference-setup-from-mail-alist
+ `((,(regexp-opt '("emacs" "auctex" "gnus" "tramp" "orgmode") 'words)
+ ,(regexp-opt '("@debbugs.gnu.org" "-devel@gnu.org"
+ ;; List-Id of Gnus devel mailing list.
+ "ding.gnus.org"))
+ "\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
+ "https://debbugs.gnu.org/%s"))
+ "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.
+
+Each element has the form
+
+ (GROUP-REGEXP HEADER-REGEXP BUG-REGEXP URL-FORMAT)
+
+GROUP-REGEXP is a regexp matched against the current mail folder
+or newsgroup name. HEADER-REGEXP is a regexp matched against the
+From, To, Cc, Newsgroup, and List-ID header values of the current
+mail or newsgroup message. If any of those matches, BUG-REGEXP
+is set as `bug-reference-bug-regexp' and URL-FORMAT is set as
+`bug-reference-url-format'.
+
+Note: In Gnus, if a summary buffer has been set up based on
+GROUP-REGEXP, all article buffers opened from there will get the
+same `bug-reference-url-format' and `bug-reference-url-format'.")
+
+(defvar gnus-newsgroup-name)
+
+(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,
+and Newsgroup.
+
+If any GROUP-REGEXP or HEADER-REGEXP of
+`bug-reference-setup-from-mail-alist' matches GROUP or any
+element in HEADER-VALUES, the corresponding BUG-REGEXP and
+URL-FORMAT are set."
+ (catch 'setup-done
+ (dolist (config bug-reference-setup-from-mail-alist)
+ (when (or
+ (and group
+ (car config)
+ (string-match-p (car config) group))
+ (and header-values
+ (nth 1 config)
+ (catch 'matching-header
+ (dolist (h header-values)
+ (when (and h (string-match-p (nth 1 config) h))
+ (throw 'matching-header t))))))
+ (setq-local bug-reference-bug-regexp (nth 2 config))
+ (setq-local bug-reference-url-format (nth 3 config))
+ (throw 'setup-done t)))))
+
+(defun bug-reference-try-setup-from-gnus ()
+ "Try setting up `bug-reference-mode' based on Gnus group or article.
+Test each configuration in `bug-reference-setup-from-mail-alist'
+and set it if applicable."
+ (when (and (derived-mode-p 'gnus-summary-mode)
+ (bound-and-true-p gnus-newsgroup-name))
+ ;; Gnus reuses its article buffer so we have to check whenever the
+ ;; article changes.
+ (add-hook 'gnus-article-prepare-hook
+ #'bug-reference--try-setup-gnus-article)
+ (bug-reference--maybe-setup-from-mail gnus-newsgroup-name nil)))
+
+(defvar gnus-article-buffer)
+(defvar gnus-original-article-buffer)
+(defvar gnus-summary-buffer)
+
+(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)))))))
+
+(defvar bug-reference-setup-from-irc-alist
+ `((,(concat "#" (regexp-opt '("emacs" "gnus" "org-mode" "rcirc"
+ "erc") 'words))
+ "freenode"
+ "\\([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.
+
+Each element has the form
+
+ (CHANNEL-REGEXP NETWORK-REGEXP BUG-REGEXP URL-FORMAT)
+
+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
+`bug-reference-bug-regexp' and URL-FORMAT is set as
+`bug-reference-url-format'.")
+
+(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
+name.
+
+If any `bug-reference-setup-from-irc-alist' entry's
+CHANNEL-REGEXP and NETWORK-REGEXP match CHANNEL and NETWORK, the
+corresponding BUG-REGEXP and URL-FORMAT are set."
+ (catch 'setup-done
+ (dolist (config bug-reference-setup-from-irc-alist)
+ (let ((channel-rx (car config))
+ (network-rx (nth 1 config)))
+ (when (and
+ ;; One of both has to be given.
+ (or channel-rx network-rx)
+ ;; The args have to be set.
+ channel network)
+ (when (and
+ (or (null channel-rx)
+ (string-match-p channel-rx channel))
+ (or (null network-rx)
+ (string-match-p network-rx network)))
+ (setq-local bug-reference-bug-regexp (nth 2 config))
+ (setq-local bug-reference-url-format (nth 3 config))
+ (throw 'setup-done t)))))))
+
+(defvar rcirc-target)
+(defvar rcirc-server-buffer)
+(defvar rcirc-server)
+
+(defun bug-reference-try-setup-from-rcirc ()
+ "Try setting up `bug-reference-mode' based on rcirc channel and server.
+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
+ rcirc-target
+ (and rcirc-server-buffer
+ (buffer-live-p rcirc-server-buffer)
+ (with-current-buffer rcirc-server-buffer
+ rcirc-server)))))
+
+(declare-function erc-format-target "erc")
+(declare-function erc-network-name "erc-networks")
+
+(defun bug-reference-try-setup-from-erc ()
+ "Try setting up `bug-reference-mode' based on ERC channel and server.
+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
+ (erc-format-target)
+ (erc-network-name))))
+
+(defun bug-reference--run-auto-setup ()
+ (when (or bug-reference-mode
+ bug-reference-prog-mode)
+ ;; Automatic setup only if the variables aren't already set, e.g.,
+ ;; by a local variables section in the file.
+ (unless (and bug-reference-bug-regexp
+ bug-reference-url-format)
+ (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))
+ (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)
(jit-lock-unregister #'bug-reference-fontify)
@@ -158,6 +458,7 @@ The second subexpression should match the bug reference (usually a number)."
nil
""
nil
+ :after-hook (bug-reference--run-auto-setup)
(if bug-reference-prog-mode
(jit-lock-register #'bug-reference-fontify)
(jit-lock-unregister #'bug-reference-fontify)
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index f30477dc787..6172afecbcf 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -790,6 +790,38 @@ arglist-cont-nonempty."
(or (c-lineup-assignments langelem)
c-basic-offset))
+(defun c-lineup-ternary-bodies (langelem)
+ "Line up true and false branches of a ternary operator (i.e. `?:').
+More precisely, if the line starts with a colon which is a part of
+a said operator, align it with corresponding question mark; otherwise
+return nil. For example:
+
+ return arg % 2 == 0 ? arg / 2
+ : (3 * arg + 1); <- c-lineup-ternary-bodies
+
+Works with: arglist-cont, arglist-cont-nonempty and statement-cont."
+ (save-excursion
+ (back-to-indentation)
+ (when (and (eq ?: (char-after))
+ (not (eq ?: (char-after (1+ (point))))))
+ (let ((limit (c-langelem-pos langelem)) (depth 1))
+ (catch 'done
+ (while (and (c-syntactic-skip-backward "^?:" limit t)
+ (not (bobp)))
+ (backward-char)
+ (cond ((eq (char-after) ??)
+ ;; If we've found a question mark, decrease depth. If we've
+ ;; reached zero, we've found the one we were looking for.
+ (when (zerop (setq depth (1- depth)))
+ (throw 'done (vector (current-column)))))
+ ((or (eq ?: (char-before)) (eq ?? (char-before)))
+ ;; Step over `::' and `?:' operators. We don't have to
+ ;; handle `?:' here but doing so saves an iteration.
+ (if (eq (point) limit)
+ (throw 'done nil)
+ (goto-char (1- (point)))))
+ ((setq depth (1+ depth)))))))))) ; Otherwise increase depth.
+
(defun c-lineup-cascaded-calls (langelem)
"Line up \"cascaded calls\" under each other.
If the line begins with \"->\" or \".\" and the preceding line ends
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index fd61e3e3287..52e6da6f4ac 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -1003,7 +1003,7 @@ std\\(err\\|in\\|out\\)\\|user\\)\\)\\>\
;; Matches an unterminated string/regexp, NOT including the eol at the end.
(defconst c-awk-harmless-pattern-characters*
- (concat "\\([^{;#/\"\\\\\n\r]\\|" c-awk-esc-pair-re "\\)*"))
+ (concat "\\([^{;#/\"\\\n\r]\\|" c-awk-esc-pair-re "\\)*"))
;; Matches any "harmless" character in a pattern or an escaped character pair.
(defun c-awk-at-statement-end-p ()
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index 1071191775b..4425e275ac9 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -48,6 +48,7 @@
(cc-bytecomp-defvar filladapt-mode) ; c-fill-paragraph contains a kludge
; which looks at this.
(cc-bytecomp-defun electric-pair-post-self-insert-function)
+(cc-bytecomp-defvar c-indent-to-body-directives)
;; Indentation / Display syntax functions
(defvar c-fix-backslashes t)
@@ -512,11 +513,11 @@ function to control that."
(let ((src (default-value 'post-self-insert-hook)))
(while src
(unless (memq (car src) c--unsafe-post-self-insert-hook-functions)
- (add-hook 'dest (car src) t)) ; Preserve the order of the functions.
+ (push (car src) dest))
(setq src (cdr src)))))
- (t (add-hook 'dest (car src) t))) ; Preserve the order of the functions.
+ (t (push (car src) dest)))
(setq src (cdr src)))
- (run-hooks 'dest)))
+ (mapc #'funcall (nreverse dest)))) ; Preserve the order of the functions.
(defmacro c--call-post-self-insert-hook-more-safely ()
;; Call post-self-insert-hook, if such exists. See comment for
@@ -1441,6 +1442,98 @@ keyword on the line, the keyword is not inserted inside a literal, and
(indent-according-to-mode)
(delete-char -2)))))
+(defun c-align-cpp-indent-to-body ()
+ "Align a \"#pragma\" line under the previous line.
+This function is intented for use as a member of `c-special-indent-hook'."
+ (when (assq 'cpp-macro c-syntactic-context)
+ (when
+ (save-excursion
+ (save-match-data
+ (back-to-indentation)
+ (and
+ (looking-at (concat c-opt-cpp-symbol "[ \t]*\\([a-zA-Z0-9_]+\\)"))
+ (member (match-string-no-properties 1)
+ c-cpp-indent-to-body-directives))))
+ (c-indent-line (delete '(cpp-macro) c-syntactic-context)))))
+
+(defvar c-cpp-indent-to-body-flag nil)
+;; Non-nil when CPP directives such as "#pragma" should be indented to under
+;; the preceding statement.
+(make-variable-buffer-local 'c-cpp-indent-to-body-flag)
+
+(defun c-electric-pragma ()
+ "Reindent the current line if appropriate.
+
+This function is used to reindent a preprocessor line when the
+symbol for the directive, typically \"pragma\", triggers this
+function as a hook function of an abbreviation.
+
+The \"#\" of the preprocessor construct is aligned under the
+first anchor point of the line's syntactic context.
+
+The line is reindented if the construct is not in a string or
+comment, there is exactly one \"#\" contained in optional
+whitespace before it on the current line, and `c-electric-flag'
+and `c-syntactic-indentation' are both non-nil."
+ (save-excursion
+ (save-match-data
+ (when
+ (and
+ c-cpp-indent-to-body-flag
+ c-electric-flag
+ c-syntactic-indentation
+ last-abbrev-location
+ c-opt-cpp-symbol ; "#" or nil.
+ (progn (back-to-indentation)
+ (looking-at (concat c-opt-cpp-symbol "[ \t]*")))
+ (>= (match-end 0) last-abbrev-location)
+ (not (c-literal-limits)))
+ (c-indent-line (delete '(cpp-macro) (c-guess-basic-syntax)))))))
+
+(defun c-add-indent-to-body-to-abbrev-table (d)
+ ;; Create an abbreviation table entry for the directive D, and add it to the
+ ;; current abbreviation table. Existing abbreviation (e.g. for "else") do
+ ;; not get overwritten.
+ (when (and c-buffer-is-cc-mode
+ local-abbrev-table
+ (not (abbrev-symbol d local-abbrev-table)))
+ (condition-case nil
+ (define-abbrev local-abbrev-table d d 'c-electric-pragma 0 t)
+ (wrong-number-of-arguments
+ (define-abbrev local-abbrev-table d d 'c-electric-pragma)))))
+
+(defun c-clear-stale-indent-to-body-abbrevs ()
+ ;; Fill in this comment. FIXME!!!
+ (when (fboundp 'abbrev-get)
+ (mapatoms (lambda (a)
+ (when (and (abbrev-get a ':system) ; Preserve a user's abbrev!
+ (not (member (symbol-name a) c-std-abbrev-keywords))
+ (not (member (symbol-name a)
+ c-cpp-indent-to-body-directives)))
+ (unintern a local-abbrev-table)))
+ local-abbrev-table)))
+
+(defun c-toggle-cpp-indent-to-body (&optional arg)
+ "Toggle the C preprocessor indent-to-body feature.
+When enabled, preprocessor directives which are words in
+`c-indent-to-body-directives' are indented as if they were statements.
+
+Optional numeric ARG, if supplied, turns on the feature when positive,
+turns it off when negative, and just toggles it when zero or
+left out."
+ (interactive "P")
+ (setq c-cpp-indent-to-body-flag
+ (c-calculate-state arg c-cpp-indent-to-body-flag))
+ (if c-cpp-indent-to-body-flag
+ (progn
+ (c-clear-stale-indent-to-body-abbrevs)
+ (mapc 'c-add-indent-to-body-to-abbrev-table
+ c-cpp-indent-to-body-directives)
+ (add-hook 'c-special-indent-hook 'c-align-cpp-indent-to-body nil t))
+ (remove-hook 'c-special-indent-hook 'c-align-cpp-indent-to-body t))
+ (message "c-cpp-indent-to-body %sabled"
+ (if c-cpp-indent-to-body-flag "en" "dis")))
+
(declare-function subword-forward "subword" (&optional arg))
@@ -1461,19 +1554,6 @@ keyword on the line, the keyword is not inserted inside a literal, and
(declare-function c-backward-subword "ext:cc-subword" (&optional arg))
;; "nomenclature" functions + c-scope-operator.
-(defun c-forward-into-nomenclature (&optional arg)
- "Compatibility alias for `c-forward-subword'."
- (interactive "p")
- (if (fboundp 'subword-mode)
- (progn
- (require 'subword)
- (subword-forward arg))
- (require 'cc-subword)
- (c-forward-subword arg)))
-(make-obsolete 'c-forward-into-nomenclature
- (if (fboundp 'subword-mode) 'subword-forward 'c-forward-subword)
- "23.2")
-
(defun c-backward-into-nomenclature (&optional arg)
"Compatibility alias for `c-backward-subword'."
(interactive "p")
@@ -2024,6 +2104,23 @@ other top level construct with a brace block."
(c-backward-syntactic-ws)
(point))))
+ ((and (c-major-mode-is 'objc-mode) (looking-at "[-+]\\s-*(")) ; Objective-C method
+ ;; Move to the beginning of the method name.
+ (c-forward-token-2 2 t)
+ (let* ((class
+ (save-excursion
+ (when (re-search-backward
+ "^\\s-*@\\(implementation\\|class\\|interface\\)\\s-+\\(\\sw+\\)" nil t)
+ (match-string-no-properties 2))))
+ (limit (save-excursion (re-search-forward "[;{]" nil t)))
+ (method (when (re-search-forward "\\(\\sw+:?\\)" limit t)
+ (match-string-no-properties 1))))
+ (when (and class method)
+ ;; Add the parameter labels onto name. They always end in ':'.
+ (while (re-search-forward "\\(\\sw+:\\)" limit 1)
+ (setq method (concat method (match-string-no-properties 1))))
+ (concat "[" class " " method "]"))))
+
(t ; Normal function or initializer.
(when (looking-at c-defun-type-name-decl-key) ; struct, etc.
(goto-char (match-end 0))
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index a1e3a236a11..77e263f1aad 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -87,7 +87,7 @@
;;; Variables also used at compile time.
-(defconst c-version "5.34.1"
+(defconst c-version "5.34.2"
"CC Mode version number.")
(defconst c-version-sym (intern c-version))
@@ -434,6 +434,15 @@ to it is returned. This function does not modify the point or the mark."
(setq count (+ count (skip-chars-backward "\\\\"))))
(not (zerop (logand count 1))))))
+(defmacro c-will-be-unescaped (beg end)
+ ;; Would the character after END be unescaped after the removal of (BEG END)?
+ ;; This is regardless of its current status. It is assumed that (>= POS END).
+ `(save-excursion
+ (let (count)
+ (goto-char ,beg)
+ (setq count (skip-chars-backward "\\\\"))
+ (zerop (logand count 1)))))
+
(defvar c-use-extents)
(defmacro c-next-single-property-change (position prop &optional object limit)
@@ -445,6 +454,15 @@ to it is returned. This function does not modify the point or the mark."
;; Emacs and earlier XEmacs
`(next-single-property-change ,position ,prop ,object ,limit)))
+(defmacro c-previous-single-property-change (position prop &optional object limit)
+ ;; See the doc string for either of the defuns expanded to.
+ (if (and c-use-extents
+ (fboundp 'previous-single-char-property-change))
+ ;; XEmacs >= 2005-01-25
+ `(previous-single-char-property-change ,position ,prop ,object ,limit)
+ ;; Emacs and earlier XEmacs
+ `(previous-single-property-change ,position ,prop ,object ,limit)))
+
(defmacro c-region-is-active-p ()
;; Return t when the region is active. The determination of region
;; activeness is different in both Emacs and XEmacs.
@@ -1047,15 +1065,6 @@ MODE is either a mode symbol or a list of mode symbols."
;; properties set on a single character and that never spread to any
;; other characters.
-(defmacro c-put-syn-tab (pos value)
- ;; Set both the syntax-table and the c-fl-syn-tab text properties at POS to
- ;; VALUE (which should not be nil).
- `(let ((-pos- ,pos)
- (-value- ,value))
- (c-put-char-property -pos- 'syntax-table -value-)
- (c-put-char-property -pos- 'c-fl-syn-tab -value-)
- (c-truncate-lit-pos-cache -pos-)))
-
(eval-and-compile
;; Constant used at compile time to decide whether or not to use
;; XEmacs extents. Check all the extent functions we'll use since
@@ -1183,13 +1192,6 @@ MODE is either a mode symbol or a list of mode symbols."
;; Emacs < 21.
`(c-clear-char-property-fun ,pos ',property))))
-(defmacro c-clear-syn-tab (pos)
- ;; Remove both the 'syntax-table and `c-fl-syn-tab properties at POS.
- `(let ((-pos- ,pos))
- (c-clear-char-property -pos- 'syntax-table)
- (c-clear-char-property -pos- 'c-fl-syn-tab)
- (c-truncate-lit-pos-cache -pos-)))
-
(defmacro c-min-property-position (from to property)
;; 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.
@@ -1235,8 +1237,18 @@ MODE is either a mode symbol or a list of mode symbols."
;; Remove all occurrences of the `syntax-table' and `c-fl-syn-tab' text
;; properties between FROM and TO.
`(let ((-from- ,from) (-to- ,to))
- (c-clear-char-properties -from- -to- 'syntax-table)
- (c-clear-char-properties -from- -to- 'c-fl-syn-tab)))
+ (when (and
+ c-min-syn-tab-mkr c-max-syn-tab-mkr
+ (< -from- c-max-syn-tab-mkr)
+ (> -to- c-min-syn-tab-mkr))
+ (let ((pos -from-))
+ (while (and
+ (< pos -to-)
+ (setq pos (c-min-property-position pos -to- 'c-fl-syn-tab))
+ (< pos -to-))
+ (c-clear-syn-tab pos)
+ (setq pos (1+ pos)))))
+ (c-clear-char-properties -from- -to- 'syntax-table)))
(defmacro c-search-forward-char-property (property value &optional limit)
"Search forward for a text-property PROPERTY having value VALUE.
@@ -1456,28 +1468,6 @@ with value CHAR in the region [FROM to)."
(c-put-char-property (point) ,property ,value)
(forward-char)))))
-(defmacro c-with-extended-string-fences (beg end &rest body)
- ;; If needed, extend the region with "mirrored" c-fl-syn-tab properties to
- ;; contain the region (BEG END), then evaluate BODY. If this mirrored
- ;; region was initially empty, restore it afterwards.
- `(let ((-beg- ,beg)
- (-end- ,end)
- )
- (cond
- ((null c-fl-syn-tab-region)
- (unwind-protect
- (progn
- (c-restore-string-fences -beg- -end-)
- ,@body)
- (c-clear-string-fences)))
- ((and (>= -beg- (car c-fl-syn-tab-region))
- (<= -end- (cdr c-fl-syn-tab-region)))
- ,@body)
- (t ; Crudely extend the mirrored region.
- (setq -beg- (min -beg- (car c-fl-syn-tab-region))
- -end- (max -end- (cdr c-fl-syn-tab-region)))
- (c-restore-string-fences -beg- -end-)
- ,@body))))
;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text.
;; For our purposes, these are characterized by being possible to
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 4b14dd131c2..4e336c0a064 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -163,7 +163,9 @@
(defvar c-doc-line-join-re)
(defvar c-doc-bright-comment-start-re)
(defvar c-doc-line-join-end-ch)
-(defvar c-fl-syn-tab-region)
+(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)
@@ -405,7 +407,7 @@ comment at the start of cc-engine.el for more info."
(when (and (car c-macro-cache)
(> (point) (car c-macro-cache)) ; in case we have a
; zero-sized region.
- (not (eq (char-before (1- (point))) ?\\)))
+ (not lim))
(setcdr c-macro-cache (point))
(setq c-macro-cache-syntactic nil)))))))
@@ -1580,6 +1582,7 @@ comment at the start of cc-engine.el for more info."
(save-excursion (backward-char)
(looking-at "\\s("))
(c-crosses-statement-barrier-p (point) end)))))
+(make-obsolete 'c-at-expression-start-p nil "CC mode 5.35")
;; A set of functions that covers various idiosyncrasies in
@@ -1642,6 +1645,21 @@ comment at the start of cc-engine.el for more info."
(forward-char 2)
t))))
+(defmacro c-forward-comment-minus-1 ()
+ "Call (forward-comment -1), taking care of escaped newlines.
+Return the result of `forward-comment' if it gets called, nil otherwise."
+ `(if (not comment-end-can-be-escaped)
+ (forward-comment -1)
+ (when (and (< (skip-syntax-backward " >") 0)
+ (eq (char-after) ?\n))
+ (forward-char))
+ (cond
+ ((and (eq (char-before) ?\n)
+ (eq (char-before (1- (point))) ?\\))
+ (backward-char)
+ nil)
+ (t (forward-comment -1)))))
+
(defun c-backward-single-comment ()
"Move backward past whitespace and the closest preceding comment, if any.
Return t if a comment was found, nil otherwise. In either case, the
@@ -1675,12 +1693,12 @@ This function does not do any hidden buffer changes."
;; same line.
(re-search-forward "\\=\\s *[\n\r]" start t)
- (if (if (forward-comment -1)
+ (if (if (c-forward-comment-minus-1)
(if (eolp)
;; If forward-comment above succeeded and we're at eol
;; then the newline we moved over above didn't end a
;; line comment, so we give it another go.
- (forward-comment -1)
+ (c-forward-comment-minus-1)
t))
;; Emacs <= 20 and XEmacs move back over the closer of a
@@ -1709,7 +1727,7 @@ comment at the start of cc-engine.el for more info."
(if (let (moved-comment)
(while
- (and (not (setq moved-comment (forward-comment -1)))
+ (and (not (setq moved-comment (c-forward-comment-minus-1)))
;; Cope specifically with ^M^J here -
;; forward-comment sometimes gets stuck after ^Ms,
;; sometimes after ^M^J.
@@ -1895,52 +1913,29 @@ comment at the start of cc-engine.el for more info."
(defun c-enclosing-c++-attribute ()
;; If we're in C++ Mode, and point is within a correctly balanced [[ ... ]]
;; attribute structure, return a cons of its starting and ending positions.
- ;; Otherwise, return nil. We use the c-{in,is}-sws-face text properties for
- ;; this determination, this macro being intended only for use in the *-sws-*
- ;; functions and macros. The match data are NOT preserved over this macro.
- (let (attr-end pos-is-sws)
- (and
- (c-major-mode-is 'c++-mode)
- (> (point) (point-min))
- (setq pos-is-sws
- (if (get-text-property (1- (point)) 'c-is-sws)
- (1- (point))
- (1- (previous-single-property-change
- (point) 'c-is-sws nil (point-min)))))
- (save-excursion
- (goto-char pos-is-sws)
- (setq attr-end (c-looking-at-c++-attribute)))
- (> attr-end (point))
- (cons pos-is-sws attr-end))))
-
-(defun c-slow-enclosing-c++-attribute ()
- ;; Like `c-enclosing-c++-attribute', but does not depend on the c-i[ns]-sws
- ;; properties being set.
+ ;; Otherwise, return nil.
(and
(c-major-mode-is 'c++-mode)
(save-excursion
- (let ((paren-state (c-parse-state))
+ (let ((lim (max (- (point) 200) (point-min)))
cand)
(while
- (progn
- (setq cand
- (catch 'found-cand
- (while (cdr paren-state)
- (when (and (numberp (car paren-state))
- (numberp (cadr paren-state))
- (eq (car paren-state)
- (1+ (cadr paren-state)))
- (eq (char-after (car paren-state)) ?\[)
- (eq (char-after (cadr paren-state)) ?\[))
- (throw 'found-cand (cadr paren-state)))
- (setq paren-state (cdr paren-state)))))
- (and cand
- (not
- (and (c-go-list-forward cand)
- (eq (char-before) ?\])
- (eq (char-before (1- (point))) ?\])))))
- (setq paren-state (cdr paren-state)))
- (and cand (cons cand (point)))))))
+ (and
+ (progn
+ (skip-chars-backward "^[;{}" lim)
+ (eq (char-before) ?\[))
+ (not (eq (char-before (1- (point))) ?\[))
+ (> (point) lim))
+ (backward-char))
+ (and (eq (char-before) ?\[)
+ (eq (char-before (1- (point))) ?\[)
+ (progn (backward-char 2) t)
+ (setq cand (point))
+ (c-go-list-forward nil (min (+ (point) 200) (point-max)))
+ (eq (char-before) ?\])
+ (eq (char-before (1- (point))) ?\])
+ (not (c-literal-limits))
+ (cons cand (point)))))))
(defun c-invalidate-sws-region-before (beg end)
;; Called from c-before-change. BEG and END are the bounds of the change
@@ -2243,7 +2238,7 @@ comment at the start of cc-engine.el for more info."
((and c-opt-cpp-prefix
(looking-at c-noise-macro-name-re))
- ;; Skip over a noise macro.
+ ;; Skip over a noise macro without parens.
(goto-char (match-end 1))
(not (eobp)))
@@ -2702,7 +2697,7 @@ comment at the start of cc-engine.el for more info."
;; or the car of the list is the "position element" of ELT, the position
;; where ELT is valid.
;;
- ;; POINT is left at the postition for which the returned state is valid. It
+ ;; POINT is left at the position for which the returned state is valid. It
;; will be either the position element of ELT, or one character before
;; that. (The latter happens in Emacs <= 25 and XEmacs, when ELT indicates
;; its position element directly follows a potential first character of a
@@ -2772,7 +2767,7 @@ comment at the start of cc-engine.el for more info."
((nth 3 state) ; A string
(list (point) (nth 3 state) (nth 8 state)))
((and (nth 4 state) ; A comment
- (not (eq (nth 7 state) 'syntax-table))) ; but not a psuedo comment.
+ (not (eq (nth 7 state) 'syntax-table))) ; but not a pseudo comment.
(list (point)
(if (eq (nth 7 state) 1) 'c++ 'c)
(nth 8 state)))
@@ -2899,7 +2894,7 @@ comment at the start of cc-engine.el for more info."
(setq nc-list (cdr nc-list))))))
(defun c-semi-get-near-cache-entry (here)
- ;; Return the near cache entry at the highest postion before HERE, if any,
+ ;; Return the near cache entry at the highest position before HERE, if any,
;; or nil. The near cache entry is of the form (POSITION . STATE), where
;; STATE has the form of a result of `parse-partial-sexp'.
(let ((nc-pos-state
@@ -2988,9 +2983,7 @@ comment at the start of cc-engine.el for more info."
c-block-comment-awkward-chars)))
(and (nth 4 s) (nth 7 s) ; Line comment
(not (memq (char-before here) '(?\\ ?\n)))))))
- (c-with-extended-string-fences
- pos here
- (setq s (parse-partial-sexp pos here nil nil s))))
+ (setq s (parse-partial-sexp pos here nil nil s)))
(when (not (eq near-pos here))
(c-semi-put-near-cache-entry here s))
(cond
@@ -3122,7 +3115,7 @@ comment at the start of cc-engine.el for more info."
(not base) ; FIXME!!! Compare base and far-base??
; (2019-05-21)
(not end)
- (> here end))
+ (>= here end))
(progn
(setq far-base-and-state (c-parse-ps-state-below here)
far-base (car far-base-and-state)
@@ -3135,7 +3128,7 @@ comment at the start of cc-engine.el for more info."
(or
(and (> here base) (null end))
(null (nth 8 s))
- (and end (> here end))
+ (and end (>= here end))
(not
(or
(and (nth 3 s) ; string
@@ -3194,6 +3187,24 @@ comment at the start of cc-engine.el for more info."
c-semi-near-cache-limit (min c-semi-near-cache-limit pos)
c-full-near-cache-limit (min c-full-near-cache-limit pos)))
+(defun c-foreign-truncate-lit-pos-cache (beg _end)
+ "Truncate CC Mode's literal cache.
+
+This function should be added to the `before-change-functions'
+hook by major modes that use CC Mode's filling functionality
+without initializing CC Mode. Currently (2020-06) these are
+js-mode and mhtml-mode."
+ (c-truncate-lit-pos-cache beg))
+
+(defun c-foreign-init-lit-pos-cache ()
+ "Initialize CC Mode's literal cache.
+
+This function should be called from the mode functions of major
+modes which use CC Mode's filling functionality without
+initializing CC Mode. Currently (2020-06) these are js-mode and
+mhtml-mode."
+ (c-truncate-lit-pos-cache 1))
+
;; A system for finding noteworthy parens before the point.
@@ -7159,7 +7170,7 @@ comment at the start of cc-engine.el for more info."
;; characters.) If the raw string is not terminated, E\) and E\" are set to
;; nil.
;;
- ;; Note: this function is dependant upon the correct syntax-table text
+ ;; 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)
@@ -9119,6 +9130,12 @@ This function might do hidden buffer changes."
(catch 'is-function
(while
(progn
+ (while
+ (cond
+ ((looking-at c-decl-hangon-key)
+ (c-forward-keyword-clause 1))
+ ((looking-at c-noise-macro-with-parens-name-re)
+ (c-forward-noise-clause))))
(if (eq (char-after) ?\))
(throw 'is-function t))
(setq cdd-got-type (c-forward-type))
@@ -9771,6 +9788,16 @@ This function might do hidden buffer changes."
(save-excursion
(goto-char after-paren-pos)
(c-forward-syntactic-ws)
+ (progn
+ (while
+ (cond
+ ((and
+ c-opt-cpp-prefix
+ (looking-at c-noise-macro-with-parens-name-re))
+ (c-forward-noise-clause))
+ ((looking-at c-decl-hangon-key)
+ (c-forward-keyword-clause 1))))
+ t)
(or (c-forward-type)
;; Recognize a top-level typeless
;; function declaration in C.
@@ -11687,7 +11714,16 @@ comment at the start of cc-engine.el for more info."
(not (c-in-literal))
))))
nil)
- (t t))))))
+ (t t)))))
+ ((and
+ (c-major-mode-is 'c++-mode)
+ (eq (char-after) ?\[)
+ ;; Be careful of "operator []"
+ (not (save-excursion
+ (c-backward-token-2 1 nil lim)
+ (looking-at c-opt-op-identifier-prefix))))
+ (setq braceassignp t)
+ nil))
(when (eq braceassignp 'dontknow)
(cond ((and
(not (eq (char-after) ?,))
@@ -11893,17 +11929,6 @@ comment at the start of cc-engine.el for more info."
(cons (list beg) type)))))
(error nil))))
-(defun c-looking-at-bos (&optional _lim)
- ;; Return non-nil if between two statements or declarations, assuming
- ;; point is not inside a literal or comment.
- ;;
- ;; Obsolete - `c-at-statement-start-p' or `c-at-expression-start-p'
- ;; are recommended instead.
- ;;
- ;; This function might do hidden buffer changes.
- (c-at-statement-start-p))
-(make-obsolete 'c-looking-at-bos 'c-at-statement-start-p "22.1")
-
(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
@@ -12074,7 +12099,7 @@ comment at the start of cc-engine.el for more info."
(c-backward-token-2 1 nil lim)
(and
(not (and (c-on-identifier)
- (looking-at c-symbol-chars)))
+ (looking-at c-symbol-char-key)))
(not (looking-at c-opt-op-identifier-prefix)))))))
(cons 'inlambda bracket-pos))
((and c-recognize-paren-inexpr-blocks
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 2cbbc66c14f..bb7e5bea6e6 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1073,17 +1073,18 @@ casts and declarations are fontified. Used on level 2 and higher."
(defun c-font-lock-declarators (limit list types not-top
&optional template-class)
;; Assuming the point is at the start of a declarator in a declaration,
- ;; fontify the identifier it declares. (If TYPES is set, it does this via
- ;; the macro `c-fontify-types-and-refs'.)
+ ;; fontify the identifier it declares. (If TYPES is t, it does this via the
+ ;; macro `c-fontify-types-and-refs'.)
;;
;; If LIST is non-nil, also fontify the ids in any following declarators in
;; a comma separated list (e.g. "foo" and "*bar" in "int foo = 17, *bar;");
;; additionally, mark the commas with c-type property 'c-decl-id-start or
;; 'c-decl-type-start (according to TYPES). Stop at LIMIT.
;;
- ;; If TYPES is non-nil, fontify all identifiers as types. If NOT-TOP is
- ;; non-nil, we are not at the top-level ("top-level" includes being directly
- ;; inside a class or namespace, etc.).
+ ;; If TYPES is t, fontify all identifiers as types, if it is nil fontify as
+ ;; either variables or functions, otherwise TYPES is a face to use. If
+ ;; NOT-TOP is non-nil, we are not at the top-level ("top-level" includes
+ ;; being directly inside a class or namespace, etc.).
;;
;; TEMPLATE-CLASS is non-nil when the declaration is in template delimiters
;; and was introduced by, e.g. "typename" or "class", such that if there is
@@ -1100,9 +1101,10 @@ casts and declarations are fontified. Used on level 2 and higher."
()
(c-do-declarators
limit list not-top
- (if types 'c-decl-type-start 'c-decl-id-start)
+ (cond ((eq types t) 'c-decl-type-start)
+ ((null types) 'c-decl-id-start))
(lambda (id-start _id-end end-pos _not-top is-function init-char)
- (if types
+ (if (eq types t)
;; Register and fontify the identifier as a type.
(let ((c-promote-possible-types t))
(goto-char id-start)
@@ -1121,9 +1123,10 @@ casts and declarations are fontified. Used on level 2 and higher."
;; `c-forward-declarator'.
(c-put-font-lock-face (car c-last-identifier-range)
(cdr c-last-identifier-range)
- (if is-function
- 'font-lock-function-name-face
- 'font-lock-variable-name-face))))
+ (cond
+ ((not (memq types '(nil t))) types)
+ (is-function 'font-lock-function-name-face)
+ (t 'font-lock-variable-name-face)))))
(and template-class
(eq init-char ?=) ; C++ "<class X = Y>"?
(progn
@@ -1357,7 +1360,8 @@ casts and declarations are fontified. Used on level 2 and higher."
'c-decl-id-start)))))
(c-font-lock-declarators
(min limit (point-max)) decl-list
- (cadr decl-or-cast) (not toplev) template-class))
+ (not (null (cadr decl-or-cast)))
+ (not toplev) template-class))
;; A declaration has been successfully identified, so do all the
;; fontification of types and refs that've been recorded.
@@ -2004,6 +2008,9 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'."
,@(when (c-major-mode-is 'c++-mode)
'(c-font-lock-c++-lambda-captures))
+ ,@(when (c-lang-const c-using-key)
+ `(c-font-lock-c++-using))
+
;; The first two rules here mostly find occurrences that
;; `c-font-lock-declarations' has found already, but not
;; declarations containing blocks in the type (see note below).
@@ -2263,6 +2270,40 @@ need for `c-font-lock-extra-types'.")
;;; C++.
+(defun c-font-lock-c++-using (limit)
+ ;; Fontify any clauses starting with the keyword `using'.
+ ;;
+ ;; This function will be called from font-lock- for a region bounded by
+ ;; POINT and LIMIT, as though it were to identify a keyword for
+ ;; font-lock-keyword-face. It always returns NIL to inhibit this and
+ ;; prevent a repeat invocation. See elisp/lispref page "Search-based
+ ;; fontification".
+ (let (pos after-name)
+ (while (c-syntactic-re-search-forward c-using-key limit 'end)
+ (while ; Do one declarator of a comma separated list, each time around.
+ (progn
+ (c-forward-syntactic-ws)
+ (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)
+ (c-font-lock-declarators limit nil t nil))
+ ((save-excursion
+ (and c-colon-type-list-re
+ (c-go-up-list-backward)
+ (eq (char-after) ?{)
+ (eq (car (c-beginning-of-decl-1)) 'same)
+ (looking-at c-colon-type-list-re)))
+ ;; Inherited protected member: leave unfontified
+ )
+ (t (goto-char pos)
+ (c-font-lock-declarators limit nil c-label-face-name nil)))
+ (eq (char-after) ?,)))
+ (forward-char))) ; over the comma.
+ nil))
(defun c-font-lock-c++-new (limit)
;; FIXME!!! Put in a comment about the context of this function's
@@ -3016,6 +3057,84 @@ need for `pike-font-lock-extra-types'.")
(c-font-lock-doc-comments "/[*/]!" limit
autodoc-font-lock-doc-comments)))))
+;; Doxygen
+
+(defconst doxygen-font-lock-doc-comments
+ ;; TODO: Handle @code, @verbatim, @dot, @f etc. better by not highlighting
+ ;; text inside of those commands. Something smarter than just regexes may be
+ ;; needed to do that efficiently.
+ `((,(concat
+ ;; Make sure that the special character has not been escaped. E.g. in
+ ;; `\@foo' only `\@' is a command (similarly for other characters like
+ ;; `\\foo', `\<foo' and `\&foo'). The downside now is that we don't
+ ;; match command started just after an escaped character, e.g. in
+ ;; `\@\foo' we should match `\@' as well as `\foo' but only the former
+ ;; is matched.
+ "\\(?:^\\|[^\\@]\\)\\("
+ ;; Doxygen commands start with backslash or an at sign. Note that for
+ ;; brevity in the comments only `\' will be mentioned.
+ "[\\@]\\(?:"
+ ;; Doxygen commands except those starting with `f'
+ "[a-eg-z][a-z]*"
+ ;; Doxygen command starting with `f':
+ "\\|f\\(?:"
+ "[][$}]" ; \f$ \f} \f[ \f]
+ "\\|{\\(?:[a-zA-Z]+\\*?}{?\\)?" ; \f{ \f{env} \f{env}{
+ "\\|[a-z]+" ; \foo
+ "\\)"
+ "\\|~[a-zA-Z]*" ; \~ \~language
+ "\\|[$@&~<=>#%\".|\\\\]" ; single-character escapes
+ "\\|::\\|---?" ; \:: \-- \---
+ "\\)"
+ ;; HTML tags and entities:
+ "\\|</?\\sw\\(?:\\sw\\|\\s \\|[=\n\r*.:]\\|\"[^\"]*\"\\|'[^']*'\\)*>"
+ "\\|&\\(?:\\sw+\\|#[0-9]+\\|#x[0-9a-fA-F]+\\);"
+ "\\)")
+ 1 ,c-doc-markup-face-name prepend nil)
+ ;; Commands inside of strings are not commands so override highlighting with
+ ;; string face. This also affects HTML attribute values if they are
+ ;; surrounded with double quotes which may or may not be considered a good
+ ;; thing.
+ ("\\(?:^\\|[^\\@]\\)\\(\"[^\"[:cntrl:]]+\"\\)"
+ 1 font-lock-string-face prepend nil)
+ ;; HTML comments inside of the Doxygen comments.
+ ("\\(?:^\\|[^\\@]\\)\\(<!--.*?-->\\)"
+ 1 font-lock-comment-face prepend nil)
+ ;; Autolinking. Doxygen auto-links anything that is a class name but we have
+ ;; no hope of matching those. We are, however, able to match functions and
+ ;; members using explicit scoped syntax. For functions, we can also find
+ ;; them by noticing argument-list. Note that Doxygen accepts `::' as well
+ ;; as `#' as scope operators.
+ (,(let* ((ref "[\\@]ref\\s-+")
+ (ref-opt (concat "\\(?:" ref "\\)?"))
+ (id "[a-zA-Z_][a-zA-Z_0-9]*")
+ (args "\\(?:()\\|([^()]*)\\)")
+ (scope "\\(?:#\\|::\\)"))
+ (concat
+ "\\(?:^\\|[^\\@/%:]\\)\\(?:"
+ ref-opt "\\(?1:" scope "?" "\\(?:" id scope "\\)+" "~?" id "\\)"
+ "\\|" ref-opt "\\(?1:" scope "~?" id "\\)"
+ "\\|" ref-opt "\\(?1:" scope "?" "~?" id "\\)" args
+ "\\|" ref "\\(?1:" "~?" id "\\)"
+ "\\|" ref-opt "\\(?1:~[A-Z][a-zA-Z0-9_]+\\)"
+ "\\)"))
+ 1 font-lock-function-name-face prepend nil)
+ ;; Match URLs and emails. This has two purposes. First of all, Doxygen
+ ;; autolinks URLs. Second of all, `@bar' in `foo@bar.baz' has been matched
+ ;; above as a command; try and overwrite it.
+ (,(let* ((host "[A-Za-z0-9]\\(?:[A-Za-z0-9-]\\{0,61\\}[A-Za-z0-9]\\)")
+ (fqdn (concat "\\(?:" host "\\.\\)+" host))
+ (comp "[!-(*--/-=?-~]+")
+ (path (concat "/\\(?:" comp "[.]+" "\\)*" comp)))
+ (concat "\\(?:mailto:\\)?[a-zA-0_.]+@" fqdn
+ "\\|https?://" fqdn "\\(?:" path "\\)?"))
+ 0 font-lock-keyword-face prepend nil)))
+
+(defconst doxygen-font-lock-keywords
+ `((,(lambda (limit)
+ (c-font-lock-doc-comments "/\\(?:/[/!]\\|\\*[\\*!]\\)"
+ limit doxygen-font-lock-doc-comments)))))
+
;; 2006-07-10: awk-font-lock-keywords has been moved back to cc-awk.el.
(cc-provide 'cc-fonts)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 0a7f4565c0e..13e70a32513 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -1174,7 +1174,7 @@ since CC Mode treats every identifier as an expression."
;; Exception.
,@(when (c-major-mode-is 'c++-mode)
- '((prefix "throw")))
+ '((prefix "throw" "co_await" "co_yield")))
;; Sequence.
(left-assoc ","))
@@ -1769,7 +1769,7 @@ ender."
`comment-start-skip' is initialized from this."
;; Default: Allow the last char of the comment starter(s) to be
;; repeated, then allow any amount of horizontal whitespace.
- t (concat "\\("
+ t (concat "\\(?:"
(c-concat-separated
(mapcar (lambda (cs)
(when cs
@@ -2040,6 +2040,7 @@ the appropriate place for that."
(c-lang-defconst c-return-kwds
"Keywords which return a value to the calling function."
t '("return")
+ c++ '("return" "co_return")
idl nil)
(c-lang-defconst c-return-key
@@ -2337,6 +2338,16 @@ will be handled."
t (c-make-keywords-re t (c-lang-const c-typedef-decl-kwds)))
(c-lang-defvar c-typedef-decl-key (c-lang-const c-typedef-decl-key))
+(c-lang-defconst c-using-kwds
+ "Keywords which behave like `using' in C++"
+ t nil
+ c++ '("using"))
+
+(c-lang-defconst c-using-key
+ ;; Regexp matching C++'s `using'.
+ t (c-make-keywords-re t (c-lang-const c-using-kwds)))
+(c-lang-defvar c-using-key (c-lang-const c-using-key))
+
(c-lang-defconst c-typeless-decl-kwds
"Keywords introducing declarations where the (first) identifier
\(declarator) follows directly after the keyword, without any type.
@@ -2387,7 +2398,8 @@ will be handled."
t nil
(c c++) '("auto" "extern" "inline" "register" "static")
c++ (append '("constexpr" "explicit" "friend" "mutable" "template"
- "thread_local" "using" "virtual")
+ "thread_local" "virtual")
+ ;; "using" is now handled specially (2020-09-14).
(c-lang-const c-modifier-kwds))
objc '("auto" "bycopy" "byref" "extern" "in" "inout" "oneway" "out" "static")
;; FIXME: Some of those below ought to be on `c-other-decl-kwds' instead.
@@ -2415,7 +2427,8 @@ If any of these also are on `c-type-list-kwds', `c-ref-list-kwds',
`c-<>-type-kwds', or `c-<>-arglist-kwds' then the associated clauses
will be handled."
t nil
- objc '("@class" "@end" "@defs")
+ objc '("@class" "@defs" "@end" "@property" "@dynamic" "@synthesize"
+ "@compatibility_alias")
java '("import" "package")
pike '("import" "inherit"))
@@ -2538,7 +2551,8 @@ one of `c-type-list-kwds', `c-ref-list-kwds',
"Access protection label keywords in classes."
t nil
c++ '("private" "protected" "public")
- objc '("@private" "@protected" "@public"))
+ objc '("@private" "@protected" "@package" "@public"
+ "@required" "@optional"))
(c-lang-defconst c-protection-key
;; A regexp match an element of `c-protection-kwds' cleanly.
@@ -2753,7 +2767,7 @@ identifiers that follows the type in a normal declaration."
"Statement keywords followed directly by a substatement."
t '("do" "else")
c++ '("do" "else" "try")
- objc '("do" "else" "@finally" "@try")
+ objc '("do" "else" "@finally" "@try" "@autoreleasepool")
java '("do" "else" "finally" "try")
idl nil)
@@ -2783,7 +2797,7 @@ Keywords here should also be in `c-block-stmt-1-kwds'."
java '("for" "if" "switch" "while" "catch" "synchronized")
idl nil
pike '("for" "if" "switch" "while" "foreach")
- awk '("for" "if" "while"))
+ awk '("for" "if" "switch" "while"))
(c-lang-defconst c-block-stmt-2-key
;; Regexp matching the start of any statement followed by a paren sexp
@@ -2822,6 +2836,7 @@ Keywords here should also be in `c-block-stmt-1-kwds'."
(c-lang-defconst c-simple-stmt-kwds
"Statement keywords followed by an expression or nothing."
t '("break" "continue" "goto" "return")
+ c++ '("break" "continue" "goto" "return" "co_return")
objc '("break" "continue" "goto" "return" "@throw")
;; Note: `goto' is not valid in Java, but the keyword is still reserved.
java '("break" "continue" "goto" "return" "throw")
@@ -2862,8 +2877,7 @@ nevertheless contains a list separated with `;' and not `,'."
(c-lang-defconst c-case-kwds
"The keyword(s) which introduce a \"case\" like construct.
This construct is \"<keyword> <expression> :\"."
- t '("case")
- awk nil)
+ t '("case"))
(c-lang-defconst c-case-kwds-regexp
;; Adorned regexp matching any "case"-like keyword.
@@ -2895,7 +2909,8 @@ This construct is \"<keyword> <expression> :\"."
c++ (append
'("nullptr")
(c-lang-const c-constant-kwds c))
- objc '("nil" "Nil" "YES" "NO" "NS_DURING" "NS_HANDLER" "NS_ENDHANDLER")
+ objc '("nil" "Nil" "YES" "NO" "IBAction" "IBOutlet"
+ "NS_DURING" "NS_HANDLER" "NS_ENDHANDLER")
idl '("TRUE" "FALSE")
java '("true" "false" "null") ; technically "literals", not keywords
pike '("UNDEFINED")) ;; Not a keyword, but practically works as one.
@@ -3030,7 +3045,14 @@ Note that Java specific rules are currently applied to tell this from
;; can start a declaration.)
"entity" "process" "service" "session" "storage"))
-
+(c-lang-defconst c-std-abbrev-keywords
+ "List of keywords which may need to cause electric indentation."
+ t '("else" "while")
+ c++ (append (c-lang-const c-std-abbrev-keywords) '("catch"))
+ java (append (c-lang-const c-std-abbrev-keywords) '("catch" "finally"))
+ idl nil)
+(c-lang-defvar c-std-abbrev-keywords (c-lang-const c-std-abbrev-keywords))
+
;;; Constants built from keywords.
;; Note: No `*-kwds' language constants may be defined below this point.
@@ -3405,8 +3427,14 @@ regexp should match \"(\" if parentheses are valid in declarators.
The end of the first submatch is taken as the end of the operator.
Identifier syntax is in effect when this is matched (see
`c-identifier-syntax-table')."
- t (if (c-lang-const c-type-modifier-kwds)
- (concat (regexp-opt (c-lang-const c-type-modifier-kwds) t) "\\>")
+ t (if (or (c-lang-const c-type-modifier-kwds) (c-lang-const c-modifier-kwds))
+ (concat
+ (regexp-opt (c--delete-duplicates
+ (append (c-lang-const c-type-modifier-kwds)
+ (c-lang-const c-modifier-kwds))
+ :test 'string-equal)
+ t)
+ "\\>")
;; Default to a regexp that never matches.
regexp-unmatchable)
;; Check that there's no "=" afterwards to avoid matching tokens
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 74afeecf8f7..c6dd671051d 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -278,6 +278,29 @@ control). See \"cc-mode.el\" for more info."
(setq defs (cdr defs)))))
(put 'c-define-abbrev-table 'lisp-indent-function 1)
+(defun c-populate-abbrev-table ()
+ ;; Insert the standard keywords which may need electric indentation into the
+ ;; current mode's abbreviation table.
+ (let ((table (intern (concat (symbol-name major-mode) "-abbrev-table")))
+ (defs c-std-abbrev-keywords)
+ )
+ (unless (and (boundp table)
+ (abbrev-table-p (symbol-value table)))
+ (define-abbrev-table table nil))
+ (setq local-abbrev-table (symbol-value table))
+ (while defs
+ (unless (intern-soft (car defs) local-abbrev-table) ; Don't overwrite the
+ ; abbrev's use count.
+ (condition-case nil
+ (define-abbrev (symbol-value table)
+ (car defs) (car defs)
+ 'c-electric-continued-statement 0 t)
+ (wrong-number-of-arguments
+ (define-abbrev (symbol-value table)
+ (car defs) (car defs)
+ 'c-electric-continued-statement 0))))
+ (setq defs (cdr defs)))))
+
(defun c-bind-special-erase-keys ()
;; Only used in Emacs to bind C-c C-<delete> and C-c C-<backspace>
;; to the proper keys depending on `normal-erase-is-backspace'.
@@ -535,6 +558,18 @@ preferably use the `c-mode-menu' language constant directly."
;; and `after-change-functions'. Note that this variable is not set when
;; `c-before-change' is invoked by a change to text properties.
+(defvar c-min-syn-tab-mkr nil)
+;; The minimum buffer position where there's a `c-fl-syn-tab' text property,
+;; or nil if there aren't any. This is a marker, or nil if there's currently
+;; no such text property.
+(make-variable-buffer-local 'c-min-syn-tab-mkr)
+
+(defvar c-max-syn-tab-mkr nil)
+;; The maximum buffer position plus 1 where there's a `c-fl-syn-tab' text
+;; property, or nil if there aren't any. This is a marker, or nil if there's
+;; currently no such text property.
+(make-variable-buffer-local 'c-max-syn-tab-mkr)
+
(defun c-basic-common-init (mode default-style)
"Do the necessary initialization for the syntax handling routines
and the line breaking/filling code. Intended to be used by other
@@ -550,6 +585,8 @@ that requires a literal mode spec at compile time."
(setq c-buffer-is-cc-mode mode)
+ (c-populate-abbrev-table)
+
;; these variables should always be buffer local; they do not affect
;; indentation style.
(make-local-variable 'comment-start)
@@ -606,6 +643,10 @@ that requires a literal mode spec at compile time."
;; Initialize the "brace stack" cache.
(c-init-bs-cache)
+ ;; Keep track of where `c-fl-syn-tab' text properties are set.
+ (setq c-min-syn-tab-mkr nil)
+ (setq c-max-syn-tab-mkr nil)
+
(when (or c-recognize-<>-arglists
(c-major-mode-is 'awk-mode)
(c-major-mode-is '(java-mode c-mode c++-mode objc-mode pike-mode)))
@@ -1207,52 +1248,94 @@ Note that the style variables are always made local to the buffer."
(c-put-syn-tab (1- (point)) '(15)))
(t nil)))))
-(defvar c-fl-syn-tab-region nil)
- ;; Non-nil when a `c-restore-string-fences' is "in force". It's value is a
- ;; cons of the BEG and END of the region currently "mirroring" the
- ;; c-fl-syn-tab properties as syntax-table properties.
+(defun c-put-syn-tab (pos value)
+ ;; Set both the syntax-table and the c-fl-syn-tab text properties at POS to
+ ;; VALUE (which should not be nil).
+ ;; `(let ((-pos- ,pos)
+ ;; (-value- ,value))
+ (c-put-char-property pos 'syntax-table value)
+ (c-put-char-property pos 'c-fl-syn-tab value)
+ (cond
+ ((null c-min-syn-tab-mkr)
+ (setq c-min-syn-tab-mkr (copy-marker pos t)))
+ ((< pos c-min-syn-tab-mkr)
+ (move-marker c-min-syn-tab-mkr pos)))
+ (cond
+ ((null c-max-syn-tab-mkr)
+ (setq c-max-syn-tab-mkr (copy-marker (1+ pos) nil)))
+ ((>= pos c-max-syn-tab-mkr)
+ (move-marker c-max-syn-tab-mkr (1+ pos))))
+ (c-truncate-lit-pos-cache pos))
+
+(defun c-clear-syn-tab (pos)
+ ;; Remove both the 'syntax-table and `c-fl-syn-tab properties at POS.
+ (c-clear-char-property pos 'syntax-table)
+ (c-clear-char-property pos 'c-fl-syn-tab)
+ (when c-min-syn-tab-mkr
+ (if (and (eq pos (marker-position c-min-syn-tab-mkr))
+ (eq (1+ pos) (marker-position c-max-syn-tab-mkr)))
+ (progn
+ (move-marker c-min-syn-tab-mkr nil)
+ (move-marker c-max-syn-tab-mkr nil)
+ (setq c-min-syn-tab-mkr nil c-max-syn-tab-mkr nil))
+ (when (eq pos (marker-position c-min-syn-tab-mkr))
+ (move-marker c-min-syn-tab-mkr
+ (if (c-get-char-property (1+ pos) 'c-fl-syn-tab)
+ (1+ pos)
+ (c-next-single-property-change
+ (1+ pos) 'c-fl-syn-tab nil c-max-syn-tab-mkr))))
+ (when (eq (1+ pos) (marker-position c-max-syn-tab-mkr))
+ (move-marker c-max-syn-tab-mkr
+ (if (c-get-char-property (1- pos) 'c-fl-syn-tab)
+ pos
+ (c-previous-single-property-change
+ pos 'c-fl-syn-tab nil (1+ c-min-syn-tab-mkr)))))))
+ (c-truncate-lit-pos-cache pos))
(defun c-clear-string-fences ()
- ;; Clear syntax-table text properties in the region defined by
- ;; `c-cl-syn-tab-region' which are "mirrored" by c-fl-syn-tab text
- ;; properties. However, any such " character which ends up not being
+ ;; Clear syntax-table text properties which are "mirrored" by c-fl-syn-tab
+ ;; text properties. However, any such " character which ends up not being
;; balanced by another " is left with a '(1) syntax-table property.
- (when c-fl-syn-tab-region
- (let ((beg (car c-fl-syn-tab-region))
- (end (cdr c-fl-syn-tab-region))
- s pos)
- (setq pos beg)
+ (when
+ (and c-min-syn-tab-mkr c-max-syn-tab-mkr)
+ (let (s pos)
+ (setq pos c-min-syn-tab-mkr)
(while
(and
- (< pos end)
- (setq pos
- (c-min-property-position pos end 'c-fl-syn-tab))
- (< pos end))
+ (< pos c-max-syn-tab-mkr)
+ (setq pos (c-min-property-position pos
+ c-max-syn-tab-mkr
+ 'c-fl-syn-tab))
+ (< pos c-max-syn-tab-mkr))
(c-clear-char-property pos 'syntax-table)
(setq pos (1+ pos)))
;; Check we haven't left any unbalanced "s.
(save-excursion
- (setq pos beg)
+ (setq pos c-min-syn-tab-mkr)
;; Is there already an unbalanced " before BEG?
- (setq pos (c-min-property-position pos end 'c-fl-syn-tab))
- (when (< pos end) (goto-char pos))
+ (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)))
- (while (< pos end)
+ (while (< pos c-max-syn-tab-mkr)
(setq pos
- (c-min-property-position pos end 'c-fl-syn-tab))
- (when (< pos end)
+ (c-min-property-position pos c-max-syn-tab-mkr 'c-fl-syn-tab))
+ (when (< pos c-max-syn-tab-mkr)
(if (memq (char-after pos) c-string-delims)
(progn
;; Step over the ".
- (setq s (parse-partial-sexp pos end nil nil nil
+ (setq s (parse-partial-sexp pos c-max-syn-tab-mkr
+ nil nil nil
'syntax-table))
;; Seek a (bogus) matching ".
- (setq s (parse-partial-sexp (point) end nil nil s
+ (setq s (parse-partial-sexp (point) c-max-syn-tab-mkr
+ nil nil s
'syntax-table))
;; When a bogus matching " is found, do nothing.
;; Otherwise mark the " with 'syntax-table '(1).
@@ -1262,23 +1345,22 @@ Note that the style variables are always made local to the buffer."
(c-get-char-property (1- (point)) 'c-fl-syn-tab))
(c-put-char-property pos 'syntax-table '(1)))
(setq pos (point)))
- (setq pos (1+ pos))))))
- (setq c-fl-syn-tab-region nil))))
-
-(defun c-restore-string-fences (beg end)
- ;; Restore any syntax-table text properties in the region (BEG END) which
- ;; are "mirrored" by c-fl-syn-tab text properties.
- (let ((pos beg))
- (while
- (and
- (< pos end)
- (setq pos
- (c-min-property-position pos end 'c-fl-syn-tab))
- (< pos end))
- (c-put-char-property pos 'syntax-table
- (c-get-char-property pos 'c-fl-syn-tab))
- (setq pos (1+ pos)))
- (setq c-fl-syn-tab-region (cons beg end))))
+ (setq pos (1+ pos)))))))))
+
+(defun c-restore-string-fences ()
+ ;; Restore any syntax-table text properties which are "mirrored" by
+ ;; c-fl-syn-tab text properties.
+ (when (and c-min-syn-tab-mkr c-max-syn-tab-mkr)
+ (let ((pos c-min-syn-tab-mkr))
+ (while
+ (and
+ (< pos c-max-syn-tab-mkr)
+ (setq pos
+ (c-min-property-position pos c-max-syn-tab-mkr 'c-fl-syn-tab))
+ (< pos c-max-syn-tab-mkr))
+ (c-put-char-property pos 'syntax-table
+ (c-get-char-property pos 'c-fl-syn-tab))
+ (setq pos (1+ pos))))))
(defvar c-bc-changed-stringiness nil)
;; Non-nil when, in a before-change function, the deletion of a range of text
@@ -1396,9 +1478,11 @@ Note that the style variables are always made local to the buffer."
(c-will-be-escaped end beg end))
(c-remove-string-fences end)
(goto-char (1+ end)))
- ;; Are we unescaping a newline by inserting stuff between \ and \n?
- ((and (eq end beg)
- (c-is-escaped end))
+ ;; Are we unescaping a newline ...
+ ((and
+ (c-is-escaped end)
+ (or (eq beg end) ; .... by inserting stuff between \ and \n?
+ (c-will-be-unescaped beg end))) ; ... by removing an odd number of \s?
(goto-char (1+ end))) ; To after the NL which is being unescaped.
(t
(goto-char end)))
@@ -1406,7 +1490,7 @@ Note that the style variables are always made local to the buffer."
;; Move to end of logical line (as it will be after the change, or as it
;; was before unescaping a NL.)
- (re-search-forward "\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*" nil t)
+ (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*" nil t)
;; We're at an EOLL or point-max.
(if (equal (c-get-char-property (point) 'syntax-table) '(15))
(if (memq (char-after) '(?\n ?\r))
@@ -1436,10 +1520,11 @@ Note that the style variables are always made local to the buffer."
(not (c-characterp c-multiline-string-start-char))))
(when (and (eq end-literal-type 'string)
(not (eq (char-before (cdr end-limits)) ?\())
- (memq (char-after (car end-limits)) c-string-delims)
- (equal (c-get-char-property (car end-limits) 'syntax-table)
- '(15)))
- (c-remove-string-fences (car end-limits))
+ (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)
+ '(15))
+ (c-remove-string-fences (car end-limits)))
(setq c-new-END (max c-new-END (cdr end-limits))))
(when (and (eq beg-literal-type 'string)
@@ -1512,9 +1597,13 @@ Note that the style variables are always made local to the buffer."
; insertion/deletion of string delimiters.
(max
(progn
- (goto-char (min (1+ end) ; 1+, in case a NL has become escaped.
- (point-max)))
- (re-search-forward "\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*"
+ (goto-char
+ (if (and (memq (char-after end) '(?\n ?\r))
+ (c-is-escaped end))
+ (min (1+ end) ; 1+, if we're inside an escaped NL.
+ (point-max))
+ end))
+ (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*"
nil t)
(point))
c-new-END))
@@ -1595,7 +1684,7 @@ Note that the style variables are always made local to the buffer."
(c-beginning-of-macro))))
(goto-char (1+ end)) ; After the \
;; Search forward for EOLL
- (setq lim (re-search-forward "\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*"
+ (setq lim (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*"
nil t))
(goto-char (1+ end))
(when (c-search-forward-char-property-with-value-on-char
@@ -1888,7 +1977,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(widen)
(unwind-protect
(progn
- (c-restore-string-fences (point-min) (point-max))
+ (c-restore-string-fences)
(save-excursion
;; Are we inserting/deleting stuff in the middle of an
;; identifier?
@@ -2018,7 +2107,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(widen)
(unwind-protect
(progn
- (c-restore-string-fences (point-min) (point-max))
+ (c-restore-string-fences)
(when (> end (point-max))
;; Some emacsen might return positions past the end. This
;; has been observed in Emacs 20.7 when rereading a buffer
@@ -2177,25 +2266,45 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(defun c-fl-decl-end (pos)
;; If POS is inside a declarator, return the end of the token that follows
;; the declarator, otherwise return nil. POS being in a literal does not
- ;; count as being in a declarator (on pragmatic grounds).
+ ;; count as being in a declarator (on pragmatic grounds). POINT is not
+ ;; preserved.
(goto-char pos)
(let ((lit-start (c-literal-start))
enclosing-attribute pos1)
(unless lit-start
(c-backward-syntactic-ws)
- (when (setq enclosing-attribute (c-slow-enclosing-c++-attribute))
+ (when (setq enclosing-attribute (c-enclosing-c++-attribute))
(goto-char (car enclosing-attribute))) ; Only happens in C++ Mode.
(when (setq pos1 (c-on-identifier))
(goto-char pos1)
(let ((lim (save-excursion
(and (c-beginning-of-macro)
(progn (c-end-of-macro) (point))))))
- (when (and (c-forward-declarator lim)
- (or (not (eq (char-after) ?\())
- (c-go-list-forward nil lim))
- (eq (c-forward-token-2 1 nil lim) 0))
- (c-backward-syntactic-ws)
- (point)))))))
+ (and (c-forward-declarator lim)
+ (if (eq (char-after) ?\()
+ (and
+ (c-go-list-forward nil lim)
+ (progn (c-forward-syntactic-ws lim)
+ (not (eobp)))
+ (progn
+ (if (looking-at c-symbol-char-key)
+ ;; Deal with baz (foo((bar)) type var), where
+ ;; foo((bar)) is not semantically valid. The result
+ ;; must be after var).
+ (and
+ (goto-char pos)
+ (setq pos1 (c-on-identifier))
+ (goto-char pos1)
+ (progn
+ (c-backward-syntactic-ws)
+ (eq (char-before) ?\())
+ (c-fl-decl-end (1- (point))))
+ (c-backward-syntactic-ws)
+ (point))))
+ (and (progn (c-forward-syntactic-ws lim)
+ (not (eobp)))
+ (c-backward-syntactic-ws)
+ (point)))))))))
(defun c-change-expand-fl-region (_beg _end _old-len)
;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock
@@ -2255,69 +2364,48 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
;; line was fouled up by context fontification.
(save-restriction
(widen)
- (let (new-beg new-end new-region case-fold-search string-fence-beg lim)
- ;; Check how far back we need to extend the region where we reapply the
- ;; string fence syntax-table properties. These must be in place for the
- ;; coming fontification operations.
- (save-excursion
- (goto-char (if c-in-after-change-fontification
- (min beg c-new-BEG)
- beg))
- (setq lim (max (- (point) 500) (point-min)))
- (while
+ (let (new-beg new-end new-region case-fold-search)
+ (c-save-buffer-state nil
+ ;; Temporarily reapply the string fence syntax-table properties.
+ (unwind-protect
(progn
- (skip-chars-backward "^\"" lim)
- (or (bobp) (backward-char))
- (save-excursion
- (eq (logand (skip-chars-backward "\\\\") 1) 1))))
- (setq string-fence-beg
- (cond ((c-get-char-property (point) 'c-fl-syn-tab)
- (point))
- (c-in-after-change-fontification
- c-new-BEG)
- (t beg)))
- (c-save-buffer-state nil
- ;; Temporarily reapply the string fence syntax-table properties.
- (c-with-extended-string-fences
- string-fence-beg (if c-in-after-change-fontification
- (max end c-new-END)
- end)
-
- (if (and c-in-after-change-fontification
- (< beg c-new-END) (> end c-new-BEG))
- ;; Region and the latest after-change fontification region overlap.
- ;; Determine the upper and lower bounds of our adjusted region
- ;; separately.
- (progn
- (if (<= beg c-new-BEG)
- (setq c-in-after-change-fontification nil))
- (setq new-beg
- (if (and (>= beg (c-point 'bol c-new-BEG))
- (<= beg c-new-BEG))
- ;; Either jit-lock has accepted `c-new-BEG', or has
- ;; (probably) extended the change region spuriously
- ;; to BOL, which position likely has a
- ;; syntactically different position. To ensure
- ;; correct fontification, we start at `c-new-BEG',
- ;; assuming any characters to the left of
- ;; `c-new-BEG' on the line do not require
- ;; fontification.
- c-new-BEG
- (setq new-region (c-before-context-fl-expand-region beg end)
- new-end (cdr new-region))
- (car new-region)))
- (setq new-end
- (if (and (>= end (c-point 'bol c-new-END))
- (<= end c-new-END))
- c-new-END
- (or new-end
- (cdr (c-before-context-fl-expand-region beg end))))))
- ;; Context (etc.) fontification.
- (setq new-region (c-before-context-fl-expand-region beg end)
- new-beg (car new-region) new-end (cdr new-region)))
- ;; Finally invoke font lock's functionality.
- (funcall (default-value 'font-lock-fontify-region-function)
- new-beg new-end verbose)))))))
+ (c-restore-string-fences)
+ (if (and c-in-after-change-fontification
+ (< beg c-new-END) (> end c-new-BEG))
+ ;; Region and the latest after-change fontification region overlap.
+ ;; Determine the upper and lower bounds of our adjusted region
+ ;; separately.
+ (progn
+ (if (<= beg c-new-BEG)
+ (setq c-in-after-change-fontification nil))
+ (setq new-beg
+ (if (and (>= beg (c-point 'bol c-new-BEG))
+ (<= beg c-new-BEG))
+ ;; Either jit-lock has accepted `c-new-BEG', or has
+ ;; (probably) extended the change region spuriously
+ ;; to BOL, which position likely has a
+ ;; syntactically different position. To ensure
+ ;; correct fontification, we start at `c-new-BEG',
+ ;; assuming any characters to the left of
+ ;; `c-new-BEG' on the line do not require
+ ;; fontification.
+ c-new-BEG
+ (setq new-region (c-before-context-fl-expand-region beg end)
+ new-end (cdr new-region))
+ (car new-region)))
+ (setq new-end
+ (if (and (>= end (c-point 'bol c-new-END))
+ (<= end c-new-END))
+ c-new-END
+ (or new-end
+ (cdr (c-before-context-fl-expand-region beg end))))))
+ ;; Context (etc.) fontification.
+ (setq new-region (c-before-context-fl-expand-region beg end)
+ new-beg (car new-region) new-end (cdr new-region)))
+ ;; Finally invoke font lock's functionality.
+ (funcall (default-value 'font-lock-fontify-region-function)
+ new-beg new-end verbose))
+ (c-clear-string-fences))))))
(defun c-after-font-lock-init ()
;; Put on `font-lock-mode-hook'. This function ensures our after-change
@@ -2444,11 +2532,6 @@ opening \" and the next unescaped end of line."
(funcall (c-lang-const c-make-mode-syntax-table c))
"Syntax table used in c-mode buffers.")
-(c-define-abbrev-table 'c-mode-abbrev-table
- '(("else" "else" c-electric-continued-statement 0)
- ("while" "while" c-electric-continued-statement 0))
- "Abbreviation table used in c-mode buffers.")
-
(defvar c-mode-map
(let ((map (c-make-inherited-keymap)))
map)
@@ -2521,13 +2604,21 @@ Key bindings:
(defconst c-or-c++-mode--regexp
(eval-when-compile
- (let ((id "[a-zA-Z0-9_]+") (ws "[ \t\r]+") (ws-maybe "[ \t\r]*"))
+ (let ((id "[a-zA-Z_][a-zA-Z0-9_]*") (ws "[ \t]+") (ws-maybe "[ \t]*")
+ (headers '("string" "string_view" "iostream" "map" "unordered_map"
+ "set" "unordered_set" "vector" "tuple")))
(concat "^" ws-maybe "\\(?:"
- "using" ws "\\(?:namespace" ws "std;\\|std::\\)"
- "\\|" "namespace" "\\(:?" ws id "\\)?" ws-maybe "{"
- "\\|" "class" ws id ws-maybe "[:{\n]"
- "\\|" "template" ws-maybe "<.*>"
- "\\|" "#include" ws-maybe "<\\(?:string\\|iostream\\|map\\)>"
+ "using" ws "\\(?:namespace" ws
+ "\\|" id "::"
+ "\\|" id ws-maybe "=\\)"
+ "\\|" "\\(?:inline" ws "\\)?namespace"
+ "\\(:?" ws "\\(?:" id "::\\)*" id "\\)?" ws-maybe "{"
+ "\\|" "class" ws id
+ "\\(?:" ws "final" "\\)?" ws-maybe "[:{;\n]"
+ "\\|" "struct" ws id "\\(?:" ws "final" ws-maybe "[:{\n]"
+ "\\|" ws-maybe ":\\)"
+ "\\|" "template" ws-maybe "<.*?>"
+ "\\|" "#include" ws-maybe "<" (regexp-opt headers) ">"
"\\)")))
"A regexp applied to C header files to check if they are really C++.")
@@ -2543,6 +2634,7 @@ should be used.
This function attempts to use file contents to determine whether
the code is C or C++ and based on that chooses whether to enable
`c-mode' or `c++-mode'."
+ (interactive)
(if (save-excursion
(save-restriction
(save-match-data
@@ -2560,12 +2652,6 @@ the code is C or C++ and based on that chooses whether to enable
(funcall (c-lang-const c-make-mode-syntax-table c++))
"Syntax table used in c++-mode buffers.")
-(c-define-abbrev-table 'c++-mode-abbrev-table
- '(("else" "else" c-electric-continued-statement 0)
- ("while" "while" c-electric-continued-statement 0)
- ("catch" "catch" c-electric-continued-statement 0))
- "Abbreviation table used in c++-mode buffers.")
-
(defvar c++-mode-map
(let ((map (c-make-inherited-keymap)))
map)
@@ -2614,11 +2700,6 @@ Key bindings:
(funcall (c-lang-const c-make-mode-syntax-table objc))
"Syntax table used in objc-mode buffers.")
-(c-define-abbrev-table 'objc-mode-abbrev-table
- '(("else" "else" c-electric-continued-statement 0)
- ("while" "while" c-electric-continued-statement 0))
- "Abbreviation table used in objc-mode buffers.")
-
(defvar objc-mode-map
(let ((map (c-make-inherited-keymap)))
map)
@@ -2665,13 +2746,6 @@ Key bindings:
(funcall (c-lang-const c-make-mode-syntax-table java))
"Syntax table used in java-mode buffers.")
-(c-define-abbrev-table 'java-mode-abbrev-table
- '(("else" "else" c-electric-continued-statement 0)
- ("while" "while" c-electric-continued-statement 0)
- ("catch" "catch" c-electric-continued-statement 0)
- ("finally" "finally" c-electric-continued-statement 0))
- "Abbreviation table used in java-mode buffers.")
-
(defvar java-mode-map
(let ((map (c-make-inherited-keymap)))
map)
@@ -2683,7 +2757,7 @@ Key bindings:
;; since it's practically impossible to write a regexp that reliably
;; matches such a construct. Other tools are necessary.
(defconst c-Java-defun-prompt-regexp
- "^[ \t]*\\(\\(\\(public\\|protected\\|private\\|const\\|abstract\\|synchronized\\|final\\|static\\|threadsafe\\|transient\\|native\\|volatile\\)\\s-+\\)*\\(\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*[][_$.a-zA-Z0-9]+\\|[[a-zA-Z]\\)\\s-*\\)\\s-+\\)\\)?\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*\\s-+\\)\\s-*\\)?\\([_a-zA-Z][^][ \t:;.,{}()\^?=]*\\|\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)\\)\\s-*\\(([^);{}]*)\\)?\\([] \t]*\\)\\(\\s-*\\<throws\\>\\s-*\\(\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)[, \t\n\r\f\v]*\\)+\\)?\\s-*")
+ "^[ \t]*\\(\\(\\(public\\|protected\\|private\\|const\\|abstract\\|synchronized\\|final\\|static\\|threadsafe\\|transient\\|native\\|volatile\\)\\s-+\\)*\\(\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]+\\|[[a-zA-Z]\\)\\s-*\\)\\s-+\\)\\)?\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*\\s-+\\)\\s-*\\)?\\([_a-zA-Z][^][ \t:;.,{}()\^?=]*\\|\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)\\)\\s-*\\(([^);{}]*)\\)?\\([] \t]*\\)\\(\\s-*\\<throws\\>\\s-*\\(\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)[, \t\n\r\f\v]*\\)+\\)?\\s-*")
(easy-menu-define c-java-menu java-mode-map "Java Mode Commands"
(cons "Java" (c-lang-const c-mode-menu java)))
@@ -2722,9 +2796,6 @@ Key bindings:
(funcall (c-lang-const c-make-mode-syntax-table idl))
"Syntax table used in idl-mode buffers.")
-(c-define-abbrev-table 'idl-mode-abbrev-table nil
- "Abbreviation table used in idl-mode buffers.")
-
(defvar idl-mode-map
(let ((map (c-make-inherited-keymap)))
map)
@@ -2767,11 +2838,6 @@ Key bindings:
(funcall (c-lang-const c-make-mode-syntax-table pike))
"Syntax table used in pike-mode buffers.")
-(c-define-abbrev-table 'pike-mode-abbrev-table
- '(("else" "else" c-electric-continued-statement 0)
- ("while" "while" c-electric-continued-statement 0))
- "Abbreviation table used in pike-mode buffers.")
-
(defvar pike-mode-map
(let ((map (c-make-inherited-keymap)))
map)
@@ -2819,11 +2885,6 @@ Key bindings:
;;;###autoload (add-to-list 'interpreter-mode-alist '("nawk" . awk-mode))
;;;###autoload (add-to-list 'interpreter-mode-alist '("gawk" . awk-mode))
-(c-define-abbrev-table 'awk-mode-abbrev-table
- '(("else" "else" c-electric-continued-statement 0)
- ("while" "while" c-electric-continued-statement 0))
- "Abbreviation table used in awk-mode buffers.")
-
(defvar awk-mode-map
(let ((map (c-make-inherited-keymap)))
map)
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index 36be9f6c74e..855e467571d 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -395,8 +395,7 @@ a null operation."
;; remain. This is not necessary for c-offsets-alist, since
;; c-get-style-variables contains every valid offset type in the
;; fallback entry.
- (setq c-special-indent-hook
- (default-value 'c-special-indent-hook)))
+ (kill-local-variable 'c-special-indent-hook))
(mapc (lambda (elem)
(c-set-style-1 elem dont-override))
;; Need to go through the variables backwards when we
@@ -644,7 +643,7 @@ CC Mode by making sure the proper entries are present on
(defun c-make-styles-buffer-local (&optional this-buf-only-p)
"Make all CC Mode style variables buffer local.
-If `this-buf-only-p' is non-nil, the style variables will be made
+If THIS-BUF-ONLY-P is non-nil, the style variables will be made
buffer local only in the current buffer. Otherwise they'll be made
permanently buffer local in any buffer that changes their values.
@@ -662,7 +661,6 @@ any reason to call this function directly."
;; Hooks must be handled specially
(if this-buf-only-p
(if (featurep 'xemacs) (make-local-hook 'c-special-indent-hook))
- (with-no-warnings (make-variable-buffer-local 'c-special-indent-hook))
(setq c-style-variables-are-local-p t))
))
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index 556ff6059f1..9e6f9527ca1 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -576,6 +576,7 @@ comment styles:
javadoc -- Javadoc style for \"/** ... */\" comments (default in Java mode).
autodoc -- Pike autodoc style for \"//! ...\" comments (default in Pike mode).
gtkdoc -- GtkDoc style for \"/** ... **/\" comments (default in C and C++ modes).
+ doxygen -- Doxygen style.
The value may also be a list of doc comment styles, in which case all
of them are recognized simultaneously (presumably with markup cues
@@ -1649,6 +1650,15 @@ white space either before or after the operator, but not both."
:type 'boolean
:group 'c)
+(defcustom c-cpp-indent-to-body-directives '("pragma")
+ "Preprocessor directives which will be indented as statements.
+
+A list of Preprocessor directives which when reindented, or newly
+typed in, will cause the \"#\" introducing the directive to be
+indented as a statement."
+ :type '(repeat string)
+ :group 'c)
+
;; Initialize the next two to a regexp which never matches.
(defvar c-noise-macro-with-parens-name-re regexp-unmatchable)
(make-variable-buffer-local 'c-noise-macro-with-parens-name-re)
@@ -1660,7 +1670,8 @@ white space either before or after the operator, but not both."
like \"INLINE\" which are syntactic noise. Such a macro/extension is complete
in itself, never having parentheses. All these names must be syntactically
valid identifiers. Alternatively, this variable may be a regular expression
-which matches the names of such macros.
+which matches the names of such macros, in which case it must have a submatch
+1 which matches the actual noise macro name.
If you change this variable's value, call the function
`c-make-noise-macro-regexps' to set the necessary internal variables (or do
@@ -1676,7 +1687,8 @@ this implicitly by reinitializing C/C++/Objc Mode on any buffer)."
which optionally have arguments in parentheses, and which expand to nothing.
All these names must be syntactically valid identifiers. These are recognized
by CC Mode only in declarations. Alternatively, this variable may be a
-regular expression which matches the names of such macros.
+regular expression which matches the names of such macros, in which case it
+must have a submatch 1 which matches the actual noise macro name.
If you change this variable's value, call the function
`c-make-noise-macro-regexps' to set the necessary internal variables (or do
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index 9ddb2ab2bbb..a8fe485b702 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -1294,10 +1294,10 @@ Calls `cfengine-cf-promises' with \"-s json\"."
'symbols))
syntax)))
-(defun cfengine3-documentation-function ()
+(defun cfengine3-documentation-function (&rest _ignored)
"Document CFengine 3 functions around point.
-Intended as the value of `eldoc-documentation-function', which see.
-Use it by enabling `eldoc-mode'."
+Intended as the value of `eldoc-documentation-functions', which
+see. Use it by enabling `eldoc-mode'."
(let ((fdef (cfengine3--current-function)))
(when fdef
(cfengine3-format-function-docstring fdef))))
@@ -1322,7 +1322,7 @@ Use it by enabling `eldoc-mode'."
(set (make-local-variable 'parens-require-spaces) nil)
(set (make-local-variable 'comment-start) "# ")
(set (make-local-variable 'comment-start-skip)
- "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
+ "\\(\\(?:^\\|[^\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
;; Like Lisp mode. Without this, we lose with, say,
;; `backward-up-list' when there's an unbalanced quote in a
;; preceding comment.
@@ -1390,12 +1390,8 @@ to the action header."
(when buffer-file-name
(shell-quote-argument buffer-file-name)))))
- ;; For emacs < 25.1 where `eldoc-documentation-function' defaults to
- ;; nil.
- (or eldoc-documentation-function
- (setq-local eldoc-documentation-function #'ignore))
- (add-function :before-until (local 'eldoc-documentation-function)
- #'cfengine3-documentation-function)
+ (add-hook 'eldoc-documentation-functions
+ #'cfengine3-documentation-function nil t)
(add-hook 'completion-at-point-functions
#'cfengine3-completion-function nil t)
diff --git a/lisp/progmodes/cl-font-lock.el b/lisp/progmodes/cl-font-lock.el
new file mode 100644
index 00000000000..65090ac3ca5
--- /dev/null
+++ b/lisp/progmodes/cl-font-lock.el
@@ -0,0 +1,290 @@
+;;; cl-font-lock.el --- Pretty Common Lisp font locking -*- lexical-binding: t; -*-
+;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+;; Author: Yue Daian <sheepduke@gmail.com>
+;; Maintainer: Spenser Truex <web@spensertruex.com>
+;; Created: 2019-06-16
+;; Old-Version: 0.3.0
+;; Package-Requires: ((emacs "24.5"))
+;; Keywords: lisp wp files convenience
+;; URL: https://github.com/cl-font-lock/cl-font-lock
+;; Homepage: https://github.com/cl-font-lock/cl-font-lock
+
+;; This file is part of GNU Emacs
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Highlight all the symbols in the Common Lisp ANSI Standard.
+;; Adds font-lock regexes to lisp-mode.
+
+;;;; Todo:
+
+;; - Integrate better into `lisp-mode' (e.g. enable it by default).
+;; - Distinguish functions from macros like `pushnew'.
+
+;;; Code:
+
+;; The list of built-in functions and variables was actually not
+;; extracted from the standard, but from SBCL with the following
+;; (Common Lisp) code:
+
+;; (defvar *functions* nil)
+;; (defvar *symbols* nil)
+;; (defvar *types* nil)
+
+;; (let ((pack (find-package :common-lisp)))
+;; (do-all-symbols (sym)
+;; (cond
+;; ((not (eql pack (symbol-package sym))) nil)
+;; ((fboundp sym) (pushnew sym *functions*))
+;; ((find-class sym nil) (pushnew sym *types*))
+;; (t (pushnew sym *symbols*)))))
+
+
+(defvar cl-font-lock-built-in--functions
+ '("+" "-" "/" "/=" "<" "<=" "=" ">" ">=" "*" "1-" "1+" "abs" "acons" "acos"
+ "acosh" "add-method" "adjoin" "adjustable-array-p" "adjust-array"
+ "allocate-instance" "alpha-char-p" "alphanumericp" "and" "append" "apply"
+ "apropos" "apropos-list" "aref" "arithmetic-error-operands"
+ "arithmetic-error-operation" "array-dimension" "array-dimensions"
+ "array-displacement" "array-element-type" "array-has-fill-pointer-p"
+ "array-in-bounds-p" "arrayp" "array-rank" "array-row-major-index"
+ "array-total-size" "ash" "asin" "asinh" "assoc" "assoc-if" "assoc-if-not"
+ "atan" "atanh" "atom" "bit" "bit-and" "bit-andc1" "bit-andc2" "bit-eqv"
+ "bit-ior" "bit-nand" "bit-nor" "bit-not" "bit-orc1" "bit-orc2"
+ "bit-vector-p" "bit-xor" "boole" "both-case-p" "boundp"
+ "broadcast-stream-streams" "butlast" "byte" "byte-position" "byte-size"
+ "call-method" "call-next-method" "car" "catch" "cdr" "ceiling"
+ "cell-error-name" "change-class" "char" "char/=" "char<" "char<=" "char="
+ "char>" "char>=" "character" "characterp" "char-code" "char-downcase"
+ "char-equal" "char-greaterp" "char-int" "char-lessp" "char-name"
+ "char-not-equal" "char-not-greaterp" "char-not-lessp" "char-upcase" "cis"
+ "class-name" "class-of" "clear-input" "clear-output" "close" "clrhash"
+ "code-char" "coerce" "compile" "compiled-function-p" "compile-file"
+ "compile-file-pathname" "compiler-macro-function" "complement" "complex"
+ "complexp" "compute-applicable-methods" "compute-restarts" "concatenate"
+ "concatenated-stream-streams" "conjugate" "cons" "consp" "constantly"
+ "constantp" "continue" "copy-alist" "copy-list" "copy-pprint-dispatch"
+ "copy-readtable" "copy-seq" "copy-structure" "copy-symbol" "copy-tree"
+ "cos" "cosh" "count" "count-if" "count-if-not" "decf" "decode-float"
+ "decode-universal-time" "delete" "delete-duplicates" "delete-file"
+ "delete-if" "delete-if-not" "delete-package" "denominator" "deposit-field"
+ "describe" "describe-object" "digit-char" "digit-char-p" "directory"
+ "directory-namestring" "disassemble" "do-all-symbols" "documentation"
+ "do-external-symbols" "do-symbols" "dpb" "dribble"
+ "echo-stream-input-stream" "echo-stream-output-stream" "ed" "eighth" "elt"
+ "encode-universal-time" "endp" "enough-namestring"
+ "ensure-directories-exist" "ensure-generic-function" "eq" "eql" "equal"
+ "equalp" "eval" "evenp" "every" "exp" "export" "expt" "fboundp" "fceiling"
+ "fdefinition" "ffloor" "fifth" "file-author" "file-error-pathname"
+ "file-length" "file-namestring" "file-position" "file-string-length"
+ "file-write-date" "fill" "fill-pointer" "find" "find-all-symbols"
+ "find-class" "find-if" "find-if-not" "find-method" "find-package"
+ "find-restart" "find-symbol" "finish-output" "first" "float" "float-digits"
+ "floatp" "float-precision" "float-radix" "float-sign" "floor" "fmakunbound"
+ "force-output" "format" "formatter" "fourth" "fresh-line" "fround"
+ "ftruncate" "funcall" "function" "function-keywords"
+ "function-lambda-expression" "functionp" "gcd" "gensym" "gentemp" "get"
+ "get-decoded-time" "get-dispatch-macro-character" "getf" "gethash"
+ "get-internal-real-time" "get-internal-run-time" "get-macro-character"
+ "get-output-stream-string" "get-properties" "get-setf-expansion"
+ "get-universal-time" "graphic-char-p" "hash-table-count" "hash-table-p"
+ "hash-table-rehash-size" "hash-table-rehash-threshold" "hash-table-size"
+ "hash-table-test" "host-namestring" "identity" "imagpart" "import" "incf"
+ "initialize-instance" "input-stream-p" "inspect" "integer-decode-float"
+ "integer-length" "integerp" "interactive-stream-p" "intern" "intersection"
+ "invalid-method-error" "invoke-debugger" "invoke-restart"
+ "invoke-restart-interactively" "isqrt" "keywordp" "last" "lcm" "ldb"
+ "ldb-test" "ldiff" "length" "lisp-implementation-type"
+ "lisp-implementation-version" "list" "list\\*" "list-all-packages" "listen"
+ "list-length" "listp" "load" "load-logical-pathname-translations"
+ "load-time-value" "log" "logand" "logandc1" "logandc2" "logbitp" "logcount"
+ "logeqv" "logical-pathname" "logical-pathname-translations" "logior"
+ "lognand" "lognor" "lognot" "logorc1" "logorc2" "logtest" "logxor"
+ "long-site-name" "loop-finish" "lower-case-p" "machine-instance"
+ "machine-type" "machine-version" "macroexpand" "macroexpand-1"
+ "macro-function" "make-array" "make-array" "make-broadcast-stream"
+ "make-concatenated-stream" "make-condition" "make-dispatch-macro-character"
+ "make-echo-stream" "make-hash-table" "make-instance"
+ "make-instances-obsolete" "make-list" "make-load-form"
+ "make-load-form-saving-slots" "make-method" "make-package" "make-pathname"
+ "make-random-state" "make-sequence" "make-string"
+ "make-string-input-stream" "make-string-output-stream" "make-symbol"
+ "make-synonym-stream" "make-two-way-stream" "makunbound" "map" "mapc"
+ "mapcan" "mapcar" "mapcon" "maphash" "map-into" "mapl" "maplist"
+ "mask-field" "max" "member" "member-if" "member-if-not" "merge"
+ "merge-pathnames" "method-combination-error" "method-qualifiers" "min"
+ "minusp" "mismatch" "mod" "muffle-warning" "multiple-value-call"
+ "multiple-value-list" "multiple-value-setq" "name-char" "namestring"
+ "nbutlast" "nconc" "next-method-p" "nintersection" "ninth"
+ "no-applicable-method" "no-next-method" "not" "notany" "notevery" "nreconc"
+ "nreverse" "nset-difference" "nset-exclusive-or" "nstring-capitalize"
+ "nstring-downcase" "nstring-upcase" "nsublis" "nsubst" "nsubst-if"
+ "nsubst-if-not" "nsubstitute" "nsubstitute-if" "nsubstitute-if-not" "nth"
+ "nthcdr" "nth-value" "null" "numberp" "numerator" "nunion" "oddp" "open"
+ "open-stream-p" "or" "output-stream-p" "package-error-package"
+ "package-name" "package-nicknames" "packagep" "package-shadowing-symbols"
+ "package-used-by-list" "package-use-list" "pairlis" "parse-integer"
+ "parse-namestring" "pathname" "pathname-device" "pathname-directory"
+ "pathname-host" "pathname-match-p" "pathname-name" "pathnamep"
+ "pathname-type" "pathname-version" "peek-char" "phase" "plusp" "pop"
+ "position" "position-if" "position-if-not" "pprint" "pprint-dispatch"
+ "pprint-exit-if-list-exhausted" "pprint-fill" "pprint-indent"
+ "pprint-linear" "pprint-logical-block" "pprint-newline" "pprint-pop"
+ "pprint-tab" "pprint-tabular" "prin1" "prin1-to-string" "princ"
+ "princ-to-string" "print" "print-not-readable-object" "print-object"
+ "print-unreadable-object" "probe-file" "provide" "psetf" "psetq" "push"
+ "pushnew" "quote" "random" "random-state-p" "rassoc" "rassoc-if"
+ "rassoc-if-not" "rational" "rationalize" "rationalp" "read" "read-byte"
+ "read-char" "read-char-no-hang" "read-delimited-list" "read-from-string"
+ "read-line" "read-preserving-whitespace" "read-sequence" "readtable-case"
+ "readtablep" "realp" "realpart" "reduce" "reinitialize-instance" "rem"
+ "remf" "remhash" "remove" "remove-duplicates" "remove-if" "remove-if-not"
+ "remove-method" "remprop" "rename-file" "rename-package" "replace"
+ "require" "rest" "restart-name" "revappend" "reverse" "room" "rotatef"
+ "round" "row-major-aref" "rplaca" "rplacd" "sbit" "scale-float" "schar"
+ "search" "second" "set" "set-difference" "set-dispatch-macro-character"
+ "set-exclusive-or" "setf" "set-macro-character" "set-pprint-dispatch"
+ "setq" "set-syntax-from-char" "seventh" "shadow" "shadowing-import"
+ "shared-initialize" "shiftf" "short-site-name" "signum"
+ "simple-bit-vector-p" "simple-condition-format-arguments"
+ "simple-condition-format-control" "simple-string-p" "simple-vector-p" "sin"
+ "sinh" "sixth" "sleep" "slot-boundp" "slot-exists-p" "slot-makunbound"
+ "slot-missing" "slot-unbound" "slot-value" "software-type"
+ "software-version" "some" "sort" "special-operator-p" "sqrt" "stable-sort"
+ "standard-char-p" "step" "store-value" "stream-element-type"
+ "stream-error-stream" "stream-external-format" "streamp" "string"
+ "string/=" "string<" "string<=" "string=" "string>" "string>="
+ "string-capitalize" "string-downcase" "string-equal" "string-greaterp"
+ "string-left-trim" "string-lessp" "string-not-equal" "string-not-greaterp"
+ "string-not-lessp" "stringp" "string-right-trim" "string-trim"
+ "string-upcase" "sublis" "subseq" "subsetp" "subst" "subst-if"
+ "subst-if-not" "substitute" "substitute-if" "substitute-if-not" "subtypep"
+ "svref" "sxhash" "symbol-function" "symbol-name" "symbolp" "symbol-package"
+ "symbol-plist" "symbol-value" "synonym-stream-symbol" "tailp" "tan" "tanh"
+ "tenth" "terpri" "third" "throw" "time" "trace"
+ "translate-logical-pathname" "translate-pathname" "tree-equal" "truename"
+ "truncate" "two-way-stream-input-stream" "two-way-stream-output-stream"
+ "type-error-datum" "type-error-expected-type" "type-of" "typep"
+ "unbound-slot-instance" "unexport" "unintern" "union" "unread-char"
+ "untrace" "unuse-package" "update-instance-for-different-class"
+ "update-instance-for-redefined-class" "upgraded-array-element-type"
+ "upgraded-complex-part-type" "upper-case-p" "use-package"
+ "user-homedir-pathname" "use-value" "values" "values-list" "vector"
+ "vectorp" "vector-pop" "vector-push" "vector-push-extend" "wild-pathname-p"
+ "write" "write-byte" "write-char" "write-line" "write-sequence"
+ "write-string" "write-to-string" "yes-or-no-p" "y-or-n-p" "zerop"))
+
+(defvar cl-font-lock-built-in--variables
+ '("//" "///" "\\*load-pathname\\*" "\\*print-pprint-dispatch\\*"
+ "\\*break-on-signals\\*" "\\*load-print\\*" "\\*print-pprint-dispatch\\*"
+ "\\*break-on-signals\\*" "\\*load-truename\\*" "\\*print-pretty\\*"
+ "\\*load-verbose\\*" "\\*print-radix\\*" "\\*compile-file-pathname\\*"
+ "\\*macroexpand-hook\\*" "\\*print-readably\\*"
+ "\\*compile-file-pathname\\*" "\\*modules\\*" "\\*print-right-margin\\*"
+ "\\*compile-file-truename\\*" "\\*package\\*" "\\*print-right-margin\\*"
+ "\\*compile-file-truename\\*" "\\*print-array\\*" "\\*query-io\\*"
+ "\\*compile-print\\*" "\\*print-base\\*" "\\*random-state\\*"
+ "\\*compile-verbose\\*" "\\*default-pathname-defaults\\*"
+ "\\*print-length\\*" "\\*readtable\\*" "\\*error-output\\*"
+ "\\*print-level\\*" "\\*standard-input\\*" "\\*print-case\\*"
+ "\\*read-base\\*" "\\*compile-verbose\\*" "\\*print-circle\\*"
+ "\\*print-lines\\*" "\\*standard-output\\*" "\\*features\\*"
+ "\\*print-miser-width\\*" "\\*read-default-float-format\\*"
+ "\\*debug-io\\*" "\\*print-escape\\*" "\\*read-eval\\*"
+ "\\*debugger-hook\\*" "\\*print-gensym\\*" "\\*read-suppress\\*"
+ "\\*terminal-io\\*" "\\*gensym-counter\\*" "\\*print-miser-width\\*"
+ "\\*trace-output\\*" "array-dimension-limit" "array-rank-limit"
+ "array-total-size-limit" "boole-1" "boole-2" "boole-and" "boole-andc1"
+ "boole-andc2" "boole-c1" "boole-c2" "boole-clr" "boole-eqv" "boole-ior"
+ "boole-nand" "boole-nor" "boole-orc1" "boole-orc2" "boole-set" "boole-xor"
+ "call-arguments-limit" "char-code-limit" "double-float-epsilon"
+ "double-float-negative-epsilon" "internal-time-units-per-second"
+ "lambda-list-keywords" "lambda-parameters-limit"
+ "least-negative-double-float" "least-negative-long-float"
+ "least-negative-normalized-double-float"
+ "least-negative-normalized-long-float"
+ "least-negative-normalized-short-float"
+ "least-negative-normalized-single-float" "least-negative-short-float"
+ "least-negative-single-float" "least-positive-double-float"
+ "least-positive-long-float" "least-positive-normalized-double-float"
+ "least-positive-normalized-long-float"
+ "least-positive-normalized-short-float"
+ "least-positive-normalized-single-float" "least-positive-short-float"
+ "least-positive-single-float" "long-float-epsilon"
+ "long-float-negative-epsilon" "most-negative-double-float"
+ "most-negative-fixnum" "most-negative-long-float"
+ "most-negative-short-float" "most-negative-single-float"
+ "most-positive-double-float" "most-positive-fixnum"
+ "most-positive-long-float" "most-positive-short-float"
+ "most-positive-single-float" "multiple-values-limit" "short-float-epsilon"
+ "short-float-negative-epsilon" "single-float-epsilon"
+ "single-float-negative-epsilon" "pi"))
+
+(defvar cl-font-lock-built-in--types
+ '("arithmetic-error" "array" "base-char" "base-string" "bignum" "bit-vector"
+ "boolean" "broadcast-stream" "built-in-class" "cell-error" "class"
+ "compiled-function" "concatenated-stream" "condition" "control-error"
+ "division-by-zero" "double-float" "echo-stream" "end-of-file"
+ "extended-char" "file-error" "file-stream" "fixnum"
+ "floating-point-inexact" "floating-point-invalid-operation"
+ "floating-point-overflow" "floating-point-underflow" "generic-function"
+ "hash-table" "integer" "keyword" "long-float" "method" "method-combination"
+ "number" "package" "package-error" "parse-error" "print-not-readable"
+ "program-error" "random-state" "ratio" "reader-error" "readtable" "real"
+ "restart" "sequence" "serious-condition" "short-float" "signed-byte"
+ "simple-array" "simple-base-string" "simple-bit-vector" "simple-condition"
+ "simple-error" "simple-string" "simple-type-error" "simple-vector"
+ "simple-warning" "single-float" "standard-char" "standard-class"
+ "standard-generic-function" "standard-method" "standard-object"
+ "storage-condition" "stream" "stream-error" "string-stream"
+ "structure-class" "structure-object" "style-warning" "symbol"
+ "synonym-stream" "two-way-stream" "type-error" "unbound-slot"
+ "unbound-variable" "undefined-function" "unsigned-byte" "warning"))
+
+(defvar cl-font-lock-built-in--symbols
+ '("compilation-speed" "compiler-macro" "debug" "declaration" "dynamic-extent"
+ "ftype" "ignorable" "ignore" "inline" "notinline" "optimize" "otherwise"
+ "safety" "satisfies" "space" "special" "speed" "structure" "type"))
+
+(defvar cl-font-lock--character-names
+ '("newline" "space" "rubout" "page" "tab" "backspace" "return" "linefeed"))
+
+(defvar cl-font-lock-built-in-keywords
+ (mapcar (lambda (s)
+ `(,(regexp-opt (symbol-value (car s)) 'symbols)
+ . ,(cdr s)))
+ '((cl-font-lock-built-in--functions . font-lock-function-name-face)
+ (cl-font-lock-built-in--variables . font-lock-variable-name-face)
+ (cl-font-lock-built-in--types . font-lock-type-face)
+ (cl-font-lock-built-in--symbols . font-lock-builtin-face)
+ (cl-font-lock--character-names . font-lock-variable-name-face))))
+
+;;;###autoload
+(define-minor-mode cl-font-lock-built-in-mode
+ "Highlight built-in functions, variables, and types in `lisp-mode'."
+ :global t
+ :group 'tools
+ (funcall
+ (if cl-font-lock-built-in-mode
+ #'font-lock-add-keywords
+ #'font-lock-remove-keywords)
+ 'lisp-mode
+ cl-font-lock-built-in-keywords))
+
+(provide 'cl-font-lock)
+
+;;; cl-font-lock.el ends here
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 455f181f501..4fe13770b5a 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -33,6 +33,7 @@
(eval-when-compile (require 'cl-lib))
(require 'tool-bar)
(require 'comint)
+(require 'text-property-search)
(defgroup compilation nil
"Run compiler as inferior of Emacs, parse error messages."
@@ -64,7 +65,8 @@ If nil, use Emacs default."
If the replacement is nil, the file will not be considered an
error after all. If not nil, it should be a regexp replacement
string."
- :type '(repeat (list regexp string))
+ :type '(repeat (list regexp (choice (const :tag "No replacement" nil)
+ string)))
:version "27.1")
(defvar compilation-filter-hook nil
@@ -221,9 +223,9 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
;; considered before EDG.
;; The message may be a "warning", "error", or "fatal error" with
;; an error code, or "see declaration of" without an error code.
- "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^ :(\t\n][^:(\t\n]*\\)(\\([0-9]+\\)) ?\
+ "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^ :(\t\n][^:(\t\n]*\\)(\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?) ?\
: \\(?:see declaration\\|\\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:\\)"
- 2 3 nil (4))
+ 2 3 4 (5))
(edg-1
"^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)"
@@ -265,6 +267,20 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
(java
"^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1))
+ (javac
+ ,(concat
+ ;; line1
+ "^\\(\\(?:[A-Za-z]:\\)?[^:\n]+\\):" ;file
+ "\\([0-9]+\\): " ;line
+ "\\(warning: \\)?.*\n" ;type (optional) and message
+ ;; line2: source line containing error
+ ".*\n"
+ ;; line3: single "^" under error position in line2
+ " *\\^$")
+ 1 2
+ ,(lambda () (1- (current-column)))
+ (3))
+
(jikes-file
"^\\(?:Found\\|Issued\\) .* compiling \"\\(.+\\)\":$" 1 nil nil 0)
@@ -302,8 +318,8 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
(gcc-include
"^\\(?:In file included \\| \\|\t\\)from \
\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\
-\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\(?:\\(:\\)\\|\\(,\\|$\\)\\)?"
- 1 2 3 (4 . 5))
+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\(?:\\([:,]\\|$\\)\\)?"
+ 1 2 3 (nil . 4))
(ruby-Test::Unit
"^ [[ ]?\\([^ (].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2)
@@ -435,6 +451,9 @@ during global destruction\\.$\\)" 1 2)
\\([0-9]+\\) of file://\\(.+\\)"
4 2 3 (1))
+ (shellcheck
+ "^In \\(.+\\) line \\([0-9]+\\):" 1 2)
+
(sparc-pascal-file
"^\\w\\w\\w \\w\\w\\w +[0-3]?[0-9] +[0-2][0-9]:[0-5][0-9]:[0-5][0-9]\
[12][09][0-9][0-9] +\\(.*\\):$"
@@ -646,6 +665,16 @@ matched file names, and weeding out false positives."
:link `(file-link :tag "example file"
,(expand-file-name "compilation.txt" data-directory)))
+(defvar compilation-error-case-fold-search nil
+ "If non-nil, use case-insensitive matching of compilation errors
+by the regexps of `compilation-error-regexp-alist' and
+`compilation-error-regexp-alist-alist'.
+If nil, matching is case-sensitive.
+
+This variable should only be set for backward compatibility as a temporary
+measure. The proper solution is to use a regexp that matches the
+messages without case-folding.")
+
;;;###autoload(put 'compilation-directory 'safe-local-variable 'stringp)
(defvar compilation-directory nil
"Directory to restore to when doing `recompile'.")
@@ -1124,12 +1153,13 @@ POS and RES.")
(setcdr l1 (cons (list ,key) l2)))))))
(defun compilation-auto-jump (buffer pos)
- (with-current-buffer buffer
- (goto-char pos)
- (let ((win (get-buffer-window buffer 0)))
- (if win (set-window-point win pos)))
- (if compilation-auto-jump-to-first-error
- (compile-goto-error))))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (goto-char pos)
+ (let ((win (get-buffer-window buffer 0)))
+ (if win (set-window-point win pos)))
+ (if compilation-auto-jump-to-first-error
+ (compile-goto-error)))))
;; This function is the central driver, called when font-locking to gather
;; all information needed to later jump to corresponding source code.
@@ -1435,7 +1465,8 @@ to `compilation-error-regexp-alist' if RULES is nil."
(if (symbolp item)
(setq item (cdr (assq item
compilation-error-regexp-alist-alist))))
- (let ((file (nth 1 item))
+ (let ((case-fold-search compilation-error-case-fold-search)
+ (file (nth 1 item))
(line (nth 2 item))
(col (nth 3 item))
(type (nth 4 item))
@@ -1455,9 +1486,15 @@ to `compilation-error-regexp-alist' if RULES is nil."
nil) ;; Not anchored or anchored but already allows empty spaces.
(t (setq pat (concat "^\\(?: \\)?" (substring pat 1)))))
- (if (consp file) (setq fmt (cdr file) file (car file)))
- (if (consp line) (setq end-line (cdr line) line (car line)))
- (if (consp col) (setq end-col (cdr col) col (car col)))
+ (if (and (consp file) (not (functionp file)))
+ (setq fmt (cdr file)
+ file (car file)))
+ (if (and (consp line) (not (functionp line)))
+ (setq end-line (cdr line)
+ line (car line)))
+ (if (and (consp col) (not (functionp col)))
+ (setq end-col (cdr col)
+ col (car col)))
(unless (or (null (nth 5 item)) (integerp (nth 5 item)))
(error "HYPERLINK should be an integer: %s" (nth 5 item)))
@@ -1537,7 +1574,14 @@ to `compilation-error-regexp-alist' if RULES is nil."
;; grep.el) don't need to flush-parse when they modify the buffer
;; in a way that impacts buffer positions but does not require
;; re-parsing.
- (setq compilation--parsed (point-min-marker)))
+ (setq compilation--parsed
+ (set-marker (make-marker)
+ (save-excursion
+ (goto-char (point-min))
+ (text-property-search-forward 'compilation-header-end)
+ ;; If we have no end marker, this will be
+ ;; `point-min' still.
+ (point)))))
(when (< compilation--parsed limit)
(let ((start (max compilation--parsed (point-min))))
(move-marker compilation--parsed limit)
@@ -1782,6 +1826,9 @@ Returns the compilation buffer created."
mode-name
(substring (current-time-string) 0 19))
command "\n")
+ ;; Mark the end of the header so that we don't interpret
+ ;; anything in it as an error.
+ (put-text-property (1- (point)) (point) 'compilation-header-end t)
(setq thisdir default-directory))
(set-buffer-modified-p nil))
;; Pop up the compilation buffer.
@@ -2033,6 +2080,8 @@ Returns the compilation buffer created."
(define-key map "\M-p" 'compilation-previous-error)
(define-key map "\M-{" 'compilation-previous-file)
(define-key map "\M-}" 'compilation-next-file)
+ (define-key map "n" 'next-error-no-select)
+ (define-key map "p" 'previous-error-no-select)
(define-key map "\t" 'compilation-next-error)
(define-key map [backtab] 'compilation-previous-error)
(define-key map "g" 'recompile) ; revert
@@ -2056,8 +2105,7 @@ Returns the compilation buffer created."
'(menu-item "Compile..." compile
:help "Compile the program including the current buffer. Default: run `make'"))
map)
- "Keymap for compilation log buffers.
-`compilation-minor-mode-map' is a parent of this.")
+ "Keymap for compilation log buffers.")
(defvar compilation-mode-tool-bar-map
;; When bootstrapping, tool-bar-map is not properly initialized yet,
@@ -2342,12 +2390,10 @@ and runs `compilation-filter-hook'."
(set-marker min nil)
(set-marker max nil))))))
-;;; test if a buffer is a compilation buffer, assuming we're in the buffer
(defsubst compilation-buffer-internal-p ()
"Test if inside a compilation buffer."
(local-variable-p 'compilation-locs))
-;;; test if a buffer is a compilation buffer, using compilation-buffer-internal-p
(defsubst compilation-buffer-p (buffer)
"Test if BUFFER is a compilation buffer."
(with-current-buffer buffer
@@ -2388,12 +2434,9 @@ and runs `compilation-filter-hook'."
&optional object limit)
(let (parsed res)
(while (progn
- ;; We parse the buffer here "on-demand" by chunks of 500 chars.
- ;; But we could also just parse the whole buffer.
(compilation--ensure-parse
(setq parsed (max compilation--parsed
- (min (+ position 500)
- (or limit (point-max))))))
+ (or limit (point-max)))))
(and (or (not (setq res (next-single-property-change
position prop object limit)))
(eq res limit))
@@ -2884,11 +2927,8 @@ attempts to find a file whose name is produced by (format FMT FILENAME)."
(and w (progn (compilation-set-window w marker)
(compilation-set-overlay-arrow w))))
(let* ((name (read-file-name
- (format "Find this %s in%s: "
- compilation-error
- (if filename
- (format " (default %s)" filename)
- ""))
+ (format-prompt "Find this %s in"
+ filename compilation-error)
spec-dir filename t nil
;; The predicate below is fine when called from
;; minibuffer-complete-and-exit, but it's too
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 5fee2df5863..2e4b9d4693c 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -7,6 +7,7 @@
;; Jonathan Rockway <jon@jrock.us>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages, Perl
+;; Package-Requires: ((emacs "26.1"))
;; This file is part of GNU Emacs.
@@ -32,7 +33,7 @@
;; support.
;; The latest version is available from
-;; http://github.com/jrockway/cperl-mode
+;; https://github.com/jrockway/cperl-mode
;;
;; (perhaps in the moosex-declare branch)
@@ -75,6 +76,26 @@
;;; Code:
+;;; Compatibility with older versions (for publishing on ELPA)
+;; The following helpers allow cperl-mode.el to work with older
+;; versions of Emacs.
+;;
+;; Whenever the minimum version is bumped (see "Package-Requires"
+;; above), please eliminate the corresponding compatibility-helpers.
+;; Whenever you create a new compatibility-helper, please add it here.
+
+;; Available in Emacs 27.1: time-convert
+(defalias 'cperl--time-convert
+ (if (fboundp 'time-convert) 'time-convert
+ 'encode-time))
+
+;; Available in Emacs 28: format-prompt
+(defalias 'cperl--format-prompt
+ (if (fboundp 'format-prompt) 'format-prompt
+ (lambda (msg default)
+ (if default (format "%s (default %s): " msg default)
+ (concat msg ": ")))))
+
(eval-when-compile (require 'cl-lib))
(defvar msb-menu-cond)
@@ -82,13 +103,6 @@
(defvar vc-rcs-header)
(defvar vc-sccs-header)
-(defmacro cperl-force-face (arg descr) ; Takes unquoted arg
- `(progn
- (or (facep (quote ,arg))
- (make-face ,arg))
- (or (boundp (quote ,arg)) ; We use unquoted variants too
- (defvar ,arg (quote ,arg) ,descr))))
-
(defun cperl-choose-color (&rest list)
(let (answer)
(while list
@@ -451,8 +465,7 @@ Older version of this page was called `perl5', newer `perl'."
:type 'string
:group 'cperl-help-system)
-(defcustom cperl-use-syntax-table-text-property
- (boundp 'parse-sexp-lookup-properties)
+(defcustom cperl-use-syntax-table-text-property t
"Non-nil means CPerl sets up and uses `syntax-table' text property."
:type 'boolean
:group 'cperl-speed)
@@ -535,8 +548,7 @@ One should tune up `cperl-close-paren-offset' as well."
:type 'boolean
:group 'cperl-indentation-details)
-(defcustom cperl-syntaxify-by-font-lock
- (boundp 'parse-sexp-lookup-properties)
+(defcustom cperl-syntaxify-by-font-lock t
"Non-nil means that CPerl uses the `font-lock' routines for syntaxification."
:type '(choice (const message) boolean)
:group 'cperl-speed)
@@ -665,10 +677,6 @@ micro-docs on what I know about CPerl problems.")
(defvar cperl-problems 'please-ignore-this-line
"Description of problems in CPerl mode.
-Some faces will not be shown on some versions of Emacs unless you
-install choose-color.el, available from
- http://ilyaz.org/software/emacs
-
`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).
@@ -816,7 +824,7 @@ capable syntax engines).
(defvar cperl-speed 'please-ignore-this-line
"This is an incomplete compendium of what is available in other parts
-of CPerl documentation. (Please inform me if I skept anything.)
+of CPerl documentation. (Please inform me if I skipped anything.)
There is a perception that CPerl is slower than alternatives. This part
of documentation is designed to overcome this misconception.
@@ -1081,10 +1089,6 @@ versions of Emacs."
(define-key map [(control ?c) (control ?h) ?v]
;;(concat (char-to-string help-char) "v") ; does not work
'cperl-get-help))
- (or (boundp 'fill-paragraph-function)
- (substitute-key-definition
- 'fill-paragraph 'cperl-fill-paragraph
- map global-map))
(substitute-key-definition
'indent-sexp 'cperl-indent-exp
map global-map)
@@ -1240,6 +1244,7 @@ versions of Emacs."
["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]
@@ -1306,7 +1311,7 @@ the last)."
cperl-maybe-white-and-comment-rex ; whitespace-comments
"\\(\\sw\\|_\\)+" ; attr-name
;; attr-arg (1 level of internal parens allowed!)
- "\\((\\(\\\\.\\|[^\\\\()]\\|([^\\\\()]*)\\)*)\\)?"
+ "\\((\\(\\\\.\\|[^\\()]\\|([^\\()]*)\\)*)\\)?"
"\\(" ; optional : (XXX allows trailing???)
cperl-maybe-white-and-comment-rex ; whitespace-comments
":\\)?"
@@ -1406,7 +1411,7 @@ the last)."
(defvar cperl-font-locking nil)
;; NB as it stands the code in cperl-mode assumes this only has one
-;; element. If XEmacs 19 support were dropped, this could all be simplified.
+;; element. Since XEmacs 19 support has been dropped, this could all be simplified.
(defvar cperl-compilation-error-regexp-alist
;; This look like a paranoiac regexp: could anybody find a better one? (which WORKS).
'(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]"
@@ -1559,12 +1564,12 @@ Variables controlling indentation style:
`cperl-min-label-indent'
Minimal indentation for line that is a label.
-Settings for classic indent-styles: K&R BSD=C++ GNU PerlStyle=Whitesmith
- `cperl-indent-level' 5 4 2 4
- `cperl-brace-offset' 0 0 0 0
- `cperl-continued-brace-offset' -5 -4 0 0
- `cperl-label-offset' -5 -4 -2 -4
- `cperl-continued-statement-offset' 5 4 2 4
+Settings for classic indent-styles: K&R BSD=C++ GNU PBP PerlStyle=Whitesmith
+ `cperl-indent-level' 5 4 2 4 4
+ `cperl-brace-offset' 0 0 0 0 0
+ `cperl-continued-brace-offset' -5 -4 0 0 0
+ `cperl-label-offset' -5 -4 -2 -2 -4
+ `cperl-continued-statement-offset' 5 4 2 4 4
CPerl knows several indentation styles, and may bulk set the
corresponding variables. Use \\[cperl-set-style] to do this. Use
@@ -1637,9 +1642,8 @@ or as help on variables `cperl-tips', `cperl-problems',
"\\)"
cperl-maybe-white-and-comment-rex))
(set (make-local-variable 'comment-indent-function) #'cperl-comment-indent)
- (and (boundp 'fill-paragraph-function)
- (set (make-local-variable 'fill-paragraph-function)
- #'cperl-fill-paragraph))
+ (set (make-local-variable 'fill-paragraph-function)
+ #'cperl-fill-paragraph)
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'indent-region-function) #'cperl-indent-region)
;;(setq auto-fill-function #'cperl-do-auto-fill) ; Need to switch on and off!
@@ -1701,13 +1705,8 @@ or as help on variables `cperl-tips', `cperl-problems',
;; to make font-lock think that font-lock-syntactic-keywords
;; are defined.
'(t)))))
- (if (boundp 'font-lock-multiline) ; Newer font-lock; use its facilities
- (progn
- (setq cperl-font-lock-multiline t) ; Not localized...
- (set (make-local-variable 'font-lock-multiline) t))
- (set (make-local-variable 'font-lock-fontify-region-function)
- ;; not present with old Emacs
- #'cperl-font-lock-fontify-region-function))
+ (setq cperl-font-lock-multiline t) ; Not localized...
+ (set (make-local-variable 'font-lock-multiline) t)
(set (make-local-variable 'font-lock-fontify-region-function)
#'cperl-font-lock-fontify-region-function)
(make-local-variable 'cperl-old-style)
@@ -1726,10 +1725,9 @@ or as help on variables `cperl-tips', `cperl-problems',
(if cperl-hook-after-change
(add-hook 'after-change-functions #'cperl-after-change-function nil t))
;; After hooks since fontification will break this
- (if cperl-pod-here-scan
- (or cperl-syntaxify-by-font-lock
- (progn (or cperl-faces-init (cperl-init-faces-weak))
- (cperl-find-pods-heres))))
+ (when (and cperl-pod-here-scan
+ (not cperl-syntaxify-by-font-lock))
+ (cperl-find-pods-heres))
;; Setup Flymake
(add-hook 'flymake-diagnostic-functions #'perl-flymake nil t))
@@ -3253,8 +3251,8 @@ Return the error message (if any). Does not work if delimiter is `)'.
Works before syntax recognition is done."
;; Works *before* syntax recognition is done
(or st-l (setq st-l (list nil))) ; Avoid overwriting '()
- (let (st b reset-st)
- (condition-case b
+ (let (st result reset-st)
+ (condition-case err
(progn
(setq st (cperl-cached-syntax-table st-l))
(modify-syntax-entry ?\( "()" st)
@@ -3262,8 +3260,7 @@ Works before syntax recognition is done."
(setq reset-st (syntax-table))
(set-syntax-table st)
(forward-sexp 1))
- (error (message
- "cperl-forward-group-in-re: error %s" b)))
+ (error (setq result err)))
;; now restore the initial state
(if st
(progn
@@ -3271,12 +3268,9 @@ Works before syntax recognition is done."
(modify-syntax-entry ?\) "." st)))
(if reset-st
(set-syntax-table reset-st))
- b))
+ result))
-(defvar font-lock-string-face)
-;;(defvar font-lock-reference-face)
-(defvar font-lock-constant-face)
(defsubst cperl-postpone-fontification (b e type val &optional now)
;; Do after syntactic fontification?
(if cperl-syntaxify-by-font-lock
@@ -3342,16 +3336,6 @@ Works before syntax recognition is done."
(setq end (point)))))
(or end pos)))))
-;; These are needed for byte-compile (at least with v19)
-(defvar cperl-nonoverridable-face)
-(defvar font-lock-variable-name-face)
-(defvar font-lock-function-name-face)
-(defvar font-lock-keyword-face)
-(defvar font-lock-builtin-face)
-(defvar font-lock-type-face)
-(defvar font-lock-comment-face)
-(defvar font-lock-warning-face)
-
(defun cperl-find-sub-attrs (&optional st-l b-fname e-fname pos)
"Syntactically mark (and fontify) attributes of a subroutine.
Should be called with the point before leading colon of an attribute."
@@ -3560,19 +3544,18 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
"\\(\\`\n?\\|^\n\\)=" ; POD
"\\|"
;; One extra () before this:
- "<<~?" ; HERE-DOC
- "\\(" ; 1 + 1
+ "<<\\(~?\\)" ; HERE-DOC, indented-p = capture 2
+ "\\(" ; 2 + 1
;; First variant "BLAH" or just ``.
"[ \t]*" ; Yes, whitespace is allowed!
- "\\([\"'`]\\)" ; 2 + 1 = 3
- "\\([^\"'`\n]*\\)" ; 3 + 1
- "\\3"
+ "\\([\"'`]\\)" ; 3 + 1 = 4
+ "\\([^\"'`\n]*\\)" ; 4 + 1
+ "\\4"
"\\|"
;; Second variant: Identifier or \ID (same as 'ID') or empty
- "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1
+ "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 5 + 1, 6 + 1
;; Do not have <<= or << 30 or <<30 or << $blah.
;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
- "\\(\\)" ; To preserve count of pars :-( 6 + 1
"\\)"
"\\|"
;; 1+6 extra () before this:
@@ -3762,11 +3745,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
;; ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
;; "\\(\\)" ; To preserve count of pars :-( 6 + 1
;; "\\)"
- ((match-beginning 2) ; 1 + 1
+ ((match-beginning 3) ; 2 + 1
(setq b (point)
tb (match-beginning 0)
c (and ; not HERE-DOC
- (match-beginning 5)
+ (match-beginning 6)
(save-match-data
(or (looking-at "[ \t]*(") ; << function_call()
(save-excursion ; 1 << func_name, or $foo << 10
@@ -3793,17 +3776,17 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(looking-at "\\(printf?\\|say\\|system\\|exec\\|sort\\)\\>")))
(error t)))))))
(error nil))) ; func(<<EOF)
- (and (not (match-beginning 6)) ; Empty
+ (and (not (match-beginning 7)) ; Empty
(looking-at
"[ \t]*[=0-9$@%&(]"))))))
(if c ; Not here-doc
nil ; Skip it.
- (setq c (match-end 2)) ; 1 + 1
- (if (match-beginning 5) ;4 + 1
- (setq b1 (match-beginning 5) ; 4 + 1
- e1 (match-end 5)) ; 4 + 1
- (setq b1 (match-beginning 4) ; 3 + 1
- e1 (match-end 4))) ; 3 + 1
+ (setq c (match-end 3)) ; 2 + 1
+ (if (match-beginning 6) ;6 + 1
+ (setq b1 (match-beginning 6) ; 5 + 1
+ e1 (match-end 6)) ; 5 + 1
+ (setq b1 (match-beginning 5) ; 4 + 1
+ e1 (match-end 5))) ; 4 + 1
(setq tag (buffer-substring b1 e1)
qtag (regexp-quote tag))
(cond (cperl-pod-here-fontify
@@ -3818,8 +3801,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(setq b (point))
;; We do not search to max, since we may be called from
;; some hook of fontification, and max is random
- (or (and (re-search-forward (concat "^[ \t]*" qtag "$")
- stop-point 'toend)
+ (or (and (re-search-forward
+ (concat "^" (when (equal (match-string 2) "~") "[ \t]*")
+ qtag "$")
+ stop-point 'toend)
;;;(eq (following-char) ?\n) ; XXXX WHY???
)
(progn ; Pretend we matched at the end
@@ -3978,6 +3963,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(and (eq (preceding-char) ?.)
(eq (char-after (- (point) 2)) ?.))
(bobp))
+ ;; { $a++ / $b } doesn't start a regex, nor does $a--
+ (not (and (memq (preceding-char) '(?+ ?-))
+ (eq (preceding-char) (char-before (1- (point))))))
;; m|blah| ? foo : bar;
(not
(and (eq c ?\?)
@@ -4494,7 +4482,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
'syntax-table cperl-st-cfence))))
(setq was-subgr nil))
(t ; (?#)-comment
- ;; Inside "(" and "\" arn't special in any way
+ ;; Inside "(" and "\" aren't special in any way
;; Works also if the outside delimiters are ().
(or;;(if (eq (char-after b) ?\) )
;;(re-search-forward
@@ -4828,9 +4816,10 @@ conditional/loop constructs."
(while (< (point) tmp-end)
(parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol
(or (eolp) (forward-sexp 1)))
- (if (> (point) tmp-end) ; Yes, there an unfinished block
+ (if (> (point) tmp-end) ; Check for an unfinished block
nil
(if (eq ?\) (preceding-char))
+ ;; closing parens can be preceded by up to three sexps
(progn ;; Plan B: find by REGEXP block followup this line
(setq top (point))
(condition-case nil
@@ -4851,7 +4840,9 @@ conditional/loop constructs."
(progn
(goto-char top)
(forward-sexp 1)
- (setq top (point)))))
+ (setq top (point)))
+ ;; no block to be processed: expression ends here
+ (setq done t)))
(error (setq done t)))
(goto-char top))
(if (looking-at ; Try Plan C: continuation block
@@ -4884,7 +4875,7 @@ Returns some position at the last line."
;; }? continue
;; blah; }
(if (not
- (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|until\\)")
+ (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|unless\\|until\\)\\_>")
(setq have-brace (save-excursion (search-forward "}" ee t)))))
nil ; Do not need to do anything
;; Looking at:
@@ -4892,7 +4883,7 @@ Returns some position at the last line."
;; else
(if cperl-merge-trailing-else
(if (looking-at
- "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>")
+ "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\_>")
(progn
(search-forward "}")
(setq p (point))
@@ -4900,7 +4891,7 @@ Returns some position at the last line."
(delete-region p (point))
(insert (make-string cperl-indent-region-fix-constructs ?\s))
(beginning-of-line)))
- (if (looking-at "[ \t]*}[ \t]*\\(els\\(e\\|if\\)\\|continue\\)\\>")
+ (if (looking-at "[ \t]*}[ \t]*\\(els\\(e\\|if\\)\\|continue\\)\\_>")
(save-excursion
(search-forward "}")
(delete-horizontal-space)
@@ -4912,7 +4903,7 @@ Returns some position at the last line."
(setq ret (point)))))))
;; Looking at:
;; } else
- (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>")
+ (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\_>")
(progn
(search-forward "}")
(delete-horizontal-space)
@@ -5447,8 +5438,7 @@ indentation and initial hashes. Behaves usually outside of comment."
(cond ((featurep 'ps-print)
(or cperl-faces-init
(progn
- (and (boundp 'font-lock-multiline)
- (setq cperl-font-lock-multiline t))
+ (setq cperl-font-lock-multiline t)
(cperl-init-faces))))
((not cperl-faces-init)
(add-hook 'font-lock-mode-hook
@@ -5480,27 +5470,12 @@ indentation and initial hashes. Behaves usually outside of comment."
(or cperl-faces-init (cperl-init-faces))
cperl-font-lock-keywords-2)
-(defun cperl-init-faces-weak ()
- ;; Allow `cperl-find-pods-heres' to run.
- (or (boundp 'font-lock-constant-face)
- (cperl-force-face font-lock-constant-face
- "Face for constant and label names"))
- (or (boundp 'font-lock-warning-face)
- (cperl-force-face font-lock-warning-face
- "Face for things which should stand out"))
- ;;(setq font-lock-constant-face 'font-lock-constant-face)
- )
-
(defun cperl-init-faces ()
(condition-case errs
(progn
(require 'font-lock)
- (and (fboundp 'font-lock-fontify-anchored-keywords)
- (featurep 'font-lock-extra)
- (message "You have an obsolete package `font-lock-extra'. Install `choose-color'."))
(let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored)
- (if (fboundp 'font-lock-fontify-anchored-keywords)
- (setq font-lock-anchored t))
+ (setq font-lock-anchored t)
(setq
t-font-lock-keywords
(list
@@ -5622,7 +5597,7 @@ indentation and initial hashes. Behaves usually outside of comment."
"wh\\(en\\|ile\\)\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
"\\|[sm]" ; Added manually
"\\)\\>")
- 2 'cperl-nonoverridable-face)
+ 2 ''cperl-nonoverridable-face) ; unbound as var, so: doubly quoted
;; (mapconcat #'identity
;; '("#endif" "#else" "#ifdef" "#ifndef" "#if"
;; "#include" "#define" "#undef")
@@ -5658,17 +5633,13 @@ indentation and initial hashes. Behaves usually outside of comment."
2 font-lock-function-name-face)
'("^[ \t]*format[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t]*=[ \t]*$"
1 font-lock-function-name-face)
- (cond ((featurep 'font-lock-extra)
- '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
- (2 font-lock-string-face t)
- (0 '(restart 2 t)))) ; To highlight $a{bc}{ef}
- (font-lock-anchored
- '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
+ (cond (font-lock-anchored
+ '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
(2 font-lock-string-face t)
("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
nil nil
(1 font-lock-string-face t))))
- (t '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
+ (t '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
2 font-lock-string-face t)))
'("[[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1
font-lock-string-face t)
@@ -5680,15 +5651,7 @@ indentation and initial hashes. Behaves usually outside of comment."
;;; '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face)
;;; '("\\([@%]\\|\\$#\\)\\(\\sw+\\)"
;;; (2 (cons font-lock-variable-name-face '(underline))))
- (cond ((featurep 'font-lock-extra)
- '("^[ \t]*\\(state\\|my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
- (3 font-lock-variable-name-face)
- (4 '(another 4 nil
- ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
- (1 font-lock-variable-name-face)
- (2 '(restart 2 nil) nil t)))
- nil t))) ; local variables, multiple
- (font-lock-anchored
+ (cond (font-lock-anchored
;; 1=my_etc, 2=white? 3=(+white? 4=white? 5=var
`(,(concat "\\<\\(state\\|my\\|local\\|our\\)"
cperl-maybe-white-and-comment-rex
@@ -5752,7 +5715,7 @@ indentation and initial hashes. Behaves usually outside of comment."
(if (eq (char-after (match-beginning 2)) ?%)
'cperl-hash-face
'cperl-array-face)
- t) ; arrays and hashes
+ nil) ; arrays and hashes
("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
1
(if (= (- (match-end 2) (match-beginning 2)) 1)
@@ -5787,167 +5750,9 @@ indentation and initial hashes. Behaves usually outside of comment."
t-font-lock-keywords)
cperl-font-lock-keywords cperl-font-lock-keywords-1
cperl-font-lock-keywords-2 (append
- cperl-font-lock-keywords-1
- t-font-lock-keywords-1)))
+ t-font-lock-keywords-1
+ cperl-font-lock-keywords-1)))
(if (fboundp 'ps-print-buffer) (cperl-ps-print-init))
- (if (or (featurep 'choose-color) (featurep 'font-lock-extra))
- (eval ; Avoid a warning
- '(font-lock-require-faces
- (list
- ;; Color-light Color-dark Gray-light Gray-dark Mono
- (list 'font-lock-comment-face
- ["Firebrick" "OrangeRed" "DimGray" "Gray80"]
- nil
- [nil nil t t t]
- [nil nil t t t]
- nil)
- (list 'font-lock-string-face
- ["RosyBrown" "LightSalmon" "Gray50" "LightGray"]
- nil
- nil
- [nil nil t t t]
- nil)
- (list 'font-lock-function-name-face
- (vector
- "Blue" "LightSkyBlue" "Gray50" "LightGray"
- (cdr (assq 'background-color ; if mono
- (frame-parameters))))
- (vector
- nil nil nil nil
- (cdr (assq 'foreground-color ; if mono
- (frame-parameters))))
- [nil nil t t t]
- nil
- nil)
- (list 'font-lock-variable-name-face
- ["DarkGoldenrod" "LightGoldenrod" "DimGray" "Gray90"]
- nil
- [nil nil t t t]
- [nil nil t t t]
- nil)
- (list 'font-lock-type-face
- ["DarkOliveGreen" "PaleGreen" "DimGray" "Gray80"]
- nil
- [nil nil t t t]
- nil
- [nil nil t t t])
- (list 'font-lock-warning-face
- ["Pink" "Red" "Gray50" "LightGray"]
- ["gray20" "gray90"
- "gray80" "gray20"]
- [nil nil t t t]
- nil
- [nil nil t t t]
- )
- (list 'font-lock-constant-face
- ["CadetBlue" "Aquamarine" "Gray50" "LightGray"]
- nil
- [nil nil t t t]
- nil
- [nil nil t t t])
- (list 'cperl-nonoverridable-face
- ["chartreuse3" ("orchid1" "orange")
- nil "Gray80"]
- [nil nil "gray90"]
- [nil nil nil t t]
- [nil nil t t]
- [nil nil t t t])
- (list 'cperl-array-face
- ["blue" "yellow" nil "Gray80"]
- ["lightyellow2" ("navy" "os2blue" "darkgreen")
- "gray90"]
- t
- nil
- nil)
- (list 'cperl-hash-face
- ["red" "red" nil "Gray80"]
- ["lightyellow2" ("navy" "os2blue" "darkgreen")
- "gray90"]
- t
- t
- nil))))
- ;; Do it the dull way, without choose-color
- (cperl-force-face font-lock-constant-face
- "Face for constant and label names")
- (cperl-force-face font-lock-variable-name-face
- "Face for variable names")
- (cperl-force-face font-lock-type-face
- "Face for data types")
- (cperl-force-face cperl-nonoverridable-face
- "Face for data types from another group")
- (cperl-force-face font-lock-warning-face
- "Face for things which should stand out")
- (cperl-force-face font-lock-comment-face
- "Face for comments")
- (cperl-force-face font-lock-function-name-face
- "Face for function names")
- ;;(defvar font-lock-constant-face 'font-lock-constant-face)
- ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face)
- ;;(or (boundp 'font-lock-type-face)
- ;; (defconst font-lock-type-face
- ;; 'font-lock-type-face
- ;; "Face to use for data types."))
- ;;(or (boundp 'cperl-nonoverridable-face)
- ;; (defconst cperl-nonoverridable-face
- ;; 'cperl-nonoverridable-face
- ;; "Face to use for data types from another group."))
- (if (and
- (not (facep 'cperl-array-face))
- (facep 'font-lock-emphasized-face))
- (copy-face 'font-lock-emphasized-face 'cperl-array-face))
- (if (and
- (not (facep 'cperl-hash-face))
- (facep 'font-lock-other-emphasized-face))
- (copy-face 'font-lock-other-emphasized-face 'cperl-hash-face))
- (if (and
- (not (facep 'cperl-nonoverridable-face))
- (facep 'font-lock-other-type-face))
- (copy-face 'font-lock-other-type-face 'cperl-nonoverridable-face))
- ;;(or (boundp 'cperl-hash-face)
- ;; (defconst cperl-hash-face
- ;; 'cperl-hash-face
- ;; "Face to use for hashes."))
- ;;(or (boundp 'cperl-array-face)
- ;; (defconst cperl-array-face
- ;; 'cperl-array-face
- ;; "Face to use for arrays."))
- (let ((background 'light))
- (and (not (facep 'font-lock-constant-face))
- (facep 'font-lock-reference-face)
- (copy-face 'font-lock-reference-face 'font-lock-constant-face))
- (if (facep 'font-lock-type-face) nil
- (copy-face 'default 'font-lock-type-face)
- (cond
- ((eq background 'light)
- (set-face-foreground 'font-lock-type-face
- (if (x-color-defined-p "seagreen")
- "seagreen"
- "sea green")))
- ((eq background 'dark)
- (set-face-foreground 'font-lock-type-face
- (if (x-color-defined-p "os2pink")
- "os2pink"
- "pink")))
- (t
- (set-face-background 'font-lock-type-face "gray90"))))
- (if (facep 'cperl-nonoverridable-face)
- nil
- (copy-face 'font-lock-type-face 'cperl-nonoverridable-face)
- (cond
- ((eq background 'light)
- (set-face-foreground 'cperl-nonoverridable-face
- (if (x-color-defined-p "chartreuse3")
- "chartreuse3"
- "chartreuse")))
- ((eq background 'dark)
- (set-face-foreground 'cperl-nonoverridable-face
- (if (x-color-defined-p "orchid1")
- "orchid1"
- "orange")))))
- (if (facep 'font-lock-variable-name-face) nil
- (copy-face 'italic 'font-lock-variable-name-face))
- (if (facep 'font-lock-constant-face) nil
- (copy-face 'italic 'font-lock-constant-face))))
(setq cperl-faces-init t))
(error (message "cperl-init-faces (ignored): %s" errs))))
@@ -6057,7 +5862,19 @@ if (foo) {
stop;
}
-### PerlStyle (=CPerl with 4 as indent) 4/0/0/-4/4/t/nil
+### PBP (=Perl Best Practices) 4/0/0/-4/4/nil/nil
+if (foo) {
+ bar
+ baz;
+ label:
+ {
+ boon;
+ }
+}
+else {
+ stop;
+}
+### PerlStyle (=CPerl with 4 as indent) 4/0/0/-2/4/t/nil
if (foo) {
bar
baz;
@@ -6160,6 +5977,18 @@ else
(cperl-extra-newline-before-brace-multiline . nil)
(cperl-merge-trailing-else . t))
+ ("PBP" ;; Perl Best Practices by Damian Conway
+ (cperl-indent-level . 4)
+ (cperl-brace-offset . 0)
+ (cperl-continued-brace-offset . 0)
+ (cperl-label-offset . -2)
+ (cperl-continued-statement-offset . 4)
+ (cperl-extra-newline-before-brace . nil)
+ (cperl-extra-newline-before-brace-multiline . nil)
+ (cperl-merge-trailing-else . nil)
+ (cperl-indent-parens-as-block . t)
+ (cperl-tab-always-indent . t))
+
("PerlStyle" ; CPerl with 4 as indent
(cperl-indent-level . 4)
(cperl-brace-offset . 0)
@@ -6231,7 +6060,8 @@ See examples in `cperl-style-examples'.")
"Set CPerl mode variables to use one of several different indentation styles.
The arguments are a string representing the desired style.
The list of styles is in `cperl-style-alist', available styles
-are CPerl, PerlStyle, GNU, K&R, BSD, C++ and Whitesmith.
+are \"CPerl\", \"PBP\", \"PerlStyle\", \"GNU\", \"K&R\", \"BSD\", \"C++\"
+and \"Whitesmith\".
The current value of style is memorized (unless there is a memorized
data already), may be restored by `cperl-set-style-back'.
@@ -6317,8 +6147,7 @@ Customized by setting variables `cperl-shrink-wrap-info-frame',
(interactive
(let* ((default (cperl-word-at-point))
(read (read-string
- (format "Find doc for Perl function (default %s): "
- default))))
+ (cperl--format-prompt "Find doc for Perl function" default))))
(list (if (equal read "")
default
read))))
@@ -6499,9 +6328,10 @@ If optional argument ALL is `recursive', will process Perl files
in subdirectories too."
(interactive)
(let ((cmd "etags")
- (args '("-l" "none" "-r"
+ (args `("-l" "none" "-r"
;; 1=fullname 2=package? 3=name 4=proto? 5=attrs? (VERY APPROX!)
- "/\\<" cperl-sub-regexp "[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/"
+ ,(concat
+ "/\\<" cperl-sub-regexp "[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/")
"-r"
"/\\<package[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\([#;]\\|$\\)/\\1/"
"-r"
@@ -6786,6 +6616,7 @@ Use as
(or topdir
(setq topdir default-directory))
(let ((tags-file-name "TAGS")
+ (inhibit-read-only t)
(case-fold-search nil)
xs rel)
(save-excursion
@@ -6851,7 +6682,7 @@ Use as
(insert (cperl-find-tags file xs topdir))))))
(if inbuffer nil ; Delegate to the caller
(save-buffer 0) ; No backup
- (if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs?
+ (if (fboundp 'initialize-new-tags-table)
(initialize-new-tags-table))))))
(defvar cperl-tags-hier-regexp-list
@@ -8275,10 +8106,7 @@ the appropriate statement modifier."
(interactive
(list (let* ((default-entry (cperl-word-at-point))
(input (read-string
- (format "perldoc entry%s: "
- (if (string= default-entry "")
- ""
- (format " (default %s)" default-entry))))))
+ (cperl--format-prompt "perldoc entry" default-entry))))
(if (string= input "")
(if (string= default-entry "")
(error "No perldoc args given")
@@ -8505,7 +8333,7 @@ start with default arguments, then refine the slowdown regions."
(or l (setq l 1))
(or step (setq step 500))
(or lim (setq lim 40))
- (let* ((timems (function (lambda () (car (time-convert nil 1000)))))
+ (let* ((timems (function (lambda () (car (cperl--time-convert nil 1000)))))
(tt (funcall timems)) (c 0) delta tot)
(goto-char (point-min))
(forward-line (1- l))
diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el
index dfb987bf99a..6e84f4f1bcc 100644
--- a/lisp/progmodes/cwarn.el
+++ b/lisp/progmodes/cwarn.el
@@ -4,7 +4,7 @@
;; Author: Anders Lindgren
;; Keywords: c, languages, faces
-;; Version: 1.3.1
+;; Old-Version: 1.3.1
;; This file is part of GNU Emacs.
@@ -168,6 +168,8 @@ deactivated."
:tag "Load Hook"
:group 'cwarn
:type 'hook)
+(make-obsolete-variable 'cwarn-load-hook
+ "use `with-eval-after-load' instead." "28.1")
;;}}}
;;{{{ The modes
diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el
index dc6bd44e482..be82c72910b 100644
--- a/lisp/progmodes/ebnf-abn.el
+++ b/lisp/progmodes/ebnf-abn.el
@@ -38,7 +38,7 @@
;; -----------
;;
;; See the URL:
-;; `http://www.ietf.org/rfc/rfc2234.txt'
+;; `https://www.ietf.org/rfc/rfc2234.txt'
;; or
;; `http://www.faqs.org/rfcs/rfc2234.html'
;; or
@@ -474,11 +474,10 @@
(aset ebnf-abn-token-table ?\; 'comment)))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-abn-non-terminal-chars
- (ebnf-range-regexp "-_0-9A-Za-z" ?\240 ?\377))
+ "-_0-9A-Za-z\u00a0-\u00ff")
(defconst ebnf-abn-non-terminal-letter-chars
- (ebnf-range-regexp "A-Za-z" ?\240 ?\377))
+ "A-Za-z\u00a0-\u00ff")
(defun ebnf-abn-lex ()
@@ -572,9 +571,8 @@ See documentation for variable `ebnf-abn-lex'."
(not eor-p)))
-;; replace the range "\177-\237" (see `ebnf-range-regexp').
(defconst ebnf-abn-comment-chars
- (ebnf-range-regexp "^\n\000-\010\016-\037" ?\177 ?\237))
+ "^\n\000-\010\016-\037\177\u0080-\u009f")
(defun ebnf-abn-skip-comment ()
@@ -612,9 +610,8 @@ See documentation for variable `ebnf-abn-lex'."
(ebnf-buffer-substring ebnf-abn-comment-chars))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-abn-string-chars
- (ebnf-range-regexp " -!#-~" ?\240 ?\377))
+ " !#-~\u00a0-\u00ff")
(defun ebnf-abn-string ()
diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el
index 583740d3617..4e11862c1dc 100644
--- a/lisp/progmodes/ebnf-bnf.el
+++ b/lisp/progmodes/ebnf-bnf.el
@@ -419,9 +419,8 @@
(aset ebnf-bnf-token-table ebnf-lex-eop-char 'period)))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-bnf-non-terminal-chars
- (ebnf-range-regexp "!#%&'*-,0-:<>@-Z\\\\^-z~" ?\240 ?\377))
+ "!#%&'*-,0-:<>@-Z\\\\^-z~\u00a0-\u00ff")
(defun ebnf-bnf-lex ()
@@ -520,9 +519,8 @@ See documentation for variable `ebnf-bnf-lex'."
))))
-;; replace the range "\177-\237" (see `ebnf-range-regexp').
(defconst ebnf-bnf-comment-chars
- (ebnf-range-regexp "^\n\000-\010\016-\037" ?\177 ?\237))
+ "^\n\000-\010\016-\037\177\u0080-\u009f")
(defun ebnf-bnf-skip-comment ()
diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el
index 7e824e487aa..ddddb27a11c 100644
--- a/lisp/progmodes/ebnf-dtd.el
+++ b/lisp/progmodes/ebnf-dtd.el
@@ -38,11 +38,11 @@
;; ----------
;;
;; See the URLs:
-;; `http://www.w3.org/TR/2004/REC-xml-20040204/'
+;; `https://www.w3.org/TR/2004/REC-xml-20040204/'
;; (Extensible Markup Language (XML) 1.0 (Third Edition))
-;; `http://www.w3.org/TR/html40/'
+;; `https://www.w3.org/TR/html40/'
;; (HTML 4.01 Specification)
-;; `http://www.w3.org/TR/NOTE-html-970421'
+;; `https://www.w3.org/TR/NOTE-html-970421'
;; (HTML DTD with support for Style Sheets)
;;
;;
@@ -1108,9 +1108,8 @@
(aset ebnf-dtd-token-table ?\] 'end-subset)))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-dtd-name-chars
- (ebnf-range-regexp "-._:0-9A-Za-z" ?\240 ?\377))
+ "-._:0-9A-Za-z\u00a0-\u00ff")
(defconst ebnf-dtd-decl-alist
@@ -1263,11 +1262,10 @@ See documentation for variable `ebnf-dtd-lex'."
(format "%s%s;" start char)))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-dtd-double-string-chars
- (ebnf-range-regexp "\t -!#-~" ?\240 ?\377))
+ "\t -!#-~\u00a0-\u00ff")
(defconst ebnf-dtd-single-string-chars
- (ebnf-range-regexp "\t -&(-~" ?\240 ?\377))
+ "\t -&(-~\u00a0-\u00ff")
(defun ebnf-dtd-string (delim)
@@ -1287,11 +1285,10 @@ See documentation for variable `ebnf-dtd-lex'."
(forward-char)))))
-;; replace the range "\177-\237" (see `ebnf-range-regexp').
(defconst ebnf-dtd-comment-chars
- (ebnf-range-regexp "^-\000-\010\013\014\016-\037" ?\177 ?\237))
+ "^-\000-\010\013\014\016-\037\177\u0080-\u009f")
(defconst ebnf-dtd-filename-chars
- (ebnf-range-regexp "^-\000-\037" ?\177 ?\237))
+ "^-\000-\037\177\u0080-\u009f")
(defun ebnf-dtd-skip-comment ()
diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el
index 2ae6fb67569..546f1f8a87f 100644
--- a/lisp/progmodes/ebnf-ebx.el
+++ b/lisp/progmodes/ebnf-ebx.el
@@ -38,7 +38,7 @@
;; ------------
;;
;; See the URL:
-;; `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
+;; `https://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
;; (Extensible Markup Language (XML) 1.0 (Third Edition))
;;
;;
@@ -405,11 +405,10 @@
(aset ebnf-ebx-token-table ?/ 'comment)))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-ebx-non-terminal-chars
- (ebnf-range-regexp "-_A-Za-z" ?\240 ?\377))
+ "-_A-Za-z\u00a0-\u00ff")
(defconst ebnf-ebx-non-terminal-letter-chars
- (ebnf-range-regexp "A-Za-z" ?\240 ?\377))
+ "A-Za-z\u00a0-\u00ff")
(defun ebnf-ebx-lex ()
@@ -488,9 +487,8 @@ See documentation for variable `ebnf-ebx-lex'."
))))
-;; replace the range "\177-\237" (see `ebnf-range-regexp').
(defconst ebnf-ebx-constraint-chars
- (ebnf-range-regexp "^\000-\010\016-\037]" ?\177 ?\237))
+ "^\000-\010\016-\037]\177\u0080-\u009f")
(defun ebnf-ebx-skip-constraint ()
@@ -517,11 +515,10 @@ See documentation for variable `ebnf-ebx-lex'."
(not eor-p)))
-;; replace the range "\177-\237" (see `ebnf-range-regexp').
(defconst ebnf-ebx-comment-chars
- (ebnf-range-regexp "^\000-\010\016-\037\\*" ?\177 ?\237))
+ "^\000-\010\016-\037*\177\u0080-\u009f")
(defconst ebnf-ebx-filename-chars
- (ebnf-range-regexp "^\000-\037\\*" ?\177 ?\237))
+ "^\000-\037*\177\u0080-\u009f")
(defun ebnf-ebx-skip-comment ()
@@ -581,11 +578,10 @@ See documentation for variable `ebnf-ebx-lex'."
(concat fname (make-string nchar ?*)))))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-ebx-double-string-chars
- (ebnf-range-regexp "\t -!#-~" ?\240 ?\377))
+ "\t -!#-~\u00a0-\u00ff")
(defconst ebnf-ebx-single-string-chars
- (ebnf-range-regexp "\t -&(-~" ?\240 ?\377))
+ "\t -&(-~\u00a0-\u00ff")
(defun ebnf-ebx-string (delim)
diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el
index b52094a5912..466e7785053 100644
--- a/lisp/progmodes/ebnf-iso.el
+++ b/lisp/progmodes/ebnf-iso.el
@@ -379,9 +379,8 @@
(aset ebnf-iso-token-table ?. 'character)))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-iso-non-terminal-chars
- (ebnf-range-regexp " 0-9A-Za-z_" ?\240 ?\377))
+ " 0-9A-Za-z_\u00a0-\u00ff")
(defun ebnf-iso-lex ()
@@ -487,9 +486,8 @@ See documentation for variable `ebnf-iso-lex'."
))))
-;; replace the range "\177-\237" (see `ebnf-range-regexp').
(defconst ebnf-iso-comment-chars
- (ebnf-range-regexp "^*(\000-\010\016-\037" ?\177 ?\237))
+ "^*(\000-\010\016-\037\177\u0080-\u009f")
(defun ebnf-iso-skip-comment ()
diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el
index f5d633e8460..a657c637f82 100644
--- a/lisp/progmodes/ebnf-yac.el
+++ b/lisp/progmodes/ebnf-yac.el
@@ -397,9 +397,8 @@ See documentation for variable `ebnf-yac-lex'."
(< (point) ebnf-limit))
-;; replace the range "\177-\377" (see `ebnf-range-regexp').
(defconst ebnf-yac-skip-chars
- (ebnf-range-regexp "^{}/'\"\000-\010\013\016-\037" ?\177 ?\377))
+ "^{}/'\"\000-\010\013\016-\037\177\u0080-\u009f")
(defun ebnf-yac-skip-code ()
@@ -442,9 +441,8 @@ See documentation for variable `ebnf-yac-lex'."
))
-;; replace the range "\177-\237" (see `ebnf-range-regexp').
(defconst ebnf-yac-comment-chars
- (ebnf-range-regexp "^*\000-\010\013\016-\037" ?\177 ?\237))
+ "^*\000-\010\013\016-\037\177\u0080-\u009f")
(defun ebnf-yac-skip-comment ()
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index 640cb576ef6..991cd6fc519 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -5,7 +5,7 @@
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
;; Version: 4.4
-;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
+;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
;; This file is part of GNU Emacs.
@@ -326,7 +326,7 @@ Please send all bug fixes and enhancements to
;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
;;
;; `abnf' ebnf2ps recognizes the syntax described in the URL:
-;; `http://www.ietf.org/rfc/rfc2234.txt'
+;; `https://www.ietf.org/rfc/rfc2234.txt'
;; ("Augmented BNF for Syntax Specifications: ABNF").
;;
;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
@@ -342,11 +342,11 @@ Please send all bug fixes and enhancements to
;; `ebnf-yac-ignore-error-recovery'.
;;
;; `ebnfx' ebnf2ps recognizes the syntax described in the URL:
-;; `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
+;; `https://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
;; ("Extensible Markup Language (XML) 1.0 (Third Edition)")
;;
;; `dtd' ebnf2ps recognizes the syntax described in the URL:
-;; `http://www.w3.org/TR/2004/REC-xml-20040204/'
+;; `https://www.w3.org/TR/2004/REC-xml-20040204/'
;; ("Extensible Markup Language (XML) 1.0 (Third Edition)")
;;
;; Any other value is treated as `ebnf'.
@@ -1157,21 +1157,6 @@ Please send all bug fixes and enhancements to
(and (string< ps-print-version "5.2.3")
(error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
-
-;; to avoid gripes with Emacs 20
-(or (fboundp 'assq-delete-all)
- (defun assq-delete-all (key alist)
- "Delete from ALIST all elements whose car is KEY.
-Return the modified alist.
-Elements of ALIST that are not conses are ignored."
- (let ((tail alist))
- (while tail
- (if (and (consp (car tail))
- (eq (car (car tail)) key))
- (setq alist (delq (car tail) alist)))
- (setq tail (cdr tail)))
- alist)))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User Variables:
@@ -1794,7 +1779,7 @@ Valid values are:
`ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
`abnf' ebnf2ps recognizes the syntax described in the URL:
- `http://www.ietf.org/rfc/rfc2234.txt'
+ `https://www.ietf.org/rfc/rfc2234.txt'
(\"Augmented BNF for Syntax Specifications: ABNF\").
`iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
@@ -1810,11 +1795,11 @@ Valid values are:
`ebnf-yac-ignore-error-recovery'.
`ebnfx' ebnf2ps recognizes the syntax described in the URL:
- `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
+ `https://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
(\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
`dtd' ebnf2ps recognizes the syntax described in the URL:
- `http://www.w3.org/TR/2004/REC-xml-20040204/'
+ `https://www.w3.org/TR/2004/REC-xml-20040204/'
(\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
Any other value is treated as `ebnf'."
@@ -2053,8 +2038,7 @@ It must be a float between 0.0 (top) and 1.0 (bottom)."
;; Printing color requires x-color-values.
-(defcustom ebnf-color-p (or (fboundp 'x-color-values) ; Emacs
- (fboundp 'color-instance-rgb-components)) ; XEmacs
+(defcustom ebnf-color-p t
"Non-nil means use color."
:type 'boolean
:version "20"
@@ -2738,8 +2722,7 @@ Used in functions `ebnf-reset-style', `ebnf-push-style' and
(ebnf-eps-footer-font . '(7 Helvetica "Black" "White" bold))
(ebnf-eps-footer . nil)
(ebnf-entry-percentage . 0.5)
- (ebnf-color-p . (or (fboundp 'x-color-values) ; Emacs
- (fboundp 'color-instance-rgb-components))) ; XEmacs
+ (ebnf-color-p . t)
(ebnf-line-width . 1.0)
(ebnf-line-color . "Black")
(ebnf-debug-ps . nil)
@@ -4544,7 +4527,7 @@ end
(let* ((ebnf-tree tree)
(ps-color-p (and ebnf-color-p (ps-color-device)))
(ps-print-color-scale (if ps-color-p
- (float (car (ps-color-values "white")))
+ (float (car (color-values "white")))
1.0))
(ebnf-total (length ebnf-tree))
(ebnf-nprod 0)
@@ -4646,7 +4629,7 @@ end
(let* ((ebnf-tree tree)
(ps-color-p (and ebnf-color-p (ps-color-device)))
(ps-print-color-scale (if ps-color-p
- (float (car (ps-color-values "white")))
+ (float (car (color-values "white")))
1.0))
ps-zebra-stripes ps-line-number ps-razzle-dazzle
ps-print-hook
@@ -4979,18 +4962,6 @@ killed after process termination."
(kill-buffer (current-buffer))))
-;; function `ebnf-range-regexp' is used to avoid a bug of `skip-chars-forward'
-;; on version 20.4.1, that is, it doesn't accept ranges like "\240-\377" (or
-;; "\177-\237"), but it accepts the character sequence from \240 to \377 (or
-;; from \177 to \237). It seems that version 20.7 has the same problem.
-(defun ebnf-range-regexp (prefix from to)
- (let (str)
- (while (<= from to)
- (setq str (concat str (char-to-string from))
- from (1+ from)))
- (concat prefix str)))
-
-
(defvar ebnf-map-name
(let ((map (make-vector 256 ?\_)))
(mapc #'(lambda (char)
@@ -5004,8 +4975,6 @@ killed after process termination."
(defun ebnf-eps-filename (str)
(let* ((len (length str))
(stri 0)
- ;; to keep compatibility with Emacs 20 & 21:
- ;; DO NOT REPLACE `?\ ' BY `?\s'
(new (make-string len ?\ )))
(while (< stri len)
(aset new stri (aref ebnf-map-name (aref str stri)))
@@ -5987,8 +5956,7 @@ killed after process termination."
(point))))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
-(defconst ebnf-8-bit-chars (ebnf-range-regexp "" ?\240 ?\377))
+(defconst ebnf-8-bit-chars "\u00a0-\u00ff")
(defun ebnf-string (chars eos-char kind)
@@ -6023,8 +5991,6 @@ killed after process termination."
(defun ebnf-trim-right (str)
(let* ((len (1- (length str)))
(index len))
- ;; to keep compatibility with Emacs 20 & 21:
- ;; DO NOT REPLACE `?\ ' BY `?\s'
(while (and (> index 0) (= (aref str index) ?\ ))
(setq index (1- index)))
(if (= index len)
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index c84803a3fab..ffd7d03d7a9 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -34,6 +34,7 @@
;;; Code:
(require 'cl-lib)
+(require 'seq)
(require 'easymenu)
(require 'view)
(require 'ebuff-menu)
@@ -52,32 +53,27 @@
"List of directories to search for source files in a class tree.
Elements should be directory names; nil as an element means to try
to find source files relative to the location of the BROWSE file loaded."
- :group 'ebrowse
:type '(repeat (choice (const :tag "Default" nil)
(string :tag "Directory"))))
(defcustom ebrowse-view/find-hook nil
"Hooks run after finding or viewing a member or class."
- :group 'ebrowse
:type 'hook)
(defcustom ebrowse-not-found-hook nil
"Hooks run when finding or viewing a member or class was not successful."
- :group 'ebrowse
:type 'hook)
(defcustom ebrowse-electric-list-mode-hook nil
"Hook called by `ebrowse-electric-position-mode'."
- :group 'ebrowse
:type 'hook)
(defcustom ebrowse-max-positions 50
"Number of markers saved on electric position stack."
- :group 'ebrowse
:type 'integer)
@@ -89,32 +85,27 @@ to find source files relative to the location of the BROWSE file loaded."
(defcustom ebrowse-tree-mode-hook nil
"Hook run in each new tree buffer."
- :group 'ebrowse-tree
:type 'hook)
(defcustom ebrowse-tree-buffer-name "*Tree*"
"The default name of class tree buffers."
- :group 'ebrowse-tree
:type 'string)
(defcustom ebrowse--indentation 4
"The amount by which subclasses are indented in the tree."
- :group 'ebrowse-tree
:type 'integer)
(defcustom ebrowse-source-file-column 40
"The column in which source file names are displayed in the tree."
- :group 'ebrowse-tree
:type 'integer)
(defcustom ebrowse-tree-left-margin 2
"Amount of space left at the left side of the tree display.
This space is used to display markers."
- :group 'ebrowse-tree
:type 'integer)
@@ -126,25 +117,21 @@ This space is used to display markers."
(defcustom ebrowse-default-declaration-column 25
"The column in which member declarations are displayed in member buffers."
- :group 'ebrowse-member
:type 'integer)
(defcustom ebrowse-default-column-width 25
"The width of the columns in member buffers (short display form)."
- :group 'ebrowse-member
:type 'integer)
(defcustom ebrowse-member-buffer-name "*Members*"
"The name of the buffer for member display."
- :group 'ebrowse-member
:type 'string)
(defcustom ebrowse-member-mode-hook nil
"Run in each new member buffer."
- :group 'ebrowse-member
:type 'hook)
@@ -156,81 +143,47 @@ This space is used to display markers."
(defface ebrowse-tree-mark
'((((min-colors 88)) :foreground "red1")
(t :foreground "red"))
- "Face for the mark character in the Ebrowse tree."
- :group 'ebrowse-faces)
+ "Face for the mark character in the Ebrowse tree.")
(defface ebrowse-root-class
'((((min-colors 88)) :weight bold :foreground "blue1")
(t :weight bold :foreground "blue"))
- "Face for root classes in the Ebrowse tree."
- :group 'ebrowse-faces)
+ "Face for root classes in the Ebrowse tree.")
(defface ebrowse-file-name '((t :slant italic))
- "Face for filenames in the Ebrowse tree."
- :group 'ebrowse-faces)
+ "Face for filenames in the Ebrowse tree.")
(defface ebrowse-default '((t))
- "Face for items in the Ebrowse tree which do not have other faces."
- :group 'ebrowse-faces)
+ "Face for items in the Ebrowse tree which do not have other faces.")
(defface ebrowse-member-attribute
'((((min-colors 88)) :foreground "red1")
(t :foreground "red"))
- "Face for member attributes."
- :group 'ebrowse-faces)
+ "Face for member attributes.")
(defface ebrowse-member-class
'((t :foreground "purple"))
- "Face used to display the class title in member buffers."
- :group 'ebrowse-faces)
+ "Face used to display the class title in member buffers.")
(defface ebrowse-progress
'((((min-colors 88)) :background "blue1")
(t :background "blue"))
- "Face for progress indicator."
- :group 'ebrowse-faces)
+ "Face for progress indicator.")
;;; Utilities.
-(defun ebrowse-some (predicate vector)
- "Return true if PREDICATE is true of some element of VECTOR.
-If so, return the value returned by PREDICATE."
- (let ((length (length vector))
- (i 0)
- result)
- (while (and (< i length) (not result))
- (setq result (funcall predicate (aref vector i))
- i (1+ i)))
- result))
+(define-obsolete-function-alias 'ebrowse-some #'seq-some "28.1")
-(defun ebrowse-every (predicate vector)
- "Return true if PREDICATE is true of every element of VECTOR."
- (let ((length (length vector))
- (i 0)
- (result t))
- (while (and (< i length) result)
- (setq result (funcall predicate (aref vector i))
- i (1+ i)))
- result))
+(define-obsolete-function-alias 'ebrowse-every #'seq-every-p "28.1")
(defun ebrowse-position (item list &optional test)
"Return the position of ITEM in LIST or nil if not found.
Compare items with `eq' or TEST if specified."
- (let ((i 0) found)
- (cond (test
- (while list
- (when (funcall test item (car list))
- (setq found i list nil))
- (setq list (cdr list) i (1+ i))))
- (t
- (while list
- (when (eq item (car list))
- (setq found i list nil))
- (setq list (cdr list) i (1+ i)))))
- found))
+ (declare (obsolete seq-position "28.1"))
+ (seq-position list item (or test #'eql)))
(defmacro ebrowse-ignoring-completion-case (&rest body)
@@ -242,17 +195,13 @@ Compare items with `eq' or TEST if specified."
(defmacro ebrowse-for-all-trees (spec &rest body)
"For all trees in SPEC, eval BODY."
(declare (indent 1) (debug ((sexp form) body)))
- (let ((var (make-symbol "var"))
- (spec-var (car spec))
+ (let ((spec-var (car spec))
(array (cadr spec)))
- `(cl-loop for ,var being the symbols of ,array
- as ,spec-var = (get ,var 'ebrowse-root) do
- (when (vectorp ,spec-var)
- ,@body))))
-
-;;; Set indentation for macros above.
-
-
+ `(maphash (lambda (_k ,spec-var)
+ (when ,spec-var
+ (cl-assert (cl-typep ,spec-var 'ebrowse-ts))
+ ,@body))
+ ,array)))
(defsubst ebrowse-set-face (start end face)
"Set face of a region START END to FACE."
@@ -264,8 +213,7 @@ Compare items with `eq' or TEST if specified."
Case is ignored in completions.
PROMPT is a string to prompt with; normally it ends in a colon and a space.
-TABLE is an alist whose elements' cars are strings, or an obarray.
-TABLE can also be a function to do the completion itself.
+TABLE is a completion table.
If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
If it is (STRING . POSITION), the initial input
is STRING, but point is placed POSITION characters into the string."
@@ -304,6 +252,9 @@ otherwise use the current frame's width."
;;; Structure definitions
+;; Note: These use `(:type vector) :named' in order to match the
+;; format used in src/BROWSE.
+
(cl-defstruct (ebrowse-hs (:type vector) :named)
"Header structure found at the head of BROWSE files."
;; A version string that is compared against the version number of
@@ -457,19 +408,17 @@ members."
This must be the same that `ebrowse' uses.")
-(defvar ebrowse--last-regexp nil
+(defvar-local ebrowse--last-regexp nil
"Last regular expression searched for in tree and member buffers.
Each tree and member buffer maintains its own search history.")
-(make-variable-buffer-local 'ebrowse--last-regexp)
-
(defconst ebrowse-member-list-accessors
- '(ebrowse-ts-member-variables
- ebrowse-ts-member-functions
- ebrowse-ts-static-variables
- ebrowse-ts-static-functions
- ebrowse-ts-friends
- ebrowse-ts-types)
+ (list #'ebrowse-ts-member-variables
+ #'ebrowse-ts-member-functions
+ #'ebrowse-ts-static-variables
+ #'ebrowse-ts-static-functions
+ #'ebrowse-ts-friends
+ #'ebrowse-ts-types)
"List of accessors for member lists.
Each element is the symbol of an accessor function.
The nth element must be the accessor for the nth member list
@@ -478,8 +427,8 @@ in an `ebrowse-ts' structure.")
;;; FIXME: Add more doc strings for the buffer-local variables below.
-(defvar ebrowse--tree-obarray nil
- "Obarray holding all `ebrowse-ts' structures of a class tree.
+(defvar ebrowse--tree-table nil
+ "Hash-table holding all `ebrowse-ts' structures of a class tree.
Buffer-local in Ebrowse buffers.")
@@ -637,12 +586,12 @@ Buffer-local in Ebrowse buffers.")
;;; Operations on `ebrowse-ts' structures
(defun ebrowse-files-table (&optional marked-only)
- "Return an obarray containing all files mentioned in the current tree.
-The tree is expected in the buffer-local variable `ebrowse--tree-obarray'.
+ "Return a hash table containing all files mentioned in the current tree.
+The tree is expected in the buffer-local variable `ebrowse--tree-table'.
MARKED-ONLY non-nil means include marked classes only."
(let ((files (make-hash-table :test 'equal))
(i -1))
- (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
+ (ebrowse-for-all-trees (tree ebrowse--tree-table)
(when (or (not marked-only) (ebrowse-ts-mark tree))
(let ((class (ebrowse-ts-class tree)))
(when (zerop (% (cl-incf i) 20))
@@ -677,7 +626,7 @@ MARKED-ONLY non-nil means include marked classes only."
(cl-defun ebrowse-marked-classes-p ()
"Value is non-nil if any class in the current class tree is marked."
- (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
+ (ebrowse-for-all-trees (tree ebrowse--tree-table)
(when (ebrowse-ts-mark tree)
(cl-return-from ebrowse-marked-classes-p tree))))
@@ -695,21 +644,21 @@ MARKED-ONLY non-nil means include marked classes only."
(ebrowse-cs-name class)))
-(defun ebrowse-tree-obarray-as-alist (&optional qualified-names-p)
+(defun ebrowse-tree-table-as-alist (&optional qualified-names-p)
"Return an alist describing all classes in a tree.
Each elements in the list has the form (CLASS-NAME . TREE).
CLASS-NAME is the name of the class. TREE is the
class tree whose root is QUALIFIED-CLASS-NAME.
QUALIFIED-NAMES-P non-nil means return qualified names as CLASS-NAME.
-The class tree is found in the buffer-local variable `ebrowse--tree-obarray'."
+The class tree is found in the buffer-local variable `ebrowse--tree-table'."
(let (alist)
(if qualified-names-p
- (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
+ (ebrowse-for-all-trees (tree ebrowse--tree-table)
(setq alist
(cl-acons (ebrowse-qualified-class-name
(ebrowse-ts-class tree))
tree alist)))
- (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
+ (ebrowse-for-all-trees (tree ebrowse--tree-table)
(setq alist
(cl-acons (ebrowse-cs-name (ebrowse-ts-class tree))
tree alist))))
@@ -751,7 +700,7 @@ computes this information lazily."
with result = nil
as search = (pop to-search)
while search finally return result
- do (ebrowse-for-all-trees (ti ebrowse--tree-obarray)
+ do (ebrowse-for-all-trees (ti ebrowse--tree-table)
(when (memq search (ebrowse-ts-subclasses ti))
(unless (memq ti result)
(setq result (nconc result (list ti))))
@@ -875,7 +824,7 @@ NOCONFIRM."
"Create a new tree buffer for tree TREE.
The tree was loaded from file TAGS-FILE.
HEADER is the header structure of the file.
-CLASSES is an obarray with a symbol for each class in the tree.
+CLASSES is a hash-table with an entry for each class in the tree.
POP non-nil means popup the buffer up at the end.
Return the buffer created."
(let ((name ebrowse-tree-buffer-name))
@@ -883,7 +832,7 @@ Return the buffer created."
(ebrowse-tree-mode)
(setq ebrowse--tree tree
ebrowse--tags-file-name tags-file
- ebrowse--tree-obarray classes
+ ebrowse--tree-table classes
ebrowse--header header
ebrowse--frozen-flag nil)
(ebrowse-redraw-tree)
@@ -895,13 +844,13 @@ Return the buffer created."
-;;; Operations for member obarrays
+;;; Operations for member tables
(defun ebrowse-fill-member-table ()
- "Return an obarray holding all members of all classes in the current tree.
+ "Return a hash table holding all members of all classes in the current tree.
-For each member, a symbol is added to the obarray. Members are
-extracted from the buffer-local tree `ebrowse--tree-obarray'.
+For each member, a symbol is added to the table. Members are
+extracted from the buffer-local tree `ebrowse--tree-table'.
Each symbol has its property `ebrowse-info' set to a list (TREE MEMBER-LIST
MEMBER) where TREE is the tree in which the member is defined,
@@ -909,26 +858,23 @@ MEMBER-LIST is a symbol describing the member list in which the member
is found, and MEMBER is a MEMBER structure describing the member.
The slot `member-table' of the buffer-local header structure of
-type `ebrowse-hs' is set to the resulting obarray."
+type `ebrowse-hs' is set to the resulting table."
(let ((members (make-hash-table :test 'equal))
(i -1))
(setf (ebrowse-hs-member-table ebrowse--header) nil)
(garbage-collect)
;; For all classes...
- (ebrowse-for-all-trees (c ebrowse--tree-obarray)
+ (ebrowse-for-all-trees (c ebrowse--tree-table)
(when (zerop (% (cl-incf i) 10))
(ebrowse-show-progress "Preparing member lookup" (zerop i)))
(dolist (f ebrowse-member-list-accessors)
(dolist (m (funcall f c))
- (let* ((member-name (ebrowse-ms-name m))
- (value (gethash member-name members)))
- (push (list c f m) value)
- (puthash member-name value members)))))
+ (push (list c f m) (gethash (ebrowse-ms-name m) members)))))
(setf (ebrowse-hs-member-table ebrowse--header) members)))
(defun ebrowse-member-table (header)
- "Return the member obarray. Build it if it hasn't been set up yet.
+ "Return the member table. Build it if it hasn't been set up yet.
HEADER is the tree header structure of the class tree."
(when (null (ebrowse-hs-member-table header))
(cl-loop for buffer in (ebrowse-browser-buffer-list)
@@ -940,19 +886,18 @@ HEADER is the tree header structure of the class tree."
-;;; Operations on TREE obarrays
+;;; Operations on TREE tables
-(defun ebrowse-build-tree-obarray (tree)
+(defun ebrowse-build-tree-table (tree)
"Make sure every class in TREE is represented by a unique object.
-Build obarray of all classes in TREE."
- (let ((classes (make-vector 127 0)))
+Build hash table of all classes in TREE."
+ (let ((classes (make-hash-table :test #'equal)))
;; Add root classes...
(cl-loop for root in tree
- as sym =
- (intern (ebrowse-qualified-class-name (ebrowse-ts-class root))
- classes)
- do (unless (get sym 'ebrowse-root)
- (setf (get sym 'ebrowse-root) root)))
+ do (let ((name (ebrowse-qualified-class-name
+ (ebrowse-ts-class root))))
+ (unless (gethash name classes)
+ (setf (gethash name classes) root))))
;; Process subclasses
(ebrowse-insert-supers tree classes)
classes))
@@ -962,7 +907,7 @@ Build obarray of all classes in TREE."
"Build base class lists in class tree TREE.
CLASSES is an obarray used to collect classes.
-Helper function for `ebrowse-build-tree-obarray'. Base classes should
+Helper function for `ebrowse-build-tree-table'. Base classes should
be ordered so that immediate base classes come first, then the base
class of the immediate base class and so on. This means that we must
construct the base-class list top down with adding each level at the
@@ -974,23 +919,21 @@ if for some reason a circle is in the inheritance graph."
as subclasses = (ebrowse-ts-subclasses class) do
;; Make sure every class is represented by a unique object
(cl-loop for subclass on subclasses
- as sym = (intern
- (ebrowse-qualified-class-name
- (ebrowse-ts-class (car subclass)))
- classes)
do
- ;; Replace the subclass tree with the one found in
- ;; CLASSES if there is already an entry for that class
- ;; in it. Otherwise make a new entry.
- ;;
- ;; CAVEAT: If by some means (e.g., use of the
- ;; preprocessor in class declarations, a name is marked
- ;; as a subclass of itself on some path, we would end up
- ;; in an endless loop. We have to omit subclasses from
- ;; the recursion that already have been processed.
- (if (get sym 'ebrowse-root)
- (setf (car subclass) (get sym 'ebrowse-root))
- (setf (get sym 'ebrowse-root) (car subclass))))
+ (let ((name (ebrowse-qualified-class-name
+ (ebrowse-ts-class (car subclass)))))
+ ;; Replace the subclass tree with the one found in
+ ;; CLASSES if there is already an entry for that class
+ ;; in it. Otherwise make a new entry.
+ ;;
+ ;; CAVEAT: If by some means (e.g., use of the
+ ;; preprocessor in class declarations, a name is marked
+ ;; as a subclass of itself on some path, we would end up
+ ;; in an endless loop. We have to omit subclasses from
+ ;; the recursion that already have been processed.
+ (if (gethash name classes)
+ (setf (car subclass) (gethash name classes))
+ (setf (gethash name classes) (car subclass)))))
;; Process subclasses
(ebrowse-insert-supers subclasses classes)))
@@ -1072,20 +1015,17 @@ Tree mode key bindings:
(erase-buffer)
(message nil))
- (set (make-local-variable 'ebrowse--show-file-names-flag) nil)
- (set (make-local-variable 'ebrowse--tree-obarray) (make-vector 127 0))
- (set (make-local-variable 'ebrowse--frozen-flag) nil)
+ (setq-local ebrowse--show-file-names-flag nil)
+ (setq-local ebrowse--frozen-flag nil)
(setq mode-line-buffer-identification ident)
(setq buffer-read-only t)
(add-to-invisibility-spec '(ebrowse . t))
- (set (make-local-variable 'revert-buffer-function)
- #'ebrowse-revert-tree-buffer-from-file)
- (set (make-local-variable 'ebrowse--header) header)
- (set (make-local-variable 'ebrowse--tree) tree)
- (set (make-local-variable 'ebrowse--tags-file-name) buffer-file-name)
- (set (make-local-variable 'ebrowse--tree-obarray)
- (and tree (ebrowse-build-tree-obarray tree)))
- (set (make-local-variable 'ebrowse--frozen-flag) nil)
+ (setq-local revert-buffer-function #'ebrowse-revert-tree-buffer-from-file)
+ (setq-local ebrowse--header header)
+ (setq-local ebrowse--tree tree)
+ (setq-local ebrowse--tags-file-name buffer-file-name)
+ (setq-local ebrowse--tree-table (and tree (ebrowse-build-tree-table tree)))
+ (setq-local ebrowse--frozen-flag nil)
(add-hook 'write-file-functions #'ebrowse-write-file-hook-fn nil t)
(modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))
@@ -1110,18 +1050,18 @@ Tree mode key bindings:
(defun ebrowse-remove-class-and-kill-member-buffers (tree class)
"Remove from TREE class CLASS.
Kill all member buffers still containing a reference to the class."
- (let ((sym (intern-soft (ebrowse-cs-name (ebrowse-ts-class class))
- ebrowse--tree-obarray)))
- (setf tree (delq class tree)
- (get sym 'ebrowse-root) nil)
- (dolist (root tree)
- (setf (ebrowse-ts-subclasses root)
- (delq class (ebrowse-ts-subclasses root))
- (ebrowse-ts-base-classes root) nil)
- (ebrowse-remove-class-and-kill-member-buffers
- (ebrowse-ts-subclasses root) class))
- (ebrowse-kill-member-buffers-displaying class)
- tree))
+ (setf tree (delq class tree)
+ (gethash (ebrowse-cs-name (ebrowse-ts-class class))
+ ebrowse--tree-table)
+ nil)
+ (dolist (root tree)
+ (setf (ebrowse-ts-subclasses root)
+ (delq class (ebrowse-ts-subclasses root))
+ (ebrowse-ts-base-classes root) nil)
+ (ebrowse-remove-class-and-kill-member-buffers
+ (ebrowse-ts-subclasses root) class))
+ (ebrowse-kill-member-buffers-displaying class)
+ tree)
(defun ebrowse-remove-class-at-point (forced)
@@ -1184,7 +1124,7 @@ If given a numeric N-TIMES argument, mark that many classes."
(defun ebrowse-mark-all-classes (prefix)
"Unmark, with PREFIX mark, all classes in the tree."
(interactive "P")
- (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
+ (ebrowse-for-all-trees (tree ebrowse--tree-table)
(setf (ebrowse-ts-mark tree) prefix))
(ebrowse-redraw-marks (point-min) (point-max)))
@@ -1277,17 +1217,17 @@ With PREFIX, insert that many filenames."
(defun ebrowse-browser-buffer-list ()
"Return a list of all tree or member buffers."
- (cl-delete-if-not 'ebrowse-buffer-p (buffer-list)))
+ (cl-delete-if-not #'ebrowse-buffer-p (buffer-list)))
(defun ebrowse-member-buffer-list ()
"Return a list of all member buffers."
- (cl-delete-if-not 'ebrowse-member-buffer-p (buffer-list)))
+ (cl-delete-if-not #'ebrowse-member-buffer-p (buffer-list)))
(defun ebrowse-tree-buffer-list ()
"Return a list of all tree buffers."
- (cl-delete-if-not 'ebrowse-tree-buffer-p (buffer-list)))
+ (cl-delete-if-not #'ebrowse-tree-buffer-p (buffer-list)))
(defun ebrowse-known-class-trees-buffer-list ()
@@ -1396,7 +1336,7 @@ Pop to member buffer if no prefix ARG, to tree buffer otherwise."
"): ")
nil nil ebrowse--indentation))))
(when (cl-plusp width)
- (set (make-local-variable 'ebrowse--indentation) width)
+ (setq-local ebrowse--indentation width)
(ebrowse-redraw-tree))))
@@ -1409,7 +1349,7 @@ Read a class name from the minibuffer if CLASS is nil."
(unless class
(setf class
(completing-read "Goto class: "
- (ebrowse-tree-obarray-as-alist) nil t)))
+ (ebrowse-tree-table-as-alist) nil t)))
(goto-char (point-min))
(widen)
(setq ebrowse--last-regexp (concat "\\b" class "\\b"))
@@ -1426,37 +1366,37 @@ Read a class name from the minibuffer if CLASS is nil."
(defun ebrowse-tree-command:show-member-variables (arg)
"Display member variables; with prefix ARG in frozen member buffer."
(interactive "P")
- (ebrowse-display-member-buffer 'ebrowse-ts-member-variables arg))
+ (ebrowse-display-member-buffer #'ebrowse-ts-member-variables arg))
(defun ebrowse-tree-command:show-member-functions (&optional arg)
"Display member functions; with prefix ARG in frozen member buffer."
(interactive "P")
- (ebrowse-display-member-buffer 'ebrowse-ts-member-functions arg))
+ (ebrowse-display-member-buffer #'ebrowse-ts-member-functions arg))
(defun ebrowse-tree-command:show-static-member-variables (arg)
"Display static member variables; with prefix ARG in frozen member buffer."
(interactive "P")
- (ebrowse-display-member-buffer 'ebrowse-ts-static-variables arg))
+ (ebrowse-display-member-buffer #'ebrowse-ts-static-variables arg))
(defun ebrowse-tree-command:show-static-member-functions (arg)
"Display static member functions; with prefix ARG in frozen member buffer."
(interactive "P")
- (ebrowse-display-member-buffer 'ebrowse-ts-static-functions arg))
+ (ebrowse-display-member-buffer #'ebrowse-ts-static-functions arg))
(defun ebrowse-tree-command:show-friends (arg)
"Display friend functions; with prefix ARG in frozen member buffer."
(interactive "P")
- (ebrowse-display-member-buffer 'ebrowse-ts-friends arg))
+ (ebrowse-display-member-buffer #'ebrowse-ts-friends arg))
(defun ebrowse-tree-command:show-types (arg)
"Display types defined in a class; with prefix ARG in frozen member buffer."
(interactive "P")
- (ebrowse-display-member-buffer 'ebrowse-ts-types arg))
+ (ebrowse-display-member-buffer #'ebrowse-ts-types arg))
@@ -1562,12 +1502,12 @@ The new frame is deleted when you quit viewing the file in that frame."
(had-a-buf (get-file-buffer file))
(buf-to-view (find-file-noselect file)))
(switch-to-buffer-other-frame buf-to-view)
- (set (make-local-variable 'ebrowse--frame-configuration)
+ (setq-local ebrowse--frame-configuration
old-frame-configuration)
- (set (make-local-variable 'ebrowse--view-exit-action)
+ (setq-local ebrowse--view-exit-action
(and (not had-a-buf)
(not (buffer-modified-p buf-to-view))
- 'kill-buffer))
+ #'kill-buffer))
(view-mode-enter (cons (selected-window) (cons (selected-window) t))
'ebrowse-view-exit-fn)))
@@ -1934,7 +1874,7 @@ COLLAPSE non-nil means collapse the branch."
(when (memq 'mode-name mode-line-format)
(setq mode-line-format (copy-sequence mode-line-format))
(setcar (memq 'mode-name mode-line-format) "Tree Buffers"))
- (set (make-local-variable 'Helper-return-blurb) "return to buffer editing")
+ (setq-local Helper-return-blurb "return to buffer editing")
(setq truncate-lines t
buffer-read-only t))
@@ -2145,41 +2085,31 @@ See `Electric-command-loop' for a description of STATE and CONDITION."
(define-derived-mode ebrowse-member-mode special-mode "Ebrowse-Members"
"Major mode for Ebrowse member buffers."
(mapc #'make-local-variable
- '(ebrowse--decl-column ;display column
- ebrowse--n-columns ;number of short columns
- ebrowse--column-width ;width of columns above
- ebrowse--show-inherited-flag ;include inherited members?
- ebrowse--filters ;public, protected, private
+ '(ebrowse--n-columns ;number of short columns
ebrowse--accessor ;vars, functions, friends
ebrowse--displayed-class ;class displayed
- ebrowse--long-display-flag ;display with regexps?
- ebrowse--source-regexp-flag ;show source regexp?
- ebrowse--attributes-flag ;show `virtual' and `inline'
ebrowse--member-list ;list of members displayed
ebrowse--tree ;the class tree
ebrowse--member-mode-strings ;part of mode line
ebrowse--tags-file-name ;
ebrowse--header
- ebrowse--tree-obarray
- ebrowse--virtual-display-flag
- ebrowse--inline-display-flag
- ebrowse--const-display-flag
- ebrowse--pure-display-flag
+ ebrowse--tree-table
ebrowse--frozen-flag)) ;buffer not automagically reused
- (setq mode-line-buffer-identification
- (propertized-buffer-identification "C++ Members")
- buffer-read-only t
- ebrowse--long-display-flag nil
- ebrowse--attributes-flag t
- ebrowse--show-inherited-flag t
- ebrowse--source-regexp-flag nil
- ebrowse--filters [0 1 2]
- ebrowse--decl-column ebrowse-default-declaration-column
- ebrowse--column-width ebrowse-default-column-width
- ebrowse--virtual-display-flag nil
- ebrowse--inline-display-flag nil
- ebrowse--const-display-flag nil
- ebrowse--pure-display-flag nil)
+ (setq-local
+ mode-line-buffer-identification
+ (propertized-buffer-identification "C++ Members")
+ buffer-read-only t
+ ebrowse--long-display-flag nil ;display with regexps?
+ ebrowse--attributes-flag t ;show `virtual' and `inline'
+ ebrowse--show-inherited-flag t ;include inherited members?
+ ebrowse--source-regexp-flag nil ;show source regexp?
+ ebrowse--filters [0 1 2] ;public, protected, private
+ ebrowse--decl-column ebrowse-default-declaration-column ;display column
+ ebrowse--column-width ebrowse-default-column-width ;width of columns above
+ ebrowse--virtual-display-flag nil
+ ebrowse--inline-display-flag nil
+ ebrowse--const-display-flag nil
+ ebrowse--pure-display-flag nil)
(modify-syntax-entry ?_ (char-to-string (char-syntax ?a))))
@@ -2257,10 +2187,10 @@ make one."
(ebrowse-create-tree-buffer ebrowse--tree
ebrowse--tags-file-name
ebrowse--header
- ebrowse--tree-obarray
+ ebrowse--tree-table
'pop))))
(and buf
- (funcall (if arg 'switch-to-buffer 'pop-to-buffer) buf))
+ (funcall (if arg #'switch-to-buffer #'pop-to-buffer) buf))
buf))
@@ -2276,8 +2206,9 @@ make one."
(defun ebrowse-cyclic-display-next/previous-member-list (incr)
"Switch buffer to INCR'th next/previous list of members."
- (let ((index (ebrowse-position ebrowse--accessor
- ebrowse-member-list-accessors)))
+ (let ((index (seq-position ebrowse-member-list-accessors
+ ebrowse--accessor
+ #'eql)))
(setf ebrowse--accessor
(cond ((cl-plusp incr)
(or (nth (1+ index)
@@ -2306,37 +2237,37 @@ make one."
(defun ebrowse-display-function-member-list ()
"Display the list of member functions."
(interactive)
- (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-functions))
+ (ebrowse-display-member-list-for-accessor #'ebrowse-ts-member-functions))
(defun ebrowse-display-variables-member-list ()
"Display the list of member variables."
(interactive)
- (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-variables))
+ (ebrowse-display-member-list-for-accessor #'ebrowse-ts-member-variables))
(defun ebrowse-display-static-variables-member-list ()
"Display the list of static member variables."
(interactive)
- (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-variables))
+ (ebrowse-display-member-list-for-accessor #'ebrowse-ts-static-variables))
(defun ebrowse-display-static-functions-member-list ()
"Display the list of static member functions."
(interactive)
- (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-functions))
+ (ebrowse-display-member-list-for-accessor #'ebrowse-ts-static-functions))
(defun ebrowse-display-friends-member-list ()
"Display the list of friends."
(interactive)
- (ebrowse-display-member-list-for-accessor 'ebrowse-ts-friends))
+ (ebrowse-display-member-list-for-accessor #'ebrowse-ts-friends))
(defun ebrowse-display-types-member-list ()
"Display the list of types."
(interactive)
- (ebrowse-display-member-list-for-accessor 'ebrowse-ts-types))
+ (ebrowse-display-member-list-for-accessor #'ebrowse-ts-types))
@@ -2565,8 +2496,8 @@ TAGS-FILE is the file name of the BROWSE file."
"Force buffer redisplay."
(interactive)
(let ((display-fn (if ebrowse--long-display-flag
- 'ebrowse-draw-member-long-fn
- 'ebrowse-draw-member-short-fn)))
+ #'ebrowse-draw-member-long-fn
+ #'ebrowse-draw-member-short-fn)))
(with-silent-modifications
(erase-buffer)
;; Show this class
@@ -2610,7 +2541,7 @@ the class cursor is on."
"Start point for member buffer creation.
LIST is the member list to display. STAND-ALONE non-nil
means the member buffer is standalone. CLASS is its class."
- (let* ((classes ebrowse--tree-obarray)
+ (let* ((classes ebrowse--tree-table)
(tree ebrowse--tree)
(tags-file ebrowse--tags-file-name)
(header ebrowse--header)
@@ -2630,7 +2561,7 @@ means the member buffer is standalone. CLASS is its class."
(setq ebrowse--member-list (funcall list class)
ebrowse--displayed-class class
ebrowse--accessor list
- ebrowse--tree-obarray classes
+ ebrowse--tree-table classes
ebrowse--frozen-flag stand-alone
ebrowse--tags-file-name tags-file
ebrowse--header header
@@ -2842,7 +2773,7 @@ REPEAT, if specified, says repeat the search REPEAT times."
(cl-defun ebrowse-move-point-to-member (name &optional count &aux member)
- "Set point on member NAME in the member buffer
+ "Set point on member NAME in the member buffer.
COUNT, if specified, says search the COUNT'th member with the same name."
(goto-char (point-min))
(widen)
@@ -2867,7 +2798,8 @@ COMPL-LIST is a completion list to use."
(class (or (ebrowse-completing-read-value title compl-list initial)
(error "Not found"))))
(setf ebrowse--displayed-class class
- ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class))
+ ebrowse--member-list (funcall ebrowse--accessor
+ ebrowse--displayed-class))
(ebrowse-redisplay-member-buffer)))
@@ -2875,7 +2807,9 @@ COMPL-LIST is a completion list to use."
"Switch member buffer to a class read from the minibuffer."
(interactive)
(ebrowse-switch-member-buffer-to-other-class
- "Goto class: " (ebrowse-tree-obarray-as-alist)))
+ "Goto class: "
+ ;; FIXME: Why not use the hash-table as-is?
+ (ebrowse-tree-table-as-alist)))
(defun ebrowse-switch-member-buffer-to-base-class (arg)
@@ -2927,8 +2861,9 @@ Prefix arg INC specifies which one."
(cl-first supers))))
(unless tree (error "Not found"))
(setq containing-list (ebrowse-ts-subclasses tree)))))
- (setq index (+ inc (ebrowse-position ebrowse--displayed-class
- containing-list)))
+ (setq index (+ inc (seq-position containing-list
+ ebrowse--displayed-class
+ #'eql)))
(cond ((cl-minusp index) (message "No previous class"))
((null (nth index containing-list)) (message "No next class")))
(setq index (max 0 (min index (1- (length containing-list)))))
@@ -2943,16 +2878,16 @@ Prefix arg INC specifies which one."
Prefix arg ARG says which class should be displayed. Default is
the first derived class."
(interactive "P")
- (cl-flet ((ebrowse-tree-obarray-as-alist ()
+ (cl-flet ((ebrowse-tree-table-as-alist ()
(cl-loop for s in (ebrowse-ts-subclasses
ebrowse--displayed-class)
- collect (cons (ebrowse-cs-name
- (ebrowse-ts-class s)) s))))
+ collect (cons (ebrowse-cs-name (ebrowse-ts-class s))
+ s))))
(let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class)
(error "No derived classes"))))
(if (and arg (cl-second subs))
(ebrowse-switch-member-buffer-to-other-class
- "Goto derived class: " (ebrowse-tree-obarray-as-alist))
+ "Goto derived class: " (ebrowse-tree-table-as-alist))
(setq ebrowse--displayed-class (cl-first subs)
ebrowse--member-list
(funcall ebrowse--accessor ebrowse--displayed-class))
@@ -3403,7 +3338,8 @@ It is a list (TREE ACCESSOR MEMBER)."
(switch-to-buffer buffer)
(setq ebrowse--displayed-class (cl-first info)
ebrowse--accessor (cl-second info)
- ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class))
+ ebrowse--member-list (funcall ebrowse--accessor
+ ebrowse--displayed-class))
(ebrowse-redisplay-member-buffer)))
(ebrowse-move-point-to-member (ebrowse-ms-name (cl-third info)))))
@@ -3513,28 +3449,20 @@ KIND is an additional string printed in the buffer."
(_ "unknown"))
"\n")))
-(defvar ebrowse-last-completion nil
+(defvar-local ebrowse-last-completion nil
"Text inserted by the last completion operation.")
-(defvar ebrowse-last-completion-start nil
+(defvar-local ebrowse-last-completion-start nil
"String which was the basis for the last completion operation.")
-(defvar ebrowse-last-completion-location nil
+(defvar-local ebrowse-last-completion-location nil
"Buffer position at which the last completion operation was initiated.")
-(defvar ebrowse-last-completion-obarray nil
+(defvar-local ebrowse-last-completion-table nil
"Member used in last completion operation.")
-
-
-(make-variable-buffer-local 'ebrowse-last-completion-obarray)
-(make-variable-buffer-local 'ebrowse-last-completion-location)
-(make-variable-buffer-local 'ebrowse-last-completion)
-(make-variable-buffer-local 'ebrowse-last-completion-start)
-
-
(defun ebrowse-some-member-table ()
"Return a hash table containing all members of a tree.
@@ -3552,7 +3480,7 @@ use choose a tree."
(defun ebrowse-cyclic-successor-in-string-list (string list)
"Return the item following STRING in LIST.
If STRING is the last element, return the first element as successor."
- (or (nth (1+ (ebrowse-position string list 'string=)) list)
+ (or (nth (1+ (seq-position list string #'string=)) list)
(cl-first list)))
@@ -3583,7 +3511,7 @@ completion."
;; expansion ended, insert the next expansion.
((eq (point) ebrowse-last-completion-location)
(setf list (all-completions ebrowse-last-completion-start
- ebrowse-last-completion-obarray)
+ ebrowse-last-completion-table)
completion (ebrowse-cyclic-successor-in-string-list
ebrowse-last-completion list))
(cond ((null completion)
@@ -3599,7 +3527,7 @@ completion."
;; buffer: Start new completion.
(t
(let* ((members (ebrowse-some-member-table))
- (completion (cl-first (all-completions pattern members nil))))
+ (completion (cl-first (all-completions pattern members))))
(cond ((eq completion t))
((null completion)
(error "Can't find completion for `%s'" pattern))
@@ -3610,14 +3538,14 @@ completion."
(setf ebrowse-last-completion-location (point)
ebrowse-last-completion-start pattern
ebrowse-last-completion completion
- ebrowse-last-completion-obarray members))))))))
+ ebrowse-last-completion-table members))))))))
;;; Tags query replace & search
-(defvar ebrowse-tags-loop-form ()
- "Form for `ebrowse-tags-loop-continue'.
-Evaluated for each file in the tree. If it returns nil, proceed
+(defvar ebrowse-tags-loop-call '(ignore)
+ "Function call for `ebrowse-tags-loop-continue'.
+Passed to `apply' for each file in the tree. If it returns nil, proceed
with the next file.")
(defvar ebrowse-tags-next-file-list ()
@@ -3684,7 +3612,7 @@ TREE-BUFFER if indirectly specifies which files to loop over."
(when first-time
(ebrowse-tags-next-file first-time tree-buffer)
(goto-char (point-min)))
- (while (not (eval ebrowse-tags-loop-form))
+ (while (not (apply ebrowse-tags-loop-call))
(ebrowse-tags-next-file)
(message "Scanning file `%s'..." buffer-file-name)
(goto-char (point-min))))
@@ -3697,9 +3625,9 @@ If marked classes exist, process marked classes, only.
If regular expression is nil, repeat last search."
(interactive "sTree search (regexp): ")
(if (and (string= regexp "")
- (eq (car ebrowse-tags-loop-form) 're-search-forward))
+ (eq (car ebrowse-tags-loop-call) #'re-search-forward))
(ebrowse-tags-loop-continue)
- (setq ebrowse-tags-loop-form (list 're-search-forward regexp nil t))
+ (setq ebrowse-tags-loop-call `(re-search-forward ,regexp nil t))
(ebrowse-tags-loop-continue 'first-time)))
@@ -3709,10 +3637,11 @@ If regular expression is nil, repeat last search."
With prefix arg, process files of marked classes only."
(interactive
"sTree query replace (regexp): \nsTree query replace %s by: ")
- (setq ebrowse-tags-loop-form
- (list 'and (list 'save-excursion
- (list 're-search-forward from nil t))
- (list 'not (list 'perform-replace from to t t nil))))
+ (setq ebrowse-tags-loop-call
+ (list (lambda ()
+ (and (save-excursion
+ (re-search-forward from nil t))
+ (not (perform-replace from to t t nil))))))
(ebrowse-tags-loop-continue 'first-time))
@@ -3737,7 +3666,7 @@ looks like a function call to the member."
(cl-values-list (ebrowse-tags-read-name header "Find calls of: "))))
;; Set tags loop form to search for member and begin loop.
(setq regexp (concat "\\<" name "[ \t]*(")
- ebrowse-tags-loop-form (list 're-search-forward regexp nil t))
+ ebrowse-tags-loop-call `(re-search-forward ,regexp nil t))
(ebrowse-tags-loop-continue 'first-time tree-buffer))))
@@ -3746,7 +3675,7 @@ looks like a function call to the member."
;;; Structures of this kind are the elements of the position stack.
-(cl-defstruct (ebrowse-position (:type vector) :named)
+(cl-defstruct (ebrowse-position)
file-name ; in which file
point ; point in file
target ; t if target of a jump
@@ -3839,18 +3768,10 @@ Prefix arg ARG says how much."
;;; Electric position list
-(defvar ebrowse-electric-position-mode-map ()
- "Keymap used in electric position stack window.")
-
-
-(defvar ebrowse-electric-position-mode-hook nil
- "If non-nil, its value is called by `ebrowse-electric-position-mode'.")
-
-
-(unless ebrowse-electric-position-mode-map
+(defvar ebrowse-electric-position-mode-map
(let ((map (make-keymap))
(submap (make-keymap)))
- (setq ebrowse-electric-position-mode-map map)
+ ;; FIXME: Yuck!
(fillarray (car (cdr map)) 'ebrowse-electric-position-undefined)
(fillarray (car (cdr submap)) 'ebrowse-electric-position-undefined)
(define-key map "\e" submap)
@@ -3873,14 +3794,19 @@ Prefix arg ARG says how much."
(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>" 'end-of-buffer)))
+ (define-key map "\e>" 'end-of-buffer)
+ map)
+ "Keymap used in electric position stack window.")
+
+
+(defvar ebrowse-electric-position-mode-hook nil
+ "If non-nil, its value is called by `ebrowse-electric-position-mode'.")
-(put 'ebrowse-electric-position-mode 'mode-class 'special)
(put 'ebrowse-electric-position-undefined 'suppress-keymap t)
(define-derived-mode ebrowse-electric-position-mode
- fundamental-mode "Electric Position Menu"
+ special-mode "Electric Position Menu"
"Mode for electric position buffers.
Runs the hook `ebrowse-electric-position-mode-hook'."
(setq mode-line-buffer-identification "Electric Position Menu")
@@ -3888,7 +3814,7 @@ Runs the hook `ebrowse-electric-position-mode-hook'."
(setq mode-line-format (copy-sequence mode-line-format))
;; FIXME: Why not set `mode-name' to "Positions"?
(setcar (memq 'mode-name mode-line-format) "Positions"))
- (set (make-local-variable 'Helper-return-blurb) "return to buffer editing")
+ (setq-local Helper-return-blurb "return to buffer editing")
(setq truncate-lines t
buffer-read-only t))
@@ -4101,7 +4027,7 @@ NUMBER-OF-INSTANCE-VARIABLES NUMBER-OF-STATIC-FUNCTIONS
NUMBER-OF-STATIC-VARIABLES:"
(let ((classes 0) (member-functions 0) (member-variables 0)
(static-functions 0) (static-variables 0))
- (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
+ (ebrowse-for-all-trees (tree ebrowse--tree-table)
(cl-incf classes)
(cl-incf member-functions (length (ebrowse-ts-member-functions tree)))
(cl-incf member-variables (length (ebrowse-ts-member-variables tree)))
@@ -4391,10 +4317,4 @@ EVENT is the mouse event."
(provide 'ebrowse)
-
-;; Local variables:
-;; eval:(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0)
-;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
-;; End:
-
;;; ebrowse.el ends here
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index f39ecf9b7bc..b4803687b5a 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -231,8 +231,35 @@ Comments in the form will be lost."
(setq-local electric-pair-text-pairs elisp-pairs)))))
(remove-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs))
+(defun elisp-enable-lexical-binding (&optional interactive)
+ "Make the current buffer use `lexical-binding'."
+ (interactive "p")
+ (if lexical-binding
+ (when interactive
+ (message "lexical-binding already enabled!")
+ (ding))
+ (when (or (not interactive)
+ (y-or-n-p (format "Enable lexical-binding in this %s? "
+ (if buffer-file-name "file" "buffer"))))
+ (setq-local lexical-binding t)
+ (add-file-local-variable-prop-line 'lexical-binding t interactive))))
+
+(defvar elisp--dynlex-modeline-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line mouse-1] 'elisp-enable-lexical-binding)
+ map))
+
;;;###autoload
-(define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp"
+(define-derived-mode emacs-lisp-mode lisp-data-mode
+ `("ELisp"
+ (lexical-binding (:propertize "/l"
+ help-echo "Using lexical-binding mode")
+ (:propertize "/d"
+ help-echo "Using old dynamic scoping mode\n\
+mouse-1: Enable lexical-binding mode"
+ face warning
+ mouse-face mode-line-highlight
+ local-map ,elisp--dynlex-modeline-map)))
"Major mode for editing Lisp code to run in Emacs.
Commands:
Delete converts tabs to spaces as it moves back.
@@ -241,35 +268,28 @@ Blank lines separate paragraphs. Semicolons start comments.
\\{emacs-lisp-mode-map}"
:group 'lisp
(defvar project-vc-external-roots-function)
- (lisp-mode-variables nil nil 'elisp)
+ (setcar font-lock-defaults
+ '(lisp-el-font-lock-keywords
+ lisp-el-font-lock-keywords-1
+ lisp-el-font-lock-keywords-2))
+ (setf (nth 2 font-lock-defaults) nil)
(add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
(if (boundp 'electric-pair-text-pairs)
(setq-local electric-pair-text-pairs
- (append '((?\` . ?\') (?‘ . ?’))
+ (append '((?\` . ?\') (?\‘ . ?\’))
electric-pair-text-pairs))
(add-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs))
- (setq-local electric-quote-string t)
- (setq imenu-case-fold-search nil)
- (add-function :before-until (local 'eldoc-documentation-function)
- #'elisp-eldoc-documentation-function)
+ (add-hook 'eldoc-documentation-functions
+ #'elisp-eldoc-funcall nil t)
+ (add-hook 'eldoc-documentation-functions
+ #'elisp-eldoc-var-docstring nil t)
(add-hook 'xref-backend-functions #'elisp--xref-backend nil t)
(setq-local project-vc-external-roots-function #'elisp-load-path-roots)
(add-hook 'completion-at-point-functions
#'elisp-completion-at-point nil 'local)
- ;; .dir-locals.el and lock files will cause the byte-compiler and
- ;; checkdoc emit spurious warnings, because they don't follow the
- ;; conventions of Emacs Lisp sources. Until we have a better fix,
- ;; like teaching elisp-mode about files that only hold data
- ;; structures, we disable the ELisp Flymake backend for these files.
- (unless
- (let* ((bfname (buffer-file-name))
- (fname (and (stringp bfname) (file-name-nondirectory bfname))))
- (and (stringp fname)
- (or (string-match "\\`\\.#" fname)
- (string-equal dir-locals-file fname))))
- (add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t)
- (add-hook 'flymake-diagnostic-functions
- #'elisp-flymake-byte-compile nil t)))
+ (add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t)
+ (add-hook 'flymake-diagnostic-functions
+ #'elisp-flymake-byte-compile nil t))
;; Font-locking support.
@@ -637,18 +657,16 @@ functions are annotated with \"<f>\" via the
;; WORKAROUND: This is nominally a constant, but the text properties
;; are not preserved thru dump if use defconst. See bug#21237.
(defvar elisp--xref-format
- (let ((str "(%s %s)"))
- (put-text-property 1 3 'face 'font-lock-keyword-face str)
- (put-text-property 4 6 'face 'font-lock-function-name-face str)
- str))
+ #("(%s %s)"
+ 1 3 (face font-lock-keyword-face)
+ 4 6 (face font-lock-function-name-face)))
;; WORKAROUND: This is nominally a constant, but the text properties
;; are not preserved thru dump if use defconst. See bug#21237.
(defvar elisp--xref-format-extra
- (let ((str "(%s %s %s)"))
- (put-text-property 1 3 'face 'font-lock-keyword-face str)
- (put-text-property 4 6 'face 'font-lock-function-name-face str)
- str))
+ #("(%s %s %s)"
+ 1 3 (face font-lock-keyword-face)
+ 4 6 (face font-lock-function-name-face)))
(defvar find-feature-regexp);; in find-func.el
@@ -665,7 +683,7 @@ otherwise build the summary from TYPE and SYMBOL."
"List of functions to be run from `elisp--xref-find-definitions' to add additional xrefs.
Called with one arg; the symbol whose definition is desired.
Each function should return a list of xrefs, or nil; the first
-non-nil result supercedes the xrefs produced by
+non-nil result supersedes the xrefs produced by
`elisp--xref-find-definitions'.")
(cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier)
@@ -845,11 +863,12 @@ non-nil result supercedes the xrefs produced by
xrefs))
-(declare-function project-external-roots "project")
+(declare-function xref-apropos-regexp "xref" (pattern))
-(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) regexp)
+(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) pattern)
(apply #'nconc
- (let (lst)
+ (let ((regexp (xref-apropos-regexp pattern))
+ lst)
(dolist (sym (apropos-internal regexp))
(push (elisp--xref-find-definitions sym) lst))
(nreverse lst))))
@@ -1386,20 +1405,29 @@ which see."
or argument string for functions.
2 - `function' if function args, `variable' if variable documentation.")
-(defun elisp-eldoc-documentation-function ()
- "`eldoc-documentation-function' (which see) for Emacs Lisp."
- (let ((current-symbol (elisp--current-symbol))
- (current-fnsym (elisp--fnsym-in-current-sexp)))
- (cond ((null current-fnsym)
- nil)
- ((eq current-symbol (car current-fnsym))
- (or (apply #'elisp-get-fnsym-args-string current-fnsym)
- (elisp-get-var-docstring current-symbol)))
- (t
- (or (elisp-get-var-docstring current-symbol)
- (apply #'elisp-get-fnsym-args-string current-fnsym))))))
-
-(defun elisp-get-fnsym-args-string (sym &optional index prefix)
+(defun elisp-eldoc-funcall (callback &rest _ignored)
+ "Document function call at point.
+Intended for `eldoc-documentation-functions' (which see)."
+ (let* ((sym-info (elisp--fnsym-in-current-sexp))
+ (fn-sym (car sym-info)))
+ (when fn-sym
+ (funcall callback (apply #'elisp-get-fnsym-args-string sym-info)
+ :thing fn-sym
+ :face (if (functionp fn-sym)
+ 'font-lock-function-name-face
+ 'font-lock-keyword-face)))))
+
+(defun elisp-eldoc-var-docstring (callback &rest _ignored)
+ "Document variable at point.
+Intended for `eldoc-documentation-functions' (which see)."
+ (let* ((sym (elisp--current-symbol))
+ (docstring (and sym (elisp-get-var-docstring sym))))
+ (when docstring
+ (funcall callback docstring
+ :thing sym
+ :face 'font-lock-variable-name-face))))
+
+(defun elisp-get-fnsym-args-string (sym &optional index)
"Return a string containing the parameter list of the function SYM.
If SYM is a subr and no arglist is obtainable from the docstring
or elsewhere, return a 1-line docstring."
@@ -1425,20 +1453,13 @@ or elsewhere, return a 1-line docstring."
;; Stringify, and store before highlighting, downcasing, etc.
(elisp--last-data-store sym (elisp-function-argstring args)
'function))))))
- ;; Highlight, truncate.
+ ;; Highlight
(if argstring
(elisp--highlight-function-argument
- sym argstring index
- (or prefix
- (concat (propertize (symbol-name sym) 'face
- (if (functionp sym)
- 'font-lock-function-name-face
- 'font-lock-keyword-face))
- ": "))))))
-
-(defun elisp--highlight-function-argument (sym args index prefix)
- "Highlight argument INDEX in ARGS list for function SYM.
-In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
+ sym argstring index))))
+
+(defun elisp--highlight-function-argument (sym args index)
+ "Highlight argument INDEX in ARGS list for function SYM."
;; FIXME: This should probably work on the list representation of `args'
;; rather than its string representation.
;; FIXME: This function is much too long, we need to split it up!
@@ -1541,7 +1562,6 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
(when start
(setq doc (copy-sequence args))
(add-text-properties start end (list 'face argument-face) doc))
- (setq doc (eldoc-docstring-format-sym-doc prefix doc))
doc)))
;; Return a string containing a brief (one-line) documentation string for
@@ -1554,9 +1574,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
(t
(let ((doc (documentation-property sym 'variable-documentation t)))
(when doc
- (let ((doc (eldoc-docstring-format-sym-doc
- sym (elisp--docstring-first-line doc)
- 'font-lock-variable-name-face)))
+ (let ((doc (elisp--docstring-first-line doc)))
(elisp--last-data-store sym doc 'variable)))))))
(defun elisp--last-data-store (symbol doc type)
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 897f105019e..f6af1f2ea84 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1424,6 +1424,10 @@ hits the start of file."
(goto-func goto-tag-location-function)
tag tag-info pt)
(forward-line 1)
+ ;; Exuberant ctags add a line starting with the DEL character;
+ ;; skip past it.
+ (when (looking-at "\177")
+ (forward-line 1))
(while (not (or (eobp) (looking-at "\f")))
;; We used to use explicit tags when available, but the current goto-func
;; can only handle implicit tags.
@@ -1841,7 +1845,7 @@ Also see the documentation of the `tags-file-name' variable."
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].
-For non-interactive use, superceded by `fileloop-initialize-replace'."
+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))
(fileloop-initialize-replace
@@ -2080,8 +2084,8 @@ file name, add `tag-partial-file-name-match-p' to the list value.")
(cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol)
(etags--xref-find-definitions symbol))
-(cl-defmethod xref-backend-apropos ((_backend (eql etags)) symbol)
- (etags--xref-find-definitions symbol t))
+(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?)
;; This emulates the behavior of `find-tag-in-order' but instead of
diff --git a/lisp/progmodes/flymake-cc.el b/lisp/progmodes/flymake-cc.el
index 1e9e25641d5..d1985b4f777 100644
--- a/lisp/progmodes/flymake-cc.el
+++ b/lisp/progmodes/flymake-cc.el
@@ -5,18 +5,20 @@
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: languages, c
-;; 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/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el
index 62f6d1aaea2..152dc725c74 100644
--- a/lisp/progmodes/flymake-proc.el
+++ b/lisp/progmodes/flymake-proc.el
@@ -37,7 +37,7 @@
;;; Bugs/todo:
;; - Only uses "Makefile", not "makefile" or "GNUmakefile"
-;; (from http://bugs.debian.org/337339).
+;; (from https://bugs.debian.org/337339).
;;; Code:
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 1ed733b7e37..b286208fff9 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -4,9 +4,12 @@
;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
;; Maintainer: João Távora <joaotavora@gmail.com>
-;; Version: 1.0.8
-;; Package-Requires: ((emacs "26.1"))
+;; Version: 1.0.9
;; Keywords: c languages tools
+;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0"))
+
+;; This is a GNU ELPA :core package. Avoid functionality that is not
+;; compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.
@@ -223,10 +226,10 @@ Specifically, start it when the saved buffer is actually displayed."
(defcustom flymake-suppress-zero-counters :warning
"Control appearance of zero-valued diagnostic counters in mode line.
-If set to t, supress all zero counters. If set to a severity
+If set to t, suppress all zero counters. If set to a severity
symbol like `:warning' (the default) suppress zero counters less
severe than that severity, according to `warning-numeric-level'.
-If set to nil, don't supress any zero counters."
+If set to nil, don't suppress any zero counters."
:type 'symbol)
(when (fboundp 'define-fringe-bitmap)
@@ -629,7 +632,7 @@ associated `flymake-category' return DEFAULT."
for (ov-prop . value) in
(append (reverse
(flymake--diag-overlay-properties diagnostic))
- (reverse ; ensure ealier props override later ones
+ (reverse ; ensure earlier props override later ones
(flymake--lookup-type-property type 'flymake-overlay-control))
(alist-get type flymake-diagnostic-types-alist))
do (overlay-put ov ov-prop value))
@@ -999,8 +1002,9 @@ special *Flymake log* buffer." :group 'flymake :lighter
(add-hook 'after-change-functions 'flymake-after-change-function nil t)
(add-hook 'after-save-hook 'flymake-after-save-hook nil t)
(add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t)
+ (add-hook 'eldoc-documentation-functions 'flymake-eldoc-function t t)
- ;; If Flymake happened to be alrady already ON, we must cleanup
+ ;; If Flymake happened to be already already ON, we must cleanup
;; existing diagnostic overlays, lest we forget them by blindly
;; reinitializing `flymake--backend-state' in the next line.
;; See https://github.com/joaotavora/eglot/issues/223.
@@ -1016,6 +1020,7 @@ special *Flymake log* buffer." :group 'flymake :lighter
(remove-hook 'after-save-hook 'flymake-after-save-hook t)
(remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t)
;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t)
+ (remove-hook 'eldoc-documentation-functions 'flymake-eldoc-function t)
(mapc #'delete-overlay (flymake--overlays))
@@ -1083,6 +1088,14 @@ START and STOP and LEN are as in `after-change-functions'."
(flymake-mode)
(flymake-log :warning "Turned on in `flymake-find-file-hook'")))
+(defun flymake-eldoc-function (report-doc &rest _)
+ "Document diagnostics at point.
+Intended for `eldoc-documentation-functions' (which see)."
+ (let ((diags (flymake-diagnostics (point))))
+ (when diags
+ (funcall report-doc
+ (mapconcat #'flymake-diagnostic-text diags "\n")))))
+
(defun flymake-goto-next-error (&optional n filter interactive)
"Go to Nth next Flymake diagnostic that matches FILTER.
Interactively, always move to the next diagnostic. With a prefix
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index 811951eaaaf..abc860b9478 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -429,7 +429,7 @@ The only difference is, it returns t in a case when the default returns nil."
fortran-font-lock-keywords-1
;; All type specifiers plus their declared items.
(list
- (list (concat fortran-type-types "[ \t(/]*\\(*\\)?")
+ (list (concat fortran-type-types "[ \t(/]*\\(\\*\\)?")
;; Type specifier.
'(1 font-lock-type-face)
;; Declaration item (or just /.../ block name).
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index e785acd2840..79df97080df 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -8,7 +8,7 @@
;; This file is part of GNU Emacs.
-;; Homepage: http://www.emacswiki.org/emacs/GDB-MI
+;; Homepage: https://www.emacswiki.org/emacs/GDB-MI
;; 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
@@ -92,6 +92,8 @@
(require 'json)
(require 'bindat)
(require 'cl-lib)
+(require 'cl-seq)
+(eval-when-compile (require 'pcase))
(declare-function speedbar-change-initial-expansion-list
"speedbar" (new-default))
@@ -105,13 +107,24 @@
(defvar speedbar-initial-expansion-list-name)
(defvar speedbar-frame)
-(defvar gdb-memory-address "main")
-(defvar gdb-memory-last-address nil
+(defvar-local gdb-memory-address-expression "main"
+ "This expression is passed to gdb.
+Possible value: main, $rsp, x+3.")
+(defvar-local gdb-memory-address nil
+ "Address of memory display.")
+(defvar-local gdb-memory-last-address nil
"Last successfully accessed memory address.")
(defvar gdb-memory-next-page nil
"Address of next memory page for program memory buffer.")
(defvar gdb-memory-prev-page nil
"Address of previous memory page for program memory buffer.")
+(defvar-local gdb--memory-display-warning nil
+ "Display warning on memory header if t.
+
+When error occurs when retrieving memory, gdb-mi displays the
+last successful page. In that case the expression might not
+match the memory displayed. We want to let the user be aware of
+that, so display a warning exclamation mark in the header line.")
(defvar gdb-thread-number nil
"Main current thread.
@@ -211,7 +224,9 @@ Only used for files that Emacs can't find.")
(defvar gdb-source-file-list nil
"List of source files for the current executable.")
(defvar gdb-first-done-or-error t)
-(defvar gdb-source-window nil)
+(defvar gdb-source-window-list nil
+ "List of windows used for displaying source files.
+Sorted in most-recently-visited-first order.")
(defvar gdb-inferior-status nil)
(defvar gdb-continuation nil)
(defvar gdb-supports-non-stop nil)
@@ -242,6 +257,27 @@ Possible values are these symbols:
disposition of output generated by commands that
gdb mode sends to gdb on its own behalf.")
+(defvar gdb--window-configuration-before nil
+ "Stores the window configuration before starting GDB.")
+
+(defcustom gdb-restore-window-configuration-after-quit nil
+ "If non-nil, restore window configuration as of before GDB started.
+
+Possible values are:
+ t -- Always restore.
+ nil -- Don't restore.
+ `if-gdb-show-main' -- Restore only if variable `gdb-show-main'
+ is non-nil
+ `if-gdb-many-windows' -- Restore only if variable `gdb-many-windows'
+ is non-nil."
+ :type '(choice
+ (const :tag "Always restore" t)
+ (const :tag "Don't restore" nil)
+ (const :tag "Depends on `gdb-show-main'" 'if-gdb-show-main)
+ (const :tag "Depends on `gdb-many-windows'" 'if-gdb-many-windows))
+ :group 'gdb
+ :version "28.1")
+
(defcustom gdb-discard-unordered-replies t
"Non-nil means discard any out-of-order GDB replies.
This protects against lost GDB replies, assuming that GDB always
@@ -592,6 +628,41 @@ Also display the main routine in the disassembly buffer if present."
:group 'gdb
:version "22.1")
+(defcustom gdb-window-configuration-directory user-emacs-directory
+ "Directory where GDB window configuration files are stored.
+If nil, use `default-directory'."
+ :type 'string
+ :group 'gdb
+ :version "28.1")
+
+(defcustom gdb-default-window-configuration-file nil
+ "If non-nil, load this window configuration (layout) on startup.
+This should be the full name of the window configuration file.
+If this is not an absolute path, GDB treats it as a relative path
+and looks under `gdb-window-configuration-directory'.
+
+Note that this variable only takes effect when variable
+`gdb-many-windows' is t."
+ :type '(choice (const :tag "None" nil)
+ string)
+ :group 'gdb
+ :version "28.1")
+
+(defcustom gdb-display-source-buffer-action '(nil . ((inhibit-same-window . t)))
+ "`display-buffer' action used when GDB displays a source buffer."
+ :type 'sexp
+ :group 'gdb
+ :version "28.1")
+
+(defcustom gdb-max-source-window-count 1
+ "Maximum number of source windows to use.
+Until there are such number of source windows on screen, GDB
+tries to open a new window when visiting a new source file; after
+that GDB starts to reuse existing source windows."
+ :type 'number
+ :group 'gdb
+ :version "28.1")
+
(defvar gdbmi-debug-mode nil
"When non-nil, print the messages sent/received from GDB/MI in *Messages*.")
@@ -750,6 +821,12 @@ detailed description of this mode.
(gdb-restore-windows)
(error
"Multiple debugging requires restarting in text command mode"))
+
+ ;; Save window configuration before starting gdb so we can restore
+ ;; it after gdb quits. Save it regardless of the value of
+ ;; `gdb-restore-window-configuration-after-quit'.
+ (setq gdb--window-configuration-before (window-state-get))
+
;;
(gud-common-init command-line nil 'gud-gdbmi-marker-filter)
@@ -925,7 +1002,7 @@ detailed description of this mode.
gdb-first-done-or-error t
gdb-buffer-fringe-width (car (window-fringes))
gdb-debug-log nil
- gdb-source-window nil
+ gdb-source-window-list nil
gdb-inferior-status nil
gdb-continuation nil
gdb-buf-publisher '()
@@ -1035,7 +1112,10 @@ no input, and GDB is waiting for input."
(declare-function tooltip-show "tooltip" (text &optional use-echo-area))
-(defconst gdb--string-regexp "\"\\(?:[^\\\"]\\|\\\\.\\)*\"")
+(defconst gdb--string-regexp (rx "\""
+ (* (or (seq "\\" nonl)
+ (not (any "\"\\"))))
+ "\""))
(defun gdb-tooltip-print (expr)
(with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
@@ -1667,25 +1747,25 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
"Interrupt the program being debugged."
(interactive)
(interrupt-process
- (get-buffer-process gud-comint-buffer) comint-ptyp))
+ (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp))
(defun gdb-io-quit ()
"Send quit signal to the program being debugged."
(interactive)
(quit-process
- (get-buffer-process gud-comint-buffer) comint-ptyp))
+ (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp))
(defun gdb-io-stop ()
"Stop the program being debugged."
(interactive)
(stop-process
- (get-buffer-process gud-comint-buffer) comint-ptyp))
+ (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp))
(defun gdb-io-eof ()
"Send end-of-file to the program being debugged."
(interactive)
(process-send-eof
- (get-buffer-process gud-comint-buffer)))
+ (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io))))
(defun gdb-clear-inferior-io ()
(with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
@@ -1788,7 +1868,8 @@ static char *magick[] = {
"\\|def\\(i\\(ne?\\)?\\)?\\|doc\\(u\\(m\\(e\\(nt?\\)?\\)?\\)?\\)?\\|"
gdb-python-guile-commands-regexp
"\\|while-stepping\\|stepp\\(i\\(ng?\\)?\\)?\\|ws\\|actions"
- "\\)\\([[:blank:]]+\\([^[:blank:]]*\\)\\)?$")
+ "\\|expl\\(o\\(re?\\)?\\)?"
+ "\\)\\([[:blank:]]+\\([^[:blank:]]*\\)\\)*$")
"Regexp matching GDB commands that enter a recursive reading loop.
As long as GDB is in the recursive reading loop, it does not expect
commands to be prefixed by \"-interpreter-exec console\".")
@@ -2007,17 +2088,36 @@ is running."
;; GDB frame (after up, down etc). If no GDB frame is visible but the last
;; visited breakpoint is, use that window.
(defun gdb-display-source-buffer (buffer)
- (let* ((last-window (if gud-last-last-frame
- (get-buffer-window
- (gud-find-file (car gud-last-last-frame)))))
- (source-window (or last-window
- (if (and gdb-source-window
- (window-live-p gdb-source-window))
- gdb-source-window))))
- (when source-window
- (setq gdb-source-window source-window)
- (set-window-buffer source-window buffer))
- source-window))
+ "Find a window to display BUFFER.
+Always find a window to display buffer, and return it."
+ ;; This function doesn't take care of setting up source window(s) at startup,
+ ;; that's handled by `gdb-setup-windows' (if `gdb-many-windows' is non-nil).
+ ;; If `buffer' is already shown in a window, use that window.
+ (or (get-buffer-window buffer)
+ (progn
+ ;; First, update the window list.
+ (setq gdb-source-window-list
+ (cl-remove-duplicates
+ (cl-remove-if-not
+ (lambda (win)
+ (and (window-live-p win)
+ (eq (window-frame win)
+ (selected-frame))))
+ gdb-source-window-list)))
+ ;; Should we create a new window or reuse one?
+ (if (> gdb-max-source-window-count
+ (length gdb-source-window-list))
+ ;; Create a new window, push it to window list and return it.
+ (car (push (display-buffer buffer gdb-display-source-buffer-action)
+ gdb-source-window-list))
+ ;; Reuse a window, we use the oldest window and put that to
+ ;; the front of the window list.
+ (let ((last-win (car (last gdb-source-window-list)))
+ (rest (butlast gdb-source-window-list)))
+ (set-window-buffer last-win buffer)
+ (setq gdb-source-window-list
+ (cons last-win rest))
+ last-win)))))
(defun gdbmi-start-with (str offset match)
@@ -2446,7 +2546,13 @@ file names include non-ASCII characters."
gdb-filter-output)
-(defun gdb-gdb (_output-field))
+(defun gdb-gdb (_output-field)
+ ;; This is needed because the "explore" command is not ended by the
+ ;; likes of "end" or "quit", but instead by a RET at the appropriate
+ ;; place, and we know we have exited "explore" when we get the
+ ;; "(gdb)" prompt.
+ (and (> gdb-control-level 0)
+ (setq gdb-control-level (1- gdb-control-level))))
(defun gdb-shell (output-field)
(setq gdb-filter-output
@@ -3450,7 +3556,7 @@ line."
(def-gdb-trigger-and-handler
gdb-invalidate-memory
(format "-data-read-memory %s %s %d %d %d"
- gdb-memory-address
+ (gdb-mi-quote gdb-memory-address-expression)
gdb-memory-format
gdb-memory-unit
gdb-memory-rows
@@ -3490,6 +3596,9 @@ in `gdb-memory-format'."
(err-msg (bindat-get-field res 'msg)))
(if (not err-msg)
(let ((memory (bindat-get-field res 'memory)))
+ (when gdb-memory-last-address
+ ;; Nil means last retrieve emits error or just started the session.
+ (setq gdb--memory-display-warning nil))
(setq gdb-memory-address (bindat-get-field res 'addr))
(setq gdb-memory-next-page (bindat-get-field res 'next-page))
(setq gdb-memory-prev-page (bindat-get-field res 'prev-page))
@@ -3503,10 +3612,15 @@ in `gdb-memory-format'."
gdb-memory-format)))))
(newline)))
;; Show last page instead of empty buffer when out of bounds
- (progn
- (let ((gdb-memory-address gdb-memory-last-address))
+ (when gdb-memory-last-address
+ (let ((gdb-memory-address-expression gdb-memory-last-address))
+ ;; If we don't set `gdb-memory-last-address' to nil,
+ ;; `gdb-invalidate-memory' eventually calls
+ ;; `gdb-read-memory-custom', making an infinite loop.
+ (setq gdb-memory-last-address nil
+ gdb--memory-display-warning t)
(gdb-invalidate-memory 'update)
- (error err-msg))))))
+ (user-error "Error when retrieving memory: %s Displaying last successful page" err-msg))))))
(defvar gdb-memory-mode-map
(let ((map (make-sparse-keymap)))
@@ -3540,7 +3654,7 @@ in `gdb-memory-format'."
"Set the start memory address."
(interactive)
(let ((arg (read-from-minibuffer "Memory address: ")))
- (setq gdb-memory-address arg))
+ (setq gdb-memory-address-expression arg))
(gdb-invalidate-memory 'update))
(defmacro def-gdb-set-positive-number (name variable echo-string &optional doc)
@@ -3723,7 +3837,19 @@ DOC is an optional documentation string."
(defvar gdb-memory-header
'(:eval
(concat
- "Start address["
+ "Start address "
+ ;; If `gdb-memory-address-expression' is nil, `propertize' would error.
+ (propertize (or gdb-memory-address-expression "N/A")
+ 'face font-lock-warning-face
+ 'help-echo "mouse-1: set start address"
+ 'mouse-face 'mode-line-highlight
+ 'local-map (gdb-make-header-line-mouse-map
+ 'mouse-1
+ #'gdb-memory-set-address-event))
+ (if gdb--memory-display-warning
+ (propertize " !" 'face '(:inherit error :weight bold))
+ "")
+ " ["
(propertize "-"
'face font-lock-warning-face
'help-echo "mouse-1: decrement address"
@@ -3740,13 +3866,9 @@ DOC is an optional documentation string."
'mouse-1
#'gdb-memory-show-next-page))
"]: "
- (propertize gdb-memory-address
- 'face font-lock-warning-face
- 'help-echo "mouse-1: set start address"
- 'mouse-face 'mode-line-highlight
- 'local-map (gdb-make-header-line-mouse-map
- 'mouse-1
- #'gdb-memory-set-address-event))
+ ;; If `gdb-memory-address' is nil, `propertize' would error.
+ (propertize (or gdb-memory-address "N/A")
+ 'face font-lock-warning-face)
" Rows: "
(propertize (number-to-string gdb-memory-rows)
'face font-lock-warning-face
@@ -3986,9 +4108,7 @@ DOC is an optional documentation string."
(let* ((buffer (find-file-noselect
(if (file-exists-p file) file
(cdr (assoc bptno gdb-location-alist)))))
- (window (or (gdb-display-source-buffer buffer)
- (display-buffer buffer))))
- (setq gdb-source-window window)
+ (window (gdb-display-source-buffer buffer)))
(with-current-buffer buffer
(goto-char (point-min))
(forward-line (1- (string-to-number line)))
@@ -4464,6 +4584,26 @@ SPLIT-HORIZONTAL and show BUF in the new window."
(define-key gud-menu-map [displays]
`(menu-item "GDB-Windows" ,menu
:visible (eq gud-minor-mode 'gdbmi)))
+ (define-key menu [gdb-restore-windows]
+ '(menu-item "Restore Initial Layout" gdb-restore-windows
+ :help "Restore the initial GDB window layout."))
+ ;; Window layout vs window configuration: We use "window layout" in
+ ;; GDB UI. Internally we refer to "window configuration" because
+ ;; that's the data structure used to store window layouts. Though
+ ;; bare in mind that there is a small difference between what we
+ ;; store and what normal window configuration functions
+ ;; output. Because GDB buffers (source, local, breakpoint, etc) are
+ ;; different between each debugging sessions, simply save/load
+ ;; window configurations doesn't
+ ;; work. `gdb-save-window-configuration' and
+ ;; `gdb-load-window-configuration' do some tricks to store and
+ ;; recreate each buffer in the layout.
+ (define-key menu [load-layout] '("Load Layout" "Load GDB window configuration (layout) from a file" . gdb-load-window-configuration))
+ (define-key menu [save-layout] '("Save Layout" "Save current GDB window configuration (layout) to a file" . gdb-save-window-configuration))
+ (define-key menu [restore-layout-after-quit]
+ '(menu-item "Restore Layout After Quit" gdb-toggle-restore-window-configuration
+ :button (:toggle . gdb-restore-window-configuration-after-quit)
+ :help "Toggle between always restore the window configuration (layout) after GDB quits and never restore.\n You can also change this setting in Customize to conditionally restore."))
(define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
(define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
(define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
@@ -4502,9 +4642,6 @@ SPLIT-HORIZONTAL and show BUF in the new window."
'(menu-item "Display Other Windows" gdb-many-windows
:help "Toggle display of locals, stack and breakpoint information"
:button (:toggle . gdb-many-windows)))
- (define-key menu [gdb-restore-windows]
- '(menu-item "Restore Window Layout" gdb-restore-windows
- :help "Restore standard layout for debug session."))
(define-key menu [sep1]
'(menu-item "--"))
(define-key menu [all-threads]
@@ -4529,11 +4666,11 @@ SPLIT-HORIZONTAL and show BUF in the new window."
(interactive)
(customize-option 'gdb-switch-reasons))))
(define-key menu [gdb-switch-when-another-stopped]
- (menu-bar-make-toggle gdb-toggle-switch-when-another-stopped
- gdb-switch-when-another-stopped
- "Automatically switch to stopped thread"
- "GDB thread switching %s"
- "Switch to stopped thread"))
+ (menu-bar-make-toggle-command
+ gdb-toggle-switch-when-another-stopped
+ gdb-switch-when-another-stopped
+ "Automatically switch to stopped thread"
+ "GDB thread switching %s" "Switch to stopped thread"))
(define-key gud-menu-map [mi]
`(menu-item "GDB-MI" ,menu :visible (eq gud-minor-mode 'gdbmi))))
@@ -4579,41 +4716,173 @@ window is dedicated."
(set-window-buffer window (get-buffer name))
(set-window-dedicated-p window t))
+(defun gdb-toggle-restore-window-configuration ()
+ "Toggle whether to restore window configuration when GDB quits."
+ (interactive)
+ (setq gdb-restore-window-configuration-after-quit
+ (not gdb-restore-window-configuration-after-quit)))
+
+(defun gdb-get-source-buffer ()
+ "Return a buffer displaying source file or nil if we can't find one.
+The source file is the file that contains the source location
+where GDB stops. There could be multiple source files during a
+debugging session, we get the most recently showed one. If
+program hasn't started running yet, the source file is the \"main
+file\" where the GDB session starts (see `gdb-main-file')."
+ (if gud-last-last-frame
+ (gud-find-file (car gud-last-last-frame))
+ (when gdb-main-file
+ (gud-find-file gdb-main-file))))
+
(defun gdb-setup-windows ()
- "Layout the window pattern for option `gdb-many-windows'."
- (gdb-get-buffer-create 'gdb-locals-buffer)
- (gdb-get-buffer-create 'gdb-stack-buffer)
- (gdb-get-buffer-create 'gdb-breakpoints-buffer)
- (set-window-dedicated-p (selected-window) nil)
- (switch-to-buffer gud-comint-buffer)
- (delete-other-windows)
- (let ((win0 (selected-window))
- (win1 (split-window nil ( / ( * (window-height) 3) 4)))
- (win2 (split-window nil ( / (window-height) 3)))
- (win3 (split-window-right)))
- (gdb-set-window-buffer (gdb-locals-buffer-name) nil win3)
- (select-window win2)
- (set-window-buffer
- win2
- (if gud-last-last-frame
- (gud-find-file (car gud-last-last-frame))
- (if gdb-main-file
- (gud-find-file gdb-main-file)
- ;; Put buffer list in window if we
- ;; can't find a source file.
- (list-buffers-noselect))))
- (setq gdb-source-window (selected-window))
- (let ((win4 (split-window-right)))
- (gdb-set-window-buffer
- (gdb-get-buffer-create 'gdb-inferior-io) nil win4))
- (select-window win1)
- (gdb-set-window-buffer (gdb-stack-buffer-name))
- (let ((win5 (split-window-right)))
- (gdb-set-window-buffer (if gdb-show-threads-by-default
- (gdb-threads-buffer-name)
- (gdb-breakpoints-buffer-name))
- nil win5))
- (select-window win0)))
+ "Lay out the window pattern for option `gdb-many-windows'."
+ (if gdb-default-window-configuration-file
+ (gdb-load-window-configuration
+ (if (file-name-absolute-p gdb-default-window-configuration-file)
+ gdb-default-window-configuration-file
+ (expand-file-name gdb-default-window-configuration-file
+ gdb-window-configuration-directory)))
+ ;; Create default layout as before.
+ (gdb-get-buffer-create 'gdb-locals-buffer)
+ (gdb-get-buffer-create 'gdb-stack-buffer)
+ (gdb-get-buffer-create 'gdb-breakpoints-buffer)
+ (set-window-dedicated-p (selected-window) nil)
+ (switch-to-buffer gud-comint-buffer)
+ (delete-other-windows)
+ (let ((win0 (selected-window))
+ (win1 (split-window nil ( / ( * (window-height) 3) 4)))
+ (win2 (split-window nil ( / (window-height) 3)))
+ (win3 (split-window-right)))
+ (gdb-set-window-buffer (gdb-locals-buffer-name) nil win3)
+ (select-window win2)
+ (set-window-buffer win2 (or (gdb-get-source-buffer)
+ (list-buffers-noselect)))
+ (setq gdb-source-window-list (list (selected-window)))
+ (let ((win4 (split-window-right)))
+ (gdb-set-window-buffer
+ (gdb-get-buffer-create 'gdb-inferior-io) nil win4))
+ (select-window win1)
+ (gdb-set-window-buffer (gdb-stack-buffer-name))
+ (let ((win5 (split-window-right)))
+ (gdb-set-window-buffer (if gdb-show-threads-by-default
+ (gdb-threads-buffer-name)
+ (gdb-breakpoints-buffer-name))
+ nil win5))
+ (select-window win0))))
+
+(defun gdb-buffer-p (buffer)
+ "Return t if BUFFER is GDB-related."
+ (with-current-buffer buffer
+ (eq gud-minor-mode 'gdbmi)))
+
+(defun gdb-function-buffer-p (buffer)
+ "Return t if BUFFER is a GDB function buffer.
+
+Function buffers are locals buffer, registers buffer, etc, but
+not including main command buffer (the one where you type GDB
+commands) or source buffers (that display program source code)."
+ (with-current-buffer buffer
+ (derived-mode-p 'gdb-parent-mode 'gdb-inferior-io-mode)))
+
+(defun gdb--buffer-type (buffer)
+ "Return the type of BUFFER if it is a function buffer.
+Buffer type is like `gdb-registers-type', `gdb-stack-buffer'.
+These symbols are used by `gdb-get-buffer-create'.
+
+Return nil if BUFFER is not a GDB function buffer."
+ (with-current-buffer buffer
+ (cl-loop for rule in gdb-buffer-rules
+ for mode-name = (gdb-rules-buffer-mode rule)
+ for type = (car rule)
+ if (eq mode-name major-mode)
+ return type
+ finally return nil)))
+
+(defun gdb-save-window-configuration (file)
+ "Save current window configuration (layout) to FILE.
+You can later restore this configuration from that file by
+`gdb-load-window-configuration'."
+ (interactive (list (read-file-name
+ "Save window configuration to file: "
+ (or gdb-window-configuration-directory
+ default-directory))))
+ ;; We replace the buffer in each window with a placeholder, store
+ ;; the buffer type (register, breakpoint, etc) in window parameters,
+ ;; and write the window configuration to the file.
+ (save-window-excursion
+ (let ((placeholder (get-buffer-create " *gdb-placeholder*"))
+ (window-persistent-parameters
+ (cons '(gdb-buffer-type . writable) window-persistent-parameters)))
+ (unwind-protect
+ (dolist (win (window-list nil 'no-minibuffer))
+ (select-window win)
+ (when (gdb-buffer-p (current-buffer))
+ (set-window-parameter
+ nil 'gdb-buffer-type
+ (cond ((gdb-function-buffer-p (current-buffer))
+ ;; 1) If a user arranged the window
+ ;; configuration herself and saves it, windows
+ ;; are probably not dedicated. 2) We use the
+ ;; same dedication flag as in
+ ;; `gdb-display-buffer'.
+ (set-window-dedicated-p nil t)
+ ;; We save this gdb-buffer-type symbol so
+ ;; we can later pass it to `gdb-get-buffer-create';
+ ;; one example: `gdb-registers-buffer'.
+ (or (gdb--buffer-type (current-buffer))
+ (error "Unrecognized gdb buffer mode: %s" major-mode)))
+ ;; Command buffer.
+ ((derived-mode-p 'gud-mode) 'command)
+ ;; Consider everything else as source buffer.
+ (t 'source)))
+ (with-window-non-dedicated nil
+ (set-window-buffer nil placeholder)
+ (set-window-prev-buffers (selected-window) nil)
+ (set-window-next-buffers (selected-window) nil))))
+ ;; Save the window configuration to FILE.
+ (let ((window-config (window-state-get nil t)))
+ (with-temp-buffer
+ (prin1 window-config (current-buffer))
+ (write-file file t)))
+ (kill-buffer placeholder)))))
+
+(defun gdb-load-window-configuration (file)
+ "Restore window configuration (layout) from FILE.
+FILE should be a window configuration file saved by
+`gdb-save-window-configuration'."
+ (interactive (list (read-file-name
+ "Restore window configuration from file: "
+ (or gdb-window-configuration-directory
+ default-directory))))
+ ;; Basically, we restore window configuration and go through each
+ ;; window and restore the function buffers.
+ (let* ((placeholder (get-buffer-create " *gdb-placeholder*")))
+ (unwind-protect ; Don't leak buffer.
+ (let ((window-config (with-temp-buffer
+ (insert-file-contents file)
+ ;; We need to go to point-min because
+ ;; `read' reads from point
+ (goto-char (point-min))
+ (read (current-buffer))))
+ (source-buffer (or (gdb-get-source-buffer)
+ ;; Do the same thing as in
+ ;; `gdb-setup-windows' if no source
+ ;; buffer is found.
+ (list-buffers-noselect)))
+ buffer-type)
+ (window-state-put window-config (frame-root-window))
+ (dolist (window (window-list nil 'no-minibuffer))
+ (with-selected-window window
+ (setq buffer-type (window-parameter nil 'gdb-buffer-type))
+ (pcase buffer-type
+ ('source (when source-buffer
+ (set-window-buffer nil source-buffer)
+ (push (selected-window) gdb-source-window-list)))
+ ('command (switch-to-buffer gud-comint-buffer))
+ (_ (let ((buffer (gdb-get-buffer-create buffer-type)))
+ (with-window-non-dedicated nil
+ (set-window-buffer nil buffer))))))))
+ (kill-buffer placeholder))))
(define-minor-mode gdb-many-windows
"If nil just pop up the GUD buffer unless `gdb-show-main' is t.
@@ -4631,7 +4900,12 @@ of the debugged program. Non-nil means display the layout shown for
(defun gdb-restore-windows ()
"Restore the basic arrangement of windows used by gdb.
-This arrangement depends on the value of option `gdb-many-windows'."
+This arrangement depends on the values of variable
+`gdb-many-windows' and `gdb-default-window-configuration-file'."
+ ;; This function is used when the user messed up window
+ ;; configuration and wants to "reset to default". The function that
+ ;; sets up window configuration on start up is
+ ;; `gdb-get-source-file'.
(interactive)
(switch-to-buffer gud-comint-buffer) ;Select the right window and frame.
(delete-other-windows)
@@ -4644,7 +4918,7 @@ This arrangement depends on the value of option `gdb-many-windows'."
(if gud-last-last-frame
(gud-find-file (car gud-last-last-frame))
(gud-find-file gdb-main-file)))
- (setq gdb-source-window win)))))
+ (setq gdb-source-window-list (list win))))))
;; Called from `gud-sentinel' in gud.el:
(defun gdb-reset ()
@@ -4678,11 +4952,25 @@ Kills the gdb buffers, and resets variables and the source buffers."
(if (boundp 'speedbar-frame) (speedbar-timer-fn))
(setq gud-running nil)
(setq gdb-active-process nil)
- (remove-hook 'after-save-hook 'gdb-create-define-alist t))
+ (remove-hook 'after-save-hook 'gdb-create-define-alist t)
+ ;; Recover window configuration.
+ (when (or (eq gdb-restore-window-configuration-after-quit t)
+ (and (eq gdb-restore-window-configuration-after-quit
+ 'if-gdb-show-main)
+ gdb-show-main)
+ (and (eq gdb-restore-window-configuration-after-quit
+ 'if-gdb-many-windows)
+ gdb-many-windows))
+ (when gdb--window-configuration-before
+ (window-state-put gdb--window-configuration-before)
+ ;; This way we don't accidentally restore an outdated window
+ ;; configuration.
+ (setq gdb--window-configuration-before nil))))
(defun gdb-get-source-file ()
"Find the source file where the program starts and display it with related
buffers, if required."
+ ;; This function is called only once on startup.
(goto-char (point-min))
(if (re-search-forward gdb-source-file-regexp nil t)
(setq gdb-main-file (read (match-string 1))))
diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el
index cad74f9f63a..ab65a1590c0 100644
--- a/lisp/progmodes/glasses.el
+++ b/lisp/progmodes/glasses.el
@@ -1,4 +1,4 @@
-;;; glasses.el --- make cantReadThis readable
+;;; glasses.el --- make cantReadThis readable -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -66,7 +66,6 @@ defined by `glasses-original-separator'. If you don't want to add missing
separators, set `glasses-separator' to an empty string. If you don't want to
replace existent separators, set `glasses-original-separator' to an empty
string."
- :group 'glasses
:type 'string
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -78,7 +77,6 @@ For instance, if you set it to \"_\" and set `glasses-separator' to \"-\",
underscore separators are displayed as hyphens.
If `glasses-original-separator' is an empty string, no such display change is
performed."
- :group 'glasses
:type 'string
:set 'glasses-custom-set
:initialize 'custom-initialize-default
@@ -92,7 +90,6 @@ If it is nil, no face is placed at the capitalized letter.
For example, you can set `glasses-separator' to an empty string and
`glasses-face' to `bold'. Then unreadable identifiers will have no separators,
but will have their capitals in bold."
- :group 'glasses
:type '(choice (const :tag "None" nil) face)
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -100,7 +97,6 @@ but will have their capitals in bold."
(defcustom glasses-separate-parentheses-p t
"If non-nil, ensure space between an identifier and an opening parenthesis."
- :group 'glasses
:type 'boolean)
(defcustom glasses-separate-parentheses-exceptions
@@ -108,7 +104,6 @@ but will have their capitals in bold."
"List of regexp that are exceptions for `glasses-separate-parentheses-p'.
They are matched to the current line truncated to the point where the
parenthesis expression starts."
- :group 'glasses
:type '(repeat regexp))
(defcustom glasses-separate-capital-groups t
@@ -116,7 +111,6 @@ parenthesis expression starts."
When the value is non-nil, HTMLSomething and IPv6 are displayed
as HTML_Something and I_Pv6 respectively. Set the value to nil
if you prefer to display them unchanged."
- :group 'glasses
:type 'boolean
:version "24.1")
@@ -124,7 +118,6 @@ if you prefer to display them unchanged."
"If non-nil, downcase embedded capital letters in identifiers.
Only identifiers starting with lower case letters are affected, letters inside
other identifiers are unchanged."
- :group 'glasses
:type 'boolean
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -135,7 +128,6 @@ other identifiers are unchanged."
Only words starting with this regexp are uncapitalized.
The regexp is case sensitive.
It has any effect only when `glasses-uncapitalize-p' is non-nil."
- :group 'glasses
:type 'regexp
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -149,7 +141,6 @@ file write then.
Note the removal action does not try to be much clever, so it can remove real
separators too."
- :group 'glasses
:type 'boolean)
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index d4aca28bd7c..279eb4d54b1 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -64,8 +64,7 @@ SYMBOL should be one of `grep-command', `grep-template',
"Number of lines in a grep window. If nil, use `compilation-window-height'."
:type '(choice (const :tag "Default" nil)
integer)
- :version "22.1"
- :group 'grep)
+ :version "22.1")
(defcustom grep-highlight-matches 'auto-detect
"Use special markers to highlight grep matches.
@@ -98,9 +97,15 @@ To change the default value, use \\[customize] or call the function
(const :tag "Use --color=always" always)
(const :tag "Use --color" auto)
(other :tag "Not Set" auto-detect))
- :set 'grep-apply-setting
- :version "22.1"
- :group 'grep)
+ :set #'grep-apply-setting
+ :version "22.1")
+
+(defcustom grep-match-regexp "\033\\[0?1;31m\\(.*?\\)\033\\[[0-9]*m"
+ "Regular expression matching grep markers to highlight.
+It matches SGR ANSI escape sequences which are emitted by grep to
+color its output. This variable is used in `grep-filter'."
+ :type 'regexp
+ :version "28.1")
(defcustom grep-scroll-output nil
"Non-nil to scroll the *grep* buffer window as output appears.
@@ -109,8 +114,7 @@ Setting it causes the grep commands to put point at the end of their
output window so that the end of the output is always visible rather
than the beginning."
:type 'boolean
- :version "22.1"
- :group 'grep)
+ :version "22.1")
;;;###autoload
(defcustom grep-command nil
@@ -124,8 +128,7 @@ by `grep-compute-defaults'; to change the default value, use
\\[customize] or call the function `grep-apply-setting'."
:type '(choice string
(const :tag "Not Set" nil))
- :set 'grep-apply-setting
- :group 'grep)
+ :set #'grep-apply-setting)
(defcustom grep-template nil
"The default command to run for \\[lgrep].
@@ -141,9 +144,8 @@ by `grep-compute-defaults'; to change the default value, use
\\[customize] or call the function `grep-apply-setting'."
:type '(choice string
(const :tag "Not Set" nil))
- :set 'grep-apply-setting
- :version "22.1"
- :group 'grep)
+ :set #'grep-apply-setting
+ :version "22.1")
(defcustom grep-use-null-device 'auto-detect
"If t, append the value of `null-device' to `grep' commands.
@@ -157,8 +159,7 @@ by `grep-compute-defaults'; to change the default value, use
:type '(choice (const :tag "Do Not Append Null Device" nil)
(const :tag "Append Null Device" t)
(other :tag "Not Set" auto-detect))
- :set 'grep-apply-setting
- :group 'grep)
+ :set #'grep-apply-setting)
(defcustom grep-use-null-filename-separator 'auto-detect
"If non-nil, use `grep's `--null' option.
@@ -167,19 +168,23 @@ This is done to disambiguate file names in `grep's output."
:type '(choice (const :tag "Do Not Use `--null'" nil)
(const :tag "Use `--null'" t)
(other :tag "Not Set" auto-detect))
- :set 'grep-apply-setting
- :group 'grep)
+ :set #'grep-apply-setting)
;;;###autoload
(defcustom grep-find-command nil
"The default find command for \\[grep-find].
In interactive usage, the actual value of this variable is set up
by `grep-compute-defaults'; to change the default value, use
-\\[customize] or call the function `grep-apply-setting'."
+\\[customize] or call the function `grep-apply-setting'.
+
+This variable can either be a string, or a cons of the
+form (COMMAND . POSITION). In the latter case, COMMAND will be
+used as the default command, and point will be placed at POSITION
+for easier editing."
:type '(choice string
+ (cons string integer)
(const :tag "Not Set" nil))
- :set 'grep-apply-setting
- :group 'grep)
+ :set #'grep-apply-setting)
(defcustom grep-find-template nil
"The default command to run for \\[rgrep].
@@ -194,9 +199,8 @@ by `grep-compute-defaults'; to change the default value, use
\\[customize] or call the function `grep-apply-setting'."
:type '(choice string
(const :tag "Not Set" nil))
- :set 'grep-apply-setting
- :version "22.1"
- :group 'grep)
+ :set #'grep-apply-setting
+ :version "22.1")
(defcustom grep-files-aliases
'(("all" . "* .[!.]* ..?*") ;; Don't match `..'. See bug#22577
@@ -213,8 +217,7 @@ by `grep-compute-defaults'; to change the default value, use
("texi" . "*.texi")
("asm" . "*.[sS]"))
"Alist of aliases for the FILES argument to `lgrep' and `rgrep'."
- :type 'alist
- :group 'grep)
+ :type 'alist)
(defcustom grep-find-ignored-directories vc-directory-exclusion-list
"List of names of sub-directories which `rgrep' shall not recurse into.
@@ -223,8 +226,7 @@ to determine whether cdr should not be recursed into.
The default value is inherited from `vc-directory-exclusion-list'."
:type '(choice (repeat :tag "Ignored directories" string)
- (const :tag "No ignored directories" nil))
- :group 'grep)
+ (const :tag "No ignored directories" nil)))
(defcustom grep-find-ignored-files
(cons ".#*" (delq nil (mapcar (lambda (s)
@@ -235,8 +237,7 @@ The default value is inherited from `vc-directory-exclusion-list'."
If an element is a cons cell, the car is called on the search directory
to determine whether cdr should not be excluded."
:type '(choice (repeat :tag "Ignored file" string)
- (const :tag "No ignored files" nil))
- :group 'grep)
+ (const :tag "No ignored files" nil)))
(defcustom grep-save-buffers 'ask
"If non-nil, save buffers before running the grep commands.
@@ -251,22 +252,19 @@ to limit saving to files located under `my-grep-root'."
(const :tag "Ask before saving" ask)
(const :tag "Don't save buffers" nil)
function
- (other :tag "Save all buffers" t))
- :group 'grep)
+ (other :tag "Save all buffers" t)))
(defcustom grep-error-screen-columns nil
"If non-nil, column numbers in grep hits are screen columns.
See `compilation-error-screen-columns'."
:type '(choice (const :tag "Default" nil)
integer)
- :version "22.1"
- :group 'grep)
+ :version "22.1")
;;;###autoload
(defcustom grep-setup-hook nil
"List of hook functions run by `grep-process-setup' (see `run-hooks')."
- :type 'hook
- :group 'grep)
+ :type 'hook)
(defvar grep-mode-map
(let ((map (make-sparse-keymap)))
@@ -333,7 +331,10 @@ See `compilation-error-screen-columns'."
;; When bootstrapping, tool-bar-map is not properly initialized yet,
;; so don't do anything.
(when (keymapp (butlast tool-bar-map))
+ ;; We have to `copy-keymap' rather than use keymap inheritance because
+ ;; we want to put the new items at the *end* of the tool-bar.
(let ((map (butlast (copy-keymap tool-bar-map)))
+ ;; FIXME: Nowadays the last button is not "help" but "search"!
(help (last tool-bar-map))) ;; Keep Help last in tool bar
(tool-bar-local-item
"left-arrow" 'previous-error-no-select 'previous-error-no-select map
@@ -439,15 +440,13 @@ and reveals the entire command line. The visibility of the
abbreviated part can also be toggled with
`grep-find-toggle-abbreviation'."
:type 'boolean
- :version "27.1"
- :group 'grep)
+ :version "27.1")
(defcustom grep-search-path '(nil)
"List of directories to search for files named in grep messages.
Elements should be directory names, not file names of
directories. The value nil as an element means the grep messages
buffer `default-directory'."
- :group 'grep
:version "27.1"
:type '(repeat (choice (const :tag "Default" nil)
(string :tag "Directory"))))
@@ -528,9 +527,8 @@ This variable's value takes effect when `grep-compute-defaults' is called."
(const :tag "find -print0 | sort -z | xargs -0'" gnu-sort)
string
(const :tag "Not Set" nil))
- :set 'grep-apply-setting
- :version "27.1"
- :group 'grep)
+ :set #'grep-apply-setting
+ :version "27.1")
;; History of grep commands.
;;;###autoload
@@ -562,7 +560,7 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
(setenv "GREP_COLORS" "mt=01;31:fn=:ln=:bn=:se=:sl=:cx=:ne"))
(setq-local grep-num-matches-found 0)
(set (make-local-variable 'compilation-exit-message-function)
- 'grep-exit-message)
+ #'grep-exit-message)
(run-hooks 'grep-setup-hook))
(defun grep-exit-message (status code msg)
@@ -599,7 +597,7 @@ This function is called from `compilation-filter-hook'."
(when (< (point) end)
(setq end (copy-marker end))
;; Highlight grep matches and delete marking sequences.
- (while (re-search-forward "\033\\[0?1;31m\\(.*?\\)\033\\[[0-9]*m" end 1)
+ (while (re-search-forward grep-match-regexp end 1)
(replace-match (propertize (match-string 1)
'face nil 'font-lock-face grep-match-face)
t t)
@@ -612,7 +610,7 @@ This function is called from `compilation-filter-hook'."
(defun grep-probe (command args &optional func result)
(let (process-file-side-effects)
(equal (condition-case nil
- (apply (or func 'process-file) command args)
+ (apply (or func #'process-file) command args)
(error nil))
(or result 0))))
@@ -808,7 +806,7 @@ The value depends on `grep-command', `grep-template',
(buffer-substring-no-properties (point) (mark)))
(funcall (or find-tag-default-function
(get major-mode 'find-tag-default-function)
- 'find-tag-default))
+ #'find-tag-default))
""))
(defun grep-default-command ()
@@ -863,11 +861,11 @@ The value depends on `grep-command', `grep-template',
(set (make-local-variable 'compilation-directory-matcher)
(list regexp-unmatchable))
(set (make-local-variable 'compilation-process-setup-function)
- 'grep-process-setup)
+ #'grep-process-setup)
(set (make-local-variable 'compilation-disable-input) t)
(set (make-local-variable 'compilation-error-screen-columns)
grep-error-screen-columns)
- (add-hook 'compilation-filter-hook 'grep-filter nil t))
+ (add-hook 'compilation-filter-hook #'grep-filter nil t))
(defun grep--save-buffers ()
(when grep-save-buffers
@@ -914,7 +912,7 @@ list is empty)."
(compilation-start (if (and grep-use-null-device null-device)
(concat command-args " " null-device)
command-args)
- 'grep-mode))
+ #'grep-mode))
;;;###autoload
@@ -993,23 +991,31 @@ these include `opts', `dir', `files', `null-device', `excl' and
"Read regexp arg for interactive grep using `read-regexp'."
(read-regexp "Search for" 'grep-tag-default 'grep-regexp-history))
+(defvar grep-read-files-function #'grep-read-files--default)
+
+(defun grep-read-files--default ()
+ ;; Instead of a `grep-read-files-function' variable, we used to lookup
+ ;; mode-specific functions in the major mode's symbol properties, so preserve
+ ;; this behavior for backward compatibility.
+ (let ((old-function (get major-mode 'grep-read-files))) ;Obsolete since 28.1
+ (if old-function
+ (funcall old-function)
+ (let ((file-name-at-point
+ (run-hook-with-args-until-success 'file-name-at-point-functions)))
+ (or (if (and (stringp file-name-at-point)
+ (not (file-directory-p file-name-at-point)))
+ file-name-at-point)
+ (buffer-file-name)
+ (replace-regexp-in-string "<[0-9]+>\\'" "" (buffer-name)))))))
+
(defun grep-read-files (regexp)
"Read a file-name pattern arg for interactive grep.
-The pattern can include shell wildcards. As whitespace triggers
+The pattern can include shell wildcards. As SPC can triggers
completion when entering a pattern, including it requires
quoting, e.g. `\\[quoted-insert]<space>'.
REGEXP is used as a string in the prompt."
- (let* ((grep-read-files-function (get major-mode 'grep-read-files))
- (file-name-at-point
- (run-hook-with-args-until-success 'file-name-at-point-functions))
- (bn (if grep-read-files-function
- (funcall grep-read-files-function)
- (or (if (and (stringp file-name-at-point)
- (not (file-directory-p file-name-at-point)))
- file-name-at-point)
- (buffer-file-name)
- (replace-regexp-in-string "<[0-9]+>\\'" "" (buffer-name)))))
+ (let* ((bn (funcall grep-read-files-function))
(fn (and bn
(stringp bn)
(file-name-nondirectory bn)))
@@ -1022,7 +1028,7 @@ REGEXP is used as a string in the prompt."
(setq alias (car aliases)
aliases (cdr aliases))
(if (string-match (mapconcat
- 'wildcard-to-regexp
+ #'wildcard-to-regexp
(split-string (cdr alias) nil t)
"\\|")
fn)
@@ -1043,11 +1049,11 @@ REGEXP is used as a string in the prompt."
"\" in files matching wildcard"
(if default (concat " (default " default ")"))
": ")
- 'read-file-name-internal
+ #'read-file-name-internal
nil nil nil 'grep-files-history
(delete-dups
(delq nil (append (list default default-alias default-extension)
- (mapcar 'car grep-files-aliases)))))))
+ (mapcar #'car grep-files-aliases)))))))
(and files
(or (cdr (assoc files grep-files-aliases))
files))))
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 540bc9ce7f3..81021bc64f4 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -486,9 +486,8 @@ The value t means that there is no stack, and we are in display-file mode.")
"Additional menu items to add to the speedbar frame.")
;; Make sure our special speedbar mode is loaded
-(if (featurep 'speedbar)
- (gud-install-speedbar-variables)
- (add-hook 'speedbar-load-hook 'gud-install-speedbar-variables))
+(with-eval-after-load 'speedbar
+ (gud-install-speedbar-variables))
(defun gud-expansion-speedbar-buttons (_directory _zero)
"Wrapper for call to `speedbar-add-expansion-list'.
@@ -1846,7 +1845,7 @@ and source-file directory for your debugger."
;; JDB command will get out of the debugger. There is some truly
;; pathetic JDB documentation available at:
;;
-;; http://java.sun.com/products/jdk/1.1/debugging/
+;; https://java.sun.com/products/jdk/1.1/debugging/
;;
;; KNOWN PROBLEMS AND FIXME's:
;;
@@ -2359,17 +2358,17 @@ during jdb initialization depending on the value of
(if (< n gud-jdb-lowest-stack-level)
(progn (setq gud-jdb-lowest-stack-level n) t)))
t)
- (if (setq file-found
- (gud-jdb-find-source (match-string 2 gud-marker-acc)))
- (setq gud-last-frame
- (cons file-found
- (string-to-number
- (let
- ((numstr (match-string 4 gud-marker-acc)))
- (if (string-match "[.,]" numstr)
- (replace-match "" nil nil numstr)
- numstr)))))
- (message "Could not find source file.")))
+ (let ((class (match-string 2 gud-marker-acc)))
+ (if (setq file-found (gud-jdb-find-source class))
+ (setq gud-last-frame
+ (cons file-found
+ (string-to-number
+ (let
+ ((numstr (match-string 4 gud-marker-acc)))
+ (if (string-match "[.,]" numstr)
+ (replace-match "" nil nil numstr)
+ numstr)))))
+ (message "Could not find source file for %s" class))))
;; Set the accumulator to the remaining text.
(setq gud-marker-acc (substring gud-marker-acc (match-end 0))))
@@ -2827,9 +2826,13 @@ Obeying it means displaying in another window the specified file and line."
(buffer
(with-current-buffer gud-comint-buffer
(gud-find-file true-file)))
- (window (and buffer
- (or (get-buffer-window buffer)
- (display-buffer buffer '(nil (inhibit-same-window . t))))))
+ (window
+ (when buffer
+ (if (eq gud-minor-mode 'gdbmi)
+ (gdb-display-source-buffer buffer)
+ ;; Gud still has the old behavior.
+ (or (get-buffer-window buffer)
+ (display-buffer buffer '(nil (inhibit-same-window . t)))))))
(pos))
(when buffer
(with-current-buffer buffer
@@ -2859,9 +2862,7 @@ Obeying it means displaying in another window the specified file and line."
(widen)
(goto-char pos))))
(when window
- (set-window-point window gud-overlay-arrow-position)
- (if (eq gud-minor-mode 'gdbmi)
- (setq gdb-source-window window))))))
+ (set-window-point window gud-overlay-arrow-position)))))
;; The gud-call function must do the right thing whether its invoking
;; keystroke is from the GUD buffer itself (via major-mode binding)
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index f5af277dc5e..25e75235aa4 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -162,7 +162,7 @@ This behavior is generally undesirable. If this option is non-nil, the outermos
"\\.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."
- :type 'string
+ :type 'regexp
:version "25.1")
(defvar hide-ifdef-mode-submap
@@ -301,7 +301,7 @@ Several variables affect how the hiding is done:
;; `hide-ifdef-env' is now a global variable.
;; We can still simulate the behavior of older hideif versions (i.e.
;; `hide-ifdef-env' being buffer local) by clearing this variable
- ;; (C-c @ C) everytime before hiding current buffer.
+ ;; (C-c @ C) every time before hiding current buffer.
;; (set (make-local-variable 'hide-ifdef-env)
;; (default-value 'hide-ifdef-env))
(set 'hide-ifdef-env (default-value 'hide-ifdef-env))
@@ -1490,7 +1490,7 @@ Refer to `hide-ifdef-expand-reinclusion-protection' for more details."
(test (hif-canonicalize hif-ifx-regexp))
(range (hif-find-range))
(elifs (hif-range-elif range))
- (if-part t) ; Everytime we start from if-part
+ (if-part t) ; Every time we start from if-part
(complete nil))
;; (message "test = %s" test) (sit-for 1)
@@ -1650,7 +1650,7 @@ first arg will be `hif-etc'."
;; postponed the evaluation process one stage and store the "parsed tree"
;; into symbol database. The evaluation process was then "strings -> tokens
;; -> [parsed tree] -> value". Hideif therefore run slower since it need to
-;; evaluate the parsed tree everytime when trying to expand the symbol. These
+;; evaluate the parsed tree every time when trying to expand the symbol. These
;; temporarily code changes are obsolete and not in Emacs source repository.
;;
;; Furthermore, CPP did allow partial expression to be defined in several
@@ -1659,7 +1659,7 @@ first arg will be `hif-etc'."
;; further, otherwise those partial expression will be fail on parsing and
;; we'll miss all macros that reference it. The evaluation process thus
;; became "strings -> [tokens] -> parsed tree -> value." This degraded the
-;; performance since we need to parse tokens and evaluate them everytime
+;; performance since we need to parse tokens and evaluate them every time
;; when that symbol is referenced.
;;
;; In real cases I found a lot portion of macros are "simple macros" that
diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el
index b0542a99da8..3bc3971f5ee 100644
--- a/lisp/progmodes/idlw-complete-structtag.el
+++ b/lisp/progmodes/idlw-complete-structtag.el
@@ -49,7 +49,7 @@
;;
;; New versions of IDLWAVE, documentation, and more information available
;; from:
-;; http://github.com/jdtsmith/idlwave
+;; https://github.com/jdtsmith/idlwave
;;
;; INSTALLATION
;; ============
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index 69385d7060f..2d4ea465c42 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -32,7 +32,7 @@
;; along with new versions of IDLWAVE, documentation, and more
;; information, at:
;;
-;; http://github.com/jdtsmith/idlwave
+;; https://github.com/jdtsmith/idlwave
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -182,14 +182,14 @@ definition is displayed instead."
which specifies the `name' section. Can be used for localization
support."
:group 'idlwave-online-help
- :type 'string)
+ :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 'string)
+ :type 'regexp)
(defface idlwave-help-link
'((t :inherit link))
@@ -267,7 +267,6 @@ support."
(declare-function idlwave-find-class-definition "idlwave")
(declare-function idlwave-find-inherited-class "idlwave")
(declare-function idlwave-find-struct-tag "idlwave")
-(declare-function idlwave-get-buffer-visiting "idlwave")
(declare-function idlwave-in-quote "idlwave")
(declare-function idlwave-make-full-name "idlwave")
(declare-function idlwave-members-only "idlwave")
@@ -880,7 +879,7 @@ This function can be used as `idlwave-extra-help-function'."
(setq in-buf ; structure-tag completion is always in current buffer
(if struct-tag
idlwave-current-tags-buffer
- (idlwave-get-buffer-visiting file)))
+ (find-buffer-visiting file)))
;; see if file is in a visited buffer, insert those contents
(if in-buf
(progn
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index dba70cb2821..38127fccbc3 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -40,7 +40,7 @@
;;
;; New versions of IDLWAVE, documentation, and more information
;; available from:
-;; http://github.com/jdtsmith/idlwave
+;; https://github.com/jdtsmith/idlwave
;;
;; INSTALLATION:
;; =============
@@ -58,7 +58,7 @@
;; The newest version of this file can be found on the maintainers
;; web site.
;;
-;; http://github.com/jdtsmith/idlwave
+;; https://github.com/jdtsmith/idlwave
;;
;; DOCUMENTATION
;; =============
@@ -896,7 +896,7 @@ IDL has currently stepped.")
Info documentation for this package is available. Use \\[idlwave-info]
to display (complain to your sysadmin if that does not work).
For PostScript and HTML versions of the documentation, check IDLWAVE's
- homepage at URL `http://github.com/jdtsmith/idlwave'.
+ homepage at URL `https://github.com/jdtsmith/idlwave'.
IDLWAVE has customize support - see the group `idlwave'.
8. Keybindings
@@ -1598,7 +1598,7 @@ number.")
"A regular expression to match any IDL error.")
(defvar idlwave-shell-halting-error
- "^% .*\n\\([^%].*\n\\)*% Execution halted at:\\(\\s-*\\S-+\\s-*[0-9]+\\s-*.*\\)\n"
+ "^% .*\n\\([^%].*\n\\)*% Execution halted at:\\(\\s-*\\S-+\\s-*[0-9]+.*\\)\n"
"A regular expression to match errors which halt execution.")
(defvar idlwave-shell-cant-continue-error
@@ -2640,7 +2640,7 @@ Assumes that `idlwave-shell-sources-alist' contains an entry for that module."
(if (or (not source-file)
(not (file-regular-p source-file))
(not (setq buf
- (or (idlwave-get-buffer-visiting source-file)
+ (or (find-buffer-visiting source-file)
(find-file-noselect source-file)))))
(progn
(message "The source file for module %s is probably not compiled"
@@ -2745,7 +2745,7 @@ Runs to the last statement and then steps 1 statement. Use the .out command."
;; event. mouse-drag-track does so.
(if drag-track 'mouse-drag-track 'mouse-drag-region)))
(funcall tracker event)
- (idlwave-shell-print (if (idlwave-region-active-p) '(4) nil)
+ (idlwave-shell-print (if (region-active-p) '(4) nil)
,help ,ev))))
;; Begin terrible hack section -- XEmacs tests for button2 explicitly
@@ -2830,7 +2830,7 @@ from `idlwave-shell-examine-alist' via mini-buffer shortcut key."
(cond
((equal arg '(16))
(setq expr (read-string "Expression: ")))
- ((and (or arg (idlwave-region-active-p))
+ ((and (or arg (region-active-p))
(< (- (region-end) (region-beginning)) 2000))
(setq beg (region-beginning)
end (region-end)))
@@ -3241,8 +3241,7 @@ Does not work for a region with multiline blocks - use
"Delete the temporary files and kill associated buffers."
(if (stringp idlwave-shell-temp-pro-file)
(condition-case nil
- (let ((buf (idlwave-get-buffer-visiting
- idlwave-shell-temp-pro-file)))
+ (let ((buf (find-buffer-visiting idlwave-shell-temp-pro-file)))
(if (buffer-live-p buf)
(kill-buffer buf))
(delete-file idlwave-shell-temp-pro-file))
@@ -3788,7 +3787,7 @@ handled by this command."
(save-buffer)
(setq idlwave-shell-last-save-and-action-file (buffer-file-name)))
(idlwave-shell-last-save-and-action-file
- (if (setq buf (idlwave-get-buffer-visiting
+ (if (setq buf (find-buffer-visiting
idlwave-shell-last-save-and-action-file))
(with-current-buffer buf
(save-buffer))))
diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el
index 23c129c1afc..1866e50d680 100644
--- a/lisp/progmodes/idlw-toolbar.el
+++ b/lisp/progmodes/idlw-toolbar.el
@@ -29,7 +29,7 @@
;; New versions of IDLWAVE, documentation, and more information
;; available from:
-;; http://github.com/jdtsmith/idlwave
+;; https://github.com/jdtsmith/idlwave
;;; Code:
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 2601c2e1653..86f9f336723 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -44,7 +44,7 @@
;;
;; New versions of IDLWAVE, documentation, and more information
;; available from:
-;; http://github.com/jdtsmith/idlwave
+;; https://github.com/jdtsmith/idlwave
;;
;; INSTALLATION
;; ============
@@ -64,7 +64,7 @@
;; The newest version of this file is available from the maintainer's
;; Webpage:
;;
-;; http://github.com/jdtsmith/idlwave
+;; https://github.com/jdtsmith/idlwave
;;
;; DOCUMENTATION
;; =============
@@ -154,21 +154,6 @@
(eval-when-compile (require 'cl-lib))
(require 'idlw-help)
-;; For XEmacs
-(unless (fboundp 'line-beginning-position)
- (defalias 'line-beginning-position 'point-at-bol))
-(unless (fboundp 'line-end-position)
- (defalias 'line-end-position 'point-at-eol))
-(unless (fboundp 'char-valid-p)
- (defalias 'char-valid-p 'characterp))
-(unless (fboundp 'match-string-no-properties)
- (defalias 'match-string-no-properties 'match-string))
-
-(if (not (fboundp 'cancel-timer))
- (condition-case nil
- (require 'timer)
- (error nil)))
-
(declare-function idlwave-shell-get-path-info "idlw-shell")
(declare-function idlwave-shell-temp-file "idlw-shell")
(declare-function idlwave-shell-is-running "idlw-shell")
@@ -179,7 +164,7 @@
"Major mode for editing IDL .pro files."
:tag "IDLWAVE"
:link '(url-link :tag "Home Page"
- "http://github.com/jdtsmith/idlwave")
+ "https://github.com/jdtsmith/idlwave")
:link '(emacs-commentary-link :tag "Commentary in idlw-shell.el"
"idlw-shell.el")
:link '(emacs-commentary-link :tag "Commentary in idlwave.el" "idlwave.el")
@@ -314,7 +299,7 @@ split then a terminal beep and warning are issued."
expression will not be changed. Note that the indentation of a comment
at the beginning of a line is never changed."
:group 'idlwave-code-formatting
- :type 'string)
+ :type 'regexp)
(defcustom idlwave-begin-line-comment nil
"A comment anchored at the beginning of line.
@@ -596,12 +581,7 @@ like this:
MyMethod <Class1,Class2,Class3>
The value of this variable may be nil to inhibit display, or an integer to
-indicate the maximum number of classes to display.
-
-On XEmacs, a full list of classes will also be placed into a `help-echo'
-property on the completion items, so that the list of classes for the current
-item is displayed in the echo area. If the value of this variable is a
-negative integer, the `help-echo' property will be suppressed."
+indicate the maximum number of classes to display."
:group 'idlwave-completion
:type '(choice (const :tag "Don't show" nil)
(integer :tag "Number of classes shown" 1)))
@@ -1069,7 +1049,6 @@ goto Goto Statements
common-blocks Common Blocks
keyword-parameters Keyword Parameters in routine definitions and calls
system-variables System Variables
-fixme FIXME: Warning in comments (on XEmacs only v. 21.0 and up)
class-arrows Object Arrows with class property"
:group 'idlwave-misc
:type '(set
@@ -1084,7 +1063,6 @@ class-arrows Object Arrows with class property"
(const :tag "Common Blocks" common-blocks)
(const :tag "Keyword Parameters" keyword-parameters)
(const :tag "System Variables" system-variables)
- (const :tag "FIXME: Warning" fixme)
(const :tag "Object Arrows with class property " class-arrows)))
(defcustom idlwave-mode-hook nil
@@ -1096,6 +1074,8 @@ class-arrows Object Arrows with class property"
"Normal hook. Executed when idlwave.el is loaded."
:group 'idlwave-misc
:type 'hook)
+(make-obsolete-variable 'idlwave-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defvar idlwave-experimental nil
"Non-nil means turn on a few experimental features.
@@ -1151,23 +1131,16 @@ As a user, you should not set this to t.")
;; Common blocks
(common-blocks
'("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?"
- (1 font-lock-keyword-face) ; "common"
- (2 font-lock-constant-face nil t) ; block name
+ (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
- (goto-char (match-end 0)) ; needed for XEmacs, could be nil
- nil
- (1 font-lock-variable-name-face) ; variable names
- )))
+ nil nil (1 font-lock-variable-name-face)))) ; variable names
;; Batch files
(batch-files
'("^[ \t]*\\(@[^ \t\n]+\\)" (1 font-lock-string-face)))
- ;; FIXME warning.
- (fixme
- '("\\<FIXME:" (0 font-lock-warning-face t)))
-
;; Labels
(label
'("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-constant-face)))
@@ -1254,9 +1227,6 @@ As a user, you should not set this to t.")
((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w"))
beginning-of-line))
-(put 'idlwave-mode 'font-lock-defaults
- idlwave-font-lock-defaults) ; XEmacs
-
(defconst idlwave-comment-line-start-skip "^[ \t]*;"
"Regexp to match the start of a full-line comment.
That is the _beginning_ of a line containing a comment delimiter `;' preceded
@@ -1492,9 +1462,7 @@ Otherwise ARGS forms a list that is evaluated."
(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
- (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)])
- 'idlwave-mouse-context-help)
+ (define-key map [(shift mouse-3)] 'idlwave-mouse-context-help)
map)
"Keymap used in IDL mode.")
@@ -1870,7 +1838,6 @@ The main features of this mode are
8. Hooks
-----
- Loading idlwave.el runs `idlwave-load-hook'.
Turning on `idlwave-mode' runs `idlwave-mode-hook'.
9. Documentation and Customization
@@ -1879,7 +1846,7 @@ The main features of this mode are
\\[idlwave-info] to display (complain to your sysadmin if that does
not work). For Postscript, PDF, and HTML versions of the
documentation, check IDLWAVE's homepage at URL
- `http://github.com/jdtsmith/idlwave'.
+ `https://github.com/jdtsmith/idlwave'.
IDLWAVE has customize support - see the group `idlwave'.
10.Keybindings
@@ -1930,8 +1897,6 @@ The main features of this mode are
(add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS")))
;; Font-lock additions
- ;; Following line is for Emacs - XEmacs uses the corresponding property
- ;; on the `idlwave-mode' symbol.
(set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults)
(set (make-local-variable 'font-lock-mark-block-function)
'idlwave-mark-subprogram)
@@ -2091,11 +2056,7 @@ Returns point if comment found and nil otherwise."
(backward-char 1)
(point)))))
-(defun idlwave-region-active-p ()
- "Should we operate on an active region?"
- (if (fboundp 'use-region-p)
- (use-region-p)
- (region-active-p)))
+(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."
@@ -3832,15 +3793,8 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(setq start (match-end 0)))
(setq ret_string (concat ret_string (substring string start last)))))
-(defun idlwave-get-buffer-visiting (file)
- ;; Return the buffer currently 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 (idlwave-get-buffer-visiting)"))))
+(define-obsolete-function-alias 'idlwave-get-buffer-visiting
+ #'find-buffer-visiting "28.1")
(defvar idlwave-outlawed-buffers nil
"List of buffers pulled up by IDLWAVE for special reasons.
@@ -3848,7 +3802,7 @@ Buffers in this list may be killed by `idlwave-kill-autoloaded-buffers'.")
(defun idlwave-find-file-noselect (file &optional why)
;; Return a buffer visiting file.
- (or (idlwave-get-buffer-visiting file)
+ (or (find-buffer-visiting file)
(let ((buf (find-file-noselect file)))
(if why (add-to-list 'idlwave-outlawed-buffers (cons buf why)))
buf)))
@@ -6636,7 +6590,6 @@ This function is not general, can only be used for completion stuff."
"A form to evaluate after completion selection in *Completions* buffer.")
(defconst idlwave-completion-mark (make-marker)
"A mark pointing to the beginning of the completion string.")
-(defvar completion-highlight-first-word-only) ;XEmacs.
(defun idlwave-complete-in-buffer (type stype list selector prompt isa
&optional prepare-display-function
@@ -6715,12 +6668,7 @@ accumulate information on matching completions."
list))
(let* ((list all-completions)
;; "complete" means, this is already a valid completion
- (complete (memq spart all-completions))
- (completion-highlight-first-word-only t)) ; XEmacs
- ;; (completion-fixup-function ; Emacs
- ;; (lambda () (and (eq (preceding-char) ?>)
- ;; (re-search-backward " <" beg t)))))
-
+ (complete (memq spart all-completions)))
(setq list (sort list (lambda (a b)
(string< (downcase a) (downcase b)))))
(if prepare-display-function
@@ -6779,10 +6727,8 @@ accumulate information on matching completions."
(not super-classes))) ; no possibilities for inheritance
;; In these cases, we do not have to do anything
list
- (let* ((do-prop (and (>= show-classes 0)
- (>= emacs-major-version 21)))
+ (let* ((do-prop (>= show-classes 0))
(do-buf (not (= show-classes 0)))
- ;; (do-dots (featurep 'xemacs))
(do-dots t)
(inherit (if (and (not (eq type 'class-tag)) super-classes)
(cons class-selector super-classes)))
@@ -6848,10 +6794,6 @@ accumulate information on matching completions."
;;----------------------------------------------------------------------
;;----------------------------------------------------------------------
;;----------------------------------------------------------------------
-(when (featurep 'xemacs)
- (defvar rtn)
- (defun idlwave-pset (item)
- (set 'rtn item)))
(defun idlwave-popup-select (ev list title &optional sort)
"Select an item in LIST with a popup menu.
@@ -6862,17 +6804,6 @@ sort the list before displaying."
(cond ((null list))
((= 1 (length list))
(setq rtn (car list)))
- ((featurep 'xemacs)
- (if sort (setq list (sort list (lambda (a b)
- (string< (upcase a) (upcase b))))))
- (setq menu
- (append (list title)
- (mapcar (lambda (x) (vector x (list 'idlwave-pset
- x)))
- list)))
- (setq menu (idlwave-split-menu-xemacs menu maxpopup))
- (let ((resp (get-popup-menu-response menu)))
- (funcall (event-function resp) (event-object resp))))
(t
(if sort (setq list (sort list (lambda (a b)
(string< (upcase a) (upcase b))))))
@@ -6880,36 +6811,14 @@ sort the list before displaying."
(list
(append (list "")
(mapcar (lambda(x) (cons x x)) list)))))
- (setq menu (idlwave-split-menu-emacs menu maxpopup))
+ (setq menu (idlwave-split-menu menu maxpopup))
(setq rtn (x-popup-menu ev menu))))
rtn))
-(defun idlwave-split-menu-xemacs (menu N)
- "Split the MENU into submenus of maximum length N."
- (if (<= (length menu) (1+ N))
- ;; No splitting needed
- menu
- (let* ((title (car menu))
- (entries (cdr menu))
- (menu (list title))
- (cnt 0)
- (nextmenu nil))
- (while entries
- (while (and entries (< cnt N))
- (setq cnt (1+ cnt)
- nextmenu (cons (car entries) nextmenu)
- entries (cdr entries)))
- (setq nextmenu (nreverse nextmenu))
- (setq nextmenu (cons (format "%s...%s"
- (aref (car nextmenu) 0)
- (aref (nth (1- cnt) nextmenu) 0))
- nextmenu))
- (setq menu (cons nextmenu menu)
- nextmenu nil
- cnt 0))
- (nreverse menu))))
+(define-obsolete-function-alias 'idlwave-split-menu-emacs
+ #'idlwave-split-menu "28.1")
-(defun idlwave-split-menu-emacs (menu N)
+(defun idlwave-split-menu (menu N)
"Split the MENU into submenus of maximum length N."
(if (<= (length (nth 1 menu)) (1+ N))
;; No splitting needed
@@ -6964,10 +6873,7 @@ sort the list before displaying."
(move-marker idlwave-completion-mark beg)
(setq idlwave-before-completion-wconf (current-window-configuration)))
- (if (featurep 'xemacs)
- (idlwave-display-completion-list-xemacs
- list)
- (idlwave-display-completion-list-emacs list))
+ (idlwave-display-completion-list-1 list)
;; Store a special value in `this-command'. When `idlwave-complete'
;; finds this in `last-command', it will scroll the *Completions* buffer.
@@ -7025,8 +6931,7 @@ The key which is associated with each option is generated automatically.
First, the strings are checked for preselected keys, like in \"[P]rint\".
If these don't exist, a letter in the string is automatically selected."
(let* ((alist (symbol-value sym))
- (temp-buffer-show-hook (if (fboundp 'fit-window-to-buffer)
- '(fit-window-to-buffer)))
+ (temp-buffer-show-hook '(fit-window-to-buffer))
keys-alist char)
;; First check the cache
(if (and (eq (symbol-value sym) (get sym :one-key-alist-last)))
@@ -7112,42 +7017,17 @@ If these don't exist, a letter in the string is automatically selected."
(and (local-variable-p var (current-buffer))
(symbol-value var))))
-;; In XEmacs, we can use :activate-callback directly to advice the
-;; choose functions. We use the private keymap only for the online
-;; help feature.
-
(defvar idlwave-completion-map nil
"Keymap for `completion-list-mode' with `idlwave-complete'.")
-(defun idlwave-display-completion-list-xemacs (list &rest cl-args)
- (with-output-to-temp-buffer "*Completions*"
- (apply 'display-completion-list list
- ':activate-callback 'idlwave-default-choose-completion
- cl-args))
- (with-current-buffer "*Completions*"
- (use-local-map
- (or idlwave-completion-map
- (setq idlwave-completion-map
- (idlwave-make-modified-completion-map-xemacs
- (current-local-map)))))))
-
(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-make-modified-completion-map-xemacs (old-map)
- "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP."
- (let ((new-map (copy-keymap old-map)))
- (define-key new-map [button3up] 'idlwave-mouse-completion-help)
- (define-key new-map [button3] (lambda ()
- (interactive)
- (setq this-command last-command)))
- new-map))
-
-;; In Emacs we also replace keybindings in the completion
-;; map in order to install our wrappers.
+(define-obsolete-function-alias 'idlwave-display-completion-list-emacs
+ #'idlwave-display-completion-list-1 "28.1")
-(defun idlwave-display-completion-list-emacs (list)
+(defun idlwave-display-completion-list-1 (list)
"Display completion list and install the choose wrappers."
(with-output-to-temp-buffer "*Completions*"
(display-completion-list list))
@@ -7155,16 +7035,16 @@ If these don't exist, a letter in the string is automatically selected."
(use-local-map
(or idlwave-completion-map
(setq idlwave-completion-map
- (idlwave-make-modified-completion-map-emacs
- (current-local-map)))))))
+ (idlwave-make-modified-completion-map (current-local-map)))))))
+
+(define-obsolete-function-alias 'idlwave-make-modified-completion-map-emacs
+ #'idlwave-make-modified-completion-map "28.1")
-(defun idlwave-make-modified-completion-map-emacs (old-map)
- "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP."
+(defun idlwave-make-modified-completion-map (old-map)
+ "Replace `choose-completion' in OLD-MAP."
(let ((new-map (copy-keymap old-map)))
(substitute-key-definition
'choose-completion 'idlwave-choose-completion new-map)
- (substitute-key-definition
- 'mouse-choose-completion 'idlwave-mouse-choose-completion new-map)
(define-key new-map [mouse-3] 'idlwave-mouse-completion-help)
new-map))
@@ -7173,10 +7053,8 @@ If these don't exist, a letter in the string is automatically selected."
(interactive (list last-nonmenu-event))
(apply 'idlwave-choose 'choose-completion args))
-(defun idlwave-mouse-choose-completion (&rest args)
- "Click on an alternative in the `*Completions*' buffer to choose it."
- (interactive "e")
- (apply 'idlwave-choose 'mouse-choose-completion args))
+(define-obsolete-function-alias 'idlwave-mouse-choose-completion
+ #'idlwave-choose-completion "28.1")
;;----------------------------------------------------------------------
;;----------------------------------------------------------------------
@@ -7370,7 +7248,7 @@ class/struct definition."
(file (idlwave-routine-source-file
(nth 3 (idlwave-rinfo-assoc pro 'pro nil
(idlwave-routines))))))
- (cons file (if file (idlwave-get-buffer-visiting file)))))
+ (cons file (if file (find-buffer-visiting file)))))
(defun idlwave-scan-class-info (class)
@@ -8241,15 +8119,9 @@ If we do not know about MODULE, just return KEYWORD literally."
(defvar idlwave-rinfo-mouse-map
(let ((map (make-sparse-keymap)))
- (define-key map
- (if (featurep 'xemacs) [button2] [mouse-2])
- 'idlwave-mouse-active-rinfo)
- (define-key map
- (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)])
- 'idlwave-mouse-active-rinfo-shift)
- (define-key map
- (if (featurep 'xemacs) [button3] [mouse-3])
- 'idlwave-mouse-active-rinfo-right)
+ (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))
@@ -8301,7 +8173,6 @@ If we do not know about MODULE, just return KEYWORD literally."
"Button2: Display info about same method in superclass")
(col 0)
(data (list name type class (current-buffer) nil initial-class))
- (km-prop (if (featurep 'xemacs) 'keymap 'local-map))
(face 'idlwave-help-link)
beg props win cnt total)
;; Fix keywords, but don't add chained super-classes, since these
@@ -8326,7 +8197,7 @@ If we do not know about MODULE, just return KEYWORD literally."
idlwave-current-obj_new-class)
(when superclasses
(setq props (list 'mouse-face 'highlight
- km-prop idlwave-rinfo-mouse-map
+ 'local-map idlwave-rinfo-mouse-map
'help-echo help-echo-class
'data (cons 'class data)))
(let ((classes (cons initial-class superclasses)) c)
@@ -8342,7 +8213,7 @@ If we do not know about MODULE, just return KEYWORD literally."
(add-text-properties beg (point) props))))
(insert "\n")))
(setq props (list 'mouse-face 'highlight
- km-prop idlwave-rinfo-mouse-map
+ 'local-map idlwave-rinfo-mouse-map
'help-echo help-echo-use
'data (cons 'usage data)))
(if html-file (setq props (append (list 'face face 'link html-file)
@@ -8370,7 +8241,7 @@ If we do not know about MODULE, just return KEYWORD literally."
(setq beg (point)
;; Relevant keywords already have link property attached
props (list 'mouse-face 'highlight
- km-prop idlwave-rinfo-mouse-map
+ 'local-map idlwave-rinfo-mouse-map
'data (cons 'keyword data)
'help-echo help-echo-kwd
'keyword (car x)))
@@ -8384,7 +8255,7 @@ If we do not know about MODULE, just return KEYWORD literally."
;; Here entry is (key file (list of type-conses))
(while (setq entry (pop all))
(setq props (list 'mouse-face 'highlight
- km-prop idlwave-rinfo-mouse-map
+ 'local-map idlwave-rinfo-mouse-map
'help-echo help-echo-src
'source (list (car (car (nth 2 entry))) ;type
(nth 1 entry)
@@ -8489,8 +8360,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
- (if (featurep 'xemacs) (list file t) (list file))))
+ (insert (apply 'abbreviate-file-name (list file)))
(if file-props
(add-text-properties beg (point) file-props)))))
@@ -8650,10 +8520,9 @@ can be used to detect possible name clashes during this process."
idlwave-user-catalog-routines
idlwave-buffer-routines
nil))
- (km-prop (if (featurep 'xemacs) 'keymap 'local-map))
(keymap (make-sparse-keymap))
(props (list 'mouse-face 'highlight
- km-prop keymap
+ 'local-map keymap
'help-echo "Mouse2: Find source"))
(nroutines (length (or special-routines routines)))
(step (/ nroutines 100))
@@ -8676,7 +8545,7 @@ can be used to detect possible name clashes during this process."
(nth 2 b) (car b)))))))
(message "Sorting routines...done")
- (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)])
+ (define-key keymap [(mouse-2)]
(lambda (ev)
(interactive "e")
(mouse-set-point ev)
@@ -9038,23 +8907,6 @@ Assumes that point is at the beginning of the unit as found by
'imenu)
(error nil)))))
-;; Here we hack func-menu.el in order to support this new mode.
-;; The latest versions of func-menu.el already have this stuff in, so
-;; we hack only if it is not already there.
-(when (featurep 'xemacs)
- (eval-after-load "func-menu"
- '(progn
- (or (assq 'idlwave-mode fume-function-name-regexp-alist)
- (not (boundp 'fume-function-name-regexp-idl)) ; avoid problems
- (setq fume-function-name-regexp-alist
- (cons '(idlwave-mode . fume-function-name-regexp-idl)
- fume-function-name-regexp-alist)))
- (or (assq 'idlwave-mode fume-find-function-name-method-alist)
- (not (fboundp 'fume-find-next-idl-function-name)) ; avoid problems
- (setq fume-find-function-name-method-alist
- (cons '(idlwave-mode . fume-find-next-idl-function-name)
- fume-find-function-name-method-alist))))))
-
(defun idlwave-edit-in-idlde ()
"Edit the current file in IDL Development environment."
(interactive)
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index a24b94073fc..59db646ff32 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -130,9 +130,8 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword
;;; "This function binds many inferior-lisp commands to C-c <letter> bindings,
;;;where they are more accessible. C-c <letter> bindings are reserved for the
-;;;user, so these bindings are non-standard. If you want them, you should
-;;;have this function called by the inferior-lisp-load-hook:
-;;; (add-hook 'inferior-lisp-load-hook 'inferior-lisp-install-letter-bindings)
+;;;user, so these bindings are non-standard. If you want them:
+;;; (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)
@@ -555,10 +554,7 @@ Used by these commands to determine defaults."
;;; Reads a string from the user.
(defun lisp-symprompt (prompt default)
- (list (let* ((prompt (if default
- (format "%s (default %s): " prompt default)
- (concat prompt ": ")))
- (ans (read-string prompt)))
+ (list (let ((ans (read-string (format-prompt prompt default))))
(if (zerop (length ans)) default ans))))
@@ -632,6 +628,8 @@ See variable `lisp-describe-sym-command'."
;;;===============================
(defvar inferior-lisp-load-hook nil
"This hook is run when the library `inf-lisp' is loaded.")
+(make-obsolete-variable 'inferior-lisp-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(run-hooks 'inferior-lisp-load-hook)
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 5ec3e942753..5c50e2accdf 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -4570,7 +4570,7 @@ This function is intended for use in `after-change-functions'."
;; Comments
(setq-local comment-start "// ")
- (setq-local comment-start-skip "\\(//+\\|/\\*+\\)\\s *")
+ (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *")
(setq-local comment-end "")
(setq-local fill-paragraph-function #'js-fill-paragraph)
(setq-local normal-auto-fill-function #'js-do-auto-fill)
@@ -4591,7 +4591,8 @@ This function is intended for use in `after-change-functions'."
(setq imenu-create-index-function #'js--imenu-create-index)
;; for filling, pretend we're cc-mode
- (c-init-language-vars js-mode)
+ (c-foreign-init-lit-pos-cache)
+ (add-hook 'before-change-functions #'c-foreign-truncate-lit-pos-cache nil t)
(setq-local comment-line-break-function #'c-indent-new-comment-line)
(setq-local comment-multi-line t)
(setq-local electric-indent-chars
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index ec246d63ac2..01cc330dc2e 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -316,7 +316,7 @@ not be enclosed in { } or ( )."
(defconst makefile-gmake-statements
`("-sinclude" "sinclude" ; makefile-makepp-statements takes rest
"ifdef" "ifndef" "ifeq" "ifneq" "-include" "define" "endef" "export"
- "override define" "override" "unexport" "vpath"
+ "override define" "override" "unexport" "vpath" "undefine"
,@(cdr makefile-automake-statements))
"List of keywords understood by gmake.")
@@ -1413,7 +1413,7 @@ Fill comments, backslashed lines, and variable definitions specially."
"Leave the browser and return to the makefile buffer."
(interactive)
(let ((my-client makefile-browser-client))
- (setq makefile-browser-client nil) ; we quitted, so NO client!
+ (setq makefile-browser-client nil) ; we quit, so NO client!
(set-buffer-modified-p nil)
(quit-window t)
(pop-to-buffer my-client)))
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index 6f0e535def8..4a5d872b790 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -895,6 +895,8 @@ The environment marked is the one that contains point or follows point."
"Hook evaluated when first loading Metafont or MetaPost mode."
:type 'hook
:group 'meta-font)
+(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'."
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index 9e039562549..55a78c6cc85 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -165,7 +165,7 @@ parenthetical grouping.")
(modify-syntax-entry ?| "." table)
(modify-syntax-entry ?! "." table)
(modify-syntax-entry ?\\ "." table)
- (modify-syntax-entry ?\' "." table)
+ (modify-syntax-entry ?\' "\"" table)
(modify-syntax-entry ?\` "." table)
(modify-syntax-entry ?. "." table)
(modify-syntax-entry ?\" "\"" table)
@@ -619,8 +619,7 @@ Key bindings:
(add-hook 'before-save-hook 'octave-sync-function-file-names nil t)
(setq-local beginning-of-defun-function 'octave-beginning-of-defun)
(and octave-font-lock-texinfo-comment (octave-font-lock-texinfo-comment))
- (add-function :before-until (local 'eldoc-documentation-function)
- 'octave-eldoc-function)
+ (add-hook 'eldoc-documentation-functions 'octave-eldoc-function nil t)
(easy-menu-add octave-mode-menu))
@@ -756,7 +755,7 @@ Key bindings:
(setq font-lock-defaults '(inferior-octave-font-lock-keywords nil nil))
(setq-local info-lookup-mode 'octave-mode)
- (setq-local eldoc-documentation-function 'octave-eldoc-function)
+ (add-hook 'eldoc-documentation-functions 'octave-eldoc-function nil t)
(setq-local comint-input-ring-file-name
(or (getenv "OCTAVE_HISTFILE") "~/.octave_hist"))
@@ -1049,10 +1048,9 @@ directory and makes this the current buffer's default directory."
(save-excursion
(skip-syntax-backward "-(")
(thing-at-point 'symbol)))))
- (completing-read
- (format (if def "Function (default %s): " "Function: ") def)
- (inferior-octave-completion-table)
- nil nil nil nil def)))
+ (completing-read (format-prompt "Function" def)
+ (inferior-octave-completion-table)
+ nil nil nil nil def)))
(defun octave-goto-function-definition (fn)
"Go to the function definition of FN in current buffer."
@@ -1173,10 +1171,7 @@ q: Don't fix\n" func file))
(min (line-end-position 4) end)
t)
(match-string 1))))
- (old-func (read-string (format (if old-func
- "Name to replace (default %s): "
- "Name to replace: ")
- old-func)
+ (old-func (read-string (format-prompt "Name to replace" old-func)
nil nil old-func)))
(if (and func old-func (not (equal func old-func)))
(perform-replace old-func func 'query
@@ -1455,7 +1450,7 @@ The block marked is the one that contains point or follows point."
Prompt for the function's name, arguments and return values (to be
entered without parens)."
(let* ((defname (file-name-sans-extension (buffer-name)))
- (name (read-string (format "Function name (default %s): " defname)
+ (name (read-string (format-prompt "Function name" defname)
nil nil defname))
(args (read-string "Arguments: "))
(vals (read-string "Return values: ")))
@@ -1640,8 +1635,8 @@ code line."
(nreverse result)))))
(cdr octave-eldoc-cache))
-(defun octave-eldoc-function ()
- "A function for `eldoc-documentation-function' (which see)."
+(defun octave-eldoc-function (&rest _ignored)
+ "A function for `eldoc-documentation-functions' (which see)."
(when (inferior-octave-process-live-p)
(let* ((ppss (syntax-ppss))
(paren-pos (cadr ppss))
diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el
index fcd9294f660..8c060991f42 100644
--- a/lisp/progmodes/opascal.el
+++ b/lisp/progmodes/opascal.el
@@ -1688,7 +1688,7 @@ comment block. If not in a // comment, just does a normal newline."
;; as comment starters. Fix it here by removing the "2" from the syntax
;; of the second char of such sequences.
("/\\(\\*\\)" (1 ". 3b"))
- ("(\\(\\/\\)" (1 (prog1 ". 1c" (forward-char -1) nil)))
+ ("(\\(/\\)" (1 (prog1 ". 1c" (forward-char -1) nil)))
;; Pascal uses '' and "" rather than \' and \" to escape quotes.
("''\\|\"\"" (0 (if (save-excursion
(nth 3 (syntax-ppss (match-beginning 0))))
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index 13505d04a2d..fce059bafc7 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -187,7 +187,7 @@
;; as comment starters. Fix it here by removing the "2" from the syntax
;; of the second char of such sequences.
("/\\(\\*\\)" (1 ". 3b"))
- ("(\\(\\/\\)" (1 (prog1 ". 1c" (forward-char -1) nil)))
+ ("(\\(/\\)" (1 (prog1 ". 1c" (forward-char -1) nil)))
;; Pascal uses '' and "" rather than \' and \" to escape quotes.
("''\\|\"\"" (0 (if (save-excursion
(nth 3 (syntax-ppss (match-beginning 0))))
@@ -589,7 +589,7 @@ See also `pascal-comment-area'."
(interactive)
(catch 'found
(if (not (looking-at (concat "\\s \\|\\s)\\|" pascal-defun-re)))
- (forward-sexp 1))
+ (ignore-errors (forward-sexp 1)))
(let ((nest 0) (max -1) (func 0)
(reg (concat pascal-beg-block-re "\\|"
pascal-end-block-re "\\|"
@@ -1170,26 +1170,27 @@ indent of the current line in parameterlist."
(defun pascal-type-completion (pascal-str)
"Calculate all possible completions for types."
- (let ((start (point))
- (pascal-all ())
- goon)
- ;; Search for all reachable type declarations
- (while (or (pascal-beg-of-defun)
- (setq goon (not goon)))
- (save-excursion
- (if (and (< start (prog1 (save-excursion (pascal-end-of-defun)
- (point))
- (forward-char 1)))
- (re-search-forward
- "\\<type\\>\\|\\<\\(begin\\|function\\|procedure\\)\\>"
- start t)
- (not (match-end 1)))
- ;; Check current type declaration
- (setq pascal-all
- (nconc (pascal-get-completion-decl pascal-str)
- pascal-all)))))
+ (save-excursion
+ (let ((start (point))
+ (pascal-all ())
+ goon)
+ ;; Search for all reachable type declarations
+ (while (or (pascal-beg-of-defun)
+ (setq goon (not goon)))
+ (save-excursion
+ (if (and (< start (prog1 (save-excursion (pascal-end-of-defun)
+ (point))
+ (forward-char 1)))
+ (re-search-forward
+ "\\<type\\>\\|\\<\\(begin\\|function\\|procedure\\)\\>"
+ start t)
+ (not (match-end 1)))
+ ;; Check current type declaration
+ (setq pascal-all
+ (nconc (pascal-get-completion-decl pascal-str)
+ pascal-all)))))
- pascal-all))
+ pascal-all)))
(defun pascal-var-completion (prefix)
"Calculate all possible completions for variables (or constants)."
@@ -1263,11 +1264,13 @@ indent of the current line in parameterlist."
(and (eq state 'defun)
(save-excursion
(re-search-backward ")[ \t]*:" (point-at-bol) t))))
- (if (or (eq state 'paramlist) (eq state 'defun))
- (pascal-beg-of-defun))
- (nconc
- (pascal-type-completion pascal-str)
- (pascal-keyword-completion pascal-type-keywords pascal-str)))
+ (save-excursion
+ (if (or (eq state 'paramlist) (eq state 'defun))
+ (pascal-beg-of-defun))
+ (nconc
+ (pascal-type-completion pascal-str)
+ (pascal-keyword-completion pascal-type-keywords
+ pascal-str))))
( ;--Starting a new statement
(and (not (eq state 'contexp))
(save-excursion
@@ -1392,7 +1395,7 @@ The default is a name found in the buffer around point."
(defvar pascal-outline-map
(let ((map (make-sparse-keymap)))
(if (fboundp 'set-keymap-name)
- (set-keymap-name pascal-outline-map 'pascal-outline-map))
+ (set-keymap-name map 'pascal-outline-map))
(define-key map "\M-\C-a" 'pascal-outline-prev-defun)
(define-key map "\M-\C-e" 'pascal-outline-next-defun)
(define-key map "\C-c\C-d" 'pascal-outline-goto-defun)
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index f864f6a34cd..127b24cb890 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -214,7 +214,9 @@
(defconst perl--syntax-exp-intro-regexp
(concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
(regexp-opt perl--syntax-exp-intro-keywords)
- "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*")))
+ "\\|[?:.,;|&*=!~({[]"
+ "\\|[^-+][-+]" ;Bug#42168: `+' is intro but `++' isn't!
+ "\\|\\(^\\)\\)[ \t\n]*")))
(defun perl-syntax-propertize-function (start end)
(let ((case-fold-search nil))
@@ -235,7 +237,7 @@
(match-beginning 0))))))
(string-to-syntax ". p"))))
;; Handle funny names like $DB'stop.
- ("\\$ ?{?^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_"))
+ ("\\$ ?{?\\^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_"))
;; format statements
("^[ \t]*format.*=[ \t]*\\(\n\\)"
(1 (prog1 "\"" (perl-syntax-propertize-special-constructs end))))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index f5f4092babf..8c550b57682 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,6 +1,11 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Version: 0.5.2
+;; Package-Requires: ((emacs "26.3") (xref "1.0.2"))
+
+;; This is a GNU ELPA :core package. Avoid using functionality that
+;; not compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.
@@ -19,6 +24,11 @@
;;; Commentary:
+;; NOTE: The project 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 contains generic infrastructure for dealing with
;; projects, some utility functions, and commands using that
;; infrastructure.
@@ -27,16 +37,29 @@
;; current project, without having to know which package handles
;; detection of that project type, parsing its config files, etc.
;;
-;; NOTE: The project 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 consists of following parts:
+;;
+;; Infrastructure (the public API):
+;;
+;; Function `project-current' that returns the current project
+;; instance based on the value of the hook `project-find-functions',
+;; and several generic functions that act on it.
+;;
+;; `project-root' must be defined for every project.
+;; `project-files' can be overridden for performance purposes.
+;; `project-ignores' and `project-external-roots' describe the project
+;; files and its relations to external directories. `project-files'
+;; should be consistent with `project-ignores'.
;;
-;; Infrastructure:
+;; This list can change in future versions.
;;
-;; Function `project-current', to determine the current project
-;; instance, and 5 (at the moment) generic functions that act on it.
-;; This list is to be extended in future versions.
+;; VC project:
+;;
+;; Originally conceived as an example implementation, now it's a
+;; relatively fast backend that delegates to 'git ls-files' or 'hg
+;; status' to list the project's files. It honors the VC ignore
+;; files, but supports additions to the list using the user option
+;; `project-vc-ignores' (usually through .dir-locals.el).
;;
;; Utils:
;;
@@ -45,9 +68,49 @@
;;
;; Commands:
;;
-;; `project-find-file', `project-find-regexp' and
-;; `project-or-external-find-regexp' use the current API, and thus
-;; will work in any project that has an adapter.
+;; `project-prefix-map' contains the full list of commands defined in
+;; this package. This map uses the prefix `C-x p' by default.
+;; Type `C-x p f' to find file in the current project.
+;; Type `C-x p C-h' to see all available commands and bindings.
+;;
+;; All commands defined in this package are implemented using the
+;; public API only. As a result, they will work with any project
+;; backend that follows the protocol.
+;;
+;; Any third-party code that wants to use this package should likewise
+;; target the public API. Use any of the built-in commands as the
+;; example.
+;;
+;; How to create a new backend:
+;;
+;; - Consider whether you really should, or whether there are other
+;; ways to reach your goals. If the backend's performance is
+;; significantly lower than that of the built-in one, and it's first
+;; in the list, it will affect all commands that use it. Unless you
+;; are going to be using it only yourself or in special circumstances,
+;; you will probably want it to be fast, and it's unlikely to be a
+;; trivial endeavor. `project-files' is the method to optimize (the
+;; default implementation gets slower the more files the directory
+;; has, and the longer the list of ignores is).
+;;
+;; - Choose the format of the value that represents a project for your
+;; backend (we call it project instance). Don't use any of the
+;; formats from other backends. The format can be arbitrary, as long
+;; as the datatype is something `cl-defmethod' can dispatch on. The
+;; value should be stable (when compared with `equal') across
+;; invocations, meaning calls to that function from buffers belonging
+;; to the same project should return equal values.
+;;
+;; - 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
+;; 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).
+;;
+;; - Define new methods for some or all generic functions for this
+;; backend using `cl-defmethod'. A `project-root' method is
+;; mandatory, `project-files' is recommended, the rest are optional.
;;; TODO:
@@ -72,9 +135,7 @@
;; whole Emacs session, independent of the current directory. Or,
;; in the more advanced case, open a set of projects, and have some
;; project-related commands to use them all. E.g., have a command
-;; to search for a regexp across all open projects. Provide a
-;; history of projects that were opened in the past (storing it as a
-;; list of directories should suffice).
+;; to search for a regexp across all open projects.
;;
;; * Support for project-local variables: a UI to edit them, and a
;; utility function to retrieve a value. Probably useless without
@@ -88,43 +149,81 @@
;;; Code:
(require 'cl-generic)
+(require 'seq)
+(eval-when-compile (require 'subr-x))
+
+(defgroup project nil
+ "Operations on the current project."
+ :version "28.1"
+ :group 'tools)
(defvar project-find-functions (list #'project-try-vc)
"Special hook to find the project containing a given directory.
Each functions on this hook is called in turn with one
-argument (the directory) and should return either nil to mean
-that it is not applicable, or a project instance.")
+argument, the directory in which to look, and should return
+either nil to mean that it is not applicable, or a project instance.
+The exact form of the project instance is up to each respective
+function; the only practical limitation is to use values that
+`cl-defmethod' can dispatch on, like a cons cell, or a list, or a
+CL struct.")
+
+(defvar project-current-inhibit-prompt nil
+ "Non-nil to skip prompting the user in `project-current'.")
;;;###autoload
-(defun project-current (&optional maybe-prompt dir)
- "Return the project instance in DIR or `default-directory'.
-When no project found in DIR, and MAYBE-PROMPT is non-nil, ask
-the user for a different directory to look in. If that directory
-is not a part of a detectable project either, return a
-`transient' project instance rooted in it."
- (unless dir (setq dir default-directory))
- (let ((pr (project--find-in-directory dir)))
+(defun project-current (&optional maybe-prompt directory)
+ "Return the project instance in DIRECTORY, defaulting to `default-directory'.
+
+When no project is found in that directory, the result depends on
+the value of MAYBE-PROMPT: if it is nil or omitted, return nil,
+else ask the user for a directory in which to look for the
+project, and if no project is found there, return a \"transient\"
+project instance.
+
+The \"transient\" project instance is a special kind of value
+which denotes a project rooted in that directory and includes all
+the files under the directory except for those that should be
+ignored (per `project-ignores').
+
+See the doc string of `project-find-functions' for the general form
+of the project instance object."
+ (unless directory (setq directory default-directory))
+ (let ((pr (project--find-in-directory directory)))
(cond
(pr)
- (maybe-prompt
- (setq dir (read-directory-name "Choose the project directory: " dir nil t)
- pr (project--find-in-directory dir))
- (unless pr
- (message "Using `%s' as a transient project root" dir)
- (setq pr (cons 'transient dir)))))
+ ((unless project-current-inhibit-prompt
+ maybe-prompt)
+ (setq directory (project-prompt-project-dir)
+ pr (project--find-in-directory directory))))
+ (when maybe-prompt
+ (if pr
+ (project-remember-project pr)
+ (project--remove-from-project-list directory)
+ (setq pr (cons 'transient directory))))
pr))
(defun project--find-in-directory (dir)
(run-hook-with-args-until-success 'project-find-functions dir))
-(cl-defgeneric project-roots (project)
- "Return the list of directory roots of the current project.
+(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.
-Most often it's just one directory which contains the project
-build file and everything else in the project. But in more
-advanced configurations, a project can span multiple directories.
+The directory name must be absolute."
+ (car (project-roots project)))
-The directory names should be absolute.")
+(cl-defgeneric project-roots (project)
+ "Return the list containing the current project root.
+
+The function is obsolete, all projects have one main root anyway,
+and the rest should be possible to express through
+`project-external-roots'."
+ ;; 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)))
;; FIXME: Add MODE argument, like in `ede-source-paths'?
(cl-defgeneric project-external-roots (_project)
@@ -133,18 +232,14 @@ The directory names should be absolute.")
It's the list of directories outside of the project that are
still related to it. If the project deals with source code then,
depending on the languages used, this list should include the
-headers search path, load path, class path, and so on.
-
-The rule of thumb for whether to include a directory here, and
-not in `project-roots', is whether its contents are meant to be
-edited together with the rest of the project."
+headers search path, load path, class path, and so on."
nil)
(cl-defgeneric project-ignores (_project _dir)
"Return the list of glob patterns to ignore inside DIR.
Patterns can match both regular files and directories.
To root an entry, start it with `./'. To match directories only,
-end it with `/'. DIR must be one of `project-roots' or
+end it with `/'. DIR must be either `project-root' or one of
`project-external-roots'."
;; TODO: Document and support regexp ignores as used by Hg.
;; TODO: Support whitelist entries.
@@ -165,21 +260,22 @@ end it with `/'. DIR must be one of `project-roots' or
(t
(complete-with-action action all-files string pred)))))
-(cl-defmethod project-roots ((project (head transient)))
- (list (cdr project)))
+(cl-defmethod project-root ((project (head transient)))
+ (cdr project))
(cl-defgeneric project-files (project &optional dirs)
"Return a list of files in directories DIRS in PROJECT.
DIRS is a list of absolute directories; it should be some
-subset of the project roots and external roots.
+subset of the project root and external roots.
The default implementation uses `find-program'. PROJECT is used
to find the list of ignores for each directory."
- (cl-mapcan
+ (mapcan
(lambda (dir)
(project--files-in-directory dir
(project--dir-ignores project dir)))
- (or dirs (project-roots project))))
+ (or dirs
+ (list (project-root project)))))
(defun project--files-in-directory (dir ignores &optional files)
(require 'find-dired)
@@ -218,14 +314,24 @@ to find the list of ignores for each directory."
local-files))))
(defgroup project-vc nil
- "Project implementation using the VC package."
+ "Project implementation based on the VC package."
:version "25.1"
- :group 'tools)
+ :group 'project)
(defcustom project-vc-ignores nil
"List of patterns to include in `project-ignores'."
:type '(repeat string)
- :safe 'listp)
+ :safe #'listp)
+
+(defcustom project-vc-merge-submodules t
+ "Non-nil to consider submodules part of the parent project.
+
+After changing this variable (using Customize or .dir-locals.el)
+you might have to restart Emacs to see the effect."
+ :type 'boolean
+ :version "28.1"
+ :package-version '(project . "0.2.0")
+ :safe #'booleanp)
;; FIXME: Using the current approach, major modes are supposed to set
;; this variable to a buffer-local value. So we don't have access to
@@ -263,20 +369,56 @@ The directory names should be absolute. Used in the VC project
backend implementation of `project-external-roots'.")
(defun project-try-vc (dir)
- (let* ((backend (ignore-errors (vc-responsible-backend dir)))
+ (let* ((backend
+ ;; FIXME: This is slow. Cache it.
+ (ignore-errors (vc-responsible-backend dir)))
(root
(pcase backend
('Git
;; Don't stop at submodule boundary.
+ ;; FIXME: Cache for a shorter time.
(or (vc-file-getprop dir 'project-git-root)
- (vc-file-setprop dir 'project-git-root
- (vc-find-root dir ".git/"))))
+ (let ((root (vc-call-backend backend 'root dir)))
+ (vc-file-setprop
+ dir 'project-git-root
+ (if (and
+ ;; FIXME: Invalidate the cache when the value
+ ;; of this variable changes.
+ (project--vc-merge-submodules-p root)
+ (project--submodule-p root))
+ (let* ((parent (file-name-directory
+ (directory-file-name root))))
+ (vc-call-backend backend 'root parent))
+ root)))))
('nil nil)
(_ (ignore-errors (vc-call-backend backend 'root dir))))))
(and root (cons 'vc root))))
-(cl-defmethod project-roots ((project (head vc)))
- (list (cdr project)))
+(defun project--submodule-p (root)
+ ;; XXX: We only support Git submodules for now.
+ ;;
+ ;; For submodules, at least, we expect the users to prefer them to
+ ;; be considered part of the parent project. For those who don't,
+ ;; there is the custom var now.
+ ;;
+ ;; Some users may also set up things equivalent to Git submodules
+ ;; using "git worktree" (for example). However, we expect that most
+ ;; of them would prefer to treat those as separate projects anyway.
+ (let* ((gitfile (expand-file-name ".git" root)))
+ (cond
+ ((file-directory-p gitfile)
+ nil)
+ ((with-temp-buffer
+ (insert-file-contents gitfile)
+ (goto-char (point-min))
+ ;; Kind of a hack to distinguish a submodule from
+ ;; other cases of .git files pointing elsewhere.
+ (looking-at "gitdir: [./]+/\\.git/modules/"))
+ t)
+ (t nil))))
+
+(cl-defmethod project-root ((project (head vc)))
+ (cdr project))
(cl-defmethod project-external-roots ((project (head vc)))
(project-subtract-directories
@@ -284,10 +426,10 @@ backend implementation of `project-external-roots'.")
(mapcar
#'file-name-as-directory
(funcall project-vc-external-roots-function)))
- (project-roots project)))
+ (list (project-root project))))
(cl-defmethod project-files ((project (head vc)) &optional dirs)
- (cl-mapcan
+ (mapcan
(lambda (dir)
(let (backend)
(if (and (file-equal-p dir (cdr project))
@@ -302,7 +444,8 @@ backend implementation of `project-external-roots'.")
(project--files-in-directory
dir
(project--dir-ignores project dir)))))
- (or dirs (project-roots project))))
+ (or dirs
+ (list (project-root project)))))
(declare-function vc-git--program-version "vc-git")
(declare-function vc-git--run-command-string "vc-git")
@@ -331,20 +474,23 @@ backend implementation of `project-external-roots'.")
(split-string
(apply #'vc-git--run-command-string nil "ls-files" args)
"\0" t)))
- ;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'.
- (let* ((submodules (project--git-submodules))
- (sub-files
- (mapcar
- (lambda (module)
- (when (file-directory-p module)
- (project--vc-list-files
- (concat default-directory module)
- backend
- extra-ignores)))
- submodules)))
- (setq files
- (apply #'nconc files sub-files)))
- files))
+ (when (project--vc-merge-submodules-p default-directory)
+ ;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'.
+ (let* ((submodules (project--git-submodules))
+ (sub-files
+ (mapcar
+ (lambda (module)
+ (when (file-directory-p module)
+ (project--vc-list-files
+ (concat default-directory module)
+ backend
+ extra-ignores)))
+ submodules)))
+ (setq files
+ (apply #'nconc files sub-files))))
+ ;; 'git ls-files' returns duplicate entries for merge conflicts.
+ ;; XXX: Better solutions welcome, but this seems cheap enough.
+ (delete-consecutive-dups files)))
(`Hg
(let ((default-directory (expand-file-name (file-name-as-directory dir)))
args)
@@ -362,6 +508,11 @@ backend implementation of `project-external-roots'.")
(lambda (s) (concat default-directory s))
(split-string (buffer-string) "\0" t)))))))
+(defun project--vc-merge-submodules-p (dir)
+ (project--value-in-dir
+ 'project-vc-merge-submodules
+ dir))
+
(defun project--git-submodules ()
;; 'git submodule foreach' is much slower.
(condition-case nil
@@ -376,7 +527,7 @@ backend implementation of `project-external-roots'.")
(cl-defmethod project-ignores ((project (head vc)) dir)
(let* ((root (cdr project))
- backend)
+ backend)
(append
(when (file-equal-p dir root)
(setq backend (vc-responsible-backend root))
@@ -424,6 +575,102 @@ DIRS must contain directory names."
(hack-dir-local-variables-non-file-buffer))
(symbol-value var)))
+
+;;; Project commands
+
+;;;###autoload
+(defvar project-prefix-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "!" 'project-shell-command)
+ (define-key map "&" 'project-async-shell-command)
+ (define-key map "f" 'project-find-file)
+ (define-key map "F" 'project-or-external-find-file)
+ (define-key map "b" 'project-switch-to-buffer)
+ (define-key map "s" 'project-shell)
+ (define-key map "d" 'project-dired)
+ (define-key map "v" 'project-vc-dir)
+ (define-key map "c" 'project-compile)
+ (define-key map "e" 'project-eshell)
+ (define-key map "k" 'project-kill-buffers)
+ (define-key map "p" 'project-switch-project)
+ (define-key map "g" 'project-find-regexp)
+ (define-key map "G" 'project-or-external-find-regexp)
+ (define-key map "r" 'project-query-replace-regexp)
+ map)
+ "Keymap for project commands.")
+
+;;;###autoload (define-key ctl-x-map "p" project-prefix-map)
+
+;; We can't have these place-specific maps inherit from
+;; project-prefix-map because project--other-place-command needs to
+;; know which map the key binding came from, as if it came from one of
+;; these maps, we don't want to set display-buffer-overriding-action
+
+(defvar project-other-window-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-o" #'project-display-buffer)
+ map)
+ "Keymap for project commands that display buffers in other windows.")
+
+(defvar project-other-frame-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-o" #'project-display-buffer-other-frame)
+ map)
+ "Keymap for project commands that display buffers in other frames.")
+
+(defun project--other-place-command (action &optional map)
+ (let* ((key (read-key-sequence-vector nil t))
+ (place-cmd (lookup-key map key))
+ (generic-cmd (lookup-key project-prefix-map key))
+ (switch-to-buffer-obey-display-actions t)
+ (display-buffer-overriding-action (unless place-cmd action)))
+ (if-let ((cmd (or place-cmd generic-cmd)))
+ (call-interactively cmd)
+ (user-error "%s is undefined" (key-description key)))))
+
+;;;###autoload
+(defun project-other-window-command ()
+ "Run project command, displaying resultant buffer in another window.
+
+The following commands are available:
+
+\\{project-prefix-map}
+\\{project-other-window-map}"
+ (interactive)
+ (project--other-place-command '((display-buffer-pop-up-window)
+ (inhibit-same-window . t))
+ project-other-window-map))
+
+;;;###autoload (define-key ctl-x-4-map "p" #'project-other-window-command)
+
+;;;###autoload
+(defun project-other-frame-command ()
+ "Run project command, displaying resultant buffer in another frame.
+
+The following commands are available:
+
+\\{project-prefix-map}
+\\{project-other-frame-map}"
+ (interactive)
+ (project--other-place-command '((display-buffer-pop-up-frame))
+ project-other-frame-map))
+
+;;;###autoload (define-key ctl-x-5-map "p" #'project-other-frame-command)
+
+;;;###autoload
+(defun project-other-tab-command ()
+ "Run project command, displaying resultant buffer in a new tab.
+
+The following commands are available:
+
+\\{project-prefix-map}"
+ (interactive)
+ (project--other-place-command '((display-buffer-in-new-tab))))
+
+;;;###autoload
+(when (bound-and-true-p tab-prefix-map)
+ (define-key tab-prefix-map "p" #'project-other-tab-command))
+
(declare-function grep-read-files "grep")
(declare-function xref--show-xrefs "xref")
(declare-function xref--find-ignores-arguments "xref")
@@ -443,7 +690,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
(let* ((pr (project-current t))
(files
(if (not current-prefix-arg)
- (project-files pr (project-roots pr))
+ (project-files pr)
(let ((dir (read-directory-name "Base directory: "
nil default-directory t)))
(project--files-in-directory dir
@@ -454,9 +701,8 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
nil)))
(defun project--dir-ignores (project dir)
- (let* ((roots (project-roots project))
- (root (cl-find dir roots :test #'file-in-directory-p)))
- (if (not root)
+ (let ((root (project-root project)))
+ (if (not (file-in-directory-p dir root))
(project-ignores nil nil) ;The defaults.
(let ((ignores (project-ignores project root)))
(if (file-equal-p root dir)
@@ -474,8 +720,8 @@ pattern to search for."
(require 'xref)
(let* ((pr (project-current t))
(files
- (project-files pr (append
- (project-roots pr)
+ (project-files pr (cons
+ (project-root pr)
(project-external-roots pr)))))
(xref--show-xrefs
(apply-partially #'project--find-regexp-in-files regexp files)
@@ -489,47 +735,29 @@ pattern to search for."
(user-error "No matches for: %s" regexp))
xrefs))
-(defun project--process-file-region (start end program
- &optional buffer display
- &rest args)
- ;; FIXME: This branching shouldn't be necessary, but
- ;; call-process-region *is* measurably faster, even for a program
- ;; doing some actual work (for a period of time). Even though
- ;; call-process-region also creates a temp file internally
- ;; (http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html).
- (if (not (file-remote-p default-directory))
- (apply #'call-process-region
- start end program nil buffer display args)
- (let ((infile (make-temp-file "ppfr")))
- (unwind-protect
- (progn
- (write-region start end infile nil 'silent)
- (apply #'process-file program infile buffer display args))
- (delete-file infile)))))
-
(defun project--read-regexp ()
(let ((sym (thing-at-point 'symbol)))
(read-regexp "Find regexp" (and sym (regexp-quote sym)))))
;;;###autoload
(defun project-find-file ()
- "Visit a file (with completion) in the current project's roots.
+ "Visit a file (with completion) in the current project.
The completion default is the filename at point, if one is
recognized."
(interactive)
(let* ((pr (project-current t))
- (dirs (project-roots pr)))
+ (dirs (list (project-root pr))))
(project-find-file-in (thing-at-point 'filename) dirs pr)))
;;;###autoload
(defun project-or-external-find-file ()
- "Visit a file (with completion) in the current project's roots or external roots.
+ "Visit a file (with completion) in the current project or external roots.
The completion default is the filename at point, if one is
recognized."
(interactive)
(let* ((pr (project-current t))
- (dirs (append
- (project-roots pr)
+ (dirs (cons
+ (project-root pr)
(project-external-roots pr))))
(project-find-file-in (thing-at-point 'filename) dirs pr)))
@@ -541,6 +769,7 @@ For the arguments list, see `project--read-file-cpd-relative'."
(const :tag "Read with completion from absolute names"
project--read-file-absolute)
(function :tag "Custom function" nil))
+ :group 'project
:version "27.1")
(defun project--read-file-cpd-relative (prompt
@@ -577,9 +806,10 @@ PREDICATE, HIST, and DEFAULT have the same meaning as in
(defun project-find-file-in (filename dirs project)
"Complete FILENAME in DIRS in PROJECT and visit the result."
(let* ((all-files (project-files project dirs))
+ (completion-ignore-case read-file-name-completion-ignore-case)
(file (funcall project-read-file-name-function
- "Find file" all-files nil nil
- filename)))
+ "Find file" all-files nil nil
+ filename)))
(if (string= file "")
(user-error "You didn't specify the file")
(find-file file))))
@@ -605,6 +835,71 @@ PREDICATE, HIST, and DEFAULT have the same meaning as in
collection predicate t res hist nil)))
res))
+;;;###autoload
+(defun project-dired ()
+ "Start Dired in the current project's root."
+ (interactive)
+ (dired (project-root (project-current t))))
+
+;;;###autoload
+(defun project-vc-dir ()
+ "Run VC-Dir in the current project's root."
+ (interactive)
+ (vc-dir (project-root (project-current t))))
+
+;;;###autoload
+(defun project-shell ()
+ "Start an inferior shell in the current project's root directory.
+If a buffer already exists for running a shell in the project's root,
+switch to it. Otherwise, create a new shell buffer.
+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*"))
+ (shell-buffer (get-buffer default-project-shell-name)))
+ (if (and shell-buffer (not current-prefix-arg))
+ (pop-to-buffer shell-buffer)
+ (shell (generate-new-buffer-name default-project-shell-name)))))
+
+;;;###autoload
+(defun project-eshell ()
+ "Start Eshell in the current project's root directory.
+If a buffer already exists for running Eshell in the project's root,
+switch to it. Otherwise, create a new Eshell buffer.
+With \\[universal-argument] prefix arg, create a new Eshell buffer even
+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 (get-buffer eshell-buffer-name)))
+ (if (and eshell-buffer (not current-prefix-arg))
+ (pop-to-buffer eshell-buffer)
+ (eshell t))))
+
+;;;###autoload
+(defun project-async-shell-command ()
+ "Run `async-shell-command' in the current project's root directory."
+ (interactive)
+ (let ((default-directory (project-root (project-current t))))
+ (call-interactively #'async-shell-command)))
+
+;;;###autoload
+(defun project-shell-command ()
+ "Run `shell-command' in the current project's root directory."
+ (interactive)
+ (let ((default-directory (project-root (project-current t))))
+ (call-interactively #'shell-command)))
+
(declare-function fileloop-continue "fileloop" ())
;;;###autoload
@@ -632,5 +927,327 @@ loop using the command \\[fileloop-continue]."
from to (project-files (project-current t)) 'default)
(fileloop-continue))
+(defvar compilation-read-command)
+(declare-function compilation-read-command "compile")
+
+;;;###autoload
+(defun project-compile (command &optional comint)
+ "Run `compile' in the project root.
+Arguments the same as in `compile'."
+ (interactive
+ (list
+ (let ((command (eval compile-command)))
+ (if (or compilation-read-command current-prefix-arg)
+ (compilation-read-command command)
+ command))
+ (consp current-prefix-arg)))
+ (let* ((pr (project-current t))
+ (default-directory (project-root pr)))
+ (compile command comint)))
+
+(defun project--read-project-buffer ()
+ (let* ((pr (project-current t))
+ (current-buffer (current-buffer))
+ (other-buffer (other-buffer current-buffer))
+ (other-name (buffer-name other-buffer))
+ (predicate
+ (lambda (buffer)
+ ;; BUFFER is an entry (BUF-NAME . BUF-OBJ) of Vbuffer_alist.
+ (and (cdr buffer)
+ (equal pr
+ (with-current-buffer (cdr buffer)
+ (project-current)))))))
+ (read-buffer
+ "Switch to buffer: "
+ (when (funcall predicate (cons other-name other-buffer))
+ other-name)
+ nil
+ predicate)))
+
+;;;###autoload
+(defun project-switch-to-buffer (buffer-or-name)
+ "Display buffer BUFFER-OR-NAME in the selected window.
+When called interactively, prompts for a buffer belonging to the
+current project. Two buffers belong to the same project if their
+project instances, as reported by `project-current' in each
+buffer, are identical."
+ (interactive (list (project--read-project-buffer)))
+ (switch-to-buffer buffer-or-name))
+
+;;;###autoload
+(defun project-display-buffer (buffer-or-name)
+ "Display BUFFER-OR-NAME in some window, without selecting it.
+When called interactively, prompts for a buffer belonging to the
+current project. Two buffers belong to the same project if their
+project instances, as reported by `project-current' in each
+buffer, are identical.
+
+This function uses `display-buffer' as a subroutine, which see
+for how it is determined where the buffer will be displayed."
+ (interactive (list (project--read-project-buffer)))
+ (display-buffer buffer-or-name))
+
+;;;###autoload
+(defun project-display-buffer-other-frame (buffer-or-name)
+ "Display BUFFER-OR-NAME preferably in another frame.
+When called interactively, prompts for a buffer belonging to the
+current project. Two buffers belong to the same project if their
+project instances, as reported by `project-current' in each
+buffer, are identical.
+
+This function uses `display-buffer-other-frame' as a subroutine,
+which see for how it is determined where the buffer will be
+displayed."
+ (interactive (list (project--read-project-buffer)))
+ (display-buffer-other-frame buffer-or-name))
+
+(defcustom project-kill-buffer-conditions
+ '(buffer-file-name ; All file-visiting buffers are included.
+ ;; Most of the temp buffers in the background:
+ (major-mode . fundamental-mode)
+ ;; non-text buffer such as xref, occur, vc, log, ...
+ (and (derived-mode . special-mode)
+ (not (major-mode . help-mode)))
+ (derived-mode . compilation-mode)
+ (derived-mode . dired-mode)
+ (derived-mode . diff-mode))
+ "List of conditions to kill buffers related to a project.
+This list is used by `project-kill-buffers'.
+Each condition is either:
+- a regular expression, to match a buffer name,
+- a predicate function that takes a buffer object as argument
+ and returns non-nil if the buffer should be killed,
+- a cons-cell, where the car describes how to interpret the cdr.
+ The car can be one of the following:
+ * `major-mode': the buffer is killed if the buffer's major
+ mode is eq to the cons-cell's cdr
+ * `derived-mode': the buffer is killed if the buffer's major
+ mode is derived from the major mode denoted by the cons-cell's
+ cdr
+ * `not': the cdr is interpreted as a negation of a condition.
+ * `and': the cdr is a list of recursive conditions, that all have
+ to be met.
+ * `or': the cdr is a list of recursive conditions, of which at
+ least one has to be met.
+
+If any of these conditions are satisfied for a buffer in the
+current project, it will be killed."
+ :type '(repeat (choice regexp function symbol
+ (cons :tag "Major mode"
+ (const major-mode) symbol)
+ (cons :tag "Derived mode"
+ (const derived-mode) symbol)
+ (cons :tag "Negation"
+ (const not) sexp)
+ (cons :tag "Conjunction"
+ (const and) sexp)
+ (cons :tag "Disjunction"
+ (const or) sexp)))
+ :version "28.1"
+ :group 'project
+ :package-version '(project . "0.6.0"))
+
+(defun project--buffer-list (pr)
+ "Return the list of all buffers in project PR."
+ (let (bufs)
+ (dolist (buf (buffer-list))
+ (when (equal pr
+ (with-current-buffer buf
+ (project-current)))
+ (push buf bufs)))
+ (nreverse bufs)))
+
+(defun project--kill-buffer-check (buf conditions)
+ "Check if buffer BUF matches any element of the list CONDITIONS.
+See `project-kill-buffer-conditions' for more details on the form
+of CONDITIONS."
+ (catch 'kill
+ (dolist (c conditions)
+ (when (cond
+ ((stringp c)
+ (string-match-p c (buffer-name buf)))
+ ((symbolp c)
+ (funcall c buf))
+ ((eq (car-safe c) 'major-mode)
+ (eq (buffer-local-value 'major-mode buf)
+ (cdr c)))
+ ((eq (car-safe c) 'derived-mode)
+ (provided-mode-derived-p
+ (buffer-local-value 'major-mode buf)
+ (cdr c)))
+ ((eq (car-safe c) 'not)
+ (not (project--kill-buffer-check buf (cdr c))))
+ ((eq (car-safe c) 'or)
+ (project--kill-buffer-check buf (cdr c)))
+ ((eq (car-safe c) 'and)
+ (seq-every-p
+ (apply-partially #'project--kill-buffer-check
+ buf)
+ (mapcar #'list (cdr c)))))
+ (throw 'kill t)))))
+
+(defun project--buffers-to-kill (pr)
+ "Return list of buffers in project PR to kill.
+What buffers should or should not be killed is described
+in `project-kill-buffer-conditions'."
+ (let (bufs)
+ (dolist (buf (project--buffer-list pr))
+ (when (project--kill-buffer-check buf project-kill-buffer-conditions)
+ (push buf bufs)))
+ bufs))
+
+;;;###autoload
+(defun project-kill-buffers (&optional no-confirm)
+ "Kill the buffers belonging to the current project.
+Two buffers belong to the same project if their project
+instances, as reported by `project-current' in each buffer, are
+identical. Only the buffers that match a condition in
+`project-kill-buffer-conditions' will be killed. If NO-CONFIRM
+is non-nil, the command will not ask the user for confirmation.
+NO-CONFIRM is always nil when the command is invoked
+interactively."
+ (interactive)
+ (let* ((pr (project-current t))
+ (bufs (project--buffers-to-kill pr)))
+ (cond (no-confirm
+ (mapc #'kill-buffer bufs))
+ ((null bufs)
+ (message "No buffers to kill"))
+ ((yes-or-no-p (format "Kill %d buffers in %s? "
+ (length bufs)
+ (project-root pr)))
+ (mapc #'kill-buffer bufs)))))
+
+
+;;; Project list
+
+(defcustom project-list-file (locate-user-emacs-file "projects")
+ "File in which to save the list of known projects."
+ :type 'file
+ :version "28.1"
+ :group 'project)
+
+(defvar project--list 'unset
+ "List structure containing root directories of known projects.
+With some possible metadata (to be decided).")
+
+(defun project--read-project-list ()
+ "Initialize `project--list' using contents of `project-list-file'."
+ (let ((filename project-list-file))
+ (setq project--list
+ (when (file-exists-p filename)
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (read (current-buffer)))))
+ (unless (seq-every-p
+ (lambda (elt) (stringp (car-safe elt)))
+ project--list)
+ (warn "Contents of %s are in wrong format, resetting"
+ project-list-file)
+ (setq project--list nil))))
+
+(defun project--ensure-read-project-list ()
+ "Initialize `project--list' if it isn't already initialized."
+ (when (eq project--list 'unset)
+ (project--read-project-list)))
+
+(defun project--write-project-list ()
+ "Save `project--list' in `project-list-file'."
+ (let ((filename project-list-file))
+ (with-temp-buffer
+ (insert ";;; -*- lisp-data -*-\n")
+ (pp project--list (current-buffer))
+ (write-region nil nil filename nil 'silent))))
+
+;;;###autoload
+(defun project-remember-project (pr)
+ "Add project PR to the front of the project list.
+Save the result in `project-list-file' if the list of projects has changed."
+ (project--ensure-read-project-list)
+ (let ((dir (project-root pr)))
+ (unless (equal (caar project--list) dir)
+ (dolist (ent project--list)
+ (when (equal dir (car ent))
+ (setq project--list (delq ent project--list))))
+ (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.
+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."
+ (project--ensure-read-project-list)
+ (when-let ((ent (assoc pr-dir project--list)))
+ (setq project--list (delq ent project--list))
+ (message "Project `%s' not found; removed from list" pr-dir)
+ (project--write-project-list)))
+
+(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,
+see `project-list-file'.
+It's also possible to enter an arbitrary directory not in the list."
+ (project--ensure-read-project-list)
+ (let* ((dir-choice "... (choose a dir)")
+ (choices
+ ;; XXX: Just using this for the category (for the substring
+ ;; completion style).
+ (project--file-completion-table
+ (append project--list `(,dir-choice))))
+ (pr-dir (completing-read "Select project: " choices nil t)))
+ (if (equal pr-dir dir-choice)
+ (read-directory-name "Select directory: " default-directory nil t)
+ pr-dir)))
+
+;;;###autoload
+(defun project-known-project-roots ()
+ "Return the list of root directories of all known projects."
+ (project--ensure-read-project-list)
+ (mapcar #'car project--list))
+
+
+;;; Project switching
+
+;;;###autoload
+(defvar project-switch-commands
+ '((?f "Find file" project-find-file)
+ (?g "Find regexp" project-find-regexp)
+ (?d "Dired" project-dired)
+ (?v "VC-Dir" project-vc-dir)
+ (?e "Eshell" project-eshell))
+ "Alist mapping keys to project switching menu entries.
+Used by `project-switch-project' to construct a dispatch menu of
+commands available upon \"switching\" to another project.
+
+Each element is of the form (KEY LABEL COMMAND), where COMMAND is the
+command to run when KEY is pressed. LABEL is used to distinguish
+the menu entries in the dispatch menu.")
+
+(defun project--keymap-prompt ()
+ "Return a prompt for the project switching dispatch menu."
+ (mapconcat
+ (pcase-lambda (`(,key ,label))
+ (format "[%s] %s"
+ (propertize (key-description `(,key)) 'face 'bold)
+ label))
+ project-switch-commands
+ " "))
+
+;;;###autoload
+(defun project-switch-project ()
+ "\"Switch\" to another project by running an Emacs command.
+The available commands are presented as a dispatch menu
+made from `project-switch-commands'."
+ (interactive)
+ (let ((dir (project-prompt-project-dir))
+ (choice nil))
+ (while (not choice)
+ (setq choice (assq (read-event (project--keymap-prompt))
+ project-switch-commands)))
+ (let ((default-directory dir)
+ (project-current-inhibit-prompt t))
+ (call-interactively (nth 2 choice)))))
+
(provide 'project)
;;; project.el ends here
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 99b57354e25..124f652ed69 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -271,10 +271,6 @@
(require 'easymenu)
(require 'align)
-(eval-when-compile
- (or (fboundp 'use-region-p)
- (defsubst use-region-p () (region-exists-p))))
-
(defgroup prolog nil
"Editing and running Prolog and Mercury files."
:group 'languages)
@@ -780,12 +776,6 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24."
(modify-syntax-entry ?> "." table)
(modify-syntax-entry ?| "." table)
(modify-syntax-entry ?\' "\"" table)
-
- ;; Any better way to handle the 0'<char> construct?!?
- (when (and prolog-char-quote-workaround
- (not (fboundp 'syntax-propertize-rules)))
- (modify-syntax-entry ?0 "\\" table))
-
(modify-syntax-entry ?% "<" table)
(modify-syntax-entry ?\n ">" table)
(modify-syntax-entry ?* ". 23b" table)
@@ -1051,21 +1041,19 @@ VERSION is of the format (Major . Minor)"
alist)))
(defconst prolog-syntax-propertize-function
- (when (fboundp 'syntax-propertize-rules)
- (syntax-propertize-rules
- ;; GNU Prolog only accepts 0'\' rather than 0'', but the only
- ;; possible meaning of 0'' is rather clear.
- ("\\<0\\(''?\\)"
- (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
- (string-to-syntax "_"))))
- ;; We could check that we're not inside an atom, but I don't think
- ;; that 'foo 8'z could be a valid syntax anyway, so why bother?
- ("\\<[1-9][0-9]*\\('\\)[0-9a-zA-Z]" (1 "_"))
- ;; Supposedly, ISO-Prolog wants \NNN\ for octal and \xNNN\ for hexadecimal
- ;; escape sequences in atoms, so be careful not to let the terminating \
- ;; escape a subsequent quote.
- ("\\\\[x0-7][[:xdigit:]]*\\(\\\\\\)" (1 "_"))
- )))
+ (syntax-propertize-rules
+ ;; GNU Prolog only accepts 0'\' rather than 0'', but the only
+ ;; possible meaning of 0'' is rather clear.
+ ("\\<0\\(''?\\)"
+ (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
+ (string-to-syntax "_"))))
+ ;; We could check that we're not inside an atom, but I don't think
+ ;; that 'foo 8'z could be a valid syntax anyway, so why bother?
+ ("\\<[1-9][0-9]*\\('\\)[0-9a-zA-Z]" (1 "_"))
+ ;; Supposedly, ISO-Prolog wants \NNN\ for octal and \xNNN\ for hexadecimal
+ ;; escape sequences in atoms, so be careful not to let the terminating \
+ ;; escape a subsequent quote.
+ ("\\\\[x0-7][[:xdigit:]]*\\(\\\\\\)" (1 "_"))))
(defun prolog-mode-variables ()
"Set some common variables to Prolog code specific values."
@@ -1890,14 +1878,7 @@ Argument BOUND is a buffer position limiting searching."
bound t)))
point))
-(defsubst prolog-face-name-p (facename)
- ;; Return t if FACENAME is the name of a face. This method is
- ;; necessary since facep in XEmacs only returns t for the actual
- ;; face objects (while it's only their names that are used just
- ;; about anywhere else) without providing a predicate that tests
- ;; face names. This function (including the above commentary) is
- ;; borrowed from cc-mode.
- (memq facename (face-list)))
+(define-obsolete-function-alias 'prolog-face-name-p 'facep "28.1")
;; Set everything up
(defun prolog-font-lock-keywords ()
@@ -1932,6 +1913,8 @@ Argument BOUND is a buffer position limiting searching."
(t (:underline t)))
"Face name to use for compiler warnings."
:group 'prolog-faces)
+ (define-obsolete-face-alias 'prolog-warning-face
+ 'font-lock-warning-face "28.1")
(defface prolog-builtin-face
'((((class color) (background light)) (:foreground "Purple"))
(((class color) (background dark)) (:foreground "Cyan"))
@@ -1941,15 +1924,11 @@ Argument BOUND is a buffer position limiting searching."
(t (:bold t)))
"Face name to use for compiler warnings."
:group 'prolog-faces)
- (defvar prolog-warning-face
- (if (prolog-face-name-p 'font-lock-warning-face)
- 'font-lock-warning-face
- 'prolog-warning-face)
+ (define-obsolete-face-alias 'prolog-builtin-face
+ 'font-lock-builtin-face "28.1")
+ (defvar prolog-warning-face 'font-lock-warning-face
"Face name to use for built in predicates.")
- (defvar prolog-builtin-face
- (if (prolog-face-name-p 'font-lock-builtin-face)
- 'font-lock-builtin-face
- 'prolog-builtin-face)
+ (defvar prolog-builtin-face 'font-lock-builtin-face
"Face name to use for built in predicates.")
(defvar prolog-redo-face 'prolog-redo-face
"Face name to use for redo trace lines.")
@@ -2295,12 +2274,12 @@ between them)."
(progn
(goto-char cbeg)
(search-forward-regexp "%+[ \t]*" end t)
- (prolog-replace-in-string (buffer-substring beg (point))
- "[^ \t%]" " "))
+ (replace-regexp-in-string "[^ \t%]" " "
+ (buffer-substring beg (point))))
;(goto-char beg)
(if (search-forward-regexp "^[ \t]*\\(%+\\|\\*+\\|/\\*+\\)[ \t]*"
end t)
- (prolog-replace-in-string (buffer-substring beg (point)) "/" " ")
+ (replace-regexp-in-string "/" " " (buffer-substring beg (point)))
(beginning-of-line)
(when (search-forward-regexp "^[ \t]+" end t)
(buffer-substring beg (point)))))))))
@@ -2340,11 +2319,10 @@ In effect it sets the `fill-prefix' when inside comments and then calls
(do-auto-fill)
))
-(defalias 'prolog-replace-in-string
- (if (fboundp 'replace-in-string)
- #'replace-in-string
- (lambda (str regexp newtext &optional literal)
- (replace-regexp-in-string regexp newtext str nil literal))))
+(defun prolog-replace-in-string (str regexp newtext &optional literal)
+ (declare (obsolete replace-regexp-in-string "28.1"))
+ (replace-regexp-in-string regexp newtext str nil literal))
+
;;-------------------------------------------------------------------
;; Online help
@@ -2373,12 +2351,8 @@ In effect it sets the `fill-prefix' when inside comments and then calls
;; in prolog-help-function-i
(t
(let* ((word (prolog-atom-under-point))
- (predicate (read-string
- (format "Help on predicate%s: "
- (if word
- (concat " (default " word ")")
- ""))
- nil nil word))
+ (predicate (read-string (format-prompt "Help on predicate" word)
+ nil nil word))
;;point
)
(if prolog-help-function-i
@@ -2752,20 +2726,6 @@ When called with prefix argument ARG, disable zipping instead."
(nth 1 state)))
))))
-;; For backward compatibility. Stolen from custom.el.
-(or (fboundp 'match-string)
- ;; Introduced in Emacs 19.29.
- (defun match-string (num &optional string)
- "Return string of text matched by last search.
-NUM specifies which parenthesized expression in the last regexp.
- Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
-Zero means the entire text matched by the whole regexp or whole string.
-STRING should be given if the last search was by `string-match' on STRING."
- (if (match-beginning num)
- (if string
- (substring string (match-beginning num) (match-end num))
- (buffer-substring (match-beginning num) (match-end num))))))
-
(defun prolog-pred-start ()
"Return the starting point of the first clause of the current predicate."
;; FIXME: Use SMIE.
@@ -3105,12 +3065,8 @@ The module name should be written manually just before the semi-colon."
(insert "%%% -*- Module: ; -*-\n")
(backward-char 6))
-(defalias 'prolog-uncomment-region
- (if (fboundp 'uncomment-region) #'uncomment-region
- (lambda (beg end)
- "Uncomment the region between BEG and END."
- (interactive "r")
- (comment-region beg end -1))))
+(define-obsolete-function-alias 'prolog-uncomment-region
+ 'uncomment-region "28.1")
(defun prolog-indent-predicate ()
"Indent the current predicate."
@@ -3396,7 +3352,7 @@ PREFIX is the prefix of the search regexp."
"Commands for Prolog code manipulation."
'("Prolog"
["Comment region" comment-region (use-region-p)]
- ["Uncomment region" prolog-uncomment-region (use-region-p)]
+ ["Uncomment region" uncomment-region (use-region-p)]
["Add comment/move to comment" indent-for-comment t]
["Convert variables in region to '_'" prolog-variables-to-anonymous
:active (use-region-p) :included (not (eq prolog-system 'mercury))]
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 2d47cdc4068..76baa4469c7 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -261,7 +261,6 @@
(require 'ansi-color)
(require 'cl-lib)
(require 'comint)
-(require 'json)
(require 'tramp-sh)
;; Avoid compiler warnings
@@ -284,24 +283,6 @@
:link '(emacs-commentary-link "python"))
-;;; 24.x Compat
-
-
-(eval-and-compile
- (unless (fboundp 'prog-first-column)
- (defun prog-first-column ()
- 0))
- (unless (fboundp 'file-local-name)
- (defun file-local-name (file)
- "Return the local name component of FILE.
-It returns a file name which can be used directly as argument of
-`process-file', `start-file-process', or `shell-command'."
- (or (file-remote-p file 'localname) file))))
-
-;; In Emacs 24.3 and earlier, `define-derived-mode' does not define
-;; the hook variable, it only puts documentation on the symbol.
-(defvar inferior-python-mode-hook)
-
;;; Bindings
@@ -634,6 +615,8 @@ builtins.")
(,(lambda (limit)
(let ((re (python-rx (group (+ (any word ?. ?_)))
(? ?\[ (+ (not (any ?\]))) ?\]) (* space)
+ ;; A type, like " : int ".
+ (? ?: (* space) (+ (any word ?. ?_)) (* space))
assignment-operator))
(res nil))
(while (and (setq res (re-search-forward re limit t))
@@ -1993,7 +1976,7 @@ position, else returns nil."
;; IPython prompts activated, this adds some safeguard for that.
"In : " "\\.\\.\\.: ")
"List of regular expressions matching input prompts."
- :type '(repeat string)
+ :type '(repeat regexp)
:version "24.4")
(defcustom python-shell-prompt-output-regexps
@@ -2001,28 +1984,28 @@ position, else returns nil."
"Out\\[[0-9]+\\]: " ; IPython
"Out :") ; ipdb safeguard
"List of regular expressions matching output prompts."
- :type '(repeat string)
+ :type '(repeat regexp)
:version "24.4")
(defcustom python-shell-prompt-regexp ">>> "
"Regular expression matching top level input prompt of Python shell.
It should not contain a caret (^) at the beginning."
- :type 'string)
+ :type 'regexp)
(defcustom python-shell-prompt-block-regexp "\\.\\.\\.:? "
"Regular expression matching block input prompt of Python shell.
It should not contain a caret (^) at the beginning."
- :type 'string)
+ :type 'regexp)
(defcustom python-shell-prompt-output-regexp ""
"Regular expression matching output prompt of Python shell.
It should not contain a caret (^) at the beginning."
- :type 'string)
+ :type 'regexp)
(defcustom python-shell-prompt-pdb-regexp "[(<]*[Ii]?[Pp]db[>)]+ "
"Regular expression matching pdb input prompt of Python shell.
It should not contain a caret (^) at the beginning."
- :type 'string)
+ :type 'regexp)
(define-obsolete-variable-alias
'python-shell-enable-font-lock 'python-shell-font-lock-enable "25.1")
@@ -2076,7 +2059,7 @@ that they are prioritized when looking for executables."
When this variable is non-nil, values are exported into remote
hosts PATH before starting processes. Values defined in
`python-shell-exec-path' will take precedence to paths defined
-here. Normally you wont use this variable directly unless you
+here. Normally you won't use this variable directly unless you
plan to ensure a particular set of paths to all Python shell
executed through tramp connections."
:version "25.1"
@@ -2091,7 +2074,7 @@ executed through tramp connections."
This variable, when set to a string, makes the environment to be
modified such that shells are started within the specified
virtualenv."
- :type '(choice (const nil) string)
+ :type '(choice (const nil) directory)
:group 'python)
(defcustom python-shell-setup-codes nil
@@ -2111,7 +2094,7 @@ virtualenv."
"(" (group (1+ digit)) ")" (1+ (not (any "("))) "()")
1 2))
"`compilation-error-regexp-alist' for inferior Python."
- :type '(alist string)
+ :type '(alist regexp)
:group 'python)
(defmacro python-shell--add-to-path-with-priority (pathvar paths)
@@ -2276,6 +2259,18 @@ Do not set this variable directly, instead use
Do not set this variable directly, instead use
`python-shell-prompt-set-calculated-regexps'.")
+(defalias 'python--parse-json-array
+ (if (fboundp 'json-parse-string)
+ (lambda (string)
+ (json-parse-string string :array-type 'list))
+ (require 'json)
+ (defvar json-array-type)
+ (declare-function json-read-from-string "json" (string))
+ (lambda (string)
+ (let ((json-array-type 'list))
+ (json-read-from-string string))))
+ "Parse the JSON array in STRING into a Lisp list.")
+
(defun python-shell-prompt-detect ()
"Detect prompts for the current `python-shell-interpreter'.
When prompts can be retrieved successfully from the
@@ -2324,11 +2319,11 @@ detection and just returns nil."
(catch 'prompts
(dolist (line (split-string output "\n" t))
(let ((res
- ;; Check if current line is a valid JSON array
- (and (string= (substring line 0 2) "[\"")
+ ;; Check if current line is a valid JSON array.
+ (and (string-prefix-p "[\"" line)
(ignore-errors
- ;; Return prompts as a list, not vector
- (append (json-read-from-string line) nil)))))
+ ;; Return prompts as a list.
+ (python--parse-json-array line)))))
;; The list must contain 3 strings, where the first
;; is the input prompt, the second is the block
;; prompt and the last one is the output prompt. The
@@ -2798,6 +2793,7 @@ variable.
python-shell-comint-watch-for-first-prompt-output-filter
python-comint-postoutput-scroll-to-bottom
comint-watch-for-password-prompt))
+ (setq-local comint-highlight-input nil)
(set (make-local-variable 'compilation-error-regexp-alist)
python-shell-compilation-regexp-alist)
(add-hook 'completion-at-point-functions
@@ -3080,7 +3076,7 @@ Returns the output. See `python-shell-send-string-no-output'."
(define-obsolete-function-alias
'python-send-string 'python-shell-internal-send-string "24.3")
-(defun python-shell-buffer-substring (start end &optional nomain)
+(defun python-shell-buffer-substring (start end &optional nomain no-cookie)
"Send buffer substring from START to END formatted for shell.
This is a wrapper over `buffer-substring' that takes care of
different transformations for the code sent to be evaluated in
@@ -3106,12 +3102,13 @@ the python shell:
(goto-char start)
(python-util-forward-comment 1)
(current-indentation))))
- (fillstr (when (not starts-at-point-min-p)
- (concat
- (format "# -*- coding: %s -*-\n" encoding)
- (make-string
- ;; Subtract 2 because of the coding cookie.
- (- (line-number-at-pos start) 2) ?\n)))))
+ (fillstr (and (not no-cookie)
+ (not starts-at-point-min-p)
+ (concat
+ (format "# -*- coding: %s -*-\n" encoding)
+ (make-string
+ ;; Subtract 2 because of the coding cookie.
+ (- (line-number-at-pos start) 2) ?\n)))))
(with-temp-buffer
(python-mode)
(when fillstr
@@ -3150,7 +3147,8 @@ the python shell:
(line-beginning-position) (line-end-position))))
(buffer-substring-no-properties (point-min) (point-max)))))
-(defun python-shell-send-region (start end &optional send-main msg)
+(defun python-shell-send-region (start end &optional send-main msg
+ no-cookie)
"Send the region delimited by START and END to inferior Python process.
When optional argument SEND-MAIN is non-nil, allow execution of
code inside blocks delimited by \"if __name__== \\='__main__\\=':\".
@@ -3160,7 +3158,8 @@ non-nil, forces display of a user-friendly message if there's no
process running; defaults to t when called interactively."
(interactive
(list (region-beginning) (region-end) current-prefix-arg t))
- (let* ((string (python-shell-buffer-substring start end (not send-main)))
+ (let* ((string (python-shell-buffer-substring start end (not send-main)
+ no-cookie))
(process (python-shell-get-process-or-error msg))
(original-string (buffer-substring-no-properties start end))
(_ (string-match "\\`\n*\\(.*\\)" original-string)))
@@ -3184,7 +3183,7 @@ interactively."
(python-shell-send-region
(save-excursion (python-nav-beginning-of-statement))
(save-excursion (python-nav-end-of-statement))
- send-main msg)))
+ send-main msg t)))
(defun python-shell-send-buffer (&optional send-main msg)
"Send the entire buffer to inferior Python process.
@@ -3206,27 +3205,29 @@ optional argument MSG is non-nil, forces display of a
user-friendly message if there's no process running; defaults to
t when called interactively."
(interactive (list current-prefix-arg t))
- (save-excursion
- (python-shell-send-region
- (progn
- (end-of-line 1)
- (while (and (or (python-nav-beginning-of-defun)
- (beginning-of-line 1))
- (> (current-indentation) 0)))
- (when (not arg)
- (while (and
- (eq (forward-line -1) 0)
- (if (looking-at (python-rx decorator))
- t
- (forward-line 1)
- nil))))
- (point-marker))
- (progn
- (or (python-nav-end-of-defun)
- (end-of-line 1))
- (point-marker))
- nil ;; noop
- msg)))
+ (let ((starting-pos (point)))
+ (save-excursion
+ (python-shell-send-region
+ (progn
+ (end-of-line 1)
+ (while (and (or (python-nav-beginning-of-defun)
+ (beginning-of-line 1))
+ (> (current-indentation) 0)))
+ (when (not arg)
+ (while (and
+ (eq (forward-line -1) 0)
+ (if (looking-at (python-rx decorator))
+ t
+ (forward-line 1)
+ nil))))
+ (point-marker))
+ (progn
+ (goto-char starting-pos)
+ (or (python-nav-end-of-defun)
+ (end-of-line 1))
+ (point-marker))
+ nil ;; noop
+ msg))))
(defun python-shell-send-file (file-name &optional process temp-file-name
delete msg)
@@ -3787,7 +3788,7 @@ the top stack frame has been reached.
Filename is expected in the first parenthesized expression.
Line number is expected in the second parenthesized expression."
- :type 'string
+ :type 'regexp
:version "27.1"
:safe 'stringp)
@@ -3802,7 +3803,7 @@ was `continue'. This behavior slightly differentiates the `continue' command
from the `exit' command listed in `python-pdbtrack-exit-command'.
See `python-pdbtrack-activate' for pdbtracking session overview."
- :type 'list
+ :type '(repeat string)
:version "27.1")
(defcustom python-pdbtrack-exit-command '("q" "quit" "exit")
@@ -3811,7 +3812,7 @@ After one of this commands is sent to pdb, pdbtracking session is
considered over.
See `python-pdbtrack-activate' for pdbtracking session overview."
- :type 'list
+ :type '(repeat string)
:version "27.1")
(defcustom python-pdbtrack-kill-buffers t
@@ -4136,7 +4137,7 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'."
(goto-char (point-max)))
(point-marker)))
(multi-line-p
- ;; Docstring styles may vary for oneliners and multi-liners.
+ ;; Docstring styles may vary for one-liners and multi-liners.
(> (count-matches "\n" str-start-pos str-end-pos) 0))
(delimiters-style
(pcase python-fill-docstring-style
@@ -4562,7 +4563,7 @@ returns will be used. If not FORCE-PROCESS is passed what
:type 'boolean
:version "25.1")
-(defun python-eldoc-function ()
+(defun python-eldoc-function (&rest _ignored)
"`eldoc-documentation-function' for Python.
For this to work as best as possible you should call
`python-shell-send-buffer' from time to time so context in
@@ -4591,9 +4592,7 @@ Interactively, prompt for symbol."
(interactive
(let ((symbol (python-eldoc--get-symbol-at-point))
(enable-recursive-minibuffers t))
- (list (read-string (if symbol
- (format "Describe symbol (default %s): " symbol)
- "Describe symbol: ")
+ (list (read-string (format-prompt "Describe symbol" symbol)
nil nil symbol))))
(message (python-eldoc--get-doc-at-point symbol)))
@@ -5137,21 +5136,22 @@ point's current `syntax-ppss'."
(>=
2
(let (last-backward-sexp-point)
- (while (save-excursion
- (python-nav-backward-sexp)
- (setq backward-sexp-point (point))
- (and (= indentation (current-indentation))
- ;; Make sure we're always moving point.
- ;; If we get stuck in the same position
- ;; on consecutive loop iterations,
- ;; bail out.
- (prog1 (not (eql last-backward-sexp-point
- backward-sexp-point))
- (setq last-backward-sexp-point
- backward-sexp-point))
- (looking-at-p
- (concat "[uU]?[rR]?"
- (python-rx string-delimiter)))))
+ (while (and (<= counter 2)
+ (save-excursion
+ (python-nav-backward-sexp)
+ (setq backward-sexp-point (point))
+ (and (= indentation (current-indentation))
+ ;; Make sure we're always moving point.
+ ;; If we get stuck in the same position
+ ;; on consecutive loop iterations,
+ ;; bail out.
+ (prog1 (not (eql last-backward-sexp-point
+ backward-sexp-point))
+ (setq last-backward-sexp-point
+ backward-sexp-point))
+ (looking-at-p
+ (concat "[uU]?[rR]?"
+ (python-rx string-delimiter))))))
;; Previous sexp was a string, restore point.
(goto-char backward-sexp-point)
(cl-incf counter))
@@ -5343,7 +5343,7 @@ To use `flake8' you would set this to (\"flake8\" \"-\")."
:group 'python-flymake
:type '(repeat string))
-;; The default regexp accomodates for older pyflakes, which did not
+;; The default regexp accommodates for older pyflakes, which did not
;; report the column number, and at the same time it's compatible with
;; flake8 output, although it may be redefined to explicitly match the
;; TYPE
@@ -5542,12 +5542,16 @@ REPORT-FN is Flymake's callback function."
(current-column))))
(^ '(- (1+ (current-indentation))))))
- (if (null eldoc-documentation-function)
- ;; Emacs<25
- (set (make-local-variable 'eldoc-documentation-function)
- #'python-eldoc-function)
- (add-function :before-until (local 'eldoc-documentation-function)
- #'python-eldoc-function))
+ (with-no-warnings
+ ;; suppress warnings about eldoc-documentation-function being obsolete
+ (if (null eldoc-documentation-function)
+ ;; Emacs<25
+ (set (make-local-variable 'eldoc-documentation-function)
+ #'python-eldoc-function)
+ (if (boundp 'eldoc-documentation-functions)
+ (add-hook 'eldoc-documentation-functions #'python-eldoc-function nil t)
+ (add-function :before-until (local 'eldoc-documentation-function)
+ #'python-eldoc-function))))
(add-to-list
'hs-special-modes-alist
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 5da5577c108..14f00597bfc 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -4,7 +4,7 @@
;; Authors: Yukihiro Matsumoto
;; Nobuyoshi Nakada
-;; URL: http://www.emacswiki.org/cgi-bin/wiki/RubyMode
+;; URL: https://www.emacswiki.org/cgi-bin/wiki/RubyMode
;; Created: Fri Feb 4 14:49:13 JST 1994
;; Keywords: languages ruby
;; Version: 1.2
@@ -142,12 +142,11 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
"Regexp to match symbols.")
(defvar ruby-use-smie t)
+(make-obsolete-variable 'ruby-use-smie nil "28.1")
(defvar ruby-mode-map
(let ((map (make-sparse-keymap)))
(unless ruby-use-smie
- (define-key map (kbd "M-C-b") 'ruby-backward-sexp)
- (define-key map (kbd "M-C-f") 'ruby-forward-sexp)
(define-key map (kbd "M-C-q") 'ruby-indent-exp))
(when ruby-use-smie
(define-key map (kbd "M-C-d") 'smie-down-list))
@@ -170,14 +169,8 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
"--"
["Toggle String Quotes" ruby-toggle-string-quotes t]
"--"
- ["Backward Sexp" ruby-backward-sexp
- :visible (not ruby-use-smie)]
- ["Backward Sexp" backward-sexp
- :visible ruby-use-smie]
- ["Forward Sexp" ruby-forward-sexp
- :visible (not ruby-use-smie)]
- ["Forward Sexp" forward-sexp
- :visible ruby-use-smie]
+ ["Backward Sexp" backward-sexp t]
+ ["Forward Sexp" forward-sexp t]
["Indent Sexp" ruby-indent-exp
:visible (not ruby-use-smie)]
["Indent Sexp" prog-indent-sexp
@@ -741,10 +734,10 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'."
(defun ruby-mode-variables ()
"Set up initial buffer-local variables for Ruby mode."
(setq indent-tabs-mode ruby-indent-tabs-mode)
- (if ruby-use-smie
- (smie-setup ruby-smie-grammar #'ruby-smie-rules
- :forward-token #'ruby-smie--forward-token
- :backward-token #'ruby-smie--backward-token)
+ (smie-setup ruby-smie-grammar #'ruby-smie-rules
+ :forward-token #'ruby-smie--forward-token
+ :backward-token #'ruby-smie--backward-token)
+ (unless ruby-use-smie
(setq-local indent-line-function #'ruby-indent-line))
(setq-local comment-start "# ")
(setq-local comment-end "")
@@ -801,7 +794,7 @@ The style of the comment is controlled by `ruby-encoding-magic-comment-style'."
(let ((coding-system (ruby--detect-encoding)))
(when coding-system
(if (looking-at "^#!") (beginning-of-line 2))
- (cond ((looking-at "\\s *#\\s *.*\\(en\\)?coding\\s *:\\s *\\([-a-z0-9_]*\\)")
+ (cond ((looking-at "\\s *#.*\\(en\\)?coding\\s *:\\s *\\([-a-z0-9_]*\\)")
;; update existing encoding comment if necessary
(unless (string= (match-string 2) coding-system)
(goto-char (match-beginning 2))
@@ -1060,22 +1053,12 @@ delimiter."
(goto-char (point))
)
((looking-at "[\\[{(]")
- (let ((deep (ruby-deep-indent-paren-p (char-after))))
- (if (and deep (or (not (eq (char-after) ?\{)) (ruby-expr-beg)))
- (progn
- (and (eq deep 'space) (looking-at ".\\s +[^# \t\n]")
- (setq pnt (1- (match-end 0))))
- (setq nest (cons (cons (char-after (point)) pnt) nest))
- (setq pcol (cons (cons pnt depth) pcol))
- (setq depth 0))
- (setq nest (cons (cons (char-after (point)) pnt) nest))
- (setq depth (1+ depth))))
+ (setq nest (cons (cons (char-after (point)) pnt) nest))
+ (setq depth (1+ depth))
(goto-char pnt)
)
((looking-at "[])}]")
- (if (ruby-deep-indent-paren-p (matching-paren (char-after)))
- (setq depth (cdr (car pcol)) pcol (cdr pcol))
- (setq depth (1- depth)))
+ (setq depth (1- depth))
(setq nest (cdr nest))
(goto-char pnt))
((looking-at ruby-block-end-re)
@@ -1388,7 +1371,8 @@ move forward."
The defun begins at or after the point. This function is called
by `end-of-defun'."
(interactive "p")
- (ruby-forward-sexp)
+ (with-suppressed-warnings ((obsolete ruby-forward-sexp))
+ (ruby-forward-sexp))
(let (case-fold-search)
(when (looking-back (concat "^\\s *" ruby-block-end-re)
(line-beginning-position))
@@ -1477,11 +1461,14 @@ With ARG, move out of multiple blocks."
(defun ruby-forward-sexp (&optional arg)
"Move forward across one balanced expression (sexp).
With ARG, do it many times. Negative ARG means move backward."
+ (declare (obsolete forward-sexp "28.1"))
;; TODO: Document body
(interactive "p")
(cond
(ruby-use-smie (forward-sexp arg))
- ((and (numberp arg) (< arg 0)) (ruby-backward-sexp (- arg)))
+ ((and (numberp arg) (< arg 0))
+ (with-suppressed-warnings ((obsolete ruby-backward-sexp))
+ (ruby-backward-sexp (- arg))))
(t
(let ((i (or arg 1)))
(condition-case nil
@@ -1525,11 +1512,14 @@ With ARG, do it many times. Negative ARG means move backward."
(defun ruby-backward-sexp (&optional arg)
"Move backward across one balanced expression (sexp).
With ARG, do it many times. Negative ARG means move forward."
+ (declare (obsolete backward-sexp "28.1"))
;; TODO: Document body
(interactive "p")
(cond
(ruby-use-smie (backward-sexp arg))
- ((and (numberp arg) (< arg 0)) (ruby-forward-sexp (- arg)))
+ ((and (numberp arg) (< arg 0))
+ (with-suppressed-warnings ((obsolete ruby-forward-sexp))
+ (ruby-forward-sexp (- arg))))
(t
(let ((i (or arg 1)))
(condition-case nil
@@ -1681,7 +1671,8 @@ See `add-log-current-defun-function'."
(defun ruby-block-contains-point (pt)
(save-excursion
(save-match-data
- (ruby-forward-sexp)
+ (with-suppressed-warnings ((obsolete ruby-forward-sexp))
+ (ruby-forward-sexp))
(> (point) pt))))
(defun ruby-brace-to-do-end (orig end)
@@ -1759,7 +1750,8 @@ If the result is do-end block, it will always be multiline."
(progn
(goto-char (or (match-beginning 1) (match-beginning 2)))
(setq beg (point))
- (save-match-data (ruby-forward-sexp))
+ (with-suppressed-warnings ((obsolete ruby-forward-sexp))
+ (save-match-data (ruby-forward-sexp)))
(setq end (point))
(> end start)))
(if (match-beginning 1)
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index 751d7da5427..33ba0d11d80 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -116,7 +116,7 @@
(defvar scheme-imenu-generic-expression
'((nil
- "^(define\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)*\\s-+(?\\(\\sw+\\)" 4)
+ "^(define\\(?:-\\(?:generic\\(?:-procedure\\)?\\|method\\)\\)?\\s-+(?\\(\\sw+\\)" 1)
("Types"
"^(define-class\\s-+(?\\(\\sw+\\)" 1)
("Macros"
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index cc6d5b46ed2..a8c0e045c6b 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -64,61 +64,10 @@
;; * Indent right half sh-basic-offset
;; / Indent left half sh-basic-offset.
;;
-;; There are 4 commands to help set the indentation variables:
-;;
-;; `sh-show-indent'
-;; This shows what variable controls the indentation of the current
-;; line and its value.
-;;
-;; `sh-set-indent'
-;; This allows you to set the value of the variable controlling the
-;; current line's indentation. You can enter a number or one of a
-;; number of special symbols to denote the value of sh-basic-offset,
-;; or its negative, or half it, or twice it, etc. If you've used
-;; cc-mode this should be familiar. If you forget which symbols are
-;; valid simply press C-h at the prompt.
-;;
-;; `sh-learn-line-indent'
-;; Simply make the line look the way you want it, then invoke this
-;; command. It will set the variable to the value that makes the line
-;; indent like that. If called with a prefix argument then it will set
-;; the value to one of the symbols if applicable.
-;;
-;; `sh-learn-buffer-indent'
-;; This is the deluxe function! It "learns" the whole buffer (use
-;; narrowing if you want it to process only part). It outputs to a
-;; buffer *indent* any conflicts it finds, and all the variables it has
-;; learned. This buffer is a sort of Occur mode buffer, allowing you to
-;; easily find where something was set. It is popped to automatically
-;; if there are any conflicts found or if `sh-popup-occur-buffer' is
-;; non-nil.
-;; `sh-indent-comment' will be set if all comments follow the same
-;; pattern; if they don't it will be set to nil.
-;; Whether `sh-basic-offset' is set is determined by variable
-;; `sh-learn-basic-offset'.
-;;
-;; Unfortunately, `sh-learn-buffer-indent' can take a long time to run
-;; (e.g. if there are large case statements). Perhaps it does not make
-;; sense to run it on large buffers: if lots of lines have different
-;; indentation styles it will produce a lot of diagnostics in the
-;; *indent* buffer; if there is a consistent style then running
-;; `sh-learn-buffer-indent' on a small region of the buffer should
-;; suffice.
-;;
;; Saving indentation values
;; -------------------------
-;; After you've learned the values in a buffer, how to you remember
-;; them? Originally I had hoped that `sh-learn-buffer-indent'
-;; would make this unnecessary; simply learn the values when you visit
-;; the buffer.
-;; You can do this automatically like this:
-;; (add-hook 'sh-set-shell-hook #'sh-learn-buffer-indent)
-;;
-;; However... `sh-learn-buffer-indent' is extremely slow,
-;; especially on large-ish buffer. Also, if there are conflicts the
-;; "last one wins" which may not produce the desired setting.
-;;
-;; So...There is a minimal way of being able to save indentation values and
+;; After you've learned the values in a buffer, how to you remember them?
+;; There is a minimal way of being able to save indentation values and
;; to reload them in another buffer or at another point in time.
;;
;; Use `sh-name-style' to give a name to the indentation settings of
@@ -132,7 +81,7 @@
;; Indentation variables - buffer local or global?
;; ----------------------------------------------
;; I think that often having them buffer-local makes sense,
-;; especially if one is using `sh-learn-buffer-indent'. However, if
+;; especially if one is using `smie-config-guess'. However, if
;; a user sets values using customization, these changes won't appear
;; to work if the variables are already local!
;;
@@ -175,18 +124,10 @@
;; - Indenting many lines is slow. It currently does each line
;; independently, rather than saving state information.
;;
-;; - `sh-learn-buffer-indent' is extremely slow.
-;;
-;; - "case $x in y) echo ;; esac)" the last ) is mis-identified as being
-;; part of a case-pattern. You need to add a semi-colon after "esac" to
-;; coerce sh-script into doing the right thing.
-;;
;; - "echo $z in ps | head)" the last ) is mis-identified as being part of
;; a case-pattern. You need to put the "in" between quotes to coerce
;; sh-script into doing the right thing.
;;
-;; - A line starting with "}>foo" is not indented like "} >foo".
-;;
;; Richard Sharman <rsharman@pobox.com> June 1999.
;;; Code:
@@ -445,6 +386,7 @@ name symbol."
?~ "_"
?, "_"
?= "."
+ ?/ "."
?\; "."
?| "."
?& "."
@@ -474,10 +416,10 @@ This is buffer-local in every such buffer.")
(define-key map "\C-c\C-i" 'sh-if)
(define-key map "\C-c\C-f" 'sh-for)
(define-key map "\C-c\C-c" 'sh-case)
- (define-key map "\C-c?" 'sh-show-indent)
- (define-key map "\C-c=" 'sh-set-indent)
- (define-key map "\C-c<" 'sh-learn-line-indent)
- (define-key map "\C-c>" 'sh-learn-buffer-indent)
+ (define-key map "\C-c?" #'smie-config-show-indent)
+ (define-key map "\C-c=" #'smie-config-set-indent)
+ (define-key map "\C-c<" #'smie-config-set-indent)
+ (define-key map "\C-c>" #'smie-config-guess)
(define-key map "\C-c\C-\\" 'sh-backslash-region)
(define-key map "\C-c+" 'sh-add)
@@ -493,17 +435,14 @@ This is buffer-local in every such buffer.")
(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 [sh-learn-buffer-indent]
- '(menu-item "Learn buffer indentation" sh-learn-buffer-indent
+ (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 [sh-learn-line-indent]
- '(menu-item "Learn line indentation" sh-learn-line-indent
- :help "Learn how to indent a line as it currently is indented"))
- (define-key menu-map [sh-show-indent]
- '(menu-item "Show indentation" sh-show-indent
+ (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 [sh-set-indent]
- '(menu-item "Set indentation" sh-set-indent
+ (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]
@@ -900,7 +839,7 @@ See `sh-feature'.")
font-lock-variable-name-face))
(rc sh-append es)
- (bash sh-append sh ("\\$(\\(\\sw+\\)" (1 'sh-quoted-exec t) ))
+ (bash sh-append sh ("\\$(\\([^)\n]+\\)" (1 'sh-quoted-exec t) ))
(sh sh-append shell
;; Variable names.
("\\$\\({#?\\)?\\([[:alpha:]_][[:alnum:]_]*\\|[-#?@!]\\)" 2
@@ -1158,7 +1097,7 @@ subshells can nest."
(")" (0 (sh-font-lock-paren (match-beginning 0))))
;; Highlight (possibly nested) subshells inside "" quoted
;; regions correctly.
- ("\"\\(?:\\(?:[^\\\"]\\|\\\\.\\)*?\\)??\\(\\$(\\|`\\)"
+ ("\"\\(?:[^\\\"]\\|\\\\.\\)*?\\(\\$(\\|`\\)"
(1 (ignore
(if (nth 8 (save-excursion (syntax-ppss (match-beginning 0))))
(goto-char (1+ (match-beginning 0)))
@@ -1196,20 +1135,8 @@ and command `sh-reset-indent-vars-to-global-values'."
:options '(sh-electric-here-document-mode)
:group 'sh-script)
-(defcustom sh-learn-basic-offset nil
- "When `sh-guess-basic-offset' should learn `sh-basic-offset'.
-
-nil mean: never.
-t means: only if there seems to be an obvious value.
-Anything else means: whenever we have a \"good guess\" as to the value."
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "Only if sure" t)
- (const :tag "If have a good guess" usually))
- :group 'sh-indentation)
-
(defcustom sh-popup-occur-buffer nil
- "Controls when `sh-learn-buffer-indent' pops the `*indent*' buffer.
+ "Controls when `smie-config-guess' pops the `*indent*' buffer.
If t it is always shown. If nil, it is shown only when there
are conflicts."
:type '(choice
@@ -1217,14 +1144,6 @@ are conflicts."
(const :tag "Always" t))
:group 'sh-indentation)
-(defcustom sh-blink t
- "If non-nil, `sh-show-indent' shows the line indentation is relative to.
-The position on the line is not necessarily meaningful.
-In some cases the line will be the matching keyword, but this is not
-always the case."
- :type 'boolean
- :group 'sh-indentation)
-
(defcustom sh-first-lines-indent 0
"The indentation of the first non-blank non-comment line.
Usually 0 meaning first column.
@@ -1567,11 +1486,9 @@ following commands are available, based on the current shell's syntax:
\\[sh-while] while loop
For sh and rc shells indentation commands are:
-\\[sh-show-indent] Show the variable controlling this line's indentation.
-\\[sh-set-indent] Set then variable controlling this line's indentation.
-\\[sh-learn-line-indent] Change the indentation variable so this line
-would indent to the way it currently is.
-\\[sh-learn-buffer-indent] Set the indentation variables so the
+\\[smie-config-show-indent] Show the rules controlling this line's indentation.
+\\[smie-config-set-indent] Change the rules controlling this line's indentation.
+\\[smie-config-guess] Try to tweak the indentation rules so the
buffer indents as it currently is indented.
@@ -1738,13 +1655,6 @@ This adds rules for comments and assignments."
(require 'smie)
-;; The SMIE code should generally be preferred, but it currently does not obey
-;; the various indentation custom-vars, and it misses some important features
-;; of the old code, mostly: sh-learn-line/buffer-indent, sh-show-indent,
-;; sh-name/save/load-style.
-(defvar sh-use-smie t
- "Whether to use the SMIE code for navigation and indentation.")
-
(defun sh-smie--keyword-p ()
"Non-nil if we're at a keyword position.
A keyword position is one where if we're looking at something that looks
@@ -2279,60 +2189,6 @@ Point should be before the newline."
(defvar sh-regexp-for-done nil
"A buffer-local regexp to match opening keyword for done.")
-(defvar sh-kw-alist nil
- "A buffer-local, since it is shell-type dependent, list of keywords.")
-
-;; ( key-word first-on-this on-prev-line )
-;; This is used to set `sh-kw-alist' which is a list of sublists each
-;; having 3 elements:
-;; a keyword
-;; a rule to check when the keyword appears on "this" line
-;; a rule to check when the keyword appears on "the previous" line
-;; The keyword is usually a string and is the first word on a line.
-;; If this keyword appears on the line whose indentation is to be
-;; calculated, the rule in element 2 is called. If this returns
-;; non-zero, the resulting point (which may be changed by the rule)
-;; is used as the default indentation.
-;; If it returned false or the keyword was not found in the table,
-;; then the keyword from the previous line is looked up and the rule
-;; in element 3 is called. In this case, however,
-;; `sh-get-indent-info' does not stop but may keep going and test
-;; other keywords against rules in element 3. This is because the
-;; preceding line could have, for example, an opening "if" and an
-;; opening "while" keyword and we need to add the indentation offsets
-;; for both.
-;;
-(defconst sh-kw
- '((sh
- ("if" nil sh-handle-prev-if)
- ("elif" sh-handle-this-else sh-handle-prev-else)
- ("else" sh-handle-this-else sh-handle-prev-else)
- ("fi" sh-handle-this-fi sh-handle-prev-fi)
- ("then" sh-handle-this-then sh-handle-prev-then)
- ("(" nil sh-handle-prev-open)
- ("{" nil sh-handle-prev-open)
- ("[" nil sh-handle-prev-open)
- ("}" sh-handle-this-close nil)
- (")" sh-handle-this-close nil)
- ("]" sh-handle-this-close nil)
- ("case" nil sh-handle-prev-case)
- ("esac" sh-handle-this-esac sh-handle-prev-esac)
- (case-label nil sh-handle-after-case-label) ;; ???
- (";;" nil sh-handle-prev-case-alt-end) ;; ???
- (";;&" nil sh-handle-prev-case-alt-end) ;Like ";;" with diff semantics.
- (";&" nil sh-handle-prev-case-alt-end) ;Like ";;" with diff semantics.
- ("done" sh-handle-this-done sh-handle-prev-done)
- ("do" sh-handle-this-do sh-handle-prev-do))
-
- ;; Note: we don't need specific stuff for bash and zsh shells;
- ;; the regexp `sh-regexp-for-done' handles the extra keywords
- ;; these shells use.
- (rc
- ("{" nil sh-handle-prev-open)
- ("}" sh-handle-this-close nil)
- ("case" sh-handle-this-rc-case sh-handle-prev-rc-case))))
-
-
(defun sh-set-shell (shell &optional no-query-flag insert-flag)
"Set this buffer's shell to SHELL (a string).
@@ -2351,8 +2207,7 @@ Shell script files can cause this function be called automatically
when the file is visited by having a `sh-shell' file-local variable
whose value is the shell name (don't quote it)."
(interactive (list (completing-read
- (format "Shell (default %s): "
- sh-shell-file)
+ (format-prompt "Shell" sh-shell-file)
;; This used to use interpreter-mode-alist, but that is
;; no longer appropriate now that uses regexps.
;; Maybe there could be a separate variable that lists
@@ -2400,16 +2255,6 @@ whose value is the shell name (don't quote it)."
(funcall mksym "rules")
:forward-token (funcall mksym "forward-token")
:backward-token (funcall mksym "backward-token")))
- (unless sh-use-smie
- (setq-local sh-kw-alist (sh-feature sh-kw))
- (let ((regexp (sh-feature sh-kws-for-done)))
- (if regexp
- (setq-local sh-regexp-for-done
- (sh-mkword-regexpr (regexp-opt regexp t)))))
- (message "setting up indent stuff")
- ;; sh-mode has already made indent-line-function local
- ;; but do it in case this is called before that.
- (setq-local indent-line-function #'sh-indent-line))
(if sh-make-vars-local
(sh-make-vars-local))
(message "Indentation setup for shell type %s" sh-shell))
@@ -2564,11 +2409,6 @@ region, clear header."
(eq -1 (% (save-excursion (skip-chars-backward "\\\\")) 2)))
;; Indentation stuff.
-(defun sh-must-support-indent ()
- "Signal an error if the shell type for this buffer is not supported.
-Also, the buffer must be in Shell-script mode."
- (unless sh-indent-supported-here
- (error "This buffer's shell does not support indentation through Emacs")))
(defun sh-make-vars-local ()
"Make the indentation variables local to this buffer.
@@ -2589,654 +2429,12 @@ Then, if variable `sh-make-vars-local' is non-nil, make them local."
(if sh-make-vars-local
(mapcar 'make-local-variable sh-var-list)))
-
-;; Theoretically these are only needed in shell and derived modes.
-;; However, the routines which use them are only called in those modes.
-(defconst sh-special-keywords "then\\|do")
-
-(defun sh-help-string-for-variable (var)
- "Construct a string for `sh-read-variable' when changing variable VAR ."
- (let ((msg (documentation-property var 'variable-documentation))
- (msg2 ""))
- (unless (memq var '(sh-first-lines-indent sh-indent-comment))
- (setq msg2
- (format "\n
-You can enter a number (positive to increase indentation,
-negative to decrease indentation, zero for no change to indentation).
-
-Or, you can enter one of the following symbols which are relative to
-the value of variable `sh-basic-offset'
-which in this buffer is currently %s.
-
-\t%s."
- sh-basic-offset
- (mapconcat (lambda (x)
- (nth (1- (length x)) x))
- sh-symbol-list "\n\t"))))
- (concat
- ;; The following shows the global not the local value!
- ;; (format "Current value of %s is %s\n\n" var (symbol-value var))
- msg msg2)))
-
-(defun sh-read-variable (var)
- "Read a new value for indentation variable VAR."
- (let ((minibuffer-help-form `(sh-help-string-for-variable
- (quote ,var)))
- val)
- (setq val (read-from-minibuffer
- (format "New value for %s (press %s for help): "
- var (single-key-description help-char))
- (format "%s" (symbol-value var))
- nil t))
- val))
-
-
-
(defun sh-in-comment-or-string (start)
"Return non-nil if START is in a comment or string."
(save-excursion
(let ((state (syntax-ppss start)))
(or (nth 3 state) (nth 4 state)))))
-(defun sh-goto-matching-if ()
- "Go to the matching if for a fi.
-This handles nested if..fi pairs."
- (let ((found (sh-find-prev-matching "\\bif\\b" "\\bfi\\b" 1)))
- (if found
- (goto-char found))))
-
-
-;; Functions named sh-handle-this-XXX are called when the keyword on the
-;; line whose indentation is being handled contain XXX;
-;; those named sh-handle-prev-XXX are when XXX appears on the previous line.
-
-(defun sh-handle-prev-if ()
- (list '(+ sh-indent-after-if)))
-
-(defun sh-handle-this-else ()
- (if (sh-goto-matching-if)
- ;; (list "aligned to if")
- (list "aligned to if" '(+ sh-indent-for-else))
- nil
- ))
-
-(defun sh-handle-prev-else ()
- (if (sh-goto-matching-if)
- (list '(+ sh-indent-after-if))
- ))
-
-(defun sh-handle-this-fi ()
- (if (sh-goto-matching-if)
- (list "aligned to if" '(+ sh-indent-for-fi))
- nil
- ))
-
-(defun sh-handle-prev-fi ()
- ;; Why do we have this rule? Because we must go back to the if
- ;; to get its indent. We may continue back from there.
- ;; We return nil because we don't have anything to add to result,
- ;; the side affect of setting align-point is all that matters.
- ;; we could return a comment (a string) but I can't think of a good one...
- (sh-goto-matching-if)
- nil)
-
-(defun sh-handle-this-then ()
- (let ((p (sh-goto-matching-if)))
- (if p
- (list '(+ sh-indent-for-then))
- )))
-
-(defun sh-handle-prev-then ()
- (let ((p (sh-goto-matching-if)))
- (if p
- (list '(+ sh-indent-after-if))
- )))
-
-(defun sh-handle-prev-open ()
- (save-excursion
- (let ((x (sh-prev-stmt)))
- (if (and x
- (progn
- (goto-char x)
- (or
- (looking-at "function\\b")
- (looking-at "\\s-*\\S-+\\s-*()")
- )))
- (list '(+ sh-indent-after-function))
- (list '(+ sh-indent-after-open)))
- )))
-
-(defun sh-handle-this-close ()
- (forward-char 1) ;; move over ")"
- (if (sh-safe-forward-sexp -1)
- (list "aligned to opening paren")))
-
-(defun sh-goto-matching-case ()
- (let ((found (sh-find-prev-matching "\\bcase\\b" "\\besac\\b" 1)))
- (if found (goto-char found))))
-
-(defun sh-handle-prev-case ()
- ;; This is typically called when point is on same line as a case
- ;; we shouldn't -- and can't find prev-case
- (if (looking-at ".*\\<case\\>")
- (list '(+ sh-indent-for-case-label))
- (error "We don't seem to be on a line with a case"))) ;; debug
-
-(defun sh-handle-this-esac ()
- (if (sh-goto-matching-case)
- (list "aligned to matching case")))
-
-(defun sh-handle-prev-esac ()
- (if (sh-goto-matching-case)
- (list "matching case")))
-
-(defun sh-handle-after-case-label ()
- (if (sh-goto-matching-case)
- (list '(+ sh-indent-for-case-alt))))
-
-(defun sh-handle-prev-case-alt-end ()
- (if (sh-goto-matching-case)
- (list '(+ sh-indent-for-case-label))))
-
-(defun sh-safe-forward-sexp (&optional arg)
- "Try and do a `forward-sexp', but do not error.
-Return new point if successful, nil if an error occurred."
- (condition-case nil
- (progn
- (forward-sexp (or arg 1))
- (point)) ;; return point if successful
- (error
- (sh-debug "oops!(1) %d" (point))
- nil))) ;; return nil if fail
-
-(defun sh-goto-match-for-done ()
- (let ((found (sh-find-prev-matching sh-regexp-for-done sh-re-done 1)))
- (if found
- (goto-char found))))
-
-(defun sh-handle-this-done ()
- (if (sh-goto-match-for-done)
- (list "aligned to do stmt" '(+ sh-indent-for-done))))
-
-(defun sh-handle-prev-done ()
- (if (sh-goto-match-for-done)
- (list "previous done")))
-
-(defun sh-handle-this-do ()
- (if (sh-goto-match-for-done)
- (list '(+ sh-indent-for-do))))
-
-(defun sh-handle-prev-do ()
- (cond
- ((save-restriction
- (narrow-to-region (point) (line-beginning-position))
- (sh-goto-match-for-done))
- (sh-debug "match for done found on THIS line")
- (list '(+ sh-indent-after-loop-construct)))
- ((sh-goto-match-for-done)
- (sh-debug "match for done found on PREV line")
- (list '(+ sh-indent-after-do)))
- (t
- (message "match for done NOT found")
- nil)))
-
-;; for rc:
-(defun sh-find-prev-switch ()
- "Find the line for the switch keyword matching this line's case keyword."
- (re-search-backward "\\<switch\\>" nil t))
-
-(defun sh-handle-this-rc-case ()
- (if (sh-find-prev-switch)
- (list '(+ sh-indent-after-switch))
- ;; (list '(+ sh-indent-for-case-label))
- nil))
-
-(defun sh-handle-prev-rc-case ()
- (list '(+ sh-indent-after-case)))
-
-(defun sh-check-rule (n thing)
- (let ((rule (nth n (assoc thing sh-kw-alist)))
- (val nil))
- (if rule
- (progn
- (setq val (funcall rule))
- (sh-debug "rule (%d) for %s at %d is %s\n-> returned %s"
- n thing (point) rule val)))
- val))
-
-
-(defun sh-get-indent-info ()
- "Return indent-info for this line.
-This is a list. nil means the line is to be left as is.
-Otherwise it contains one or more of the following sublists:
-\(t NUMBER) NUMBER is the base location in the buffer that indentation is
- relative to. If present, this is always the first of the
- sublists. The indentation of the line in question is
- derived from the indentation of this point, possibly
- modified by subsequent sublists.
-\(+ VAR)
-\(- VAR) Get the value of variable VAR and add to or subtract from
- the indentation calculated so far.
-\(= VAR) Get the value of variable VAR and *replace* the
- indentation with its value. This only occurs for
- special variables such as `sh-indent-comment'.
-STRING This is ignored for the purposes of calculating
- indentation, it is printed in certain cases to help show
- what the indentation is based on."
- ;; See comments before `sh-kw'.
- (save-excursion
- (let ((have-result nil)
- this-kw
- val
- (result nil)
- (align-point nil)
- prev-line-end x)
- (beginning-of-line)
- ;; Note: setting result to t means we are done and will return nil.
- ;;(This function never returns just t.)
- (cond
- ((or (nth 3 (syntax-ppss (point)))
- (eq (get-text-property (point) 'face) 'sh-heredoc))
- ;; String continuation -- don't indent
- (setq result t)
- (setq have-result t))
- ((looking-at "\\s-*#") ; was (equal this-kw "#")
- (if (bobp)
- (setq result t) ;; return nil if 1st line!
- (setq result (list '(= sh-indent-comment)))
- ;; we still need to get previous line in case
- ;; sh-indent-comment is t (indent as normal)
- (setq align-point (sh-prev-line nil))
- (setq have-result nil)
- ))
- ) ;; cond
-
- (unless have-result
- ;; Continuation lines are handled specially
- (if (sh-this-is-a-continuation)
- (progn
- (setq result
- (if (save-excursion
- (beginning-of-line)
- (not (memq (char-before (- (point) 2)) '(?\s ?\t))))
- ;; By convention, if the continuation \ is not
- ;; preceded by a SPC or a TAB it means that the line
- ;; is cut at a place where spaces cannot be freely
- ;; added/removed. I.e. do not indent the line.
- (list '(= nil))
- ;; We assume the line being continued is already
- ;; properly indented...
- ;; (setq prev-line-end (sh-prev-line))
- (setq align-point (sh-prev-line nil))
- (list '(+ sh-indent-for-continuation))))
- (setq have-result t))
- (beginning-of-line)
- (skip-chars-forward " \t")
- (setq this-kw (sh-get-kw)))
-
- ;; Handle "this" keyword: first word on the line we're
- ;; calculating indentation info for.
- (if this-kw
- (if (setq val (sh-check-rule 1 this-kw))
- (progn
- (setq align-point (point))
- (sh-debug
- "this - setting align-point to %d" align-point)
- (setq result (append result val))
- (setq have-result t)
- ;; set prev-line to continue processing remainder
- ;; of this line as a previous line
- (setq prev-line-end (point))
- ))))
-
- (unless have-result
- (setq prev-line-end (sh-prev-line 'end)))
-
- (if prev-line-end
- (save-excursion
- ;; We start off at beginning of this line.
- ;; Scan previous statements while this is <=
- ;; start of previous line.
- (goto-char prev-line-end)
- (setq x t)
- (while (and x (setq x (sh-prev-thing)))
- (sh-debug "at %d x is: %s result is: %s" (point) x result)
- (cond
- ((and (equal x ")")
- (equal (get-text-property (1- (point)) 'syntax-table)
- sh-st-punc))
- (sh-debug "Case label) here")
- (setq x 'case-label)
- (if (setq val (sh-check-rule 2 x))
- (progn
- (setq result (append result val))
- (setq align-point (point))))
- (or (bobp)
- (forward-char -1))
- (skip-chars-forward "*0-9?[]a-z")
- )
- ((string-match "[])}]" x)
- (setq x (sh-safe-forward-sexp -1))
- (if x
- (progn
- (setq align-point (point))
- (setq result (append result
- (list "aligned to opening paren")))
- )))
- ((string-match "[[({]" x)
- (sh-debug "Checking special thing: %s" x)
- (if (setq val (sh-check-rule 2 x))
- (setq result (append result val)))
- (forward-char -1)
- (setq align-point (point)))
- ((string-match "[\"'`]" x)
- (sh-debug "Skipping back for %s" x)
- ;; this was oops-2
- (setq x (sh-safe-forward-sexp -1)))
- ((stringp x)
- (sh-debug "Checking string %s at %s" x (point))
- (if (setq val (sh-check-rule 2 x))
- ;; (or (eq t (car val))
- ;; (eq t (car (car val))))
- (setq result (append result val)))
- ;; not sure about this test Wed Jan 27 23:48:35 1999
- (setq align-point (point))
- (unless (bolp)
- (forward-char -1)))
- (t
- (error "Don't know what to do with %s" x))
- )
- ) ;; while
- (sh-debug "result is %s" result)
- )
- (sh-debug "No prev line!")
- (sh-debug "result: %s align-point: %s" result align-point)
- )
-
- (if align-point
- ;; was: (setq result (append result (list (list t align-point))))
- (setq result (append (list (list t align-point)) result))
- )
- (sh-debug "result is now: %s" result)
-
- (or result
- (setq result (list (if prev-line-end
- (list t prev-line-end)
- (list '= 'sh-first-lines-indent)))))
-
- (if (eq result t)
- (setq result nil))
- (sh-debug "result is: %s" result)
- result
- ) ;; let
- ))
-
-
-(defun sh-get-indent-var-for-line (&optional info)
- "Return the variable controlling indentation for this line.
-If there is not [just] one such variable, return a string
-indicating the problem.
-If INFO is supplied it is used, else it is calculated."
- (let ((var nil)
- (result nil)
- (reason nil)
- sym elt)
- (or info
- (setq info (sh-get-indent-info)))
- (if (null info)
- (setq result "this line to be left as is")
- (while (and info (null result))
- (setq elt (car info))
- (cond
- ((stringp elt)
- (setq reason elt)
- )
- ((not (listp elt))
- (error "sh-get-indent-var-for-line invalid elt: %s" elt))
- ;; so it is a list
- ((eq t (car elt))
- ) ;; nothing
- ((symbolp (setq sym (nth 1 elt)))
- ;; A bit of a kludge - when we see the sh-indent-comment
- ;; ignore other variables. Otherwise it is tricky to
- ;; "learn" the comment indentation.
- (if (eq var 'sh-indent-comment)
- (setq result var)
- (if var
- (setq result
- "this line is controlled by more than 1 variable.")
- (setq var sym))))
- (t
- (error "sh-get-indent-var-for-line invalid list elt: %s" elt)))
- (setq info (cdr info))
- ))
- (or result
- (setq result var))
- (or result
- (setq result reason))
- (if (null result)
- ;; e.g. just had (t POS)
- (setq result "line has default indentation"))
- result))
-
-
-
-;; Finding the previous line isn't trivial.
-;; We must *always* go back one more and see if that is a continuation
-;; line -- it is the PREVIOUS line which is continued, not the one
-;; we are going to!
-;; Also, we want to treat a whole "here document" as one big line,
-;; because we may want to align to the beginning of it.
-;;
-;; What we do:
-;; - go back to previous non-empty line
-;; - if this is in a here-document, go to the beginning of it
-;; - while previous line is continued, go back one line
-(defun sh-prev-line (&optional end)
- "Back to end of previous non-comment non-empty line.
-Go to beginning of logical line unless END is non-nil, in which case
-we go to the end of the previous line and do not check for continuations."
- (save-excursion
- (beginning-of-line)
- (forward-comment (- (point-max)))
- (unless end (beginning-of-line))
- (when (and (not (bobp))
- (eq (get-text-property (1- (point)) 'face) 'sh-heredoc))
- (let ((p1 (previous-single-property-change (1- (point)) 'face)))
- (when p1
- (goto-char p1)
- (if end
- (end-of-line)
- (beginning-of-line)))))
- (unless end
- ;; we must check previous lines to see if they are continuation lines
- ;; if so, we must return position of first of them
- (while (and (sh-this-is-a-continuation)
- (>= 0 (forward-line -1))))
- (beginning-of-line)
- (skip-chars-forward " \t"))
- (point)))
-
-
-(defun sh-prev-stmt ()
- "Return the address of the previous stmt or nil."
- ;; This is used when we are trying to find a matching keyword.
- ;; Searching backward for the keyword would certainly be quicker, but
- ;; it is hard to remove "false matches" -- such as if the keyword
- ;; appears in a string or quote. This way is slower, but (I think) safer.
- (interactive)
- (save-excursion
- (let ((going t)
- (start (point))
- (found nil)
- (prev nil))
- (skip-chars-backward " \t;|&({[")
- (while (and (not found)
- (not (bobp))
- going)
- ;; Do a backward-sexp if possible, else backup bit by bit...
- (if (sh-safe-forward-sexp -1)
- (progn
- (if (looking-at sh-special-keywords)
- (progn
- (setq found prev))
- (setq prev (point))
- ))
- ;; backward-sexp failed
- (if (zerop (skip-chars-backward " \t()[]{};`'"))
- (forward-char -1))
- (if (bolp)
- (let ((back (sh-prev-line nil)))
- (if back
- (goto-char back)
- (setq going nil)))))
- (unless found
- (skip-chars-backward " \t")
- (if (or (and (bolp) (not (sh-this-is-a-continuation)))
- (eq (char-before) ?\;)
- (looking-at "\\s-*[|&]"))
- (setq found (point)))))
- (if found
- (goto-char found))
- (if found
- (progn
- (skip-chars-forward " \t|&({[")
- (setq found (point))))
- (if (>= (point) start)
- (progn
- (debug "We didn't move!")
- (setq found nil))
- (or found
- (sh-debug "Did not find prev stmt.")))
- found)))
-
-
-(defun sh-get-word ()
- "Get a shell word skipping whitespace from point."
- (interactive)
- (skip-chars-forward "\t ")
- (let ((start (point)))
- (while
- (if (looking-at "[\"'`]")
- (sh-safe-forward-sexp)
- ;; (> (skip-chars-forward "^ \t\n\"'`") 0)
- (> (skip-chars-forward "-_$[:alnum:]") 0)
- ))
- (buffer-substring start (point))
- ))
-
-(defun sh-prev-thing ()
- "Return the previous thing this logical line."
- ;; This is called when `sh-get-indent-info' is working backwards on
- ;; the previous line(s) finding what keywords may be relevant for
- ;; indenting. It moves over sexps if possible, and will stop
- ;; on a ; and at the beginning of a line if it is not a continuation
- ;; line.
- ;;
- ;; Added a kludge for ";;"
- ;; Possible return values:
- ;; nil - nothing
- ;; a string - possibly a keyword
- ;;
- (if (bolp)
- nil
- (let ((start (point))
- (min-point (if (sh-this-is-a-continuation)
- (sh-prev-line nil)
- (line-beginning-position))))
- (skip-chars-backward " \t;" min-point)
- (if (looking-at "\\s-*;[;&]")
- ;; (message "Found ;; !")
- ";;"
- (skip-chars-backward "^)}];\"'`({[" min-point)
- (let ((c (if (> (point) min-point) (char-before))))
- (sh-debug "stopping at %d c is %s start=%d min-point=%d"
- (point) c start min-point)
- (if (not (memq c '(?\n nil ?\;)))
- ;; c -- return a string
- (char-to-string c)
- ;; Return the leading keyword of the "command" we supposedly
- ;; skipped over. Maybe we skipped too far (e.g. past a `do' or
- ;; `then' that precedes the actual command), so check whether
- ;; we're looking at such a keyword and if so, move back forward.
- (let ((boundary (point))
- kwd next)
- (while
- (progn
- ;; Skip forward over white space newline and \ at eol.
- (skip-chars-forward " \t\n\\\\" start)
- (if (>= (point) start)
- (progn
- (sh-debug "point: %d >= start: %d" (point) start)
- nil)
- (if next (setq boundary next))
- (sh-debug "Now at %d start=%d" (point) start)
- (setq kwd (sh-get-word))
- (if (member kwd (sh-feature sh-leading-keywords))
- (progn
- (setq next (point))
- t)
- nil))))
- (goto-char boundary)
- kwd)))))))
-
-
-(defun sh-this-is-a-continuation ()
- "Return non-nil if current line is a continuation of previous line."
- (save-excursion
- (and (zerop (forward-line -1))
- (looking-at ".*\\\\$")
- (not (nth 4 (parse-partial-sexp (match-beginning 0) (match-end 0)
- nil nil nil t))))))
-
-(defun sh-get-kw (&optional where and-move)
- "Return first word of line from WHERE.
-If AND-MOVE is non-nil then move to end of word."
- (let ((start (point)))
- (if where
- (goto-char where))
- (prog1
- (buffer-substring (point)
- (progn (skip-chars-forward "^ \t\n;&|")(point)))
- (unless and-move
- (goto-char start)))))
-
-(defun sh-find-prev-matching (open close &optional depth)
- "Find a matching token for a set of opening and closing keywords.
-This takes into account that there may be nested open..close pairings.
-OPEN and CLOSE are regexps denoting the tokens to be matched.
-Optional parameter DEPTH (usually 1) says how many to look for."
- (let ((parse-sexp-ignore-comments t)
- (forward-sexp-function nil)
- prev)
- (setq depth (or depth 1))
- (save-excursion
- (condition-case nil
- (while (and
- (/= 0 depth)
- (not (bobp))
- (setq prev (sh-prev-stmt)))
- (goto-char prev)
- (save-excursion
- (if (looking-at "\\\\\n")
- (progn
- (forward-char 2)
- (skip-chars-forward " \t")))
- (cond
- ((looking-at open)
- (setq depth (1- depth))
- (sh-debug "found open at %d - depth = %d" (point) depth))
- ((looking-at close)
- (setq depth (1+ depth))
- (sh-debug "found close - depth = %d" depth))
- (t
- ))))
- (error nil))
- (if (eq depth 0)
- prev ;; (point)
- nil)
- )))
-
(defun sh-var-value (var &optional ignore-error)
"Return the value of variable VAR, interpreting symbols.
@@ -3268,620 +2466,16 @@ IGNORE-ERROR is non-nil."
"Don't know how to handle %s's value of %s" var val)
0))))
-(defun sh-set-var-value (var value &optional no-symbol)
- "Set variable VAR to VALUE.
-Unless optional argument NO-SYMBOL is non-nil, then if VALUE is
-can be represented by a symbol then do so."
- (cond
- (no-symbol
- (set var value))
- ((= value sh-basic-offset)
- (set var '+))
- ((= value (- sh-basic-offset))
- (set var '-))
- ((eq value (* 2 sh-basic-offset))
- (set var '++))
- ((eq value (* 2 (- sh-basic-offset)))
- (set var '--))
- ((eq value (/ sh-basic-offset 2))
- (set var '*))
- ((eq value (/ (- sh-basic-offset) 2))
- (set var '/))
- (t
- (set var value)))
- )
-
-
-(defun sh-calculate-indent (&optional info)
- "Return the indentation for the current line.
-If INFO is supplied it is used, else it is calculated from current line."
- (let ((ofs 0)
- (base-value 0)
- elt a b val)
- (or info
- (setq info (sh-get-indent-info)))
- (when info
- (while info
- (sh-debug "info: %s ofs=%s" info ofs)
- (setq elt (car info))
- (cond
- ((stringp elt)) ;; do nothing?
- ((listp elt)
- (setq a (car (car info)))
- (setq b (nth 1 (car info)))
- (cond
- ((eq a t)
- (save-excursion
- (goto-char b)
- (setq val (current-indentation)))
- (setq base-value val))
- ((symbolp b)
- (setq val (sh-var-value b))
- (cond
- ((eq a '=)
- (cond
- ((null val)
- ;; no indentation
- ;; set info to nil so we stop immediately
- (setq base-value nil ofs nil info nil))
- ((eq val t) (setq ofs 0)) ;; indent as normal line
- (t
- ;; The following assume the (t POS) come first!
- (setq ofs val base-value 0)
- (setq info nil)))) ;; ? stop now
- ((eq a '+) (setq ofs (+ ofs val)))
- ((eq a '-) (setq ofs (- ofs val)))
- (t
- (error "sh-calculate-indent invalid a a=%s b=%s" a b))))
- (t
- (error "sh-calculate-indent invalid elt: a=%s b=%s" a b))))
- (t
- (error "sh-calculate-indent invalid elt %s" elt)))
- (sh-debug "a=%s b=%s val=%s base-value=%s ofs=%s"
- a b val base-value ofs)
- (setq info (cdr info)))
- ;; return value:
- (sh-debug "at end: base-value: %s ofs: %s" base-value ofs)
-
- (cond
- ((or (null base-value)(null ofs))
- nil)
- ((and (numberp base-value)(numberp ofs))
- (sh-debug "base (%d) + ofs (%d) = %d"
- base-value ofs (+ base-value ofs))
- (+ base-value ofs)) ;; return value
- (t
- (error "sh-calculate-indent: Help. base-value=%s ofs=%s"
- base-value ofs)
- nil)))))
+(define-obsolete-function-alias 'sh-show-indent
+ #'smie-config-show-indent "28.1")
+(define-obsolete-function-alias 'sh-set-indent #'smie-config-set-indent "28.1")
-(defun sh-indent-line ()
- "Indent the current line."
- (interactive)
- (let ((indent (sh-calculate-indent))
- (pos (- (point-max) (point))))
- (when indent
- (beginning-of-line)
- (skip-chars-forward " \t")
- (indent-line-to indent)
- ;; If initial point was within line's indentation,
- ;; position after the indentation. Else stay at same point in text.
- (if (> (- (point-max) pos) (point))
- (goto-char (- (point-max) pos))))))
-
-
-(defun sh-blink (blinkpos &optional msg)
- "Move cursor momentarily to BLINKPOS and display MSG."
- ;; We can get here without it being a number on first line
- (if (numberp blinkpos)
- (save-excursion
- (goto-char blinkpos)
- (if msg (message "%s" msg) (message nil))
- (sit-for blink-matching-delay))
- (if msg (message "%s" msg) (message nil))))
-
-(defun sh-show-indent (arg)
- "Show how the current line would be indented.
-This tells you which variable, if any, controls the indentation of
-this line.
-If optional arg ARG is non-null (called interactively with a prefix),
-a pop up window describes this variable.
-If variable `sh-blink' is non-nil then momentarily go to the line
-we are indenting relative to, if applicable."
- (interactive "P")
- (sh-must-support-indent)
- (if sh-use-smie
- (smie-config-show-indent)
- (let* ((info (sh-get-indent-info))
- (var (sh-get-indent-var-for-line info))
- (curr-indent (current-indentation))
- val msg)
- (if (stringp var)
- (message "%s" (setq msg var))
- (setq val (sh-calculate-indent info))
-
- (if (eq curr-indent val)
- (setq msg (format "%s is %s" var (symbol-value var)))
- (setq msg
- (if val
- (format "%s (%s) would change indent from %d to: %d"
- var (symbol-value var) curr-indent val)
- (format "%s (%s) would leave line as is"
- var (symbol-value var)))
- ))
- (if (and arg var)
- (describe-variable var)))
- (if sh-blink
- (let ((info (sh-get-indent-info)))
- (if (and info (listp (car info))
- (eq (car (car info)) t))
- (sh-blink (nth 1 (car info)) msg)
- (message "%s" msg)))
- (message "%s" msg))
- )))
+(define-obsolete-function-alias 'sh-learn-line-indent
+ #'smie-config-set-indent "28.1")
-(defun sh-set-indent ()
- "Set the indentation for the current line.
-If the current line is controlled by an indentation variable, prompt
-for a new value for it."
- (interactive)
- (sh-must-support-indent)
- (if sh-use-smie
- (smie-config-set-indent)
- (let* ((info (sh-get-indent-info))
- (var (sh-get-indent-var-for-line info))
- val old-val indent-val)
- (if (stringp var)
- (message "Cannot set indent - %s" var)
- (setq old-val (symbol-value var))
- (setq val (sh-read-variable var))
- (condition-case nil
- (progn
- (set var val)
- (setq indent-val (sh-calculate-indent info))
- (if indent-val
- (message "Variable: %s Value: %s would indent to: %d"
- var (symbol-value var) indent-val)
- (message "Variable: %s Value: %s would leave line as is."
- var (symbol-value var)))
- ;; I'm not sure about this, indenting it now?
- ;; No. Because it would give the impression that an undo would
- ;; restore thing, but the value has been altered.
- ;; (sh-indent-line)
- )
- (error
- (set var old-val)
- (message "Bad value for %s, restoring to previous value %s"
- var old-val)
- (sit-for 1)
- nil))
- ))))
-
-
-(defun sh-learn-line-indent (arg)
- "Learn how to indent a line as it currently is indented.
-
-If there is an indentation variable which controls this line's indentation,
-then set it to a value which would indent the line the way it
-presently is.
-
-If the value can be represented by one of the symbols then do so
-unless optional argument ARG (the prefix when interactive) is non-nil."
- (interactive "*P")
- (sh-must-support-indent)
- (if sh-use-smie
- (smie-config-set-indent)
- ;; I'm not sure if we show allow learning on an empty line.
- ;; Though it might occasionally be useful I think it usually
- ;; would just be confusing.
- (if (save-excursion
- (beginning-of-line)
- (looking-at "\\s-*$"))
- (message "sh-learn-line-indent ignores empty lines.")
- (let* ((info (sh-get-indent-info))
- (var (sh-get-indent-var-for-line info))
- ival sval diff new-val
- (no-symbol arg)
- (curr-indent (current-indentation)))
- (cond
- ((stringp var)
- (message "Cannot learn line - %s" var))
- ((eq var 'sh-indent-comment)
- ;; This is arbitrary...
- ;; - if curr-indent is 0, set to curr-indent
- ;; - else if it has the indentation of a "normal" line,
- ;; then set to t
- ;; - else set to curr-indent.
- (setq sh-indent-comment
- (if (= curr-indent 0)
- 0
- (let* ((sh-indent-comment t)
- (val2 (sh-calculate-indent info)))
- (if (= val2 curr-indent)
- t
- curr-indent))))
- (message "%s set to %s" var (symbol-value var))
- )
- ((numberp (setq sval (sh-var-value var)))
- (setq ival (sh-calculate-indent info))
- (setq diff (- curr-indent ival))
-
- (sh-debug "curr-indent: %d ival: %d diff: %d var:%s sval %s"
- curr-indent ival diff var sval)
- (setq new-val (+ sval diff))
- ;; I commented out this because someone might want to replace
- ;; a value of `+' with the current value of sh-basic-offset
- ;; or vice-versa.
- ;;(if (= 0 diff)
- ;; (message "No change needed!")
- (sh-set-var-value var new-val no-symbol)
- (message "%s set to %s" var (symbol-value var))
- )
- (t
- (debug)
- (message "Cannot change %s" var)))))))
-
-
-
-(defun sh-mark-init (buffer)
- "Initialize a BUFFER to be used by `sh-mark-line'."
- (with-current-buffer (get-buffer-create buffer)
- (erase-buffer)
- (occur-mode)))
-
-
-(defun sh-mark-line (message point buffer &optional add-linenum occur-point)
- "Insert MESSAGE referring to location POINT in current buffer into BUFFER.
-Buffer BUFFER is in `occur-mode'.
-If ADD-LINENUM is non-nil the message is preceded by the line number.
-If OCCUR-POINT is non-nil then the line is marked as a new occurrence
-so that `occur-next' and `occur-prev' will work."
- (let ((m1 (make-marker))
- start
- (line ""))
- (when point
- (set-marker m1 point (current-buffer))
- (if add-linenum
- (setq line (format "%d: " (1+ (count-lines 1 point))))))
- (save-excursion
- (if (get-buffer buffer)
- (set-buffer (get-buffer buffer))
- (set-buffer (get-buffer-create buffer))
- (occur-mode)
- )
- (goto-char (point-max))
- (setq start (point))
- (let ((inhibit-read-only t))
- (insert line)
- (if occur-point
- (setq occur-point (point)))
- (insert message)
- (if point
- (add-text-properties
- start (point)
- '(mouse-face highlight
- help-echo "mouse-2: go to the line where I learned this")))
- (insert "\n")
- (when point
- (put-text-property start (point) 'occur-target m1)
- (if occur-point
- (put-text-property start occur-point
- 'occur-match t))
- )))))
-
-;; Is this really worth having?
-(defvar sh-learned-buffer-hook nil
- "An abnormal hook, called with an alist of learned variables.")
-;; Example of how to use sh-learned-buffer-hook
-;;
-;; (defun what-i-learned (list)
-;; (let ((p list))
-;; (with-current-buffer "*scratch*"
-;; (goto-char (point-max))
-;; (insert "(setq\n")
-;; (while p
-;; (insert (format " %s %s \n"
-;; (nth 0 (car p)) (nth 1 (car p))))
-;; (setq p (cdr p)))
-;; (insert ")\n")
-;; )))
-;;
-;; (add-hook 'sh-learned-buffer-hook #'what-i-learned)
-
-
-;; Originally this was sh-learn-region-indent (beg end)
-;; However, in practice this was awkward so I changed it to
-;; use the whole buffer. Use narrowing if need be.
-(defun sh-learn-buffer-indent (&optional arg)
- "Learn how to indent the buffer the way it currently is.
-
-If `sh-use-smie' is non-nil, call `smie-config-guess'.
-Otherwise, run the sh-script specific indent learning command, as
-described below.
-
-Output in buffer \"*indent*\" shows any lines which have conflicting
-values of a variable, and the final value of all variables learned.
-When called interactively, pop to this buffer automatically if
-there are any discrepancies.
-
-If no prefix ARG is given, then variables are set to numbers.
-If a prefix arg is given, then variables are set to symbols when
-applicable -- e.g. to symbol `+' if the value is that of the
-basic indent.
-If a positive numerical prefix is given, then `sh-basic-offset'
-is set to the prefix's numerical value.
-Otherwise, sh-basic-offset may or may not be changed, according
-to the value of variable `sh-learn-basic-offset'.
-
-Abnormal hook `sh-learned-buffer-hook' if non-nil is called when the
-function completes. The function is abnormal because it is called
-with an alist of variables learned.
-
-This command can often take a long time to run."
- (interactive "P")
- (sh-must-support-indent)
- (if sh-use-smie
- (smie-config-guess)
- (save-excursion
- (goto-char (point-min))
- (let ((learned-var-list nil)
- (out-buffer "*indent*")
- (num-diffs 0)
- previous-set-info
- (max 17)
- vec
- msg
- (comment-col nil) ;; number if all same, t if seen diff values
- (comments-always-default t) ;; nil if we see one not default
- initial-msg
- (specified-basic-offset (and arg (numberp arg)
- (> arg 0)))
- (linenum 0)
- suggested)
- (setq vec (make-vector max 0))
- (sh-mark-init out-buffer)
-
- (if specified-basic-offset
- (progn
- (setq sh-basic-offset arg)
- (setq initial-msg
- (format "Using specified sh-basic-offset of %d"
- sh-basic-offset)))
- (setq initial-msg
- (format "Initial value of sh-basic-offset: %s"
- sh-basic-offset)))
-
- (while (< (point) (point-max))
- (setq linenum (1+ linenum))
- ;; (if (zerop (% linenum 10))
- (message "line %d" linenum)
- ;; )
- (unless (looking-at "\\s-*$") ;; ignore empty lines!
- (let* ((sh-indent-comment t) ;; info must return default indent
- (info (sh-get-indent-info))
- (var (sh-get-indent-var-for-line info))
- sval ival diff new-val
- (curr-indent (current-indentation)))
- (cond
- ((null var)
- nil)
- ((stringp var)
- nil)
- ((numberp (setq sval (sh-var-value var 'no-error)))
- ;; the numberp excludes comments since sval will be t.
- (setq ival (sh-calculate-indent))
- (setq diff (- curr-indent ival))
- (setq new-val (+ sval diff))
- (sh-set-var-value var new-val 'no-symbol)
- (unless (looking-at "\\s-*#") ;; don't learn from comments
- (if (setq previous-set-info (assoc var learned-var-list))
- (progn
- ;; it was already there, is it same value ?
- (unless (eq (symbol-value var)
- (nth 1 previous-set-info))
- (sh-mark-line
- (format "Variable %s was set to %s"
- var (symbol-value var))
- (point) out-buffer t t)
- (sh-mark-line
- (format " but was previously set to %s"
- (nth 1 previous-set-info))
- (nth 2 previous-set-info) out-buffer t)
- (setq num-diffs (1+ num-diffs))
- ;; (delete previous-set-info learned-var-list)
- (setcdr previous-set-info
- (list (symbol-value var) (point)))
- )
- )
- (setq learned-var-list
- (append (list (list var (symbol-value var)
- (point)))
- learned-var-list)))
- (if (numberp new-val)
- (progn
- (sh-debug
- "This line's indent value: %d" new-val)
- (if (< new-val 0)
- (setq new-val (- new-val)))
- (if (< new-val max)
- (aset vec new-val (1+ (aref vec new-val))))))
- ))
- ((eq var 'sh-indent-comment)
- (unless (= curr-indent (sh-calculate-indent info))
- ;; this is not the default indentation
- (setq comments-always-default nil)
- (if comment-col ;; then we have see one before
- (or (eq comment-col curr-indent)
- (setq comment-col t)) ;; seen a different one
- (setq comment-col curr-indent))
- ))
- (t
- (sh-debug "Cannot learn this line!!!")
- ))
- (sh-debug
- "at %s learned-var-list is %s" (point) learned-var-list)
- ))
- (forward-line 1)
- ) ;; while
- (if sh-debug
- (progn
- (setq msg (format
- "comment-col = %s comments-always-default = %s"
- comment-col comments-always-default))
- ;; (message msg)
- (sh-mark-line msg nil out-buffer)))
- (cond
- ((eq comment-col 0)
- (setq msg "\nComments are all in 1st column.\n"))
- (comments-always-default
- (setq msg "\nComments follow default indentation.\n")
- (setq comment-col t))
- ((numberp comment-col)
- (setq msg (format "\nComments are in col %d." comment-col)))
- (t
- (setq msg "\nComments seem to be mixed, leaving them as is.\n")
- (setq comment-col nil)
- ))
- (sh-debug msg)
- (sh-mark-line msg nil out-buffer)
-
- (sh-mark-line initial-msg nil out-buffer t t)
-
- (setq suggested (sh-guess-basic-offset vec))
-
- (if (and suggested (not specified-basic-offset))
- (let ((new-value
- (cond
- ;; t => set it if we have a single value as a number
- ((and (eq sh-learn-basic-offset t) (numberp suggested))
- suggested)
- ;; other non-nil => set it if only one value was found
- (sh-learn-basic-offset
- (if (numberp suggested)
- suggested
- (if (= (length suggested) 1)
- (car suggested))))
- (t
- nil))))
- (if new-value
- (progn
- (setq learned-var-list
- (append (list (list 'sh-basic-offset
- (setq sh-basic-offset new-value)
- (point-max)))
- learned-var-list))
- ;; Not sure if we need to put this line in, since
- ;; it will appear in the "Learned variable settings".
- (sh-mark-line
- (format "Changed sh-basic-offset to: %d" sh-basic-offset)
- nil out-buffer))
- (sh-mark-line
- (if (listp suggested)
- (format "Possible value(s) for sh-basic-offset: %s"
- (mapconcat 'int-to-string suggested " "))
- (format "Suggested sh-basic-offset: %d" suggested))
- nil out-buffer))))
-
-
- (setq learned-var-list
- (append (list (list 'sh-indent-comment comment-col (point-max)))
- learned-var-list))
- (setq sh-indent-comment comment-col)
- (let ((name (buffer-name)))
- (sh-mark-line "\nLearned variable settings:" nil out-buffer)
- (if arg
- ;; Set learned variables to symbolic rather than numeric
- ;; values where possible.
- (dolist (learned-var (reverse learned-var-list))
- (let ((var (car learned-var))
- (val (nth 1 learned-var)))
- (when (and (not (eq var 'sh-basic-offset))
- (numberp val))
- (sh-set-var-value var val)))))
- (dolist (learned-var (reverse learned-var-list))
- (let ((var (car learned-var)))
- (sh-mark-line (format " %s %s" var (symbol-value var))
- (nth 2 learned-var) out-buffer)))
- (with-current-buffer out-buffer
- (goto-char (point-min))
- (let ((inhibit-read-only t))
- (insert
- (format "Indentation values for buffer %s.\n" name)
- (format "%d indentation variable%s different values%s\n\n"
- num-diffs
- (if (= num-diffs 1)
- " has" "s have")
- (if (zerop num-diffs)
- "." ":"))))))
- (run-hook-with-args 'sh-learned-buffer-hook learned-var-list)
- (and (called-interactively-p 'any)
- (or sh-popup-occur-buffer (> num-diffs 0))
- (pop-to-buffer out-buffer))))))
-
-(defun sh-guess-basic-offset (vec)
- "See if we can determine a reasonable value for `sh-basic-offset'.
-This is experimental, heuristic and arbitrary!
-Argument VEC is a vector of information collected by
-`sh-learn-buffer-indent'.
-Return values:
- number - there appears to be a good single value
- list of numbers - no obvious one, here is a list of one or more
- reasonable choices
- nil - we couldn't find a reasonable one."
- (let* ((max (1- (length vec)))
- (i 1)
- (totals (make-vector max 0)))
- (while (< i max)
- (cl-incf (aref totals i) (* 4 (aref vec i)))
- (if (zerop (% i 2))
- (cl-incf (aref totals i) (aref vec (/ i 2))))
- (if (< (* i 2) max)
- (cl-incf (aref totals i) (aref vec (* i 2))))
- (setq i (1+ i)))
-
- (let ((x nil)
- (result nil)
- tot sum p)
- (setq i 1)
- (while (< i max)
- (if (/= (aref totals i) 0)
- (push (cons i (aref totals i)) x))
- (setq i (1+ i)))
-
- (setq x (sort (nreverse x) (lambda (a b) (> (cdr a) (cdr b)))))
- (setq tot (apply '+ (append totals nil)))
- (sh-debug (format "vec: %s\ntotals: %s\ntot: %d"
- vec totals tot))
- (cond
- ((zerop (length x))
- (message "no values!")) ;; we return nil
- ((= (length x) 1)
- (message "only value is %d" (car (car x)))
- (setq result (car (car x)))) ;; return single value
- ((> (cdr (car x)) (/ tot 2))
- ;; 1st is > 50%
- (message "basic-offset is probably %d" (car (car x)))
- (setq result (car (car x)))) ;; again, return a single value
- ((>= (cdr (car x)) (* 2 (cdr (car (cdr x)))))
- ;; 1st is >= 2 * 2nd
- (message "basic-offset could be %d" (car (car x)))
- (setq result (car (car x))))
- ((>= (+ (cdr (car x))(cdr (car (cdr x)))) (/ tot 2))
- ;; 1st & 2nd together >= 50% - return a list
- (setq p x sum 0 result nil)
- (while (and p
- (<= (setq sum (+ sum (cdr (car p)))) (/ tot 2)))
- (setq result (append result (list (car (car p)))))
- (setq p (cdr p)))
- (message "Possible choices for sh-basic-offset: %s"
- (mapconcat 'int-to-string result " ")))
- (t
- (message "No obvious value for sh-basic-offset. Perhaps %d"
- (car (car x)))
- ;; result is nil here
- ))
- result)))
+(define-obsolete-function-alias 'sh-learn-buffer-indent
+ #'smie-config-guess "28.1")
;; ========================================================================
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 7d1f5ef6544..bfef2a663a0 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -257,7 +257,6 @@
(defcustom sql-user ""
"Default username."
:type 'string
- :group 'SQL
:safe 'stringp)
(defcustom sql-password ""
@@ -265,33 +264,28 @@
If you customize this, the value will be stored in your init
file. Since that is a plaintext file, this could be dangerous."
:type 'string
- :group 'SQL
:risky t)
(defcustom sql-database ""
"Default database."
:type 'string
- :group 'SQL
:safe 'stringp)
(defcustom sql-server ""
"Default server or host."
:type 'string
- :group 'SQL
:safe 'stringp)
(defcustom sql-port 0
"Default port for connecting to a MySQL or Postgres server."
:version "24.1"
:type 'number
- :group 'SQL
:safe 'numberp)
(defcustom sql-default-directory nil
"Default directory for SQL processes."
:version "25.1"
:type '(choice (const nil) string)
- :group 'SQL
:safe 'stringp)
;; Login parameter type
@@ -348,8 +342,7 @@ file. Since that is a plaintext file, this could be dangerous."
(const :format "" :completion)
(sexp :tag ":completion")
(const :format "" :must-match)
- (restricted-sexp
- :match-alternatives (listp stringp))))
+ (symbol :tag ":must-match")))
(const port)))
;; SQL Product support
@@ -461,7 +454,7 @@ file. Since that is a plaintext file, this could be dangerous."
:prompt-regexp "^mysql> "
:prompt-length 6
:prompt-cont-regexp "^ -> "
- :syntax-alist ((?# . "< b"))
+ :syntax-alist ((?# . "< b") (?\\ . "\\"))
:input-filter sql-remove-tabs-filter)
(oracle
@@ -707,9 +700,9 @@ making new SQLi sessions."
(repeat :inline t
(list :tab "Other"
(symbol :tag " Variable Symbol")
+ ;; FIXME: Why "Value *Expression*"?
(sexp :tag "Value Expression")))))
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
(defvaralias 'sql-dialect 'sql-product)
@@ -723,7 +716,6 @@ This allows highlighting buffers properly when you open them."
(capitalize (symbol-name (car prod-info))))
,(car prod-info)))
sql-product-alist))
- :group 'SQL
:safe 'symbolp)
;; SQL indent support
@@ -735,7 +727,6 @@ SQL statements with easy customizations to support varied layout
requirements.
The package must be available to be loaded and activated."
- :group 'SQL
:link '(url-link "https://elpa.gnu.org/packages/sql-indent.html")
:type 'boolean
:version "27.1")
@@ -846,12 +837,11 @@ host key."
(setq w (locate-user-emacs-file (concat "sql-wallet" ext)
(concat ".sql-wallet" ext)))
(when (file-exists-p w)
- (setq wallet w)))))
+ (setq wallet (list w))))))
"Identification of the password wallet.
See `sql-password-search-wallet-function' to understand how this value
is used to locate the password wallet."
- :type `(plist-get (symbol-plist 'auth-sources) 'custom-type)
- :group 'SQL
+ :type (plist-get (symbol-plist 'auth-sources) 'custom-type)
:version "27.1")
(defvar sql-password-search-wallet-function #'sql-auth-source-search-wallet
@@ -878,8 +868,7 @@ current input in the SQLi buffer to the process."
:type '(choice (const :tag "Nothing" nil)
(const :tag "The semicolon `;'" semicolon)
(const :tag "The string `go' by itself" go))
- :version "20.8"
- :group 'SQL)
+ :version "20.8")
(defcustom sql-send-terminator nil
"When non-nil, add a terminator to text sent to the SQL interpreter.
@@ -905,10 +894,9 @@ it automatically."
(const :tag "Default Terminator" t)
(string :tag "Terminator String")
(cons :tag "Terminator Pattern and String"
- (string :tag "Terminator Pattern")
+ (regexp :tag "Terminator Pattern")
(string :tag "Terminator String")))
- :version "22.2"
- :group 'SQL)
+ :version "22.2")
(defvar sql-contains-names nil
"When non-nil, the current buffer contains database names.
@@ -932,8 +920,7 @@ buffer."
:type '(choice (const :tag "Default" t)
(const :tag "No display" nil)
(function :tag "Display Buffer function"))
- :version "27.1"
- :group 'SQL)
+ :version "27.1")
;; imenu support for sql-mode.
@@ -971,8 +958,7 @@ This is used to initialize `comint-input-ring-file-name'.
Note that the size of the input history is determined by the variable
`comint-input-ring-size'."
:type '(choice (const :tag "none" nil)
- (file))
- :group 'SQL)
+ (file)))
(defcustom sql-input-ring-separator "\n--\n"
"Separator between commands in the history file.
@@ -987,21 +973,18 @@ does not have it, setting `sql-input-ring-separator' will have no
effect. In that case multiline commands will be split into several
commands when the input history is read, as if you had set
`sql-input-ring-separator' to \"\\n\"."
- :type 'string
- :group 'SQL)
+ :type 'string)
;; The usual hooks
(defcustom sql-interactive-mode-hook '(sql-indent-enable)
"Hook for customizing `sql-interactive-mode'."
:type 'hook
- :group 'SQL
:version "27.1")
(defcustom sql-mode-hook '(sql-indent-enable)
"Hook for customizing `sql-mode'."
:type 'hook
- :group 'SQL
:version "27.1")
(defcustom sql-set-sqli-hook '()
@@ -1009,8 +992,7 @@ commands when the input history is read, as if you had set
This is called by `sql-set-sqli-buffer' when the value of `sql-buffer'
is changed."
- :type 'hook
- :group 'SQL)
+ :type 'hook)
(defcustom sql-login-hook '()
"Hook for interacting with a buffer in `sql-interactive-mode'.
@@ -1018,8 +1000,7 @@ is changed."
This hook is invoked in a buffer once it is ready to accept input
for the first time."
:version "24.1"
- :type 'hook
- :group 'SQL)
+ :type 'hook)
;; Customization for ANSI
@@ -1033,8 +1014,7 @@ 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 'string
- :group 'SQL)
+ :type 'regexp)
;; Customization for Oracle
@@ -1046,27 +1026,23 @@ Starts `sql-interactive-mode' after doing some setup.
On Windows, \"sqlplus\" usually starts the sqlplus \"GUI\". In order
to start the sqlplus console, use \"plus33\" or something similar.
You will find the file in your Orant\\bin directory."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-oracle-options '("-L")
"List of additional options for `sql-oracle-program'."
:type '(repeat string)
- :version "24.4"
- :group 'SQL)
+ :version "24.4")
(defcustom sql-oracle-login-params '(user password database)
"List of login parameters needed to connect to Oracle."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
(defcustom sql-oracle-statement-starters
(regexp-opt '("declare" "begin" "with"))
"Additional statement starting keywords in Oracle."
:version "24.1"
- :type 'string
- :group 'SQL)
+ :type 'string)
(defcustom sql-oracle-scan-on t
"Non-nil if placeholders should be replaced in Oracle SQLi.
@@ -1082,8 +1058,7 @@ You need to issue the following command in SQL*Plus to be safe:
In older versions of SQL*Plus, this was the SET SCAN OFF command."
:version "24.1"
- :type 'boolean
- :group 'SQL)
+ :type 'boolean)
(defcustom sql-db2-escape-newlines nil
"Non-nil if newlines should be escaped by a backslash in DB2 SQLi.
@@ -1092,8 +1067,7 @@ When non-nil, Emacs will automatically insert a space and
backslash prior to every newline in multi-line SQL statements as
they are submitted to an interactive DB2 session."
:version "24.3"
- :type 'boolean
- :group 'SQL)
+ :type 'boolean)
;; Customization for SQLite
@@ -1103,21 +1077,18 @@ they are submitted to an interactive DB2 session."
"Command to start SQLite.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-sqlite-options nil
"List of additional options for `sql-sqlite-program'."
:type '(repeat string)
- :version "20.8"
- :group 'SQL)
+ :version "20.8")
(defcustom sql-sqlite-login-params '((database :file nil
:must-match confirm))
"List of login parameters needed to connect to SQLite."
:type 'sql-login-params
- :version "26.1"
- :group 'SQL)
+ :version "26.1")
;; Customization for MariaDB
@@ -1134,22 +1105,19 @@ Starts `sql-interactive-mode' after doing some setup."
"Command to start mysql by Oracle.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-mysql-options nil
"List of additional options for `sql-mysql-program'.
The following list of options is reported to make things work
on Windows: \"-C\" \"-t\" \"-f\" \"-n\"."
:type '(repeat string)
- :version "20.8"
- :group 'SQL)
+ :version "20.8")
(defcustom sql-mysql-login-params '(user password database server)
"List of login parameters needed to connect to MySQL."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for Solid
@@ -1157,14 +1125,12 @@ on Windows: \"-C\" \"-t\" \"-f\" \"-n\"."
"Command to start SOLID SQL Editor.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-solid-login-params '(user password server)
"List of login parameters needed to connect to Solid."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for Sybase
@@ -1172,21 +1138,18 @@ Starts `sql-interactive-mode' after doing some setup."
"Command to start isql by Sybase.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-sybase-options nil
"List of additional options for `sql-sybase-program'.
Some versions of isql might require the -n option in order to work."
:type '(repeat string)
- :version "20.8"
- :group 'SQL)
+ :version "20.8")
(defcustom sql-sybase-login-params '(server user password database)
"List of login parameters needed to connect to Sybase."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for Informix
@@ -1194,14 +1157,12 @@ Some versions of isql might require the -n option in order to work."
"Command to start dbaccess by Informix.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-informix-login-params '(database)
"List of login parameters needed to connect to Informix."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for Ingres
@@ -1209,14 +1170,12 @@ Starts `sql-interactive-mode' after doing some setup."
"Command to start sql by Ingres.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-ingres-login-params '(database)
"List of login parameters needed to connect to Ingres."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for Microsoft
@@ -1229,21 +1188,18 @@ Starts `sql-interactive-mode' after doing some setup."
"Command to start osql by Microsoft.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-ms-options '("-w" "300" "-n")
;; -w is the linesize
"List of additional options for `sql-ms-program'."
:type '(repeat string)
- :version "22.1"
- :group 'SQL)
+ :version "22.1")
(defcustom sql-ms-login-params '(user password server database)
"List of login parameters needed to connect to Microsoft."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for Postgres
@@ -1251,8 +1207,7 @@ Starts `sql-interactive-mode' after doing some setup."
"Command to start psql by Postgres.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-postgres-options '("-P" "pager=off")
"List of additional options for `sql-postgres-program'.
@@ -1263,8 +1218,7 @@ name, add the string \"-u\" to the list of options. If you want to
provide a user name on the command line (newer versions such as 7.1),
add your name with a \"-U\" prefix (such as \"-Umark\") to the list."
:type '(repeat string)
- :version "20.8"
- :group 'SQL)
+ :version "20.8")
(defcustom sql-postgres-login-params
`((user :default ,(user-login-name))
@@ -1275,8 +1229,7 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list."
server)
"List of login parameters needed to connect to Postgres."
:type 'sql-login-params
- :version "26.1"
- :group 'SQL)
+ :version "26.1")
(defun sql-postgres-list-databases ()
"Return a list of available PostgreSQL databases."
@@ -1297,20 +1250,17 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list."
"Command to start isql by Interbase.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-interbase-options nil
"List of additional options for `sql-interbase-program'."
:type '(repeat string)
- :version "20.8"
- :group 'SQL)
+ :version "20.8")
(defcustom sql-interbase-login-params '(user password database)
"List of login parameters needed to connect to Interbase."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for DB2
@@ -1318,20 +1268,17 @@ Starts `sql-interactive-mode' after doing some setup."
"Command to start db2 by IBM.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-db2-options nil
"List of additional options for `sql-db2-program'."
:type '(repeat string)
- :version "20.8"
- :group 'SQL)
+ :version "20.8")
(defcustom sql-db2-login-params nil
"List of login parameters needed to connect to DB2."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for Linter
@@ -1339,20 +1286,17 @@ Starts `sql-interactive-mode' after doing some setup."
"Command to start inl by RELEX.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-linter-options nil
"List of additional options for `sql-linter-program'."
:type '(repeat string)
- :version "21.3"
- :group 'SQL)
+ :version "21.3")
(defcustom sql-linter-login-params '(user password database server)
"Login parameters to needed to connect to Linter."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
@@ -1436,10 +1380,7 @@ specified, it's `sql-product' or `sql-connection' must match."
(defvar sql-interactive-mode-map
(let ((map (make-sparse-keymap)))
- (if (fboundp 'set-keymap-parent)
- (set-keymap-parent map comint-mode-map); Emacs
- (if (fboundp 'set-keymap-parents)
- (set-keymap-parents map (list comint-mode-map)))); XEmacs
+ (set-keymap-parent map comint-mode-map)
(if (fboundp 'set-keymap-name)
(set-keymap-name map 'sql-interactive-mode-map)); XEmacs
(define-key map (kbd "C-j") 'sql-accumulate-and-indent)
@@ -2374,7 +2315,8 @@ function `regexp-opt'.")
"ansi_warnings" "forceplan" "showplan_all" "showplan_text"
"statistics" "implicit_transactions" "remote_proc_transactions"
"transaction" "xact_abort"
-) t)
+)
+ t)
"\\)\\)\\|go\\s-*\\|use\\s-+\\|setuser\\s-+\\|dbcc\\s-+\\).*$")
'font-lock-doc-face)
@@ -2856,7 +2798,7 @@ See `sql-product-alist' for a list of products and supported features."
(member feature sql-indirect-features)
(not not-indirect)
(symbolp v))
- (eval v)
+ (symbol-value v)
v))
(error "`%s' is not a known product; use `sql-add-product' to add it first." product)
nil)))
@@ -4244,8 +4186,7 @@ must tell Emacs. Here's how to do that in your init file:
\(add-hook \\='sql-mode-hook
(lambda ()
- (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))"
- :group 'SQL
+ (modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))"
:abbrev-table sql-mode-abbrev-table
(if sql-mode-menu
@@ -4268,6 +4209,18 @@ must tell Emacs. Here's how to do that in your init file:
(setq-local abbrev-all-caps 1)
;; Contains the name of database objects
(set (make-local-variable 'sql-contains-names) t)
+ (setq-local syntax-propertize-function
+ (syntax-propertize-rules
+ ;; Handle escaped apostrophes within strings.
+ ("''"
+ (0
+ (if (save-excursion (nth 3 (syntax-ppss (match-beginning 0))))
+ (string-to-syntax ".")
+ (forward-char -1)
+ nil)))
+ ;; Propertize rules to not have /- and -* start comments.
+ ("\\(/-\\)" (1 "."))
+ ("\\(-\\*\\)" (1 "."))))
;; Set syntax and font-face highlighting
;; Catch changes to sql-product and highlight accordingly
(sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591
@@ -4280,7 +4233,7 @@ must tell Emacs. Here's how to do that in your init file:
(put 'sql-interactive-mode 'mode-class 'special)
(put 'sql-interactive-mode 'custom-mode-group 'SQL)
;; FIXME: Why not use `define-derived-mode'?
-(defun sql-interactive-mode ()
+(define-derived-mode sql-interactive-mode comint-mode "SQLi[?]"
"Major mode to use a SQL interpreter interactively.
Do not call this function by yourself. The environment must be
@@ -4340,17 +4293,18 @@ Here is an example for your init file. It keeps the SQLi buffer a
certain length.
\(add-hook \\='sql-interactive-mode-hook
- (function (lambda ()
- (setq comint-output-filter-functions #\\='comint-truncate-buffer))))
+ (lambda ()
+ (setq comint-output-filter-functions #\\='comint-truncate-buffer)))
Here is another example. It will always put point back to the statement
you entered, right above the output it created.
\(setq comint-output-filter-functions
- (function (lambda (STR) (comint-show-output))))"
+ (lambda (STR) (comint-show-output)))"
+ :syntax-table sql-mode-syntax-table
;; FIXME: The doc above uses `setq' on `comint-output-filter-functions',
;; whereas hooks should be manipulated with things like `add/remove-hook'.
- (delay-mode-hooks (comint-mode))
+ :after-hook (sql--adjust-interactive-setup)
;; Get the `sql-product' for this interactive session.
(set (make-local-variable 'sql-product)
@@ -4358,14 +4312,11 @@ you entered, right above the output it created.
sql-product))
;; Setup the mode.
- (setq major-mode 'sql-interactive-mode)
(setq mode-name
(concat "SQLi[" (or (sql-get-product-feature sql-product :name)
(symbol-name sql-product)) "]"))
- (use-local-map sql-interactive-mode-map)
(if sql-interactive-mode-menu
(easy-menu-add sql-interactive-mode-menu)) ; XEmacs
- (set-syntax-table sql-mode-syntax-table)
;; Note that making KEYWORDS-ONLY nil will cause havoc if you try
;; SELECT 'x' FROM DUAL with SQL*Plus, because the title of the column
@@ -4409,9 +4360,10 @@ you entered, right above the output it created.
(add-hook 'comint-preoutput-filter-functions
#'sql-interactive-remove-continuation-prompt nil t)
(make-local-variable 'sql-input-ring-separator)
- (make-local-variable 'sql-input-ring-file-name)
- ;; Run the mode hook (along with comint's hooks).
- (run-mode-hooks 'sql-interactive-mode-hook)
+ (make-local-variable 'sql-input-ring-file-name))
+
+(defun sql--adjust-interactive-setup ()
+ "Finish the mode's setup after running the mode hook."
;; Set comint based on user overrides.
(setq comint-prompt-regexp
(if sql-prompt-cont-regexp
@@ -4490,7 +4442,7 @@ is specified in the connection settings."
(dolist (vv connect-set)
(let ((var (car vv))
(val (cadr vv)))
- (set-default var (eval val))))
+ (set-default var (eval val)))) ;FIXME: Why `eval'?
(setq-default sql-connection connection)
;; :sqli-login params variable
@@ -4521,10 +4473,10 @@ is specified in the connection settings."
(if vals (cons var vals) var)))))
;; Start the SQLi session with revised list of login parameters
- (eval `(let ((,param-var ',rem-vars))
- (sql-product-interactive
- ',sql-product
- ',(or buf-name (format "<%s>" connection))))))
+ (cl-progv (list param-var) (list rem-vars)
+ (sql-product-interactive
+ sql-product
+ (or buf-name (format "<%s>" connection)))))
(user-error "SQL Connection <%s> does not exist" connection)
nil)))
@@ -4595,7 +4547,10 @@ optionally is saved to the user's init file."
(format "Connection <%s>\t%s" (car conn)
(let ((sql-user "") (sql-database "")
(sql-server "") (sql-port 0))
- (eval `(let ,(cdr conn) (sql-make-alternate-buffer-name)))))
+ (cl-progv
+ (mapcar #'car (cdr conn))
+ (mapcar #'cadr (cdr conn))
+ (sql-make-alternate-buffer-name))))
(list 'sql-connect (car conn))
t))
sql-connection-alist)
@@ -4977,8 +4932,7 @@ The default comes from `process-coding-system-alist' and
See the distinct values in ALL_OBJECTS.OBJECT_TYPE for possible values."
:version "24.1"
- :type '(repeat string)
- :group 'SQL)
+ :type '(repeat string))
(defun sql-oracle-completion-object (sqlbuf schema)
(sql-redirect-value
@@ -5624,21 +5578,18 @@ buffer.
(defcustom sql-vertica-program "vsql"
"Command to start the Vertica client."
:version "25.1"
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-vertica-options '("-P" "pager=off")
"List of additional options for `sql-vertica-program'.
The default value disables the internal pager."
:version "25.1"
- :type '(repeat string)
- :group 'SQL)
+ :type '(repeat string))
(defcustom sql-vertica-login-params '(user password database server)
"List of login parameters needed to connect to Vertica."
:version "25.1"
- :type 'sql-login-params
- :group 'SQL)
+ :type 'sql-login-params)
(defun sql-comint-vertica (product options &optional buf-name)
"Create comint buffer and connect to Vertica."
diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el
index f9b069fd4e5..0f2c9431f6e 100644
--- a/lisp/progmodes/subword.el
+++ b/lisp/progmodes/subword.el
@@ -115,6 +115,8 @@ treat nomenclature boundaries as word boundaries."
(when subword-mode (superword-mode -1))
(subword-setup-buffer))
+;; This is defined also in cc-cmds.el, but as obsolete since 24.3.
+;; Let's keep this until the other one can also be removed.
(define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2")
;;;###autoload
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index 7ffa6d41dac..33aad2d39f7 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -1346,9 +1346,8 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'."
(not tcl-use-smart-word-finder)
tcl-use-smart-word-finder))))
(completing-read
- (if (or (null word) (string= word ""))
- "Help on Tcl command: "
- (format "Help on Tcl command (default %s): " word))
+ (format-prompt "Help on Tcl command: "
+ (and (not (equal word "")) word))
tcl-help-alist nil t nil nil word)))
current-prefix-arg))
(if (not (equal tcl-help-directory-list tcl-help-saved-dirs))
diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el
index 3c9ced02916..8bde89e774e 100644
--- a/lisp/progmodes/vera-mode.el
+++ b/lisp/progmodes/vera-mode.el
@@ -1,4 +1,4 @@
-;;; vera-mode.el --- major mode for editing Vera files
+;;; vera-mode.el --- major mode for editing Vera files -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
@@ -33,9 +33,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:
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This package provides a simple Emacs major mode for editing Vera code.
;; It includes the following features:
@@ -44,38 +42,11 @@
;; - Indentation
;; - Word/keyword completion
;; - Block commenting
-;; - Works under GNU Emacs and XEmacs
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Documentation
;; See comment string of function `vera-mode' or type `C-h m' in Emacs.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Installation
-
-;; Prerequisites: GNU Emacs 20.X/21.X, XEmacs 20.X/21.X
-
-;; Put `vera-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
-;; following line in your Emacs start-up file (`.emacs'):
-
-;; (setq load-path (cons (expand-file-name "<directory-name>") load-path))
-
-;; If you already have the compiled `vera-mode.elc' file, put it in the same
-;; directory. Otherwise, byte-compile the source file:
-;; Emacs: M-x byte-compile-file -> vera-mode.el
-;; Unix: emacs -batch -q -no-site-file -f batch-byte-compile vera-mode.el
-
-;; 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'):
-
-;; (autoload 'vera-mode "vera-mode" "Vera Mode" t)
-;; (setq auto-mode-alist (cons '("\\.vr[hi]?\\'" . vera-mode) auto-mode-alist))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -90,16 +61,14 @@
(defcustom vera-basic-offset 2
"Amount of basic offset used for indentation."
- :type 'integer
- :group 'vera)
+ :type 'integer)
(defcustom vera-underscore-is-part-of-word nil
"Non-nil means consider the underscore character `_' as part of word.
An identifier containing underscores is then treated as a single word in
select and move operations. All parts of an identifier separated by underscore
are treated as single words otherwise."
- :type 'boolean
- :group 'vera)
+ :type 'boolean)
(make-obsolete-variable 'vera-underscore-is-part-of-word
'superword-mode "24.4")
@@ -110,8 +79,7 @@ else if not at beginning of line then insert tab,
else if last command was a `TAB' or `RET' then dedent one step,
else indent current line.
If nil, TAB always indents current line."
- :type 'boolean
- :group 'vera)
+ :type 'boolean)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -125,9 +93,6 @@ If nil, TAB always indents current line."
(let ((map (make-sparse-keymap)))
;; Backspace/delete key bindings.
(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))
;; Standard key bindings.
(define-key map "\M-e" 'vera-forward-statement)
(define-key map "\M-a" 'vera-backward-statement)
@@ -227,9 +192,7 @@ If nil, TAB always indents current line."
(modify-syntax-entry ?\{ "(}" syntax-table)
(modify-syntax-entry ?\} "){" syntax-table)
;; comment
- (if (featurep 'xemacs)
- (modify-syntax-entry ?\/ ". 1456" syntax-table) ; XEmacs
- (modify-syntax-entry ?\/ ". 124b" syntax-table)) ; Emacs
+ (modify-syntax-entry ?\/ ". 124b" syntax-table)
(modify-syntax-entry ?\* ". 23" syntax-table)
;; newline and CR
(modify-syntax-entry ?\n "> b" syntax-table)
@@ -314,8 +277,6 @@ Key bindings:
;; initialize font locking
(set (make-local-variable 'font-lock-defaults)
'(vera-font-lock-keywords nil nil ((?\_ . "w"))))
- ;; add menu (XEmacs)
- (easy-menu-add vera-mode-menu)
;; miscellaneous
(message "Vera Mode %s. Type C-c C-h for documentation." vera-version))
@@ -542,12 +503,6 @@ Key bindings:
)
"List of Vera-RVM predefined constants.")
-;; `regexp-opt' undefined (`xemacs-devel' not installed)
-(unless (fboundp 'regexp-opt)
- (defun regexp-opt (strings &optional paren)
- (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
- (concat open (mapconcat 'regexp-quote strings "\\|") close))))
-
(defconst vera-keywords-regexp
(concat "\\<\\(" (regexp-opt vera-keywords) "\\)\\>")
"Regexp for Vera keywords.")
@@ -796,10 +751,7 @@ This function does not modify point or mark."
(defun vera-skip-forward-literal ()
"Skip forward literal and return t if within one."
- (let ((state (save-excursion
- (if (fboundp 'syntax-ppss)
- (syntax-ppss)
- (parse-partial-sexp (point-min) (point))))))
+ (let ((state (save-excursion (syntax-ppss))))
(when (nth 8 state)
;; Inside a string or comment.
(goto-char (nth 8 state))
@@ -814,10 +766,7 @@ This function does not modify point or mark."
(defun vera-skip-backward-literal ()
"Skip backward literal and return t if within one."
- (let ((state (save-excursion
- (if (fboundp 'syntax-ppss)
- (syntax-ppss)
- (parse-partial-sexp (point-min) (point))))))
+ (let ((state (save-excursion (syntax-ppss))))
(when (nth 8 state)
;; Inside a string or comment.
(goto-char (nth 8 state))
@@ -1232,6 +1181,8 @@ Calls `indent-region' for whole buffer."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; electrifications
+(defvar hippie-expand-only-buffers)
+
(defun vera-electric-tab (&optional prefix)
"Do what I mean (indent, expand, tab, change indent, etc..).
If preceding character is part of a word or a paren then `hippie-expand',
@@ -1243,7 +1194,7 @@ If `vera-intelligent-tab' is nil, always indent line."
(interactive "*P")
(if vera-intelligent-tab
(progn
- (cond ((and (not (featurep 'xemacs)) (use-region-p))
+ (cond ((use-region-p)
(vera-indent-region (region-beginning) (region-end) nil))
((memq (char-syntax (preceding-char)) '(?w ?_))
(let ((case-fold-search t)
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 460957b7161..b1abefe534e 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: 2019.12.17.268053413
+;; Version: 2020.06.27.014326051
;; 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 "2019-12-17-ffa2ba5-vpo-GNU"
+(defconst verilog-mode-version "2020-06-27-0da9923-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.")
@@ -605,7 +605,7 @@ are lineup only when \\[verilog-pretty-declarations] is typed."
(function :tag "Other"))
:group 'verilog-mode-indent )
(put 'verilog-auto-lineup 'safe-local-variable
- '(lambda (x) (memq x '(nil all assignments declarations))))
+ (lambda (x) (memq x '(nil all assignments declarations))))
(defcustom verilog-indent-level 3
"Indentation of Verilog statements with respect to containing block."
@@ -958,8 +958,8 @@ See `compilation-error-regexp-alist-alist' for the formatting. For XEmacs.")
("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 1 bold t)
("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 2 bold t)
;; verilog-verilator
- (".*%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 bold t)
- (".*%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 4 bold t)
+ (".*\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 bold t)
+ (".*\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 4 bold t)
;; verilog-leda
("^In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\(Warning\\|Error\\|Failure\\)[^\n]*" 1 bold t)
("^In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\(Warning\\|Error\\|Failure\\)[^\n]*" 2 bold t)
@@ -1118,7 +1118,7 @@ SystemVerilog designs."
:type 'boolean
:group 'verilog-mode-auto)
(put 'verilog-auto-reset-widths 'safe-local-variable
- '(lambda (x) (memq x '(nil t unbased))))
+ (lambda (x) (memq x '(nil t unbased))))
(defcustom verilog-assignment-delay ""
"Text used for delays in delayed assignments. Add a trailing space if set."
@@ -1138,7 +1138,7 @@ line."
(const :tag "Line up Assignment statements" single))
:group 'verilog-mode-auto)
(put 'verilog-auto-arg-format 'safe-local-variable
- '(lambda (x) (memq x '(packed single))))
+ (lambda (x) (memq x '(packed single))))
(defcustom verilog-auto-arg-sort nil
"Non-nil means AUTOARG signal names will be sorted, not in declaration order.
@@ -1263,7 +1263,7 @@ otherwise no vectors if sizes match (like using nil)."
:group 'verilog-mode-auto
:type '(choice (const nil) (const t) (const unsigned)))
(put 'verilog-auto-inst-vector 'safe-local-variable
- '(lambda (x) (memq x '(nil t unsigned))))
+ (lambda (x) (memq x '(nil t unsigned))))
(defcustom verilog-auto-inst-template-numbers nil
"If true, when creating templated ports with AUTOINST, add a comment.
@@ -1280,7 +1280,19 @@ won't merge conflict."
:group 'verilog-mode-auto
:type '(choice (const nil) (const t) (const lhs)))
(put 'verilog-auto-inst-template-numbers 'safe-local-variable
- '(lambda (x) (memq x '(nil t lhs))))
+ (lambda (x) (memq x '(nil t lhs))))
+
+(defcustom verilog-auto-inst-template-required nil
+ "If non-nil, when creating a port with AUTOINST, require a template.
+Any port which does not have a template will be omitted from the
+instantiation.
+
+If nil, if a port is not templated it will be inserted to connect
+to a net with the same name as the port."
+ :version "28.0"
+ :group 'verilog-mode-auto
+ :type 'boolean)
+(put 'verilog-auto-inst-template-required 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-inst-column 40
"Indent-to column number for net name part of AUTOINST created pin."
@@ -1418,7 +1430,7 @@ See also `verilog-case-fold'."
:type 'hook)
(defvar verilog-imenu-generic-expression
- '((nil "^\\s-*\\(?:m\\(?:odule\\|acromodule\\)\\|p\\(?:rimitive\\|rogram\\|ackage\\)\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 1)
+ '((nil "^\\s-*\\(?:connectmodule\\|m\\(?:odule\\|acromodule\\)\\|p\\(?:rimitive\\|rogram\\|ackage\\)\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 1)
("*Variables*" "^\\s-*\\(reg\\|wire\\|logic\\)\\s-+\\(\\|\\[[^]]+\\]\\s-+\\)\\([A-Za-z0-9_]+\\)" 3)
("*Classes*" "^\\s-*\\(?:\\(?:virtual\\|interface\\)\\s-+\\)?class\\s-+\\([A-Za-z_][A-Za-z0-9_]+\\)" 1)
("*Tasks*" "^\\s-*\\(?:\\(?:static\\|pure\\|virtual\\|local\\|protected\\)\\s-+\\)*task\\s-+\\(?:\\(?:static\\|automatic\\)\\s-+\\)?\\([A-Za-z_][A-Za-z0-9_:]+\\)" 1)
@@ -2503,11 +2515,13 @@ find the errors."
(eval-when-compile
(verilog-regexp-words
'( "begin"
+ "connectmodule"
"else"
"end"
"endcase"
"endclass"
"endclocking"
+ "endconnectmodule"
"endgroup"
"endfunction"
"endmodule"
@@ -2550,6 +2564,7 @@ find the errors."
"\\(sequence\\)\\|" ; 14
"\\(clocking\\)\\|" ; 15
"\\(property\\)\\|" ; 16
+ "\\(connectmodule\\)\\|" ; 17
"\\)\\>\\)"))
(defconst verilog-end-block-re
(eval-when-compile
@@ -2710,6 +2725,7 @@ find the errors."
"endclass"
"endclocking"
"endconfig"
+ "endconnectmodule"
"endfunction"
"endgenerate"
"endgroup"
@@ -2728,7 +2744,7 @@ find the errors."
(defconst verilog-declaration-opener
(eval-when-compile
(verilog-regexp-words
- '("module" "begin" "task" "function"))))
+ '("connectmodule" "module" "begin" "task" "function"))))
(defconst verilog-declaration-prefix-re
(eval-when-compile
@@ -2790,9 +2806,9 @@ find the errors."
(defconst verilog-declaration-re-1-no-macro (concat "^" verilog-declaration-re-2-no-macro))
(defconst verilog-defun-re
- (eval-when-compile (verilog-regexp-words '("macromodule" "module" "class" "program" "interface" "package" "primitive" "config"))))
+ (eval-when-compile (verilog-regexp-words '("macromodule" "connectmodule" "module" "class" "program" "interface" "package" "primitive" "config"))))
(defconst verilog-end-defun-re
- (eval-when-compile (verilog-regexp-words '("endmodule" "endclass" "endprogram" "endinterface" "endpackage" "endprimitive" "endconfig"))))
+ (eval-when-compile (verilog-regexp-words '("endconnectmodule" "endmodule" "endclass" "endprogram" "endinterface" "endpackage" "endprimitive" "endconfig"))))
(defconst verilog-zero-indent-re
(concat verilog-defun-re "\\|" verilog-end-defun-re))
(defconst verilog-inst-comment-re
@@ -2824,7 +2840,7 @@ find the errors."
"generate" "endgenerate"
"initial"
"interface" "endinterface"
- "module" "macromodule" "endmodule"
+ "connectmodule" "module" "macromodule" "endconnectmodule" "endmodule"
"package" "endpackage"
"primitive" "endprimitive"
"program" "endprogram"
@@ -2892,14 +2908,14 @@ find the errors."
(defconst verilog-defun-level-not-generate-re
(eval-when-compile
(verilog-regexp-words
- '( "module" "macromodule" "primitive" "class" "program"
+ '( "connectmodule" "module" "macromodule" "primitive" "class" "program"
"interface" "package" "config"))))
(defconst verilog-defun-level-re
(eval-when-compile
(verilog-regexp-words
(append
- '( "module" "macromodule" "primitive" "class" "program"
+ '( "connectmodule" "module" "macromodule" "primitive" "class" "program"
"interface" "package" "config")
'( "initial" "final" "always" "always_comb" "always_ff"
"always_latch" "endtask" "endfunction" )))))
@@ -2914,7 +2930,7 @@ find the errors."
(eval-when-compile
(verilog-regexp-words
'(
- "endmodule" "endprimitive" "endinterface" "endpackage" "endprogram" "endclass"
+ "endconnectmodule" "endmodule" "endprimitive" "endinterface" "endpackage" "endprogram" "endclass"
))))
(defconst verilog-dpi-import-export-re
@@ -2935,7 +2951,7 @@ find the errors."
(eval-when-compile
(verilog-regexp-words
'(
- "always" "assign" "always_latch" "always_ff" "always_comb" "constraint"
+ "always" "assign" "always_latch" "always_ff" "always_comb" "connectmodule" "constraint"
"import" "initial" "final" "module" "macromodule" "repeat" "randcase" "while"
"if" "for" "forever" "foreach" "else" "parameter" "do" "localparam" "assert"
))))
@@ -3053,6 +3069,8 @@ find the errors."
"sync_reject_on" "unique0" "until" "until_with" "untyped" "weak"
;; 1800-2012
"implements" "interconnect" "nettype" "soft"
+ ;; AMS
+ "connectmodule" "endconnectmodule"
))
"List of Verilog keywords.")
@@ -3117,7 +3135,7 @@ See also `verilog-font-lock-extra-types'.")
(:foreground "DimGray" :italic t))
(((class grayscale) (background dark))
(:foreground "LightGray" :italic t))
- (t (:italis t)))
+ (t (:italic t)))
"Font lock mode face used to background highlight translate-off regions."
:group 'font-lock-highlighting-faces)
@@ -3199,7 +3217,7 @@ See also `verilog-font-lock-extra-types'.")
"atan2" "atanh" "branch" "ceil" "connect" "connectmodule"
"connectrules" "continuous" "cos" "cosh" "ddt" "ddt_nature"
"ddx" "discipline" "discrete" "domain" "driver_update"
- "endconnectrules" "enddiscipline" "endnature" "endparamset"
+ "endconnectmodule" "endconnectrules" "enddiscipline" "endnature" "endparamset"
"exclude" "exp" "final_step" "flicker_noise" "floor" "flow"
"from" "ground" "hypot" "idt" "idt_nature" "idtmod" "inf"
"initial_step" "laplace_nd" "laplace_np" "laplace_zd"
@@ -3278,9 +3296,9 @@ See also `verilog-font-lock-extra-types'.")
(list
;; Fontify module definitions
(list
- "\\<\\(\\(macro\\)?module\\|primitive\\|class\\|program\\|interface\\|package\\|task\\)\\>\\s-*\\(\\sw+\\)"
+ "\\<\\(\\(macro\\|connect\\)?module\\|primitive\\|class\\|program\\|interface\\|package\\|task\\)\\>\\s-*\\(\\sw+\\)"
'(1 font-lock-keyword-face)
- '(3 font-lock-function-name-face 'prepend))
+ '(3 font-lock-function-name-face prepend))
;; Fontify function definitions
(list
(concat "\\<function\\>\\s-+\\(integer\\|real\\(time\\)?\\|time\\)\\s-+\\(\\sw+\\)" )
@@ -3290,7 +3308,16 @@ See also `verilog-font-lock-extra-types'.")
(1 font-lock-keyword-face)
(2 font-lock-constant-face append))
'("\\<function\\>\\s-+\\(\\sw+\\)"
- 1 'font-lock-constant-face append))))
+ 1 'font-lock-constant-face append)
+ ;; Fontify variable names in declarations
+ (list ;; Implemented as an anchored-matcher
+ (concat verilog-declaration-re
+ " *\\(" verilog-range-re "\\)?")
+ (list ;; anchored-highlighter
+ (concat "\\_<\\(" verilog-symbol-re "\\)"
+ " *\\(" verilog-range-re "\\)?*")
+ nil nil '(1 font-lock-variable-name-face))))))
+
(setq verilog-font-lock-keywords-2
(append verilog-font-lock-keywords-1
@@ -3596,7 +3623,7 @@ Use filename, if current buffer being edited shorten to just buffer name."
(setq found 't))))))
((looking-at verilog-end-block-re)
(verilog-leap-to-head))
- ((looking-at "\\(endmodule\\>\\)\\|\\(\\<endprimitive\\>\\)\\|\\(\\<endclass\\>\\)\\|\\(\\<endprogram\\>\\)\\|\\(\\<endinterface\\>\\)\\|\\(\\<endpackage\\>\\)")
+ ((looking-at "\\(endmodule\\>\\)\\|\\(\\<endprimitive\\>\\)\\|\\(\\<endclass\\>\\)\\|\\(\\<endprogram\\>\\)\\|\\(\\<endinterface\\>\\)\\|\\(\\<endpackage\\>\\)\\|\\(\\<endconnectmodule\\>\\)")
(cond
((match-end 1)
(verilog-re-search-backward "\\<\\(macro\\)?module\\>" nil 'move))
@@ -3610,6 +3637,8 @@ Use filename, if current buffer being edited shorten to just buffer name."
(verilog-re-search-backward "\\<interface\\>" nil 'move))
((match-end 6)
(verilog-re-search-backward "\\<package\\>" nil 'move))
+ ((match-end 7)
+ (verilog-re-search-backward "\\<connectmodule\\>" nil 'move))
(t
(goto-char st)
(backward-sexp 1))))
@@ -3735,7 +3764,8 @@ Use filename, if current buffer being edited shorten to just buffer name."
"\\(\\<class\\>\\)\\|"
"\\(\\<program\\>\\)\\|"
"\\(\\<interface\\>\\)\\|"
- "\\(\\<package\\>\\)"))
+ "\\(\\<package\\>\\)\\|"
+ "\\(\\<connectmodule\\>\\)"))
(cond
((match-end 1)
(verilog-re-search-forward "\\<endmodule\\>" nil 'move))
@@ -3749,6 +3779,8 @@ Use filename, if current buffer being edited shorten to just buffer name."
(verilog-re-search-forward "\\<endinterface\\>" nil 'move))
((match-end 6)
(verilog-re-search-forward "\\<endpackage\\>" nil 'move))
+ ((match-end 7)
+ (verilog-re-search-forward "\\<endconnectmodule\\>" nil 'move))
(t
(goto-char st)
(if (= (following-char) ?\) )
@@ -4556,13 +4588,13 @@ More specifically, point @ in the line foo : @ begin"
(let ((nest 1))
(while t
(verilog-re-search-backward
- (concat "\\(\\<module\\>\\)\\|\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|"
+ (concat "\\(\\<module\\>\\)\\|\\(\\<connectmodule\\>\\)\\|\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|"
"\\(\\<endcase\\>\\)\\>")
nil 'move)
(cond
- ((match-end 3)
+ ((match-end 4)
(setq nest (1+ nest)))
- ((match-end 2)
+ ((match-end 3)
(if (= nest 1)
(throw 'found 1))
(setq nest (1- nest)))
@@ -4571,9 +4603,11 @@ More specifically, point @ in the line foo : @ begin"
nil)))
(defun verilog-backward-up-list (arg)
- "Call `backward-up-list' ARG, ignoring comments."
+ "Call `backward-up-list' ARG, ignoring comments and errors."
(let ((parse-sexp-ignore-comments t))
- (backward-up-list arg)))
+ (condition-case nil
+ (backward-up-list arg) ;; May throw Unbalanced parenthesis
+ (error nil))))
(defun verilog-forward-sexp-cmt (arg)
"Call `forward-sexp' ARG, inside comments."
@@ -4595,13 +4629,15 @@ More specifically, after a generate and before an endgenerate."
(while (and
(/= nest 0)
(verilog-re-search-backward
- "\\<\\(module\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\>" nil 'move)
+ "\\<\\(module\\)\\|\\(connectmodule\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\>" nil 'move)
(cond
((match-end 1) ; module - we have crawled out
(throw 'done 1))
- ((match-end 2) ; generate
+ ((match-end 2) ; connectmodule - we have crawled out
+ (throw 'done 1))
+ ((match-end 3) ; generate
(setq nest (1- nest)))
- ((match-end 3) ; endgenerate
+ ((match-end 4) ; endgenerate
(setq nest (1+ nest))))))))
(= nest 0) )) ; return nest
@@ -5064,6 +5100,8 @@ primitive or interface named NAME."
(setq reg "\\(\\<clocking\\>\\)\\|\\<endclocking\\>"))
((match-end 16) ; of verilog-end-block-ordered-re
(setq reg "\\(\\<property\\>\\)\\|\\<endproperty\\>"))
+ ((match-end 17) ; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<connectmodule\\>\\)\\|\\<endconnectmodule\\>"))
(t (error "Problem in verilog-set-auto-endcomments")))
(let (b e)
@@ -5089,7 +5127,7 @@ primitive or interface named NAME."
(setq string (buffer-substring b e)))
(t
(ding 't)
- (setq string "unmatched end(function|task|module|primitive|interface|package|class|clocking)")))))
+ (setq string "unmatched end(function|task|module|connectmodule|primitive|interface|package|class|clocking)")))))
(end-of-line)
(insert (concat " // " string )))
))))))))))
@@ -5345,7 +5383,7 @@ becomes:
(interactive)
(save-excursion
(beginning-of-line)
- (when (looking-at "\\(.*\\)([WE]\\([0-9A-Z]+\\)).*,\\s +line\\s +[0-9]+:\\s +\\([^:\n]+\\):?.*$")
+ (when (looking-at "\\(.*\\)([WE]\\([0-9A-Z]+\\)).*,\\s +line\\s +[0-9]+:\\s +\\([^:\n]+\\).*$")
(replace-match (format
;; %3s makes numbers 1-999 line up nicely
"\\1//Verilint %3s off // WARNING: \\3"
@@ -5560,7 +5598,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(case-fold-search nil)
(par 0)
(begin (looking-at "[ \t]*begin\\>"))
- (lim (save-excursion (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<module\\>\\)" nil t)))
+ (lim (save-excursion (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<\\(connect\\)?module\\>\\)" nil t)))
(structres nil)
(type (catch 'nesting
;; Keep working backwards until we can figure out
@@ -6788,7 +6826,7 @@ Do not count named blocks or case-statements."
((looking-at verilog-named-block-re)
(current-column))
((and (not (looking-at verilog-extended-case-re))
- (looking-at "^[^:;]+[ \t]*:"))
+ (looking-at "^[^:;]+:"))
(verilog-re-search-forward ":" nil t)
(skip-chars-forward " \t")
(current-column))
@@ -7113,7 +7151,7 @@ BASEIND is the base indent to offset everything."
(let ((pos (point-marker))
(lim (save-excursion
;; (verilog-re-search-backward verilog-declaration-opener nil 'move)
- (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<module\\>\\)\\|\\(\\<task\\>\\)" nil 'move)
+ (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<\\(connect\\)?module\\>\\)\\|\\(\\<task\\>\\)" nil 'move)
(point)))
(ind)
(val)
@@ -7272,7 +7310,7 @@ it displays a list of all possible completions.")
\(integer, real, reg...)")
(defvar verilog-cpp-keywords
- '("module" "macromodule" "primitive" "timescale" "define" "ifdef" "ifndef" "else"
+ '("connectmodule" "module" "macromodule" "primitive" "timescale" "define" "ifdef" "ifndef" "else"
"endif")
"Keywords to complete when at first word of a line in declarative scope.
\(initial, always, begin, assign...)
@@ -7283,7 +7321,7 @@ will be completed at runtime and should not be added to this list.")
(append
'(
"always" "always_comb" "always_ff" "always_latch" "assign"
- "begin" "end" "generate" "endgenerate" "module" "endmodule"
+ "begin" "end" "connectmodule" "endconnectmodule" "generate" "endgenerate" "module" "endmodule"
"specify" "endspecify" "function" "endfunction" "initial" "final"
"task" "endtask" "primitive" "endprimitive"
)
@@ -7380,9 +7418,9 @@ 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\\)\\s +")
+ ((eq type 'module) "\\<\\(module\\|connectmodule\\)\\s +")
((eq type 'tf) "\\<\\(task\\|function\\)\\s +")
- (t "\\<\\(task\\|function\\|module\\)\\s +"))
+ (t "\\<\\(task\\|function\\|module\\|connectmodule\\)\\s +"))
"\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>"))
match)
@@ -7724,7 +7762,7 @@ If search fails, other files are checked based on
(first 1)
(prevpos (point-min))
(final-context-start (make-marker))
- (regexp "\\(module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)"))
+ (regexp "\\(\\(connect\\)?module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)"))
(with-output-to-temp-buffer "*Occur*"
(save-excursion
(message "Searching for %s ..." regexp)
@@ -7782,7 +7820,7 @@ If search fails, other files are checked based on
"Return point if within translate-off region, else nil."
(and (save-excursion
(re-search-backward
- (concat "//\\s-*.*\\s-*" verilog-directive-regexp "\\(on\\|off\\)\\>")
+ (concat "//.*" verilog-directive-regexp "\\(on\\|off\\)\\>")
nil t))
(equal "off" (match-string 2))
(point)))
@@ -7790,14 +7828,14 @@ If search fails, other files are checked based on
(defun verilog-start-translate-off (limit)
"Return point before translate-off directive if before LIMIT, else nil."
(when (re-search-forward
- (concat "//\\s-*.*\\s-*" verilog-directive-regexp "off\\>")
+ (concat "//.*" verilog-directive-regexp "off\\>")
limit t)
(match-beginning 0)))
(defun verilog-back-to-start-translate-off (limit)
"Return point before translate-off directive if before LIMIT, else nil."
(when (re-search-backward
- (concat "//\\s-*.*\\s-*" verilog-directive-regexp "off\\>")
+ (concat "//.*" verilog-directive-regexp "off\\>")
limit t)
(match-beginning 0)))
@@ -7805,7 +7843,7 @@ If search fails, other files are checked based on
"Return point after translate-on directive if before LIMIT, else nil."
(re-search-forward (concat
- "//\\s-*.*\\s-*" verilog-directive-regexp "on\\>") limit t))
+ "//.*" verilog-directive-regexp "on\\>") limit t))
(defun verilog-match-translate-off (limit)
"Match a translate-off block, setting `match-data' and returning t, else nil.
@@ -8445,7 +8483,8 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters."
(let ((olist))
(save-excursion
;; /*AUTOPUNT("parameter", "parameter")*/
- (backward-sexp 1)
+ (when (not (eq (char-before) ?\*)) ; Not .*
+ (backward-sexp 1))
(while (looking-at "(?\\s *\"\\([^\"]*\\)\"\\s *,?")
(setq olist (cons (match-string-no-properties 1) olist))
(goto-char (match-end 0))))
@@ -9895,7 +9934,7 @@ Allows version control to check out the file if need be."
(while (and
;; It may be tempting to look for verilog-defun-re,
;; don't, it slows things down a lot!
- (verilog-re-search-forward-quick "\\<\\(module\\|interface\\|program\\)\\>" nil t)
+ (verilog-re-search-forward-quick "\\<\\(connectmodule\\|module\\|interface\\|program\\)\\>" nil t)
(setq type (match-string-no-properties 0))
(verilog-re-search-forward-quick "[(;]" nil t))
(if (equal module (verilog-read-module-name))
@@ -9982,7 +10021,7 @@ Or, just the existing dirnames themselves if there are no wildcards."
(while dirnames
(setq dirname (car dirnames)
dirnames (cdr dirnames))
- (cond ((string-match (concat "^\\(\\|[/\\]*[^*?]*[/\\]\\)" ; root
+ (cond ((string-match (concat "^\\(\\|[^*?]*[/\\]\\)" ; root
"\\([^/\\]*[*?][^/\\]*\\)" ; filename with *?
"\\(.*\\)") ; rest
dirname)
@@ -10923,9 +10962,9 @@ shown) will make this into:
;; Presume one module per file.
(save-excursion
(goto-char (point-min))
- (while (verilog-re-search-forward-quick "\\<module\\>" nil t)
+ (while (verilog-re-search-forward-quick "\\<\\(connect\\)?module\\>" nil t)
(let ((endmodp (save-excursion
- (verilog-re-search-forward-quick "\\<endmodule\\>" nil t)
+ (verilog-re-search-forward-quick "\\<end\\(connect\\)?module\\>" nil t)
(point))))
;; See if there's already a comment .. inside a comment so not verilog-re-search
(when (not (re-search-forward "/\\*AUTOARG\\*/" endmodp t))
@@ -11370,9 +11409,10 @@ See the example in `verilog-auto-inout-modport'."
(defvar vl-bits nil "See `verilog-auto-inst'.") ; Prevent compile warning
(defvar vl-mbits nil "See `verilog-auto-inst'.") ; Prevent compile warning
-(defun verilog-auto-inst-port (port-st indent-pt moddecls tpl-list tpl-num for-star par-values)
+(defun verilog-auto-inst-port (section port-st indent-pt moddecls tpl-list tpl-num
+ for-star par-values)
"Print out an instantiation connection for this PORT-ST.
-Insert to INDENT-PT, use template TPL-LIST.
+Inside SECTION, insert to INDENT-PT, use template TPL-LIST.
@ are instantiation numbers, replaced with TPL-NUM.
@\"(expression @)\" are evaluated, with @ as a variable.
If FOR-STAR add comment it is a .* expansion.
@@ -11474,60 +11514,74 @@ If PAR-VALUES replace final strings with these parameter values."
(setq tpl-net (verilog-string-replace-matches "\\[\\]\\[\\]" dflt-bits nil nil tpl-net))
(setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net)))
;; Insert it
- (indent-to indent-pt)
- (insert "." port)
- (unless (and verilog-auto-inst-dot-name
- (equal port tpl-net))
- (indent-to verilog-auto-inst-column)
- (insert "(" tpl-net ")"))
- (insert ",")
- (cond (tpl-ass
- (verilog-read-auto-template-hit tpl-ass)
- (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16)
- verilog-auto-inst-column))
- ;; verilog-insert requires the complete comment in one call - including the newline
- (cond ((equal verilog-auto-inst-template-numbers 'lhs)
- (verilog-insert " // Templated"
- " LHS: " (nth 0 tpl-ass)
- "\n"))
- (verilog-auto-inst-template-numbers
- (verilog-insert " // Templated"
- " T" (int-to-string (nth 2 tpl-ass))
- " L" (int-to-string (nth 3 tpl-ass))
- "\n"))
- (t
- (verilog-insert " // Templated\n"))))
- (for-star
- (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16)
- verilog-auto-inst-column))
- (verilog-insert " // Implicit .*\n"))
- (t
- (insert "\n")))))
-;;(verilog-auto-inst-port (list "foo" "[5:0]") 10 (list (list "foo" "a@\"(% (+ @ 1) 4)\"a")) "3")
+ (when (or tpl-ass (not verilog-auto-inst-template-required))
+ (verilog-auto-inst-first section)
+ (indent-to indent-pt)
+ (insert "." port)
+ (unless (and verilog-auto-inst-dot-name
+ (equal port tpl-net))
+ (indent-to verilog-auto-inst-column)
+ (insert "(" tpl-net ")"))
+ (insert ",")
+ (cond (tpl-ass
+ (verilog-read-auto-template-hit tpl-ass)
+ (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16)
+ verilog-auto-inst-column))
+ ;; verilog-insert requires the complete comment in one call - including the newline
+ (cond ((equal verilog-auto-inst-template-numbers 'lhs)
+ (verilog-insert " // Templated"
+ " LHS: " (nth 0 tpl-ass)
+ "\n"))
+ (verilog-auto-inst-template-numbers
+ (verilog-insert " // Templated"
+ " T" (int-to-string (nth 2 tpl-ass))
+ " L" (int-to-string (nth 3 tpl-ass))
+ "\n"))
+ (t
+ (verilog-insert " // Templated\n"))))
+ (for-star
+ (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16)
+ verilog-auto-inst-column))
+ (verilog-insert " // Implicit .*\n"))
+ (t
+ (insert "\n"))))))
+;;(verilog-auto-inst-port "" (list "foo" "[5:0]") 10 (list (list "foo" "a@\"(% (+ @ 1) 4)\"a")) "3")
;;(x "incom[@\"(+ (* 8 @) 7)\":@\"(* 8 @)\"]")
;;(x ".out (outgo[@\"(concat (+ (* 8 @) 7) \\\":\\\" ( * 8 @))\"]));")
-(defun verilog-auto-inst-port-list (sig-list indent-pt moddecls tpl-list tpl-num for-star par-values)
- "For `verilog-auto-inst' print a list of ports using `verilog-auto-inst-port'."
- (when verilog-auto-inst-sort
- (setq sig-list (sort (copy-alist sig-list) #'verilog-signals-sort-compare)))
- (mapc (lambda (port)
- (verilog-auto-inst-port port indent-pt moddecls
- tpl-list tpl-num for-star par-values))
- sig-list))
+(defvar verilog-auto-inst-first-section nil
+ "Local first-in-section for `verilog-auto-inst-first'.")
+(defvar verilog-auto-inst-first-any nil
+ "Local first-in-any-section for `verilog-auto-inst-first'.")
-(defun verilog-auto-inst-first ()
- "Insert , etc before first ever port in this instant, as part of \\[verilog-auto-inst]."
+(defun verilog-auto-inst-first (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
;; to avoid trouble we only insert on preceding ) or *.
;; Insert first port on new line
- (insert "\n") ; Must insert before search, so point will move forward if insert comma
- (save-excursion
- (verilog-re-search-backward-quick "[^ \t\n\f]" nil nil)
- (when (looking-at ")\\|\\*") ; Generally don't insert, unless we are fairly sure
- (forward-char 1)
- (insert ","))))
+ (when verilog-auto-inst-first-any
+ (setq verilog-auto-inst-first-any nil)
+ (insert "\n") ; Must insert before search, so point will move forward if insert comma
+ (save-excursion
+ (verilog-re-search-backward-quick "[^ \t\n\f]" nil nil)
+ (when (looking-at ")\\|\\*") ; Generally don't insert, unless we are fairly sure
+ (forward-char 1)
+ (insert ","))))
+ (when verilog-auto-inst-first-section
+ (setq verilog-auto-inst-first-section nil)
+ (verilog-insert-indent section)))
+
+(defun verilog-auto-inst-port-list (section sig-list indent-pt moddecls
+ tpl-list tpl-num for-star par-values)
+ "For `verilog-auto-inst' print a list of ports using `verilog-auto-inst-port'."
+ (when verilog-auto-inst-sort
+ (setq sig-list (sort (copy-alist sig-list) #'verilog-signals-sort-compare)))
+ (let ((verilog-auto-inst-first-section t))
+ (mapc (lambda (port)
+ (verilog-auto-inst-port section port indent-pt moddecls
+ tpl-list tpl-num for-star par-values))
+ sig-list)))
(defun verilog-auto-star ()
"Expand SystemVerilog .* pins, as part of \\[verilog-auto].
@@ -11554,6 +11608,9 @@ Replace the pin connections to an instantiation or interface
declaration with ones automatically derived from the module or
interface header of the instantiated item.
+You may also provide an optional regular expression, in which
+case only I/O matching the regular expression will be included.
+
If `verilog-auto-star-expand' is set, also expand SystemVerilog .* ports,
and delete them before saving unless `verilog-auto-star-save' is set.
See `verilog-auto-star' for more information.
@@ -11697,6 +11754,10 @@ Templates:
debugging is completed though, it will result in lots of extra differences
and merge conflicts.
+ If a connection name does not match any template, it is
+ connected to a net by the same name as the port (unless
+ `verilog-auto-inst-template-required' is true).
+
Setting `verilog-auto-template-warn-unused' will report errors
if any template lines are unused.
@@ -11868,16 +11929,19 @@ For more information see the \\[verilog-faq] and forums at URL
`https://www.veripool.org'."
(save-excursion
;; Find beginning
- (let* ((pt (point))
+ (let* ((params (verilog-read-auto-params 0 1))
+ (regexp (nth 0 params))
+ (pt (point))
(for-star (save-excursion (backward-char 2) (looking-at "\\.\\*")))
(indent-pt (save-excursion (verilog-backward-open-paren)
(1+ (current-column))))
(verilog-auto-inst-column (max verilog-auto-inst-column
(+ 16 (* 8 (/ (+ indent-pt 7) 8)))))
+ (verilog-auto-inst-first-any t)
(modi (verilog-modi-current))
(moddecls (verilog-modi-get-decls modi))
submod submodi submoddecls
- inst skip-pins tpl-list tpl-num did-first par-values)
+ inst skip-pins tpl-list tpl-num par-values)
;; Find module name that is instantiated
(setq submod (verilog-read-inst-module)
@@ -11912,53 +11976,58 @@ For more information see the \\[verilog-faq] and forums at URL
(verilog-decls-get-vars submoddecls)
skip-pins)))
(vl-dir "interfaced"))
+ (when regexp
+ (setq sig-list (verilog-signals-matching-regexp sig-list regexp)))
(when (and sig-list
verilog-auto-inst-interfaced-ports)
- (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
;; Note these are searched for in verilog-read-sub-decls.
- (verilog-insert-indent "// Interfaced\n")
- (verilog-auto-inst-port-list sig-list indent-pt moddecls
+ (verilog-auto-inst-port-list "// Interfaced\n"
+ sig-list indent-pt moddecls
tpl-list tpl-num for-star par-values)))
(let ((sig-list (verilog-signals-not-in
(verilog-decls-get-interfaces submoddecls)
skip-pins))
(vl-dir "interface"))
+ (when regexp
+ (setq sig-list (verilog-signals-matching-regexp sig-list regexp)))
(when sig-list
- (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
;; Note these are searched for in verilog-read-sub-decls.
- (verilog-insert-indent "// Interfaces\n")
- (verilog-auto-inst-port-list sig-list indent-pt moddecls
- tpl-list tpl-num for-star par-values)))
+ (verilog-auto-inst-port-list "// Interfaces\n"
+ sig-list indent-pt moddecls
+ tpl-list tpl-num for-star par-values)))
(let ((sig-list (verilog-signals-not-in
(verilog-decls-get-outputs submoddecls)
skip-pins))
(vl-dir "output"))
+ (when regexp
+ (setq sig-list (verilog-signals-matching-regexp sig-list regexp)))
(when sig-list
- (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
- (verilog-insert-indent "// Outputs\n")
- (verilog-auto-inst-port-list sig-list indent-pt moddecls
+ (verilog-auto-inst-port-list "// Outputs\n"
+ sig-list indent-pt moddecls
tpl-list tpl-num for-star par-values)))
(let ((sig-list (verilog-signals-not-in
(verilog-decls-get-inouts submoddecls)
skip-pins))
(vl-dir "inout"))
+ (when regexp
+ (setq sig-list (verilog-signals-matching-regexp sig-list regexp)))
(when sig-list
- (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
- (verilog-insert-indent "// Inouts\n")
- (verilog-auto-inst-port-list sig-list indent-pt moddecls
+ (verilog-auto-inst-port-list "// Inouts\n"
+ sig-list indent-pt moddecls
tpl-list tpl-num for-star par-values)))
(let ((sig-list (verilog-signals-not-in
(verilog-decls-get-inputs submoddecls)
skip-pins))
(vl-dir "input"))
+ (when regexp
+ (setq sig-list (verilog-signals-matching-regexp sig-list regexp)))
(when sig-list
- (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
- (verilog-insert-indent "// Inputs\n")
- (verilog-auto-inst-port-list sig-list indent-pt moddecls
+ (verilog-auto-inst-port-list "// Inputs\n"
+ sig-list indent-pt moddecls
tpl-list tpl-num for-star par-values)))
;; Kill extra semi
(save-excursion
- (cond (did-first
+ (cond ((not verilog-auto-inst-first-any)
(re-search-backward "," pt t)
(delete-char 1)
(insert ");")
@@ -12020,10 +12089,11 @@ Templates:
(1+ (current-column))))
(verilog-auto-inst-column (max verilog-auto-inst-column
(+ 16 (* 8 (/ (+ indent-pt 7) 8)))))
+ (verilog-auto-inst-first-any t)
(modi (verilog-modi-current))
(moddecls (verilog-modi-get-decls modi))
submod submodi submoddecls
- inst skip-pins tpl-list tpl-num did-first)
+ inst skip-pins tpl-list tpl-num)
;; Find module name that is instantiated
(setq submod (save-excursion
;; Get to the point where AUTOINST normally is to read the module
@@ -12060,14 +12130,13 @@ Templates:
(when regexp
(setq sig-list (verilog-signals-matching-regexp sig-list regexp)))
(when sig-list
- (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
;; Note these are searched for in verilog-read-sub-decls.
- (verilog-insert-indent "// Parameters\n")
- (verilog-auto-inst-port-list sig-list indent-pt moddecls
+ (verilog-auto-inst-port-list "// Parameters\n"
+ sig-list indent-pt moddecls
tpl-list tpl-num nil nil)))
;; Kill extra semi
(save-excursion
- (cond (did-first
+ (cond ((not verilog-auto-inst-first-any)
(re-search-backward "," pt t)
(delete-char 1)
(insert ")")
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 39819131010..3d66483b83e 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -2304,10 +2304,6 @@ Ignore byte-compiler warnings you might see."
(defvaralias 'vhdl-last-input-event 'last-input-char)
(defvaralias 'vhdl-last-input-event 'last-input-event))
-;; `help-print-return-message' changed to `print-help-return-message' in Emacs
-;;;(unless (fboundp 'help-print-return-message)
-;;; (defalias 'help-print-return-message 'print-help-return-message))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Compatibility with older VHDL Mode versions
@@ -16148,7 +16144,7 @@ expansion function)."
;; initialize speedbar
(if (not (boundp 'speedbar-frame))
- (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)))
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 1cee552b0c0..266f40abbae 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -186,7 +186,7 @@ and you want to simplify them for the mode line
"Non-nil means display current function name in mode line.
This makes a difference only if `which-function-mode' is non-nil.")
-(add-hook 'find-file-hook 'which-func-ff-hook t)
+(add-hook 'after-change-major-mode-hook 'which-func-ff-hook t)
(defun which-func-try-to-enable ()
(unless (or (not which-function-mode)
@@ -195,7 +195,7 @@ This makes a difference only if `which-function-mode' is non-nil.")
(member major-mode which-func-modes)))))
(defun which-func-ff-hook ()
- "File find hook for Which Function mode.
+ "`after-change-major-mode-hook' for Which Function mode.
It creates the Imenu index for the buffer, if necessary."
(which-func-try-to-enable)
@@ -282,52 +282,55 @@ If no function name is found, return nil."
(when (null name)
(setq name (add-log-current-defun)))
;; If Imenu is loaded, try to make an index alist with it.
+ ;; If `add-log-current-defun' ran and gave nil, accept that.
(when (and (null name)
- (boundp 'imenu--index-alist)
- (or (null imenu--index-alist)
- ;; Update if outdated
- (/= (buffer-chars-modified-tick) imenu-menubar-modified-tick))
- (null which-function-imenu-failed))
- (ignore-errors (imenu--make-index-alist t))
- (unless imenu--index-alist
- (set (make-local-variable 'which-function-imenu-failed) t)))
- ;; If we have an index alist, use it.
- (when (and (null name)
- (boundp 'imenu--index-alist) imenu--index-alist)
- (let ((alist imenu--index-alist)
- (minoffset (point-max))
- offset pair mark imstack namestack)
- ;; Elements of alist are either ("name" . marker), or
- ;; ("submenu" ("name" . marker) ... ). The list can be
- ;; arbitrarily nested.
- (while (or alist imstack)
- (if (null alist)
- (setq alist (car imstack)
- namestack (cdr namestack)
- imstack (cdr imstack))
-
- (setq pair (car-safe alist)
- alist (cdr-safe alist))
-
- (cond
- ((atom pair)) ; Skip anything not a cons.
-
- ((imenu--subalist-p pair)
- (setq imstack (cons alist imstack)
- namestack (cons (car pair) namestack)
- alist (cdr pair)))
-
- ((or (number-or-marker-p (setq mark (cdr pair)))
- (and (overlayp mark)
- (setq mark (overlay-start mark))))
- (when (and (>= (setq offset (- (point) mark)) 0)
- (< offset minoffset)) ; Find the closest item.
- (setq minoffset offset
- name (if (null which-func-imenu-joiner-function)
- (car pair)
- (funcall
- which-func-imenu-joiner-function
- (reverse (cons (car pair) namestack))))))))))))
+ (null add-log-current-defun-function))
+ (when (and (null name)
+ (boundp 'imenu--index-alist)
+ (or (null imenu--index-alist)
+ ;; Update if outdated
+ (/= (buffer-chars-modified-tick) imenu-menubar-modified-tick))
+ (null which-function-imenu-failed))
+ (ignore-errors (imenu--make-index-alist t))
+ (unless imenu--index-alist
+ (set (make-local-variable 'which-function-imenu-failed) t)))
+ ;; If we have an index alist, use it.
+ (when (and (null name)
+ (boundp 'imenu--index-alist) imenu--index-alist)
+ (let ((alist imenu--index-alist)
+ (minoffset (point-max))
+ offset pair mark imstack namestack)
+ ;; Elements of alist are either ("name" . marker), or
+ ;; ("submenu" ("name" . marker) ... ). The list can be
+ ;; arbitrarily nested.
+ (while (or alist imstack)
+ (if (null alist)
+ (setq alist (car imstack)
+ namestack (cdr namestack)
+ imstack (cdr imstack))
+
+ (setq pair (car-safe alist)
+ alist (cdr-safe alist))
+
+ (cond
+ ((atom pair)) ; Skip anything not a cons.
+
+ ((imenu--subalist-p pair)
+ (setq imstack (cons alist imstack)
+ namestack (cons (car pair) namestack)
+ alist (cdr pair)))
+
+ ((or (number-or-marker-p (setq mark (cdr pair)))
+ (and (overlayp mark)
+ (setq mark (overlay-start mark))))
+ (when (and (>= (setq offset (- (point) mark)) 0)
+ (< offset minoffset)) ; Find the closest item.
+ (setq minoffset offset
+ name (if (null which-func-imenu-joiner-function)
+ (car pair)
+ (funcall
+ which-func-imenu-joiner-function
+ (reverse (cons (car pair) namestack)))))))))))))
;; Filter the name if requested.
(when name
(if which-func-cleanup-function
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index c36a9bd9940..de2053c3c99 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1,6 +1,11 @@
-;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
+;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Version: 1.0.3
+;; Package-Requires: ((emacs "26.3"))
+
+;; This is a GNU ELPA :core package. Avoid functionality that is not
+;; compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.
@@ -258,17 +263,24 @@ be found, return nil.
The default implementation uses `semantic-symref-tool-alist' to
find a search tool; by default, this uses \"find | grep\" in the
-`project-current' roots."
- (cl-mapcan
+current project's main and external roots."
+ (mapcan
(lambda (dir)
(xref-references-in-directory identifier dir))
(let ((pr (project-current t)))
- (append
- (project-roots pr)
+ (cons
+ (if (fboundp 'project-root)
+ (project-root pr)
+ (with-no-warnings
+ (project-roots pr)))
(project-external-roots pr)))))
(cl-defgeneric xref-backend-apropos (backend pattern)
- "Find all symbols that match regexp PATTERN.")
+ "Find all symbols that match PATTERN string.
+The second argument has the same meaning as in `apropos'.
+
+If BACKEND is implemented in Lisp, it can use
+`xref-apropos-regexp' to convert the pattern to regexp.")
(cl-defgeneric xref-backend-identifier-at-point (_backend)
"Return the relevant identifier at point.
@@ -596,7 +608,10 @@ buffer."
(user-error "No reference at point")))
(xref--current-item xref))
(xref--show-location (xref-item-location xref) (if quit 'quit t))
- (next-error-found buffer (current-buffer))))
+ (if (fboundp 'next-error-found)
+ (next-error-found buffer (current-buffer))
+ ;; Emacs < 27
+ (setq next-error-last-buffer buffer))))
(defun xref-quit-and-goto-xref ()
"Quit *xref* buffer, then jump to xref on current line."
@@ -946,8 +961,18 @@ Accepts the same arguments as `xref-show-xrefs-function'."
(defvar xref--read-pattern-history nil)
-(defun xref--show-xrefs (fetcher display-action)
+(defun xref--show-xrefs (fetcher display-action &optional _always-show-list)
(xref--push-markers)
+ (unless (functionp fetcher)
+ ;; Old convention.
+ (let ((xrefs fetcher))
+ (setq fetcher
+ (lambda ()
+ (if (eq xrefs 'called-already)
+ (user-error "Refresh is not supported")
+ (prog1
+ xrefs
+ (setq xrefs 'called-already)))))))
(funcall xref-show-xrefs-function fetcher
`((window . ,(selected-window))
(display-action . ,display-action))))
@@ -1093,14 +1118,24 @@ The argument has the same meaning as in `apropos'."
"Search for pattern (word list or regexp): "
nil 'xref--read-pattern-history)))
(require 'apropos)
- (xref--find-xrefs pattern 'apropos
- (apropos-parse-pattern
- (if (string-equal (regexp-quote pattern) pattern)
- ;; Split into words
- (or (split-string pattern "[ \t]+" t)
- (user-error "No word list given"))
- pattern))
- nil))
+ (let* ((newpat
+ (if (and (version< emacs-version "28.0.50")
+ (memq (xref-find-backend) '(elisp etags)))
+ ;; Handle backends in older Emacs.
+ (xref-apropos-regexp pattern)
+ ;; Delegate pattern handling to the backend fully.
+ ;; The old way didn't work for "external" backends.
+ pattern)))
+ (xref--find-xrefs pattern 'apropos newpat nil)))
+
+(defun xref-apropos-regexp (pattern)
+ "Return an Emacs regexp from PATTERN similar to `apropos'."
+ (apropos-parse-pattern
+ (if (string-equal (regexp-quote pattern) pattern)
+ ;; Split into words
+ (or (split-string pattern "[ \t]+" t)
+ (user-error "No word list given"))
+ pattern)))
;;; Key bindings
@@ -1262,13 +1297,13 @@ FILES must be a list of absolute file names."
(insert (mapconcat #'identity files "\0"))
(setq default-directory dir)
(setq status
- (project--process-file-region (point-min)
- (point-max)
- shell-file-name
- output
- nil
- shell-command-switch
- command)))
+ (xref--process-file-region (point-min)
+ (point-max)
+ shell-file-name
+ output
+ nil
+ shell-command-switch
+ command)))
(goto-char (point-min))
(when (and (/= (point-min) (point-max))
(not (looking-at grep-re))
@@ -1283,6 +1318,24 @@ FILES must be a list of absolute file names."
hits)))
(xref--convert-hits (nreverse hits) regexp)))
+(defun xref--process-file-region ( start end program
+ &optional buffer display
+ &rest args)
+ ;; FIXME: This branching shouldn't be necessary, but
+ ;; call-process-region *is* measurably faster, even for a program
+ ;; doing some actual work (for a period of time). Even though
+ ;; call-process-region also creates a temp file internally
+ ;; (http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html).
+ (if (not (file-remote-p default-directory))
+ (apply #'call-process-region
+ start end program nil buffer display args)
+ (let ((infile (make-temp-file "ppfr")))
+ (unwind-protect
+ (progn
+ (write-region start end infile nil 'silent)
+ (apply #'process-file program infile buffer display args))
+ (delete-file infile)))))
+
(defun xref--rgrep-command (regexp files dir ignores)
(require 'find-dired) ; for `find-name-arg'
(defvar grep-find-template)
@@ -1317,11 +1370,11 @@ directory, used as the root of the ignore globs."
(lambda (ignore)
(when (string-match-p "/\\'" ignore)
(setq ignore (concat ignore "*")))
- (if (string-match "\\`\\./" ignore)
- (setq ignore (replace-match dir t t ignore))
- (unless (string-prefix-p "*" ignore)
- (setq ignore (concat "*/" ignore))))
- (shell-quote-argument ignore))
+ (shell-quote-argument (if (string-match "\\`\\./" ignore)
+ (replace-match dir t t ignore)
+ (if (string-prefix-p "*" ignore)
+ ignore
+ (concat "*/" ignore)))))
ignores
" -o -path ")
" "
@@ -1364,8 +1417,8 @@ Such as the current syntax table and the applied syntax properties."
(let (xref--last-file-buffer
(tmp-buffer (generate-new-buffer " *xref-temp*")))
(unwind-protect
- (cl-mapcan (lambda (hit) (xref--collect-matches hit regexp tmp-buffer))
- hits)
+ (mapcan (lambda (hit) (xref--collect-matches hit regexp tmp-buffer))
+ hits)
(kill-buffer tmp-buffer))))
(defun xref--collect-matches (hit regexp tmp-buffer)
diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index 8dfb3a40dd1..c6997862f7f 100644
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -446,8 +446,6 @@ Entry to this mode runs `scheme-mode-hook' and then
(scheme-interaction-mode-initialize)
(scheme-interaction-mode t)))))
-(define-obsolete-function-alias 'advertised-xscheme-send-previous-expression
- 'xscheme-send-previous-expression "23.2")
;;;; Debugger Mode
diff --git a/lisp/ps-def.el b/lisp/ps-def.el
index 49d72d3be50..571e1a68c5e 100644
--- a/lisp/ps-def.el
+++ b/lisp/ps-def.el
@@ -5,7 +5,7 @@
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Kenichi Handa <handa@gnu.org> (multi-byte characters)
;; Keywords: wp, print, PostScript
-;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
+;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
;; Package: ps-print
;; This file is part of GNU Emacs.
@@ -55,24 +55,14 @@
(face-background face nil t))
-(defalias 'ps-frame-parameter 'frame-parameter)
+(define-obsolete-function-alias 'ps-frame-parameter #'frame-parameter "28.1")
;; Return t if the device (which can be changed during an emacs session) can
-;; handle colors. This function is not yet implemented for GNU emacs.
+;; handle colors.
(defun ps-color-device ()
- (if (fboundp 'color-values)
- (funcall 'color-values "Green")
- t))
-
-
-(defun ps-color-values (x-color)
- (cond
- ((fboundp 'color-values)
- (funcall 'color-values x-color))
- ((fboundp 'x-color-values)
- (funcall 'x-color-values x-color))
- (t
- (error "No available function to determine X color values"))))
+ (color-values "Green"))
+
+(define-obsolete-function-alias 'ps-color-values #'color-values "28.1")
(defun ps-face-bold-p (face)
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index aade09214c0..351c489f487 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -9,7 +9,7 @@
;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, print, PostScript
;; Version: 7.3.5
-;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
+;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
(eval-when-compile (require 'cl-lib))
@@ -3856,7 +3856,7 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'."
(defun ps-color-scale (color)
;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
(mapcar #'(lambda (value) (/ value ps-print-color-scale))
- (ps-color-values color)))
+ (color-values color)))
(defun ps-face-underlined-p (face)
@@ -4523,7 +4523,7 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
(let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
(buffer-name)))
".ps"))
- (prompt (format "Save PostScript to file (default %s): " name))
+ (prompt (format-prompt "Save PostScript to file" name))
(res (read-file-name prompt default-directory name nil)))
(while (cond ((file-directory-p res)
(ding)
@@ -5752,7 +5752,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
;; evaluated at dump-time because X isn't initialized.
ps-color-p (and ps-print-color-p (ps-color-device))
ps-print-color-scale (if ps-color-p
- (float (car (ps-color-values "white")))
+ (float (car (color-values "white")))
1.0)
ps-default-background (ps-rgb-color
(cond
@@ -5761,7 +5761,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
(eq genfunc 'ps-generate-postscript))
nil)
((eq ps-default-bg 'frame-parameter)
- (ps-frame-parameter nil 'background-color))
+ (frame-parameter nil 'background-color))
((eq ps-default-bg t)
(ps-face-background-name 'default))
(t
@@ -5775,7 +5775,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
(eq genfunc 'ps-generate-postscript))
nil)
((eq ps-default-fg 'frame-parameter)
- (ps-frame-parameter nil 'foreground-color))
+ (frame-parameter nil 'foreground-color))
((eq ps-default-fg t)
(ps-face-foreground-name 'default))
(t
@@ -6275,10 +6275,6 @@ If FACE is not a valid face name, use default face."
(goto-char to))
-;; Ensure that face-list is fbound.
-(or (fboundp 'face-list) (defalias 'face-list 'list-faces))
-
-
(defun ps-build-reference-face-lists ()
(setq ps-print-face-alist nil)
(if ps-auto-font-detect
diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el
index 656ad3e79b8..c5dcf494c0b 100644
--- a/lisp/ps-samp.el
+++ b/lisp/ps-samp.el
@@ -8,7 +8,7 @@
;; Kenichi Handa <handa@gnu.org> (multi-byte characters)
;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, print, PostScript
-;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
+;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
;; Package: ps-print
;; This file is part of GNU Emacs.
diff --git a/lisp/recentf.el b/lisp/recentf.el
index b636e594864..61c39de12b2 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -245,7 +245,10 @@ The following values can be set:
- A number
Cleanup each time Emacs has been idle that number of seconds.
- A time string
- Cleanup at specified time string, for example at \"11:00pm\".
+ Cleanup at specified time string daily, for example at \"11:00pm\".
+
+If a time string is provided and it is already past the specified time
+for the current day, the first cleanup happens immediately as for `mode'.
Setting this variable directly does not take effect;
use \\[customize].
@@ -257,7 +260,7 @@ cleanup the list."
:value mode)
(const :tag "Never"
:value never)
- (number :tag "When idle that seconds"
+ (number :tag "When idle after (seconds)"
:value 300)
(string :tag "At time"
:value "11:00pm"))
@@ -277,6 +280,8 @@ If `file-name-history' is not empty, do nothing."
"Normal hook run at end of loading the `recentf' package."
:group 'recentf
:type 'hook)
+(make-obsolete-variable 'recentf-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom recentf-filename-handlers nil
"Functions to post process recent file names.
@@ -369,7 +374,8 @@ See also the option `recentf-auto-cleanup'.")
recentf-auto-cleanup t 'recentf-cleanup))
((stringp recentf-auto-cleanup)
(run-at-time
- recentf-auto-cleanup nil 'recentf-cleanup))))))
+ ;; Repeat every 24 hours.
+ recentf-auto-cleanup (* 24 60 60) 'recentf-cleanup))))))
;;; File functions
;;
@@ -1287,7 +1293,8 @@ Write data into the file specified by `recentf-save-file'."
(insert "\n \n;; Local Variables:\n"
(format ";; coding: %s\n" recentf-save-file-coding-system)
";; End:\n")
- (write-file (expand-file-name recentf-save-file))
+ (write-region (point-min) (point-max)
+ (expand-file-name recentf-save-file))
(when recentf-save-file-modes
(set-file-modes recentf-save-file recentf-save-file-modes))
nil)
diff --git a/lisp/rect.el b/lisp/rect.el
index 9922aac9ec9..ebf309a88fe 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -521,8 +521,9 @@ Called from a program, takes three args; START, END and STRING."
#'rectangle--string-erase-preview nil t)
(add-hook 'post-command-hook
#'rectangle--string-preview nil t))
- (read-string (format "String rectangle (default %s): "
- (or (car string-rectangle-history) ""))
+ (read-string (format-prompt
+ "String rectangle"
+ (or (car string-rectangle-history) ""))
nil 'string-rectangle-history
(car string-rectangle-history)
'inherit-input-method))))))
@@ -549,8 +550,8 @@ This command does not delete or overwrite any existing text."
(list
(region-beginning)
(region-end)
- (read-string (format "String insert rectangle (default %s): "
- (or (car string-rectangle-history) ""))
+ (read-string (format-prompt "String insert rectangle"
+ (or (car string-rectangle-history) ""))
nil 'string-rectangle-history
(car string-rectangle-history)))))
(apply-on-rectangle 'string-rectangle-line start end string nil))
diff --git a/lisp/registry.el b/lisp/registry.el
index 7d95d91ad2c..ef47f07aec5 100644
--- a/lisp/registry.el
+++ b/lisp/registry.el
@@ -317,7 +317,7 @@ Errors out if the key exists already."
(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)))
+ (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))))))
diff --git a/lisp/repeat.el b/lisp/repeat.el
index db33b083386..1dabd76e071 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -4,7 +4,7 @@
;; Author: Will Mengarini <seldon@eskimo.com>
;; Created: Mo 02 Mar 98
-;; Version: 0.51
+;; Old-Version: 0.51
;; Keywords: convenience, vi, repeat
;; This file is part of GNU Emacs.
@@ -85,10 +85,6 @@
;; C-x { shrink-window-horizontally
;; C-x } enlarge-window-horizontally
-;; This command was first called `vi-dot', because
-;; it was inspired by the `.' command in the vi editor,
-;; but it was renamed to make its name more meaningful.
-
;;; Code:
;;;;; ************************* USER OPTIONS ************************** ;;;;;
diff --git a/lisp/replace.el b/lisp/replace.el
index 0880cbdb1ea..2d17ec9097c 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -208,12 +208,15 @@ wants to replace FROM with TO."
(minibuffer-allow-text-properties t) ; separator uses text-properties
(prompt
(cond ((and query-replace-defaults separator)
- (format "%s (default %s): " prompt (car minibuffer-history)))
+ (format-prompt prompt (car minibuffer-history)))
(query-replace-defaults
- (format "%s (default %s -> %s): " prompt
- (query-replace-descr (caar query-replace-defaults))
- (query-replace-descr (cdar query-replace-defaults))))
- (t (format "%s: " prompt))))
+ (format-prompt
+ prompt (format "%s -> %s"
+ (query-replace-descr
+ (caar query-replace-defaults))
+ (query-replace-descr
+ (cdar query-replace-defaults)))))
+ (t (format-prompt prompt nil))))
(from
;; The save-excursion here is in case the user marks and copies
;; a region in order to specify the minibuffer input.
@@ -757,6 +760,13 @@ 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-collect-regexp-history '("\\1")
"History of regexp for occur's collect operation")
@@ -1113,6 +1123,8 @@ a previously found match."
(define-key map "\C-m" 'occur-mode-goto-occurrence)
(define-key map "o" 'occur-mode-goto-occurrence-other-window)
(define-key map "\C-o" 'occur-mode-display-occurrence)
+ (define-key map "n" 'next-error-no-select)
+ (define-key map "p" 'previous-error-no-select)
(define-key map "\M-n" 'occur-next)
(define-key map "\M-p" 'occur-prev)
(define-key map "r" 'occur-rename-buffer)
@@ -1261,9 +1273,12 @@ If not invoked by a mouse click, go to occurrence on the current line."
(with-current-buffer (window-buffer (posn-window (event-end event)))
(save-excursion
(goto-char (posn-point (event-end event)))
- (occur-mode-find-occurrence))))))
+ (occur-mode-find-occurrence)))))
+ (regexp occur-highlight-regexp))
(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))
(when buffer (next-error-found buffer (current-buffer)))
(run-hooks 'occur-mode-find-occurrence-hook)))
@@ -1277,17 +1292,74 @@ If not invoked by a mouse click, go to occurrence on the current line."
(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)
+ ;; 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))
+ (remove-hook 'pre-command-hook
+ #'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-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)
(setq window (display-buffer (marker-buffer pos) t))
;; 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))
(next-error-found buffer (current-buffer))
(run-hooks 'occur-mode-find-occurrence-hook))))
@@ -1418,7 +1490,7 @@ which means to discard all text properties."
;; Get the regexp for collection pattern.
(let ((default (car occur-collect-regexp-history)))
(read-regexp
- (format "Regexp to collect (default %s): " default)
+ (format-prompt "Regexp to collect" default)
default 'occur-collect-regexp-history)))
;; Otherwise normal occur takes numerical prefix argument.
(when current-prefix-arg
@@ -1500,6 +1572,18 @@ is not modified."
(defvar ido-ignore-item-temp-list)
+(defun multi-occur--prompt ()
+ (concat
+ "Next buffer to search "
+ (cond
+ ((eq read-buffer-function #'ido-read-buffer)
+ (substitute-command-keys
+ "(\\<ido-completion-map>\\[ido-select-text] to end): "))
+ ((bound-and-true-p fido-mode)
+ (substitute-command-keys
+ "(\\<icomplete-fido-mode-map>\\[icomplete-fido-exit] to end): "))
+ (t "(RET to end): "))))
+
(defun multi-occur (bufs regexp &optional nlines)
"Show all lines in buffers BUFS containing a match for REGEXP.
Optional argument NLINES specifies the number of context lines to show
@@ -1515,11 +1599,7 @@ See also `multi-occur-in-matching-buffers'."
(buf nil)
(ido-ignore-item-temp-list bufs))
(while (not (string-equal
- (setq buf (read-buffer
- (if (eq read-buffer-function #'ido-read-buffer)
- "Next buffer to search (C-j to end): "
- "Next buffer to search (RET to end): ")
- nil t))
+ (setq buf (read-buffer (multi-occur--prompt) nil t))
""))
(cl-pushnew buf bufs)
(setq ido-ignore-item-temp-list bufs))
@@ -1583,7 +1663,8 @@ See also `multi-occur'."
(and (overlayp boo)
(overlay-buffer boo)))
boo))
- bufs))))
+ bufs)))
+ (source-buffer-default-directory default-directory))
;; Handle the case where one of the buffers we're searching is the
;; output buffer. Just rename it.
(when (member buf-name
@@ -1600,6 +1681,9 @@ See also `multi-occur'."
(setq occur-buf (get-buffer-create buf-name))
(with-current-buffer occur-buf
+ ;; 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)
(if (stringp nlines)
(fundamental-mode) ;; This is for collect operation.
(occur-mode))
@@ -1608,6 +1692,7 @@ See also `multi-occur'."
(buffer-undo-list t)
(occur--final-pos nil))
(erase-buffer)
+ (set (make-local-variable 'occur-highlight-regexp) regexp)
(let ((count
(if (stringp nlines)
;; Treat nlines as a regexp to collect.
@@ -1944,10 +2029,8 @@ See also `multi-occur'."
global-matches)))
(defun occur-engine-line (beg end &optional keep-props)
- (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
- (text-property-not-all beg end 'fontified t))
- (if (fboundp 'jit-lock-fontify-now)
- (jit-lock-fontify-now beg end)))
+ (if (and keep-props font-lock-mode)
+ (font-lock-ensure beg end))
(if (and keep-props (not (eq occur-excluded-properties t)))
(let ((str (buffer-substring beg end)))
(remove-list-of-text-properties
@@ -2878,6 +2961,8 @@ characters."
(replace-dehighlight)
(save-excursion (recursive-edit))
(setq replaced t))
+ ((commandp def t)
+ (call-interactively def))
;; Note: we do not need to treat `exit-prefix'
;; specially here, since we reread
;; any unrecognized character.
diff --git a/lisp/reveal.el b/lisp/reveal.el
index 92b80071f71..f9e38646349 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -60,6 +60,13 @@
:type 'boolean
:group 'reveal)
+(defcustom reveal-auto-hide t
+ "Automatically hide revealed text when leaving it.
+If nil, the `reveal-hide-revealed' command can be useful to hide
+revealed text manually."
+ :type 'boolean
+ :version "28.1")
+
(defvar reveal-open-spots nil
"List of spots in the buffer which are open.
Each element has the form (WINDOW . OVERLAY).")
@@ -97,7 +104,8 @@ Each element has the form (WINDOW . OVERLAY).")
(cdr x))))
reveal-open-spots))))
(setq old-ols (reveal-open-new-overlays old-ols))
- (reveal-close-old-overlays old-ols)))))
+ (when reveal-auto-hide
+ (reveal-close-old-overlays old-ols))))))
(defun reveal-open-new-overlays (old-ols)
(let ((repeat t))
@@ -196,6 +204,14 @@ Each element has the form (WINDOW . OVERLAY).")
(delq (rassoc ol reveal-open-spots)
reveal-open-spots)))))))
+(defun reveal-hide-revealed ()
+ "Hide all revealed text.
+If there is revealed text under point, this command does not hide
+that text."
+ (interactive)
+ (let ((reveal-auto-hide t))
+ (reveal-post-command)))
+
(defvar reveal-mode-map
(let ((map (make-sparse-keymap)))
;; Override the default move-beginning-of-line and move-end-of-line
@@ -209,7 +225,9 @@ Each element has the form (WINDOW . OVERLAY).")
"Toggle uncloaking of invisible text near point (Reveal mode).
Reveal mode is a buffer-local minor mode. When enabled, it
-reveals invisible text around point."
+reveals invisible text around point.
+
+Also see the `reveal-auto-hide' variable."
:group 'reveal
:lighter (global-reveal-mode nil " Reveal")
:keymap reveal-mode-map
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index f6b49b46e3f..82e6178da14 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -4,7 +4,7 @@
;; Author: David Ponce <david@dponce.com>
;; Created: 24 Mar 2001
-;; Version: 1.6
+;; Old-Version: 1.6
;; Keywords: convenience
;; This file is part of GNU Emacs.
diff --git a/lisp/savehist.el b/lisp/savehist.el
index fcfdb47c7e8..4e52efe7f1a 100644
--- a/lisp/savehist.el
+++ b/lisp/savehist.el
@@ -4,7 +4,7 @@
;; Author: Hrvoje Nikšić <hrvoje.niksic@avl.com>
;; Maintainer: emacs-devel@gnu.org
-;; Keywords: minibuffer
+;; Keywords: convenience, minibuffer
;; Version: 24
;; This file is part of GNU Emacs.
@@ -27,7 +27,7 @@
;; Many editors (e.g. Vim) have the feature of saving minibuffer
;; history to an external file after exit. This package provides the
;; same feature in Emacs. When set up, it saves recorded minibuffer
-;; histories to a file (`~/.emacs-history' by default). Additional
+;; histories to a file (`~/.emacs.d/history' by default). Additional
;; variables may be specified by customizing
;; `savehist-additional-variables'.
diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index fa0e181bb10..d420bfb4e9f 100644
--- a/lisp/saveplace.el
+++ b/lisp/saveplace.el
@@ -1,4 +1,4 @@
-;;; saveplace.el --- automatically save place in files
+;;; saveplace.el --- automatically save place in files -*- lexical-binding:t -*-
;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
@@ -42,7 +42,6 @@
"Automatically save place in files."
:group 'data)
-
(defvar save-place-alist nil
"Alist of saved places to go back to when revisiting files.
Each element looks like (FILENAME . POSITION);
@@ -175,10 +174,11 @@ file:
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
(defun save-place-to-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.
- ;; first check to make sure alist has been loaded in from the master
+ "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."
+ ;; 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.
(or save-place-loaded (load-save-place-alist-from-file))
@@ -248,8 +248,8 @@ may have changed) back to `save-place-alist'."
(delete-region (point-min) (point-max))
(when save-place-forget-unreadable-files
(save-place-forget-unreadable-files))
- (insert (format ";;; -*- coding: %s -*-\n"
- (symbol-name coding-system-for-write)))
+ (insert (format ";;; -*- coding: %s; mode: lisp-data -*-\n"
+ coding-system-for-write))
(let ((print-length nil)
(print-level nil))
(pp save-place-alist (current-buffer)))
diff --git a/lisp/sb-image.el b/lisp/sb-image.el
deleted file mode 100644
index 1e8b1057bc8..00000000000
--- a/lisp/sb-image.el
+++ /dev/null
@@ -1,107 +0,0 @@
-;;; sb-image --- Image management for speedbar
-
-;; Copyright (C) 1999-2003, 2005-2020 Free Software Foundation, Inc.
-
-;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Keywords: file, tags, tools
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Supporting Image display for Emacs 20 and less, Emacs 21, and XEmacs,
-;; is a challenging task, which doesn't take kindly to being byte compiled.
-;; When sharing speedbar.elc between these three applications, the Image
-;; support can get lost.
-;;
-;; By splitting out that hard part into this file, and avoiding byte
-;; compilation, one copy speedbar can support all these platforms together.
-;;
-;; This file requires the `image' package if it is available.
-
-(require 'ezimage)
-
-;;; Code:
-(defcustom speedbar-use-images ezimage-use-images
- "Non-nil if speedbar should display icons."
- :group 'speedbar
- :version "21.1"
- :type 'boolean)
-
-(defalias 'defimage-speedbar 'defezimage)
-
-(defvar speedbar-expand-image-button-alist
- '(("<+>" . ezimage-directory-plus)
- ("<->" . ezimage-directory-minus)
- ("< >" . ezimage-directory)
- ("[+]" . ezimage-page-plus)
- ("[-]" . ezimage-page-minus)
- ("[?]" . ezimage-page)
- ("[ ]" . ezimage-page)
- ("{+}" . ezimage-box-plus)
- ("{-}" . ezimage-box-minus)
- ("<M>" . ezimage-mail)
- ("<d>" . ezimage-document-tag)
- ("<i>" . ezimage-info-tag)
- (" =>" . ezimage-tag)
- (" +>" . ezimage-tag-gt)
- (" ->" . ezimage-tag-v)
- (">" . ezimage-tag)
- ("@" . ezimage-tag-type)
- (" @" . ezimage-tag-type)
- ("*" . ezimage-checkout)
- ("#" . ezimage-object)
- ("!" . ezimage-object-out-of-date)
- ("//" . ezimage-label)
- ("%" . ezimage-lock)
- )
- "List of text and image associations.")
-
-(defun speedbar-insert-image-button-maybe (start length)
- "Insert an image button based on text starting at START for LENGTH chars.
-If buttontext is unknown, just insert that text.
-If we have an image associated with it, use that image."
- (when speedbar-use-images
- (let ((ezimage-expand-image-button-alist
- speedbar-expand-image-button-alist))
- (ezimage-insert-image-button-maybe start length))))
-
-(defun speedbar-image-dump ()
- "Dump out the current state of the Speedbar image alist.
-See `speedbar-expand-image-button-alist' for details."
- (interactive)
- (with-output-to-temp-buffer "*Speedbar Images*"
- (with-current-buffer "*Speedbar Images*"
- (goto-char (point-max))
- (insert "Speedbar image cache.\n\n")
- (let ((start (point)) (end nil))
- (insert "Image\tText\tImage Name")
- (setq end (point))
- (insert "\n")
- (put-text-property start end 'face 'underline))
- (let ((ia speedbar-expand-image-button-alist))
- (while ia
- (let ((start (point)))
- (insert (car (car ia)))
- (insert "\t")
- (speedbar-insert-image-button-maybe start
- (length (car (car ia))))
- (insert (car (car ia)) "\t" (format "%s" (cdr (car ia))) "\n"))
- (setq ia (cdr ia)))))))
-
-(provide 'sb-image)
-
-;;; sb-image.el ends here
diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el
index 3a6d9d36429..f20ea1bcc87 100644
--- a/lisp/scroll-lock.el
+++ b/lisp/scroll-lock.el
@@ -1,4 +1,4 @@
-;;; scroll-lock.el --- Scroll lock scrolling.
+;;; scroll-lock.el --- Scroll lock scrolling. -*- lexical-binding:t -*-
;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
diff --git a/lisp/server.el b/lisp/server.el
index e6d8b1783c9..a660deab8e8 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -274,10 +274,11 @@ the \"-f\" switch otherwise."
(if internal--daemon-sockname
(file-name-directory internal--daemon-sockname)
(and (featurep 'make-network-process '(:family local))
- (let ((xdg_runtime_dir (getenv "XDG_RUNTIME_DIR")))
- (if xdg_runtime_dir
- (format "%s/emacs" xdg_runtime_dir)
- (format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid))))))
+ (let ((runtime-dir (getenv "XDG_RUNTIME_DIR")))
+ (if runtime-dir
+ (expand-file-name "emacs" runtime-dir)
+ (expand-file-name (format "emacs%d" (user-uid))
+ (or (getenv "TMPDIR") "/tmp"))))))
"The directory in which to place the server socket.
If local sockets are not supported, this is nil.")
@@ -563,7 +564,7 @@ See variable `server-auth-dir' for details."
(format "it is not owned by you (owner = %s (%d))"
(user-full-name uid) uid))
(w32 nil) ; on NTFS?
- ((let ((modes (file-modes dir)))
+ ((let ((modes (file-modes dir 'nofollow)))
(unless (zerop (logand (or modes 0) #o077))
(format "it is accessible by others (%03o)" modes))))
(t nil))))
@@ -727,7 +728,8 @@ If server is running, it is first stopped.
NAME defaults to `server-name'. With argument, ask for NAME."
(interactive
(list (if current-prefix-arg
- (read-string "Server name: " nil nil server-name))))
+ (read-string (format-prompt "Server name" server-name)
+ nil nil server-name))))
(when server-mode (with-temp-message nil (server-mode -1)))
(let ((file (expand-file-name (or name server-name)
(if server-use-tcp
@@ -1336,7 +1338,13 @@ The following commands are accepted by the client:
"When done with this frame, type \\[delete-frame]")))
((not (null buffers))
(run-hooks 'server-after-make-frame-hook)
- (server-switch-buffer (car buffers) nil (cdr (car files)))
+ (server-switch-buffer
+ (car buffers) nil (cdr (car files))
+ ;; When triggered from "emacsclient -c", we popped up a
+ ;; new frame. Ensure that we switch to the requested
+ ;; buffer in that frame, and not in some other frame
+ ;; where it may be displayed.
+ (plist-get (process-plist proc) 'frame))
(run-hooks 'server-switch-hook)
(unless nowait
(message "%s" (substitute-command-keys
@@ -1566,7 +1574,8 @@ 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-switch-buffer (&optional next-buffer killed-one filepos)
+(defun server-switch-buffer (&optional next-buffer killed-one filepos
+ this-frame-only)
"Switch to another buffer, preferably one that has a client.
Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it.
@@ -1600,7 +1609,8 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)."
;; OK, we know next-buffer is live, let's display and select it.
(if (functionp server-window)
(funcall server-window next-buffer)
- (let ((win (get-buffer-window next-buffer 0)))
+ (let ((win (get-buffer-window next-buffer
+ (if this-frame-only nil 0))))
(if (and win (not server-window))
;; The buffer is already displayed: just reuse the
;; window. If FILEPOS is non-nil, use it to replace the
@@ -1618,7 +1628,8 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)."
(setq server-window (make-frame)))
(select-window (frame-selected-window server-window))))
(when (window-minibuffer-p)
- (select-window (next-window nil 'nomini 0)))
+ (select-window (next-window nil 'nomini
+ (if this-frame-only nil 0))))
;; Move to a non-dedicated window, if we have one.
(when (window-dedicated-p)
(select-window
diff --git a/lisp/ses.el b/lisp/ses.el
index b3811afd71a..bfafc132bf5 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -2540,10 +2540,8 @@ cell formula was unsafe and user declined confirmation."
(if (equal initial "\"")
(progn
(if (not (stringp curval)) (setq curval nil))
- (read-string (if curval
- (format "String Cell %s (default %s): "
- ses--curcell curval)
- (format "String Cell %s: " ses--curcell))
+ (read-string (format-prompt "String Cell %s"
+ curval ses--curcell)
nil 'ses-read-string-history curval))
(read-from-minibuffer
(format "Cell %s: " ses--curcell)
@@ -3007,9 +3005,9 @@ inserts a new row if at bottom of print area. Repeat COUNT times."
(list col
(if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
- (read-from-minibuffer (format "Column %s width (default %d): "
- (ses-column-letter col)
- (ses-col-width col))
+ (read-from-minibuffer (format-prompt "Column %s width"
+ (ses-col-width col)
+ (ses-column-letter col))
nil ; No initial contents.
nil ; No override keymap.
t ; Convert to Lisp object.
@@ -3674,7 +3672,7 @@ highlighted range in the spreadsheet."
;; 'rowcol' corresponding to 'ses-cell' property of symbol
;; 'sym'. Both must be the same.
(unless (eq sym old-name)
- (error "Spreadsheet is broken, both symbols %S and %S refering to cell (%d,%d)" sym old-name row col))
+ (error "Spreadsheet is broken, both symbols %S and %S referring to cell (%d,%d)" sym old-name row col))
(if new-rowcol
;; the new name is of A1 type, so we test that the coordinate
;; inferred from new name
@@ -3687,7 +3685,7 @@ highlighted range in the spreadsheet."
(puthash new-name rowcol ses--named-cell-hashmap))
(push `(ses-rename-cell ,old-name ,cell) buffer-undo-list)
(cl-pushnew rowcol ses--deferred-write :test #'equal)
- ;; Replace name by new name in formula of cells refering to renamed cell.
+ ;; Replace name by new name in formula of cells referring to renamed cell.
(dolist (ref (ses-cell-references cell))
(let* ((x (ses-sym-rowcol ref))
(xcell (ses-get-cell (car x) (cdr x))))
diff --git a/lisp/shell.el b/lisp/shell.el
index dc1198b7bac..226bdf4d919 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -249,7 +249,7 @@ This mirrors the optional behavior of tcsh."
(defcustom shell-chdrive-regexp
(if (memq system-type '(ms-dos windows-nt))
; NetWare allows the five chars between upper and lower alphabetics.
- "[]a-zA-Z^_`\\[\\\\]:"
+ "[]a-zA-Z^_`[\\]:"
nil)
"If non-nil, is regexp used to track drive changes."
:type '(choice regexp
@@ -374,7 +374,7 @@ Thus, this does not include the shell's current directory.")
"\\|\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)"
"\\|{\\(?1:[^{}]+\\)}\\)"
(when (memq system-type '(ms-dos windows-nt))
- "\\|%\\(?1:[^\\\\/]*\\)%")
+ "\\|%\\(?1:[^\\/]*\\)%")
(when comint-file-name-quote-list
"\\|\\\\\\(.\\)")))
(qupos nil)
@@ -460,9 +460,12 @@ Thus, this does not include the shell's current directory.")
This is the value of `pcomplete-command-completion-function' for
Shell buffers. It implements `shell-completion-execonly' for
`pcomplete' completion."
- (pcomplete-here (pcomplete-entries nil
- (if shell-completion-execonly
- 'file-executable-p))))
+ (if (pcomplete-match "/")
+ (pcomplete-here (pcomplete-entries nil
+ (if shell-completion-execonly
+ 'file-executable-p)))
+ (pcomplete-here
+ (nth 2 (shell--command-completion-data)))))
(defun shell-completion-vars ()
"Setup completion vars for `shell-mode' and `read-shell-command'."
@@ -619,7 +622,12 @@ buffer."
;; Bypass a bug in certain versions of bash.
(when (string-equal shell "bash")
(add-hook 'comint-preoutput-filter-functions
- #'shell-filter-ctrl-a-ctrl-b nil t)))
+ #'shell-filter-ctrl-a-ctrl-b nil t))
+
+ ;; Skip extended history for zsh.
+ (when (string-equal shell "zsh")
+ (setq-local comint-input-ring-file-prefix
+ ": [[:digit:]]+:[[:digit:]]+;")))
(comint-read-input-ring t)))
(defun shell-apply-ansi-color (beg end face)
@@ -985,9 +993,6 @@ this feature; see the function `dirtrack-mode'."
(add-hook 'comint-input-filter-functions #'shell-directory-tracker nil t)
(remove-hook 'comint-input-filter-functions #'shell-directory-tracker t)))
-(define-obsolete-function-alias 'shell-dirtrack-toggle #'shell-dirtrack-mode
- "23.1")
-
(defun shell-cd (dir)
"Do normal `cd' to DIR, and set `list-buffers-directory'."
(cd dir)
@@ -1033,25 +1038,41 @@ command again."
(accept-process-output proc)
(goto-char pt)))
(goto-char pmark) (delete-char 1) ; remove the extra newline
- ;; That's the dirlist. grab it & parse it.
- (let* ((dl (buffer-substring (match-beginning 2) (1- (match-end 2))))
- (dl-len (length dl))
- (ds '()) ; new dir stack
- (i 0))
- (while (< i dl-len)
- ;; regexp = optional whitespace, (non-whitespace), optional whitespace
- (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir
- (setq ds (cons (concat comint-file-name-prefix
- (substring dl (match-beginning 1)
- (match-end 1)))
- ds))
- (setq i (match-end 0)))
- (let ((ds (nreverse ds)))
- (with-demoted-errors "Couldn't cd: %s"
- (shell-cd (car ds))
- (setq shell-dirstack (cdr ds)
- shell-last-dir (car shell-dirstack))
- (shell-dirstack-message)))))
+ ;; That's the dirlist. Grab it & parse it.
+ (let* ((dls (buffer-substring-no-properties
+ (match-beginning 0) (1- (match-end 0))))
+ (dlsl nil)
+ (pos 0)
+ (ds nil))
+ ;; Split the dirlist into whitespace and non-whitespace chunks.
+ ;; dlsl will be a reversed list of tokens.
+ (while (string-match "\\(\\S-+\\|\\s-+\\)" dls pos)
+ (push (match-string 1 dls) dlsl)
+ (setq pos (match-end 1)))
+
+ ;; Prepend trailing entries until they form an existing directory,
+ ;; whitespace and all. Discard the next whitespace and repeat.
+ (while dlsl
+ (let ((newelt "")
+ tem1 tem2)
+ (while newelt
+ ;; We need tem1 because we don't want to prepend
+ ;; `comint-file-name-prefix' repeatedly into newelt via tem2.
+ (setq tem1 (pop dlsl)
+ tem2 (concat comint-file-name-prefix tem1 newelt))
+ (cond ((file-directory-p tem2)
+ (push tem2 ds)
+ (when (string= " " (car dlsl))
+ (pop dlsl))
+ (setq newelt nil))
+ (t
+ (setq newelt (concat tem1 newelt)))))))
+
+ (with-demoted-errors "Couldn't cd: %s"
+ (shell-cd (car ds))
+ (setq shell-dirstack (cdr ds)
+ shell-last-dir (car shell-dirstack))
+ (shell-dirstack-message))))
(if started-at-pmark (goto-char (marker-position pmark)))))
;; For your typing convenience:
@@ -1187,7 +1208,7 @@ Returns t if successful."
(cwd (file-name-as-directory (expand-file-name default-directory)))
(ignored-extensions
(and comint-completion-fignore
- (mapconcat (function (lambda (x) (concat (regexp-quote x) "\\'")))
+ (mapconcat (lambda (x) (concat (regexp-quote x) "\\'"))
comint-completion-fignore "\\|")))
(dir "") (comps-in-dir ())
(file "") (abs-file-name "") (completions ()))
diff --git a/lisp/simple.el b/lisp/simple.el
index 3ea00d44a03..b6d4e0603ee 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -199,7 +199,7 @@ rejected, and the function returns nil."
(and extra-test-inclusive
(funcall extra-test-inclusive))))))
-(defcustom next-error-find-buffer-function #'next-error-buffer-unnavigated-current
+(defcustom next-error-find-buffer-function #'ignore
"Function called to find a `next-error' capable buffer.
This functions takes the same three arguments as the function
`next-error-find-buffer', and should return the buffer to be
@@ -215,7 +215,7 @@ all other buffers."
next-error-buffer-unnavigated-current)
(function :tag "Other function"))
:group 'next-error
- :version "27.1")
+ :version "28.1")
(defcustom next-error-found-function #'ignore
"Function called when a next locus is found and displayed.
@@ -516,7 +516,7 @@ This hook is run by `delete-selection-uses-region-p', which see.")
"Propertized string representing a hard newline character.")
(defun newline (&optional arg interactive)
- "Insert a newline, and move to left margin of the new line if it's blank.
+ "Insert a newline, and move to left margin of the new line.
With prefix argument ARG, insert that many newlines.
If `electric-indent-mode' is enabled, this indents the final new line
@@ -553,7 +553,7 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
(save-excursion
(goto-char beforepos)
(beginning-of-line)
- (and (looking-at "[ \t]$")
+ (and (looking-at "[ \t]+$")
(> (current-left-margin) 0)
(delete-region (point)
(line-end-position))))
@@ -1227,7 +1227,47 @@ that uses or sets the mark."
;; Counting lines, one way or another.
-(defun goto-line (line &optional buffer)
+(defvar goto-line-history nil
+ "History of values entered with `goto-line'.")
+(make-variable-buffer-local 'goto-line-history)
+
+(defun goto-line-read-args (&optional relative)
+ "Read arguments for `goto-line' related commands."
+ (if (and current-prefix-arg (not (consp current-prefix-arg)))
+ (list (prefix-numeric-value current-prefix-arg))
+ ;; Look for a default, a number in the buffer at point.
+ (let* ((default
+ (save-excursion
+ (skip-chars-backward "0-9")
+ (if (looking-at "[0-9]")
+ (string-to-number
+ (buffer-substring-no-properties
+ (point)
+ (progn (skip-chars-forward "0-9")
+ (point)))))))
+ ;; Decide if we're switching buffers.
+ (buffer
+ (if (consp current-prefix-arg)
+ (other-buffer (current-buffer) t)))
+ (buffer-prompt
+ (if buffer
+ (concat " in " (buffer-name buffer))
+ "")))
+ ;; Read the argument, offering that number (if any) as default.
+ (list (read-number (format "Goto%s line%s: "
+ (if (= (point-min) 1) ""
+ ;; In a narrowed buffer.
+ (if relative " relative" " absolute"))
+ buffer-prompt)
+ (list default (if (or relative (= (point-min) 1))
+ (line-number-at-pos)
+ (save-restriction
+ (widen)
+ (line-number-at-pos))))
+ 'goto-line-history)
+ buffer))))
+
+(defun goto-line (line &optional buffer relative)
"Go to LINE, counting from line 1 at beginning of buffer.
If called interactively, a numeric prefix argument specifies
LINE; without a numeric prefix argument, read LINE from the
@@ -1237,6 +1277,13 @@ If optional argument BUFFER is non-nil, switch to that buffer and
move to line LINE there. If called interactively with \\[universal-argument]
as argument, BUFFER is the most recently selected other buffer.
+If optional argument RELATIVE is non-nil, counting starts at the beginning
+of the accessible portion of the (potentially narrowed) buffer.
+
+If the variable `widen-automatically' is non-nil, cancel narrowing and
+leave all lines accessible. If `widen-automatically' is nil, just move
+point to the edge of visible portion and don't change the buffer bounds.
+
Prior to moving point, this function sets the mark (without
activating it), unless Transient Mark mode is enabled and the
mark is already active.
@@ -1248,31 +1295,7 @@ What you probably want instead is something like:
If at all possible, an even better solution is to use char counts
rather than line counts."
(declare (interactive-only forward-line))
- (interactive
- (if (and current-prefix-arg (not (consp current-prefix-arg)))
- (list (prefix-numeric-value current-prefix-arg))
- ;; Look for a default, a number in the buffer at point.
- (let* ((default
- (save-excursion
- (skip-chars-backward "0-9")
- (if (looking-at "[0-9]")
- (string-to-number
- (buffer-substring-no-properties
- (point)
- (progn (skip-chars-forward "0-9")
- (point)))))))
- ;; Decide if we're switching buffers.
- (buffer
- (if (consp current-prefix-arg)
- (other-buffer (current-buffer) t)))
- (buffer-prompt
- (if buffer
- (concat " in " (buffer-name buffer))
- "")))
- ;; Read the argument, offering that number (if any) as default.
- (list (read-number (format "Goto line%s: " buffer-prompt)
- (list default (line-number-at-pos)))
- buffer))))
+ (interactive (goto-line-read-args))
;; Switch to the desired buffer, one way or another.
(if buffer
(let ((window (get-buffer-window buffer)))
@@ -1281,13 +1304,28 @@ rather than line counts."
;; Leave mark at previous position
(or (region-active-p) (push-mark))
;; Move to the specified line number in that buffer.
- (save-restriction
- (widen)
+ (if (and (not relative) (not widen-automatically))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (if (eq selective-display t)
+ (re-search-forward "[\n\C-m]" nil 'end (1- line))
+ (forward-line (1- line))))
+ (unless relative (widen))
(goto-char (point-min))
(if (eq selective-display t)
(re-search-forward "[\n\C-m]" nil 'end (1- line))
(forward-line (1- line)))))
+(defun goto-line-relative (line &optional buffer)
+ "Go to LINE, counting from line at (point-min).
+The line number is relative to the accessible portion of the narrowed
+buffer. The argument BUFFER is the same as in the function `goto-line'."
+ (declare (interactive-only forward-line))
+ (interactive (goto-line-read-args t))
+ (with-suppressed-warnings ((interactive-only goto-line))
+ (goto-line line buffer t)))
+
(defun count-words-region (start end &optional arg)
"Count the number of words in the region.
If called interactively, print a message reporting the number of
@@ -1318,7 +1356,9 @@ If called from Lisp, return the number of words between START and
END, without printing any message."
(interactive (list nil nil))
(cond ((not (called-interactively-p 'any))
- (let ((words 0))
+ (let ((words 0)
+ ;; Count across field boundaries. (Bug#41761)
+ (inhibit-field-text-motion t))
(save-excursion
(save-restriction
(narrow-to-region start end)
@@ -1361,28 +1401,47 @@ END, without printing any message."
(message "line %d (narrowed line %d)"
(+ n (line-number-at-pos start) -1) n))))))
-(defun count-lines (start end)
+(defun count-lines (start end &optional ignore-invisible-lines)
"Return number of lines between START and END.
-This is usually the number of newlines between them,
-but can be one more if START is not equal to END
-and the greater of them is not at the start of a line."
+This is usually the number of newlines between them, but can be
+one more if START is not equal to END and the greater of them is
+not at the start of a line.
+
+When IGNORE-INVISIBLE-LINES is non-nil, invisible lines are not
+included in the count."
(save-excursion
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
- (if (eq selective-display t)
- (save-match-data
- (let ((done 0))
- (while (re-search-forward "[\n\C-m]" nil t 40)
- (setq done (+ 40 done)))
- (while (re-search-forward "[\n\C-m]" nil t 1)
- (setq done (+ 1 done)))
- (goto-char (point-max))
- (if (and (/= start end)
- (not (bolp)))
- (1+ done)
- done)))
- (- (buffer-size) (forward-line (buffer-size)))))))
+ (cond ((and (not ignore-invisible-lines)
+ (eq selective-display t))
+ (save-match-data
+ (let ((done 0))
+ (while (re-search-forward "\n\\|\r[^\n]" nil t 40)
+ (setq done (+ 40 done)))
+ (while (re-search-forward "\n\\|\r[^\n]" nil t 1)
+ (setq done (+ 1 done)))
+ (goto-char (point-max))
+ (if (and (/= start end)
+ (not (bolp)))
+ (1+ done)
+ done))))
+ (ignore-invisible-lines
+ (save-match-data
+ (- (buffer-size)
+ (forward-line (buffer-size))
+ (let ((invisible-count 0)
+ prop)
+ (goto-char (point-min))
+ (while (re-search-forward "\n\\|\r[^\n]" nil t)
+ (setq prop (get-char-property (1- (point)) 'invisible))
+ (if (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))
+ (setq invisible-count (1+ invisible-count))))
+ invisible-count))))
+ (t (- (buffer-size) (forward-line (buffer-size))))))))
(defun line-number-at-pos (&optional pos absolute)
"Return buffer line number at position POS.
@@ -1474,7 +1533,11 @@ in *Help* buffer. See also the command `describe-char'."
encoded encoding-msg display-prop under-display)
(if (or (not coding)
(eq (coding-system-type coding) t))
- (setq coding (default-value 'buffer-file-coding-system)))
+ (setq coding (or (default-value 'buffer-file-coding-system)
+ ;; A nil value of `buffer-file-coding-system'
+ ;; means "no conversion" which means each byte
+ ;; is a char and vice versa.
+ 'binary)))
(if (eq (char-charset char) 'eight-bit)
(setq encoding-msg
(format "(%d, #o%o, #x%x%s, raw-byte)" char char char char-name-fmt))
@@ -1532,6 +1595,8 @@ in *Help* buffer. See also the command `describe-char'."
;; Might as well bind TAB to completion, since inserting a TAB char is
;; much too rarely useful.
(define-key m "\t" 'completion-at-point)
+ (define-key m "\r" 'read--expression-try-read)
+ (define-key m "\n" 'read--expression-try-read)
(set-keymap-parent m minibuffer-local-map)
m))
@@ -1614,11 +1679,18 @@ display the result of expression evaluation."
"Hook run by `eval-expression' when entering the minibuffer.")
(defun read--expression (prompt &optional initial-contents)
+ "Read an Emacs Lisp expression from the minibuffer.
+
+PROMPT and optional argument INITIAL-CONTENTS do the same as in
+function `read-from-minibuffer'."
(let ((minibuffer-completing-symbol t))
(minibuffer-with-setup-hook
(lambda ()
- ;; FIXME: call emacs-lisp-mode (see also
- ;; `eldoc--eval-expression-setup')?
+ ;; FIXME: instead of just applying the syntax table, maybe
+ ;; use a special major mode tailored to reading Lisp
+ ;; expressions from the minibuffer? (`emacs-lisp-mode'
+ ;; doesn't preserve the necessary keybindings.)
+ (set-syntax-table emacs-lisp-mode-syntax-table)
(add-hook 'completion-at-point-functions
#'elisp-completion-at-point nil t)
(run-hooks 'eval-expression-minibuffer-setup-hook))
@@ -1626,6 +1698,45 @@ display the result of expression evaluation."
read-expression-map t
'read-expression-history))))
+(defun read--expression-try-read ()
+ "Try to read an Emacs Lisp expression in the minibuffer.
+
+Exit the minibuffer if successful, else report the error to the
+user and move point to the location of the error. If point is
+not already at the location of the error, push a mark before
+moving point."
+ (interactive)
+ (unless (> (minibuffer-depth) 0)
+ (error "Minibuffer must be active"))
+ (if (let* ((contents (minibuffer-contents))
+ (error-point nil))
+ (with-temp-buffer
+ (condition-case err
+ (progn
+ (insert contents)
+ (goto-char (point-min))
+ ;; `read' will signal errors like "End of file during
+ ;; parsing" and "Invalid read syntax".
+ (read (current-buffer))
+ ;; Since `read' does not signal the "Trailing garbage
+ ;; following expression" error, we check for trailing
+ ;; garbage ourselves.
+ (or (progn
+ ;; This check is similar to what `string_to_object'
+ ;; does in minibuf.c.
+ (skip-chars-forward " \t\n")
+ (= (point) (point-max)))
+ (error "Trailing garbage following expression")))
+ (error
+ (setq error-point (+ (length (minibuffer-prompt)) (point)))
+ (with-current-buffer (window-buffer (minibuffer-window))
+ (unless (= (point) error-point)
+ (push-mark))
+ (goto-char error-point)
+ (minibuffer-message (error-message-string err)))
+ nil))))
+ (exit-minibuffer)))
+
(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)
@@ -1773,9 +1884,15 @@ to get different commands to edit and resubmit."
(lambda ()
;; Get a command name at point in the original buffer
;; to propose it after M-n.
- (with-current-buffer (window-buffer (minibuffer-selected-window))
- (and (commandp (function-called-at-point))
- (format "%S" (function-called-at-point)))))))
+ (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.
@@ -1797,23 +1914,34 @@ to get different commands to edit and resubmit."
;; and it serves as a shorthand for "Extended command: ".
"M-x ")
(lambda (string pred action)
- (let ((pred
- (if (memq action '(nil t))
- ;; Exclude obsolete commands from completions.
- (lambda (sym)
- (and (funcall pred sym)
- (or (equal string (symbol-name sym))
- (not (get sym 'byte-obsolete-info)))))
- pred)))
+ (if (and suggest-key-bindings (eq action 'metadata))
+ '(metadata
+ (annotation-function . read-extended-command--annotation)
+ (category . command))
(complete-with-action action obarray string pred)))
#'commandp t nil 'extended-command-history)))
+(defun read-extended-command--annotation (command-name)
+ (let* ((fun (and (stringp command-name) (intern-soft command-name)))
+ (binding (where-is-internal fun overriding-local-map t))
+ (obsolete (get fun 'byte-obsolete-info))
+ (alias (symbol-function fun)))
+ (cond ((symbolp alias)
+ (format " (%s)" alias))
+ (obsolete
+ (format " (%s)" (car obsolete)))
+ ((and binding (not (stringp binding)))
+ (format " (%s)" (key-description binding))))))
+
(defcustom suggest-key-bindings t
"Non-nil means show the equivalent key-binding when M-x command has one.
The value can be a length of time to show the message for.
If the value is non-nil and not a number, we wait 2 seconds.
-Also see `extended-command-suggest-shorter'."
+Also see `extended-command-suggest-shorter'.
+
+Equivalent key-bindings are also shown in the completion list of
+M-x for all commands that have them."
:group 'keyboard
:type '(choice (const :tag "off" nil)
(integer :tag "time" 2)
@@ -1939,13 +2067,18 @@ invoking, give a prefix argument to `execute-extended-command'."
;; BEWARE: Called directly from the C code.
"Execute CMD as an editor command.
CMD must be a symbol that satisfies the `commandp' predicate.
-Optional second arg RECORD-FLAG non-nil
-means unconditionally put this command in the variable `command-history'.
-Otherwise, that is done only if an arg is read using the minibuffer.
-The argument KEYS specifies the value to use instead of (this-command-keys)
-when reading the arguments; if it is nil, (this-command-keys) is used.
-The argument SPECIAL, if non-nil, means that this command is executing
-a special event, so ignore the prefix argument and don't clear it."
+
+Optional second arg RECORD-FLAG non-nil means unconditionally put
+this command in the variable `command-history'. Otherwise, that
+is done only if an arg is read using the minibuffer.
+
+The argument KEYS specifies the value to use instead of the
+return value of the `this-command-keys' function when reading the
+arguments; if it is nil, `this-command-keys' is used.
+
+The argument SPECIAL, if non-nil, means that this command is
+executing a special event, so ignore the prefix argument and
+don't clear it."
(setq debug-on-next-call nil)
(let ((prefixarg (unless special
;; FIXME: This should probably be done around
@@ -2036,11 +2169,9 @@ See also `minibuffer-history-case-insensitive-variables'."
(interactive
(let* ((enable-recursive-minibuffers t)
(regexp (read-from-minibuffer
- (format "Previous element matching regexp%s: "
- (if minibuffer-history-search-history
- (format " (default %s)"
- (car minibuffer-history-search-history))
- ""))
+ (format-prompt "Previous element matching regexp"
+ (and minibuffer-history-search-history
+ (car minibuffer-history-search-history)))
nil minibuffer-local-map nil
'minibuffer-history-search-history
(car minibuffer-history-search-history))))
@@ -2323,15 +2454,17 @@ previous element of the minibuffer history in the minibuffer."
(goto-char (1- (minibuffer-prompt-end)))
(current-column))))
(move-to-column old-column))
- ;; Put the cursor at the end of the visual line instead of the
- ;; logical line, so the next `previous-line-or-history-element'
- ;; would move to the previous history element, not to a possible upper
- ;; visual line from the end of logical line in `line-move-visual' mode.
- (end-of-visual-line)
- ;; Since `end-of-visual-line' puts the cursor at the beginning
- ;; of the next visual line, move it one char back to the end
- ;; of the first visual line (bug#22544).
- (unless (eolp) (backward-char 1)))))))
+ (if (not line-move-visual) ; Handle logical lines (bug#42862)
+ (end-of-line)
+ ;; Put the cursor at the end of the visual line instead of the
+ ;; logical line, so the next `previous-line-or-history-element'
+ ;; would move to the previous history element, not to a possible upper
+ ;; visual line from the end of logical line in `line-move-visual' mode.
+ (end-of-visual-line)
+ ;; Since `end-of-visual-line' puts the cursor at the beginning
+ ;; of the next visual line, move it one char back to the end
+ ;; of the first visual line (bug#22544).
+ (unless (eolp) (backward-char 1))))))))
(defun next-complete-history-element (n)
"Get next history element that completes the minibuffer before the point.
@@ -2528,6 +2661,11 @@ A redo record for ordinary undo maps to the following (earlier) undo.")
"Within a run of consecutive undo commands, list remaining to be undone.
If t, we undid all the way to the end of it.")
+(defun undo--last-change-was-undo-p (undo-list)
+ (while (and (consp undo-list) (eq (car undo-list) nil))
+ (setq undo-list (cdr undo-list)))
+ (gethash undo-list undo-equiv-table))
+
(defun undo (&optional arg)
"Undo some previous changes.
Repeat this command to undo more changes.
@@ -2563,12 +2701,7 @@ as an argument limits undo to changes within the current region."
(or (eq pending-undo-list t)
;; If something (a timer or filter?) changed the buffer
;; since the previous command, don't continue the undo seq.
- (let ((list buffer-undo-list))
- (while (eq (car list) nil)
- (setq list (cdr list)))
- ;; If the last undo record made was made by undo
- ;; it shows nothing else happened in between.
- (gethash list undo-equiv-table))))
+ (undo--last-change-was-undo-p buffer-undo-list)))
(setq undo-in-region
(and (or (region-active-p) (and arg (not (numberp arg))))
(not inhibit-region)))
@@ -2658,6 +2791,26 @@ Contrary to `undo', this will not redo a previous undo."
(interactive "*p")
(let ((undo-no-redo t)) (undo arg)))
+(defun undo-redo (&optional arg)
+ "Undo the last ARG undos, i.e., redo the last ARG changes.
+Interactively, ARG is the prefix numeric argument and defaults to 1."
+ (interactive "*p")
+ (cond
+ ((not (undo--last-change-was-undo-p buffer-undo-list))
+ (user-error "No undone changes to redo"))
+ (t
+ (let* ((ul buffer-undo-list)
+ (new-ul
+ (let ((undo-in-progress t))
+ (while (and (consp ul) (eq (car ul) nil))
+ (setq ul (cdr ul)))
+ (primitive-undo arg ul)))
+ (new-pul (undo--last-change-was-undo-p new-ul)))
+ (message "Redo%s" (if undo-in-region " in region" ""))
+ (setq this-command 'undo)
+ (setq pending-undo-list new-pul)
+ (setq buffer-undo-list new-ul)))))
+
(defvar undo-in-progress nil
"Non-nil while performing an undo.
Some change-hooks test this variable to do something different.")
@@ -3329,6 +3482,14 @@ which is defined in the `warnings' library.\n")
(setq buffer-undo-list nil)
t))
+;;;; Shell commands
+
+(defconst shell-command-buffer-name "*Shell Command Output*"
+ "Name of the output buffer for shell commands.")
+
+(defconst shell-command-buffer-name-async "*Async Shell Command*"
+ "Name of the output buffer for asynchronous shell commands.")
+
(defvar shell-command-history nil
"History list for some commands that read shell commands.
@@ -3393,8 +3554,9 @@ to `shell-command-history'."
(defcustom async-shell-command-buffer 'confirm-new-buffer
"What to do when the output buffer is used by another shell command.
This option specifies how to resolve the conflict where a new command
-wants to direct its output to the buffer `*Async Shell Command*',
-but this buffer is already taken by another running shell command.
+wants to direct its output to the buffer whose name is stored
+in `shell-command-buffer-name-async', but that buffer is already
+taken by another running shell command.
The value `confirm-kill-process' is used to ask for confirmation before
killing the already running process and running a new process
@@ -3545,14 +3707,18 @@ whose `car' is BUFFER."
Like `shell-command', but adds `&' at the end of COMMAND
to execute it asynchronously.
-The output appears in the buffer `*Async Shell Command*'.
-That buffer is in shell mode.
+The output appears in the buffer whose name is stored in the
+variable `shell-command-buffer-name-async'. That buffer is in
+shell mode.
You can configure `async-shell-command-buffer' to specify what to do
-when the `*Async Shell Command*' buffer is already taken by another
-running shell command. To run COMMAND without displaying the output
-in a window you can configure `display-buffer-alist' to use the action
-`display-buffer-no-window' for the buffer `*Async Shell Command*'.
+when the buffer specified by `shell-command-buffer-name-async' is
+already taken by another running shell command.
+
+To run COMMAND without displaying the output in a window you can
+configure `display-buffer-alist' to use the action
+`display-buffer-no-window' for the buffer given by
+`shell-command-buffer-name-async'.
In Elisp, you will often be better served by calling `start-process'
directly, since it offers more control and does not impose the use of
@@ -3588,16 +3754,18 @@ If `shell-command-prompt-show-cwd' is non-nil, show the current
directory in the prompt.
If COMMAND ends in `&', execute it asynchronously.
-The output appears in the buffer `*Async Shell Command*'.
-That buffer is in shell mode. You can also use
-`async-shell-command' that automatically adds `&'.
+The output appears in the buffer whose name is specified
+by `shell-command-buffer-name-async'. That buffer is in shell
+mode. You can also use `async-shell-command' that automatically
+adds `&'.
Otherwise, COMMAND is executed synchronously. The output appears in
-the buffer `*Shell Command Output*'. If the output is short enough to
-display in the echo area (which is determined by the variables
-`resize-mini-windows' and `max-mini-window-height'), it is shown
-there, but it is nonetheless available in buffer `*Shell Command
-Output*' even though that buffer is not automatically displayed.
+the buffer named by `shell-command-buffer-name'. If the output is
+short enough to display in the echo area (which is determined by the
+variables `resize-mini-windows' and `max-mini-window-height'), it is
+shown there, but it is nonetheless available in buffer named by
+`shell-command-buffer-name' even though that buffer is not
+automatically displayed.
To specify a coding system for converting non-ASCII characters
in the shell command output, use \\[universal-coding-system-argument] \
@@ -3716,7 +3884,7 @@ impose the use of a shell (with its need to quote arguments)."
(if (string-match "[ \t]*&[ \t]*\\'" command)
;; Command ending with ampersand means asynchronous.
(let* ((buffer (get-buffer-create
- (or output-buffer "*Async Shell Command*")))
+ (or output-buffer shell-command-buffer-name-async)))
(bname (buffer-name buffer))
(proc (get-buffer-process buffer))
(directory default-directory))
@@ -3868,9 +4036,9 @@ and are used only if a pop-up buffer is displayed."
error-buffer display-error-buffer
region-noncontiguous-p)
"Execute string COMMAND in inferior shell with region as input.
-Normally display output (if any) in temp buffer `*Shell Command Output*';
-Prefix arg means replace the region with it. Return the exit code of
-COMMAND.
+Normally display output (if any) in temp buffer specified
+by `shell-command-buffer-name'; prefix arg means replace the region
+with it. Return the exit code of COMMAND.
To specify a coding system for converting non-ASCII characters
in the input and output to the shell command, use \\[universal-coding-system-argument]
@@ -3887,7 +4055,7 @@ in the echo area or in a buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
`resize-mini-windows' is non-nil), it is shown there.
-Otherwise it is displayed in the buffer `*Shell Command Output*'.
+Otherwise it is displayed in the buffer named by `shell-command-buffer-name'.
The output is available in that buffer in both cases.
If there is output and an error, a message about the error
@@ -3897,7 +4065,7 @@ Optional fourth arg OUTPUT-BUFFER specifies where to put the
command's output. If the value is a buffer or buffer name,
erase that buffer and insert the output there; a non-nil value of
`shell-command-dont-erase-buffer' prevent to erase the buffer.
-If the value is nil, use the buffer `*Shell Command Output*'.
+If the value is nil, use the buffer specified by `shell-command-buffer-name'.
Any other non-nil value means to insert the output in the
current buffer after START.
@@ -3945,7 +4113,7 @@ characters."
exit-status)
;; Unless a single contiguous chunk is selected, operate on multiple chunks.
(if region-noncontiguous-p
- (let ((input (concat (funcall region-extract-function 'delete) "\n"))
+ (let ((input (concat (funcall region-extract-function (when replace 'delete)) "\n"))
output)
(with-temp-buffer
(insert input)
@@ -3953,9 +4121,24 @@ characters."
shell-file-name t t
nil shell-command-switch
command)
- (setq output (split-string (buffer-string) "\n")))
- (goto-char start)
- (funcall region-insert-function output))
+ (setq output (split-string (buffer-substring
+ (point-min)
+ ;; Trim the trailing newline.
+ (if (eq (char-before (point-max)) ?\n)
+ (1- (point-max))
+ (point-max)))
+ "\n")))
+ (cond
+ (replace
+ (goto-char start)
+ (funcall region-insert-function output))
+ (t
+ (let ((buffer (get-buffer-create
+ (or output-buffer shell-command-buffer-name))))
+ (with-current-buffer buffer
+ (erase-buffer)
+ (funcall region-insert-function output))
+ (display-message-or-buffer buffer)))))
(if (or replace
(and output-buffer
(not (or (bufferp output-buffer) (stringp output-buffer)))))
@@ -3970,7 +4153,7 @@ characters."
(list t error-file)
t)))
;; It is rude to delete a buffer that the command is not using.
- ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
+ ;; (let ((shell-buffer (get-buffer shell-command-buffer-name)))
;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
;; (kill-buffer shell-buffer)))
;; Don't muck with mark unless REPLACE says we should.
@@ -3978,12 +4161,13 @@ characters."
;; No prefix argument: put the output in a temp buffer,
;; replacing its entire contents.
(let ((buffer (get-buffer-create
- (or output-buffer "*Shell Command Output*"))))
+ (or output-buffer shell-command-buffer-name))))
(set-buffer-major-mode buffer) ; Enable globalized modes (bug#38111)
(unwind-protect
(if (and (eq buffer (current-buffer))
(or (memq shell-command-dont-erase-buffer '(nil erase))
- (and (not (eq buffer (get-buffer "*Shell Command Output*")))
+ (and (not (eq buffer (get-buffer
+ shell-command-buffer-name)))
(not (region-active-p)))))
;; If the input is the same buffer as the output,
;; delete everything but the specified region,
@@ -4118,6 +4302,20 @@ its behavior with respect to remote file attribute caching.
You should only ever change this variable with a let-binding;
never with `setq'.")
+(defcustom process-file-return-signal-string nil
+ "Whether to return a string describing the signal interrupting a process.
+When a process returns an exit code greater than 128, it is
+interpreted as a signal. `process-file' requires to return a
+string describing this signal.
+Since there are processes violating this rule, returning exit
+codes greater than 128 which are not bound to a signal,
+`process-file' returns the exit code as natural number also in
+this case. Setting this user option to non-nil forces
+`process-file' to interpret such exit codes as signals, and to
+return a corresponding string."
+ :version "28.1"
+ :type 'boolean)
+
(defun start-file-process (name buffer program &rest program-args)
"Start a program in a subprocess. Return the process object for it.
@@ -4215,7 +4413,7 @@ Also, delete any process that is exited or signaled."
((thread-name (process-thread p)))
(t "--")))
(cmd
- (if (memq type '(network serial))
+ (if (memq type '(network serial pipe))
(let ((contact (process-contact p t t)))
(if (eq type 'network)
(format "(%s %s)"
@@ -5963,8 +6161,6 @@ Does not set point. Does nothing if mark ring is empty."
(pop mark-ring))
(deactivate-mark))
-(define-obsolete-function-alias
- 'exchange-dot-and-mark 'exchange-point-and-mark "23.3")
(defun exchange-point-and-mark (&optional arg)
"Put the mark where point is now, and point where the mark is now.
This command works even when the mark is not active,
@@ -6862,15 +7058,16 @@ rests."
(setq done t)))))))
(defun move-beginning-of-line (arg)
- "Move point to beginning of current line as displayed.
-\(If there's an image in the line, this disregards newlines
-that are part of the text that the image rests on.)
+ "Move point to visible beginning of current logical line.
+This disregards any invisible newline characters.
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If point reaches the beginning or end of buffer, it stops there.
\(But if the buffer doesn't end in a newline, it stops at the
beginning of the last line.)
-To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
+
+To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
+For motion by visual lines, see `beginning-of-visual-line'."
(interactive "^p")
(or arg (setq arg 1))
@@ -7083,15 +7280,16 @@ Mode' for details."
:lighter " Wrap"
(if visual-line-mode
(progn
- (set (make-local-variable 'visual-line--saved-state) nil)
- ;; Save the local values of some variables, to be restored if
- ;; visual-line-mode is turned off.
- (dolist (var '(line-move-visual truncate-lines
- truncate-partial-width-windows
- word-wrap fringe-indicator-alist))
- (if (local-variable-p var)
- (push (cons var (symbol-value var))
- visual-line--saved-state)))
+ (unless visual-line--saved-state
+ (setq-local visual-line--saved-state (list nil))
+ ;; Save the local values of some variables, to be restored if
+ ;; visual-line-mode is turned off.
+ (dolist (var '(line-move-visual truncate-lines
+ truncate-partial-width-windows
+ word-wrap fringe-indicator-alist))
+ (if (local-variable-p var)
+ (push (cons var (symbol-value var))
+ visual-line--saved-state))))
(set (make-local-variable 'line-move-visual) t)
(set (make-local-variable 'truncate-partial-width-windows) nil)
(setq truncate-lines nil
@@ -7105,7 +7303,8 @@ Mode' for details."
(kill-local-variable 'truncate-partial-width-windows)
(kill-local-variable 'fringe-indicator-alist)
(dolist (saved visual-line--saved-state)
- (set (make-local-variable (car saved)) (cdr saved)))
+ (when (car saved)
+ (set (make-local-variable (car saved)) (cdr saved))))
(kill-local-variable 'visual-line--saved-state)))
(defun turn-on-visual-line-mode ()
@@ -7650,11 +7849,17 @@ a specialization of overwrite mode, entered by setting the
Line numbers do not appear for very large buffers and buffers
with very long lines; see variables `line-number-display-limit'
-and `line-number-display-limit-width'."
+and `line-number-display-limit-width'.
+
+See `mode-line-position-line-format' for how this number is
+presented."
:init-value t :global t :group 'mode-line)
(define-minor-mode column-number-mode
- "Toggle column number display in the mode line (Column Number mode)."
+ "Toggle column number display in the mode line (Column Number mode).
+
+See `mode-line-position-column-format' for how this number is
+presented."
:global t :group 'mode-line)
(define-minor-mode size-indication-mode
@@ -8154,7 +8359,7 @@ makes it easier to edit it."
(interactive
(let* ((default-var (variable-at-point))
(var (if (custom-variable-p default-var)
- (read-variable (format "Set variable (default %s): " default-var)
+ (read-variable (format-prompt "Set variable" default-var)
default-var)
(read-variable "Set variable: ")))
(minibuffer-help-form `(describe-variable ',var))
@@ -8249,18 +8454,6 @@ Called with three arguments (BEG END TEXT), it should replace the text
between BEG and END with TEXT. Expected to be set buffer-locally
in the *Completions* buffer.")
-(defvar completion-base-size nil
- "Number of chars before point not involved in completion.
-This is a local variable in the completion list buffer.
-It refers to the chars in the minibuffer if completing in the
-minibuffer, or in `completion-reference-buffer' otherwise.
-Only characters in the field at point are included.
-
-If nil, Emacs determines which part of the tail end of the
-buffer's text is involved in completion by comparing the text
-directly.")
-(make-obsolete-variable 'completion-base-size 'completion-base-position "23.2")
-
(defun delete-completion-window ()
"Delete the completion list window.
Go to the window from which completion was requested."
@@ -8314,7 +8507,6 @@ If EVENT, use EVENT's position to determine the starting position."
(run-hooks 'mouse-leave-buffer-hook)
(with-current-buffer (window-buffer (posn-window (event-start event)))
(let ((buffer completion-reference-buffer)
- (base-size completion-base-size)
(base-position completion-base-position)
(insert-function completion-list-insert-choice-function)
(choice
@@ -8341,10 +8533,6 @@ If EVENT, use EVENT's position to determine the starting position."
(choose-completion-string
choice buffer
(or base-position
- (when base-size
- ;; Someone's using old completion code that doesn't know
- ;; about base-position yet.
- (list (+ base-size (field-beginning))))
;; If all else fails, just guess.
(list (choose-completion-guess-base-position choice)))
insert-function)))))
@@ -8372,10 +8560,6 @@ If EVENT, use EVENT's position to determine the starting position."
(forward-char 1))
(point))))
-(defun choose-completion-delete-max-match (string)
- (declare (obsolete choose-completion-guess-base-position "23.2"))
- (delete-region (choose-completion-guess-base-position string) (point)))
-
(defvar choose-completion-string-functions nil
"Functions that may override the normal insertion of a completion choice.
These functions are called in order with three arguments:
@@ -8404,13 +8588,6 @@ back on `completion-list-insert-choice-function' when nil."
;; unless it is reading a file name and CHOICE is a directory,
;; or completion-no-auto-exit is non-nil.
- ;; Some older code may call us passing `base-size' instead of
- ;; `base-position'. It's difficult to make any use of `base-size',
- ;; so we just ignore it.
- (unless (consp base-position)
- (message "Obsolete `base-size' passed to choose-completion-string")
- (setq base-position nil))
-
(let* ((buffer (or buffer completion-reference-buffer))
(mini-p (minibufferp buffer)))
;; If BUFFER is a minibuffer, barf unless it's the currently
@@ -8466,8 +8643,7 @@ 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.
-\\{completion-list-mode-map}"
- (set (make-local-variable 'completion-base-size) nil))
+\\{completion-list-mode-map}")
(defun completion-list-mode-finish ()
"Finish setup of the completions buffer.
@@ -8504,14 +8680,11 @@ Called from `temp-buffer-show-hook'."
(if minibuffer-completing-file-name
(file-name-as-directory
(expand-file-name
- (buffer-substring (minibuffer-prompt-end)
- (- (point) (or completion-base-size 0))))))))
+ (buffer-substring (minibuffer-prompt-end) (point)))))))
(with-current-buffer standard-output
- (let ((base-size completion-base-size) ;Read before killing localvars.
- (base-position completion-base-position)
+ (let ((base-position completion-base-position)
(insert-fun completion-list-insert-choice-function))
(completion-list-mode)
- (set (make-local-variable 'completion-base-size) base-size)
(set (make-local-variable 'completion-base-position) base-position)
(set (make-local-variable 'completion-list-insert-choice-function)
insert-fun))
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index 8c694c128b5..ea4e5dbc227 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -1,4 +1,4 @@
-;;; skeleton.el --- Lisp language extension for writing statement skeletons
+;;; skeleton.el --- Lisp language extension for writing statement skeletons -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1996, 2001-2020 Free Software Foundation, Inc.
@@ -135,7 +135,8 @@ A prefix argument of -1 says to wrap around region, even if not highlighted.
A prefix argument of zero says to wrap around zero words---that is, nothing.
This is a way of overriding the use of a highlighted region.")
(interactive "*P\nP")
- (skeleton-proxy-new ',skeleton str arg))))
+ (atomic-change-group
+ (skeleton-proxy-new ',skeleton str arg)))))
;;;###autoload
(defun skeleton-proxy-new (skeleton &optional str arg)
@@ -154,8 +155,7 @@ of `str' whereas the skeleton's interactor is then ignored."
(prefix-numeric-value (or arg
current-prefix-arg))
(and skeleton-autowrap
- (or (eq last-command 'mouse-drag-region)
- (and transient-mark-mode mark-active))
+ (use-region-p)
;; Deactivate the mark, in case one of the
;; elements of the skeleton is sensitive
;; to such situations (e.g. it is itself a
@@ -258,23 +258,25 @@ available:
(goto-char (car skeleton-regions))
(setq skeleton-regions (cdr skeleton-regions)))
(let ((beg (point))
- skeleton-modified skeleton-point resume: help input v1 v2)
- (setq skeleton-positions nil)
- (unwind-protect
- (cl-progv
- (mapcar #'car skeleton-further-elements)
- (mapcar (lambda (x) (eval (cadr x))) skeleton-further-elements)
- (skeleton-internal-list skeleton str))
- (or (eolp) (not skeleton-end-newline) (newline-and-indent))
- (run-hooks 'skeleton-end-hook)
- (sit-for 0)
- (or (not (eq (window-buffer) (current-buffer)))
- (pos-visible-in-window-p beg)
- (progn
- (goto-char beg)
- (recenter 0)))
- (if skeleton-point
- (goto-char skeleton-point))))))
+ skeleton-modified skeleton-point) ;; resume:
+ (with-suppressed-warnings ((lexical help input v1 v2))
+ (dlet (help input v1 v2)
+ (setq skeleton-positions nil)
+ (unwind-protect
+ (cl-progv
+ (mapcar #'car skeleton-further-elements)
+ (mapcar (lambda (x) (eval (cadr x) t)) skeleton-further-elements)
+ (skeleton-internal-list skeleton str))
+ (or (eolp) (not skeleton-end-newline) (newline-and-indent))
+ (run-hooks 'skeleton-end-hook)
+ (sit-for 0)
+ (or (not (eq (window-buffer) (current-buffer)))
+ (pos-visible-in-window-p beg)
+ (progn
+ (goto-char beg)
+ (recenter 0)))
+ (if skeleton-point
+ (goto-char skeleton-point))))))))
(defun skeleton-read (prompt &optional initial-input recursive)
"Function for reading a string from the minibuffer within skeletons.
@@ -327,36 +329,39 @@ automatically, and you are prompted to fill in the variable parts.")))
(signal 'quit t)
prompt))
-(defun skeleton-internal-list (skeleton-il &optional str recursive)
+(defun skeleton-internal-list (skeleton &optional str recursive)
(let* ((start (line-beginning-position))
(column (current-column))
(line (buffer-substring start (line-end-position)))
- opoint)
- (or str
- (setq str `(setq str
- (skeleton-read ',(car skeleton-il) nil ,recursive))))
- (when (and (eq (cadr skeleton-il) '\n) (not recursive)
- (save-excursion (skip-chars-backward " \t") (bolp)))
- (setq skeleton-il (cons nil (cons '> (cddr skeleton-il)))))
- (while (setq skeleton-modified (eq opoint (point))
- opoint (point)
- skeleton-il (cdr skeleton-il))
- (condition-case quit
- (skeleton-internal-1 (car skeleton-il) nil recursive)
- (quit
- (if (eq (cdr quit) 'recursive)
- (setq recursive 'quit
- skeleton-il (memq 'resume: skeleton-il))
- ;; Remove the subskeleton as far as it has been shown
- ;; the subskeleton shouldn't have deleted outside current line.
- (end-of-line)
- (delete-region start (point))
- (insert line)
- (move-to-column column)
- (if (cdr quit)
- (setq skeleton-il ()
- recursive nil)
- (signal 'quit 'recursive)))))))
+ (skeleton-il skeleton)
+ opoint)
+ (with-suppressed-warnings ((lexical str))
+ (dlet ((str (or str
+ `(setq str
+ (skeleton-read ',(car skeleton-il)
+ nil ,recursive)))))
+ (when (and (eq (cadr skeleton-il) '\n) (not recursive)
+ (save-excursion (skip-chars-backward " \t") (bolp)))
+ (setq skeleton-il (cons nil (cons '> (cddr skeleton-il)))))
+ (while (setq skeleton-modified (eq opoint (point))
+ opoint (point)
+ skeleton-il (cdr skeleton-il))
+ (condition-case quit
+ (skeleton-internal-1 (car skeleton-il) nil recursive)
+ (quit
+ (if (eq (cdr quit) 'recursive)
+ (setq recursive 'quit
+ skeleton-il (memq 'resume: skeleton-il))
+ ;; Remove the subskeleton as far as it has been shown
+ ;; the subskeleton shouldn't have deleted outside current line.
+ (end-of-line)
+ (delete-region start (point))
+ (insert line)
+ (move-to-column column)
+ (if (cdr quit)
+ (setq skeleton-il ()
+ recursive nil)
+ (signal 'quit 'recursive)))))))))
;; maybe continue loop or go on to next outer resume: section
(if (eq recursive 'quit)
(signal 'quit 'recursive)
diff --git a/lisp/so-long.el b/lisp/so-long.el
index c800c7a1430..6ae8d0aec8a 100644
--- a/lisp/so-long.el
+++ b/lisp/so-long.el
@@ -389,7 +389,7 @@
;; this caveat is the `mode' pseudo-variable, which is processed early in all
;; versions of Emacs, and can be set to `so-long-mode' if desired.
-;;; * Change Log:
+;; * Change Log:
;;
;; 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.
@@ -833,7 +833,7 @@ available in Emacs versions < 27). For more information refer to info node
`(emacs) Bidirectional Editing' and info node `(elisp) Bidirectional Display'.
Buffers are made read-only by default to prevent potentially-slow editing from
-occurring inadvertantly, as buffers with excessively long lines are likely not
+occurring inadvertently, as buffers with excessively long lines are likely not
intended to be edited manually."
:type '(alist :key-type (variable :tag "Variable")
:value-type (sexp :tag "Value"))
@@ -1001,8 +1001,10 @@ This command calls `so-long' with the selected action as an argument.")
(cl-letf (((symbol-function 'finder-summary) #'ignore))
(finder-commentary "so-long"))
(let ((inhibit-read-only t))
- (when (looking-at "^Commentary:\n\n")
- (replace-match "so-long.el\n\n"))
+ (if (looking-at "^Commentary:\n\n")
+ (replace-match "so-long.el\n\n")
+ (insert "so-long.el\n")
+ (forward-line 1))
(save-excursion
(while (re-search-forward "^-+$" nil :noerror)
(replace-match ""))))
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 4cd4fb9161d..aab6a3a1283 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -7,10 +7,12 @@
(defvar speedbar-version "1.0"
"The current version of speedbar.")
+(make-obsolete-variable 'speedbar-version nil "28.1")
(defvar speedbar-incompatible-version "0.14beta4"
"This version of speedbar is incompatible with this version.
Due to massive API changes (removing the use of the word PATH)
this version is not backward compatible to 0.14 or earlier.")
+(make-obsolete-variable 'speedbar-incompatible-version nil "28.1")
;; This file is part of GNU Emacs.
@@ -115,7 +117,7 @@ this version is not backward compatible to 0.14 or earlier.")
(require 'easymenu)
(require 'dframe)
-(require 'sb-image)
+(require 'ezimage)
;; customization stuff
(defgroup speedbar nil
@@ -141,6 +143,12 @@ this version is not backward compatible to 0.14 or earlier.")
:prefix "speedbar-"
:group 'speedbar)
+(defcustom speedbar-use-images ezimage-use-images
+ "Non-nil if speedbar should display icons."
+ :group 'speedbar
+ :version "21.1"
+ :type 'boolean)
+
;;; Code:
;; Note: `inversion-test' requires parts of the CEDET package that are
@@ -296,6 +304,8 @@ The default buffer is the buffer in the selected window in the attached frame."
"Hooks run when speedbar is loaded."
:group 'speedbar
:type 'hook)
+(make-obsolete-variable 'speedbar-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom speedbar-reconfigure-keymaps-hook nil
"Hooks run when the keymaps are regenerated."
@@ -641,7 +651,7 @@ They should include commonly existing directories which are not
useful. It is no longer necessary to include version-control
directories here; see `vc-directory-exclusion-list'."
:group 'speedbar
- :type 'string)
+ :type 'regexp)
(defcustom speedbar-file-unshown-regexp
(let ((nstr "") (noext completion-ignored-extensions))
@@ -654,7 +664,7 @@ directories here; see `vc-directory-exclusion-list'."
"Regexp matching files we don't want displayed in a speedbar buffer.
It is generated from the variable `completion-ignored-extensions'."
:group 'speedbar
- :type 'string)
+ :type 'regexp)
(defvar speedbar-file-regexp nil
"Regular expression matching files we know how to expand.
@@ -1069,7 +1079,7 @@ in the selected file.
(setq font-lock-keywords nil) ;; no font-locking please
(setq truncate-lines t)
(make-local-variable 'frame-title-format)
- (setq frame-title-format (concat "Speedbar " speedbar-version)
+ (setq frame-title-format "Speedbar"
case-fold-search nil
buffer-read-only t)
(speedbar-set-mode-line-format)
@@ -1703,7 +1713,7 @@ argument."
(put-text-property start end 'help-echo #'dframe-help-echo))
(if function (put-text-property start end 'speedbar-function function))
(if token (put-text-property start end 'speedbar-token token))
- ;; So far the only text we have is less that 3 chars.
+ ;; So far the only text we have is less than 3 chars.
(if (<= (- end start) 3)
(speedbar-insert-image-button-maybe start (- end start)))
)
@@ -1749,8 +1759,9 @@ This is based on `speedbar-initial-expansion-list-name' referencing
"Change speedbar's default expansion list to NEW-DEFAULT."
(interactive
(list
- (completing-read (format "Speedbar Mode (default %s): "
- speedbar-previously-used-expansion-list-name)
+ (completing-read (format-prompt
+ "Speedbar Mode"
+ speedbar-previously-used-expansion-list-name)
speedbar-initial-expansion-mode-alist
nil t "" nil
speedbar-previously-used-expansion-list-name)))
@@ -3230,19 +3241,21 @@ With universal argument ARG, flush cached data."
"Expand the line under the cursor and all descendants.
Optional argument ARG indicates that any cache should be flushed."
(interactive "P")
- (speedbar-expand-line arg)
- ;; Now, inside the area expanded here, expand all subnodes of
- ;; the same descendant type.
- (save-excursion
- (speedbar-next 1) ;; Move into the list.
- (let ((err nil))
- (while (not err)
- (condition-case nil
- (progn
- (speedbar-expand-line-descendants arg)
- (speedbar-restricted-next 1))
- (error (setq err t))))))
- )
+ (save-restriction
+ (narrow-to-region (line-beginning-position)
+ (line-beginning-position 2))
+ (speedbar-expand-line arg)
+ ;; Now, inside the area expanded here, expand all subnodes of
+ ;; the same descendant type.
+ (save-excursion
+ (speedbar-next 1) ;; Move into the list.
+ (let ((err nil))
+ (while (not err)
+ (condition-case nil
+ (progn
+ (speedbar-expand-line-descendants arg)
+ (speedbar-restricted-next 1))
+ (error (setq err t))))))))
(defun speedbar-contract-line-descendants ()
"Expand the line under the cursor and all descendants."
@@ -4022,6 +4035,68 @@ TEXT is the buffer's name, TOKEN and INDENT are unused."
(setq font-lock-global-modes (delq 'speedbar-mode
font-lock-global-modes)))))
+;;; Image management
+
+(defvar speedbar-expand-image-button-alist
+ '(("<+>" . ezimage-directory-plus)
+ ("<->" . ezimage-directory-minus)
+ ("< >" . ezimage-directory)
+ ("[+]" . ezimage-page-plus)
+ ("[-]" . ezimage-page-minus)
+ ("[?]" . ezimage-page)
+ ("[ ]" . ezimage-page)
+ ("{+}" . ezimage-box-plus)
+ ("{-}" . ezimage-box-minus)
+ ("<M>" . ezimage-mail)
+ ("<d>" . ezimage-document-tag)
+ ("<i>" . ezimage-info-tag)
+ (" =>" . ezimage-tag)
+ (" +>" . ezimage-tag-gt)
+ (" ->" . ezimage-tag-v)
+ (">" . ezimage-tag)
+ ("@" . ezimage-tag-type)
+ (" @" . ezimage-tag-type)
+ ("*" . ezimage-checkout)
+ ("#" . ezimage-object)
+ ("!" . ezimage-object-out-of-date)
+ ("//" . ezimage-label)
+ ("%" . ezimage-lock)
+ )
+ "List of text and image associations.")
+
+(defun speedbar-insert-image-button-maybe (start length)
+ "Insert an image button based on text starting at START for LENGTH chars.
+If buttontext is unknown, just insert that text.
+If we have an image associated with it, use that image."
+ (when speedbar-use-images
+ (let ((ezimage-expand-image-button-alist
+ speedbar-expand-image-button-alist))
+ (ezimage-insert-image-button-maybe start length))))
+
+(defun speedbar-image-dump ()
+ "Dump out the current state of the Speedbar image alist.
+See `speedbar-expand-image-button-alist' for details."
+ (interactive)
+ (with-output-to-temp-buffer "*Speedbar Images*"
+ (with-current-buffer "*Speedbar Images*"
+ (goto-char (point-max))
+ (insert "Speedbar image cache.\n\n")
+ (let ((start (point)) (end nil))
+ (insert "Image\tText\tImage Name")
+ (setq end (point))
+ (insert "\n")
+ (put-text-property start end 'face 'underline))
+ (let ((ia speedbar-expand-image-button-alist))
+ (while ia
+ (let ((start (point)))
+ (insert (car (car ia)))
+ (insert "\t")
+ (speedbar-insert-image-button-maybe start
+ (length (car (car ia))))
+ (insert (car (car ia)) "\t" (format "%s" (cdr (car ia))) "\n"))
+ (setq ia (cdr ia)))))))
+
+
(provide 'speedbar)
;; run load-time hooks
diff --git a/lisp/startup.el b/lisp/startup.el
index c8b36e205fd..9f67dfde124 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -463,9 +463,6 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
(and (string-match "\\`[[:alnum:]]" file)
;; The lower-case variants of RCS and CVS are for DOS/Windows.
(not (member file '("RCS" "CVS" "rcs" "cvs")))
- ;; Avoid doing a `stat' when it isn't necessary because
- ;; that can cause trouble when an NFS server is down.
- (not (string-match "\\.elc?\\'" file))
(file-directory-p file)
(let ((expanded (expand-file-name file)))
(or (file-exists-p (expand-file-name ".nosearch" expanded))
@@ -645,16 +642,13 @@ It is the default value of the variable `top-level'."
(list (default-value 'user-full-name)))
;; If the PWD environment variable isn't accurate, delete it.
(let ((pwd (getenv "PWD")))
- (and (stringp pwd)
- ;; Use FOO/., so that if FOO is a symlink, file-attributes
- ;; describes the directory linked to, not FOO itself.
+ (and pwd
(or (and default-directory
(ignore-errors
(equal (file-attributes
- (concat (file-name-as-directory pwd) "."))
+ (file-name-as-directory pwd))
(file-attributes
- (concat (file-name-as-directory default-directory)
- ".")))))
+ (file-name-as-directory default-directory)))))
(setq process-environment
(delete (concat "PWD=" pwd)
process-environment)))))
diff --git a/lisp/strokes.el b/lisp/strokes.el
index 334e1a72d38..c2f03cac0f1 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -296,6 +296,8 @@ the corresponding interactive function.")
(defvar strokes-load-hook nil
"Functions to be called when Strokes is loaded.")
+(make-obsolete-variable 'strokes-load-hook
+ "use `with-eval-after-load' instead." "28.1")
;;; ### NOT IMPLEMENTED YET ###
;;(defvar edit-strokes-menu
@@ -1373,9 +1375,7 @@ If STROKES-MAP is not given, `strokes-global-map' will be used instead."
(defun strokes-alphabetic-lessp (stroke1 stroke2)
"Return t if STROKE1's command name precedes STROKE2's in lexicographic order."
- (let ((command-name-1 (symbol-name (cdr stroke1)))
- (command-name-2 (symbol-name (cdr stroke2))))
- (string-lessp command-name-1 command-name-2)))
+ (string-lessp (cdr stroke1) (cdr stroke2)))
(defvar strokes-mode-map
(let ((map (make-sparse-keymap)))
diff --git a/lisp/subr.el b/lisp/subr.el
index 2b3231b879b..23e4dcfa7ed 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -193,9 +193,9 @@ except that PLACE is evaluated only once (after NEWELT)."
(list 'setq place
(list 'cons newelt place))
(require 'macroexp)
- (macroexp-let2 macroexp-copyable-p v newelt
+ (macroexp-let2 macroexp-copyable-p x newelt
(gv-letplace (getter setter) place
- (funcall setter `(cons ,v ,getter))))))
+ (funcall setter `(cons ,x ,getter))))))
(defmacro pop (place)
"Return the first element of PLACE's value, and remove it from the list.
@@ -257,10 +257,9 @@ Then evaluate RESULT to get return value, default nil.
;; use dolist.
;; FIXME: This cost disappears in byte-compiled lexical-binding files.
(let ((temp '--dolist-tail--))
- ;; This is not a reliable test, but it does not matter because both
- ;; semantics are acceptable, tho one is slightly faster with dynamic
- ;; scoping and the other is slightly faster (and has cleaner semantics)
- ;; with lexical scoping.
+ ;; This test does not matter much because both semantics are acceptable,
+ ;; but one is slightly faster with dynamic scoping and the other is
+ ;; slightly faster (and has cleaner semantics) with lexical scoping.
(if lexical-binding
`(let ((,temp ,(nth 1 spec)))
(while ,temp
@@ -280,8 +279,11 @@ Then evaluate RESULT to get return value, default nil.
(defmacro dotimes (spec &rest body)
"Loop a certain number of times.
Evaluate BODY with VAR bound to successive integers running from 0,
-inclusive, to COUNT, exclusive. Then evaluate RESULT to get
-the return value (nil if RESULT is omitted). Its use is deprecated.
+inclusive, to COUNT, exclusive.
+
+Finally RESULT is evaluated to get the return value (nil if
+RESULT is omitted). Using RESULT is deprecated, and may result
+in compilation warnings about unused variables.
\(fn (VAR COUNT [RESULT]) BODY...)"
(declare (indent 1) (debug dolist))
@@ -292,9 +294,9 @@ the return value (nil if RESULT is omitted). Its use is deprecated.
(let ((temp '--dotimes-limit--)
(start 0)
(end (nth 1 spec)))
- ;; This is not a reliable test, but it does not matter because both
- ;; semantics are acceptable, tho one is slightly faster with dynamic
- ;; scoping and the other has cleaner semantics.
+ ;; This test does not matter much because both semantics are acceptable,
+ ;; but one is slightly faster with dynamic scoping and the other has
+ ;; cleaner semantics.
(if lexical-binding
(let ((counter '--dotimes-counter--))
`(let ((,temp ,end)
@@ -767,7 +769,6 @@ If that is non-nil, the element matches; then `assoc-default'
If no element matches, the value is nil.
If TEST is omitted or nil, `equal' is used."
- (declare (side-effect-free t))
(let (found (tail alist) value)
(while (and tail (not found))
(let ((elt (car tail)))
@@ -884,6 +885,10 @@ side-effects, and the argument LIST is not modified."
;;;; Keymap support.
+;; Declare before first use of `save-match-data',
+;; where it is used internally.
+(defvar save-match-data-internal)
+
(defun kbd (keys)
"Convert KEYS to the internal Emacs key representation.
KEYS should be a string in the format returned by commands such
@@ -894,8 +899,9 @@ This is the same format used for saving keyboard macros (see
For an approximate inverse of this, see `key-description'."
;; Don't use a defalias, since the `pure' property is true only for
;; the calling convention of `kbd'.
- (read-kbd-macro keys))
-(put 'kbd 'pure t)
+ (declare (pure t))
+ ;; A pure function is expected to preserve the match data.
+ (save-match-data (read-kbd-macro keys)))
(defun undefined ()
"Beep to tell the user this binding is undefined."
@@ -1558,7 +1564,6 @@ be a list of the form returned by `event-start' and `event-end'."
;;;; Obsolescent names for functions.
-(make-obsolete 'forward-point "use (+ (point) N) instead." "23.1")
(make-obsolete 'buffer-has-markers-at nil "24.3")
(make-obsolete 'invocation-directory "use the variable of the same name."
@@ -1604,8 +1609,6 @@ be a list of the form returned by `event-start' and `event-end'."
(make-obsolete 'set-window-redisplay-end-trigger nil "23.1")
(make-obsolete 'run-window-configuration-change-hook nil "27.1")
-(make-obsolete 'process-filter-multibyte-p nil "23.1")
-(make-obsolete 'set-process-filter-multibyte nil "23.1")
(make-obsolete-variable 'command-debug-status
"expect it to be removed in a future version." "25.2")
@@ -1621,6 +1624,9 @@ be a list of the form returned by `event-start' and `event-end'."
(defvaralias 'messages-buffer-max-lines 'message-log-max)
(define-obsolete-variable-alias 'inhibit-null-byte-detection
'inhibit-nul-byte-detection "27.1")
+(make-obsolete-variable 'load-dangerous-libraries
+ "no longer used." "27.1")
+
;;;; Alternate names for functions - these are not being phased out.
@@ -1645,7 +1651,8 @@ be a list of the form returned by `event-start' and `event-end'."
(defalias 'point-at-eol 'line-end-position)
(defalias 'point-at-bol 'line-beginning-position)
-(defalias 'user-original-login-name 'user-login-name)
+(define-obsolete-function-alias 'user-original-login-name
+ 'user-login-name "28.1")
;;;; Hook manipulation functions.
@@ -1774,6 +1781,21 @@ all symbols are bound before any of the VALUEFORMs are evalled."
,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
,@body))
+(defmacro dlet (binders &rest body)
+ "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,
+ ;; which is what the surrounding `let' is for.
+ ;; FIXME: (let () ...) currently doesn't actually create a new scope,
+ ;; which is why we use (let (_) ...).
+ `(let (_)
+ ,@(mapcar (lambda (binder)
+ `(defvar ,(if (consp binder) (car binder) binder)))
+ binders)
+ (let* ,binders ,@body)))
+
+
(defmacro with-wrapper-hook (hook args &rest body)
"Run BODY, using wrapper functions from HOOK with additional ARGS.
HOOK is an abnormal hook. Each hook function in HOOK \"wraps\"
@@ -1804,6 +1826,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)))
;; We need those two gensyms because CL's lexical scoping is not available
;; for function arguments :-(
(let ((funs (make-symbol "funs"))
@@ -2263,6 +2286,8 @@ Otherwise TYPE is assumed to be a symbol property."
(not (eq 'require (car match)))))))
(throw 'found file))))))
+(declare-function read-library-name "find-func" nil)
+
(defun locate-library (library &optional nosuffix path interactive-call)
"Show the precise file name of Emacs library LIBRARY.
LIBRARY should be a relative file name of the library, a string.
@@ -2279,12 +2304,7 @@ is used instead of `load-path'.
When called from a program, the file name is normally returned as a
string. When run interactively, the argument INTERACTIVE-CALL is t,
and the file name is displayed in the echo area."
- (interactive (list (completing-read "Locate library: "
- (apply-partially
- 'locate-file-completion-table
- load-path (get-load-suffixes)))
- nil nil
- t))
+ (interactive (list (read-library-name) nil nil t))
(let ((file (locate-file library
(or path load-path)
(append (unless nosuffix (get-load-suffixes))
@@ -2327,13 +2347,19 @@ use `start-file-process'."
(if program
(list :command (cons program program-args))))))
-(defun process-lines (program &rest args)
+(defun process-lines-handling-status (program status-handler &rest args)
"Execute PROGRAM with ARGS, returning its output as a list of lines.
-Signal an error if the program returns with a non-zero exit status."
+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
+exit status."
(with-temp-buffer
(let ((status (apply 'call-process program nil (current-buffer) nil args)))
- (unless (eq status 0)
- (error "%s exited with status %s" program status))
+ (if status-handler
+ (funcall status-handler status)
+ (unless (eq status 0)
+ (error "%s exited with status %s" program status)))
(goto-char (point-min))
(let (lines)
(while (not (eobp))
@@ -2344,6 +2370,18 @@ Signal an error if the program returns with a non-zero exit status."
(forward-line 1))
(nreverse lines)))))
+(defun process-lines (program &rest args)
+ "Execute PROGRAM with ARGS, returning its output as a list of lines.
+Signal an error if the program returns with a non-zero exit status.
+Also see `process-lines-ignore-status'."
+ (apply #'process-lines-handling-status program nil args))
+
+(defun process-lines-ignore-status (program &rest args)
+ "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))
+
(defun process-live-p (process)
"Return non-nil if PROCESS is alive.
A process is considered alive if its status is `run', `open',
@@ -2521,10 +2559,15 @@ by doing (clear-string STRING)."
;; And of course, don't keep the sensitive data around.
(erase-buffer))))))))
-(defun read-number (prompt &optional default)
+(defvar read-number-history nil
+ "The default history for the `read-number' function.")
+
+(defun read-number (prompt &optional default hist)
"Read a numeric value in the minibuffer, prompting with PROMPT.
DEFAULT specifies a default value to return if the user just types RET.
The value of DEFAULT is inserted into PROMPT.
+HIST specifies a history list variable. See `read-from-minibuffer'
+for details of the HIST argument.
This function is used by the `interactive' code letter `n'."
(let ((n nil)
(default1 (if (consp default) (car default) default)))
@@ -2538,7 +2581,7 @@ This function is used by the `interactive' code letter `n'."
(while
(progn
(let ((str (read-from-minibuffer
- prompt nil nil nil nil
+ prompt nil nil nil (or hist 'read-number-history)
(when default
(if (consp default)
(mapcar 'number-to-string (delq nil default))
@@ -3049,9 +3092,17 @@ If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
o1))
(defun remove-overlays (&optional beg end name val)
- "Clear BEG and END of overlays whose property NAME has value VAL.
-Overlays might be moved and/or split.
-BEG and END default respectively to the beginning and end of buffer."
+ "Remove overlays between BEG and END that have property NAME with value VAL.
+Overlays might be moved and/or split. If any targeted overlays
+start before BEG, the overlays will be altered so that they end
+at BEG. Likewise, if the targeted overlays end after END, they
+will be altered so that they start at END. Overlays that start
+at or after BEG and end before END will be removed completely.
+
+BEG and END default respectively to the beginning and end of the
+buffer.
+Values are compared with `eq'.
+If either NAME or VAL are specified, both should be specified."
;; This speeds up the loops over overlays.
(unless beg (setq beg (point-min)))
(unless end (setq end (point-max)))
@@ -3200,7 +3251,7 @@ See Info node `(elisp)Security Considerations'."
;; First, quote argument so that CommandLineToArgvW will
;; understand it. See
- ;; http://msdn.microsoft.com/en-us/library/17w5ykft%28v=vs.85%29.aspx
+ ;; https://msdn.microsoft.com/en-us/library/17w5ykft%28v=vs.85%29.aspx
;; After we perform that level of quoting, escape shell
;; metacharacters so that cmd won't mangle our argument. If the
;; argument contains no double quote characters, we can just
@@ -3967,7 +4018,7 @@ the function `undo--wrap-and-run-primitive-undo'."
(let (;; (inhibit-modification-hooks t)
(before-change-functions
;; Ugly Hack: if the body uses syntax-ppss/syntax-propertize
- ;; (e.g. via a regexp-search or sexp-movement trigerring
+ ;; (e.g. via a regexp-search or sexp-movement triggering
;; on-the-fly syntax-propertize), make sure that this gets
;; properly refreshed after subsequent changes.
(if (memq #'syntax-ppss-flush-cache before-change-functions)
@@ -4009,7 +4060,7 @@ the function `undo--wrap-and-run-primitive-undo'."
(defmacro combine-change-calls (beg end &rest body)
"Evaluate BODY, running the change hooks just once.
-BODY is a sequence of lisp forms to evaluate. BEG and END bound
+BODY is a sequence of Lisp forms to evaluate. BEG and END bound
the region the change hooks will be run for.
Firstly, `before-change-functions' is invoked for the region
@@ -4027,7 +4078,8 @@ 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'. "
+the function `undo--wrap-and-run-primitive-undo'."
+ (declare (debug t) (indent 2))
`(combine-change-calls-1 ,beg ,end (lambda () ,@body)))
(defun undo--wrap-and-run-primitive-undo (beg end list)
@@ -4080,8 +4132,6 @@ MODES is as for `set-default-file-modes'."
;;; Matching and match data.
-(defvar save-match-data-internal)
-
;; We use save-match-data-internal as the local variable because
;; that works ok in practice (people should not use that variable elsewhere).
;; We used to use an uninterned symbol; the compiler handles that properly
@@ -4382,6 +4432,27 @@ Unless optional argument INPLACE is non-nil, return a new string."
(aset newstr i tochar)))
newstr))
+(defun string-replace (fromstring tostring instring)
+ "Replace FROMSTRING with TOSTRING in INSTRING each time it occurs."
+ (declare (pure t))
+ (when (equal fromstring "")
+ (signal 'wrong-length-argument fromstring))
+ (let ((start 0)
+ (result nil)
+ pos)
+ (while (setq pos (string-search fromstring instring start))
+ (unless (= start pos)
+ (push (substring instring start pos) result))
+ (push tostring result)
+ (setq start (+ pos (length fromstring))))
+ (if (null result)
+ ;; No replacements were done, so just return the original string.
+ instring
+ ;; Get any remaining bit.
+ (unless (= start (length instring))
+ (push (substring instring start) result))
+ (apply #'concat (nreverse result)))))
+
(defun replace-regexp-in-string (regexp rep string &optional
fixedcase literal subexp start)
"Replace all matches for REGEXP with REP in STRING.
@@ -4649,13 +4720,6 @@ This function is called directly from the C code."
;; Finally, run any other hook.
(run-hook-with-args 'after-load-functions abs-file))
-(defun eval-next-after-load (file)
- "Read the following input sexp, and run it whenever FILE is loaded.
-This makes or adds to an entry on `after-load-alist'.
-FILE should be the name of a library, with no directory name."
- (declare (obsolete eval-after-load "23.2"))
- (eval-after-load file (read)))
-
(defun display-delayed-warnings ()
"Display delayed warnings from `delayed-warnings-list'.
diff --git a/lisp/svg.el b/lisp/svg.el
index 7aadbc23593..eeb945f53b5 100644
--- a/lisp/svg.el
+++ b/lisp/svg.el
@@ -5,7 +5,7 @@
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Felix E. Klee <felix.klee@inka.de>
;; Keywords: image
-;; Version: 1.0
+;; Version: 1.1
;; Package-Requires: ((emacs "25"))
;; This file is part of GNU Emacs.
diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el
index fc174176cd6..4feab71401e 100644
--- a/lisp/t-mouse.el
+++ b/lisp/t-mouse.el
@@ -1,4 +1,4 @@
-;;; t-mouse.el --- mouse support within the text terminal
+;;; t-mouse.el --- mouse support within the text terminal -*- lexical-binding:t -*-
;; Author: Nick Roberts <nickrob@gnu.org>
;; Maintainer: emacs-devel@gnu.org
@@ -63,8 +63,6 @@
(set-terminal-parameter nil 'gpm-mouse-active nil))
;;;###autoload
-(define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1")
-;;;###autoload
(define-minor-mode gpm-mouse-mode
"Toggle mouse support in GNU/Linux consoles (GPM Mouse mode).
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index d97ca37a731..9c6b9cbc048 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -665,7 +665,8 @@ to get the name of the last visited tab, the second last, and so on."
(let* ((recent-tabs (mapcar (lambda (tab)
(alist-get 'name tab))
(tab-bar--tabs-recent))))
- (list (completing-read "Switch to tab by name (default recent): "
+ (list (completing-read (format-prompt "Switch to tab by name"
+ (car recent-tabs))
recent-tabs nil nil nil nil recent-tabs))))
(tab-bar-select-tab (1+ (or (tab-bar--tab-index-by-name name) 0))))
@@ -799,11 +800,13 @@ After the tab is created, the hooks in
(run-hook-with-args 'tab-bar-tab-post-open-functions
(nth to-index tabs)))
- (when (and (not tab-bar-mode)
- (or (eq tab-bar-show t)
- (and (natnump tab-bar-show)
- (> (length tabs) tab-bar-show))))
+ (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)))
+ (set-frame-parameter nil 'tab-bar-lines 1)))
(force-mode-line-update)
(unless tab-bar-mode
@@ -936,10 +939,11 @@ for the last tab on a frame is determined by
tab-bar-closed-tabs)
(set-frame-parameter nil 'tabs (delq close-tab tabs)))
- (when (and tab-bar-mode
- (and (natnump tab-bar-show)
- (<= (length tabs) tab-bar-show)))
- (tab-bar-mode -1))
+ (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))
(force-mode-line-update)
(unless tab-bar-mode
@@ -975,10 +979,11 @@ for the last tab on a frame is determined by
(run-hook-with-args 'tab-bar-tab-pre-close-functions (nth index tabs) nil)))
(set-frame-parameter nil 'tabs (list (nth current-index tabs)))
- (when (and tab-bar-mode
- (and (natnump tab-bar-show)
- (<= 1 tab-bar-show)))
- (tab-bar-mode -1))
+ (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))
(force-mode-line-update)
(unless tab-bar-mode
@@ -1483,8 +1488,7 @@ 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
indirectly called by the latter."
- (let* ((tab-name (alist-get 'tab-name alist))
- (reusable-frames (alist-get 'reusable-frames alist))
+ (let* ((reusable-frames (alist-get 'reusable-frames alist))
(reusable-tab (when reusable-frames
(tab-bar-get-buffer-tab buffer reusable-frames))))
(if reusable-tab
@@ -1496,17 +1500,46 @@ indirectly called by the latter."
(tab-bar-select-tab (1+ index)))
(when (get-buffer-window buffer frame)
(select-window (get-buffer-window buffer frame))))
+ (let ((tab-name (alist-get 'tab-name alist)))
+ (when (functionp tab-name)
+ (setq tab-name (funcall tab-name buffer alist)))
+ (if tab-name
+ (let ((tab-index (tab-bar--tab-index-by-name tab-name)))
+ (if tab-index
+ (progn
+ (tab-bar-select-tab (1+ tab-index))
+ (when (get-buffer-window buffer)
+ (select-window (get-buffer-window buffer))))
+ (display-buffer-in-new-tab buffer alist)))
+ (display-buffer-in-new-tab buffer alist))))))
+
+(defun display-buffer-in-new-tab (buffer alist)
+ "Display BUFFER in a new tab.
+ALIST is an association list of action symbols and values. See
+Info node `(elisp) Buffer Display Action Alists' for details of
+such alists.
+
+Like `display-buffer-in-tab', but always creates a new tab unconditionally,
+without checking if a suitable tab already exists.
+
+If ALIST contains a `tab-name' entry, it creates a new tab with that name
+and displays BUFFER in a new tab. The `tab-name' entry can be 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.
+
+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
+indirectly called by the latter."
+ (let ((tab-bar-new-tab-choice t))
+ (tab-bar-new-tab)
+ (let ((tab-name (alist-get 'tab-name alist)))
(when (functionp tab-name)
(setq tab-name (funcall tab-name buffer alist)))
- (if tab-name
- (let ((tab-index (tab-bar--tab-index-by-name tab-name)))
- (if tab-index
- (tab-bar-select-tab (1+ tab-index))
- (let ((tab-bar-new-tab-choice t))
- (tab-bar-new-tab)
- (tab-bar-rename-tab tab-name))))
- (let ((tab-bar-new-tab-choice t))
- (tab-bar-new-tab))))))
+ (when tab-name
+ (tab-bar-rename-tab tab-name)))
+ (window--display-buffer buffer (selected-window) 'tab alist)))
(defun switch-to-buffer-other-tab (buffer-or-name &optional norecord)
"Switch to buffer BUFFER-OR-NAME in another tab.
@@ -1514,8 +1547,7 @@ Like \\[switch-to-buffer-other-frame] (which see), but creates a new tab."
(interactive
(list (read-buffer-to-switch "Switch to buffer in other tab: ")))
(display-buffer (window-normalize-buffer-to-switch-to buffer-or-name)
- '((display-buffer-in-tab
- display-buffer-same-window)
+ '((display-buffer-in-tab)
(inhibit-same-window . nil))
norecord))
@@ -1534,6 +1566,39 @@ Like \\[find-file-other-frame] (which see), but creates a new tab."
value)
(switch-to-buffer-other-tab value))))
+(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
+ (find-file-read-args "Find file read-only in other tab: "
+ (confirm-nonexistent-file-or-buffer)))
+ (find-file--read-only (lambda (filename wildcards)
+ (window-buffer
+ (find-file-other-tab filename wildcards)))
+ filename wildcards))
+
+(defun other-tab-prefix ()
+ "Display the buffer of the next command in a new tab.
+The next buffer is the buffer displayed by the next command invoked
+immediately after this command (ignoring reading from the minibuffer).
+Creates a new tab before displaying the buffer, or switches to the tab
+that already contains that buffer.
+When `switch-to-buffer-obey-display-actions' is non-nil,
+`switch-to-buffer' commands are also supported."
+ (interactive)
+ (display-buffer-override-next-command
+ (lambda (buffer alist)
+ (cons (progn
+ (display-buffer-in-tab
+ buffer (append alist '((inhibit-same-window . nil))))
+ (selected-window))
+ 'tab))
+ nil "[other-tab]")
+ (message "Display next command buffer in a new tab..."))
+
(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)
@@ -1544,6 +1609,8 @@ Like \\[find-file-other-frame] (which see), but creates a new tab."
(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)
(provide 'tab-bar)
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index e8c4dc4d93c..8da554a3267 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -642,6 +642,16 @@ using the `previous-buffer' command."
(with-selected-window window
(switch-to-buffer buffer))))))
+(defcustom tab-line-switch-cycling nil
+ "Enable cycling tab switch.
+If non-nil, `tab-line-switch-to-prev-tab' in the first tab
+switches to the last tab and `tab-line-switch-to-next-tab' in the
+last tab switches to the first tab. This variable is not consulted
+when `tab-line-tabs-function' is `tab-line-tabs-window-buffers'."
+ :type 'boolean
+ :group 'tab-line
+ :version "28.1")
+
(defun tab-line-switch-to-prev-tab (&optional mouse-event)
"Switch to the previous tab.
Its effect is the same as using the `previous-buffer' command
@@ -652,13 +662,16 @@ Its effect is the same as using the `previous-buffer' command
(switch-to-prev-buffer window)
(with-selected-window (or window (selected-window))
(let* ((tabs (funcall tab-line-tabs-function))
- (tab (nth (1- (seq-position
- tabs (current-buffer)
- (lambda (tab buffer)
- (if (bufferp tab)
- (eq buffer tab)
- (eq buffer (cdr (assq 'buffer tab)))))))
- tabs))
+ (pos (seq-position
+ tabs (current-buffer)
+ (lambda (tab buffer)
+ (if (bufferp tab)
+ (eq buffer tab)
+ (eq buffer (cdr (assq 'buffer tab)))))))
+ (tab (if pos
+ (if (and tab-line-switch-cycling (<= pos 0))
+ (nth (1- (length tabs)) tabs)
+ (nth (1- pos) tabs))))
(buffer (if (bufferp tab) tab (cdr (assq 'buffer tab)))))
(when (bufferp buffer)
(switch-to-buffer buffer)))))))
@@ -673,13 +686,16 @@ Its effect is the same as using the `next-buffer' command
(switch-to-next-buffer window)
(with-selected-window (or window (selected-window))
(let* ((tabs (funcall tab-line-tabs-function))
- (tab (nth (1+ (seq-position
- tabs (current-buffer)
- (lambda (tab buffer)
- (if (bufferp tab)
- (eq buffer tab)
- (eq buffer (cdr (assq 'buffer tab)))))))
- tabs))
+ (pos (seq-position
+ tabs (current-buffer)
+ (lambda (tab buffer)
+ (if (bufferp tab)
+ (eq buffer tab)
+ (eq buffer (cdr (assq 'buffer tab)))))))
+ (tab (if pos
+ (if (and tab-line-switch-cycling (<= (length tabs) (1+ pos)))
+ (car tabs)
+ (nth (1+ pos) tabs))))
(buffer (if (bufferp tab) tab (cdr (assq 'buffer tab)))))
(when (bufferp buffer)
(switch-to-buffer buffer)))))))
@@ -764,11 +780,15 @@ from the tab line."
(global-set-key [tab-line mouse-5] 'tab-line-hscroll-right)
(global-set-key [tab-line wheel-up] 'tab-line-hscroll-left)
(global-set-key [tab-line wheel-down] 'tab-line-hscroll-right)
+(global-set-key [tab-line wheel-left] 'tab-line-hscroll-left)
+(global-set-key [tab-line wheel-right] 'tab-line-hscroll-right)
(global-set-key [tab-line S-mouse-4] 'tab-line-switch-to-prev-tab)
(global-set-key [tab-line S-mouse-5] 'tab-line-switch-to-next-tab)
(global-set-key [tab-line S-wheel-up] 'tab-line-switch-to-prev-tab)
(global-set-key [tab-line S-wheel-down] 'tab-line-switch-to-next-tab)
+(global-set-key [tab-line S-wheel-left] 'tab-line-switch-to-prev-tab)
+(global-set-key [tab-line S-wheel-right] 'tab-line-switch-to-next-tab)
(provide 'tab-line)
diff --git a/lisp/talk.el b/lisp/talk.el
index 5541b0a4c69..a18cf263435 100644
--- a/lisp/talk.el
+++ b/lisp/talk.el
@@ -90,7 +90,7 @@ Each element has the form (DISPLAY FRAME BUFFER).")
(let ((frame (nth 1 (car tail)))
(this-buffer (nth 2 (car tail)))
(buffers
- (mapcar (function (lambda (elt) (nth 2 elt)))
+ (mapcar (lambda (elt) (nth 2 elt))
talk-display-alist)))
;; Put this display's own talk buffer
;; at the front of the list.
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 97d883eebd9..5cf09f9055e 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -480,23 +480,9 @@ checksum before doing the check."
(defun tar-grind-file-mode (mode)
"Construct a `rw-r--r--' string indicating MODE.
-MODE should be an integer which is a file mode value."
- (string
- (if (zerop (logand 256 mode)) ?- ?r)
- (if (zerop (logand 128 mode)) ?- ?w)
- (if (zerop (logand 2048 mode))
- (if (zerop (logand 64 mode)) ?- ?x)
- (if (zerop (logand 64 mode)) ?S ?s))
- (if (zerop (logand 32 mode)) ?- ?r)
- (if (zerop (logand 16 mode)) ?- ?w)
- (if (zerop (logand 1024 mode))
- (if (zerop (logand 8 mode)) ?- ?x)
- (if (zerop (logand 8 mode)) ?S ?s))
- (if (zerop (logand 4 mode)) ?- ?r)
- (if (zerop (logand 2 mode)) ?- ?w)
- (if (zerop (logand 512 mode))
- (if (zerop (logand 1 mode)) ?- ?x)
- (if (zerop (logand 1 mode)) ?T ?t))))
+MODE should be an integer which is a file mode value.
+For instance, if mode is #o700, then it produces `rwx------'."
+ (substring (file-modes-number-to-symbolic mode) 1))
(defun tar-header-block-summarize (tar-hblock &optional mod-p)
"Return a line similar to the output of `tar -vtf'."
@@ -936,6 +922,56 @@ actually appear on disk when you save the tar-file's buffer."
(setq buffer-undo-list nil))))
buffer))
+(defun tar-goto-file (file)
+ "Go to FILE in the current buffer.
+FILE should be a relative file name. If FILE can't be found,
+return nil. Otherwise point is returned."
+ (let ((start (point))
+ found)
+ (goto-char (point-min))
+ (while (and (not found)
+ (not (eobp)))
+ (forward-line 1)
+ (when-let ((descriptor (ignore-errors (tar-get-descriptor))))
+ (when (equal (tar-header-name descriptor) file)
+ (setq found t))))
+ (if (not found)
+ (progn
+ (goto-char start)
+ nil)
+ (point))))
+
+(defun tar-next-file-displayer (file regexp n)
+ "Return a closure to display the next file after FILE that matches REGEXP."
+ (let ((short (replace-regexp-in-string "\\`.*!" "" file))
+ next)
+ ;; The tar buffer chops off leading "./", so do the same
+ ;; here.
+ (setq short (replace-regexp-in-string "\\`\\./" "" file))
+ (tar-goto-file short)
+ (while (and (not next)
+ ;; Stop if we reach the end/start of the buffer.
+ (if (> n 0)
+ (not (eobp))
+ (not (save-excursion
+ (beginning-of-line)
+ (bobp)))))
+ (tar-next-line n)
+ (when-let ((descriptor (ignore-errors (tar-get-descriptor))))
+ (let ((candidate (tar-header-name descriptor))
+ (buffer (current-buffer)))
+ (when (and candidate
+ (string-match-p regexp candidate))
+ (setq next (lambda ()
+ (kill-buffer (current-buffer))
+ (switch-to-buffer buffer)
+ (tar-extract)))))))
+ (unless next
+ ;; If we didn't find a next/prev file, then restore
+ ;; point.
+ (tar-goto-file short))
+ next))
+
(defun tar-extract (&optional other-window-p)
"In Tar mode, extract this entry of the tar file into its own buffer."
(interactive)
@@ -1056,7 +1092,7 @@ extracted file."
(write-region start end to-file nil nil nil t))
(when (and tar-copy-preserve-time
date)
- (set-file-times to-file date)))
+ (set-file-times to-file date 'nofollow)))
(message "Copied tar entry %s to %s" name to-file)))
(defun tar-new-entry (filename &optional index)
diff --git a/lisp/tempo.el b/lisp/tempo.el
index ea072ff9dd7..f6612354b1c 100644
--- a/lisp/tempo.el
+++ b/lisp/tempo.el
@@ -75,7 +75,7 @@
;; ftp.lysator.liu.se in the directory /pub/emacs
;; There is also a WWW page at
-;; http://www.lysator.liu.se/~davidk/elisp/ which has some information
+;; https://www.lysator.liu.se/~davidk/elisp/ which has some information
;;; Known bugs:
@@ -220,7 +220,9 @@ list of elements in the template, TAG is the tag used for completion,
DOCUMENTATION is the documentation string for the insertion command
created, and TAGLIST (a symbol) is the tag list that TAG (if provided)
should be added to. If TAGLIST is nil and TAG is non-nil, TAG is
-added to `tempo-tags'.
+added to `tempo-tags'. If TAG already corresponds to a template in
+the tag list, modify the list so that TAG now corresponds to the newly
+defined template.
The elements in ELEMENTS can be of several types:
@@ -304,8 +306,8 @@ mode, ON-REGION is ignored and assumed true if the region is active."
(goto-char tempo-region-start))
(save-excursion
(tempo-insert-mark (point-marker))
- (mapc (function (lambda (elt)
- (tempo-insert elt on-region)))
+ (mapc (lambda (elt)
+ (tempo-insert elt on-region))
(symbol-value template))
(tempo-insert-mark (point-marker)))
(tempo-forward-mark))
@@ -447,9 +449,9 @@ never prompted."
"Tries all the user-defined element handlers in `tempo-user-elements'."
;; Sigh... I need (some list)
(catch 'found
- (mapc (function (lambda (handler)
- (let ((result (funcall handler element)))
- (if result (throw 'found result)))))
+ (mapc (lambda (handler)
+ (let ((result (funcall handler element)))
+ (if result (throw 'found result))))
tempo-user-elements)
(throw 'found nil)))
@@ -579,14 +581,20 @@ and insert the results."
(defun tempo-add-tag (tag template &optional tag-list)
"Add a template tag.
Add the TAG, that should complete to TEMPLATE to the list in TAG-LIST,
-or to `tempo-tags' if TAG-LIST is nil."
+or to `tempo-tags' if TAG-LIST is nil. If TAG was already in the list,
+replace its template with TEMPLATE."
(interactive "sTag: \nCTemplate: ")
(if (null tag-list)
(setq tag-list 'tempo-tags))
- (if (not (assoc tag (symbol-value tag-list)))
- (set tag-list (cons (cons tag template) (symbol-value tag-list))))
- (tempo-invalidate-collection))
+ (let ((entry (assoc tag (symbol-value tag-list))))
+ (if entry
+ ;; Tag is already in the list, assign a new template to it.
+ (setcdr entry template)
+ ;; Tag is not present in the list, add it with its template.
+ (set tag-list (cons (cons tag template) (symbol-value tag-list)))))
+ ;; Invalidate globally if we're modifying 'tempo-tags'.
+ (tempo-invalidate-collection (eq tag-list 'tempo-tags)))
;;;
;;; tempo-use-tag-list
@@ -609,10 +617,17 @@ COMPLETION-FUNCTION just sets `tempo-match-finder' locally."
;;;
;;; tempo-invalidate-collection
-(defun tempo-invalidate-collection ()
+(defun tempo-invalidate-collection (&optional global)
"Marks the tag collection as obsolete.
-Whenever it is needed again it will be rebuilt."
- (setq tempo-dirty-collection t))
+Whenever it is needed again it will be rebuilt. If GLOBAL is non-nil,
+mark the tag collection of all buffers as obsolete, not just the
+current one."
+ (if global
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ (when (assq 'tempo-dirty-collection (buffer-local-variables))
+ (setq tempo-dirty-collection t))))
+ (setq tempo-dirty-collection t)))
;;;
;;; tempo-build-collection
@@ -625,11 +640,11 @@ If `tempo-dirty-collection' is nil, the old collection is reused."
tempo-collection)
(setq tempo-collection
(apply (function append)
- (mapcar (function (lambda (tag-list)
+ (mapcar (lambda (tag-list)
; If the format for
; tempo-local-tags changes,
; change this
- (eval (car tag-list))))
+ (eval (car tag-list)))
tempo-local-tags))))
(setq tempo-dirty-collection nil)))
diff --git a/lisp/term.el b/lisp/term.el
index 09dfeb61d17..ff8b3f00f34 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -241,9 +241,9 @@
;; printf '\033AnSiTu %s\n' "$USER"
;; printf '\033AnSiTc %s\n' "$PWD"
;;
-;; cd() { command cd "$@"; printf '\033AnSiTc %s\n' "$PWD"; }
-;; pushd() { command pushd "$@"; printf '\033AnSiTc %s\n' "$PWD"; }
-;; popd() { command popd "$@"; printf '\033AnSiTc %s\n' "$PWD"; }
+;; cd() { command cd "$@" && printf '\033AnSiTc %s\n' "$PWD"; }
+;; pushd() { command pushd "$@" && printf '\033AnSiTc %s\n' "$PWD"; }
+;; popd() { command popd "$@" && printf '\033AnSiTc %s\n' "$PWD"; }
;;
;; # Use custom dircolors in term buffers.
;; # eval $(dircolors $HOME/.emacs_dircolors)
@@ -467,6 +467,11 @@ Customize this option to nil if you want the previous behavior."
:type 'boolean
:group 'term)
+(defcustom term-set-terminal-size nil
+ "If non-nil, set the LINES and COLUMNS environment variables."
+ :type 'boolean
+ :version "28.1")
+
(defcustom term-char-mode-point-at-process-mark t
"If non-nil, keep point at the process mark in char mode.
@@ -501,6 +506,14 @@ This variable is buffer-local."
:type 'boolean
:group 'term)
+(defcustom term-scroll-snap-to-bottom t
+ "Control whether to keep the prompt at the bottom of the window.
+If non-nil, when the prompt is visible within the window, then
+scroll so that the prompt is on the bottom on any input or
+output."
+ :version "28.1"
+ :type 'boolean)
+
(defcustom term-scroll-show-maximum-output nil
"Controls how interpreter output causes window to scroll.
If non-nil, then show the maximum output when the window is scrolled.
@@ -541,7 +554,7 @@ See also `term-dynamic-complete'.
This is a good thing to set in mode hooks.")
(defvar term-input-filter
- (function (lambda (str) (not (string-match "\\`\\s *\\'" str))))
+ (lambda (str) (not (string-match "\\`\\s *\\'" str)))
"Predicate for filtering additions to input history.
Only inputs answering true to this function are saved on the input
history list. Default is to save anything that isn't all whitespace.")
@@ -847,6 +860,7 @@ is buffer-local."
(define-key map [prior] 'term-send-prior)
(define-key map [next] 'term-send-next)
(define-key map [xterm-paste] #'term--xterm-paste)
+ (define-key map [?\C-/] #'term-send-C-_)
map)
"Keyboard map for sending characters directly to the inferior process.")
@@ -1269,6 +1283,7 @@ without any interpretation."
(defun term-send-next () (interactive) (term-send-raw-string "\e[6~"))
(defun term-send-del () (interactive) (term-send-raw-string "\e[3~"))
(defun term-send-backspace () (interactive) (term-send-raw-string "\C-?"))
+(defun term-send-C-_ () (interactive) (term-send-raw-string "\C-_"))
(defun term-char-mode ()
"Switch to char (\"raw\") sub-mode of term mode.
@@ -1543,9 +1558,12 @@ Nil if unknown.")
(format term-termcap-format "TERMCAP="
term-term-name term-height term-width)
- (format "INSIDE_EMACS=%s,term:%s" emacs-version term-protocol-version)
- (format "LINES=%d" term-height)
- (format "COLUMNS=%d" term-width))
+ (format "INSIDE_EMACS=%s,term:%s"
+ emacs-version term-protocol-version))
+ (when term-set-terminal-size
+ (list
+ (format "LINES=%d" term-height)
+ (format "COLUMNS=%d" term-width)))
process-environment))
(process-connection-type t)
;; We should suppress conversion of end-of-line format.
@@ -2796,12 +2814,12 @@ See `term-prompt-regexp'."
"\\(?:[\r\n\000\007\t\b\016\017]\\|"
;; some Emacs specific control sequences, implemented by
;; `term-command-hook',
- "\032[^\n]+\r?\n\\|"
+ "\032[^\n]+\n\\|"
;; a C1 escape coded character (see [ECMA-48] section 5.3 "Elements
;; of the C1 set"),
"\e\\(?:[DM78c]\\|"
;; another Emacs specific control sequence,
- "AnSiT[^\n]+\r?\n\\|"
+ "AnSiT[^\n]+\n\\|"
;; or an escape sequence (section 5.4 "Control Sequences"),
"\\[\\([\x30-\x3F]*\\)[\x20-\x2F]*[\x40-\x7E]\\)\\)")
"Regexp matching control sequences handled by term.el.")
@@ -3108,15 +3126,19 @@ See `term-prompt-regexp'."
(or (eq scroll 'this) (not save-point)))
(and (eq scroll 'others)
(not (eq selected win))))
- (goto-char term-home-marker)
- (recenter 0)
+ (when term-scroll-snap-to-bottom
+ (goto-char term-home-marker)
+ (recenter 0))
(goto-char (process-mark proc))
(if (not (pos-visible-in-window-p (point) win))
(recenter -1)))
;; Optionally scroll so that the text
;; ends at the bottom of the window.
(when (and term-scroll-show-maximum-output
- (>= (point) (process-mark proc)))
+ (>= (point) (process-mark proc))
+ (or term-scroll-snap-to-bottom
+ (not (pos-visible-in-window-p
+ (point-max) win))))
(save-excursion
(goto-char (point-max))
(recenter -1)))))
@@ -3618,8 +3640,8 @@ The top-most line is line 0."
(message "Terminal-emulator pager break help...")
(sit-for 0)
(with-electric-help
- (function (lambda ()
- (princ (substitute-command-keys
+ (lambda ()
+ (princ (substitute-command-keys
"\\<term-pager-break-map>\
Terminal-emulator MORE break.\n\
Type one of the following keys:\n\n\
@@ -3637,7 +3659,7 @@ Type one of the following keys:\n\n\
Any other key is passed through to the program
running under the terminal emulator and disables pager processing until
all pending output has been dealt with."))
- nil))))
+ nil)))
(defun term-pager-continue (new-count)
(let ((process (get-buffer-process (current-buffer))))
@@ -4090,53 +4112,6 @@ see `expand-file-name' and `substitute-in-file-name'. For completion see
(term-dynamic-complete-filename))
-(defun term-dynamic-simple-complete (stub candidates)
- "Dynamically complete STUB from CANDIDATES list.
-This function inserts completion characters at point by completing STUB from
-the strings in CANDIDATES. A completions listing may be shown in a help buffer
-if completion is ambiguous.
-
-Returns nil if no completion was inserted.
-Returns `sole' if completed with the only completion match.
-Returns `shortest' if completed with the shortest of the completion matches.
-Returns `partial' if completed as far as possible with the completion matches.
-Returns `listed' if a completion listing was shown.
-
-See also `term-dynamic-complete-filename'."
- (declare (obsolete completion-in-region "23.2"))
- (let* ((completion-ignore-case nil)
- (completions (all-completions stub candidates)))
- (cond ((null completions)
- (message "No completions of %s" stub)
- nil)
- ((= 1 (length completions)) ; Gotcha!
- (let ((completion (car completions)))
- (if (string-equal completion stub)
- (message "Sole completion")
- (insert (substring completion (length stub)))
- (message "Completed"))
- (when term-completion-addsuffix (insert " "))
- 'sole))
- (t ; There's no unique completion.
- (let ((completion (try-completion stub candidates)))
- ;; Insert the longest substring.
- (insert (substring completion (length stub)))
- (cond ((and term-completion-recexact term-completion-addsuffix
- (string-equal stub completion)
- (member completion completions))
- ;; It's not unique, but user wants shortest match.
- (insert " ")
- (message "Completed shortest")
- 'shortest)
- ((or term-completion-autolist
- (string-equal stub completion))
- ;; It's not unique, list possible completions.
- (term-dynamic-list-completions completions)
- 'listed)
- (t
- (message "Partially completed")
- 'partial)))))))
-
(defun term-dynamic-list-filename-completions ()
"List in help buffer possible completions of the filename at point."
(interactive)
@@ -4166,7 +4141,7 @@ Typing SPC flushes the help buffer."
(eq (window-buffer (posn-window (event-start first)))
(get-buffer "*Completions*"))
(memq (key-binding key)
- '(mouse-choose-completion choose-completion))))
+ '(choose-completion))))
;; If the user does choose-completion with the mouse,
;; execute the command, then delete the completion window.
(progn
@@ -4305,8 +4280,7 @@ well as the newer ports COM10 and higher."
;; `prompt': The most recently used port is provided as
;; the default value, which is used when the user
;; simply presses return.
- (if (stringp h) (format "Serial port (default %s): " h)
- "Serial port: ")
+ (format-prompt "Serial port" h)
;; `directory': Most systems have their serial ports
;; in the same directory, so start in the directory
;; of the most recently used port, or in a reasonable
@@ -4321,8 +4295,7 @@ well as the newer ports COM10 and higher."
;; serial port.
"")
(read-from-minibuffer
- (if (stringp h) (format "Serial port (default %s): " h)
- "Serial port: ")
+ (format-prompt "Serial port" h)
nil nil nil '(file-name-history . 1) nil nil))))
(if (or (null x) (and (stringp x) (zerop (length x))))
(setq x h)
@@ -4344,7 +4317,7 @@ Try to be nice by providing useful defaults and history."
(cond ((string= h serial-no-speed)
"Speed (default nil = set by port): ")
(h
- (format "Speed (default %s b/s): " h))
+ (format-prompt "Speed" (format "%s b/s" h)))
(t
(format "Speed (b/s): ")))
nil nil nil '(history . 1) nil nil)))
diff --git a/lisp/term/bobcat.el b/lisp/term/bobcat.el
index a32da6ae8f2..983c8cded2f 100644
--- a/lisp/term/bobcat.el
+++ b/lisp/term/bobcat.el
@@ -1,3 +1,4 @@
+;;; bobcat.el -*- lexical-binding:t -*-
(defun terminal-init-bobcat ()
"Terminal initialization function for bobcat."
diff --git a/lisp/term/cygwin.el b/lisp/term/cygwin.el
index edc64b4404d..8f0d751cf29 100644
--- a/lisp/term/cygwin.el
+++ b/lisp/term/cygwin.el
@@ -1,4 +1,4 @@
-;;; cygwin.el --- support for the Cygwin terminal
+;;; cygwin.el --- support for the Cygwin terminal -*- lexical-binding:t -*-
;;; The Cygwin terminal can't really display underlines.
diff --git a/lisp/term/internal.el b/lisp/term/internal.el
index 5e22c0f6afe..c54481a5327 100644
--- a/lisp/term/internal.el
+++ b/lisp/term/internal.el
@@ -400,9 +400,9 @@ If TABLE is nil or omitted, `standard-display-table' is used."
;; The following alist was compiled from:
;;
;; Ralf Brown's Interrupt List. file INTERRUP.F, D-2138, Table 01400
-;; http://www.ethnologue.com/country_index.asp (official languages)
-;; http://unicode.org/onlinedat/languages.html
-;; http://unicode.org/onlinedat/countries.html
+;; https://www.ethnologue.com/country_index.asp (official languages)
+;; https://unicode.org/onlinedat/languages.html
+;; https://unicode.org/onlinedat/countries.html
;;
;; Only the official languages listed for each country.
;;
diff --git a/lisp/term/konsole.el b/lisp/term/konsole.el
index 8b2e7e1d5f8..4af818b4a63 100644
--- a/lisp/term/konsole.el
+++ b/lisp/term/konsole.el
@@ -1,4 +1,4 @@
-;;; konsole.el --- terminal initialization for konsole
+;;; konsole.el --- terminal initialization for konsole -*- lexical-binding:t -*-
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
(require 'term/xterm)
diff --git a/lisp/term/linux.el b/lisp/term/linux.el
index 70730dc5844..35bd3ac0acb 100644
--- a/lisp/term/linux.el
+++ b/lisp/term/linux.el
@@ -1,4 +1,4 @@
-;; The Linux console handles Latin-1 by default.
+;; The Linux console handles Latin-1 by default. -*- lexical-binding:t -*-
(declare-function gpm-mouse-enable "t-mouse" ())
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 90024b001f7..dd0a986572d 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -314,10 +314,9 @@ The overlay is assigned the face `ns-working-text-face'."
(interactive)
(ns-delete-working-text)
(let ((start (point)))
- (insert ns-working-text)
- (overlay-put (setq ns-working-overlay (make-overlay start (point)
- (current-buffer) nil t))
- 'face 'ns-working-text-face)))
+ (overlay-put (setq ns-working-overlay (make-overlay start (point)))
+ 'after-string
+ (propertize ns-working-text 'face 'ns-working-text-face))))
(defun ns-echo-working-text ()
"Echo contents of `ns-working-text' in message display area.
@@ -340,8 +339,7 @@ See `ns-insert-working-text'."
;; Still alive?
(overlay-buffer ns-working-overlay))
(with-current-buffer (overlay-buffer ns-working-overlay)
- (delete-region (overlay-start ns-working-overlay)
- (overlay-end ns-working-overlay))
+ (overlay-put ns-working-overlay 'after-string nil)
(delete-overlay ns-working-overlay)))
((integerp ns-working-overlay)
(let ((msg (current-message))
@@ -634,15 +632,21 @@ This function has been overloaded in Nextstep.")
(defvar ns-input-fontsize)
(defun ns-respond-to-change-font ()
- "Respond to changeFont: event, expecting `ns-input-font' and\n\
-`ns-input-fontsize' of new font."
+ "Set the font chosen in the font-picker panel.
+Respond to changeFont: event, expecting ns-input-font and
+ns-input-fontsize of new font."
(interactive)
- (modify-frame-parameters (selected-frame)
- (list (cons 'fontsize ns-input-fontsize)))
- (modify-frame-parameters (selected-frame)
- (list (cons 'font ns-input-font)))
- (set-frame-font ns-input-font))
-
+ (let ((face 'default))
+ (set-face-attribute face t
+ :family ns-input-font
+ :height (* 10 ns-input-fontsize))
+ (set-face-attribute face (selected-frame)
+ :family ns-input-font
+ :height (* 10 ns-input-fontsize))
+ (let ((spec (list (list t (face-attr-construct 'default)))))
+ (put face 'customized-face spec)
+ (custom-push-theme 'theme-face face 'user 'set spec)
+ (put face 'face-modified nil))))
;; Default fontset for macOS. This is mainly here to show how a fontset
;; can be set up manually. Ordinarily, fontsets are auto-created whenever
diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el
index ca6c468f525..31e3d6ede4f 100644
--- a/lisp/term/rxvt.el
+++ b/lisp/term/rxvt.el
@@ -26,6 +26,16 @@
(require 'term/xterm)
+(defgroup rxvt nil
+ "(U)RXVT support."
+ :version "28.1"
+ :group 'terminals)
+
+(defcustom rxvt-set-window-title nil
+ "Whether Emacs should set window titles to an Emacs frame in RXVT."
+ :version "28.1"
+ :type 'boolean)
+
(defvar rxvt-function-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map xterm-rxvt-function-map)
@@ -171,7 +181,16 @@
(xterm-register-default-colors rxvt-standard-colors)
(rxvt-set-background-mode)
;; This recomputes all the default faces given the colors we've just set up.
- (tty-set-up-initial-frame-faces))
+ (tty-set-up-initial-frame-faces)
+
+ ;; Unconditionally enable bracketed paste mode: terminals that don't
+ ;; support it just ignore the sequence.
+ (xterm--init-bracketed-paste-mode)
+
+ (when rxvt-set-window-title
+ (xterm--init-frame-title))
+
+ (run-hooks 'terminal-init-rxvt-hook))
;; rxvt puts the default colors into an environment variable
;; COLORFGBG. We use this to set the background mode in a more
diff --git a/lisp/term/st.el b/lisp/term/st.el
new file mode 100644
index 00000000000..617664bb263
--- /dev/null
+++ b/lisp/term/st.el
@@ -0,0 +1,20 @@
+;;; st.el --- terminal initialization for st -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;;; Commentary:
+
+;; Support for the st terminal emulator.
+;; https://st.suckless.org/
+
+;;; Code:
+
+(require 'term/xterm)
+
+(defun terminal-init-st ()
+ "Terminal initialization function for st."
+ (tty-run-terminal-initialization (selected-frame) "xterm"))
+
+(provide 'term/st)
+
+;; st.el ends here
diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el
index 39ca2d36276..dda7fcc3691 100644
--- a/lisp/term/tty-colors.el
+++ b/lisp/term/tty-colors.el
@@ -923,62 +923,8 @@ The returned value reflects the standard Emacs definition of
COLOR (see the info node `(emacs) Colors'), regardless of whether
the terminal can display it, so the return value should be the
same regardless of what display is being used."
- (let ((len (length color)))
- (cond ((and (>= len 4) ;; HTML/CSS/SVG-style "#XXYYZZ" color spec
- (eq (aref color 0) ?#)
- (member (aref color 1)
- '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
- ?a ?b ?c ?d ?e ?f
- ?A ?B ?C ?D ?E ?F)))
- ;; Translate the string "#XXYYZZ" into a list of numbers
- ;; (XX YY ZZ), scaling each to the {0..65535} range. This
- ;; follows the HTML color convention, where both "#fff" and
- ;; "#ffffff" represent the same color, white.
- (let* ((ndig (/ (- len 1) 3))
- (maxval (1- (ash 1 (* 4 ndig))))
- (i1 1)
- (i2 (+ i1 ndig))
- (i3 (+ i2 ndig))
- (i4 (+ i3 ndig)))
- (list
- (/ (* (string-to-number
- (substring color i1 i2) 16)
- 65535)
- maxval)
- (/ (* (string-to-number
- (substring color i2 i3) 16)
- 65535)
- maxval)
- (/ (* (string-to-number
- (substring color i3 i4) 16)
- 65535)
- maxval))))
- ((and (>= len 9) ;; X-style rgb:xx/yy/zz color spec
- (string= (substring color 0 4) "rgb:"))
- ;; Translate the string "rgb:XX/YY/ZZ" into a list of
- ;; numbers (XX YY ZZ), scaling each to the {0..65535}
- ;; range. "rgb:F/F/F" is white.
- (let* ((ndig (/ (- len 3) 3))
- (maxval (1- (ash 1 (* 4 (- ndig 1)))))
- (i1 4)
- (i2 (+ i1 ndig))
- (i3 (+ i2 ndig))
- (i4 (+ i3 ndig)))
- (list
- (/ (* (string-to-number
- (substring color i1 (- i2 1)) 16)
- 65535)
- maxval)
- (/ (* (string-to-number
- (substring color i2 (- i3 1)) 16)
- 65535)
- maxval)
- (/ (* (string-to-number
- (substring color i3 (1- i4)) 16)
- 65535)
- maxval))))
- (t
- (cdr (assoc color color-name-rgb-alist))))))
+ (or (color-values-from-color-spec color)
+ (cdr (assoc color color-name-rgb-alist))))
(defun tty-color-translate (color &optional frame)
"Given a color COLOR, return the index of the corresponding TTY color.
diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el
index 7ddbe38a287..2df14145231 100644
--- a/lisp/term/vt100.el
+++ b/lisp/term/vt100.el
@@ -1,4 +1,4 @@
-;;; vt100.el --- define VT100 function key sequences in function-key-map
+;;; vt100.el --- define VT100 function key sequences in function-key-map -*- lexical-binding:t -*-
;; Copyright (C) 1989, 1993, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/term/vt200.el b/lisp/term/vt200.el
index dde2e229068..569b79e25a1 100644
--- a/lisp/term/vt200.el
+++ b/lisp/term/vt200.el
@@ -1,3 +1,5 @@
+;;; vt200.el -*- lexical-binding:t -*-
+
;; For our purposes we can treat the vt200 and vt100 almost alike.
;; Most differences are handled by the termcap entry.
(defun terminal-init-vt200 ()
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index 3e932c7593d..e866fdc36ce 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -78,12 +78,8 @@
(require 'dnd)
(require 'w32-vars)
-;; Keep an obsolete alias for w32-focus-frame and w32-select-font in case
-;; they are used by code outside Emacs.
-(define-obsolete-function-alias 'w32-focus-frame 'x-focus-frame "23.1")
(declare-function x-select-font "w32font.c"
(&optional frame exclude-proportional))
-(define-obsolete-function-alias 'w32-select-font 'x-select-font "23.1")
(defvar w32-color-map) ;; defined in w32fns.c
(make-obsolete 'w32-default-color-map nil "24.1")
@@ -231,6 +227,8 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;;; Set default known names for external libraries
(setq dynamic-library-alist
(list
+ '(gdiplus "gdiplus.dll")
+ '(shlwapi "shlwapi.dll")
'(xpm "libxpm.dll" "xpm4.dll" "libXpm-nox4.dll")
;; Versions of libpng 1.4.x and later are incompatible with
;; earlier versions. Set up the list of libraries according to
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 5b8feb14a5e..42a6f4030e5 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -1407,13 +1407,13 @@ This returns an error if any Emacs frames are X frames."
("etc/images/right-arrow" . ("go-next" "gtk-go-forward"))
("etc/images/home" . ("go-home" "gtk-home"))
("etc/images/jump-to" . ("go-jump" "gtk-jump-to"))
- ("etc/images/index" . "gtk-index")
+ ("etc/images/index" . ("gtk-search" "gtk-index"))
("etc/images/exit" . ("application-exit" "gtk-quit"))
("etc/images/cancel" . "gtk-cancel")
("etc/images/info" . ("dialog-information" "gtk-info"))
("etc/images/bookmark_add" . "n:bookmark_add")
;; Used in Gnus and/or MH-E:
- ("etc/images/attach" . "gtk-attach")
+ ("etc/images/attach" . ("mail-attachment" "gtk-attach"))
("etc/images/connect" . "gtk-connect")
("etc/images/contact" . "gtk-contact")
("etc/images/delete" . ("edit-delete" "gtk-delete"))
@@ -1425,14 +1425,16 @@ This returns an error if any Emacs frames are X frames."
("etc/images/lock" . "gtk-lock")
("etc/images/next-page" . "gtk-next-page")
("etc/images/refresh" . ("view-refresh" "gtk-refresh"))
+ ("etc/images/search-replace" . "edit-find-replace")
("etc/images/sort-ascending" . ("view-sort-ascending" "gtk-sort-ascending"))
("etc/images/sort-column-ascending" . "gtk-sort-column-ascending")
("etc/images/sort-criteria" . "gtk-sort-criteria")
("etc/images/sort-descending" . ("view-sort-descending"
"gtk-sort-descending"))
("etc/images/sort-row-ascending" . "gtk-sort-row-ascending")
+ ("etc/images/spell" . ("tools-check-spelling" "gtk-spell-check"))
("images/gnus/toggle-subscription" . "gtk-task-recurring")
- ("images/mail/compose" . "gtk-mail-compose")
+ ("images/mail/compose" . ("mail-message-new" "gtk-mail-compose"))
("images/mail/copy" . "gtk-mail-copy")
("images/mail/forward" . "gtk-mail-forward")
("images/mail/inbox" . "gtk-inbox")
@@ -1442,7 +1444,7 @@ This returns an error if any Emacs frames are X frames."
("images/mail/reply-all" . "gtk-mail-reply-to-all")
("images/mail/reply" . "gtk-mail-reply")
("images/mail/save-draft" . "gtk-mail-handling")
- ("images/mail/send" . "gtk-mail-send")
+ ("images/mail/send" . ("mail-send" "gtk-mail-send"))
("images/mail/spam" . "gtk-spam")
;; Used for GDB Graphical Interface
("images/gud/break" . "gtk-no")
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index eb07bb4d910..80682883c85 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -115,8 +115,6 @@
;;; Requirements:
-;; Artist requires Emacs 19.28 or higher.
-;;
;; Artist requires the `rect' package (which comes with Emacs) to be
;; loadable, unless the variable `artist-interface-with-rect' is set
;; to nil.
@@ -127,9 +125,6 @@
;;; Known bugs:
-;; The shifted operations are not available when drawing with the mouse
-;; in Emacs 19.29 and 19.30.
-;;
;; It is not possible to change between shifted and unshifted operation
;; while drawing with the mouse. (See the comment in the function
;; artist-shift-has-changed for further details.)
@@ -1999,25 +1994,11 @@ The replacement is used to convert tabs and new-lines to spaces."
(defun artist-replace-chars (new-char count)
"Replace characters at point with NEW-CHAR. COUNT chars are replaced."
- ;; Check that the variable exists first. The doc says it was added in 19.23.
- (if (and (and (boundp 'emacs-major-version) (= emacs-major-version 20))
- (and (boundp 'emacs-minor-version) (<= emacs-minor-version 3)))
- ;; This is a bug workaround for Emacs 20, versions up to 20.3:
- ;; The self-insert-command doesn't care about the overwrite-mode,
- ;; so the insertion is done in the same way as in picture mode.
- ;; This seems to be a little bit slower.
- (let* ((replaced-c (artist-get-replacement-char new-char))
- (replaced-s (make-string count replaced-c)))
- (artist-move-to-xy (+ (artist-current-column) count)
- (artist-current-line))
- (delete-char (- count))
- (insert replaced-s))
- ;; In emacs-19, the self-insert-command works better
- (let ((overwrite-mode 'overwrite-mode-textual)
- (fill-column 32765) ; Large :-)
- (blink-matching-paren nil))
- (setq last-command-event (artist-get-replacement-char new-char))
- (self-insert-command count))))
+ (let ((overwrite-mode 'overwrite-mode-textual)
+ (fill-column 32765) ; Large :-)
+ (blink-matching-paren nil))
+ (setq last-command-event (artist-get-replacement-char new-char))
+ (self-insert-command count)))
(defsubst artist-replace-string (string &optional see-thru)
"Replace contents at point with STRING.
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 670e763814c..910bd7dbb9d 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -440,7 +440,7 @@ If parsing fails, try to set this variable to nil."
"Alist of BibTeX entry types and their associated fields.
Elements are lists (ENTRY-TYPE DOC REQUIRED CROSSREF OPTIONAL).
ENTRY-TYPE is the type of a BibTeX entry.
-DOC is a brief doc string used for menus. If nil ENTRY-TYPE is used.
+DOC is a brief doc string used for menus. If nil ENTRY-TYPE is used.
REQUIRED is a list of required fields.
CROSSREF is a list of fields that are optional if a crossref field
is present; but these fields are required otherwise.
@@ -850,11 +850,11 @@ Predefined dialects include BibTeX and biblatex."
To interactively change the dialect use the command `bibtex-set-dialect'."
:group 'bibtex
:version "24.1"
- :set '(lambda (symbol value)
- (set-default symbol value)
- ;; `bibtex-set-dialect' is undefined during loading (no problem)
- (if (fboundp 'bibtex-set-dialect)
- (bibtex-set-dialect value)))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ ;; `bibtex-set-dialect' is undefined during loading (no problem).
+ (if (fboundp 'bibtex-set-dialect)
+ (bibtex-set-dialect value)))
:type '(choice (const BibTeX)
(const biblatex)
(symbol :tag "Custom")))
@@ -1051,7 +1051,7 @@ See `bibtex-generate-autokey' for details."
(defvaralias 'bibtex-autokey-name-case-convert
'bibtex-autokey-name-case-convert-function)
-(defcustom bibtex-autokey-name-case-convert-function 'downcase
+(defcustom bibtex-autokey-name-case-convert-function #'downcase
"Function called for each name to perform case conversion.
See `bibtex-generate-autokey' for details."
:group 'bibtex-autokey
@@ -1127,7 +1127,7 @@ Case is significant. See `bibtex-generate-autokey' for details."
(defvaralias 'bibtex-autokey-titleword-case-convert
'bibtex-autokey-titleword-case-convert-function)
-(defcustom bibtex-autokey-titleword-case-convert-function 'downcase
+(defcustom bibtex-autokey-titleword-case-convert-function #'downcase
"Function called for each titleword to perform case conversion.
See `bibtex-generate-autokey' for details."
:group 'bibtex-autokey
@@ -1188,12 +1188,13 @@ See `bibtex-generate-autokey' for details."
:group 'bibtex-autokey
:type 'boolean)
-(defcustom bibtex-autokey-before-presentation-function nil
- "If non-nil, function to call before generated key is presented.
+(defcustom bibtex-autokey-before-presentation-function #'identity
+ "Function to call before generated key is presented.
The function must take one argument (the automatically generated key),
and must return a string (the key to use)."
:group 'bibtex-autokey
- :type '(choice (const nil) function))
+ :version "28.1"
+ :type 'function)
(defcustom bibtex-entry-offset 0
"Offset for BibTeX entries.
@@ -1242,7 +1243,7 @@ If non-nil, the column for the equal sign is the value of
:group 'bibtex
:type '(repeat string))
-(defcustom bibtex-summary-function 'bibtex-summary
+(defcustom bibtex-summary-function #'bibtex-summary
"Function to call for generating a summary of current BibTeX entry.
It takes no arguments. Point must be at beginning of entry.
Used by `bibtex-complete-crossref-cleanup' and `bibtex-copy-summary-as-kill'."
@@ -1660,7 +1661,7 @@ Initialized by `bibtex-set-dialect'.")
(defvar bibtex-font-lock-url-regexp
;; Assume that field names begin at the beginning of a line.
(concat "^[ \t]*"
- (regexp-opt (delete-dups (mapcar 'caar bibtex-generate-url-list)) t)
+ (regexp-opt (delete-dups (mapcar #'caar bibtex-generate-url-list)) t)
"[ \t]*=[ \t]*")
"Regexp for `bibtex-font-lock-url' derived from `bibtex-generate-url-list'.")
@@ -1892,14 +1893,16 @@ If `bibtex-expand-strings' is non-nil, also expand BibTeX strings."
(let ((mtch (match-string-no-properties 0)))
(push (or (if bibtex-expand-strings
(cdr (assoc-string mtch (bibtex-strings) t)))
- mtch) content)
+ mtch)
+ content)
(goto-char (match-end 0)))
(let ((bounds (bibtex-parse-field-string)))
(push (buffer-substring-no-properties
- (1+ (car bounds)) (1- (cdr bounds))) content)
+ (1+ (car bounds)) (1- (cdr bounds)))
+ content)
(goto-char (cdr bounds))))
(re-search-forward "\\=[ \t\n]*#[ \t\n]*" nil t))
- (apply 'concat (nreverse content))))
+ (apply #'concat (nreverse content))))
(buffer-substring-no-properties (bibtex-start-of-text-in-field bounds)
(bibtex-end-of-text-in-field bounds))))
@@ -2239,8 +2242,9 @@ Optional arg BEG is beginning of entry."
Optional arg COMMA is as in `bibtex-enclosing-field'."
(unless bibtex-last-kill-command (error "BibTeX kill ring is empty"))
(let ((fun (lambda (kryp kr) ; adapted from `current-kill'
- (car (set kryp (nthcdr (mod (- n (length (eval kryp)))
- (length kr)) kr))))))
+ (car (set kryp (nthcdr (mod (- n (length (symbol-value kryp)))
+ (length kr))
+ kr))))))
;; We put the mark at the beginning of the inserted field or entry
;; and point at its end - a behavior similar to what `yank' does.
;; The mark is then used by `bibtex-yank-pop', which needs to know
@@ -2251,7 +2255,8 @@ Optional arg COMMA is as in `bibtex-enclosing-field'."
(goto-char (bibtex-end-of-field (bibtex-enclosing-field comma)))
(push-mark)
(bibtex-make-field (funcall fun 'bibtex-field-kill-ring-yank-pointer
- bibtex-field-kill-ring) t nil t))
+ bibtex-field-kill-ring)
+ t nil t))
;; insert past the current entry
(bibtex-skip-to-valid-entry)
(push-mark)
@@ -2615,7 +2620,7 @@ Return optimized value to be used by `bibtex-format-entry'."
regexp-alist))
(let (opt-list)
;; Loop over field names
- (dolist (field (delete-dups (apply 'append (mapcar 'car regexp-alist))))
+ (dolist (field (delete-dups (apply #'append (mapcar #'car regexp-alist))))
(let (rules)
;; Collect all matches we have for this field name
(dolist (e regexp-alist)
@@ -2623,7 +2628,7 @@ Return optimized value to be used by `bibtex-format-entry'."
(push (cons (nth 1 e) (nth 2 e)) rules)))
(if (eq type 'braces)
;; concatenate all regexps to a single regexp
- (setq rules (concat "\\(?:" (mapconcat 'car rules "\\|") "\\)")))
+ (setq rules (concat "\\(?:" (mapconcat #'car rules "\\|") "\\)")))
;; create list of replacement rules.
(push (cons field rules) opt-list)))
opt-list))
@@ -2674,7 +2679,7 @@ and `bibtex-autokey-names-stretch'."
(if (string= "" names)
names
(let* ((case-fold-search t)
- (name-list (mapcar 'bibtex-autokey-demangle-name
+ (name-list (mapcar #'bibtex-autokey-demangle-name
(split-string names "[ \t\n]+and[ \t\n]+")))
additional-names)
(unless (or (not (numberp bibtex-autokey-names))
@@ -2686,7 +2691,7 @@ and `bibtex-autokey-names-stretch'."
bibtex-autokey-names)
(nreverse name-list)))
additional-names bibtex-autokey-additional-names))
- (concat (mapconcat 'identity name-list
+ (concat (mapconcat #'identity name-list
bibtex-autokey-name-separator)
additional-names)))))
@@ -2736,7 +2741,7 @@ Return the result as a string."
;; specific words and use only a specific amount of words.
(let ((counter 0)
(ignore-re (concat "\\`\\(?:"
- (mapconcat 'identity
+ (mapconcat #'identity
bibtex-autokey-titleword-ignore "\\|")
"\\)\\'"))
titlewords titlewords-extra word)
@@ -2760,7 +2765,7 @@ Return the result as a string."
;; titlewords-extra in titlewords. Otherwise, we ignore titlewords-extra.
(unless (string-match "\\b\\w+" titlestring)
(setq titlewords (append titlewords-extra titlewords)))
- (mapconcat 'bibtex-autokey-demangle-title (nreverse titlewords)
+ (mapconcat #'bibtex-autokey-demangle-title (nreverse titlewords)
bibtex-autokey-titleword-separator))))
(defun bibtex-autokey-demangle-title (titleword)
@@ -2837,7 +2842,7 @@ Concatenate the key:
non-empty insert `bibtex-autokey-name-year-separator' between the two.
If the title part and the year (or name) part are non-empty, insert
`bibtex-autokey-year-title-separator' between the two.
- 2. If `bibtex-autokey-before-presentation-function' is non-nil, it must be
+ 2. `bibtex-autokey-before-presentation-function' must be
a function taking one argument. Call this function with the generated
key as the argument. Use the return value of this function (a string)
as the key.
@@ -2865,7 +2870,7 @@ Concatenate the key:
(defun bibtex-global-key-alist ()
"Return global key alist based on `bibtex-files'."
(if bibtex-files
- (apply 'append
+ (apply #'append
(mapcar (lambda (buf)
(with-current-buffer buf bibtex-reference-keys))
;; include current buffer only if it uses `bibtex-mode'
@@ -3129,7 +3134,7 @@ does not use `bibtex-mode'."
(if buffer-list
(switch-to-buffer
(completing-read "Switch to BibTeX buffer: "
- (mapcar 'buffer-name buffer-list)
+ (mapcar #'buffer-name buffer-list)
nil t
(if current (buffer-name (current-buffer)))))
(message "No BibTeX buffers defined")))
@@ -3178,7 +3183,7 @@ that is generated by calling `bibtex-url'."
Used as default value of `bibtex-summary-function'."
;; It would be neat to make this function customizable. How?
(if (looking-at bibtex-entry-maybe-empty-head)
- (let* ((bibtex-autokey-name-case-convert-function 'identity)
+ (let* ((bibtex-autokey-name-case-convert-function #'identity)
(bibtex-autokey-name-length 'infty)
(bibtex-autokey-names 1)
(bibtex-autokey-names-stretch 0)
@@ -3189,7 +3194,7 @@ Used as default value of `bibtex-summary-function'."
(year (bibtex-autokey-get-year))
(bibtex-autokey-titlewords 5)
(bibtex-autokey-titlewords-stretch 2)
- (bibtex-autokey-titleword-case-convert-function 'identity)
+ (bibtex-autokey-titleword-case-convert-function #'identity)
(bibtex-autokey-titleword-length 5)
(bibtex-autokey-titleword-separator " ")
(title (bibtex-autokey-get-title))
@@ -3336,12 +3341,12 @@ BOUND limits the search."
(define-button-type 'bibtex-url
'action 'bibtex-button-action
- 'bibtex-function 'bibtex-url
+ 'bibtex-function #'bibtex-url
'help-echo (purecopy "mouse-2, RET: follow URL"))
(define-button-type 'bibtex-search-crossref
'action 'bibtex-button-action
- 'bibtex-function 'bibtex-search-crossref
+ 'bibtex-function #'bibtex-search-crossref
'help-echo (purecopy "mouse-2, RET: follow crossref"))
(defun bibtex-button (beg end type &rest args)
@@ -3405,7 +3410,7 @@ if that value is non-nil.
\\{bibtex-mode-map}"
(add-hook 'completion-at-point-functions
- 'bibtex-completion-at-point-function nil 'local)
+ #'bibtex-completion-at-point-function nil 'local)
(make-local-variable 'bibtex-buffer-last-parsed-tick)
;; Install stealthy parse function if not already installed
(unless bibtex-parse-idle-timer
@@ -3419,7 +3424,7 @@ if that value is non-nil.
(set (make-local-variable 'comment-column) 0)
(set (make-local-variable 'defun-prompt-regexp) "^[ \t]*@[[:alnum:]]+[ \t]*")
(set (make-local-variable 'outline-regexp) "[ \t]*@")
- (set (make-local-variable 'fill-paragraph-function) 'bibtex-fill-field)
+ (set (make-local-variable 'fill-paragraph-function) #'bibtex-fill-field)
(set (make-local-variable 'fill-prefix)
(make-string (+ bibtex-entry-offset bibtex-contline-indentation) ?\s))
(set (make-local-variable 'font-lock-defaults)
@@ -3440,8 +3445,9 @@ if that value is non-nil.
(set (make-local-variable 'syntax-propertize-function)
(syntax-propertize-via-font-lock
bibtex-font-lock-syntactic-keywords))
+ (bibtex-set-dialect nil t)
;; Allow `bibtex-dialect' as a file-local variable.
- (add-hook 'hack-local-variables-hook 'bibtex-set-dialect nil t))
+ (add-hook 'hack-local-variables-hook #'bibtex-set-dialect nil t))
(defun bibtex-entry-alist (dialect)
"Return entry-alist for DIALECT."
@@ -3488,8 +3494,9 @@ are also bound buffer-locally if `bibtex-dialect' is already buffer-local
in the current buffer (for example, as a file-local variable).
LOCAL is t for interactive calls."
(interactive (list (intern (completing-read "Dialect: "
- (mapcar 'list bibtex-dialect-list)
- nil t)) t))
+ (mapcar #'list bibtex-dialect-list)
+ nil t))
+ t))
(let ((setfun (if (or local (local-variable-p 'bibtex-dialect))
(lambda (var val) (set (make-local-variable var) val))
'set)))
@@ -3506,7 +3513,7 @@ LOCAL is t for interactive calls."
bibtex-dialect))))
(funcall setfun 'bibtex-entry-type
(concat "@[ \t]*\\(?:"
- (regexp-opt (mapcar 'car bibtex-entry-alist)) "\\)"))
+ (regexp-opt (mapcar #'car bibtex-entry-alist)) "\\)"))
(funcall setfun 'bibtex-entry-head
(concat "^[ \t]*\\(" bibtex-entry-type "\\)[ \t]*[({][ \t\n]*\\("
bibtex-reference-key "\\)"))
@@ -3516,7 +3523,7 @@ LOCAL is t for interactive calls."
(concat "^[ \t]*@[ \t]*\\(?:"
(regexp-opt
(append '("String" "Preamble")
- (mapcar 'car bibtex-entry-alist))) "\\)"))
+ (mapcar #'car bibtex-entry-alist))) "\\)"))
(setq imenu-generic-expression
(list (list nil bibtex-entry-head bibtex-key-in-head))
imenu-case-fold-search t)))
@@ -3549,11 +3556,13 @@ LOCAL is t for interactive calls."
(let* ((entry (car elt))
(fname (intern (format "bibtex-%s" entry))))
(unless (fboundp fname)
- (eval (list 'defun fname nil
- (format "Insert a template for a @%s entry; see also `bibtex-entry'."
- entry)
- '(interactive "*")
- `(bibtex-entry ,entry))))
+ (defalias fname
+ (lambda ()
+ (:documentation
+ (format "Insert a template for a @%s entry; see also `bibtex-entry'."
+ entry))
+ (interactive "*")
+ (bibtex-entry entry))))
;; Menu entries
(define-key menu-map (vector fname)
`(menu-item ,(or (nth 1 elt) (car elt)) ,fname))))
@@ -3608,8 +3617,8 @@ is non-nil."
(insert "@" entry-type (bibtex-entry-left-delimiter))
(if key (insert key))
(save-excursion
- (mapc 'bibtex-make-field (car field-list))
- (mapc 'bibtex-make-optional-field (cdr field-list))
+ (mapc #'bibtex-make-field (car field-list))
+ (mapc #'bibtex-make-optional-field (cdr field-list))
(if bibtex-comma-after-last-field
(insert ","))
(insert "\n")
@@ -3657,8 +3666,8 @@ When called interactively with a prefix arg, query for a value of ENTRY-TYPE."
(insert (bibtex-field-left-delimiter)))
(goto-char end)))
(skip-chars-backward " \t\n")
- (mapc 'bibtex-make-field required)
- (mapc 'bibtex-make-optional-field optional)))))
+ (mapc #'bibtex-make-field required)
+ (mapc #'bibtex-make-optional-field optional)))))
(defun bibtex-parse-entry (&optional content keep-opt-alt)
"Parse entry at point, return an alist.
@@ -4980,7 +4989,8 @@ If mark is active reformat entries in region, if not in whole buffer."
("Remove empty optional and alternative fields? " . opts-or-alts)
("Remove delimiters around pure numerical fields? " . numerical-fields)
(,(concat (if bibtex-comma-after-last-field "Insert" "Remove")
- " comma at end of entry? ") . last-comma)
+ " comma at end of entry? ")
+ . last-comma)
("Replace double page dashes by single ones? " . page-dashes)
("Delete whitespace at the beginning and end of fields? " . whitespace)
("Inherit booktitle? " . inherit-booktitle)
@@ -5047,7 +5057,7 @@ entries from minibuffer."
(goto-char (point-max))
(message "Buffer is now parsable. Please save it.")))
-(define-obsolete-function-alias 'bibtex-complete 'completion-at-point "24.1")
+(define-obsolete-function-alias 'bibtex-complete #'completion-at-point "24.1")
(defun bibtex-completion-at-point-function ()
(let ((pnt (point))
(case-fold-search t)
@@ -5258,8 +5268,8 @@ Return the URL or nil if none can be generated."
;; If SCHEME is set up correctly,
;; we should never reach this point
(error "Match failed: %s" text)))
- (if fmt (apply 'format fmt (nreverse obj))
- (apply 'concat (nreverse obj)))))
+ (if fmt (apply #'format fmt (nreverse obj))
+ (apply #'concat (nreverse obj)))))
(if (called-interactively-p 'interactive) (message "%s" url))
(unless no-browse (browse-url url)))
(if (and (not url) (called-interactively-p 'interactive))
@@ -5289,10 +5299,11 @@ where FILE is the BibTeX file of ENTRY."
(list (completing-read
"Field: "
(delete-dups
- (apply 'append
+ (apply #'append
bibtex-user-optional-fields
- (mapcar (lambda (x) (mapcar 'car (apply 'append (nthcdr 2 x))))
- bibtex-entry-alist))) nil t)
+ (mapcar (lambda (x) (mapcar #'car (apply #'append (nthcdr 2 x))))
+ bibtex-entry-alist)))
+ nil t)
(read-string "Regexp: ")
(if bibtex-search-entry-globally
(not current-prefix-arg)
diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el
index 86db6980433..722fc0a3137 100644
--- a/lisp/textmodes/conf-mode.el
+++ b/lisp/textmodes/conf-mode.el
@@ -44,28 +44,23 @@
"Align assignments to this column by default with \\[conf-align-assignments].
If this number is negative, the `=' comes before the whitespace. Use 0 to
not align (only setting space according to `conf-assignment-space')."
- :type 'integer
- :group 'conf)
+ :type 'integer)
(defcustom conf-javaprop-assignment-column 32
"Value for `conf-assignment-column' in Java properties buffers."
- :type 'integer
- :group 'conf)
+ :type 'integer)
(defcustom conf-colon-assignment-column (- (abs conf-assignment-column))
"Value for `conf-assignment-column' in Java properties buffers."
- :type 'integer
- :group 'conf)
+ :type 'integer)
(defcustom conf-assignment-space t
"Put at least one space around assignments when aligning."
- :type 'boolean
- :group 'conf)
+ :type 'boolean)
(defcustom conf-colon-assignment-space nil
"Value for `conf-assignment-space' in colon style Conf mode buffers."
- :type 'boolean
- :group 'conf)
+ :type 'boolean)
(defvar conf-mode-map
(let ((map (make-sparse-keymap))
@@ -349,9 +344,37 @@ unbalanced, but hey...)"
(scan-error depth))))
+(defun conf--guess-mode ()
+ "Try to guess sub-mode of `conf-mode' based on buffer content."
+ (let ((unix 0) (win 0) (equal 0) (colon 0) (space 0) (jp 0))
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (skip-chars-forward " \t\f")
+ (cond ((eq (char-after) ?\#) (setq unix (1+ unix)))
+ ((eq (char-after) ?\;) (setq win (1+ win)))
+ ((eq (char-after) ?\[)) ; nop
+ ((eolp)) ; nop
+ ((eq (char-after) ?})) ; nop
+ ;; recognize at most double spaces within names
+ ((looking-at "[^ \t\n=:]+\\(?: ?[^ \t\n=:]+\\)*[ \t]*[=:]")
+ (if (eq (char-before (match-end 0)) ?=)
+ (setq equal (1+ equal))
+ (setq colon (1+ colon))))
+ ((looking-at "/[/*]") (setq jp (1+ jp)))
+ ((looking-at ".*{")) ; nop
+ ((setq space (1+ space))))
+ (forward-line)))
+ (cond
+ ((> jp (max unix win 3)) #'conf-javaprop-mode)
+ ((> colon (max equal space)) #'conf-colon-mode)
+ ((> space (max equal colon)) #'conf-space-mode)
+ ((or (> win unix) (and (= win unix) (eq system-type 'windows-nt)))
+ #'conf-windows-mode)
+ (t #'conf-unix-mode))))
;;;###autoload
-(defun conf-mode ()
+(define-derived-mode conf-mode nil "Conf[?]"
"Mode for Unix and Windows Conf files and Java properties.
Most conf files know only three kinds of constructs: parameter
assignments optionally grouped into sections and comments. Yet
@@ -382,75 +405,41 @@ See also `conf-space-mode', `conf-colon-mode', `conf-javaprop-mode',
\\{conf-mode-map}"
- (interactive)
- ;; `conf-mode' plays two roles: it's the parent of several sub-modes
- ;; but it's also the function that chooses between those submodes.
- ;; To tell the difference between those two cases where the function
- ;; might be called, we check `delay-mode-hooks'.
- ;; (adopted from tex-mode.el)
- (if (not delay-mode-hooks)
- ;; try to guess sub-mode of conf-mode based on buffer content
- (let ((unix 0) (win 0) (equal 0) (colon 0) (space 0) (jp 0))
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward " \t\f")
- (cond ((eq (char-after) ?\#) (setq unix (1+ unix)))
- ((eq (char-after) ?\;) (setq win (1+ win)))
- ((eq (char-after) ?\[)) ; nop
- ((eolp)) ; nop
- ((eq (char-after) ?})) ; nop
- ;; recognize at most double spaces within names
- ((looking-at "[^ \t\n=:]+\\(?: ?[^ \t\n=:]+\\)*[ \t]*[=:]")
- (if (eq (char-before (match-end 0)) ?=)
- (setq equal (1+ equal))
- (setq colon (1+ colon))))
- ((looking-at "/[/*]") (setq jp (1+ jp)))
- ((looking-at ".*{")) ; nop
- ((setq space (1+ space))))
- (forward-line)))
- (cond
- ((> jp (max unix win 3)) (conf-javaprop-mode))
- ((> colon (max equal space)) (conf-colon-mode))
- ((> space (max equal colon)) (conf-space-mode))
- ((or (> win unix) (and (= win unix) (eq system-type 'windows-nt)))
- (conf-windows-mode))
- (t (conf-unix-mode))))
-
- (kill-all-local-variables)
- (use-local-map conf-mode-map)
- (setq major-mode 'conf-mode
- mode-name "Conf[?]")
- (set (make-local-variable 'font-lock-defaults)
- '(conf-font-lock-keywords nil t nil nil))
- ;; Let newcomment.el decide this for itself.
- ;; (set (make-local-variable 'comment-use-syntax) t)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'outline-regexp)
- "[ \t]*\\(?:\\[\\|.+[ \t\n]*{\\)")
- (set (make-local-variable 'outline-heading-end-regexp)
- "[\n}]")
- (set (make-local-variable 'outline-level)
- 'conf-outline-level)
- (set-syntax-table conf-mode-syntax-table)
- (setq imenu-generic-expression
- '(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*=" 1)
- ;; [section]
- (nil "^[ \t]*\\[[ \t]*\\(.+\\)[ \t]*\\]" 1)
- ;; section { ... }
- (nil "^[ \t]*\\([^=:{} \t\n][^=:{}\n]+\\)[ \t\n]*{" 1)))
- (run-mode-hooks 'conf-mode-hook)))
+ (setq-local font-lock-defaults '(conf-font-lock-keywords nil t nil nil))
+ ;; Let newcomment.el decide this for itself.
+ ;; (setq-local comment-use-syntax t)
+ (setq-local parse-sexp-ignore-comments t)
+ (setq-local outline-regexp "[ \t]*\\(?:\\[\\|.+[ \t\n]*{\\)")
+ (setq-local outline-heading-end-regexp "[\n}]")
+ (setq-local outline-level #'conf-outline-level)
+ (setq-local imenu-generic-expression
+ '(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*=" 1)
+ ;; [section]
+ (nil "^[ \t]*\\[[ \t]*\\(.+\\)[ \t]*\\]" 1)
+ ;; section { ... }
+ (nil "^[ \t]*\\([^=:{} \t\n][^=:{}\n]+\\)[ \t\n]*{" 1))))
+
+;; `conf-mode' plays two roles: it's the parent of several sub-modes
+;; but it's also the function that chooses between those submodes.
+;; To tell the difference between those two cases where the function
+;; might be called, we check `delay-mode-hooks'.
+;; (inspired from tex-mode.el)
+(advice-add 'conf-mode :around
+ (lambda (orig-fun)
+ "Redirect to one of the submodes when called directly."
+ (funcall (if delay-mode-hooks orig-fun (conf--guess-mode)))))
+
+
(defun conf-mode-initialize (comment &optional font-lock)
"Initializations for sub-modes of `conf-mode'.
COMMENT initializes `comment-start' and `comment-start-skip'.
The optional arg FONT-LOCK is the value for FONT-LOCK-KEYWORDS."
- (set (make-local-variable 'comment-start) comment)
- (set (make-local-variable 'comment-start-skip)
- (concat (regexp-quote comment-start) "+\\s *"))
+ (setq-local comment-start comment)
+ (setq-local comment-start-skip
+ (concat (regexp-quote comment-start) "+\\s *"))
(if font-lock
- (set (make-local-variable 'font-lock-defaults)
- `(,font-lock nil t nil nil))))
+ (setq-local font-lock-defaults `(,font-lock nil t nil nil))))
;;;###autoload
(define-derived-mode conf-unix-mode conf-mode "Conf[Unix]"
@@ -497,13 +486,11 @@ x.1 =
x.2.y.1.z.1 =
x.2.y.1.z.2.zz ="
(conf-mode-initialize "#" 'conf-javaprop-font-lock-keywords)
- (set (make-local-variable 'conf-assignment-column)
- conf-javaprop-assignment-column)
- (set (make-local-variable 'conf-assignment-regexp)
- ".+?\\([ \t]*[=: \t][ \t]*\\|$\\)")
- (setq comment-start-skip "\\(?:#+\\|/[/*]+\\)\\s *")
- (setq imenu-generic-expression
- '(("Parameters" "^[ \t]*\\(.+?\\)[=: \t]" 1))))
+ (setq-local conf-assignment-column conf-javaprop-assignment-column)
+ (setq-local conf-assignment-regexp ".+?\\([ \t]*[=: \t][ \t]*\\|$\\)")
+ (setq-local comment-start-skip "\\(?:#+\\|/[/*]+\\)\\s *")
+ (setq-local imenu-generic-expression
+ '(("Parameters" "^[ \t]*\\(.+?\\)[=: \t]" 1))))
;;;###autoload
(define-derived-mode conf-space-mode conf-unix-mode "Conf[Space]"
@@ -529,20 +516,18 @@ class desktop
add /dev/audio desktop
add /dev/mixer desktop"
(conf-mode-initialize "#" 'conf-space-font-lock-keywords)
- (make-local-variable 'conf-assignment-sign)
- (setq conf-assignment-sign nil)
- (make-local-variable 'conf-space-keywords)
+ (setq-local conf-assignment-sign nil)
(cond (buffer-file-name
;; We set conf-space-keywords directly, but a value which is
;; in the local variables list or interactively specified
;; (see the function conf-space-keywords) takes precedence.
- (setq conf-space-keywords
- (assoc-default buffer-file-name conf-space-keywords-alist
- 'string-match))))
+ (setq-local conf-space-keywords
+ (assoc-default buffer-file-name conf-space-keywords-alist
+ #'string-match))))
(conf-space-mode-internal)
;; In case the local variables list specifies conf-space-keywords,
;; recompute other things from that afterward.
- (add-hook 'hack-local-variables-hook 'conf-space-mode-internal nil t))
+ (add-hook 'hack-local-variables-hook #'conf-space-mode-internal nil t))
;;;###autoload
(defun conf-space-keywords (keywords)
@@ -553,16 +538,16 @@ See `conf-space-mode'."
(conf-space-mode))
(if (string-equal keywords "")
(setq keywords nil))
- (setq conf-space-keywords keywords)
+ (setq-local conf-space-keywords keywords)
(conf-space-mode-internal)
(run-mode-hooks))
(defun conf-space-mode-internal ()
- (make-local-variable 'conf-assignment-regexp)
- (setq conf-assignment-regexp
- (if conf-space-keywords
- (concat "\\(?:" conf-space-keywords "\\)[ \t]+.+?\\([ \t]+\\|$\\)")
- ".+?\\([ \t]+\\|$\\)"))
+ (setq-local conf-assignment-regexp
+ (if conf-space-keywords
+ (concat "\\(?:" conf-space-keywords
+ "\\)[ \t]+.+?\\([ \t]+\\|$\\)")
+ ".+?\\([ \t]+\\|$\\)"))
;; If Font Lock is already enabled, reenable it with new
;; conf-assignment-regexp.
(when (and font-lock-mode
@@ -596,17 +581,13 @@ For details see `conf-mode'. Example:
<Multi_key> <exclam> <exclam> : \"\\241\" exclamdown
<Multi_key> <c> <slash> : \"\\242\" cent"
(conf-mode-initialize "#" 'conf-colon-font-lock-keywords)
- (set (make-local-variable 'conf-assignment-space)
- conf-colon-assignment-space)
- (set (make-local-variable 'conf-assignment-column)
- conf-colon-assignment-column)
- (set (make-local-variable 'conf-assignment-sign)
- ?:)
- (set (make-local-variable 'conf-assignment-regexp)
- ".+?\\([ \t]*:[ \t]*\\)")
- (setq imenu-generic-expression
- `(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*:" 1)
- ,@(cdr imenu-generic-expression))))
+ (setq-local conf-assignment-space conf-colon-assignment-space)
+ (setq-local conf-assignment-column conf-colon-assignment-column)
+ (setq-local conf-assignment-sign ?:)
+ (setq-local conf-assignment-regexp ".+?\\([ \t]*:[ \t]*\\)")
+ (setq-local imenu-generic-expression
+ `(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*:" 1)
+ ,@(cdr imenu-generic-expression))))
;;;###autoload
(define-derived-mode conf-ppd-mode conf-colon-mode "Conf[PPD]"
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 0d4a910a1db..0d1eeed5611 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -67,7 +67,7 @@
(defconst scss-at-ids
'("at-root" "content" "debug" "each" "else" "else if" "error" "extend"
- "for" "function" "if" "import" "include" "mixin" "return" "warn"
+ "for" "function" "if" "import" "include" "mixin" "return" "use" "warn"
"while")
"Additional identifiers that appear in the form @foo in SCSS.")
@@ -100,7 +100,7 @@
"Identifiers for types of media.")
(defconst css-property-alist
- ;; CSS 2.1 properties (http://www.w3.org/TR/CSS21/propidx.html).
+ ;; CSS 2.1 properties (https://www.w3.org/TR/CSS21/propidx.html).
;;
;; Properties duplicated by any of the CSS3 modules below have been
;; removed.
@@ -119,7 +119,6 @@
("cue" cue-before cue-after)
("cue-after" uri "none")
("cue-before" uri "none")
- ("direction" "ltr" "rtl")
("display" "inline" "block" "list-item" "inline-block" "table"
"inline-table" "table-row-group" "table-header-group"
"table-footer-group" "table-row" "table-column-group"
@@ -180,7 +179,6 @@
("stress" number)
("table-layout" "auto" "fixed")
("top" length percentage "auto")
- ("unicode-bidi" "normal" "embed" "bidi-override")
("vertical-align" "baseline" "sub" "super" "top" "text-top"
"middle" "bottom" "text-bottom" percentage length)
("visibility" "visible" "hidden" "collapse")
@@ -192,7 +190,7 @@
("z-index" "auto" integer)
;; CSS Animations
- ;; (http://www.w3.org/TR/css3-animations/#property-index)
+ ;; (https://www.w3.org/TR/css3-animations/#property-index)
("animation" single-animation-name time single-timing-function
single-animation-iteration-count single-animation-direction
single-animation-fill-mode single-animation-play-state)
@@ -206,7 +204,7 @@
("animation-timing-function" single-timing-function)
;; CSS Backgrounds and Borders Module Level 3
- ;; (http://www.w3.org/TR/css3-background/#property-index)
+ ;; (https://www.w3.org/TR/css3-background/#property-index)
("background" bg-layer final-bg-layer)
("background-attachment" attachment)
("background-clip" box)
@@ -251,7 +249,7 @@
("box-shadow" "none" shadow)
;; CSS Basic User Interface Module Level 3 (CSS3 UI)
- ;; (http://www.w3.org/TR/css3-ui/#property-index)
+ ;; (https://www.w3.org/TR/css3-ui/#property-index)
("box-sizing" "content-box" "border-box")
("caret-color" "auto" color)
("cursor" uri x y "auto" "default" "none" "context-menu" "help"
@@ -274,10 +272,14 @@
("text-overflow" "clip" "ellipsis" string)
;; CSS Color Module Level 3
- ;; (http://www.w3.org/TR/css3-color/#property)
+ ;; (https://www.w3.org/TR/css3-color/#property)
("color" color)
("opacity" alphavalue)
+ ;; CSS Containment Module Level 1
+ ;; (https://www.w3.org/TR/css-contain-1/#property-index)
+ ("contain" "none" "strict" "content" "size" "layout" "paint")
+
;; CSS Grid Layout Module Level 1
;; (https://www.w3.org/TR/css-grid-1/#property-index)
("grid" grid-template grid-template-rows "auto-flow" "dense"
@@ -302,7 +304,7 @@
("grid-template-rows" "none" track-list auto-track-list)
;; CSS Flexible Box Layout Module Level 1
- ;; (http://www.w3.org/TR/css-flexbox-1/#property-index)
+ ;; (https://www.w3.org/TR/css-flexbox-1/#property-index)
("align-content" "flex-start" "flex-end" "center" "space-between"
"space-around" "stretch")
("align-items" "flex-start" "flex-end" "center" "baseline"
@@ -321,7 +323,7 @@
("order" integer)
;; CSS Fonts Module Level 3
- ;; (http://www.w3.org/TR/css3-fonts/#property-index)
+ ;; (https://www.w3.org/TR/css3-fonts/#property-index)
("font" font-style font-variant-css21 font-weight font-stretch
font-size line-height font-family "caption" "icon" "menu"
"message-box" "small-caption" "status-bar")
@@ -417,7 +419,7 @@
("columns" column-width column-count)
;; CSS Overflow Module Level 3
- ;; (http://www.w3.org/TR/css-overflow-3/#property-index)
+ ;; (https://www.w3.org/TR/css-overflow-3/#property-index)
("max-lines" "none" integer)
("overflow" "visible" "hidden" "scroll" "auto" "paged-x" "paged-y"
"paged-x-controls" "paged-y-controls" "fragments")
@@ -446,7 +448,7 @@
("text-underline-position" "auto" "under" "left" "right")
;; CSS Text Module Level 3
- ;; (http://www.w3.org/TR/css3-text/#property-index)
+ ;; (https://www.w3.org/TR/css3-text/#property-index)
("hanging-punctuation" "none" "first" "force-end" "allow-end"
"last")
("hyphens" "none" "manual" "auto")
@@ -468,7 +470,7 @@
("word-wrap" "normal" "break-word")
;; CSS Transforms Module Level 1
- ;; (http://www.w3.org/TR/css3-2d-transforms/#property-index)
+ ;; (https://www.w3.org/TR/css3-2d-transforms/#property-index)
("backface-visibility" "visible" "hidden")
("perspective" "none" length)
("perspective-origin" "left" "center" "right" "top" "bottom"
@@ -479,7 +481,7 @@
("transform-style" "flat" "preserve-3d")
;; CSS Transitions
- ;; (http://www.w3.org/TR/css3-transitions/#property-index)
+ ;; (https://www.w3.org/TR/css3-transitions/#property-index)
("transition" single-transition)
("transition-delay" time)
("transition-duration" time)
@@ -490,8 +492,18 @@
;; (https://www.w3.org/TR/css-will-change-1/#property-index)
("will-change" "auto" animateable-feature)
+ ;; CSS Writing Modes Level 3
+ ;; (https://www.w3.org/TR/css-writing-modes-3/#property-index)
+ ;; "glyph-orientation-vertical" is obsolete and left out.
+ ("direction" "ltr" "rtl")
+ ("text-combine-upright" "none" "all")
+ ("text-orientation" "mixed" "upright" "sideways")
+ ("unicode-bidi" "normal" "embed" "isolate" "bidi-override"
+ "isolate-override" "plaintext")
+ ("writing-mode" "horizontal-tb" "vertical-rl" "vertical-lr")
+
;; Filter Effects Module Level 1
- ;; (http://www.w3.org/TR/filter-effects/#property-index)
+ ;; (https://www.w3.org/TR/filter-effects/#property-index)
("color-interpolation-filters" "auto" "sRGB" "linearRGB")
("filter" "none" filter-function-list)
("flood-color" color)
@@ -874,7 +886,7 @@ cannot be completed sensibly: `custom-ident',
(defconst css-escapes-re
"\\\\\\(?:[^\000-\037\177]\\|[[:xdigit:]]+[ \n\t\r\f]?\\)")
-(defconst css-nmchar-re (concat "\\(?:[-[:alnum:]]\\|" css-escapes-re "\\)"))
+(defconst css-nmchar-re (concat "\\(?:[-_[:alnum:]]\\|" css-escapes-re "\\)"))
(defconst css-nmstart-re (concat "\\(?:[[:alpha:]]\\|" css-escapes-re "\\)"))
(defconst css-ident-re ;; (concat css-nmstart-re css-nmchar-re "*")
;; Apparently, "at rules" names can start with a dash, e.g. @-moz-keyframes.
@@ -1137,17 +1149,6 @@ returns, point will be at the end of the recognized color."
;; Evaluate to the color if the name is found.
((css--named-color start-point match))))
-(defun css--contrasty-color (name)
- "Return a color that contrasts with NAME.
-NAME is of any form accepted by `color-distance'.
-The returned color will be usable by Emacs and will contrast
-with NAME; in particular so that if NAME is used as a background
-color, the returned color can be used as the foreground and still
-be readable."
- ;; See bug#25525 for a discussion of this.
- (if (> (color-distance name "black") 292485)
- "black" "white"))
-
(defcustom css-fontify-colors t
"Whether CSS colors should be fontified using the color as the background.
When non-`nil', a text representing CSS color will be fontified
@@ -1187,7 +1188,8 @@ START and END are buffer positions."
(add-text-properties
start (point)
(list 'face (list :background color
- :foreground (css--contrasty-color color)
+ :foreground (readable-foreground-color
+ color)
:box '(:line-width -1))))))))))))
extended-region))
@@ -1354,21 +1356,17 @@ the string PROPERTY."
(defun css--complete-property-value ()
"Complete property value at point."
- (let ((property
- (save-excursion
- (re-search-backward ":[^/]" (line-beginning-position) t)
- (when (eq (char-after) ?:)
- (let ((property-end (point)))
- (skip-chars-backward "-[:alnum:]")
- (let ((prop (buffer-substring (point) property-end)))
- (car (member prop css-property-ids))))))))
+ (let ((property (and (looking-back "\\([[:alnum:]-]+\\):[^/][^;]*"
+ (line-beginning-position) t)
+ (member (match-string-no-properties 1)
+ css-property-ids))))
(when property
(let ((end (point)))
(save-excursion
(skip-chars-backward "[:graph:]")
(list (point) end
(append '("inherit" "initial" "unset")
- (css--property-values property))))))))
+ (css--property-values (car property)))))))))
(defvar css--html-tags (mapcar #'car html-tag-alist)
"List of HTML tags.
@@ -1881,12 +1879,9 @@ on what is seen near point."
(list
(let* ((sym (css--mdn-find-symbol))
(enable-recursive-minibuffers t)
- (value (completing-read
- (if sym
- (format "Describe CSS symbol (default %s): " sym)
- "Describe CSS symbol: ")
- css--mdn-completion-list nil nil nil
- 'css--mdn-lookup-history sym)))
+ (value (completing-read (format-prompt "Describe CSS symbol" sym)
+ css--mdn-completion-list nil nil nil
+ 'css--mdn-lookup-history sym)))
(if (equal value "") sym value))))
(when symbol
;; If we see a single-colon pseudo-element like ":after", turn it
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 4c24e70d1f7..65702d081f1 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -57,7 +57,6 @@
(defcustom flyspell-highlight-flag t
"How Flyspell should indicate misspelled words.
Non-nil means use highlight, nil means use minibuffer messages."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-mark-duplications-flag t
@@ -65,12 +64,10 @@ Non-nil means use highlight, nil means use minibuffer messages."
See `flyspell-mark-duplications-exceptions' to add exceptions to this rule.
Detection of repeated words is not implemented in
\"large\" regions; see variable `flyspell-large-region'."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-case-fold-duplications t
"Non-nil means Flyspell matches duplicate words case-insensitively."
- :group 'flyspell
:type 'boolean
:version "27.1")
@@ -87,9 +84,8 @@ dictionary name (`ispell-local-dictionary' or
EXCEPTION-LIST is a list of strings. The checked word is
downcased before comparing with these exceptions."
- :group 'flyspell
:type '(alist :key-type (choice (const :tag "All dictionaries" nil)
- string)
+ regexp)
:value-type (repeat string))
:version "24.1")
@@ -97,7 +93,6 @@ downcased before comparing with these exceptions."
"If non-nil, sort the corrections before popping them.
The sorting is controlled by the `flyspell-sort-corrections-function'
variable, and defaults to sorting alphabetically."
- :group 'flyspell
:version "21.1"
:type 'boolean)
@@ -109,8 +104,7 @@ function takes three parameters -- the two correction candidates
to be sorted, and the third parameter is the word that's being
corrected."
:version "26.1"
- :type 'function
- :group 'flyspell)
+ :type 'function)
(defun flyspell-sort-corrections-alphabetically (corr1 corr2 _)
(string< corr1 corr2))
@@ -130,14 +124,12 @@ Flyspell uses a different face (`flyspell-duplicate') to highlight it.
This variable specifies how far to search to find such a duplicate.
-1 means no limit (search the whole buffer).
0 means do not search for duplicate unrecognized spellings."
- :group 'flyspell
:version "24.5" ; -1 -> 400000
:type '(choice (const :tag "no limit" -1)
number))
(defcustom flyspell-delay 3
"The number of seconds to wait before checking, after a \"delayed\" command."
- :group 'flyspell
:type 'number)
(defcustom flyspell-persistent-highlight t
@@ -147,12 +139,10 @@ is highlighted, and the highlight is turned off as soon as point moves
off the misspelled word.
Make sure this variable is non-nil if you use `flyspell-region'."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-highlight-properties t
"Non-nil means highlight incorrect words even if a property exists for this word."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-default-delayed-commands
@@ -164,7 +154,6 @@ Make sure this variable is non-nil if you use `flyspell-region'."
backward-delete-char-untabify)
"The standard list of delayed commands for Flyspell.
See `flyspell-delayed-commands'."
- :group 'flyspell
:version "21.1"
:type '(repeat (symbol)))
@@ -172,7 +161,6 @@ See `flyspell-delayed-commands'."
"List of commands that are \"delayed\" for Flyspell mode.
After these commands, Flyspell checking is delayed for a short time,
whose length is specified by `flyspell-delay'."
- :group 'flyspell
:type '(repeat (symbol)))
(defcustom flyspell-default-deplacement-commands
@@ -182,7 +170,6 @@ whose length is specified by `flyspell-delay'."
scroll-down)
"The standard list of deplacement commands for Flyspell.
See variable `flyspell-deplacement-commands'."
- :group 'flyspell
:version "21.1"
:type '(repeat (symbol)))
@@ -190,18 +177,15 @@ See variable `flyspell-deplacement-commands'."
"List of commands that are \"deplacement\" for Flyspell mode.
After these commands, Flyspell checking is performed only if the previous
command was not the very same command."
- :group 'flyspell
:version "21.1"
:type '(repeat (symbol)))
(defcustom flyspell-issue-welcome-flag t
"Non-nil means that Flyspell should display a welcome message when started."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-issue-message-flag t
"Non-nil means that Flyspell emits messages when checking words."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-incorrect-hook nil
@@ -213,7 +197,6 @@ of possible corrections as returned by `ispell-parse-output'.
If any of the functions return non-nil, the word is not highlighted as
incorrect."
- :group 'flyspell
:version "21.1"
:type 'hook)
@@ -225,50 +208,43 @@ when flyspell is started, the value of that variable is used instead
of `flyspell-default-dictionary' to select the default dictionary.
Otherwise, if `flyspell-default-dictionary' is nil, it means to use
Ispell's ultimate default dictionary."
- :group 'flyspell
:version "21.1"
:type '(choice string (const :tag "Default" nil)))
(defcustom flyspell-tex-command-regexp
"\\(\\(begin\\|end\\)[ \t]*{\\|\\(cite[a-z*]*\\|label\\|ref\\|eqref\\|usepackage\\|documentclass\\)[ \t]*\\(\\[[^]]*\\]\\)?{[^{}]*\\)"
"A string that is the regular expression that matches TeX commands."
- :group 'flyspell
:version "21.1"
- :type 'string)
+ :type 'regexp)
(defcustom flyspell-check-tex-math-command nil
"Non-nil means check even inside TeX math environment.
TeX math environments are discovered by `texmathp', implemented
inside AUCTeX package. That package may be found at
URL `https://www.gnu.org/software/auctex/'"
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-dictionaries-that-consider-dash-as-word-delimiter
'("francais" "deutsch8" "norsk")
"List of dictionary names that consider `-' as word delimiter."
- :group 'flyspell
:version "21.1"
:type '(repeat (string)))
(defcustom flyspell-abbrev-p
nil
"If non-nil, add correction to abbreviation table."
- :group 'flyspell
:version "21.1"
:type 'boolean)
(defcustom flyspell-use-global-abbrev-table-p
nil
"If non-nil, prefer global abbrev table to local abbrev table."
- :group 'flyspell
:version "21.1"
:type 'boolean)
(defcustom flyspell-mode-line-string " Fly"
"String displayed on the mode line when flyspell is active.
Set this to nil if you don't want a mode line indicator."
- :group 'flyspell
:type '(choice string (const :tag "None" nil)))
(defcustom flyspell-large-region 1000
@@ -282,30 +258,25 @@ Doubled words are not detected in a large region, because Ispell
does not check for them.
If this variable is nil, all regions are treated as small."
- :group 'flyspell
:version "21.1"
:type '(choice number (const :tag "All small" nil)))
(defcustom flyspell-insert-function (function insert)
"Function for inserting word by flyspell upon correction."
- :group 'flyspell
:type 'function)
(defcustom flyspell-before-incorrect-word-string nil
"String used to indicate an incorrect word starting."
- :group 'flyspell
:type '(choice string (const nil)))
(defcustom flyspell-after-incorrect-word-string nil
"String used to indicate an incorrect word ending."
- :group 'flyspell
:type '(choice string (const nil)))
(defvar flyspell-mode-map)
(defcustom flyspell-use-meta-tab t
"Non-nil means that flyspell uses M-TAB to correct word."
- :group 'flyspell
:type 'boolean
:initialize 'custom-initialize-default
:set (lambda (sym val)
@@ -316,8 +287,7 @@ If this variable is nil, all regions are treated as small."
(defcustom flyspell-auto-correct-binding
[(control ?\;)]
"The key binding for flyspell auto correction."
- :type 'key-sequence
- :group 'flyspell)
+ :type 'key-sequence)
;;*---------------------------------------------------------------------*/
;;* Mode specific options */
@@ -417,9 +387,13 @@ like <img alt=\"Some thing.\">."
;;*---------------------------------------------------------------------*/
;;* Programming mode */
;;*---------------------------------------------------------------------*/
-(defvar flyspell-prog-text-faces
+(defcustom flyspell-prog-text-faces
'(font-lock-string-face font-lock-comment-face font-lock-doc-face)
- "Faces corresponding to text in programming-mode buffers.")
+ "Faces corresponding to text in programming-mode buffers."
+ :type '(set (const font-lock-string-face)
+ (const font-lock-comment-face)
+ (const font-lock-doc-face))
+ :version "28.1")
(defun flyspell-generic-progmode-verify ()
"Used for `flyspell-generic-check-word-predicate' in programming modes."
@@ -428,8 +402,8 @@ like <img alt=\"Some thing.\">."
(let ((f (get-text-property (1- (point)) 'face)))
(memq f flyspell-prog-text-faces))))
-;; Records the binding of M-TAB in effect before flyspell was activated.
-(defvar flyspell--prev-meta-tab-binding)
+(defvar flyspell--prev-meta-tab-binding nil
+ "Records the binding of M-TAB in effect before flyspell was activated.")
;;;###autoload
(defun flyspell-prog-mode ()
@@ -475,6 +449,22 @@ like <img alt=\"Some thing.\">."
map)
"Minor mode keymap for Flyspell mode--for the whole buffer.")
+;; correct on mouse 3
+(defun flyspell--set-use-mouse-3-for-menu (var value)
+ (set-default var value)
+ (if value
+ (progn (define-key flyspell-mouse-map [mouse-2] nil)
+ (define-key flyspell-mouse-map [down-mouse-3] 'flyspell-correct-word))
+ (define-key flyspell-mouse-map [mouse-2] 'flyspell-correct-word)
+ (define-key flyspell-mouse-map [down-mouse-3] nil)))
+
+(defcustom flyspell-use-mouse-3-for-menu nil
+ "Non-nil means to bind `mouse-3' to `flyspell-correct-word'.
+If this is set, also unbind `mouse-2'."
+ :type 'boolean
+ :set 'flyspell--set-use-mouse-3-for-menu
+ :version "28.1")
+
;; dash character machinery
(defvar flyspell-consider-dash-as-word-delimiter-flag nil
"Non-nil means that the `-' char is considered as a word delimiter.")
@@ -493,8 +483,7 @@ like <img alt=\"Some thing.\">."
(t
:underline t :inherit error))
"Flyspell face for misspelled words."
- :version "24.4"
- :group 'flyspell)
+ :version "24.4")
(defface flyspell-duplicate
'((((supports :underline (:style wave)))
@@ -503,8 +492,7 @@ like <img alt=\"Some thing.\">."
:underline t :inherit warning))
"Flyspell face for words that appear twice in a row.
See also `flyspell-duplicate-distance'."
- :version "24.4"
- :group 'flyspell)
+ :version "24.4")
(defvar flyspell-overlay nil)
@@ -536,17 +524,34 @@ invoking `ispell-change-dictionary'.
Consider using the `ispell-parser' to check your text. For instance
consider adding:
-\(add-hook \\='tex-mode-hook (function (lambda () (setq ispell-parser \\='tex))))
+\(add-hook \\='tex-mode-hook (lambda () (setq ispell-parser \\='tex)))
in your init file.
\\[flyspell-region] checks all words inside a region.
\\[flyspell-buffer] checks the whole buffer."
- :lighter flyspell-mode-line-string
+ :lighter (flyspell-mode-line-string
+ ;; If `flyspell-mode-line-string' is nil, then nothing of
+ ;; the following is displayed in the mode line.
+ ((:propertize flyspell-mode-line-string)
+ (:propertize
+ (:eval
+ (concat "/" (substring (or ispell-local-dictionary
+ ispell-dictionary
+ "--")
+ 0 2)))
+ face bold
+ help-echo "mouse-1: Change dictionary"
+ local-map (keymap
+ (mode-line keymap
+ (mouse-1 . ispell-change-dictionary))))))
:keymap flyspell-mode-map
:group 'flyspell
(if flyspell-mode
(condition-case err
- (flyspell-mode-on)
+ (progn
+ (when flyspell-use-mouse-3-for-menu
+ (flyspell--set-use-mouse-3-for-menu 'flyspell-use-mouse-3-for-menu t))
+ (flyspell-mode-on (called-interactively-p 'interactive)))
(error (message "Error enabling Flyspell mode:\n%s" (cdr err))
(flyspell-mode -1)))
(flyspell-mode-off)))
@@ -563,12 +568,9 @@ in your init file.
(custom-add-option 'text-mode-hook 'turn-on-flyspell)
-;;*---------------------------------------------------------------------*/
-;;* flyspell-buffers ... */
-;;* ------------------------------------------------------------- */
-;;* For remembering buffers running flyspell */
-;;*---------------------------------------------------------------------*/
-(defvar flyspell-buffers nil)
+(defvar flyspell-buffers nil
+ "For remembering buffers running flyspell")
+(make-obsolete-variable 'flyspell-buffers "not used." "28.1")
;;*---------------------------------------------------------------------*/
;;* flyspell-minibuffer-p ... */
@@ -624,8 +626,12 @@ in your init file.
;;*---------------------------------------------------------------------*/
;;* flyspell-mode-on ... */
;;*---------------------------------------------------------------------*/
-(defun flyspell-mode-on ()
- "Turn Flyspell mode on. Do not use this; use `flyspell-mode' instead."
+(defun flyspell-mode-on (&optional show-msg)
+ "Turn Flyspell mode on. Do not use this; use `flyspell-mode' instead.
+
+If optional argument SHOW-MSG is non-nil, show a welcome message
+if `flyspell-issue-message-flag' and `flyspell-issue-welcome-flag'
+are both non-nil."
(ispell-set-spellchecker-params) ; Initialize variables and dicts alists
(setq ispell-highlight-face 'flyspell-incorrect)
;; local dictionaries setup
@@ -657,15 +663,17 @@ in your init file.
(setq flyspell-generic-check-word-predicate mode-predicate)))
;; the welcome message
(if (and flyspell-issue-message-flag
- flyspell-issue-welcome-flag
- (called-interactively-p 'interactive))
- (let ((binding (where-is-internal 'flyspell-auto-correct-word
- nil 'non-ascii)))
- (message "%s"
- (if binding
- (format "Welcome to flyspell. Use %s or Mouse-2 to correct words."
- (key-description binding))
- "Welcome to flyspell. Use Mouse-2 to correct words.")))))
+ flyspell-issue-welcome-flag
+ show-msg)
+ (let* ((binding (where-is-internal 'flyspell-auto-correct-word
+ nil 'non-ascii))
+ (mouse-button (if flyspell-use-mouse-3-for-menu
+ "Mouse-3" "Mouse-2")))
+ (message (format-message
+ "Welcome to Flyspell. Use %s to correct words."
+ (if binding
+ (format "`%s' or `%s'" (key-description binding) mouse-button)
+ (format "`%s'" mouse-button)))))))
;;*---------------------------------------------------------------------*/
;;* flyspell-delay-commands ... */
@@ -1815,7 +1823,9 @@ for the overlay."
(overlay-put overlay 'mouse-face mouse-face)
(overlay-put overlay 'flyspell-overlay t)
(overlay-put overlay 'evaporate t)
- (overlay-put overlay 'help-echo "mouse-2: correct word at point")
+ (overlay-put overlay 'help-echo (concat (if flyspell-use-mouse-3-for-menu
+ "mouse-3"
+ "mouse-2") ": correct word at point"))
;; If misspelled text has a 'keymap' property, let that remain in
;; effect for the bindings that flyspell-mouse-map doesn't override.
(set-keymap-parent flyspell-mouse-map (get-char-property beg 'keymap))
@@ -1912,7 +1922,7 @@ before point that's highlighted as misspelled."
(while (and (setq pos (previous-overlay-change pos))
(not (= pos pos1)))
(setq pos1 pos)
- (if (> pos (point-min))
+ (if (>= pos (point-min))
(progn
(setq ovs (overlays-at pos))
(while (consp ovs)
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 65f61644b6d..05a4bd058c4 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -44,6 +44,7 @@
;; ispell-buffer
;; ispell-message
;; ispell-comments-and-strings
+;; ispell-comment-or-string-at-point
;; ispell-continue
;; ispell-complete-word
;; ispell-complete-word-interior-frag
@@ -197,14 +198,13 @@ Must be greater than 1."
:type 'integer
:group 'ispell)
-;; XXX Add enchant to this list once enchant >= 2.1.0 is widespread.
-;; Before that, adding it is useless, as if it is found, it will just
-;; cause an error; and one of the other spelling engines below is
-;; almost certainly installed in any case, for enchant to use.
(defcustom ispell-program-name
(or (executable-find "aspell")
(executable-find "ispell")
(executable-find "hunspell")
+ ;; Enchant is commonly installed as `enchant-2', so use this
+ ;; name and avoid old versions of `enchant'.
+ (executable-find "enchant-2")
"ispell")
"Program invoked by \\[ispell-word] and \\[ispell-region] commands."
:type 'string
@@ -329,7 +329,7 @@ The function must take one string argument and return a string."
:group 'ispell)
;; FIXME framepop.el last updated c 2003 (?),
-;; probably something else replaces it these days.
+;; use posframe.
(defcustom ispell-use-framepop-p nil
"When non-nil ispell uses framepop to display choices in a dedicated frame.
You can set this variable to dynamically use framepop if you are in a
@@ -621,15 +621,6 @@ For Aspell, non-nil also means to try to automatically find its dictionaries.
Earlier Aspell versions do not consistently support charset encoding. Handling
this would require some extra guessing in `ispell-aspell-find-dictionary'.")
-(defvar ispell-aspell-supports-utf8 nil
- "Non-nil if Aspell has consistent command line UTF-8 support. Obsolete.
-ispell.el and flyspell.el will use for this purpose the more generic
-variable `ispell-encoding8-command' for both Aspell and Hunspell. Is left
-here just for backwards compatibility.")
-
-(make-obsolete-variable 'ispell-aspell-supports-utf8
- 'ispell-encoding8-command "23.1")
-
(defvar ispell-dicts-name2locale-equivs-alist
'(("american" "en_US")
("brasileiro" "pt_BR")
@@ -682,9 +673,7 @@ Otherwise returns the library directory name, if that is defined."
;; all versions, since versions earlier than 3.0.09 didn't identify
;; themselves on startup.
(interactive "p")
- (let ((default-directory (or (and (boundp 'temporary-file-directory)
- temporary-file-directory)
- default-directory))
+ (let ((default-directory (or temporary-file-directory default-directory))
(get-config-var
(lambda (var)
(when (re-search-forward
@@ -1106,28 +1095,38 @@ to dictionaries found, and will remove aliases from the list
in `ispell-dicts-name2locale-equivs-alist' if an explicit
dictionary from that list was found."
(let ((hunspell-found-dicts
- (split-string
- (with-temp-buffer
- (ispell-call-process ispell-program-name
- null-device
- t
- nil
- "-D"
- ;; Use -a to prevent Hunspell from
- ;; trying to initialize its
- ;; curses/termcap UI, which causes it
- ;; to crash or fail to start in some
- ;; MS-Windows ports.
- "-a"
- ;; Hunspell 1.7.0 (and later?) won't
- ;; show LOADED DICTIONARY unless
- ;; there's at least one file argument
- ;; on the command line. So we feed
- ;; it with the null device.
- null-device)
- (buffer-string))
- "[\n\r]+"
- t))
+ (seq-filter
+ (lambda (str)
+ (when (string-match
+ ;; Hunspell gives this error when there is some
+ ;; installation problem, for example if $LANG is unset.
+ (concat "^Can't open affix or dictionary files "
+ "for dictionary named \"default\".$")
+ str)
+ (user-error "Hunspell error (is $LANG unset?): %s" str))
+ (file-name-absolute-p str))
+ (split-string
+ (with-temp-buffer
+ (ispell-call-process ispell-program-name
+ null-device
+ t
+ nil
+ "-D"
+ ;; Use -a to prevent Hunspell from
+ ;; trying to initialize its
+ ;; curses/termcap UI, which causes it
+ ;; to crash or fail to start in some
+ ;; MS-Windows ports.
+ "-a"
+ ;; Hunspell 1.7.0 (and later?) won't
+ ;; show LOADED DICTIONARY unless
+ ;; there's at least one file argument
+ ;; on the command line. So we feed
+ ;; it with the null device.
+ null-device)
+ (buffer-string))
+ "[\n\r]+"
+ t)))
hunspell-default-dict
hunspell-default-dict-entry
hunspell-multi-dict)
@@ -1237,11 +1236,11 @@ If LANG is omitted, get the extra word characters for the default language."
"Find Enchant's dictionaries, and record in `ispell-enchant-dictionary-alist'."
(let* ((dictionaries
(split-string
- (ispell--call-enchant-lsmod "-list-dicts" (buffer-string)) " ([^)]+)\n"))
+ (ispell--call-enchant-lsmod "-list-dicts") " ([^)]+)\n" t))
(found
(mapcar #'(lambda (lang)
`(,lang "[[:alpha:]]" "[^[:alpha:]]"
- ,(ispell--get-extra-word-characters) t nil nil utf-8))
+ ,(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.
@@ -3591,24 +3590,40 @@ Returns the sum SHIFT due to changes in word replacements."
;;;###autoload
-(defun ispell-comments-and-strings ()
- "Check comments and strings in the current buffer for spelling errors."
- (interactive)
- (goto-char (point-min))
+(defun ispell-comments-and-strings (&optional start end)
+ "Check comments and strings in the current buffer for spelling errors.
+If called interactively with an active region, check only comments and
+strings in the region.
+When called from Lisp, START and END buffer positions can be provided
+to limit the check."
+ (interactive (when (use-region-p) (list (region-beginning) (region-end))))
+ (unless end (setq end (point-max)))
+ (goto-char (or start (point-min)))
(let (state done)
(while (not done)
(setq done t)
- (setq state (parse-partial-sexp (point) (point-max)
- nil nil state 'syntax-table))
+ (setq state (parse-partial-sexp (point) end nil nil state 'syntax-table))
(if (or (nth 3 state) (nth 4 state))
(let ((start (point)))
- (setq state (parse-partial-sexp start (point-max)
+ (setq state (parse-partial-sexp start end
nil nil state 'syntax-table))
(if (or (nth 3 state) (nth 4 state))
(error "Unterminated string or comment"))
(save-excursion
(setq done (not (ispell-region start (point))))))))))
+;;;###autoload
+(defun ispell-comment-or-string-at-point ()
+ "Check the comment or string containing point for spelling errors."
+ (interactive)
+ (save-excursion
+ (let ((state (syntax-ppss)))
+ (if (or (nth 3 state) (nth 4 state))
+ (ispell-region (nth 8 state)
+ (progn (parse-partial-sexp (point) (point-max)
+ nil nil state 'syntax-table)
+ (point)))
+ (user-error "Not inside a string or comment")))))
;;;###autoload
(defun ispell-buffer ()
@@ -3734,8 +3749,7 @@ looking for a dictionary, please see the distribution of the GNU ispell
program, or do an Internet search; there are various dictionaries
available on the net."
(interactive)
- (if (and (boundp 'transient-mark-mode) transient-mark-mode
- (boundp 'mark-active) mark-active)
+ (if (and transient-mark-mode mark-active)
(ispell-region (region-beginning) (region-end))
(ispell-buffer)))
@@ -3923,7 +3937,7 @@ in your init file:
You can bind this to the key C-c i in GNUS or mail by adding to
`news-reply-mode-hook' or `mail-mode-hook' the following lambda expression:
- (function (lambda () (local-set-key \"\\C-ci\" \\='ispell-message)))"
+ (lambda () (local-set-key \"\\C-ci\" \\='ispell-message))"
(interactive)
(save-excursion
(goto-char (point-min))
@@ -4200,7 +4214,7 @@ Both should not be used to define a buffer-local dictionary."
(let (line-okay search done found)
(while (not done)
(let ((case-fold-search nil))
- (setq search (search-forward ispell-words-keyword nil 'move)
+ (setq search (search-forward ispell-words-keyword nil t)
found (or found search)
line-okay (< (+ (length word) 1 ; 1 for space after word..
(progn (end-of-line) (current-column)))
@@ -4211,8 +4225,10 @@ Both should not be used to define a buffer-local dictionary."
(setq done t)
(if (null search)
(progn
- (open-line 1)
- (unless found (newline))
+ (if found (insert "\n") ;; after an existing LocalWords
+ (goto-char (point-max)) ;; no LocalWords, go to end of file
+ (open-line 1)
+ (newline))
(insert (if comment-start
(concat
(progn
diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el
index b9161d9697e..54e20779bdc 100644
--- a/lisp/textmodes/mhtml-mode.el
+++ b/lisp/textmodes/mhtml-mode.el
@@ -73,7 +73,9 @@ code();
(defconst mhtml--crucial-variable-prefix
(regexp-opt '("comment-" "uncomment-" "electric-indent-"
- "smie-" "forward-sexp-function" "completion-" "major-mode"))
+ "smie-" "forward-sexp-function" "completion-" "major-mode"
+ "adaptive-fill-" "fill-" "normal-auto-fill-function"
+ "paragraph-"))
"Regexp matching the prefix of \"crucial\" buffer-locals we want to capture.")
(defconst mhtml--variable-prefix
@@ -157,54 +159,6 @@ code();
(mhtml--submode-name submode)
"")))
-(defvar font-lock-beg)
-(defvar font-lock-end)
-
-(defun mhtml--extend-font-lock-region ()
- "Extend the font lock region according to HTML sub-mode needs.
-
-This is used via `font-lock-extend-region-functions'. It ensures
-that the font-lock region is extended to cover either whole
-lines, or to the spot where the submode changes, whichever is
-smallest."
- (let ((orig-beg font-lock-beg)
- (orig-end font-lock-end))
- ;; The logic here may look odd but it is needed to ensure that we
- ;; do the right thing when trying to limit the search.
- (save-excursion
- (goto-char font-lock-beg)
- ;; previous-single-property-change starts by looking at the
- ;; previous character, but we're trying to extend a region to
- ;; include just characters with the same submode as this
- ;; character.
- (unless (eobp)
- (forward-char))
- (setq font-lock-beg (previous-single-property-change
- (point) 'mhtml-submode nil
- (line-beginning-position)))
- (unless (eq (get-text-property font-lock-beg 'mhtml-submode)
- (get-text-property orig-beg 'mhtml-submode))
- (cl-incf font-lock-beg))
-
- (goto-char font-lock-end)
- (unless (bobp)
- (backward-char))
- (setq font-lock-end (next-single-property-change
- (point) 'mhtml-submode nil
- (line-beginning-position 2)))
- (unless (eq (get-text-property font-lock-end 'mhtml-submode)
- (get-text-property orig-end 'mhtml-submode))
- (cl-decf font-lock-end)))
-
- ;; Also handle the multiline property -- but handle it here, and
- ;; not via font-lock-extend-region-functions, to avoid the
- ;; situation where the two extension functions disagree.
- ;; See bug#29159.
- (font-lock-extend-region-multiline)
-
- (or (/= font-lock-beg orig-beg)
- (/= font-lock-end orig-end))))
-
(defun mhtml--submode-fontify-one-region (submode beg end &optional loudly)
(if submode
(mhtml--with-locals submode
@@ -303,17 +257,14 @@ This is used by `mhtml--pre-command'.")
sgml-syntax-propertize-rules))
(defun mhtml-syntax-propertize (start end)
- ;; First remove our special settings from the affected text. They
- ;; will be re-applied as needed.
- (remove-list-of-text-properties start end
- '(syntax-table local-map mhtml-submode))
- (goto-char start)
- ;; Be sure to look back one character, because START won't yet have
- ;; been propertized.
- (unless (bobp)
- (let ((submode (get-text-property (1- (point)) 'mhtml-submode)))
- (if submode
- (mhtml--syntax-propertize-submode submode end))))
+ (let ((submode (get-text-property start 'mhtml-submode)))
+ ;; First remove our special settings from the affected text. They
+ ;; will be re-applied as needed.
+ (remove-list-of-text-properties start end
+ '(syntax-table local-map mhtml-submode))
+ (goto-char start)
+ (if submode
+ (mhtml--syntax-propertize-submode submode end)))
(sgml-syntax-propertize (point) end mhtml--syntax-propertize))
(defun mhtml-indent-line ()
@@ -364,8 +315,6 @@ the rules from `css-mode'."
(setq-local syntax-propertize-function #'mhtml-syntax-propertize)
(setq-local font-lock-fontify-region-function
#'mhtml--submode-fontify-region)
- (setq-local font-lock-extend-region-functions
- '(mhtml--extend-font-lock-region))
;; Attach this to both pre- and post- hooks just in case it ever
;; changes a key binding that might be accessed from the menu bar.
@@ -383,6 +332,18 @@ the rules from `css-mode'."
;: Hack
(js--update-quick-match-re)
+ ;; Setup the appropriate js-mode value of auto-fill-function.
+ (setf (mhtml--submode-crucial-captured-locals mhtml--js-submode)
+ (push (cons 'auto-fill-function
+ (if (and (boundp 'auto-fill-function) auto-fill-function)
+ #'js-do-auto-fill
+ nil))
+ (mhtml--submode-crucial-captured-locals mhtml--js-submode)))
+
+ ;; This mode might be using CC Mode's filling functionality.
+ (c-foreign-init-lit-pos-cache)
+ (add-hook 'before-change-functions #'c-foreign-truncate-lit-pos-cache nil t)
+
;; This is sort of a prog-mode as well as a text mode.
(run-hooks 'prog-mode-hook))
diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el
index 62e8b1f0934..bb2582cf7a2 100644
--- a/lisp/textmodes/nroff-mode.el
+++ b/lisp/textmodes/nroff-mode.el
@@ -50,7 +50,6 @@
(let ((map (make-sparse-keymap))
(menu-map (make-sparse-keymap)))
(define-key map "\t" 'tab-to-tab-stop)
- (define-key map "\es" 'center-line)
(define-key map "\e?" 'nroff-count-text-lines)
(define-key map "\n" 'nroff-electric-newline)
(define-key map "\en" 'nroff-forward-text-line)
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index 99c3e471241..b0975291428 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -168,7 +168,7 @@ to obtain the value of this variable."
(defcustom sentence-end-base "[.?!…‽][]\"'”’)}»›]*"
"Regexp matching the basic end of a sentence, not including following space."
:group 'paragraphs
- :type 'string
+ :type 'regexp
:version "25.1")
(put 'sentence-end-base 'safe-local-variable 'stringp)
@@ -371,33 +371,50 @@ See `forward-paragraph' for more information."
(defun mark-paragraph (&optional arg allow-extend)
"Put point at beginning of this paragraph, mark at end.
-The paragraph marked is the one that contains point or follows point.
+The paragraph marked is the one that contains point or follows
+point.
-With argument ARG, puts mark at end of a following paragraph, so that
-the number of paragraphs marked equals ARG.
+With argument ARG, puts mark at the end of this or a following
+paragraph, so that the number of paragraphs marked equals ARG.
-If ARG is negative, point is put at end of this paragraph, mark is put
-at beginning of this or a previous paragraph.
+If ARG is negative, point is put at the end of this paragraph,
+mark is put at the beginning of this or a previous paragraph.
Interactively (or if ALLOW-EXTEND is non-nil), if this command is
-repeated or (in Transient Mark mode) if the mark is active,
-it marks the next ARG paragraphs after the ones already marked."
- (interactive "p\np")
- (unless arg (setq arg 1))
- (when (zerop arg)
- (error "Cannot mark zero paragraphs"))
- (cond ((and allow-extend
- (or (and (eq last-command this-command) (mark t))
- (and transient-mark-mode mark-active)))
- (set-mark
- (save-excursion
- (goto-char (mark))
- (forward-paragraph arg)
- (point))))
- (t
- (forward-paragraph arg)
- (push-mark nil t t)
- (backward-paragraph arg))))
+repeated or (in Transient Mark mode) if the mark is active, it
+marks the next ARG paragraphs after the region already marked.
+This also means when activating the mark immediately before using
+this command, the current paragraph is only marked from point."
+ (interactive "P\np")
+ (let ((numeric-arg (prefix-numeric-value arg)))
+ (cond ((zerop numeric-arg))
+ ((and allow-extend
+ (or (and (eq last-command this-command) mark-active)
+ (region-active-p)))
+ (if arg
+ (setq arg numeric-arg)
+ (if (< (mark) (point))
+ (setq arg -1)
+ (setq arg 1)))
+ (set-mark
+ (save-excursion
+ (goto-char (mark))
+ (forward-paragraph arg)
+ (point))))
+ ;; don't activate the mark when at eob
+ ((and (eobp) (> numeric-arg 0)))
+ (t
+ (unless (save-excursion
+ (forward-line 0)
+ (looking-at paragraph-start))
+ (backward-paragraph (cond ((> numeric-arg 0) 1)
+ ((< numeric-arg 0) -1)
+ (t 0))))
+ (push-mark
+ (save-excursion
+ (forward-paragraph numeric-arg)
+ (point))
+ t t)))))
(defun kill-paragraph (arg)
"Kill forward to end of paragraph.
diff --git a/lisp/textmodes/po.el b/lisp/textmodes/po.el
index d5645e86304..29c6d3f4608 100644
--- a/lisp/textmodes/po.el
+++ b/lisp/textmodes/po.el
@@ -1,4 +1,4 @@
-;;; po.el --- basic support of PO translation files
+;;; po.el --- basic support of PO translation files -*- lexical-binding:t -*-
;; Copyright (C) 1995-1998, 2000-2020 Free Software Foundation, Inc.
diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el
index 8d8223a7326..c8fd0bea004 100644
--- a/lisp/textmodes/refer.el
+++ b/lisp/textmodes/refer.el
@@ -336,9 +336,9 @@ found on the last `refer-find-entry' or `refer-find-next-entry'."
(list (expand-file-name
(if (eq major-mode 'bibtex-mode)
(read-file-name
- (format ".bib file (default %s): "
- (file-name-nondirectory
- (buffer-file-name)))
+ (format-prompt ".bib file"
+ (file-name-nondirectory
+ (buffer-file-name)))
(file-name-directory (buffer-file-name))
(file-name-nondirectory (buffer-file-name))
t)
diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el
index b79bb292c8a..4c780d8d8c3 100644
--- a/lisp/textmodes/reftex-ref.el
+++ b/lisp/textmodes/reftex-ref.el
@@ -861,9 +861,7 @@ Optional prefix argument OTHER-WINDOW goes to the label in another window."
(default (when (looking-back "\\\\\\(?:page\\)?ref{[-a-zA-Z0-9_*.:]*"
(line-beginning-position))
(reftex-this-word "-a-zA-Z0-9_*.:")))
- (label (completing-read (if default
- (format "Label (default %s): " default)
- "Label: ")
+ (label (completing-read (format-prompt "Label" default)
docstruct
(lambda (x) (stringp (car x))) t nil nil
default))
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index ca92541331e..c9fd19d2324 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -925,7 +925,7 @@ DOWNCASE t: Downcase words before using them."
"\\<label[[:space:]]*=[[:space:]]*"
;; Match the label value; braces around the value are
;; optional.
- "{?\\(?1:[^] ,}\r\n\t%]+\\)}?"
+ "{?\\(?1:[^] ,}\r\n\t%]+\\)"
;; We are done. Just search until the next closing bracket
"[^]]*\\]"))
"List of regexps matching \\label definitions.
@@ -2100,6 +2100,8 @@ construct: \\bbb [xxx] {aaa}."
"Hook which is being run when loading reftex.el."
:group 'reftex-miscellaneous-configurations
:type 'hook)
+(make-obsolete-variable 'reftex-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom reftex-mode-hook nil
"Hook which is being run when turning on RefTeX mode."
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index 542f1fef14e..4071c0dd074 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -2371,7 +2371,7 @@ what in fact did happen.
Check if the bug is reproducible with an up-to-date version of
RefTeX available from https://www.gnu.org/software/auctex/.
-If the bug is triggered by a specific \(La)TeX file, you should try
+If the bug is triggered by a specific (La)TeX file, you should try
to produce a minimal sample file showing the problem and include it
in your report.
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index 836dfb4a538..7bc7dc1762e 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -5,7 +5,7 @@
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: emacs-devel@gnu.org
;; Created: 29 Mar 1999
-;; Version: 2.0
+;; Old-Version: 2.0
;; Keywords: data memory todo pim
;; URL: http://gna.org/projects/remember-el/
@@ -181,6 +181,7 @@
(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."
@@ -486,9 +487,6 @@ Most useful for remembering things from other applications."
(interactive)
(remember-region (point-min) (point-max)))
-;; Org needs this
-(define-obsolete-function-alias 'remember-buffer 'remember-finalize "23.1")
-
(defun remember-destroy ()
"Destroy the current *Remember* buffer."
(interactive)
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 5fadec491a5..f2fcd62c871 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -2363,7 +2363,7 @@ If user selects enumerations, a further prompt is given. User need to
input a starting item, for example 'e' for 'A)' style. The position is
also arranged by `rst-insert-list-new-tag'."
(let* ((itemstyle (completing-read
- "Select preferred item style [#.]: "
+ (format-prompt "Select preferred item style" "#.")
rst-initial-items nil t nil nil "#."))
(cnt (if (string-match (rst-re 'cntexp-tag) itemstyle)
(match-string 0 itemstyle)))
@@ -2371,21 +2371,23 @@ also arranged by `rst-insert-list-new-tag'."
(save-match-data
(cond
((equal cnt "a")
- (let ((itemno (read-string "Give starting value [a]: "
- nil nil "a")))
+ (let ((itemno (read-string
+ (format-prompt "Give starting value" "a")
+ nil nil "a")))
(downcase (substring itemno 0 1))))
((equal cnt "A")
- (let ((itemno (read-string "Give starting value [A]: "
- nil nil "A")))
+ (let ((itemno (read-string
+ (format-prompt "Give starting value" "A")
+ nil nil "A")))
(upcase (substring itemno 0 1))))
((equal cnt "I")
- (let ((itemno (read-number "Give starting value [1]: " 1)))
+ (let ((itemno (read-number "Give starting value: " 1)))
(rst-arabic-to-roman itemno)))
((equal cnt "i")
- (let ((itemno (read-number "Give starting value [1]: " 1)))
+ (let ((itemno (read-number "Give starting value: " 1)))
(downcase (rst-arabic-to-roman itemno))))
((equal cnt "1")
- (let ((itemno (read-number "Give starting value [1]: " 1)))
+ (let ((itemno (read-number "Give starting value: " 1)))
(number-to-string itemno)))))))
(if no
(setq itemstyle (replace-match no t t itemstyle)))
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 6152a8ad0a7..f3d8695e248 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -46,7 +46,8 @@
(defcustom sgml-basic-offset 2
"Specifies the basic indentation level for `sgml-indent-line'."
- :type 'integer)
+ :type 'integer
+ :safe #'integerp)
(defcustom sgml-attribute-offset 0
"Specifies a delta for attribute indentation in `sgml-indent-line'.
@@ -286,7 +287,10 @@ separated by a space."
(defconst sgml-namespace-re "[_[:alpha:]][-_.[:alnum:]]*")
(defconst sgml-name-re "[_:[:alpha:]][-_.:[:alnum:]]*")
(defconst sgml-tag-name-re (concat "<\\([!/?]?" sgml-name-re "\\)"))
-(defconst sgml-attrs-re "\\(?:[^\"'/><]\\|\"[^\"]*\"\\|'[^']*'\\)*")
+(defconst sgml-attrs-re
+ ;; This pattern cannot begin with a character matched by the end of
+ ;; `sgml-name-re' above.
+ "\\(?:[^_.:\"'/><[:alnum:]-]\\(?:[^\"'/><]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?")
(defconst sgml-start-tag-regex (concat "<" sgml-name-re sgml-attrs-re)
"Regular expression that matches a non-empty start tag.
Any terminating `>' or `/' is not matched.")
@@ -775,7 +779,7 @@ If you like tags and attributes in uppercase, customize
(setq sgml-tag-last
(completing-read
(if (> (length sgml-tag-last) 0)
- (format "Tag (default %s): " sgml-tag-last)
+ (format-prompt "Tag" sgml-tag-last)
"Tag: ")
sgml-tag-alist nil nil nil 'sgml-tag-history sgml-tag-last)))
?< str |
@@ -874,9 +878,7 @@ With prefix argument, only self insert."
(list (let ((def (save-excursion
(if (eq (following-char) ?<) (forward-char))
(sgml-beginning-of-tag))))
- (completing-read (if def
- (format "Tag (default %s): " def)
- "Tag: ")
+ (completing-read (format-prompt "Tag" def)
sgml-tag-alist nil nil nil
'sgml-tag-history def))))
(or (and tag (> (length tag) 0))
@@ -1186,10 +1188,9 @@ and move to the line in the SGML document that caused it."
(or sgml-saved-validate-command
(concat sgml-validate-command
" "
- (shell-quote-argument
- (let ((name (buffer-file-name)))
- (and name
- (file-name-nondirectory name)))))))))
+ (when-let ((name (buffer-file-name)))
+ (shell-quote-argument
+ (file-name-nondirectory name))))))))
(setq sgml-saved-validate-command command)
(save-some-buffers (not compilation-ask-about-save) nil)
(compilation-start command))
@@ -1803,6 +1804,7 @@ This takes effect when first loading the library.")
(define-key map "\C-c\C-cc" 'html-checkboxes)
(define-key map "\C-c\C-cl" 'html-list-item)
(define-key map "\C-c\C-ch" 'html-href-anchor)
+ (define-key map "\C-c\C-cf" 'html-href-anchor-file)
(define-key map "\C-c\C-cn" 'html-name-anchor)
(define-key map "\C-c\C-c#" 'html-id-anchor)
(define-key map "\C-c\C-ci" 'html-image)
@@ -1815,6 +1817,7 @@ This takes effect when first loading the library.")
(define-key map "\C-cc" 'html-checkboxes)
(define-key map "\C-cl" 'html-list-item)
(define-key map "\C-ch" 'html-href-anchor)
+ (define-key map "\C-cf" 'html-href-anchor-file)
(define-key map "\C-cn" 'html-name-anchor)
(define-key map "\C-c#" 'html-id-anchor)
(define-key map "\C-ci" 'html-image)
@@ -1842,15 +1845,16 @@ This takes effect when first loading the library.")
(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" . html-href-anchor))
+ (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.")
(defvar html-face-tag-alist
- '((bold . "b")
- (italic . "i")
+ '((bold . "strong")
+ (italic . "em")
(underline . "u")
(mode-line . "rev"))
"Value of `sgml-face-tag-alist' for HTML mode.")
@@ -2360,7 +2364,7 @@ have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6>
<p>Paragraphs only need an opening tag. Line breaks and multiple spaces are
ignored unless the text is <pre>preformatted.</pre> Text can be marked as
-<b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal M-o or
+<strong>bold</strong>, <em>italic</em> or <u>underlined</u> using the normal M-o or
Edit/Text Properties/Face commands.
Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
@@ -2450,6 +2454,11 @@ HTML Autoview mode is a buffer-local minor mode for use with
;; '(setq input "http:")
"<a href=\"" str "\">" _ "</a>")
+(define-skeleton html-href-anchor-file
+ "HTML anchor tag with href attribute (from a local file)."
+ (file-relative-name (read-file-name "File name: ") default-directory)
+ "<a href=\"" str "\">" _ "</a>")
+
(define-skeleton html-name-anchor
"HTML anchor tag with name attribute."
"Name: "
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index bd2cac7aebb..25aa58046f4 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -339,8 +339,8 @@
;; When using `table-cell-map-hook' do not use `local-set-key'.
;;
;; (add-hook 'table-cell-map-hook
-;; (function (lambda ()
-;; (local-set-key [<key sequence>] '<function>))))
+;; (lambda ()
+;; (local-set-key [<key sequence>] '<function>)))
;;
;; Adding the above to your init file is a common way to customize a
;; mode specific keymap. However it does not work for this package.
@@ -349,8 +349,8 @@
;; explicitly. The correct way of achieving above task is:
;;
;; (add-hook 'table-cell-map-hook
-;; (function (lambda ()
-;; (define-key table-cell-map [<key sequence>] '<function>))))
+;; (lambda ()
+;; (define-key table-cell-map [<key sequence>] '<function>)))
;;
;; -----
;; Menu:
@@ -793,6 +793,8 @@ simply by any key input."
"List of functions to be called after the table is first loaded."
:type 'hook
:group 'table-hooks)
+(make-obsolete-variable 'table-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom table-point-entered-cell-hook nil
"List of functions to be called after point entered a table cell."
@@ -1822,11 +1824,11 @@ See `table-insert-row' and `table-insert-column'."
(list (intern (let ((completion-ignore-case t)
(default (car table-insert-row-column-history)))
(downcase (completing-read
- (format "Insert %s row%s/column%s (default %s): "
- (if (> n 1) (format "%d" n) "a")
- (if (> n 1) "s" "")
- (if (> n 1) "s" "")
- default)
+ (format-prompt
+ "Insert %s row%s/column%s" default
+ (if (> n 1) (format "%d" n) "a")
+ (if (> n 1) "s" "")
+ (if (> n 1) "s" ""))
'(("row") ("column"))
nil t nil 'table-insert-row-column-history default))))
n)))
@@ -2532,7 +2534,7 @@ DIRECTION is one of symbols; right, left, above or below."
(caar direction-list)))
(completion-ignore-case t))
(intern (downcase (completing-read
- (format "Span into (default %s): " default-direction)
+ (format-prompt "Span into" default-direction)
direction-list
nil t nil 'table-cell-span-direction-history default-direction))))))
(unless (memq direction '(right left above below))
@@ -2695,7 +2697,7 @@ Creates a cell on the left and a cell on the right of the current point location
("Title"
("Split" . "split") ("Left" . "left") ("Right" . "right"))))
(downcase (completing-read
- (format "Existing cell contents to (default %s): " default)
+ (format-prompt "Existing cell contents to" default)
'(("split") ("left") ("right"))
nil t nil 'table-cell-split-contents-to-history default)))))))
(unless (eq contents-to 'split)
@@ -2767,7 +2769,7 @@ ORIENTATION is a symbol either horizontally or vertically."
(completion-ignore-case t)
(default (car table-cell-split-orientation-history)))
(intern (downcase (completing-read
- (format "Split orientation (default %s): " default)
+ (format-prompt "Split orientation" default)
'(("horizontally") ("vertically"))
nil t nil 'table-cell-split-orientation-history default))))))
(unless (memq orientation '(horizontally vertically))
@@ -2787,7 +2789,7 @@ WHAT is a symbol `cell', `row' or `column'. JUSTIFY is a symbol
(completion-ignore-case t)
(default (car table-target-history)))
(intern (downcase (completing-read
- (format "Justify what (default %s): " default)
+ (format-prompt "Justify what" default)
'(("cell") ("row") ("column"))
nil t nil 'table-target-history default))))
(table--query-justification)))
@@ -2927,7 +2929,7 @@ buffer, and leaves the previous contents of the buffer untouched.
References used for this implementation:
HTML:
- URL `http://www.w3.org'
+ URL `https://www.w3.org'
LaTeX:
URL `http://www.maths.tcd.ie/~dwilkins/LaTeXPrimer/Tables.html'
@@ -2941,7 +2943,7 @@ CALS (DocBook DTD):
(completion-ignore-case t)
(default (car table-source-language-history))
(language (downcase (completing-read
- (format "Language (default %s): " default)
+ (format-prompt "Language" default)
table-source-languages
nil t nil 'table-source-language-history default))))
(list
@@ -3207,11 +3209,7 @@ CALS (DocBook DTD):
(while (and (re-search-forward "$" nil t)
(not (eobp)))
(insert "<br />")
- (forward-char 1)))
- (unless (and table-html-delegate-spacing-to-user-agent
- (progn
- (goto-char (point-min))
- (looking-at "\\s *\\'")))))
+ (forward-char 1))))
((eq language 'cals)
(table--remove-eol-spaces (point-min) (point-max))
(if (re-search-forward "\\s +\\'" nil t)
@@ -3281,7 +3279,7 @@ Currently this method is for LaTeX only."
(with-temp-buffer
(insert line)
(goto-char (point-min))
- (while (re-search-forward "\\([#$~_^%{}]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t)
+ (while (re-search-forward "\\([#$~_^%{}&]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t)
(if (match-beginning 1)
(save-excursion
(goto-char (match-beginning 1))
@@ -3368,7 +3366,7 @@ Example:
(let* ((completion-ignore-case t)
(default (car table-sequence-justify-history)))
(intern (downcase (completing-read
- (format "Justify (default %s): " default)
+ (format-prompt "Justify" default)
'(("left") ("center") ("right"))
nil t nil 'table-sequence-justify-history default)))))))
(unless (or (called-interactively-p 'interactive) (table--probe-cell))
@@ -3505,9 +3503,9 @@ column must consists from cells of same width."
(let ((cell-list (table--vertical-cell-list 'top-to-bottom)))
(unless
(and (table--uniform-list-p
- (mapcar (function (lambda (cell) (car (table--get-coordinate (car cell))))) cell-list))
+ (mapcar (lambda (cell) (car (table--get-coordinate (car cell)))) cell-list))
(table--uniform-list-p
- (mapcar (function (lambda (cell) (car (table--get-coordinate (cdr cell))))) cell-list)))
+ (mapcar (lambda (cell) (car (table--get-coordinate (cdr cell)))) cell-list)))
(error "Cells in this column are not in uniform width"))
(unless lu-coord
(setq lu-coord (table--get-coordinate (caar cell-list))))
@@ -3670,7 +3668,7 @@ companion command to `table-capture' this way.
(if (and (string= col-delim-regexp "") (string= row-delim-regexp "")) 'left
(intern
(downcase (completing-read
- (format "Justify (default %s): " default)
+ (format-prompt "Justify" default)
'(("left") ("center") ("right"))
nil t nil 'table-capture-justify-history default)))))
(if (and (string= col-delim-regexp "") (string= row-delim-regexp "")) "1"
@@ -4255,9 +4253,8 @@ cache buffer into the designated cell in the table buffer."
PROMPT-HISTORY is a cons cell which car is the prompt string and the
cdr is the history symbol."
(let ((default (car (symbol-value (cdr prompt-history)))))
- (read-from-minibuffer
- (format "%s (default %s): " (car prompt-history) default)
- "" nil nil (cdr prompt-history) default))
+ (read-from-minibuffer (format-prompt (car prompt-history) default)
+ "" nil nil (cdr prompt-history) default))
(car (symbol-value (cdr prompt-history))))
(defun table--buffer-substring-and-trim (beg end)
@@ -4314,7 +4311,7 @@ Returns the coordinate of the final point location."
(let* ((completion-ignore-case t)
(default (car table-justify-history)))
(intern (downcase (completing-read
- (format "Justify (default %s): " default)
+ (format-prompt "Justify" default)
'(("left") ("center") ("right") ("top") ("middle") ("bottom") ("none"))
nil t nil 'table-justify-history default)))))
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 0e28756ea75..11db25cb7a2 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -224,7 +224,7 @@ Should show the queue(s) that \\[tex-print] puts jobs on."
:group 'tex-view)
;;;###autoload
-(defcustom tex-default-mode 'latex-mode
+(defcustom tex-default-mode #'latex-mode
"Mode to enter for a new file that might be either TeX or LaTeX.
This variable is used when it can't be determined whether the file
is plain TeX or LaTeX or what because the file contains no commands.
@@ -422,7 +422,7 @@ An alternative value is \" . \", if you use a font with a narrow period."
(push (cons "--" (match-beginning 0)) menu))
;; Sort in increasing buffer position order.
- (sort menu (function (lambda (a b) (< (cdr a) (cdr b))))))))
+ (sort menu (lambda (a b) (< (cdr a) (cdr b)))))))
;;;;
;;;; Outline support
@@ -465,7 +465,7 @@ An alternative value is \" . \", if you use a font with a narrow period."
; ("{\\\\bf\\([^}]+\\)}" 1 'bold keep)
; ("{\\\\\\(em\\|it\\|sl\\)\\([^}]+\\)}" 2 'italic keep)
; ("\\\\\\([a-zA-Z@]+\\|.\\)" . font-lock-keyword-face)
-; ("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" 1 font-lock-function-name-face keep))
+; ("^[ \t\n]*\\\\def[\\@]\\(\\w+\\)" 1 font-lock-function-name-face keep))
; ;; Rewritten and extended for LaTeX2e by Ulrik Dickow <dickow@nbi.dk>.
; '(("\\\\\\(begin\\|end\\|newcommand\\){\\([a-zA-Z0-9\\*]+\\)}"
; 2 font-lock-function-name-face)
@@ -593,7 +593,7 @@ An alternative value is \" . \", if you use a font with a narrow period."
;; Miscellany.
(slash "\\\\")
(opt " *\\(\\[[^]]*\\] *\\)*")
- (args "\\(\\(?:[^{}&\\]+\\|\\\\.\\|{[^}]*}\\)+\\)")
+ (args "\\(\\(?:[^${}&\\]+\\|\\\\.\\|{[^}]*}\\)+\\)")
(arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)"))
(list
;;
@@ -668,7 +668,9 @@ An alternative value is \" . \", if you use a font with a narrow period."
"Default expressions to highlight in TeX modes.")
(defvar tex-verbatim-environments
- '("verbatim" "verbatim*"))
+ '("verbatim" "verbatim*"
+ "Verbatim" ;; From "fancyvrb"
+ ))
(put 'tex-verbatim-environments 'safe-local-variable
(lambda (x) (not (memq nil (mapcar #'stringp x)))))
@@ -966,7 +968,7 @@ Inherits `shell-mode-map' with a few additions.")
;; This would be a lot simpler if we just used a regexp search,
;; but then it would be too slow.
-(defun tex-guess-mode ()
+(defun tex--guess-mode ()
(let ((mode tex-default-mode) slash comment)
(save-excursion
(goto-char (point-min))
@@ -983,52 +985,40 @@ Inherits `shell-mode-map' with a few additions.")
(regexp-opt '("documentstyle" "documentclass"
"begin" "subsection" "section"
"part" "chapter" "newcommand"
- "renewcommand" "RequirePackage") 'words)
+ "renewcommand" "RequirePackage")
+ 'words)
"\\|NeedsTeXFormat{LaTeX")))
(if (and (looking-at
"document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}")
;; SliTeX is almost never used any more nowadays.
(tex-executable-exists-p slitex-run-command))
- 'slitex-mode
- 'latex-mode)
- 'plain-tex-mode))))
- (funcall mode)))
+ #'slitex-mode
+ #'latex-mode)
+ #'plain-tex-mode))))
+ mode))
;; `tex-mode' plays two roles: it's the parent of several sub-modes
;; but it's also the function that chooses between those submodes.
;; To tell the difference between those two cases where the function
;; might be called, we check `delay-mode-hooks'.
-(define-derived-mode tex-mode text-mode "generic-TeX"
- (tex-common-initialization))
-;; We now move the function and define it again. This gives a warning
-;; in the byte-compiler :-( but it's difficult to avoid because
-;; `define-derived-mode' will necessarily define the function once
-;; and we need to define it a second time for `autoload' to get the
-;; proper docstring.
-(defalias 'tex-mode-internal (symbol-function 'tex-mode))
-
-;; Suppress the byte-compiler warning about multiple definitions.
-;; This is a) ugly, and b) cheating, but this was the last
-;; remaining warning from byte-compiling all of Emacs...
-(eval-when-compile
- (if (boundp 'byte-compile-function-environment)
- (setq byte-compile-function-environment
- (delq (assq 'tex-mode byte-compile-function-environment)
- byte-compile-function-environment))))
-
;;;###autoload
-(defun tex-mode ()
+(define-derived-mode tex-mode text-mode "generic-TeX"
"Major mode for editing files of input for TeX, LaTeX, or SliTeX.
+This is the shared parent mode of several submodes.
Tries to determine (by looking at the beginning of the file) whether
this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode',
-`latex-mode', or `slitex-mode', respectively. If it cannot be determined,
+`latex-mode', or `slitex-mode', accordingly. If it cannot be determined,
such as if there are no commands in the file, the value of `tex-default-mode'
says which mode to use."
- (interactive)
- (if delay-mode-hooks
- ;; We're called from one of the children already.
- (tex-mode-internal)
- (tex-guess-mode)))
+ (tex-common-initialization))
+
+(advice-add 'tex-mode :around #'tex--redirect-to-submode)
+(defun tex--redirect-to-submode (orig-fun)
+ "Redirect to one of the submodes when called directly."
+ (funcall (if delay-mode-hooks
+ ;; We're called from one of the children already.
+ orig-fun
+ (tex--guess-mode))))
;; The following three autoloaded aliases appear to conflict with
;; AUCTeX. However, even though AUCTeX uses the mixed case variants
@@ -1037,6 +1027,10 @@ says which mode to use."
;; AUCTeX to provide a fully functional user-level replacement. So
;; these aliases should remain as they are, in particular since AUCTeX
;; users are likely to use them.
+;; Note from Stef: I don't understand the above explanation, the only
+;; justification I can find to keep those confusing aliases is for those
+;; users who may have files annotated with -*- LaTeX -*- (e.g. because they
+;; received them from someone using AUCTeX).
;;;###autoload
(defalias 'TeX-mode 'tex-mode)
@@ -1252,10 +1246,10 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook
("\\\\[a-zA-Z]+\\( +\\|{}\\)[a-zA-Z]*" . "")
("%" . "$"))))
;; A line containing just $$ is treated as a paragraph separator.
- (setq-local paragraph-start "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$")
+ (setq-local paragraph-start "[ \t]*$\\|[\f\\%]\\|[ \t]*\\$\\$")
;; A line starting with $$ starts a paragraph,
;; but does not separate paragraphs if it has more stuff on it.
- (setq-local paragraph-separate "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$[ \t]*$")
+ (setq-local paragraph-separate "[ \t]*$\\|[\f\\%]\\|[ \t]*\\$\\$[ \t]*$")
(setq-local add-log-current-defun-function #'tex-current-defun-name)
(setq-local comment-start "%")
(setq-local comment-add 1)
@@ -2301,9 +2295,6 @@ FILE is typically the output DVI or PDF file."
(setq uptodate nil)))))
uptodate)))
-
-(autoload 'format-spec "format-spec")
-
(defvar tex-executable-cache nil)
(defun tex-executable-exists-p (name)
"Like `executable-find' but with a cache."
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index 438cb7798a1..b3bc634de9b 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -482,6 +482,13 @@ Subexpression 1 is what goes into the corresponding `@end' statement.")
(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)
map))
(easy-menu-define texinfo-mode-menu
@@ -958,6 +965,12 @@ to jump to the corresponding spot in the Texinfo source file."
:type 'string
:group 'texinfo)
+(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
@@ -1002,9 +1015,10 @@ The value of `texinfo-tex-trailer' is appended to the temporary file after the r
(interactive)
(require 'tex-mode)
(let ((tex-command texinfo-texi2dvi-command)
- ;; Disable tex-start-options-string. texi2dvi would not
- ;; understand anything specified here.
- (tex-start-options-string ""))
+ (tex-start-options texinfo-texi2dvi-options)
+ ;; Disable tex-start-commands. texi2dvi would not understand
+ ;; anything specified here.
+ (tex-start-commands ""))
(tex-buffer)))
(defun texinfo-texindex ()
@@ -1065,6 +1079,70 @@ You are prompted for the job number (use a number shown by a previous
;; job-number"\n"))
(tex-recenter-output-buffer nil))
+(defun texinfo-to-environment-bounds ()
+ "Move point alternately to the start and end of a Texinfo environment.
+Do nothing when outside of an environment. This command does not
+handle nested environments."
+ (interactive)
+ (cond ((save-excursion
+ (forward-line 0)
+ (looking-at texinfo-environment-regexp))
+ (if (save-excursion
+ (forward-line 0)
+ (looking-at "^@end"))
+ (texinfo-previous-environment-start)
+ (texinfo-next-environment-end)))
+ ((save-excursion
+ (and (re-search-backward texinfo-environment-regexp nil t)
+ (not (looking-at "^@end"))))
+ (texinfo-previous-environment-start))
+ ;; Otherwise, point is outside of an environment, so do nothing.
+ ))
+
+(defun texinfo-next-environment-start ()
+ "Move forward to the beginning of a Texinfo environment."
+ (interactive)
+ (if (looking-at texinfo-environment-regexp)
+ (forward-line 1))
+ (while (and (re-search-forward texinfo-environment-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (looking-at "@end"))))
+ (if (save-excursion
+ (forward-line 0)
+ (looking-at texinfo-environment-regexp))
+ (forward-line 0)))
+
+(defun texinfo-previous-environment-start ()
+ "Move back to the beginning of the previous Texinfo environment."
+ (interactive)
+ (while (and (re-search-backward texinfo-environment-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (looking-at "@end")))))
+
+(defun texinfo-next-environment-end ()
+ "Move forward to the beginning of the next @end line of an environment."
+ (interactive)
+ (if (looking-at "^@end")
+ (forward-line 1))
+ (while (and (re-search-forward texinfo-environment-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (not (looking-at "^@end")))))
+ (if (save-excursion
+ (forward-line 0)
+ (looking-at "^@end"))
+ (forward-line 0)))
+
+(defun texinfo-previous-environment-end ()
+ "Move backward to the beginning of the next @end line of an environment."
+ (interactive)
+ (while (and (re-search-backward texinfo-environment-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (not (looking-at "@end"))))))
+
(provide 'texinfo)
;;; texinfo.el ends here
diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el
index 25f37ffa23d..398f7fdc232 100644
--- a/lisp/textmodes/tildify.el
+++ b/lisp/textmodes/tildify.el
@@ -67,7 +67,7 @@ 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 'string
+ :type 'regexp
:safe t)
(defcustom tildify-pattern-alist ()
@@ -417,7 +417,7 @@ 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 'string)
+ :type 'regexp)
(defcustom tildify-space-predicates '(tildify-space-region-predicate)
"A list of predicate functions for `tildify-space' function."
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 1a15df33e50..558a3fd7368 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -258,7 +258,7 @@ E.g.:
;; Filenames
-(defvar thing-at-point-file-name-chars "-~/[:alnum:]_.${}#%,:"
+(defvar thing-at-point-file-name-chars "-@~/[:alnum:]_.${}#%,:"
"Characters allowable in filenames.")
(define-thing-chars filename thing-at-point-file-name-chars)
@@ -278,7 +278,7 @@ If nil, construct the regexp from `thing-at-point-uri-schemes'.")
"Regexp matching a URI without a scheme component.")
(defvar thing-at-point-uri-schemes
- ;; Officials from http://www.iana.org/assignments/uri-schemes.html
+ ;; Officials from https://www.iana.org/assignments/uri-schemes.html
'("aaa://" "about:" "acap://" "apt:" "bzr://" "bzr+ssh://"
"attachment:/" "chrome://" "cid:" "content://" "crid://" "cvs://"
"data:" "dav:" "dict://" "doi:" "dns:" "dtn:" "feed:" "file:/"
@@ -334,7 +334,7 @@ the bounds of a possible ill-formed URI (one lacking a scheme)."
;; may contain parentheses but may not contain spaces (RFC3986).
(let* ((allowed-chars "--:=&?$+@-Z_[:alpha:]~#,%;*()!'")
(skip-before "^[0-9a-zA-Z]")
- (skip-after ":;.,!?")
+ (skip-after ":;.,!?'")
(pt (point))
(beg (save-excursion
(skip-chars-backward allowed-chars)
diff --git a/lisp/thread.el b/lisp/thread.el
index d40d7bed538..00a0084f81f 100644
--- a/lisp/thread.el
+++ b/lisp/thread.el
@@ -43,8 +43,6 @@ An EVENT has the format
(err (cddr event)))
(message "Error %s: %S" thread err))))
-(make-obsolete 'thread-alive-p 'thread-live-p "27.1")
-
;;; The thread list buffer and list-threads command
(defcustom thread-list-refresh-seconds 0.5
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index dd259ec1ff6..3aa7ff0836b 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -30,7 +30,7 @@
;; your images, use image-dired.el
;;
;; The 'convert' program from 'ImageMagick'
-;; [URL:http://www.imagemagick.org/] is required.
+;; [URL:https://www.imagemagick.org/] is required.
;;
;; Thanks: Alex Schroeder <alex@gnu.org> for maintaining the package at some
;; time. The peoples at #emacs@freenode.net for numerous help. RMS
diff --git a/lisp/time.el b/lisp/time.el
index 44fd1a7e337..cb3a8470edc 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -25,33 +25,31 @@
;; Facilities to display current time/date and a new-mail indicator
;; in the Emacs mode line. The entry point is `display-time'.
-;; Display time world in a buffer, the entry point is
-;; `display-time-world'.
+;; Use `world-clock' to display world clock in a buffer.
;;; Code:
+(eval-when-compile (require 'subr-x))
+
(defgroup display-time nil
"Display time and load in mode line of Emacs."
:group 'mode-line
:group 'mail)
-
(defcustom display-time-mail-file nil
"File name of mail inbox file, for indicating existence of new mail.
Non-nil and not a string means don't check for mail; nil means use
default, which is system-dependent, and is the same as used by Rmail."
:type '(choice (const :tag "None" none)
(const :tag "Default" nil)
- (file :format "%v"))
- :group 'display-time)
+ (file :format "%v")))
(defcustom display-time-mail-directory nil
"Name of mail inbox directory, for indicating existence of new mail.
Any nonempty regular file in the directory is regarded as newly arrived mail.
If nil, do not check a directory for arriving mail."
:type '(choice (const :tag "None" nil)
- (directory :format "%v"))
- :group 'display-time)
+ (directory :format "%v")))
(defcustom display-time-mail-function nil
"Function to call, for indicating existence of new mail.
@@ -59,8 +57,7 @@ If nil, that means use the default method: check that the file
specified by `display-time-mail-file' is nonempty or that the
directory `display-time-mail-directory' contains nonempty files."
:type '(choice (const :tag "Default" nil)
- (function))
- :group 'display-time)
+ (function)))
(defcustom display-time-default-load-average 0
"Which load average value will be shown in the mode line.
@@ -75,8 +72,7 @@ The value can be one of:
:type '(choice (const :tag "1 minute load" 0)
(const :tag "5 minutes load" 1)
(const :tag "15 minutes load" 2)
- (const :tag "None" nil))
- :group 'display-time)
+ (const :tag "None" nil)))
(defvar display-time-load-average nil
"Value of the system's load average currently shown on the mode line.
@@ -86,27 +82,23 @@ This is an internal variable; setting it has no effect.")
(defcustom display-time-load-average-threshold 0.1
"Load-average values below this value won't be shown in the mode line."
- :type 'number
- :group 'display-time)
+ :type 'number)
;;;###autoload
(defcustom display-time-day-and-date nil "\
Non-nil means \\[display-time] should display day and date as well as time."
- :type 'boolean
- :group 'display-time)
+ :type 'boolean)
(defvar display-time-timer nil)
(defcustom display-time-interval 60
"Seconds between updates of time in the mode line."
- :type 'integer
- :group 'display-time)
+ :type 'integer)
(defcustom display-time-24hr-format nil
"Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23.
A value of nil means 1 <= hh <= 12, and an AM/PM suffix is used."
- :type 'boolean
- :group 'display-time)
+ :type 'boolean)
(defvar display-time-string nil
"String used in mode lines to display a time string.
@@ -116,103 +108,12 @@ It should not be set directly, but is instead updated by the
(defcustom display-time-hook nil
"List of functions to be called when the time is updated on the mode line."
- :type 'hook
- :group 'display-time)
+ :type 'hook)
(defvar display-time-server-down-time nil
"Time when mail file's file system was recorded to be down.
If that file system seems to be up, the value is nil.")
-(defcustom zoneinfo-style-world-list
- '(("America/Los_Angeles" "Seattle")
- ("America/New_York" "New York")
- ("Europe/London" "London")
- ("Europe/Paris" "Paris")
- ("Asia/Calcutta" "Bangalore")
- ("Asia/Tokyo" "Tokyo"))
- "Alist of zoneinfo-style time zones and places for `display-time-world'.
-Each element has the form (TIMEZONE LABEL).
-TIMEZONE should be a string of the form AREA/LOCATION, where AREA is
-the name of a region -- a continent or ocean, and LOCATION is the name
-of a specific location, e.g., a city, within that region.
-LABEL is a string to display as the label of that TIMEZONE's time."
- :group 'display-time
- :type '(repeat (list string string))
- :version "23.1")
-
-(defcustom legacy-style-world-list
- '(("PST8PDT" "Seattle")
- ("EST5EDT" "New York")
- ("GMT0BST" "London")
- ("CET-1CDT" "Paris")
- ("IST-5:30" "Bangalore")
- ("JST-9" "Tokyo"))
- "Alist of traditional-style time zones and places for `display-time-world'.
-Each element has the form (TIMEZONE LABEL).
-TIMEZONE should be a string of the form:
-
- std[+|-]offset[dst[offset][,date[/time],date[/time]]]
-
-See the documentation of the TZ environment variable on your system,
-for more details about the format of TIMEZONE.
-LABEL is a string to display as the label of that TIMEZONE's time."
- :group 'display-time
- :type '(repeat (list string string))
- :version "23.1")
-
-(defcustom display-time-world-list t
- "Alist of time zones and places for `display-time-world' to display.
-Each element has the form (TIMEZONE LABEL).
-TIMEZONE should be in a format supported by your system. See the
-documentation of `zoneinfo-style-world-list' and
-`legacy-style-world-list' for two widely used formats. LABEL is
-a string to display as the label of that TIMEZONE's time.
-
-If the value is t instead of an alist, use the value of
-`zoneinfo-style-world-list' if it works on this platform, and of
-`legacy-style-world-list' otherwise."
-
- :group 'display-time
- :type '(choice (const :tag "Default" t)
- (repeat :tag "List of zones and labels"
- (list (string :tag "Zone") (string :tag "Label"))))
- :version "23.1")
-
-(defun time--display-world-list ()
- (if (listp display-time-world-list)
- display-time-world-list
- ;; Determine if zoneinfo style timezones are supported by testing that
- ;; America/New York and Europe/London return different timezones.
- (let ((nyt (format-time-string "%z" nil "America/New_York"))
- (gmt (format-time-string "%z" nil "Europe/London")))
- (if (string-equal nyt gmt)
- legacy-style-world-list
- zoneinfo-style-world-list))))
-
-(defcustom display-time-world-time-format "%A %d %B %R %Z"
- "Format of the time displayed, see `format-time-string'."
- :group 'display-time
- :type 'string
- :version "23.1")
-
-(defcustom display-time-world-buffer-name "*wclock*"
- "Name of the world clock buffer."
- :group 'display-time
- :type 'string
- :version "23.1")
-
-(defcustom display-time-world-timer-enable t
- "If non-nil, a timer will update the world clock."
- :group 'display-time
- :type 'boolean
- :version "23.1")
-
-(defcustom display-time-world-timer-second 60
- "Interval in seconds for updating the world clock."
- :group 'display-time
- :type 'integer
- :version "23.1")
-
;;;###autoload
(defun display-time ()
"Enable display of time, load level, and mail flag in mode lines.
@@ -249,14 +150,12 @@ See `display-time-use-mail-icon' and `display-time-mail-face'.")
"Non-nil means use an icon as mail indicator on a graphic display.
Otherwise use `display-time-mail-string'. The icon may consume less
of the mode line. It is specified by `display-time-mail-icon'."
- :group 'display-time
:type 'boolean)
;; Fixme: maybe default to the character if we can display Unicode.
(defcustom display-time-mail-string "Mail"
"String to use as the mail indicator in `display-time-string-forms'.
This can use the Unicode letter character if you can display it."
- :group 'display-time
:version "22.1"
:type '(choice (const "Mail")
;; Use :tag here because the Lucid menu won't display
@@ -270,8 +169,7 @@ See the function `format-time-string' for an explanation of
how to write this string. If this is nil, the defaults
depend on `display-time-day-and-date' and `display-time-24hr-format'."
:type '(choice (const :tag "Default" nil)
- string)
- :group 'display-time)
+ string))
(defcustom display-time-string-forms
'((if (and (not display-time-format) display-time-day-and-date)
@@ -325,8 +223,7 @@ For example:
(if mail \" Mail\" \"\"))
would give mode line times like `94/12/30 21:07:48 (UTC)'."
- :type '(repeat sexp)
- :group 'display-time)
+ :type '(repeat sexp))
(defun display-time-event-handler ()
(display-time-update)
@@ -508,13 +405,127 @@ runs the normal hook `display-time-hook' after each update."
(remove-hook 'rmail-after-get-new-mail-hook
'display-time-event-handler)))
+
+;;; Obsolete names
+
+(define-obsolete-variable-alias 'display-time-world-list
+ 'world-clock-list "28.1")
+(define-obsolete-variable-alias 'display-time-world-time-format
+ 'world-clock-time-format "28.1")
+(define-obsolete-variable-alias 'display-time-world-buffer-name
+ 'world-clock-buffer-name "28.1")
+(define-obsolete-variable-alias 'display-time-world-timer-enable
+ 'world-clock-timer-enable "28.1")
+(define-obsolete-variable-alias 'display-time-world-timer-second
+ 'world-clock-timer-second "28.1")
+
+(define-obsolete-function-alias 'display-time-world-mode
+ #'world-clock-mode "28.1")
+(define-obsolete-function-alias 'display-time-world-display
+ #'world-clock-display "28.1")
+(define-obsolete-function-alias 'display-time-world-timer
+ #'world-clock-update "28.1")
+
+
+;;; World clock
+
+(defgroup world-clock nil
+ "Display a world clock."
+ :group 'display-time)
+
+(defcustom zoneinfo-style-world-list
+ '(("America/Los_Angeles" "Seattle")
+ ("America/New_York" "New York")
+ ("Europe/London" "London")
+ ("Europe/Paris" "Paris")
+ ("Asia/Calcutta" "Bangalore")
+ ("Asia/Tokyo" "Tokyo"))
+ "Alist of zoneinfo-style time zones and places for `world-clock'.
+Each element has the form (TIMEZONE LABEL).
+TIMEZONE should be a string of the form AREA/LOCATION, where AREA is
+the name of a region -- a continent or ocean, and LOCATION is the name
+of a specific location, e.g., a city, within that region.
+LABEL is a string to display as the label of that TIMEZONE's time."
+ :type '(repeat (list string string))
+ :version "23.1")
+
+(defcustom legacy-style-world-list
+ '(("PST8PDT" "Seattle")
+ ("EST5EDT" "New York")
+ ("GMT0BST" "London")
+ ("CET-1CDT" "Paris")
+ ("IST-5:30" "Bangalore")
+ ("JST-9" "Tokyo"))
+ "Alist of traditional-style time zones and places for `world-clock'.
+Each element has the form (TIMEZONE LABEL).
+TIMEZONE should be a string of the form:
+
+ std[+|-]offset[dst[offset][,date[/time],date[/time]]]
+
+See the documentation of the TZ environment variable on your system,
+for more details about the format of TIMEZONE.
+LABEL is a string to display as the label of that TIMEZONE's time."
+ :type '(repeat (list string string))
+ :version "23.1")
+
+(defcustom world-clock-list t
+ "Alist of time zones and places for `world-clock' to display.
+Each element has the form (TIMEZONE LABEL).
+TIMEZONE should be in a format supported by your system. See the
+documentation of `zoneinfo-style-world-list' and
+`legacy-style-world-list' for two widely used formats. LABEL is
+a string to display as the label of that TIMEZONE's time.
+
+If the value is t instead of an alist, use the value of
+`zoneinfo-style-world-list' if it works on this platform, and of
+`legacy-style-world-list' otherwise."
+ :type '(choice (const :tag "Default" t)
+ (repeat :tag "List of zones and labels"
+ (list (string :tag "Zone") (string :tag "Label"))))
+ :version "28.1")
+
+(defun time--display-world-list ()
+ (if (listp world-clock-list)
+ world-clock-list
+ ;; Determine if zoneinfo style timezones are supported by testing that
+ ;; America/New York and Europe/London return different timezones.
+ (let ((nyt (format-time-string "%z" nil "America/New_York"))
+ (gmt (format-time-string "%z" nil "Europe/London")))
+ (if (string-equal nyt gmt)
+ legacy-style-world-list
+ zoneinfo-style-world-list))))
-(define-derived-mode display-time-world-mode special-mode "World clock"
+(defcustom world-clock-time-format "%A %d %B %R %Z"
+ "Time format for `world-clock', see `format-time-string'."
+ :type 'string
+ :version "28.1")
+
+(defcustom world-clock-buffer-name "*wclock*"
+ "Name of the `world-clock' buffer."
+ :type 'string
+ :version "28.1")
+
+(defcustom world-clock-timer-enable t
+ "If non-nil, a timer will update the `world-clock' buffer."
+ :type 'boolean
+ :version "28.1")
+
+(defcustom world-clock-timer-second 60
+ "Interval in seconds for updating the `world-clock' buffer."
+ :type 'integer
+ :version "28.1")
+
+(defface world-clock-label
+ '((t :inherit font-lock-variable-name-face))
+ "Face for time zone label in `world-clock' buffer.")
+
+(define-derived-mode world-clock-mode special-mode "World clock"
"Major mode for buffer that displays times in various time zones.
-See `display-time-world'."
+See `world-clock'."
+ (setq-local revert-buffer-function #'world-clock-update)
(setq show-trailing-whitespace nil))
-(defun display-time-world-display (alist)
+(defun world-clock-display (alist)
"Replace current buffer text with times in various zones, based on ALIST."
(let ((inhibit-read-only t)
(buffer-undo-list t)
@@ -526,58 +537,74 @@ See `display-time-world'."
(let* ((label (cadr zone))
(width (string-width label)))
(push (cons label
- (format-time-string display-time-world-time-format
+ (format-time-string world-clock-time-format
now (car zone)))
result)
(when (> width max-width)
(setq max-width width))))
(setq fmt (concat "%-" (int-to-string max-width) "s %s\n"))
(dolist (timedata (nreverse result))
- (insert (format fmt (car timedata) (cdr timedata))))
+ (insert (format fmt
+ (propertize (car timedata)
+ 'face 'world-clock-label)
+ (cdr timedata))))
(delete-char -1))
(goto-char (point-min)))
;;;###autoload
-(defun display-time-world ()
- "Enable updating display of times in various time zones.
-`display-time-world-list' specifies the zones.
-To turn off the world time display, go to that window and type `q'."
+(define-obsolete-function-alias 'display-time-world
+ #'world-clock "28.1")
+
+;;;###autoload
+(defun world-clock ()
+ "Display a world clock buffer with times in various time zones.
+The variable `world-clock-list' specifies which time zones to use.
+To turn off the world time display, go to the window and type `\\[quit-window]'."
(interactive)
- (when (and display-time-world-timer-enable
- (not (get-buffer display-time-world-buffer-name)))
- (run-at-time t display-time-world-timer-second 'display-time-world-timer))
- (with-current-buffer (get-buffer-create display-time-world-buffer-name)
- (display-time-world-display (time--display-world-list))
- (display-buffer display-time-world-buffer-name
- (cons nil '((window-height . fit-window-to-buffer))))
- (display-time-world-mode)))
-
-(defun display-time-world-timer ()
- (if (get-buffer display-time-world-buffer-name)
- (with-current-buffer (get-buffer display-time-world-buffer-name)
- (display-time-world-display (time--display-world-list)))
- ;; cancel timer
- (let ((list timer-list))
- (while list
- (let ((elt (pop list)))
- (when (equal (symbol-name (timer--function elt))
- "display-time-world-timer")
- (cancel-timer elt)))))))
+ (if-let ((buffer (get-buffer world-clock-buffer-name)))
+ (pop-to-buffer buffer)
+ (pop-to-buffer world-clock-buffer-name)
+ (when world-clock-timer-enable
+ (run-at-time t world-clock-timer-second #'world-clock-update)
+ (add-hook 'kill-buffer-hook #'world-clock-cancel-timer nil t)))
+ (world-clock-display (time--display-world-list))
+ (world-clock-mode)
+ (fit-window-to-buffer))
+
+(defun world-clock-cancel-timer ()
+ "Cancel the world clock timer."
+ (let ((list timer-list))
+ (while list
+ (let ((elt (pop list)))
+ (when (equal (symbol-name (timer--function elt))
+ "world-clock-update")
+ (cancel-timer elt))))))
+
+(defun world-clock-update (&optional _arg _noconfirm)
+ "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)))
+ (world-clock-cancel-timer)))
;;;###autoload
-(defun emacs-uptime (&optional format)
+(defun emacs-uptime (&optional format here)
"Return a string giving the uptime of this instance of Emacs.
FORMAT is a string to format the result, using `format-seconds'.
-For example, the Unix uptime command format is \"%D, %z%2h:%.2m\"."
- (interactive)
+For example, the Unix uptime command format is \"%D, %z%2h:%.2m\".
+If the optional argument HERE is non-nil, insert string at
+point."
+ (interactive "i\nP")
(let ((str
(format-seconds (or format "%Y, %D, %H, %M, %z%S")
(time-convert
(time-since before-init-time)
'integer))))
- (if (called-interactively-p 'interactive)
- (message "%s" str)
- str)))
+ (if here
+ (insert str)
+ (if (called-interactively-p 'interactive)
+ (message "%s" str)
+ str))))
;;;###autoload
(defun emacs-init-time ()
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index f35f6b9a03e..5f5a4788b26 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -167,8 +167,6 @@ This variable has effect only on GUI frames."
;;; Variables that are not customizable.
-(define-obsolete-variable-alias 'tooltip-hook 'tooltip-functions "23.1")
-
(defvar tooltip-functions nil
"Functions to call to display tooltips.
Each function is called with one argument EVENT which is a copy
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index 70e8ecee745..e6a1b35bc06 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -104,6 +104,14 @@ would have the following buffer names in the various styles:
post-forward-angle-brackets name<bar/mumble> name<quux/mumble>
nil name name<2>
+The value can be set to a customized function with two arguments
+BASE and EXTRA-STRINGS where BASE is a string and EXTRA-STRINGS
+is a list of strings. For example the current implementation for
+post-forward-angle-brackets could be:
+
+(defun my-post-forward-angle-brackets (base extra-string)
+ (concat base \"<\" (mapconcat #'identity extra-string \"/\") \">\"))
+
The \"mumble\" part may be stripped as well, depending on the
setting of `uniquify-strip-common-suffix'. For more options that
you can set, browse the `uniquify' custom group."
@@ -111,6 +119,7 @@ you can set, browse the `uniquify' custom group."
(const reverse)
(const post-forward)
(const post-forward-angle-brackets)
+ (function :tag "Other")
(const :tag "numeric suffixes" nil))
:version "24.4"
:require 'uniquify)
@@ -364,20 +373,22 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
(cond
((null extra-string) base)
((string-equal base "") ;Happens for dired buffers on the root directory.
- (mapconcat 'identity extra-string "/"))
+ (mapconcat #'identity extra-string "/"))
((eq uniquify-buffer-name-style 'reverse)
- (mapconcat 'identity
+ (mapconcat #'identity
(cons base (nreverse extra-string))
(or uniquify-separator "\\")))
((eq uniquify-buffer-name-style 'forward)
- (mapconcat 'identity (nconc extra-string (list base))
+ (mapconcat #'identity (nconc extra-string (list base))
"/"))
((eq uniquify-buffer-name-style 'post-forward)
(concat base (or uniquify-separator "|")
- (mapconcat 'identity extra-string "/")))
+ (mapconcat #'identity extra-string "/")))
((eq uniquify-buffer-name-style 'post-forward-angle-brackets)
- (concat base "<" (mapconcat 'identity extra-string "/")
+ (concat base "<" (mapconcat #'identity extra-string "/")
">"))
+ ((functionp uniquify-buffer-name-style)
+ (funcall uniquify-buffer-name-style base extra-string))
(t (error "Bad value for uniquify-buffer-name-style: %s"
uniquify-buffer-name-style)))))
diff --git a/lisp/url/url-about.el b/lisp/url/url-about.el
index dde47e94de5..5fe817cc0e8 100644
--- a/lisp/url/url-about.el
+++ b/lisp/url/url-about.el
@@ -51,7 +51,7 @@
" <title>Supported Protocols</title>\n"
" </head>\n"
" <body>\n"
- " <h1>Supported Protocols - URL v" url-version "</h1>\n"
+ " <h1>Supported Protocols - URL package in Emacs " emacs-version "</h1>\n"
" <table width='100%' border='1'>\n"
" <tr>\n"
" <td>Protocol\n"
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index f2044617b94..8f39b5ae010 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -39,7 +39,7 @@
;;; ------------------------
;;; This implements the BASIC authorization type. See the online
;;; documentation at
-;;; http://www.w3.org/hypertext/WWW/AccessAuthorization/Basic.html
+;;; https://www.w3.org/hypertext/WWW/AccessAuthorization/Basic.html
;;; for the complete documentation on this type.
;;;
;;; This is very insecure, but it works as a proof-of-concept
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index a67e5dcd125..056ad1e0188 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -125,8 +125,8 @@ The actual return value is the last modification time of the cache file."
(setq fname (and fname
(mapconcat
- (function (lambda (x)
- (if (= x ?~) "" (char-to-string x))))
+ (lambda (x)
+ (if (= x ?~) "" (char-to-string x)))
fname ""))
fname (cond
((null fname) nil)
diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el
index 47964b081f4..be9b5426dc4 100644
--- a/lisp/url/url-expand.el
+++ b/lisp/url/url-expand.el
@@ -92,12 +92,19 @@ path components followed by `..' are removed, along with the `..' itself."
(cond
((= (length url) 0) ; nil or empty string
(url-recreate-url default))
- ((string-match url-nonrelative-link url) ; Fully-qualified URL, return it immediately
+ ((string-match url-nonrelative-link url) ; Fully-qualified URL,
+ ; return it immediately
url)
(t
(let* ((urlobj (url-generic-parse-url url))
(inhibit-file-name-handlers t)
- (expander (url-scheme-get-property (url-type default) 'expand-file-name)))
+ (expander (if (url-type default)
+ (url-scheme-get-property (url-type default)
+ 'expand-file-name)
+ ;; If neither the default nor the URL to be
+ ;; expanded have a protocol, then just use the
+ ;; identity expander as a fallback.
+ 'url-identity-expander)))
(if (string-match "^//" url)
(setq urlobj (url-generic-parse-url (concat (url-type default) ":"
url))))
@@ -113,7 +120,7 @@ path components followed by `..' are removed, along with the `..' itself."
;; Well, they told us the scheme, let's just go with it.
nil
(setf (url-type urlobj) (or (url-type urlobj) (url-type defobj)))
- (setf (url-port urlobj) (or (url-portspec urlobj)
+ (setf (url-portspec urlobj) (or (url-portspec urlobj)
(and (string= (url-type urlobj)
(url-type defobj))
(url-port defobj))))
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index bcb67431aa8..f16fc234025 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -191,7 +191,7 @@ linked Emacs under SunOS 4.x."
proc (concat (mapconcat 'identity
(append url-gateway-telnet-parameters
(list host service)) " ") "\n"))
- (url-wait-for-string "^\r*Escape character.*\r*\n+" proc)
+ (url-wait-for-string "^\r*Escape character.*\n+" proc)
(delete-region (point-min) (match-end 0))
(process-send-string proc "\^]\n")
(url-wait-for-string "^telnet" proc)
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 331152808fd..1c3607bb661 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -339,8 +339,7 @@ if it had been inserted from a file named URL."
(decode-coding-inserted-region (point-min) (point) url
visit beg end replace))
(let ((inserted (car size-and-charset)))
- (list url (or (and (fboundp 'after-insert-file-set-coding)
- (after-insert-file-set-coding inserted visit))
+ (list url (or (after-insert-file-set-coding inserted visit)
inserted))))))
;;;###autoload
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 55953c83c04..8532da1d1fb 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -225,7 +225,7 @@ request.")
(os-info (unless (and (listp url-privacy-level)
(memq 'os url-privacy-level))
(format "(%s; %s)" url-system-type url-os-type)))
- (url-info (format "URL/%s" url-version)))
+ (url-info (format "URL/Emacs")))
(string-join (delq nil (list package-info url-info
emacs-info os-info))
" ")))
@@ -702,15 +702,7 @@ should be shown to the user."
;; Treat everything like '300'
nil))
(when redirect-uri
- ;; Clean off any whitespace and/or <...> cruft.
- (if (string-match "\\([^ \t]+\\)[ \t]" redirect-uri)
- (setq redirect-uri (match-string 1 redirect-uri)))
- (if (string-match "^<\\(.*\\)>$" redirect-uri)
- (setq redirect-uri (match-string 1 redirect-uri)))
-
- ;; Some stupid sites (like sourceforge) send a
- ;; non-fully-qualified URL (ie: /), which royally confuses
- ;; the URL library.
+ ;; Handle relative redirect URIs.
(if (not (string-match url-nonrelative-link redirect-uri))
;; Be careful to use the real target URL, otherwise we may
;; compute the redirection relative to the URL of the proxy.
@@ -1404,13 +1396,22 @@ The return value of this function is the retrieval buffer."
(defun url-https-proxy-connect (connection)
(setq url-http-after-change-function 'url-https-proxy-after-change-function)
- (process-send-string connection (format (concat "CONNECT %s:%d HTTP/1.1\r\n"
- "Host: %s\r\n"
- "\r\n")
- (url-host url-current-object)
- (or (url-port url-current-object)
- url-https-default-port)
- (url-host url-current-object))))
+ (process-send-string
+ connection
+ (format
+ (concat "CONNECT %s:%d HTTP/1.1\r\n"
+ "Host: %s\r\n"
+ (let ((proxy-auth (let ((url-basic-auth-storage
+ 'url-http-proxy-basic-auth-storage))
+ (url-get-authentication url-http-proxy nil
+ 'any nil))))
+ (and proxy-auth
+ (concat "Proxy-Authorization: " proxy-auth "\r\n")))
+ "\r\n")
+ (url-host url-current-object)
+ (or (url-port url-current-object)
+ url-https-default-port)
+ (url-host url-current-object))))
(defun url-https-proxy-after-change-function (_st _nd _length)
(let* ((process-buffer (current-buffer))
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
index 03a3b37f398..9647df1c13c 100644
--- a/lisp/url/url-irc.el
+++ b/lisp/url/url-irc.el
@@ -22,7 +22,7 @@
;;; Commentary:
;; IRC URLs are defined in
-;; http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
+;; https://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
;;; Code:
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index d47eb02db68..9ef17cccd77 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -75,7 +75,7 @@
" </div>\n"
" </body>\n"
"</html>\n"
- "<!-- Automatically generated by URL v" url-version " -->\n"
+ "<!-- Automatically generated by URL in Emacs " emacs-version " -->\n"
)))
buf))
diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el
index ff18cf1fe40..46cdff0f724 100644
--- a/lisp/url/url-queue.el
+++ b/lisp/url/url-queue.el
@@ -123,17 +123,24 @@ The variable `url-queue-timeout' sets a timeout."
(setq url-queue-progress-timer nil))))
(defun url-queue-callback-function (status job)
- (setq url-queue (delq job url-queue))
- (when (and (eq (car status) :error)
- (eq (cadr (cadr status)) 'connection-failed))
- ;; If we get a connection error, then flush all other jobs from
- ;; the host from the queue. This particularly makes sense if the
- ;; error really is a DNS resolver issue, which happens
- ;; synchronously and totally halts Emacs.
- (url-queue-remove-jobs-from-host
- (plist-get (nthcdr 3 (cadr status)) :host)))
- (url-queue-run-queue)
- (apply (url-queue-callback job) (cons status (url-queue-cbargs job))))
+ (let ((buffer (current-buffer)))
+ (setq url-queue (delq job url-queue))
+ (when (and (eq (car status) :error)
+ (eq (cadr (cadr status)) 'connection-failed))
+ ;; If we get a connection error, then flush all other jobs from
+ ;; the host from the queue. This particularly makes sense if the
+ ;; error really is a DNS resolver issue, which happens
+ ;; synchronously and totally halts Emacs.
+ (url-queue-remove-jobs-from-host
+ (plist-get (nthcdr 3 (cadr status)) :host)))
+ (url-queue-run-queue)
+ ;; Somehow something deep in the bowels in the URL library may
+ ;; have killed off the current buffer. So check that it's still
+ ;; alive before doing anything, and if not, just create a dummy
+ ;; buffer and do the callback anyway.
+ (unless (buffer-live-p buffer)
+ (set-buffer (generate-new-buffer " *temp*")))
+ (apply (url-queue-callback job) (cons status (url-queue-cbargs job)))))
(defun url-queue-remove-jobs-from-host (host)
(let ((jobs nil))
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 645011a5783..0a7e7e205e0 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -569,31 +569,6 @@ Has a preference for looking backward when not directly on a symbol."
(setq url nil))
url)))
-(defun url-generate-unique-filename (&optional fmt)
- "Generate a unique filename in `url-temporary-directory'."
- (declare (obsolete make-temp-file "23.1"))
- ;; This variable is obsolete, but so is this function.
- (let ((tempdir (with-no-warnings url-temporary-directory)))
- (if (not fmt)
- (let ((base (format "url-tmp.%d" (user-real-uid)))
- (fname "")
- (x 0))
- (setq fname (format "%s%d" base x))
- (while (file-exists-p
- (expand-file-name fname tempdir))
- (setq x (1+ x)
- fname (concat base (int-to-string x))))
- (expand-file-name fname tempdir))
- (let ((base (concat "url" (int-to-string (user-real-uid))))
- (fname "")
- (x 0))
- (setq fname (format fmt (concat base (int-to-string x))))
- (while (file-exists-p
- (expand-file-name fname tempdir))
- (setq x (1+ x)
- fname (format fmt (concat base (int-to-string x)))))
- (expand-file-name fname tempdir)))))
-
(defun url-extract-mime-headers ()
"Set `url-current-mime-headers' in current buffer."
(save-excursion
@@ -615,9 +590,7 @@ Creates FILE and its parent directories if they do not exist."
(with-temp-buffer
(write-region (point-min) (point-max) file nil 'silent nil 'excl)))
(file-already-exists
- (if (file-symlink-p file)
- (error "Danger: `%s' is a symbolic link" file))
- (set-file-modes file #o0600))))
+ (set-file-modes file #o0600 'nofollow))))
(autoload 'puny-encode-domain "puny")
(autoload 'url-domsuf-cookie-allowed-p "url-domsuf")
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 82617b76a71..e35823ab9af 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -24,6 +24,7 @@
(defconst url-version "Emacs"
"Version number of URL package.")
+(make-obsolete-variable 'url-version nil "28.1")
(defgroup url nil
"Uniform Resource Locator tool."
@@ -311,13 +312,6 @@ Applies when a protected document is denied by the server."
:type 'integer
:group 'url)
-(defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp")
- "Where temporary files go."
- :type 'directory
- :group 'url-file)
-(make-obsolete-variable 'url-temporary-directory
- 'temporary-file-directory "23.1")
-
(defcustom url-show-status t
"Whether to show a running total of bytes transferred.
Can cause a large hit if using a remote X display over a slow link, or
@@ -430,6 +424,8 @@ Should be one of:
"Hook run after initializing the URL library."
:group 'url
:type 'hook)
+(make-obsolete-variable 'url-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defconst url-working-buffer " *url-work")
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 12a8a9c2e21..33a5ebcdccc 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -24,7 +24,7 @@
;;; Commentary:
-;; Registered URI schemes: http://www.iana.org/assignments/uri-schemes
+;; Registered URI schemes: https://www.iana.org/assignments/uri-schemes
;;; Code:
@@ -238,7 +238,8 @@ how long to wait for a response before giving up."
(let ((retrieval-done nil)
(start-time (current-time))
(url-asynchronous nil)
- (asynch-buffer 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))
@@ -261,7 +262,9 @@ how long to wait for a response before giving up."
;; process output.
(while (and (not retrieval-done)
(or (not timeout)
- (time-less-p (time-since start-time) 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)
@@ -300,8 +303,16 @@ how long to wait for a response before giving up."
(when quit-flag
(delete-process proc))
(setq proc (and (not quit-flag)
- (get-buffer-process asynch-buffer)))))))
- asynch-buffer)))
+ (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))
;; url-mm-callback called from url-mm, which requires mm-decode.
(declare-function mm-dissect-buffer "mm-decode"
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index d302fb16eda..54bb3569788 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -667,7 +667,7 @@ With a numeric prefix ARG, go back ARG comments."
"Prompt for a change log name."
(let* ((default (change-log-name))
(name (expand-file-name
- (read-file-name (format "Log file (default %s): " default)
+ (read-file-name (format-prompt "Log file" default)
nil default))))
;; Handle something that is syntactically a directory name.
;; Look for ChangeLog or whatever in that directory.
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 8171a585158..f223ae48f3b 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -392,6 +392,12 @@ well."
'((t :inherit diff-file-header))
"`diff-mode' face used to highlight nonexistent files in recursive diffs.")
+(defface diff-error
+ '((((class color))
+ :foreground "red" :background "black" :weight bold)
+ (t :weight bold))
+ "`diff-mode' face for error messages from diff.")
+
(defconst diff-yank-handler '(diff-yank-function))
(defun diff-yank-function (text)
;; FIXME: the yank-handler is now called separately on each piece of text
@@ -472,6 +478,7 @@ and the face `diff-added' for added lines.")
("^\\(#\\)\\(.*\\)"
(1 font-lock-comment-delimiter-face)
(2 font-lock-comment-face))
+ ("^diff: .*" (0 'diff-error))
("^[^-=+*!<>#].*\n" (0 'diff-context))
(,#'diff--font-lock-syntax)
(,#'diff--font-lock-prettify)
@@ -484,7 +491,7 @@ and the face `diff-added' for added lines.")
;; Prefer second name as first is most likely to be a backup or
;; version-control name. The [\t\n] at the end of the unidiff pattern
;; catches Debian source diff files (which lack the trailing date).
- '((nil "\\+\\+\\+\\ \\([^\t\n]+\\)[\t\n]" 1) ; unidiffs
+ '((nil "\\+\\+\\+ \\([^\t\n]+\\)[\t\n]" 1) ; unidiffs
(nil "^--- \\([^\t\n]+\\)\t.*\n\\*" 1))) ; context diffs
;;;;
@@ -923,8 +930,12 @@ If the OLD prefix arg is passed, tell the file NAME of the old file."
(progn (diff-hunk-prev) (point))
(error (point-min)))))
(header-files
- ;; handle filenames with spaces;
+ ;; handle file names with spaces;
;; cf. diff-font-lock-keywords / diff-file-header
+ ;; FIXME if there are nonascii characters in the file names,
+ ;; GNU diff displays them as octal escapes.
+ ;; This function should undo that, so as to return file names
+ ;; that are usable in Emacs.
(if (looking-at "[-*][-*][-*] \\([^\t\n]+\\).*\n[-+][-+][-+] \\([^\t\n]+\\)")
(list (if old (match-string 1) (match-string 2))
(if old (match-string 2) (match-string 1)))
@@ -1988,8 +1999,7 @@ revision of the file otherwise."
(diff-find-source-location other-file reverse)))
(pop-to-buffer buf)
(goto-char (+ (car pos) (cdr src)))
- (when buffer (next-error-found buffer (current-buffer)))
- (diff-hunk-status-msg line-offset (xor reverse switched) t))))
+ (when buffer (next-error-found buffer (current-buffer))))))
(defun diff-current-defun ()
@@ -2163,9 +2173,10 @@ Return new point, if it was moved."
(smerge-refine-regions beg-del beg-add beg-add end-add
nil #'diff-refine-preproc props-r props-a)))))
('context
- (let* ((middle (save-excursion (re-search-forward "^---" end)))
+ (let* ((middle (save-excursion (re-search-forward "^---" end t)))
(other middle))
- (while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
+ (while (and middle
+ (re-search-forward "^\\(?:!.*\n\\)+" middle t))
(smerge-refine-regions (match-beginning 0) (match-end 0)
(save-excursion
(goto-char other)
@@ -2518,7 +2529,7 @@ fixed, visit it in a buffer."
'((?+ . (left-fringe diff-fringe-add diff-indicator-added))
(?- . (left-fringe diff-fringe-del diff-indicator-removed))
(?! . (left-fringe diff-fringe-rep diff-indicator-changed))
- (?\s . (left-fringe diff-fringe-nul))))))
+ (?\s . (left-fringe diff-fringe-nul fringe))))))
(put-text-property (match-beginning 0) (match-end 0) 'display spec))))
;; Mimicks the output of Magit's diff.
;; FIXME: This has only been tested with Git's diff output.
@@ -2720,7 +2731,9 @@ hunk text is not found in the source file."
;; When initialization is requested, we should be in a brand new
;; temp buffer.
(cl-assert (null buffer-file-name))
- (let ((enable-local-variables :safe) ;; to find `mode:'
+ ;; Use `:safe' to find `mode:'. In case of hunk-only, use nil because
+ ;; Local Variables list might be incomplete when context is truncated.
+ (let ((enable-local-variables (unless hunk-only :safe))
(buffer-file-name file))
;; Don't run hooks that might assume buffer-file-name
;; really associates buffer with a file (bug#39190).
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index 469888078c4..b7f17bf3c73 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -258,6 +258,8 @@ This requires the external program `diff' to be in your `exec-path'."
(interactive "bBuffer: ")
(let ((buf (get-buffer (or buffer (current-buffer)))))
(with-current-buffer (or (buffer-base-buffer buf) buf)
+ (unless buffer-file-name
+ (error "Buffer is not visiting a file"))
(diff buffer-file-name (current-buffer) nil 'noasync))))
;;;###autoload
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index ef466741b24..ccf5a7807f2 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -325,6 +325,10 @@ one optional arguments, diff-number to refine.")
(error-buf ediff-error-buffer))
(ediff-skip-unsuitable-frames)
(switch-to-buffer error-buf)
+ ;; We output data from the diff command using `raw-text' as
+ ;; the coding system, so decode before displaying.
+ (when (eq ediff-coding-system-for-read 'raw-text)
+ (decode-coding-region (point-min) (point-max) 'undecided))
(ediff-kill-buffer-carefully ctl-buf)
(user-error "Errors in diff output. Diff output is in %S" diff-buff))))
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index fb1f25b6c6d..04926af16ef 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -452,6 +452,8 @@ For each buffer, the hooks are run with that buffer made current."
"Hook run after Ediff is loaded. Can be used to change defaults."
:type 'hook
:group 'ediff-hook)
+(make-obsolete-variable 'ediff-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom ediff-mode-hook nil
"Hook run just after ediff-mode is set up in the control buffer.
@@ -1255,22 +1257,8 @@ Instead, C-h would jump to previous difference."
:type 'boolean
:group 'ediff)
-;; This is the same as temporary-file-directory from Emacs 20.3.
-;; Copied over here because XEmacs doesn't have this variable.
-(defcustom ediff-temp-file-prefix
- (file-name-as-directory
- (cond ((boundp 'temporary-file-directory) temporary-file-directory)
- ((fboundp 'temp-directory) (temp-directory))
- (t "/tmp/")))
-;;; (file-name-as-directory
-;;; (cond ((memq system-type '(ms-dos windows-nt))
-;;; (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
-;;; (t
-;;; (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
- "Prefix to put on Ediff temporary file names.
-Do not start with `~/' or `~USERNAME/'."
- :type 'string
- :group 'ediff)
+(define-obsolete-variable-alias 'ediff-temp-file-prefix
+ 'temporary-file-directory "28.1")
(defcustom ediff-temp-file-mode 384 ; u=rw only
"Mode for Ediff temporary files."
@@ -1282,11 +1270,11 @@ Do not start with `~/' or `~USERNAME/'."
(defcustom ediff-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]"
"Regexp that matches characters that must be quoted with `\\' in shell command line.
This default should work without changes."
- :type 'string
+ :type 'regexp
:group 'ediff)
-;; needed to simulate frame-char-width in XEmacs.
-(defvar ediff-H-glyph (if (featurep 'xemacs) (make-glyph "H")))
+(defvar ediff-H-glyph nil)
+(make-obsolete-variable 'ediff-H-glyph nil "28.1")
;; Temporary file used for refining difference regions in buffer A.
@@ -1522,34 +1510,9 @@ This default should work without changes."
(setq dir (substring dir 0 pos)))
(ediff-abbreviate-file-name (file-name-directory dir))))
-(defun ediff-truncate-string-left (str newlen)
- ;; leave space for ... on the left
- (let ((len (length str))
- substr)
- (if (<= len newlen)
- str
- (setq newlen (max 0 (- newlen 3)))
- (setq substr (substring str (max 0 (- len 1 newlen))))
- (concat "..." substr))))
-
(defsubst ediff-nonempty-string-p (string)
(and (stringp string) (not (string= string ""))))
-(unless (fboundp 'subst-char-in-string)
- (defun subst-char-in-string (fromchar tochar string &optional inplace)
- "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
-Unless optional argument INPLACE is non-nil, return a new string."
- (let ((i (length string))
- (newstr (if inplace string (copy-sequence string))))
- (while (> i 0)
- (setq i (1- i))
- (if (eq (aref newstr i) fromchar)
- (aset newstr i tochar)))
- newstr)))
-
-(unless (fboundp 'format-message)
- (defalias 'format-message 'format))
-
(defun ediff-abbrev-jobname (jobname)
(cond ((eq jobname 'ediff-directories)
"Compare two directories")
@@ -1610,9 +1573,8 @@ Unless optional argument INPLACE is non-nil, return a new string."
(defun ediff-convert-standard-filename (fname)
- (if (fboundp 'convert-standard-filename)
- (convert-standard-filename fname)
- fname))
+ (declare (obsolete convert-standard-filename "28.1"))
+ (convert-standard-filename fname))
(define-obsolete-function-alias 'ediff-with-syntax-table
#'with-syntax-table "27.1")
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index fee87e8352e..c977291a524 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -113,7 +113,6 @@
(require 'ediff-wind)
(require 'ediff-util)
-
;; meta-buffer
(ediff-defvar-local ediff-meta-buffer nil "")
(ediff-defvar-local ediff-parent-meta-buffer nil "")
@@ -1172,7 +1171,7 @@ behavior."
;; abbreviate the file name, if file exists
(if (and (not (stringp fname)) (< file-size -1))
"-------" ; file doesn't exist
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name fname)
max-filename-width)))))))
@@ -1266,7 +1265,7 @@ Useful commands:
(if (= (mod membership-code ediff-membership-code1) 0) ; dir1
(let ((beg (point)))
(insert (format "%-27s"
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir1 file))
(file-name-as-directory file)
@@ -1281,7 +1280,7 @@ Useful commands:
(if (= (mod membership-code ediff-membership-code2) 0) ; dir2
(let ((beg (point)))
(insert (format "%-26s"
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir2 file))
(file-name-as-directory file)
@@ -1295,7 +1294,7 @@ Useful commands:
(if (= (mod membership-code ediff-membership-code3) 0) ; dir3
(let ((beg (point)))
(insert (format " %-25s"
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir3 file))
(file-name-as-directory file)
@@ -1808,11 +1807,9 @@ all marked sessions must be active."
(ediff-show-meta-buffer session-buf)
(setq regexp
(read-string
- (if (stringp default-regexp)
- (format
- "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt
+ "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp t)))
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index cb0ae6ff6e1..f6af5a45550 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -119,7 +119,7 @@ patch. So, don't change these variables, unless the default doesn't work."
(defcustom ediff-context-diff-label-regexp
(let ((stuff "\\([^ \t\n]+\\)"))
(concat "\\(" ; context diff 2-liner
- "^\\*\\*\\* +" stuff "[^*]+[\t ]*\n--- +" stuff
+ "^\\*\\*\\* +" stuff "[^*]+\n--- +" stuff
"\\|" ; unified format diff 2-liner
"^--- +" stuff ".*\n\\+\\+\\+ +" stuff
"\\)"))
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index a8af9ba37a2..e28d8574b1c 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -131,7 +131,6 @@ to invocation.")
(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))
- ;; must come after C-h, or else C-h wipes out backspace's binding in XEmacs
(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)
@@ -241,18 +240,16 @@ to invocation.")
startup-hooks setup-parameters
&optional merge-buffer-file)
(run-hooks 'ediff-before-setup-hook)
- ;; ediff-convert-standard-filename puts file names in the form appropriate
+ ;; convert-standard-filename puts file names in the form appropriate
;; for the OS at hand.
- (setq file-A (ediff-convert-standard-filename (expand-file-name file-A)))
- (setq file-B (ediff-convert-standard-filename (expand-file-name file-B)))
+ (setq file-A (convert-standard-filename (expand-file-name file-A)))
+ (setq file-B (convert-standard-filename (expand-file-name file-B)))
(if (stringp file-C)
- (setq file-C
- (ediff-convert-standard-filename (expand-file-name file-C))))
+ (setq file-C (convert-standard-filename (expand-file-name file-C))))
(if (stringp merge-buffer-file)
(progn
(setq merge-buffer-file
- (ediff-convert-standard-filename
- (expand-file-name merge-buffer-file)))
+ (convert-standard-filename (expand-file-name merge-buffer-file)))
;; check the directory exists
(or (file-exists-p (file-name-directory merge-buffer-file))
(error "Directory %s given as place to save the merge doesn't exist"
@@ -1540,10 +1537,10 @@ the width of the A/B/C windows."
;; hscrolling.
(if (= last-command-event ?<)
(lambda (arg)
- (let ((prefix-arg arg))
+ (let ((current-prefix-arg arg))
(call-interactively #'scroll-left)))
(lambda (arg)
- (let ((prefix-arg arg))
+ (let ((current-prefix-arg arg))
(call-interactively #'scroll-right))))
;; calculate argument to scroll-left/right
;; if there is an explicit argument
@@ -2184,19 +2181,18 @@ a regular expression typed in by the user."
(setq ediff-skip-diff-region-function ediff-hide-regexp-matches-function
regexp-A
(read-string
- (format
- "Ignore A-regions matching this regexp (default %s): "
- ediff-regexp-hide-A))
+ (format-prompt
+ "Ignore A-regions matching this regexp" ediff-regexp-hide-A))
regexp-B
(read-string
- (format
- "Ignore B-regions matching this regexp (default %s): "
+ (format-prompt
+ "Ignore B-regions matching this regexp"
ediff-regexp-hide-B)))
(if ediff-3way-comparison-job
(setq regexp-C
(read-string
- (format
- "Ignore C-regions matching this regexp (default %s): "
+ (format-prompt
+ "Ignore C-regions matching this regexp"
ediff-regexp-hide-C))))
(if (eq ediff-hide-regexp-connective 'and)
(setq msg-connective "BOTH"
@@ -2223,20 +2219,18 @@ a regular expression typed in by the user."
ediff-focus-on-regexp-matches-function
regexp-A
(read-string
- (format
- "Focus on A-regions matching this regexp (default %s): "
- ediff-regexp-focus-A))
+ (format-prompt
+ "Focus on A-regions matching this regexp" ediff-regexp-focus-A))
regexp-B
(read-string
- (format
- "Focus on B-regions matching this regexp (default %s): "
- ediff-regexp-focus-B)))
+ (format-prompt
+ "Focus on B-regions matching this regexp" ediff-regexp-focus-B)))
(if ediff-3way-comparison-job
(setq regexp-C
(read-string
- (format
- "Focus on C-regions matching this regexp (default %s): "
- ediff-regexp-focus-C))))
+ (format-prompt
+ "Focus on C-regions matching this regexp"
+ ediff-regexp-focus-C))))
(if (eq ediff-focus-regexp-connective 'and)
(setq msg-connective "BOTH"
alt-msg-connective "ONE OF"
@@ -3070,10 +3064,8 @@ Hit \\[ediff-recenter] to reset the windows afterward."
;; for compatibility
-(defmacro ediff-minibuffer-with-setup-hook (fun &rest body)
- `(if (fboundp 'minibuffer-with-setup-hook)
- (minibuffer-with-setup-hook ,fun ,@body)
- ,@body))
+(define-obsolete-function-alias 'ediff-minibuffer-with-setup-hook
+ #'minibuffer-with-setup-hook "28.1")
;; This is adapted from a similar function in `emerge.el'.
;; PROMPT should not have a trailing ': ', so that it can be modified
@@ -3102,7 +3094,7 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(and default-file (list default-file))
default-dir)))
f)
- (setq f (ediff-minibuffer-with-setup-hook
+ (setq f (minibuffer-with-setup-hook
(lambda () (when defaults
(setq minibuffer-default defaults)))
(read-file-name
@@ -3135,7 +3127,7 @@ Hit \\[ediff-recenter] to reset the windows afterward."
;; Also, save buffer from START to END in the file.
;; START defaults to (point-min), END to (point-max)
(defun ediff-make-temp-file (buff &optional prefix given-file start end)
- (let* ((p (ediff-convert-standard-filename (or prefix "ediff")))
+ (let* ((p (convert-standard-filename (or prefix "ediff")))
(short-p p)
(coding-system-for-write ediff-coding-system-for-write)
f short-f)
@@ -3144,8 +3136,8 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(> (length p) 2))
(setq short-p (substring p 0 2)))
- (setq f (concat ediff-temp-file-prefix p)
- short-f (concat ediff-temp-file-prefix short-p)
+ (setq f (concat temporary-file-directory p)
+ short-f (concat temporary-file-directory short-p)
f (cond (given-file)
((find-file-name-handler f 'insert-file-contents)
;; to thwart file name handlers in write-region,
@@ -3449,7 +3441,6 @@ Without an argument, it saves customized diff argument, if available
(declare-function ediff-regions-internal "ediff"
(buffer-a beg-a end-a buffer-b beg-b end-b
startup-hooks job-name word-mode setup-parameters))
-(defvar zmacs-regions) ;;XEmacs'ism.
(defun ediff-inferior-compare-regions ()
"Compare regions in an active Ediff session.
@@ -3461,7 +3452,6 @@ Ediff Control Panel to restore highlighting."
(interactive)
(let ((answer "")
(possibilities (list ?A ?B ?C))
- (zmacs-regions t)
use-current-diff-p
begA begB endA endB bufA bufB)
@@ -4139,10 +4129,10 @@ Mail anyway? (y or n) ")
(ediff-with-current-buffer standard-output
(fundamental-mode))
(princ (format "\nCtl buffer: %S\n" ediff-control-buffer))
- (ediff-print-diff-vector (intern "ediff-difference-vector-A"))
- (ediff-print-diff-vector (intern "ediff-difference-vector-B"))
- (ediff-print-diff-vector (intern "ediff-difference-vector-C"))
- (ediff-print-diff-vector (intern "ediff-difference-vector-Ancestor"))
+ (ediff-print-diff-vector 'ediff-difference-vector-A)
+ (ediff-print-diff-vector 'ediff-difference-vector-B)
+ (ediff-print-diff-vector 'ediff-difference-vector-C)
+ (ediff-print-diff-vector 'ediff-difference-vector-Ancestor)
))
diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el
index a95606fad5e..4ee7ee5c1f5 100644
--- a/lisp/vc/ediff-vers.el
+++ b/lisp/vc/ediff-vers.el
@@ -49,15 +49,10 @@ comparison or merge operations are being performed."
:group 'ediff-vers
)
-(defalias 'ediff-vc-revision-other-window
- (if (fboundp 'vc-revision-other-window)
- 'vc-revision-other-window
- 'vc-version-other-window))
-
-(defalias 'ediff-vc-working-revision
- (if (fboundp 'vc-working-revision)
- 'vc-working-revision
- 'vc-workfile-version))
+(define-obsolete-function-alias 'ediff-vc-revision-other-window
+ #'vc-revision-other-window "28.1")
+(define-obsolete-function-alias 'ediff-vc-working-revision
+ #'vc-working-revision "28.1")
;; VC.el support
@@ -88,12 +83,12 @@ comparison or merge operations are being performed."
(setq rev1 (ediff-vc-latest-version (buffer-file-name))))
(save-window-excursion
(save-excursion
- (ediff-vc-revision-other-window rev1)
+ (vc-revision-other-window rev1)
(setq rev1buf (current-buffer)
file1 (buffer-file-name)))
(save-excursion
(or (string= rev2 "") ; use current buffer
- (ediff-vc-revision-other-window rev2))
+ (vc-revision-other-window rev2))
(setq rev2buf (current-buffer)
file2 (buffer-file-name)))
(push (lambda ()
@@ -165,18 +160,18 @@ comparison or merge operations are being performed."
(let (buf1 buf2 ancestor-buf)
(save-window-excursion
(save-excursion
- (ediff-vc-revision-other-window rev1)
+ (vc-revision-other-window rev1)
(setq buf1 (current-buffer)))
(save-excursion
(or (string= rev2 "")
- (ediff-vc-revision-other-window rev2))
+ (vc-revision-other-window rev2))
(setq buf2 (current-buffer)))
(if ancestor-rev
(save-excursion
(if (string= ancestor-rev "")
- (setq ancestor-rev (ediff-vc-working-revision
+ (setq ancestor-rev (vc-working-revision
buffer-file-name)))
- (ediff-vc-revision-other-window ancestor-rev)
+ (vc-revision-other-window ancestor-rev)
(setq ancestor-buf (current-buffer))))
(push (let ((f1 (buffer-file-name buf1))
(f2 (unless (string= rev2 "") (buffer-file-name buf2)))
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 7b2e1109c87..a23d72070ab 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -156,12 +156,10 @@ In this case, Ediff will use those frames to display these buffers."
'(name . "Ediff")
;;'(unsplittable . t)
'(minibuffer . nil)
- '(user-position . t) ; Emacs only
- '(vertical-scroll-bars . nil) ; Emacs only
- '(scrollbar-width . 0) ; XEmacs only
- '(scrollbar-height . 0) ; XEmacs only
- '(menu-bar-lines . 0) ; Emacs only
- '(tool-bar-lines . 0) ; Emacs 21+ only
+ '(user-position . t)
+ '(vertical-scroll-bars . nil)
+ '(menu-bar-lines . 0)
+ '(tool-bar-lines . 0)
'(left-fringe . 0)
'(right-fringe . 0)
;; don't lower but auto-raise
@@ -260,10 +258,9 @@ the frame used for the wide display.")
This has effect only on a windowing system.
If t, hitting `?' to toggle control panel off iconifies it.
-This is only useful in Emacs and only for certain kinds of window managers,
-such as TWM and its derivatives, since the window manager must permit
-keyboard input to go into icons. XEmacs completely ignores keyboard input
-into icons, regardless of the window manager."
+This is only useful for certain kinds of window managers, such as
+TWM and its derivatives, since the window manager must permit
+keyboard input to go into icons."
:type 'boolean)
;;; Functions
@@ -952,8 +949,7 @@ create a new splittable frame if none is found."
;; just a precaution--we should be in ctl-buffer already
(with-current-buffer ctl-buffer
(make-local-variable 'frame-title-format)
- (make-local-variable 'frame-icon-title-format) ; XEmacs
- (make-local-variable 'icon-title-format)) ; Emacs
+ (make-local-variable 'icon-title-format))
(ediff-setup-control-buffer ctl-buffer)
(setq dont-iconify-ctl-frame
@@ -1098,6 +1094,7 @@ create a new splittable frame if none is found."
)))
(defun ediff-xemacs-select-frame-hook ()
+ (declare (obsolete nil "28.1"))
(if (and (equal (selected-frame) ediff-control-frame)
(not ediff-use-long-help-message))
(raise-frame ediff-control-frame)))
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index 133d2109f5b..ae2f8ad6c1c 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -566,10 +566,8 @@ expression; only file names that match the regexp are considered."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -594,10 +592,8 @@ names. Only the files that are under revision control are taken into account."
(list (read-directory-name
"Directory to compare with revision:" dir-A nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt
+ "Filter filenames through regular expression" default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -632,10 +628,8 @@ regular expression; only file names that match the regexp are considered."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -665,10 +659,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -707,10 +699,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -735,10 +725,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
(list (read-directory-name
"Directory to merge with revisions:" dir-A nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -767,10 +755,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
"Directory to merge with revisions and ancestors:"
dir-A nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -1353,16 +1339,18 @@ the merge buffer."
(let (rev1 rev2)
(setq rev1
(read-string
- (format-message
- "Version 1 to merge (default %s's working version): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer")))
+ (format-prompt "Version 1 to merge"
+ (concat
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")
+ "'s working version")))
rev2
(read-string
- (format
- "Version 2 to merge (default %s): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer"))))
+ (format-prompt "Version 2 to merge"
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer"))))
(ediff-load-version-control)
;; ancestor-revision=nil
(funcall
@@ -1388,22 +1376,26 @@ the merge buffer."
(let (rev1 rev2 ancestor-rev)
(setq rev1
(read-string
- (format-message
- "Version 1 to merge (default %s's working version): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer")))
+ (format-prompt "Version 1 to merge"
+ (concat
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")
+ "'s working version")))
rev2
(read-string
- (format
- "Version 2 to merge (default %s): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer")))
+ (format-prompt "Version 2 to merge"
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")))
ancestor-rev
- (read-string
- (format-message
- "Ancestor version (default %s's base revision): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer"))))
+ (read-string (format-prompt
+ "Ancestor version"
+ (concat
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")
+ "'s base revision"))))
(ediff-load-version-control)
(funcall
(intern (format "ediff-%S-merge-internal" ediff-version-control-package))
@@ -1503,13 +1495,14 @@ arguments after setting up the Ediff buffers."
(save-buffer (current-buffer)))
(let (rev1 rev2)
(setq rev1
- (read-string
- (format "Revision 1 to compare (default %s's latest revision): "
- (file-name-nondirectory file)))
+ (read-string (format-prompt "Revision 1 to compare"
+ (concat (file-name-nondirectory file)
+ "'s latest revision")))
rev2
(read-string
- (format "Revision 2 to compare (default %s's current state): "
- (file-name-nondirectory file))))
+ (format-prompt "Revision 2 to compare"
+ (concat (file-name-nondirectory file)
+ "'s current state"))))
(ediff-load-version-control)
(funcall
(intern (format "ediff-%S-internal" ediff-version-control-package))
diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el
index fc8c318e3af..d2d419ac786 100644
--- a/lisp/vc/emerge.el
+++ b/lisp/vc/emerge.el
@@ -2757,15 +2757,14 @@ Otherwise, signal an error."
alternative-default-dir
(not (string-equal alternative-default-dir
(file-name-directory A-file))))
- (read-file-name (format "%s (default %s): "
- prompt (file-name-nondirectory A-file))
+ (read-file-name (format-prompt prompt (file-name-nondirectory A-file))
alternative-default-dir
(concat alternative-default-dir
(file-name-nondirectory A-file))
(and must-match 'confirm)))
;; If there is a default file, use it.
(default-file
- (read-file-name (format "%s (default %s): " prompt default-file)
+ (read-file-name (format-prompt prompt default-file)
;; If emerge-default-last-directories is set, use the
;; directory from the same argument of the last call of
;; Emerge as the default for this argument.
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 906f9a94205..1c69bdf4135 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -51,6 +51,9 @@
;; The main keymap
+(define-obsolete-variable-alias 'vc-log-mode-map 'log-edit-mode-map "28.1")
+(define-obsolete-variable-alias 'vc-log-entry-mode 'log-edit-mode-map "28.1")
+
(easy-mmode-defmap log-edit-mode-map
'(("\C-c\C-c" . log-edit-done)
("\C-c\C-a" . log-edit-insert-changelog)
@@ -67,10 +70,6 @@
"Keymap for the `log-edit-mode' (to edit version control log messages)."
:group 'log-edit)
-;; Compatibility with old names. Should we bother ?
-(defvar vc-log-mode-map log-edit-mode-map)
-(defvar vc-log-entry-mode vc-log-mode-map)
-
(easy-menu-define log-edit-menu log-edit-mode-map
"Menu used for `log-edit-mode'."
'("Log-Edit"
@@ -245,7 +244,9 @@ If the optional argument STRIDE is present, that is a step-width to use
when going through the comment ring."
;; Why substring rather than regexp ? -sm
(interactive
- (list (read-string "Comment substring: " nil nil log-edit-last-comment-match)))
+ (list (read-string (format-prompt "Comment substring"
+ log-edit-last-comment-match)
+ nil nil log-edit-last-comment-match)))
(unless stride (setq stride 1))
(if (string= str "")
(setq str log-edit-last-comment-match)
@@ -262,7 +263,9 @@ when going through the comment ring."
(defun log-edit-comment-search-forward (str)
"Search forwards through comment history for a substring match of STR."
(interactive
- (list (read-string "Comment substring: " nil nil log-edit-last-comment-match)))
+ (list (read-string (format-prompt "Comment substring"
+ log-edit-last-comment-match)
+ nil nil log-edit-last-comment-match)))
(log-edit-comment-search-backward str -1))
(defun log-edit-comment-to-change-log (&optional whoami file-name)
diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el
index 466c621311f..dd56aec94a0 100644
--- a/lisp/vc/pcvs-parse.el
+++ b/lisp/vc/pcvs-parse.el
@@ -472,7 +472,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
;; Let's not get all worked up if the format changes a bit
(cvs-match " *Working revision:.*$"))
(cvs-or
- (cvs-match " *RCS Version:[ \t]*\\([0-9.]+\\)[ \t]*.*$" (head-rev 1))
+ (cvs-match " *RCS Version:[ \t]*\\([0-9.]+\\).*$" (head-rev 1))
(cvs-match " *Repository revision:[ \t]*\\([0-9.]+\\)[ \t]*\\(.*\\)$"
(head-rev 1))
(cvs-match " *Repository revision:.*"))
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 85868b91ecc..d0a83fd7c49 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -1429,15 +1429,16 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict."
(smerge-remove-props (point-min) (point-max))))
;;;###autoload
-(defun smerge-start-session ()
+(defun smerge-start-session (&optional interactively)
"Turn on `smerge-mode' and move point to first conflict marker.
If no conflict maker is found, turn off `smerge-mode'."
- (interactive)
- (smerge-mode 1)
- (condition-case nil
- (unless (looking-at smerge-begin-re)
- (smerge-next))
- (error (smerge-auto-leave))))
+ (interactive "p")
+ (when (or (null smerge-mode) interactively)
+ (smerge-mode 1)
+ (condition-case nil
+ (unless (looking-at smerge-begin-re)
+ (smerge-next))
+ (error (smerge-auto-leave)))))
(defcustom smerge-change-buffer-confirm t
"If non-nil, request confirmation before moving to another buffer."
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index d82cadc70dd..5198bccf846 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -403,12 +403,12 @@ should be applied to the background or to the foreground."
(let ((def (vc-working-revision buffer-file-name)))
(if (null current-prefix-arg) def
(vc-read-revision
- (format "Annotate from revision (default %s): " def)
+ (format-prompt "Annotate from revision" def)
(list buffer-file-name) nil def)))
(if (null current-prefix-arg)
vc-annotate-display-mode
(float (string-to-number
- (read-string "Annotate span days (default 20): "
+ (read-string (format-prompt "Annotate span days" 20)
nil nil "20")))))))
(vc-ensure-vc-buffer)
(setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index e5d307e7ede..f98730ed221 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -1316,6 +1316,15 @@ stream. Standard error output is discarded."
vc-bzr-revision-keywords))
string pred)))))
+(defun vc-bzr-repository-url (file-or-dir &optional _remote-name)
+ (let ((default-directory (vc-bzr-root file-or-dir)))
+ (with-temp-buffer
+ (vc-bzr-command "info" (current-buffer) 0 nil)
+ (goto-char (point-min))
+ (if (re-search-forward "parent branch: \\(.*\\)$" nil t)
+ (match-string 1)
+ (error "Cannot determine Bzr repository URL")))))
+
(provide 'vc-bzr)
;;; vc-bzr.el ends here
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index e8231ecb289..fdbf44e0f13 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -337,32 +337,35 @@ its parents."
(directory-file-name dir))))
(eq dir t)))
+(declare-function log-edit-extract-headers "log-edit" (headers string))
+
(defun vc-cvs-checkin (files comment &optional rev)
"CVS-specific version of `vc-backend-checkin'."
- (unless (or (not rev) (vc-cvs-valid-revision-number-p rev))
- (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
+ (unless (or (not rev) (vc-cvs-valid-revision-number-p rev))
+ (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
(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))
- (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag 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))
+ (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev))
files)))
- (let ((status (apply 'vc-cvs-command nil 1 files
- "ci" (if rev (concat "-r" rev))
- (concat "-m" comment)
- (vc-switches 'CVS 'checkin))))
+ (let ((status (apply
+ '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))))
(set-buffer "*vc*")
(goto-char (point-min))
(when (not (zerop status))
;; Check checkin problem.
(cond
((re-search-forward "Up-to-date check failed" nil t)
- (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
+ (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
files)
(error "%s" (substitute-command-keys
- (concat "Up-to-date check failed: "
- "type \\[vc-next-action] to merge in changes"))))
+ (concat "Up-to-date check failed: "
+ "type \\[vc-next-action] to merge in changes"))))
(t
(pop-to-buffer (current-buffer))
(goto-char (point-min))
@@ -372,7 +375,7 @@ its parents."
;; Otherwise we can't necessarily tell what goes with what; clear
;; its properties so they have to be refetched.
(if (= (length files) 1)
- (vc-file-setprop
+ (vc-file-setprop
(car files) 'vc-working-revision
(vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
(mapc 'vc-file-clearprops files))
@@ -385,7 +388,7 @@ its parents."
;; if this was an explicit check-in (does not include creation of
;; a branch), remove the sticky tag.
(if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev)))
- (vc-cvs-command nil 0 files "update" "-A"))))
+ (vc-cvs-command nil 0 files "update" "-A"))))
(defun vc-cvs-find-revision (file rev buffer)
(apply 'vc-cvs-command
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 38b4937e854..cdf8ab984e8 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -147,6 +147,12 @@ See `run-hooks'."
'(menu-item "Unmark Previous " vc-dir-unmark-file-up
:help "Move to the previous line and unmark the file"))
+ (define-key map [mark-unregistered]
+ '(menu-item "Mark Unregistered" vc-dir-mark-unregistered-files
+ :help "Mark all files in the unregistered state"))
+ (define-key map [mark-registered]
+ '(menu-item "Mark Registered" vc-dir-mark-registered-files
+ :help "Mark all files in the state edited, added or removed"))
(define-key map [mark-all]
'(menu-item "Mark All" vc-dir-mark-all-files
:help "Mark all files that are in the same state as the current file\
@@ -310,6 +316,10 @@ See `run-hooks'."
(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))
+
;; Hook up the menu.
(define-key map [menu-bar vc-dir-mode]
`(menu-item
@@ -696,6 +706,38 @@ share the same state."
(vc-dir-mark-file crt)))
(setq crt (ewoc-next vc-ewoc crt))))))))
+(defun vc-dir-mark-files (mark-files)
+ "Mark files specified by file names in the argument MARK-FILES.
+MARK-FILES should be a list of absolute filenames."
+ (ewoc-map
+ (lambda (filearg)
+ (when (member (expand-file-name (vc-dir-fileinfo->name filearg))
+ mark-files)
+ (setf (vc-dir-fileinfo->marked filearg) t)
+ t))
+ vc-ewoc))
+
+(defun vc-dir-mark-state-files (states)
+ "Mark files that are in the state specified by the list in STATES."
+ (unless (listp states)
+ (setq states (list states)))
+ (ewoc-map
+ (lambda (filearg)
+ (when (memq (vc-dir-fileinfo->state filearg) states)
+ (setf (vc-dir-fileinfo->marked filearg) t)
+ t))
+ vc-ewoc))
+
+(defun vc-dir-mark-registered-files ()
+ "Mark files that are in one of registered state: edited, added or removed."
+ (interactive)
+ (vc-dir-mark-state-files '(edited added removed)))
+
+(defun vc-dir-mark-unregistered-files ()
+ "Mark files that are in unregistered state."
+ (interactive)
+ (vc-dir-mark-state-files 'unregistered))
+
(defun vc-dir-unmark-file ()
;; Unmark the current file and move to the next line.
(let* ((crt (ewoc-locate vc-ewoc))
@@ -1064,6 +1106,7 @@ the *vc-dir* buffer.
(set (make-local-variable 'vc-dir-backend) use-vc-backend)
(set (make-local-variable 'desktop-save-buffer)
'vc-dir-desktop-buffer-misc-data)
+ (setq-local bookmark-make-record-function #'vc-dir-bookmark-make-record)
(setq buffer-read-only t)
(when (boundp 'tool-bar-map)
(set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map))
@@ -1193,7 +1236,8 @@ Throw an error if another update process is in progress."
(if remaining
(vc-dir-refresh-files
(mapcar 'vc-dir-fileinfo->name remaining))
- (setq mode-line-process nil))))))))))))
+ (setq mode-line-process nil)
+ (run-hooks 'vc-dir-refresh-hook))))))))))))
(defun vc-dir-show-fileentry (file)
"Insert an entry for a specific file into the current *VC-dir* listing.
@@ -1287,6 +1331,16 @@ state of item at point, if any."
(list vc-dir-backend files only-files-list state model)))
;;;###autoload
+(defun vc-dir-root ()
+ "Run `vc-dir' in the repository root directory without prompt.
+If the default directory of the current buffer is
+not under version control, prompt for a directory."
+ (interactive)
+ (let ((root-dir (vc-root-dir)))
+ (if root-dir (vc-dir root-dir)
+ (call-interactively 'vc-dir))))
+
+;;;###autoload
(defun vc-dir (dir &optional backend)
"Show the VC status for \"interesting\" files in and below DIR.
This allows you to mark files and perform VC operations on them.
@@ -1309,7 +1363,7 @@ These are the commands available for use in the file status buffer:
;; When you hit C-x v d in a visited VC file,
;; the *vc-dir* buffer visits the directory under its truename;
;; therefore it makes sense to always do that.
- ;; Otherwise if you do C-x v d -> C-x C-f -> C-c v d
+ ;; Otherwise if you do C-x v d -> C-x C-f -> C-x v d
;; you may get a new *vc-dir* buffer, different from the original
(file-truename (read-directory-name "VC status for directory: "
(vc-root-dir) nil t
@@ -1413,6 +1467,42 @@ These are the commands available for use in the file status buffer:
'(vc-dir-mode . vc-dir-restore-desktop-buffer))
+;;; Support for bookmark.el (adapted from what info.el does).
+
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+(declare-function bookmark-default-handler "bookmark" (bmk))
+(declare-function bookmark-get-bookmark-record "bookmark" (bmk))
+
+(defun vc-dir-bookmark-make-record ()
+ "Make record used to bookmark a `vc-dir' buffer.
+This implements the `bookmark-make-record-function' type for
+`vc-dir' buffers."
+ (let* ((bookmark-name
+ (concat "(" (symbol-name vc-dir-backend) ") "
+ (file-name-nondirectory
+ (directory-file-name default-directory))))
+ (defaults (list bookmark-name default-directory)))
+ `(,bookmark-name
+ ,@(bookmark-make-record-default 'no-file)
+ (filename . ,default-directory)
+ (handler . vc-dir-bookmark-jump)
+ (defaults . ,defaults))))
+
+;;;###autoload
+(defun vc-dir-bookmark-jump (bmk)
+ "Provides the bookmark-jump behavior for a `vc-dir' buffer.
+This implements the `handler' function interface for the record
+type returned by `vc-dir-bookmark-make-record'."
+ (let* ((file (bookmark-prop-get bmk 'filename))
+ (buf (progn ;; Don't use save-window-excursion (bug#39722)
+ (vc-dir file)
+ (current-buffer))))
+ (bookmark-default-handler
+ `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk)))))
+
+
(provide 'vc-dir)
;;; vc-dir.el ends here
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 5ae300bf09b..99bf5bf9b64 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -691,7 +691,6 @@ BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer."
(message "%s Type C-c C-c when done" msg)
(vc-finish-logentry (eq comment t)))))
-(declare-function vc-dir-move-to-goal-column "vc-dir" ())
;; vc-finish-logentry is typically called from a log-edit buffer (see
;; vc-start-logentry).
(defun vc-finish-logentry (&optional nocomment)
@@ -740,13 +739,12 @@ the buffer contents as a comment."
(mapc
(lambda (file) (vc-resynch-buffer file t t))
log-fileset))
- (when (vc-dispatcher-browsing)
- (vc-dir-move-to-goal-column))
(run-hooks after-hook 'vc-finish-logentry-hook)))
(defun vc-dispatcher-browsing ()
"Are we in a directory browser buffer?"
- (derived-mode-p 'vc-dir-mode))
+ (or (derived-mode-p 'vc-dir-mode)
+ (derived-mode-p 'dired-mode)))
;; These are unused.
;; (defun vc-dispatcher-in-fileset-p (fileset)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 61e6c642d1f..6ff6951dbc9 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -72,6 +72,7 @@
;; by git, so it's probably
;; not a good idea.
;; - merge-news (file) see `merge-file'
+;; - mark-resolved (file) OK
;; - steal-lock (file &optional revision) NOT NEEDED
;; HISTORY FUNCTIONS
;; * print-log (files buffer &optional shortlog start-revision limit) OK
@@ -100,6 +101,7 @@
;; - rename-file (old new) OK
;; - find-file-hook () OK
;; - conflicted-files OK
+;; - repository-url (file-or-dir) OK
;;; Code:
@@ -166,7 +168,7 @@ format string (which is passed to \"git log\" via the argument
\"--pretty=tformat:FORMAT\"), REGEXP is a regular expression
matching the resulting Git log output, and KEYWORDS is a list of
`font-lock-keywords' for highlighting the Log View buffer."
- :type '(list string string (repeat sexp))
+ :type '(list string regexp (repeat sexp))
:version "24.1")
(defcustom vc-git-commits-coding-system 'utf-8
@@ -208,6 +210,16 @@ toggle display of the entire list."
widget))))
:version "27.1")
+(defcustom vc-git-revision-complete-only-branches nil
+ "Control whether tags are returned by revision completion for Git.
+
+When non-nil, only branches and remotes will be returned by
+`vc-git-revision-completion-table'. This is used by various VC
+commands when completing branch names. When nil, tags are also
+included in the completions."
+ :type 'boolean
+ :version "28.1")
+
;; History of Git commands.
(defvar vc-git-history nil)
@@ -241,7 +253,7 @@ toggle display of the entire list."
;; path specs.
;; See also: http://marc.info/?l=git&m=125787684318129&w=2
(name (file-relative-name file dir))
- (str (ignore-errors
+ (str (with-demoted-errors "Error: %S"
(cd dir)
(vc-git--out-ok "ls-files" "-c" "-z" "--" name)
;; If result is empty, use ls-tree to check for deleted
@@ -733,6 +745,7 @@ or an empty string if none."
(with-current-buffer standard-output
(vc-git--out-ok "symbolic-ref" "HEAD"))))
(stash-list (vc-git-stash-list))
+ (default-directory dir)
branch remote remote-url stash-button stash-string)
(if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
@@ -745,14 +758,8 @@ or an empty string if none."
(concat "branch." branch ".remote")))))
(when (string-match "\\([^\n]+\\)" remote)
(setq remote (match-string 1 remote)))
- (when remote
- (setq remote-url
- (with-output-to-string
- (with-current-buffer standard-output
- (vc-git--out-ok "config"
- (concat "remote." remote ".url"))))))
- (when (string-match "\\([^\n]+\\)" remote-url)
- (setq remote-url (match-string 1 remote-url))))
+ (when (> (length remote) 0)
+ (setq remote-url (vc-git-repository-url dir remote))))
(setq branch "not (detached HEAD)"))
(when stash-list
(let* ((len (length stash-list))
@@ -807,7 +814,7 @@ or an empty string if none."
(propertize "Branch : " 'face 'font-lock-type-face)
(propertize branch
'face 'font-lock-variable-name-face)
- (when remote
+ (when remote-url
(concat
"\n"
(propertize "Remote : " 'face 'font-lock-type-face)
@@ -819,10 +826,10 @@ or an empty string if none."
(when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root dir)))
(propertize "\nRebase : in progress" 'face 'font-lock-warning-face))
(if stash-list
- (concat
- (propertize "\nStash : " 'face 'font-lock-type-face)
- stash-button
- stash-string)
+ (concat
+ (propertize "\nStash : " 'face 'font-lock-type-face)
+ stash-button
+ stash-string)
(concat
(propertize "\nStash : " 'face 'font-lock-type-face)
(propertize "Nothing stashed"
@@ -1081,6 +1088,13 @@ This prompts for a branch to merge from."
"DU" "AA" "UU"))
(push (expand-file-name file directory) files)))))))
+(defun vc-git-repository-url (file-or-dir &optional remote-name)
+ (let ((default-directory (vc-git-root file-or-dir)))
+ (with-temp-buffer
+ (vc-git-command (current-buffer) 0 nil "remote" "get-url"
+ (or remote-name "origin"))
+ (buffer-substring-no-properties (point-min) (1- (point-max))))))
+
;; Everywhere but here, follows vc-git-command, which uses vc-do-command
;; from vc-dispatcher.
(autoload 'vc-resynch-buffer "vc-dispatcher")
@@ -1233,7 +1247,7 @@ log entries."
(set (make-local-variable 'log-view-message-re)
(if (not (memq vc-log-view-type '(long log-search with-diff)))
(cadr vc-git-root-log-format)
- "^commit *\\([0-9a-z]+\\)"))
+ "^commit +\\([0-9a-z]+\\)"))
;; Allow expanding short log entries.
(when (memq vc-log-view-type '(short log-outgoing log-incoming mergebase))
(setq truncate-lines t)
@@ -1262,7 +1276,7 @@ log entries."
("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
(1 'change-log-acknowledgment)
(2 'change-log-acknowledgment))
- ("^Date: \\(.+\\)" (1 'change-log-date))
+ ("^\\(?:Date: \\|AuthorDate: \\)\\(.+\\)" (1 'change-log-date))
("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
@@ -1411,9 +1425,11 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(with-temp-buffer
(vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
(goto-char (point-min))
- (while (re-search-forward "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$"
- nil t)
- (push (match-string 2) table)))
+ (let ((regexp (if vc-git-revision-complete-only-branches
+ "^refs/\\(heads\\|remotes\\)/\\(.*\\)$"
+ "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$")))
+ (while (re-search-forward regexp nil t)
+ (push (match-string 2) table))))
table))
(defun vc-git-revision-completion-table (files)
@@ -1530,6 +1546,9 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(defun vc-git-rename-file (old new)
(vc-git-command nil 0 (list old new) "mv" "-f" "--"))
+(defun vc-git-mark-resolved (files)
+ (vc-git-command nil 0 files "add"))
+
(defvar vc-git-extra-menu-map
(let ((map (make-sparse-keymap)))
(define-key map [git-grep]
@@ -1688,12 +1707,13 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(vc-resynch-buffer (vc-git-root default-directory) t t))
(defun vc-git-stash-list ()
- (delete
- ""
- (split-string
- (replace-regexp-in-string
- "^stash@" " " (vc-git--run-command-string nil "stash" "list"))
- "\n")))
+ (when-let ((out (vc-git--run-command-string nil "stash" "list")))
+ (delete
+ ""
+ (split-string
+ (replace-regexp-in-string
+ "^stash@" " " out)
+ "\n"))))
(defun vc-git-stash-get-at-point (point)
(save-excursion
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index d00b69c0d08..cb0657e70a0 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -182,10 +182,20 @@ is the \"--template\" argument string to pass to Mercurial,
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 string (repeat sexp))
+ :type '(list string regexp (repeat sexp))
:group 'vc-hg
:version "24.5")
+(defcustom vc-hg-create-bookmark t
+ "This controls whether `vc-create-tag' will create a bookmark or branch.
+If nil, named branch will be created.
+If t, bookmark will be created.
+If `ask', you will be prompted for a branch type."
+ :type '(choice (const :tag "No" nil)
+ (const :tag "Yes" t)
+ (const :tag "Ask" ask))
+ :version "28.1")
+
;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
@@ -625,10 +635,18 @@ Optional arg REVISION is a revision to annotate from."
;;; Tag system
(defun vc-hg-create-tag (dir name branchp)
- "Attach the tag NAME to the state of the working copy."
+ "Create tag NAME in repo in DIR. Create branch if BRANCHP.
+Variable `vc-hg-create-bookmark' controls what kind of branch will be created."
(let ((default-directory dir))
- (and (vc-hg-command nil 0 nil "status")
- (vc-hg-command nil 0 nil (if branchp "bookmark" "tag") name))))
+ (vc-hg-command nil 0 nil
+ (if branchp
+ (if (if (eq vc-hg-create-bookmark 'ask)
+ (yes-or-no-p "Create bookmark instead of branch? ")
+ vc-hg-create-bookmark)
+ "bookmark"
+ "branch")
+ "tag")
+ name)))
(defun vc-hg-retrieve-tag (dir name _update)
"Retrieve the version tagged by NAME of all registered files at or below DIR."
@@ -1366,25 +1384,28 @@ REV is the revision to check out into WORKFILE."
(vc-run-delayed
(vc-hg-after-dir-status update-function)))
-(defun vc-hg-dir-extra-header (name &rest commands)
- (concat (propertize name 'face 'font-lock-type-face)
- (propertize
- (with-temp-buffer
- (apply 'vc-hg-command (current-buffer) 0 nil commands)
- (buffer-substring-no-properties (point-min) (1- (point-max))))
- 'face 'font-lock-variable-name-face)))
-
(defun vc-hg-dir-extra-headers (dir)
- "Generate extra status headers for a Mercurial tree."
+ "Generate extra status headers for a repository in DIR.
+This runs the command \"hg summary\"."
(let ((default-directory dir))
- (concat
- (vc-hg-dir-extra-header "Root : " "root") "\n"
- (vc-hg-dir-extra-header "Branch : " "id" "-b") "\n"
- (vc-hg-dir-extra-header "Tags : " "id" "-t") ; "\n"
- ;; these change after each commit
- ;; (vc-hg-dir-extra-header "Local num : " "id" "-n") "\n"
- ;; (vc-hg-dir-extra-header "Global id : " "id" "-i")
- )))
+ (with-temp-buffer
+ (vc-hg-command t 0 nil "summary")
+ (goto-char (point-min))
+ (mapconcat
+ #'identity
+ (let (result)
+ (while (not (eobp))
+ (push
+ (let ((entry (if (looking-at "\\([^ ].*\\): \\(.*\\)")
+ (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)))
+ result)
+ (forward-line))
+ (nreverse result))
+ "\n"))))
(defun vc-hg-log-incoming (buffer remote-location)
(vc-setup-buffer buffer)
@@ -1525,6 +1546,14 @@ This function differs from vc-do-command in that it invokes
(defun vc-hg-root (file)
(vc-find-root file ".hg"))
+(defun vc-hg-repository-url (file-or-dir &optional remote-name)
+ (let ((default-directory (vc-hg-root file-or-dir)))
+ (with-temp-buffer
+ (vc-hg-command (current-buffer) 0 nil
+ "config"
+ (concat "paths." (or remote-name "default")))
+ (buffer-substring-no-properties (point-min) (1- (point-max))))))
+
(provide 'vc-hg)
;;; vc-hg.el ends here
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 345a28d3f1d..f09ceddcb37 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -498,21 +498,13 @@ status of this file. Otherwise, the value returned is one of:
"Return the repository version from which FILE was checked out.
If FILE is not registered, this function always returns nil."
(or (vc-file-getprop file 'vc-working-revision)
- (progn
+ (let ((default-directory (file-name-directory file)))
(setq backend (or backend (vc-backend file)))
(when backend
(vc-file-setprop file 'vc-working-revision
(vc-call-backend
backend 'working-revision file))))))
-;; Backward compatibility.
-(define-obsolete-function-alias
- 'vc-workfile-version 'vc-working-revision "23.1")
-(defun vc-default-working-revision (backend file)
- (message
- "`working-revision' not found: using the old `workfile-version' instead")
- (vc-call-backend backend 'workfile-version file))
-
(defun vc-default-registered (backend file)
"Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
(let ((sym (vc-make-backend-sym backend 'master-templates)))
@@ -972,9 +964,9 @@ In the latter case, VC mode is deactivated for this buffer."
(bindings--define-key map [vc-ignore]
'(menu-item "Ignore File..." vc-ignore
:help "Ignore a file under current version control system"))
- (bindings--define-key map [vc-dir]
- '(menu-item "VC Dir" vc-dir
- :help "Show the VC status of files in a directory"))
+ (bindings--define-key map [vc-dir-root]
+ '(menu-item "VC Dir" vc-dir-root
+ :help "Show the VC status of the repository"))
map))
(defalias 'vc-menu-map vc-menu-map)
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index 092d8b53968..3c26ffc0e58 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/vc/vc-mtn.el
@@ -60,7 +60,6 @@ switches."
:version "25.1"
:group 'vc-mtn)
-(define-obsolete-variable-alias 'vc-mtn-command 'vc-mtn-program "23.1")
(defcustom vc-mtn-program "mtn"
"Name of the monotone executable."
:type 'string
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 273f37c10d6..23f088b0cff 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -312,7 +312,7 @@ whether to remove it."
(and (string= (file-name-nondirectory (directory-file-name dir)) "RCS")
;; check whether RCS dir is empty, i.e. it does not
;; contain any files except "." and ".."
- (not (directory-files dir nil (rx (or (not ".") "..."))))
+ (not (directory-files dir nil directory-files-no-dot-files-regexp))
(yes-or-no-p (format "Directory %s is empty; remove it? " dir))
(delete-directory dir)))))
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
index db127ee726d..4eb638978a9 100644
--- a/lisp/vc/vc-src.el
+++ b/lisp/vc/vc-src.el
@@ -146,6 +146,20 @@ For a description of possible values, see `vc-check-master-templates'."
(progn
(defun vc-src-registered (f) (vc-default-registered 'src f)))
+(defun vc-src--parse-state (out)
+ (when (null (string-match "does not exist or is unreadable" out))
+ (let ((state (aref out 0)))
+ (cond
+ ;; FIXME: What to do about L code?
+ ((eq state ?.) 'up-to-date)
+ ((eq state ?A) 'added)
+ ((eq state ?M) 'edited)
+ ((eq state ?I) 'ignored)
+ ((eq state ?R) 'removed)
+ ((eq state ?!) 'missing)
+ ((eq state ??) 'unregistered)
+ (t 'up-to-date)))))
+
(defun vc-src-state (file)
"SRC-specific version of `vc-state'."
(let*
@@ -163,32 +177,41 @@ For a description of possible values, see `vc-check-master-templates'."
"status" "-a" (file-relative-name file))
(error nil)))))))
(when (eq 0 status)
- (when (null (string-match "does not exist or is unreadable" out))
- (let ((state (aref out 0)))
- (cond
- ;; FIXME: What to do about A and L codes?
- ((eq state ?.) 'up-to-date)
- ((eq state ?A) 'added)
- ((eq state ?M) 'edited)
- ((eq state ?I) 'ignored)
- ((eq state ?R) 'removed)
- ((eq state ?!) 'missing)
- ((eq state ??) 'unregistered)
- (t 'up-to-date)))))))
+ (vc-src--parse-state out))))
(autoload 'vc-expand-dirs "vc")
(defun vc-src-dir-status-files (dir files update-function)
- ;; FIXME: Use one src status -a call for this
- (if (not files) (setq files (vc-expand-dirs (list dir) 'SRC)))
- (let ((result nil))
- (dolist (file files)
- (let ((state (vc-state file))
- (frel (file-relative-name file)))
- (when (and (eq (vc-backend file) 'SRC)
- (not (eq state 'up-to-date)))
- (push (list frel state) result))))
- (funcall update-function result)))
+ (let* ((result nil)
+ (status nil)
+ (default-directory (or dir default-directory))
+ (out
+ (with-output-to-string
+ (with-current-buffer standard-output
+ (setq status
+ (ignore-errors
+ (apply
+ #'process-file vc-src-program nil t nil
+ "status" "-a"
+ (mapcar #'file-relative-name files)))))))
+ dlist)
+ (when (eq 0 status)
+ (dolist (line (split-string out "[\n\r]" t))
+ (let* ((pair (split-string line "[\t]" t))
+ (state (vc-src--parse-state (car pair)))
+ (frel (cadr pair)))
+ (if (file-directory-p frel)
+ (push frel dlist)
+ (when (not (eq state 'up-to-date))
+ (push (list frel state) result)))))
+ (dolist (drel dlist)
+ (let ((dresult (vc-src-dir-status-files
+ (expand-file-name drel) nil #'identity)))
+ (dolist (dres dresult)
+ (push (list (concat (file-name-as-directory drel) (car dres))
+ (cadr dres))
+ result))))
+ (funcall update-function result))))
(defun vc-src-command (buffer file-or-list &rest flags)
"A wrapper around `vc-do-command' for use in vc-src.el.
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index d039bf3c6a3..e108b3a340f 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -816,7 +816,14 @@ Set file properties accordingly. If FILENAME is non-nil, return its status."
(push (match-string 1 loglines) vc-svn-revisions)
(setq start (+ start (match-end 0)))
(setq loglines (buffer-substring-no-properties start (point-max)))))
- vc-svn-revisions)))
+ vc-svn-revisions)))
+
+(defun vc-svn-repository-url (file-or-dir &optional _remote-name)
+ (let ((default-directory (vc-svn-root file-or-dir)))
+ (with-temp-buffer
+ (vc-svn-command (current-buffer) 0 nil
+ "info" "--show-item" "repos-root-url")
+ (buffer-substring-no-properties (point-min) (1- (point-max))))))
(provide 'vc-svn)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index fe666413168..3852a64550a 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -553,6 +553,13 @@
;; Return the list of files where conflict resolution is needed in
;; the project that contains DIR.
;; FIXME: what should it do with non-text conflicts?
+;;
+;; - repository-url (file-or-dir &optional remote-name)
+;;
+;; Returns the URL of the repository of the current checkout
+;; containing FILE-OR-DIR. The optional REMOTE-NAME specifies the
+;; remote (in Git parlance) whose URL is to be returned. It has
+;; only a meaning for distributed VCS and is ignored otherwise.
;;; Changes from the pre-25.1 API:
;;
@@ -957,7 +964,7 @@ use."
(throw 'found bk))))
;;;###autoload
-(defun vc-responsible-backend (file)
+(defun vc-responsible-backend (file &optional no-error)
"Return the name of a backend system that is responsible for FILE.
If FILE is already registered, return the
@@ -967,7 +974,10 @@ responsible for FILE is returned.
Note that if FILE is a symbolic link, it will not be resolved --
the responsible backend system for the symbolic link itself will
-be reported."
+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))
(catch 'found
;; First try: find a responsible backend. If this is for registration,
@@ -975,7 +985,8 @@ be reported."
(dolist (backend vc-handled-backends)
(and (vc-call-backend backend 'responsible-p file)
(throw 'found backend))))
- (error "No VC backend is responsible for %s" file)))
+ (unless no-error
+ (error "No VC backend is responsible for %s" file))))
(defun vc-expand-dirs (file-or-dir-list backend)
"Expands directories in a file list specification.
@@ -1006,35 +1017,47 @@ Within directories, only files already under version control are noticed."
(declare-function vc-dir-current-file "vc-dir" ())
(declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files))
+(declare-function dired-vc-deduce-fileset "dired-aux" (&optional state-model-only-files not-state-changing))
-(defun vc-deduce-fileset (&optional observer allow-unregistered
+(defun vc-deduce-fileset (&optional not-state-changing
+ allow-unregistered
state-model-only-files)
"Deduce a set of files and a backend to which to apply an operation.
-Return (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL).
+Return a list of the form:
+
+ (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL)
+
+where the last 3 members are optional, and must be present only if
+STATE-MODEL-ONLY-FILES is non-nil.
+
+NOT-STATE-CHANGING, if non-nil, means that the operation
+requesting the fileset doesn't intend to change the VC state,
+such as when printing the log or showing the diffs.
-If we're in VC-dir mode, FILESET is the list of marked files,
-or the directory if no files are marked.
-Otherwise, if in a buffer visiting a version-controlled file,
-FILESET is a single-file fileset containing that file.
+If the current buffer is in `vc-dir' or Dired mode, FILESET is the
+list of marked files, or the current directory if no files are
+marked.
+Otherwise, if the current buffer is visiting a version-controlled
+file, FILESET is a single-file list containing that file's name.
Otherwise, if ALLOW-UNREGISTERED is non-nil and the visited file
-is unregistered, FILESET is a single-file fileset containing it.
+is unregistered, FILESET is a single-file list containing the
+name of the visited file.
Otherwise, throw an error.
-STATE-MODEL-ONLY-FILES if non-nil, means that the caller needs
-the FILESET-ONLY-FILES STATE and MODEL info. Otherwise, that
-part may be skipped.
+STATE-MODEL-ONLY-FILES, if non-nil, means that the caller needs
+the FILESET-ONLY-FILES, STATE, and CHECKOUT-MODEL info, where
+FILESET-ONLY-FILES means only files in similar VC states,
+possible values of STATE are explained in `vc-state', and MODEL in
+`vc-checkout-model'. Otherwise, these 3 members may be omitted from
+the returned list.
BEWARE: this function may change the current buffer."
- ;; FIXME: OBSERVER is unused. The name is not intuitive and is not
- ;; documented. It's set to t when called from diff and print-log.
(let (backend)
(cond
((derived-mode-p 'vc-dir-mode)
(vc-dir-deduce-fileset state-model-only-files))
((derived-mode-p 'dired-mode)
- (if observer
- (vc-dired-deduce-fileset)
- (error "State changing VC operations not supported in `dired-mode'")))
+ (dired-vc-deduce-fileset state-model-only-files not-state-changing))
((setq backend (vc-backend buffer-file-name))
(if state-model-only-files
(list backend (list buffer-file-name)
@@ -1046,15 +1069,14 @@ BEWARE: this function may change the current buffer."
;; FIXME: Why this test? --Stef
(or (buffer-file-name vc-parent-buffer)
(with-current-buffer vc-parent-buffer
- (derived-mode-p 'vc-dir-mode))))
+ (or (derived-mode-p 'vc-dir-mode)
+ (derived-mode-p 'dired-mode)))))
(progn ;FIXME: Why not `with-current-buffer'? --Stef.
(set-buffer vc-parent-buffer)
- (vc-deduce-fileset observer allow-unregistered state-model-only-files)))
- ((and (derived-mode-p 'log-view-mode)
+ (vc-deduce-fileset not-state-changing allow-unregistered state-model-only-files)))
+ ((and (not buffer-file-name)
(setq backend (vc-responsible-backend default-directory)))
(list backend nil))
- ((not buffer-file-name)
- (error "Buffer %s is not associated with a file" (buffer-name)))
((and allow-unregistered (not (vc-registered buffer-file-name)))
(if state-model-only-files
(list (vc-backend-for-registration (buffer-file-name))
@@ -1066,10 +1088,6 @@ BEWARE: this function may change the current buffer."
(list buffer-file-name))))
(t (error "File is not under version control")))))
-(defun vc-dired-deduce-fileset ()
- (list (vc-responsible-backend default-directory)
- (dired-map-over-marks (dired-get-filename nil t) nil)))
-
(defun vc-ensure-vc-buffer ()
"Make sure that the current buffer visits a version-controlled file."
(cond
@@ -1328,8 +1346,6 @@ For old-style locking-based version control systems, like RCS:
nil t)))))
(vc-call-backend backend 'create-repo))
-(declare-function vc-dir-move-to-goal-column "vc-dir" ())
-
;;;###autoload
(defun vc-register (&optional vc-fileset comment)
"Register into a version control system.
@@ -1380,8 +1396,6 @@ first backend that could register the file is used."
(vc-resynch-buffer file t t))
files)
- (when (derived-mode-p 'vc-dir-mode)
- (vc-dir-move-to-goal-column))
(message "Registering %s... done" files)))
(defun vc-register-with (backend)
@@ -1881,9 +1895,16 @@ saving the buffer."
(interactive (list current-prefix-arg t))
(if historic
(call-interactively 'vc-version-diff)
- (when buffer-file-name (vc-buffer-sync not-urgent))
- (vc-diff-internal t (vc-deduce-fileset t) nil nil
- (called-interactively-p 'interactive))))
+ (let ((fileset (vc-deduce-fileset t)))
+ (vc-buffer-sync-fileset fileset not-urgent)
+ (vc-diff-internal t fileset nil nil
+ (called-interactively-p 'interactive)))))
+
+(defun vc-buffer-sync-fileset (fileset not-urgent)
+ (dolist (filename (cadr fileset))
+ (when-let ((buffer (find-buffer-visiting filename)))
+ (with-current-buffer buffer
+ (vc-buffer-sync not-urgent)))))
;;;###autoload
(defun vc-diff-mergebase (_files rev1 rev2)
@@ -2502,11 +2523,8 @@ with its diffs (if the underlying VCS supports that)."
(cond
((eq current-prefix-arg 1)
(let* ((default (thing-at-point 'word t))
- (revision (read-string
- (if default
- (format "Revision to show (default %s): " default)
- "Revision to show: ")
- nil nil default)))
+ (revision (read-string (format-prompt "Revision to show" default)
+ nil nil default)))
(list 1 revision)))
((numberp current-prefix-arg)
(list current-prefix-arg))
@@ -2537,15 +2555,17 @@ with its diffs (if the underlying VCS supports that)."
;;;###autoload
(defun vc-print-branch-log (branch)
- "Show the change log for BRANCH in a window."
+ "Show the change log for BRANCH root in a window."
(interactive
(list
(vc-read-revision "Branch to log: ")))
(when (equal branch "")
(error "No branch specified"))
- (vc-print-log-internal (vc-responsible-backend default-directory)
- (list default-directory) branch t
- (when (> vc-log-show-limit 0) vc-log-show-limit)))
+ (let* ((backend (vc-responsible-backend default-directory))
+ (rootdir (vc-call-backend backend 'root default-directory)))
+ (vc-print-log-internal backend
+ (list rootdir) branch t
+ (when (> vc-log-show-limit 0) vc-log-show-limit))))
;;;###autoload
(defun vc-log-incoming (&optional remote-location)
@@ -2690,9 +2710,6 @@ to the working revision (except for keyword expansion)."
(message "Reverting %s...done" (vc-delistify files)))))
;;;###autoload
-(define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
-
-;;;###autoload
(defun vc-pull (&optional arg)
"Update the current fileset or branch.
You must be visiting a version controlled file, or in a `vc-dir' buffer.
diff --git a/lisp/vcursor.el b/lisp/vcursor.el
index fa0cbb74b0d..3601abcd6e4 100644
--- a/lisp/vcursor.el
+++ b/lisp/vcursor.el
@@ -1132,9 +1132,6 @@ line is treated like ordinary characters."
(vcursor-copy (if (or (= count 0) arg) (1+ count) count)))
)
-(define-obsolete-function-alias
- 'vcursor-toggle-vcursor-map 'vcursor-use-vcursor-map "23.1")
-
(defun vcursor-post-command ()
(and vcursor-auto-disable (not vcursor-last-command)
vcursor-overlay
diff --git a/lisp/version.el b/lisp/version.el
index bf666cbff99..b247232dcfd 100644
--- a/lisp/version.el
+++ b/lisp/version.el
@@ -1,4 +1,4 @@
-;;; version.el --- record version number of Emacs
+;;; version.el --- record version number of Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1985, 1992, 1994-1995, 1999-2020 Free Software
;; Foundation, Inc.
@@ -123,7 +123,7 @@ or if we could not determine the revision.")
(looking-at "[[:xdigit:]]\\{40\\}"))
(match-string 0)))))
-(defun emacs-repository-get-version (&optional dir external)
+(defun emacs-repository-get-version (&optional dir _external)
"Try to return as a string the repository revision of the Emacs sources.
The format of the returned string is dependent on the VCS in use.
Value is nil if the sources do not seem to be under version
diff --git a/lisp/vt-control.el b/lisp/vt-control.el
index fc3a514f921..d4c14197bdc 100644
--- a/lisp/vt-control.el
+++ b/lisp/vt-control.el
@@ -1,4 +1,4 @@
-;;; vt-control.el --- Common VTxxx control functions
+;;; vt-control.el --- Common VTxxx control functions -*- lexical-binding:t -*-
;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/vt100-led.el b/lisp/vt100-led.el
index 7552fbb99c1..1e81dd241f1 100644
--- a/lisp/vt100-led.el
+++ b/lisp/vt100-led.el
@@ -1,4 +1,4 @@
-;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones
+;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones -*- lexical-binding:t -*-
;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index 8a816da1f2c..e159d1888e5 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -202,8 +202,7 @@ This function is provided for backward compatibility, since
(interactive
(list (let ((default locale-coding-system))
(read-coding-system
- (format "Coding system for system calls (default %s): "
- default)
+ (format-prompt "Coding system for system calls" default)
default))))
(check-coding-system coding-system)
(setq locale-coding-system coding-system))
@@ -238,14 +237,18 @@ bit output with no translation."
;; value from x-select-font etc, so list the most important charsets last.
(w32-add-charset-info "iso8859-14" 'w32-charset-ansi 28604)
(w32-add-charset-info "iso8859-15" 'w32-charset-ansi 28605)
+ (w32-add-charset-info "iso8859-16" 'w32-charset-ansi 28606)
;; The following two are included for pattern matching.
(w32-add-charset-info "jisx0201" 'w32-charset-shiftjis 932)
(w32-add-charset-info "jisx0208" 'w32-charset-shiftjis 932)
(w32-add-charset-info "jisx0201-latin" 'w32-charset-shiftjis 932)
(w32-add-charset-info "jisx0201-katakana" 'w32-charset-shiftjis 932)
+ (w32-add-charset-info "jisx0212" 'w32-charset-shiftjis 932)
(w32-add-charset-info "ksc5601.1989" 'w32-charset-hangeul 949)
+ (w32-add-charset-info "ksx1001" 'w32-charset-hangeul 949)
(w32-add-charset-info "big5" 'w32-charset-chinesebig5 950)
(w32-add-charset-info "gb2312.1980" 'w32-charset-gb2312 936)
+ (w32-add-charset-info "gbk" 'w32-charset-gb2312 936)
(w32-add-charset-info "ms-symbol" 'w32-charset-symbol nil)
(w32-add-charset-info "ms-oem" 'w32-charset-oem 437)
(w32-add-charset-info "ms-oemlatin" 'w32-charset-oem 850)
@@ -258,9 +261,12 @@ bit output with no translation."
(w32-add-charset-info "iso8859-9" 'w32-charset-turkish 1254)
(w32-add-charset-info "iso8859-13" 'w32-charset-baltic 1257)
(w32-add-charset-info "koi8-r" 'w32-charset-russian 20866)
+ (w32-add-charset-info "microsoft-cp1251" 'w32-charset-russian 1251)
+ (w32-add-charset-info "windows-1251" 'w32-charset-russian 1251)
(w32-add-charset-info "tis620-2533" 'w32-charset-russian 28595)
(w32-add-charset-info "iso8859-11" 'w32-charset-thai 874)
(w32-add-charset-info "windows-1258" 'w32-charset-vietnamese 1258)
+ (w32-add-charset-info "viscii" 'w32-charset-vietnamese 1258)
(w32-add-charset-info "ksc5601.1992" 'w32-charset-johab 1361)
(w32-add-charset-info "mac-roman" 'w32-charset-mac 10000)
(w32-add-charset-info "iso10646-1" 'w32-charset-default t)
diff --git a/lisp/w32-vars.el b/lisp/w32-vars.el
index 307490dc4b0..642a48446ef 100644
--- a/lisp/w32-vars.el
+++ b/lisp/w32-vars.el
@@ -1,4 +1,4 @@
-;;; w32-vars.el --- MS-Windows specific user options
+;;; w32-vars.el --- MS-Windows specific user options -*- lexical-binding:t -*-
;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
@@ -44,22 +44,19 @@ after changing the value of this variable."
:type 'boolean
:set (lambda (symbol value)
(set symbol value)
- (setq mouse-appearance-menu-map nil))
- :group 'w32)
+ (setq mouse-appearance-menu-map nil)))
(unless (eq system-type 'cygwin)
(defcustom w32-allow-system-shell nil
"Disable startup warning when using \"system\" shells."
- :type 'boolean
- :group 'w32))
+ :type 'boolean))
(unless (eq system-type 'cygwin)
(defcustom w32-system-shells '("cmd" "cmd.exe" "command" "command.com"
"4nt" "4nt.exe" "4dos" "4dos.exe"
"tcc" "tcc.exe" "ndos" "ndos.exe")
"List of strings recognized as Windows system shells."
- :type '(repeat string)
- :group 'w32))
+ :type '(repeat string)))
;; Want "menu" custom type for this.
(defcustom w32-fixed-font-alist
@@ -149,8 +146,7 @@ menu if the variable `w32-use-w32-font-dialog' is nil."
(const :tag "Separator" (""))
(list :tag "Font Entry"
(string :tag "Menu text")
- (string :tag "Font")))))))
- :group 'w32)
+ (string :tag "Font"))))))))
(make-obsolete-variable 'w32-enable-synthesized-fonts nil "24.4")
diff --git a/lisp/wdired.el b/lisp/wdired.el
index d91853e64dd..40f4cd97190 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -4,7 +4,7 @@
;; Filename: wdired.el
;; Author: Juan León Lahoz García <juanleon1@gmail.com>
-;; Version: 2.0
+;; Old-Version: 2.0
;; Keywords: dired, environment, files, renaming
;; This file is part of GNU Emacs.
@@ -344,7 +344,7 @@ non-nil means return old filename."
;; Don't unquote the old name, it wasn't quoted in the first place
(and file (setq file (wdired-normalize-filename file (not old)))))
(if (or no-dir old)
- file
+ (if no-dir (file-relative-name file) file)
(and file (> (length file) 0)
(concat (dired-current-directory) file))))))
@@ -461,10 +461,12 @@ non-nil means return old filename."
(defun wdired-do-renames (renames)
"Perform RENAMES in parallel."
- (let ((residue ())
- (progress nil)
- (errors 0)
- (overwrite (or (not wdired-confirm-overwrite) 1)))
+ (let* ((residue ())
+ (progress nil)
+ (errors 0)
+ (total (1- (length renames)))
+ (prep (make-progress-reporter "Renaming" 0 total))
+ (overwrite (or (not wdired-confirm-overwrite) 1)))
(while (or renames
;; We've done one round through the renames, we have found
;; some residue, but we also made some progress, so maybe
@@ -472,6 +474,7 @@ non-nil means return old filename."
(prog1 (setq renames residue)
(setq progress nil)
(setq residue nil)))
+ (progress-reporter-update prep (- total (length renames)))
(let* ((rename (pop renames))
(file-new (cdr rename)))
(cond
@@ -519,6 +522,7 @@ non-nil means return old filename."
(dired-log "Rename `%s' to `%s' failed:\n%s\n"
file-ori file-new
err)))))))))
+ (progress-reporter-done prep)
errors))
(defun wdired-create-parentdirs (file-new)
@@ -609,7 +613,10 @@ Optional arguments are ignored."
(defun wdired--restore-dired-filename-prop (beg end _len)
(save-match-data
(save-excursion
- (let ((lep (line-end-position)))
+ (let ((lep (line-end-position))
+ (used-F (dired-check-switches
+ dired-actual-switches
+ "F" "classify")))
(beginning-of-line)
(when (re-search-forward
directory-listing-before-filename-regexp lep t)
@@ -623,13 +630,17 @@ Optional arguments are ignored."
(and (re-search-backward
dired-permission-flags-regexp nil t)
(looking-at "l")
- (search-forward " -> " lep t))
+ ;; 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 (dired-check-switches dired-actual-switches
- "F" "classify")
+ (and used-F
(re-search-forward "[*/@|=>]$" lep t)))
(goto-char (match-beginning 0))
lep))
@@ -640,6 +651,7 @@ Optional arguments are ignored."
See `wdired-use-dired-vertical-movement'. Optional prefix ARG
says how many lines to move; default is one line."
(interactive "^p")
+ (setq this-command 'next-line) ;Let `line-move' preserve the column.
(with-no-warnings (next-line arg))
(if (or (eq wdired-use-dired-vertical-movement t)
(and wdired-use-dired-vertical-movement
@@ -653,6 +665,7 @@ says how many lines to move; default is one line."
See `wdired-use-dired-vertical-movement'. Optional prefix ARG
says how many lines to move; default is one line."
(interactive "^p")
+ (setq this-command 'previous-line) ;Let `line-move' preserve the column.
(with-no-warnings (previous-line arg))
(if (or (eq wdired-use-dired-vertical-movement t)
(and wdired-use-dired-vertical-movement
@@ -900,9 +913,9 @@ Like original function but it skips read-only words."
(if (= (length perms-new) 10)
(progn
(setq perm-tmp
- (int-to-string (wdired-perms-to-number perms-new)))
- (unless (equal 0 (process-file dired-chmod-program
- nil nil nil perm-tmp filename))
+ (string-to-number
+ (int-to-string (wdired-perms-to-number perms-new)) 8))
+ (unless (set-file-modes filename perm-tmp)
(setq errors (1+ errors))
(dired-log "%s %s `%s' failed\n\n"
dired-chmod-program perm-tmp filename)))
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index db7c023324b..669057811a5 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -5,7 +5,7 @@
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: data, wp
;; Version: 13.2.2
-;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
+;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
;; This file is part of GNU Emacs.
@@ -262,7 +262,7 @@
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; code:
+;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -283,7 +283,8 @@
'(face
tabs spaces trailing lines space-before-tab newline
indentation empty space-after-tab
- space-mark tab-mark newline-mark)
+ space-mark tab-mark newline-mark
+ missing-newline-at-eof)
"Specify which kind of blank is visualized.
It's a list containing some or all of the following values:
@@ -326,6 +327,11 @@ It's a list containing some or all of the following values:
It has effect only if `face' (see above)
is present in `whitespace-style'.
+ missing-newline-at-eof Missing newline at the end of the file is
+ visualized via faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
+
empty empty lines at beginning and/or end of buffer
are visualized via faces.
It has effect only if `face' (see above)
@@ -439,6 +445,8 @@ See also `whitespace-display-mappings' for documentation."
(const :tag "(Face) Lines" lines)
(const :tag "(Face) Lines, only overlong part" lines-tail)
(const :tag "(Face) NEWLINEs" newline)
+ (const :tag "(Face) Missing newlines at EOB"
+ missing-newline-at-eof)
(const :tag "(Face) Empty Lines At BOB And/Or EOB" empty)
(const :tag "(Face) Indentation SPACEs" indentation::tab)
(const :tag "(Face) Indentation TABs"
@@ -586,6 +594,10 @@ line. Used when `whitespace-style' includes the value `indentation'.")
"Face used to visualize big indentation."
:group 'whitespace)
+(defface whitespace-missing-newline-at-eof
+ '((((class mono)) :inverse-video t :weight bold :underline t)
+ (t :background "#d0d040" :foreground "black"))
+ "Face used to visualize missing newline at the end of the file.")
(defvar whitespace-empty 'whitespace-empty
"Symbol face used to visualize empty lines at beginning and/or end of buffer.
@@ -717,7 +729,7 @@ and the cons cdr is used for TABs visualization.
Used when `whitespace-style' includes `indentation',
`indentation::tab' or `indentation::space'."
:type '(cons (string :tag "Indentation SPACEs")
- (string :tag "Indentation TABs"))
+ (regexp :tag "Indentation TABs"))
:group 'whitespace)
@@ -1700,6 +1712,8 @@ cleaning up these problems."
(whitespace-space-after-tab-regexp 'tab))
((eq (car option) 'space-after-tab::space)
(whitespace-space-after-tab-regexp 'space))
+ ((eq (car option) 'missing-newline-at-eof)
+ "[^\n]\\'")
(t
(cdr option)))))
(when (re-search-forward regexp rend t)
@@ -2067,16 +2081,7 @@ resultant list will be returned."
,@(when (or (memq 'lines whitespace-active-style)
(memq 'lines-tail whitespace-active-style))
;; Show "long" lines.
- `((,(let ((line-column (or whitespace-line-column fill-column)))
- (format
- "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
- tab-width
- (1- tab-width)
- (/ line-column tab-width)
- (let ((rem (% line-column tab-width)))
- (if (zerop rem)
- ""
- (format ".\\{%d\\}" rem)))))
+ `((,#'whitespace-lines-regexp
,(if (memq 'lines whitespace-active-style)
0 ; whole line
2) ; line tail
@@ -2131,7 +2136,16 @@ resultant list will be returned."
((memq 'space-after-tab::space whitespace-active-style)
;; Show SPACEs after TAB (TABs).
(whitespace-space-after-tab-regexp 'space)))
- 1 whitespace-space-after-tab t)))))
+ 1 whitespace-space-after-tab t)))
+ ,@(when (memq 'missing-newline-at-eof whitespace-active-style)
+ ;; Show missing newline.
+ `(("[^\n]\\'" 0
+ ;; Don't mark the end of the buffer is point is there --
+ ;; it probably means that the user is typing something
+ ;; at the end of the buffer.
+ (and (/= whitespace-point (point-max))
+ 'whitespace-missing-newline-at-eof)
+ t)))))
(font-lock-add-keywords nil whitespace-font-lock-keywords t)
(font-lock-flush)))
@@ -2177,6 +2191,19 @@ resultant list will be returned."
(setq status nil))) ;; end of buffer
status))
+(defun whitespace-lines-regexp (limit)
+ (re-search-forward
+ (let ((line-column (or whitespace-line-column fill-column)))
+ (format
+ "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
+ tab-width
+ (1- tab-width)
+ (/ line-column tab-width)
+ (let ((rem (% line-column tab-width)))
+ (if (zerop rem)
+ ""
+ (format ".\\{%d\\}" rem)))))
+ limit t))
(defun whitespace-empty-at-bob-regexp (limit)
"Match spaces at beginning of buffer which do not contain the point at \
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index 097e769de8f..53f918cff9c 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -187,7 +187,7 @@ if that value is non-nil."
(define-widget 'widget-browse 'push-button
"Button for creating a widget browser.
-The :value of the widget shuld be the widget to be browsed."
+The :value of the widget should be the widget to be browsed."
:format "%[[%v]%]"
:value-create 'widget-browse-value-create
:action 'widget-browse-action)
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 62846523be4..0a2ddb0ea1d 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -236,8 +236,7 @@ minibuffer."
;; Construct a menu of the choices
;; and then use it for prompting for a single character.
(let* ((next-digit ?0)
- (map (make-sparse-keymap))
- choice some-choice-enabled value)
+ alist choice some-choice-enabled value)
(with-current-buffer (get-buffer-create " widget-choose")
(erase-buffer)
(insert "Available choices:\n\n")
@@ -247,7 +246,7 @@ minibuffer."
(let* ((name (substitute-command-keys (car choice)))
(function (cdr choice)))
(insert (format "%c = %s\n" next-digit name))
- (define-key map (vector next-digit) function)
+ (push (cons next-digit function) alist)
(setq some-choice-enabled t)))
;; Allocate digits to disabled alternatives
;; so that the digit of a given alternative never varies.
@@ -257,33 +256,17 @@ minibuffer."
(forward-line))
(or some-choice-enabled
(error "None of the choices is currently meaningful"))
- (define-key map [?\M-\C-v] 'scroll-other-window)
- (define-key map [?\M--] 'negative-argument)
(save-window-excursion
- (let ((buf (get-buffer " widget-choose")))
- (display-buffer buf
- '(display-buffer-in-direction
- (direction . bottom)
- (window-height . fit-window-to-buffer)))
- (let ((cursor-in-echo-area t)
- (arg 1))
- (while (not value)
- (setq value (lookup-key map (read-key-sequence (format "%s: " title))))
- (unless value
- (user-error "Canceled"))
- (when
- (cond ((eq value 'scroll-other-window)
- (let ((minibuffer-scroll-window
- (get-buffer-window buf)))
- (if (> 0 arg)
- (scroll-other-window-down
- (window-height minibuffer-scroll-window))
- (scroll-other-window))
- (setq arg 1)))
- ((eq value 'negative-argument)
- (setq arg -1)))
- (setq value nil))))))
- value))))
+ ;; Select window to be able to scroll it from minibuffer
+ (with-selected-window
+ (display-buffer (get-buffer " widget-choose")
+ '(display-buffer-in-direction
+ (direction . bottom)
+ (window-height . fit-window-to-buffer)))
+ (setq value (read-char-from-minibuffer
+ (format "%s: " title)
+ (mapcar #'car alist)))))
+ (cdr (assoc value alist))))))
;;; Widget text specifications.
;;
@@ -320,12 +303,15 @@ the :notify function can't know the new value.")
(or (not widget-field-add-space) (widget-get widget :size))))
(if (functionp help-echo)
(setq help-echo 'widget-mouse-help))
- (when (= (char-before to) ?\n)
+ (when (and (or (> to (1+ from)) (null (widget-get widget :size)))
+ (= (char-before to) ?\n))
;; When the last character in the field is a newline, we want to
;; give it a `field' char-property of `boundary', which helps the
;; C-n/C-p act more naturally when entering/leaving the field. We
- ;; do this by making a small secondary overlay to contain just that
- ;; one character.
+ ;; do this by making a small secondary overlay to contain just that
+ ;; one character. BUT we only do this if there is more than one
+ ;; character (so we don't do this for the character widget),
+ ;; or if the size of the editable field isn't specified.
(let ((overlay (make-overlay (1- to) to nil t nil)))
(overlay-put overlay 'field 'boundary)
;; We need the real field for tabbing.
@@ -594,6 +580,63 @@ respectively."
(if (and widget (funcall function widget maparg))
(setq overlays nil)))))
+(defun widget-describe (&optional widget-or-pos)
+ "Describe the widget at point.
+Displays a buffer with information about the widget (e.g., its actions) as well
+as a link to browse all the properties of the widget.
+
+This command resolves the indirection of widgets running the action of its
+parents, so the real action executed can be known.
+
+When called from Lisp, pass WIDGET-OR-POS as the widget to describe,
+or a buffer position where a widget is present. If WIDGET-OR-POS is nil,
+the widget at point is the widget to describe."
+ (interactive "d")
+ (require 'wid-browse) ; The widget-browse widget.
+ (let ((widget (if (widgetp widget-or-pos)
+ widget-or-pos
+ (widget-at widget-or-pos)))
+ props)
+ (when widget
+ (help-setup-xref (list #'widget-describe widget)
+ (called-interactively-p 'interactive))
+ (setq props (list (cons 'action (widget--resolve-parent-action widget))
+ (cons 'mouse-down-action
+ (widget-get widget :mouse-down-action))))
+ (with-help-window (help-buffer)
+ (with-current-buffer (help-buffer)
+ (widget-insert "This widget's type is ")
+ (widget-create 'widget-browse :format "%[%v%]\n%d"
+ :doc (get (car widget) 'widget-documentation)
+ :help-echo "Browse this widget's properties"
+ widget)
+ (dolist (action '(action mouse-down-action))
+ (let ((name (symbol-name action))
+ (val (alist-get action props)))
+ (when (functionp val)
+ (widget-insert "\n\n" (propertize (capitalize name) 'face 'bold)
+ "'\nThe " name " of this widget is")
+ (if (symbolp val)
+ (progn (widget-insert " ")
+ (widget-create 'function-link :value val
+ :button-prefix "" :button-suffix ""
+ :help-echo "Describe this function"))
+ (widget-insert "\n")
+ (princ val)))))))
+ (widget-setup)
+ t)))
+
+(defun widget--resolve-parent-action (widget)
+ "Resolve the real action of WIDGET up its inheritance chain.
+Follow the WIDGET's parents, until its :action is no longer
+`widget-parent-action', and return its value."
+ (let ((action (widget-get widget :action))
+ (parent (widget-get widget :parent)))
+ (while (eq action 'widget-parent-action)
+ (setq parent (widget-get parent :parent)
+ action (widget-get parent :action)))
+ action))
+
;;; Images.
(defcustom widget-image-directory (file-name-as-directory
@@ -933,86 +976,91 @@ Note that such modes will need to require wid-edit.")
"If non-nil, `widget-button-click' moves point to a button after invoking it.
If nil, point returns to its original position after invoking a button.")
+(defun widget-button--check-and-call-button (event button)
+ "Call BUTTON if BUTTON is a widget and EVENT is correct for it.
+If nothing was called, return non-nil."
+ (let* ((oevent event)
+ (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1)))
+ (pos (widget-event-point event))
+ newpoint)
+ (catch 'button-press-cancelled
+ ;; Mouse click on a widget button. Do the following
+ ;; in a save-excursion so that the click on the button
+ ;; doesn't change point.
+ (save-selected-window
+ (select-window (posn-window (event-start event)))
+ (save-excursion
+ (goto-char (posn-point (event-start event)))
+ (let* ((overlay (widget-get button :button-overlay))
+ (pressed-face (or (widget-get button :pressed-face)
+ widget-button-pressed-face))
+ (face (overlay-get overlay 'face))
+ (mouse-face (overlay-get overlay 'mouse-face)))
+ (unwind-protect
+ ;; Read events, including mouse-movement
+ ;; events, waiting for a release event. If we
+ ;; began with a mouse-1 event and receive a
+ ;; movement event, that means the user wants
+ ;; to perform drag-selection, so cancel the
+ ;; button press and do the default mouse-1
+ ;; action. For mouse-2, just highlight/
+ ;; unhighlight the button the mouse was
+ ;; initially on when we move over it.
+ (save-excursion
+ (when face ; avoid changing around image
+ (overlay-put overlay 'face pressed-face)
+ (overlay-put overlay 'mouse-face pressed-face))
+ (unless (widget-apply button :mouse-down-action event)
+ (let ((track-mouse t))
+ (while (not (widget-button-release-event-p event))
+ (setq event (read-event))
+ (when (and mouse-1 (mouse-movement-p event))
+ (push event unread-command-events)
+ (setq event oevent)
+ (throw 'button-press-cancelled t))
+ (unless (or (integerp event)
+ (memq (car event)
+ '(switch-frame select-window))
+ (eq (car event) 'scroll-bar-movement))
+ (setq pos (widget-event-point event))
+ (if (and pos
+ (eq (get-char-property pos 'button)
+ button))
+ (when face
+ (overlay-put overlay 'face pressed-face)
+ (overlay-put overlay 'mouse-face pressed-face))
+ (overlay-put overlay 'face face)
+ (overlay-put overlay 'mouse-face mouse-face))))))
+
+ ;; When mouse is released over the button, run
+ ;; its action function.
+ (when (and pos (eq (get-char-property pos 'button) button))
+ (goto-char pos)
+ (widget-apply-action button event)
+ (if widget-button-click-moves-point
+ (setq newpoint (point)))))
+ (overlay-put overlay 'face face)
+ (overlay-put overlay 'mouse-face mouse-face))))
+
+ (when newpoint
+ (goto-char newpoint)))
+ nil)))
+
(defun widget-button-click (event)
"Invoke the button that the mouse is pointing at."
(interactive "e")
(if (widget-event-point event)
- (let* ((oevent event)
- (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1)))
+ (let* ((mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1)))
(pos (widget-event-point event))
(start (event-start event))
- (button (get-char-property
+ (button (get-char-property
pos 'button (and (windowp (posn-window start))
- (window-buffer (posn-window start)))))
- newpoint)
+ (window-buffer (posn-window start))))))
+
(when (or (null button)
- (catch 'button-press-cancelled
- ;; Mouse click on a widget button. Do the following
- ;; in a save-excursion so that the click on the button
- ;; doesn't change point.
- (save-selected-window
- (select-window (posn-window (event-start event)))
- (save-excursion
- (goto-char (posn-point (event-start event)))
- (let* ((overlay (widget-get button :button-overlay))
- (pressed-face (or (widget-get button :pressed-face)
- widget-button-pressed-face))
- (face (overlay-get overlay 'face))
- (mouse-face (overlay-get overlay 'mouse-face)))
- (unwind-protect
- ;; Read events, including mouse-movement
- ;; events, waiting for a release event. If we
- ;; began with a mouse-1 event and receive a
- ;; movement event, that means the user wants
- ;; to perform drag-selection, so cancel the
- ;; button press and do the default mouse-1
- ;; action. For mouse-2, just highlight/
- ;; unhighlight the button the mouse was
- ;; initially on when we move over it.
- (save-excursion
- (when face ; avoid changing around image
- (overlay-put overlay 'face pressed-face)
- (overlay-put overlay 'mouse-face pressed-face))
- (unless (widget-apply button :mouse-down-action event)
- (let ((track-mouse t))
- (while (not (widget-button-release-event-p event))
- (setq event (read-event))
- (when (and mouse-1 (mouse-movement-p event))
- (push event unread-command-events)
- (setq event oevent)
- (throw 'button-press-cancelled t))
- (unless (or (integerp event)
- (memq (car event) '(switch-frame select-window))
- (eq (car event) 'scroll-bar-movement))
- (setq pos (widget-event-point event))
- (if (and pos
- (eq (get-char-property pos 'button)
- button))
- (when face
- (overlay-put overlay 'face pressed-face)
- (overlay-put overlay 'mouse-face pressed-face))
- (overlay-put overlay 'face face)
- (overlay-put overlay 'mouse-face mouse-face))))))
-
- ;; When mouse is released over the button, run
- ;; its action function.
- (when (and pos (eq (get-char-property pos 'button) button))
- (goto-char pos)
- (widget-apply-action button event)
- (if widget-button-click-moves-point
- (setq newpoint (point)))))
- (overlay-put overlay 'face face)
- (overlay-put overlay 'mouse-face mouse-face))))
-
- (if newpoint (goto-char newpoint))
- ;; This loses if the widget action switches windows. -- cyd
- ;; (unless (pos-visible-in-window-p (widget-event-point event))
- ;; (mouse-set-point event)
- ;; (beginning-of-line)
- ;; (recenter))
- )
- nil))
- (let ((up t) command)
+ (widget-button--check-and-call-button event button))
+ (let ((up t)
+ command)
;; Mouse click not on a widget button. Find the global
;; command to run, and check whether it is bound to an
;; up event.
@@ -1321,7 +1369,8 @@ Unlike (get-char-property POS \\='field), this works with empty fields too."
(signal 'text-read-only
'("Attempt to change text outside editable field")))
(widget-field-use-before-change
- (widget-apply from-field :notify from-field))))))
+ (widget-apply from-field :notify
+ from-field (list 'before-change from to)))))))
(defun widget-add-change ()
(remove-hook 'post-command-hook 'widget-add-change t)
@@ -1358,7 +1407,7 @@ Unlike (get-char-property POS \\='field), this works with empty fields too."
(> (point) begin))
(delete-char -1)))))))
(widget-specify-secret field))
- (widget-apply field :notify field))))
+ (widget-apply field :notify field (list 'after-change from to)))))
;;; Widget Functions
;;
@@ -1871,6 +1920,16 @@ If END is omitted, it defaults to the length of LIST."
"Show the variable specified by WIDGET."
(describe-variable (widget-value widget)))
+;;; The `face-link' Widget.
+
+(define-widget 'face-link 'link
+ "A link to an Emacs face."
+ :action 'widget-face-link-action)
+
+(defun widget-face-link-action (widget &optional _event)
+ "Show the variable specified by WIDGET."
+ (describe-face (widget-value widget)))
+
;;; The `file-link' Widget.
(define-widget 'file-link 'link
@@ -3121,6 +3180,16 @@ It reads a file name from an editable text field."
:completions (completion-table-case-fold
#'completion-file-name-table
(not read-file-name-completion-ignore-case))
+ :match (lambda (widget value)
+ (and (stringp value)
+ (or (not (widget-get widget :must-match))
+ (file-exists-p value))))
+ :validate (lambda (widget)
+ (let ((value (widget-value widget)))
+ (unless (widget-apply widget :match value)
+ (widget-put widget
+ :error (format "File %s does not exist" value))
+ widget)))
:prompt-value 'widget-file-prompt-value
:format "%{%t%}: %v"
;; Doesn't work well with terminating newline.
@@ -3132,11 +3201,10 @@ It reads a file name from an editable text field."
(abbreviate-file-name
(if unbound
(read-file-name prompt)
- (let ((prompt2 (format "%s (default %s): " prompt value))
- (dir (file-name-directory value))
+ (let ((dir (file-name-directory value))
(file (file-name-nondirectory value))
(must-match (widget-get widget :must-match)))
- (read-file-name prompt2 dir nil must-match file)))))
+ (read-file-name (format-prompt prompt value) dir nil must-match file)))))
;;;(defun widget-file-action (widget &optional event)
;;; ;; Read a file name from the minibuffer.
@@ -3248,10 +3316,10 @@ It reads a directory name from an editable text field."
"Read coding-system from minibuffer."
(if (widget-get widget :base-only)
(intern
- (completing-read (format "%s (default %s): " prompt value)
+ (completing-read (format-prompt prompt value)
(mapcar #'list (coding-system-list t)) nil nil nil
coding-system-history))
- (read-coding-system (format "%s (default %s): " prompt value) value)))
+ (read-coding-system (format-prompt prompt value) value)))
(defun widget-coding-system-action (widget &optional event)
(let ((answer
@@ -3459,19 +3527,76 @@ To use this type, you must define :match or :match-alternatives."
:value 0
:size 1
:format "%{%t%}: %v\n"
- :valid-regexp "\\`.\\'"
+ :valid-regexp "\\`\\(.\\|\n\\)\\'"
:error "This field should contain a single character"
:value-get (lambda (w) (widget-field-value-get w t))
:value-to-internal (lambda (_widget value)
(if (stringp value)
value
- (char-to-string value)))
+ (let ((disp
+ (widget-character--change-character-display
+ value)))
+ (if disp
+ (propertize (char-to-string value) 'display disp)
+ (char-to-string value)))))
:value-to-external (lambda (_widget value)
(if (stringp value)
(aref value 0)
value))
:match (lambda (_widget value)
- (characterp value)))
+ (characterp value))
+ :notify #'widget-character-notify)
+
+;; Only some escape sequences, not all of them. (Bug#15925)
+(defvar widget-character--escape-sequences-alist
+ '((?\t . ?t)
+ (?\n . ?n)
+ (?\s . ?s))
+ "Alist that associates escape sequences to a character.
+Each element has the form (ESCAPE-SEQUENCE . CHARACTER).
+
+The character widget uses this alist to display the
+non-printable character represented by ESCAPE-SEQUENCE as \\CHARACTER,
+since that makes it easier to see what's in the widget.")
+
+(defun widget-character--change-character-display (c)
+ "Return a string to represent the character C, or nil.
+
+The character widget represents some characters (e.g., the newline character
+or the tab character) specially, to make it easier for the user to see what's
+in it. For those characters, return a string to display that character in a
+more user-friendly way.
+
+For the caller, nil should mean that it is good enough to use the return value
+of `char-to-string' for the representation of C."
+ (let ((char (alist-get c widget-character--escape-sequences-alist)))
+ (and char (propertize (format "\\%c" char) 'face 'escape-glyph))))
+
+(defun widget-character-notify (widget child &optional event)
+ "Notify function for the character widget.
+
+This function allows the widget character to better display some characters,
+like the newline character or the tab character."
+ (when (eq (car-safe event) 'after-change)
+ (let* ((start (nth 1 event))
+ (end (nth 2 event))
+ str)
+ (if (eql start end)
+ (when (char-equal (widget-value widget) ?\s)
+ ;; The character widget is not really empty:
+ ;; its value is a single space character.
+ ;; We need to propertize it again, if it became empty for a while.
+ (let ((ov (widget-get widget :field-overlay)))
+ (put-text-property
+ (overlay-start ov) (overlay-end ov)
+ 'display (widget-character--change-character-display ?\s))))
+ (setq str (buffer-substring-no-properties start end))
+ ;; This assumes the user enters one character at a time,
+ ;; and does nothing crazy, like yanking a long string.
+ (let ((disp (widget-character--change-character-display (aref str 0))))
+ (when disp
+ (put-text-property start end 'display disp))))))
+ (widget-default-notify widget child event))
(define-widget 'list 'group
"A Lisp list."
diff --git a/lisp/windmove.el b/lisp/windmove.el
index 6e62e161548..65579600640 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -461,50 +461,38 @@ select the window with a displayed buffer, and the meaning of
the prefix argument is reversed.
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))
- (old-window (or (minibuffer-selected-window) (selected-window)))
- (new-window)
- (minibuffer-depth (minibuffer-depth))
- (action (lambda (buffer alist)
- (unless (> (minibuffer-depth) minibuffer-depth)
- (let ((window (cond
- ((eq dir 'new-tab)
- (let ((tab-bar-new-tab-choice t))
- (tab-bar-new-tab))
- (selected-window))
- ((eq dir 'same-window)
- (selected-window))
- (t (window-in-direction
- dir nil nil
- (and arg (prefix-numeric-value arg))
- windmove-wrap-around))))
- (type 'reuse))
- (unless window
- (setq window (split-window nil nil dir) type 'window))
- (setq new-window (window--display-buffer buffer window
- type alist))))))
- (command this-command)
- (clearfun (make-symbol "clear-display-buffer-overriding-action"))
- (exitfun
- (lambda ()
- (setq display-buffer-overriding-action
- (delq action display-buffer-overriding-action))
- (when (window-live-p (if no-select old-window new-window))
- (select-window (if no-select old-window new-window)))
- (remove-hook 'post-command-hook clearfun))))
- (fset clearfun
- (lambda ()
- (unless (or
- ;; Remove the hook immediately
- ;; after exiting the minibuffer.
- (> (minibuffer-depth) minibuffer-depth)
- ;; But don't remove immediately after
- ;; adding the hook by the same command below.
- (eq this-command command))
- (funcall exitfun))))
- (add-hook 'post-command-hook clearfun)
- (push action display-buffer-overriding-action)
- (message "[display-%s]" dir)))
+ (let ((no-select (xor (consp arg) windmove-display-no-select)))
+ (display-buffer-override-next-command
+ (lambda (_buffer alist)
+ (let* ((type 'reuse)
+ (window (cond
+ ((eq dir 'new-tab)
+ (let ((tab-bar-new-tab-choice t))
+ (tab-bar-new-tab))
+ (setq type 'tab)
+ (selected-window))
+ ((eq dir 'new-frame)
+ (let* ((params (cdr (assq 'pop-up-frame-parameters alist)))
+ (pop-up-frame-alist (append params pop-up-frame-alist))
+ (frame (make-frame-on-current-monitor
+ pop-up-frame-alist)))
+ (unless (cdr (assq 'inhibit-switch-frame alist))
+ (window--maybe-raise-frame frame))
+ (setq type 'frame)
+ (frame-selected-window frame)))
+ ((eq dir 'same-window)
+ (selected-window))
+ (t (window-in-direction
+ dir nil nil
+ (and arg (prefix-numeric-value arg))
+ windmove-wrap-around)))))
+ (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))
+ (select-window (if no-select old-window new-window))))
+ (format "[display-%s]" dir))))
;;;###autoload
(defun windmove-display-left (&optional arg)
@@ -541,6 +529,12 @@ See the logic of the prefix ARG in `windmove-display-in-direction'."
(windmove-display-in-direction 'same-window arg))
;;;###autoload
+(defun windmove-display-new-frame (&optional arg)
+ "Display the next buffer in a new frame."
+ (interactive "P")
+ (windmove-display-in-direction 'new-frame arg))
+
+;;;###autoload
(defun windmove-display-new-tab (&optional arg)
"Display the next buffer in a new tab."
(interactive "P")
@@ -561,6 +555,7 @@ Default value of MODIFIERS is `shift-meta'."
(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))
diff --git a/lisp/window.el b/lisp/window.el
index 7b75495ad84..1fcfffcb53d 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -226,7 +226,9 @@ BODY."
"Show a buffer BUFFER-OR-NAME and evaluate BODY in that buffer.
This construct is like `with-current-buffer-window' but unlike that,
displays the buffer specified by BUFFER-OR-NAME before running BODY."
- (declare (debug t) (indent 3))
+ (declare (debug t) (indent 3)
+ (obsolete "use `with-current-buffer-window' with action alist entry `body-function'."
+ "28.1"))
(let ((buffer (make-symbol "buffer"))
(window (make-symbol "window"))
(value (make-symbol "value")))
@@ -278,6 +280,24 @@ displays the buffer specified by BUFFER-OR-NAME before running BODY."
(funcall ,vquit-function ,window ,value)
,value)))))
+(defmacro with-window-non-dedicated (window &rest body)
+ "Evaluate BODY with WINDOW temporarily made non-dedicated.
+If WINDOW is nil, use the selected window. Return the value of
+the last form in BODY."
+ (declare (indent 1) (debug t))
+ (let ((window-dedicated-sym (gensym))
+ (window-sym (gensym)))
+ `(let* ((,window-sym (window-normalize-window ,window t))
+ (,window-dedicated-sym (window-dedicated-p ,window-sym)))
+ (set-window-dedicated-p ,window-sym nil)
+ (unwind-protect
+ (progn ,@body)
+ ;; `window-dedicated-p' returns the value set by
+ ;; `set-window-dedicated-p', which differentiates non-nil and
+ ;; t, so we cannot simply use t here. That's why we use
+ ;; `window-dedicated-sym'.
+ (set-window-dedicated-p ,window-sym ,window-dedicated-sym)))))
+
;; The following two functions are like `window-next-sibling' and
;; `window-prev-sibling' but the WINDOW argument is _not_ optional (so
;; they don't substitute the selected window for nil), and they return
@@ -2152,7 +2172,8 @@ the font."
(with-selected-window (window-normalize-window window t)
(let* ((window-width (window-body-width window t))
(font-width (window-font-width window face))
- (ncols (/ window-width font-width)))
+ (ncols (- (/ window-width font-width)
+ (ceiling (line-number-display-width 'columns)))))
(if (and (display-graphic-p)
overflow-newline-into-fringe
(not
@@ -2622,12 +2643,17 @@ and no others."
"Return t if WINDOW is the currently active minibuffer window."
(and (window-live-p window) (eq window (active-minibuffer-window))))
-(defun count-windows (&optional minibuf)
+(defun count-windows (&optional minibuf all-frames)
"Return the number of live windows on the selected frame.
+
The optional argument MINIBUF specifies whether the minibuffer
-window shall be counted. See `walk-windows' for the precise
-meaning of this argument."
- (length (window-list-1 nil minibuf)))
+window is included in the count.
+
+If ALL-FRAMES is non-nil, count the windows in all frames instead
+just the selected frame.
+
+See `walk-windows' for the precise meaning of this argument."
+ (length (window-list-1 nil minibuf all-frames)))
;;; Resizing windows.
(defun window--size-to-pixel (window size &optional horizontal pixelwise round-maybe)
@@ -3911,7 +3937,7 @@ TOP RIGHT BOTTOM) as returned by `window-edges'."
(setq frame (window-normalize-frame frame))
(window--subtree (frame-root-window frame) t))
-(defun other-window (count &optional all-frames)
+(defun other-window (count &optional all-frames interactive)
"Select another window in cyclic ordering of windows.
COUNT specifies the number of windows to skip, starting with the
selected window, before making the selection. If COUNT is
@@ -3931,7 +3957,7 @@ This function uses `next-window' for finding the window to
select. The argument ALL-FRAMES has the same meaning as in
`next-window', but the MINIBUF argument of `next-window' is
always effectively nil."
- (interactive "p")
+ (interactive "p\ni\np")
(let* ((window (selected-window))
(original-window window)
(function (and (not ignore-window-parameters)
@@ -3977,13 +4003,53 @@ always effectively nil."
(setq count (1+ count)))))
(when (and (eq window original-window)
- (called-interactively-p 'interactive))
+ interactive
+ (not (or executing-kbd-macro noninteractive)))
(message "No other window to select"))
(select-window window)
;; Always return nil.
nil))))
+(defun other-window-prefix ()
+ "Display the buffer of the next command in a new window.
+The next buffer is the buffer displayed by the next command invoked
+immediately after this command (ignoring reading from the minibuffer).
+Creates a new window before displaying the buffer.
+When `switch-to-buffer-obey-display-actions' is non-nil,
+`switch-to-buffer' commands are also supported."
+ (interactive)
+ (display-buffer-override-next-command
+ (lambda (buffer alist)
+ (let ((alist (append '((inhibit-same-window . t)) alist))
+ window type)
+ (if (setq window (display-buffer-pop-up-window buffer alist))
+ (setq type 'window)
+ (setq window (display-buffer-use-some-window buffer alist)
+ type 'reuse))
+ (cons window type)))
+ nil "[other-window]")
+ (message "Display next command buffer in a new window..."))
+
+(defun same-window-prefix ()
+ "Display the buffer of the next command in the same window.
+The next buffer is the buffer displayed by the next command invoked
+immediately after this command (ignoring reading from the minibuffer).
+Even when the default rule should display the buffer in a new window,
+force its display in the already selected window.
+When `switch-to-buffer-obey-display-actions' is non-nil,
+`switch-to-buffer' commands are also supported."
+ (interactive)
+ (display-buffer-override-next-command
+ (lambda (buffer alist)
+ (setq alist (append '((inhibit-same-window . nil)) alist))
+ (cons (or
+ (display-buffer-same-window buffer alist)
+ (display-buffer-use-some-window buffer alist))
+ 'reuse))
+ nil "[same-window]")
+ (message "Display next command buffer in the same window..."))
+
;; This should probably return non-nil when the selected window is part
;; of an atomic window whose root is the frame's root window.
(defun one-window-p (&optional nomini all-frames)
@@ -4192,7 +4258,7 @@ that is its frame's root window."
;; Always return nil.
nil))))
-(defun delete-other-windows (&optional window)
+(defun delete-other-windows (&optional window interactive)
"Make WINDOW fill its frame.
WINDOW must be a valid window and defaults to the selected one.
Return nil.
@@ -4209,7 +4275,7 @@ with the root of the atomic window as its argument. Signal an
error if that root window is the root window of WINDOW's frame.
Also signal an error if WINDOW is a side window. Do not delete
any window whose `no-delete-other-windows' parameter is non-nil."
- (interactive)
+ (interactive "i\np")
(setq window (window-normalize-window window))
(let* ((frame (window-frame window))
(function (window-parameter window 'delete-other-windows))
@@ -4275,7 +4341,8 @@ any window whose `no-delete-other-windows' parameter is non-nil."
(if (eq window main)
;; Give a message to the user if this has been called as a
;; command.
- (when (called-interactively-p 'interactive)
+ (when (and interactive
+ (not (or executing-kbd-macro noninteractive)))
(message "No other windows to delete"))
(delete-other-windows-internal window main)
(window--check frame))
@@ -4838,11 +4905,11 @@ displayed there."
(interactive)
(switch-to-buffer (last-buffer)))
-(defun next-buffer (&optional arg)
+(defun next-buffer (&optional arg interactive)
"In selected window switch to ARGth next buffer.
Call `switch-to-next-buffer' unless the selected window is the
minibuffer window or is dedicated to its buffer."
- (interactive "p")
+ (interactive "p\np")
(cond
((window-minibuffer-p)
(user-error "Cannot switch buffers in minibuffer window"))
@@ -4851,14 +4918,15 @@ minibuffer window or is dedicated to its buffer."
(t
(dotimes (_ (or arg 1))
(when (and (not (switch-to-next-buffer))
- (called-interactively-p 'interactive))
+ interactive
+ (not (or executing-kbd-macro noninteractive)))
(user-error "No next buffer"))))))
-(defun previous-buffer (&optional arg)
+(defun previous-buffer (&optional arg interactive)
"In selected window switch to ARGth previous buffer.
Call `switch-to-prev-buffer' unless the selected window is the
minibuffer window or is dedicated to its buffer."
- (interactive "p")
+ (interactive "p\np")
(cond
((window-minibuffer-p)
(user-error "Cannot switch buffers in minibuffer window"))
@@ -4867,7 +4935,8 @@ minibuffer window or is dedicated to its buffer."
(t
(dotimes (_ (or arg 1))
(when (and (not (switch-to-prev-buffer))
- (called-interactively-p 'interactive))
+ interactive
+ (not (or executing-kbd-macro noninteractive)))
(user-error "No previous buffer"))))))
(defun delete-windows-on (&optional buffer-or-name frame)
@@ -5009,6 +5078,13 @@ nil means to not handle the buffer in a particular way. This
quad entry)
(cond
((and (not prev-buffer)
+ (eq (nth 1 quit-restore) 'tab)
+ (eq (nth 3 quit-restore) buffer))
+ (tab-bar-close-tab)
+ ;; If the previously selected window is still alive, select it.
+ (when (window-live-p (nth 2 quit-restore))
+ (select-window (nth 2 quit-restore))))
+ ((and (not prev-buffer)
(or (eq (nth 1 quit-restore) 'frame)
(and (eq (nth 1 quit-restore) 'window)
;; If the window has been created on an existing
@@ -5659,10 +5735,10 @@ window."
WINDOW defaults to the selected window. DIRECTION can be
nil (i.e. any), `height' or `width'."
(with-current-buffer (window-buffer window)
- (when (and (boundp 'window-size-fixed) window-size-fixed)
- (not (and direction
- (member (cons direction window-size-fixed)
- '((height . width) (width . height))))))))
+ (and window-size-fixed
+ (not (and direction
+ (member (cons direction window-size-fixed)
+ '((height . width) (width . height))))))))
;;; A different solution to balance-windows.
(defvar window-area-factor 1
@@ -6367,7 +6443,12 @@ fourth element is BUFFER."
;; WINDOW has been created on a new frame.
(set-window-parameter
window 'quit-restore
- (list 'frame 'frame (selected-window) buffer)))))
+ (list 'frame 'frame (selected-window) buffer)))
+ ((eq type 'tab)
+ ;; WINDOW has been created on a new tab.
+ (set-window-parameter
+ window 'quit-restore
+ (list 'tab 'tab (selected-window) buffer)))))
(defcustom display-buffer-function nil
"If non-nil, function to call to handle `display-buffer'.
@@ -7034,8 +7115,14 @@ Return WINDOW if BUFFER and WINDOW are live."
;; use that.
(display-buffer-mark-dedicated
(set-window-dedicated-p window display-buffer-mark-dedicated))))
- (when (memq type '(window frame))
+ (when (memq type '(window frame tab))
(set-window-prev-buffers window nil))
+
+ (when (functionp (cdr (assq 'body-function alist)))
+ (let ((inhibit-read-only t)
+ (inhibit-modification-hooks t))
+ (funcall (cdr (assq 'body-function alist)) window)))
+
(let ((quit-restore (window-parameter window 'quit-restore))
(height (cdr (assq 'window-height alist)))
(width (cdr (assq 'window-width alist)))
@@ -7363,6 +7450,12 @@ Action alist entries are:
parameters to give the chosen window.
`allow-no-window' -- A non-nil value means that `display-buffer'
may not display the buffer and return nil immediately.
+ `body-function' -- A function called with one argument - the
+ displayed window. It is called after the buffer is
+ displayed, and before `window-height', `window-width'
+ and `preserve-size' are applied. The function is supposed
+ to fill the window body with some contents that might depend
+ on dimensions of the displayed window.
The entries `window-height', `window-width' and `preserve-size'
are applied only when the window used for displaying the buffer
@@ -7619,7 +7712,7 @@ indirectly called by the latter."
(with-current-buffer (window-buffer window)
(cond ((memq major-mode allowed-modes)
'same)
- ((derived-mode-p allowed-modes)
+ ((apply #'derived-mode-p allowed-modes)
'derived)))))
(when (and mode?
(not (and inhibit-same-window-p
@@ -7879,15 +7972,15 @@ Info node `(elisp) Buffer Display Action Alists' for details of
such alists.
ALIST has to contain a `direction' entry whose value should be
-one of `left', `above' (or `up'), `right' and `below' (or
-'down'). Other values are usually interpreted as `below'.
+one of `left', `above' (or `up'), `right' and `below' (or `down').
+Other values are usually interpreted as `below'.
If ALIST also contains a `window' entry, its value specifies a
reference window. That value can be a special symbol like
-'main' (which stands for the selected frame's main window) or
-'root' (standings for the selected frame's root window) or an
+`main' (which stands for the selected frame's main window) or
+`root' (standings for the selected frame's root window) or an
arbitrary valid window. Any other value (or omitting the
-'window' entry) means to use the selected window as reference
+`window' entry) means to use the selected window as reference
window.
This function tries to reuse or split a window such that the
@@ -8530,6 +8623,60 @@ documentation for additional customization information."
(interactive
(list (read-buffer-to-switch "Switch to buffer in other frame: ")))
(pop-to-buffer buffer-or-name display-buffer--other-frame-action norecord))
+
+(defun display-buffer-override-next-command (pre-function &optional post-function echo)
+ "Set `display-buffer-overriding-action' for the next command.
+`pre-function' is called to prepare the window where the buffer should be
+displayed. This function takes two arguments `buffer' and `alist', and
+should return a cons with the displayed window and its type. See the
+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."
+ (let* ((old-window (or (minibuffer-selected-window) (selected-window)))
+ (new-window nil)
+ (minibuffer-depth (minibuffer-depth))
+ (clearfun (make-symbol "clear-display-buffer-overriding-action"))
+ (action (lambda (buffer alist)
+ (unless (> (minibuffer-depth) minibuffer-depth)
+ (let* ((ret (funcall pre-function buffer alist))
+ (window (car ret))
+ (type (cdr ret)))
+ (setq new-window (window--display-buffer buffer window
+ type alist))
+ ;; Reset display-buffer-overriding-action
+ ;; after the first buffer display action
+ (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)
+ (remove-hook 'prefix-command-echo-keystrokes-functions echofun)
+ (when (functionp post-function)
+ (funcall post-function old-window new-window)))))
+ (fset clearfun
+ (lambda ()
+ (unless (or
+ ;; Remove the hook immediately
+ ;; after exiting the minibuffer.
+ (> (minibuffer-depth) minibuffer-depth)
+ ;; But don't remove immediately after
+ ;; 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)
+ (when echofun
+ (add-hook 'prefix-command-echo-keystrokes-functions echofun))
+ (push action (car display-buffer-overriding-action))))
+
(defun set-window-text-height (window height)
"Set the height in lines of the text display area of WINDOW to HEIGHT.
@@ -8590,16 +8737,32 @@ in some window."
(setq end (point-max)))
(if (= beg end)
0
- (save-excursion
- (save-restriction
- (widen)
- (narrow-to-region (min beg end)
- (if (and (not count-final-newline)
- (= ?\n (char-before (max beg end))))
- (1- (max beg end))
- (max beg end)))
- (goto-char (point-min))
- (1+ (vertical-motion (buffer-size) window))))))
+ (let ((start (min beg end))
+ (finish (max beg end))
+ count end-invisible-p)
+ ;; When END is invisible because lines are truncated in WINDOW,
+ ;; vertical-motion returns a number that is 1 larger than it
+ ;; should. We need to fix that.
+ (setq end-invisible-p
+ (and (or truncate-lines
+ (and (natnump truncate-partial-width-windows)
+ (< (window-total-width window)
+ truncate-partial-width-windows)))
+ (save-excursion
+ (goto-char finish)
+ (> (- (current-column) (window-hscroll window))
+ (window-body-width window)))))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (narrow-to-region start
+ (if (and (not count-final-newline)
+ (= ?\n (char-before finish)))
+ (1- finish)
+ finish))
+ (goto-char start)
+ (setq count (vertical-motion (buffer-size) window))
+ (if end-invisible-p count (1+ count)))))))
(defun window-buffer-height (window)
"Return the height (in screen lines) of the buffer that WINDOW is displaying.
@@ -10019,5 +10182,9 @@ displaying that processes's buffer."
(define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer)
(define-key ctl-x-map "+" 'balance-windows)
(define-key ctl-x-4-map "0" 'kill-buffer-and-window)
+(define-key ctl-x-4-map "1" 'same-window-prefix)
+(define-key ctl-x-4-map "4" 'other-window-prefix)
+
+(provide 'window)
;;; window.el ends here
diff --git a/lisp/woman.el b/lisp/woman.el
index 8465ab7c32e..eeacceadc27 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -6,7 +6,7 @@
;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, unix
;; Adapted-By: Eli Zaretskii <eliz@gnu.org>
-;; Version: 0.551
+;; Old-Version: 0.551
;; URL: http://centaur.maths.qmul.ac.uk/Emacs/WoMan/
;; This file is part of GNU Emacs.
@@ -401,6 +401,7 @@
;;; Code:
(defvar woman-version "0.551 (beta)" "WoMan version information.")
+(make-obsolete-variable 'woman-version nil "28.1")
(require 'man)
(require 'button)
@@ -674,7 +675,7 @@ These normally have names of the form `man?'. Its default value is
\"[Mm][Aa][Nn]\", which is case-insensitive mainly for the benefit of
Microsoft platforms. Its purpose is to avoid `cat?', `.', `..', etc."
;; Based on a suggestion by Wei-Xue Shi.
- :type 'string
+ :type 'regexp
:group 'woman-interface)
(defcustom woman-path
@@ -753,7 +754,7 @@ Default is t."
An alist with elements of the form (MENU-TITLE REGEXP INDEX) --
see the documentation for `imenu-generic-expression'."
:type '(alist :key-type (choice :tag "Title" (const nil) string)
- :value-type (group (choice (string :tag "Regexp")
+ :value-type (group (choice (regexp :tag "Regexp")
function)
integer))
:group 'woman-interface)
@@ -913,8 +914,8 @@ Troff emulation is experimental and largely untested.
:group 'faces)
(defcustom woman-fontify
- (or (and (fboundp 'display-color-p) (display-color-p))
- (and (fboundp 'display-graphic-p) (display-graphic-p))
+ (or (display-color-p)
+ (display-graphic-p)
(x-display-color-p))
"If non-nil then WoMan assumes that face support is available.
It defaults to a non-nil value if the display supports either colors
@@ -1276,14 +1277,11 @@ cache to be re-read."
(test-completion
word-at-point woman-topic-all-completions))
word-at-point)))
- (completing-read
- (if default
- (format "Manual entry (default %s): " default)
- "Manual entry: ")
- woman-topic-all-completions nil 1
- nil
- 'woman-topic-history
- default))))
+ (completing-read (format-prompt "Manual entry" default)
+ woman-topic-all-completions nil 1
+ nil
+ 'woman-topic-history
+ default))))
;; Note that completing-read always returns a string.
(unless (= (length topic) 0)
(cond
@@ -1830,7 +1828,6 @@ Argument EVENT is the invoking mouse event."
["Mini Help" woman-mini-help t]
,@(if (fboundp 'customize-group)
'(["Customize..." (customize-group 'woman) t]))
- ["Show Version" (message "WoMan %s" woman-version) t]
"--"
("Advanced"
["View Source" (view-file woman-last-file-name) woman-last-file-name]
@@ -1878,7 +1875,6 @@ Argument EVENT is the invoking mouse event."
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
-WoMan version: see `woman-version'.
See `Man-mode' for additional details.
\\{woman-mode-map}"
(let ((Man-build-page-list (symbol-function 'Man-build-page-list))
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index ea9d119e2ff..1d49f462531 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -1,4 +1,4 @@
-;;; x-dnd.el --- drag and drop support for X
+;;; x-dnd.el --- drag and drop support for X -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
@@ -32,7 +32,7 @@
(require 'dnd)
;;; Customizable variables
-(defcustom x-dnd-test-function 'x-dnd-default-test-function
+(defcustom x-dnd-test-function #'x-dnd-default-test-function
"The function drag and drop uses to determine if to accept or reject a drop.
The function takes three arguments, WINDOW, ACTION and TYPES.
WINDOW is where the mouse is when the function is called. WINDOW may be a
@@ -412,19 +412,13 @@ FRAME is the frame and W is the window where the drop happened.
If W is a window, return its absolute coordinates,
otherwise return the frame coordinates."
(let* ((frame-left (frame-parameter frame 'left))
- ;; If the frame is outside the display, frame-left looks like
- ;; '(0 -16). Extract the -16.
- (frame-real-left (if (consp frame-left) (car (cdr frame-left))
- frame-left))
- (frame-top (frame-parameter frame 'top))
- (frame-real-top (if (consp frame-top) (car (cdr frame-top))
- frame-top)))
+ (frame-top (frame-parameter frame 'top)))
(if (windowp w)
(let ((edges (window-inside-pixel-edges w)))
(cons
- (+ frame-real-left (nth 0 edges))
- (+ frame-real-top (nth 1 edges))))
- (cons frame-real-left frame-real-top))))
+ (+ frame-left (nth 0 edges))
+ (+ frame-top (nth 1 edges))))
+ (cons frame-left frame-top))))
(declare-function x-get-atom-name "xselect.c" (value &optional frame))
(declare-function x-send-client-message "xselect.c"
@@ -434,15 +428,11 @@ otherwise return the frame coordinates."
(defun x-dnd-version-from-flags (flags)
"Return the version byte from the 32 bit FLAGS in an XDndEnter message."
- (if (consp flags) ;; Long as cons
- (ash (car flags) -8)
- (ash flags -24))) ;; Ordinary number
+ (ash flags -24))
(defun x-dnd-more-than-3-from-flags (flags)
"Return the nmore-than3 bit from the 32 bit FLAGS in an XDndEnter message."
- (if (consp flags)
- (logand (cdr flags) 1)
- (logand flags 1)))
+ (logand flags 1))
(defun x-dnd-handle-xdnd (event frame window message _format data)
"Receive one XDND event (client message) and send the appropriate reply.
@@ -454,7 +444,7 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
(version (x-dnd-version-from-flags flags))
(more-than-3 (x-dnd-more-than-3-from-flags flags))
(dnd-source (aref data 0)))
- (message "%s %s" version more-than-3)
+ (message "%s %s" version more-than-3)
(if version ;; If flags is bad, version will be nil.
(x-dnd-save-state
window nil nil
@@ -495,10 +485,12 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
((equal "XdndDrop" message)
(if (windowp window) (select-window window))
(let* ((dnd-source (aref data 0))
+ (timestamp (aref data 2))
(value (and (x-dnd-current-type window)
(x-get-selection-internal
'XdndSelection
- (intern (x-dnd-current-type window)))))
+ (intern (x-dnd-current-type window))
+ timestamp)))
success action)
(setq action (if value
@@ -545,14 +537,14 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
((eq size 4)
(if (eq byteorder ?l)
- (cons (+ (ash (aref data (+ 3 offset)) 8)
- (aref data (+ 2 offset)))
- (+ (ash (aref data (1+ offset)) 8)
- (aref data offset)))
- (cons (+ (ash (aref data offset) 8)
- (aref data (1+ offset)))
- (+ (ash (aref data (+ 2 offset)) 8)
- (aref data (+ 3 offset))))))))
+ (+ (ash (aref data (+ 3 offset)) 24)
+ (ash (aref data (+ 2 offset)) 16)
+ (ash (aref data (1+ offset)) 8)
+ (aref data offset))
+ (+ (ash (aref data offset) 24)
+ (ash (aref data (1+ offset)) 16)
+ (ash (aref data (+ 2 offset)) 8)
+ (aref data (+ 3 offset)))))))
(defun x-dnd-motif-value-to-list (value size byteorder)
(let ((bytes (cond ((eq size 2)
@@ -560,15 +552,10 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
(logand value ?\xff)))
((eq size 4)
- (if (consp value)
- (list (logand (ash (car value) -8) ?\xff)
- (logand (car value) ?\xff)
- (logand (ash (cdr value) -8) ?\xff)
- (logand (cdr value) ?\xff))
- (list (logand (ash value -24) ?\xff)
- (logand (ash value -16) ?\xff)
- (logand (ash value -8) ?\xff)
- (logand value ?\xff)))))))
+ (list (logand (ash value -24) ?\xff)
+ (logand (ash value -16) ?\xff)
+ (logand (ash value -8) ?\xff)
+ (logand value ?\xff))))))
(if (eq byteorder ?l)
(reverse bytes)
bytes)))
diff --git a/lisp/xml.el b/lisp/xml.el
index dc774a202cf..c96ff80446a 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -655,7 +655,7 @@ Leave point at the first non-blank character after the tag."
(setq name (xml-maybe-do-ns (match-string-no-properties 1) nil xml-ns))
(goto-char end-pos)
- ;; See also: http://www.w3.org/TR/2000/REC-xml-20001006#AVNormalize
+ ;; See also: https://www.w3.org/TR/2000/REC-xml-20001006#AVNormalize
;; Do we have a string between quotes (or double-quotes),
;; or a simple word ?
@@ -1015,7 +1015,10 @@ The first line is indented with the optional INDENT-STRING."
(defalias 'xml-print 'xml-debug-print)
-(defun xml-escape-string (string)
+(defconst xml-invalid-characters-re
+ "[^\u0009\u000A\u000D\u0020-\uD7FF\uE000-\uFFFD\U00010000-\U0010FFFF]")
+
+(defun xml-escape-string (string &optional noerror)
"Convert STRING into a string containing valid XML character data.
Replace occurrences of &<>\\='\" in STRING with their default XML
entity references (e.g., replace each & with &amp;).
@@ -1023,9 +1026,20 @@ entity references (e.g., replace each & with &amp;).
XML character data must not contain & or < characters, nor the >
character under some circumstances. The XML spec does not impose
restriction on \" or \\=', but we just substitute for these too
-\(as is permitted by the spec)."
+\(as is permitted by the spec).
+
+If STRING contains characters that are invalid in XML (as defined
+by https://www.w3.org/TR/xml/#charsets), operate depending on the
+value of NOERROR: if it is non-nil, remove them; else, signal an
+error of type `xml-invalid-character'."
(with-temp-buffer
(insert string)
+ (goto-char (point-min))
+ (while (re-search-forward xml-invalid-characters-re nil t)
+ (if noerror
+ (replace-match "")
+ (signal 'xml-invalid-character
+ (list (char-before) (match-beginning 0)))))
(dolist (substitution '(("&" . "&amp;")
("<" . "&lt;")
(">" . "&gt;")
@@ -1036,6 +1050,9 @@ restriction on \" or \\=', but we just substitute for these too
(replace-match (cdr substitution) t t nil)))
(buffer-string)))
+(define-error 'xml-invalid-character "Invalid XML character"
+ 'wrong-type-argument)
+
(defun xml-debug-print-internal (xml indent-string)
"Outputs the XML tree in the current buffer.
The first line is indented with INDENT-STRING."
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index 2b9fab556e0..362d29b943d 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -237,7 +237,10 @@ which is the \"1006\" extension implemented in Xterm >= 277."
(xterm-mouse--read-event-sequence extension))
(t
(error "Unsupported XTerm mouse protocol")))))
- (when click
+ (when (and click
+ ;; In very obscure circumstances, the click may become
+ ;; invalid (see bug#17378).
+ (>= (nth 1 click) 0))
(let* ((type (nth 0 click))
(x (nth 1 click))
(y (nth 2 click))
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index 775dddf8ef6..caf57ae43fe 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -41,7 +41,10 @@
(declare-function xwidget-resize "xwidget.c" (xwidget new-width new-height))
(declare-function xwidget-webkit-execute-script "xwidget.c"
(xwidget script &optional callback))
+(declare-function xwidget-webkit-uri "xwidget.c" (xwidget))
+(declare-function xwidget-webkit-title "xwidget.c" (xwidget))
(declare-function xwidget-webkit-goto-uri "xwidget.c" (xwidget uri))
+(declare-function xwidget-webkit-goto-history "xwidget.c" (xwidget rel-pos))
(declare-function xwidget-webkit-zoom "xwidget.c" (xwidget factor))
(declare-function xwidget-plist "xwidget.c" (xwidget))
(declare-function set-xwidget-plist "xwidget.c" (xwidget plist))
@@ -51,6 +54,10 @@
(declare-function get-buffer-xwidgets "xwidget.c" (buffer))
(declare-function xwidget-query-on-exit-flag "xwidget.c" (xwidget))
+(defgroup xwidget nil
+ "Displaying native widgets in Emacs buffers."
+ :group 'widgets)
+
(defun xwidget-insert (pos type title width height &optional args)
"Insert an xwidget at position POS.
Supply the xwidget's TYPE, TITLE, WIDTH, and HEIGHT.
@@ -78,6 +85,8 @@ This returns the result of `make-xwidget'."
;;; webkit support
(require 'browse-url)
(require 'image-mode);;for some image-mode alike functionality
+(require 'seq)
+(require 'url-handlers)
;;;###autoload
(defun xwidget-webkit-browse-url (url &optional new-session)
@@ -92,10 +101,31 @@ Interactively, URL defaults to the string looking like a url around point."
(or (featurep 'xwidget-internal)
(user-error "Your Emacs was not compiled with xwidgets support"))
(when (stringp url)
+ ;; If it's a "naked url", just try adding https: to it.
+ (unless (string-match "\\`[A-Za-z]+:" url)
+ (setq url (concat "https://" url)))
(if new-session
(xwidget-webkit-new-session url)
(xwidget-webkit-goto-url url))))
+(defun xwidget-webkit-clone-and-split-below ()
+ "Clone current URL into a new widget place in new window below.
+Get the URL of current session, then browse to the URL
+in `split-window-below' with a new xwidget webkit session."
+ (interactive)
+ (let ((url (xwidget-webkit-current-url)))
+ (with-selected-window (split-window-below)
+ (xwidget-webkit-new-session url))))
+
+(defun xwidget-webkit-clone-and-split-right ()
+ "Clone current URL into a new widget place in new window right.
+Get the URL of current session, then browse to the URL
+in `split-window-right' with a new xwidget webkit session."
+ (interactive)
+ (let ((url (xwidget-webkit-current-url)))
+ (with-selected-window (split-window-right)
+ (xwidget-webkit-new-session url))))
+
;;todo.
;; - check that the webkit support is compiled in
(defvar xwidget-webkit-mode-map
@@ -103,6 +133,7 @@ Interactively, URL defaults to the string looking like a url around point."
(define-key map "g" 'xwidget-webkit-browse-url)
(define-key map "a" 'xwidget-webkit-adjust-size-dispatch)
(define-key map "b" 'xwidget-webkit-back)
+ (define-key map "f" 'xwidget-webkit-forward)
(define-key map "r" 'xwidget-webkit-reload)
(define-key map "t" (lambda () (interactive) (message "o"))) ;FIXME: ?!?
(define-key map "\C-m" 'xwidget-webkit-insert-string)
@@ -112,20 +143,21 @@ Interactively, URL defaults to the string looking like a url around point."
;;similar to image mode bindings
(define-key map (kbd "SPC") 'xwidget-webkit-scroll-up)
+ (define-key map (kbd "S-SPC") 'xwidget-webkit-scroll-down)
(define-key map (kbd "DEL") 'xwidget-webkit-scroll-down)
- (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up)
+ (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up-line)
(define-key map [remap scroll-up-command] 'xwidget-webkit-scroll-up)
- (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down)
+ (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down-line)
(define-key map [remap scroll-down-command] 'xwidget-webkit-scroll-down)
(define-key map [remap forward-char] 'xwidget-webkit-scroll-forward)
(define-key map [remap backward-char] 'xwidget-webkit-scroll-backward)
(define-key map [remap right-char] 'xwidget-webkit-scroll-forward)
(define-key map [remap left-char] 'xwidget-webkit-scroll-backward)
- (define-key map [remap previous-line] 'xwidget-webkit-scroll-down)
- (define-key map [remap next-line] 'xwidget-webkit-scroll-up)
+ (define-key map [remap previous-line] 'xwidget-webkit-scroll-down-line)
+ (define-key map [remap next-line] 'xwidget-webkit-scroll-up-line)
;; (define-key map [remap move-beginning-of-line] 'image-bol)
;; (define-key map [remap move-end-of-line] 'image-eol)
@@ -144,33 +176,63 @@ Interactively, URL defaults to the string looking like a url around point."
(interactive)
(xwidget-webkit-zoom (xwidget-webkit-current-session) -0.1))
-(defun xwidget-webkit-scroll-up ()
- "Scroll webkit up."
- (interactive)
+(defun xwidget-webkit-scroll-up (&optional arg)
+ "Scroll webkit up by ARG pixels; or full window height if no ARG.
+Stop if bottom of page is reached.
+Interactively, ARG is the prefix numeric argument.
+Negative ARG scrolls down."
+ (interactive "P")
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
- "window.scrollBy(0, 50);"))
-
-(defun xwidget-webkit-scroll-down ()
- "Scroll webkit down."
- (interactive)
+ (format "window.scrollBy(0, %d);"
+ (or arg (xwidget-window-inside-pixel-height (selected-window))))))
+
+(defun xwidget-webkit-scroll-down (&optional arg)
+ "Scroll webkit down by ARG pixels; or full window height if no ARG.
+Stop if top of page is reached.
+Interactively, ARG is the prefix numeric argument.
+Negative ARG scrolls up."
+ (interactive "P")
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
- "window.scrollBy(0, -50);"))
-
-(defun xwidget-webkit-scroll-forward ()
- "Scroll webkit forwards."
- (interactive)
+ (format "window.scrollBy(0, -%d);"
+ (or arg (xwidget-window-inside-pixel-height (selected-window))))))
+
+(defun xwidget-webkit-scroll-up-line (&optional n)
+ "Scroll webkit up by N lines.
+The height of line is calculated with `window-font-height'.
+Stop if the bottom edge of the page is reached.
+If N is omitted or nil, scroll up by one line."
+ (interactive "p")
+ (xwidget-webkit-scroll-up (* n (window-font-height))))
+
+(defun xwidget-webkit-scroll-down-line (&optional n)
+ "Scroll webkit down by N lines.
+The height of line is calculated with `window-font-height'.
+Stop if the top edge of the page is reached.
+If N is omitted or nil, scroll down by one line."
+ (interactive "p")
+ (xwidget-webkit-scroll-down (* n (window-font-height))))
+
+(defun xwidget-webkit-scroll-forward (&optional n)
+ "Scroll webkit horizontally by N chars.
+The width of char is calculated with `window-font-width'.
+If N is omitted or nil, scroll forwards by one char."
+ (interactive "p")
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
- "window.scrollBy(50, 0);"))
-
-(defun xwidget-webkit-scroll-backward ()
- "Scroll webkit backwards."
- (interactive)
+ (format "window.scrollBy(%d, 0);"
+ (* n (window-font-width)))))
+
+(defun xwidget-webkit-scroll-backward (&optional n)
+ "Scroll webkit back by N chars.
+The width of char is calculated with `window-font-width'.
+If N is omitted or nil, scroll backwards by one char."
+ (interactive "p")
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
- "window.scrollBy(-50, 0);"))
+ (format "window.scrollBy(-%d, 0);"
+ (* n (window-font-width)))))
(defun xwidget-webkit-scroll-top ()
"Scroll webkit to the very top."
@@ -184,7 +246,7 @@ Interactively, URL defaults to the string looking like a url around point."
(interactive)
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
- "window.scrollTo(pageXOffset, window.document.body.clientHeight);"))
+ "window.scrollTo(pageXOffset, window.document.body.scrollHeight);"))
;; The xwidget event needs to go into a higher level handler
;; since the xwidget can generate an event even if it's offscreen.
@@ -204,12 +266,8 @@ Interactively, URL defaults to the string looking like a url around point."
(let*
((xwidget-event-type (nth 1 last-input-event))
(xwidget (nth 2 last-input-event))
- ;;(xwidget-callback (xwidget-get xwidget 'callback))
- ;;TODO stopped working for some reason
- )
- ;;(funcall xwidget-callback xwidget xwidget-event-type)
- (message "xw callback %s" xwidget)
- (funcall 'xwidget-webkit-callback xwidget xwidget-event-type)))
+ (xwidget-callback (xwidget-get xwidget 'callback)))
+ (funcall xwidget-callback xwidget xwidget-event-type)))
(defun xwidget-webkit-callback (xwidget xwidget-event-type)
"Callback for xwidgets.
@@ -219,21 +277,23 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget."
"error: callback called for xwidget with dead buffer")
(with-current-buffer (xwidget-buffer xwidget)
(cond ((eq xwidget-event-type 'load-changed)
- (xwidget-webkit-execute-script
- xwidget "document.title"
- (lambda (title)
- (xwidget-log "webkit finished loading: '%s'" title)
- ;;TODO - check the native/internal scroll
- ;;(xwidget-adjust-size-to-content xwidget)
- (xwidget-webkit-adjust-size-to-window xwidget)
- (rename-buffer (format "*xwidget webkit: %s *" title))))
- (pop-to-buffer (current-buffer)))
+ (let ((title (xwidget-webkit-title xwidget)))
+ (xwidget-log "webkit finished loading: %s" title)
+ ;; Do not adjust webkit size to window here, the selected window
+ ;; can be the mini-buffer window unwantedly.
+ (rename-buffer (format "*xwidget webkit: %s *" title) t)))
((eq xwidget-event-type 'decide-policy)
(let ((strarg (nth 3 last-input-event)))
(if (string-match ".*#\\(.*\\)" strarg)
(xwidget-webkit-show-id-or-named-element
xwidget
(match-string 1 strarg)))))
+ ;; TODO: Response handling other than download.
+ ((eq xwidget-event-type 'download-callback)
+ (let ((url (nth 3 last-input-event))
+ (mime-type (nth 4 last-input-event))
+ (file-name (nth 5 last-input-event)))
+ (xwidget-webkit-save-as-file url mime-type file-name)))
((eq xwidget-event-type 'javascript-callback)
(let ((proc (nth 3 last-input-event))
(arg (nth 4 last-input-event)))
@@ -241,21 +301,66 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget."
(t (xwidget-log "unhandled event:%s" xwidget-event-type))))))
(defvar bookmark-make-record-function)
+(when (memq window-system '(mac ns))
+ (defvar xwidget-webkit-enable-plugins nil
+ "Enable plugins for xwidget webkit.
+If non-nil, plugins are enabled. Otherwise, disabled."))
+
(define-derived-mode xwidget-webkit-mode
- special-mode "xwidget-webkit" "Xwidget webkit view mode."
- (setq buffer-read-only t)
- (setq-local bookmark-make-record-function
- #'xwidget-webkit-bookmark-make-record)
- ;; Keep track of [vh]scroll when switching buffers
- (image-mode-setup-winprops))
+ special-mode "xwidget-webkit" "Xwidget webkit view mode."
+ (setq buffer-read-only t)
+ (setq-local bookmark-make-record-function
+ #'xwidget-webkit-bookmark-make-record)
+ ;; Keep track of [vh]scroll when switching buffers
+ (image-mode-setup-winprops))
+
+;;; Download, save as file.
+
+(defcustom xwidget-webkit-download-dir "~/Downloads/"
+ "Directory where download file saved."
+ :version "28.1"
+ :type 'file)
+
+(defun xwidget-webkit-save-as-file (url mime-type file-name)
+ "For XWIDGET webkit, save URL of MIME-TYPE to location specified by user.
+FILE-NAME combined with `xwidget-webkit-download-dir' is the default file name
+of the prompt when reading. When the file name the user specified is a
+directory, URL is saved at the specified directory as FILE-NAME."
+ (let ((save-name (read-file-name
+ (format "Save URL `%s' of type `%s' in file/directory: "
+ url mime-type)
+ xwidget-webkit-download-dir
+ (when file-name
+ (expand-file-name
+ file-name
+ xwidget-webkit-download-dir)))))
+ (if (file-directory-p save-name)
+ (setq save-name
+ (expand-file-name (file-name-nondirectory file-name) save-name)))
+ (setq xwidget-webkit-download-dir (file-name-directory save-name))
+ (url-copy-file url save-name t)))
+
+;;; Bookmarks integration
+
+(defcustom xwidget-webkit-bookmark-jump-new-session nil
+ "Control bookmark jump to use new session or not.
+If non-nil, use a new xwidget webkit session after bookmark jump.
+Otherwise, it will use `xwidget-webkit-last-session'.
+When you set this variable to nil, consider further customization with
+`xwidget-webkit-last-session-buffer'."
+ :version "28.1"
+ :type 'boolean)
(defun xwidget-webkit-bookmark-make-record ()
- "Integrate Emacs bookmarks with the webkit xwidget."
+ "Create bookmark record in webkit xwidget."
(nconc (bookmark-make-record-default t t)
- `((page . ,(xwidget-webkit-current-url))
- (handler . (lambda (bmk) (browse-url
- (bookmark-prop-get bmk 'page)))))))
+ `((page . ,(xwidget-webkit-uri (xwidget-webkit-current-session)))
+ (handler . (lambda (bmk)
+ (xwidget-webkit-browse-url
+ (bookmark-prop-get bmk 'page)
+ xwidget-webkit-bookmark-jump-new-session))))))
+;;; xwidget webkit session
(defvar xwidget-webkit-last-session-buffer nil)
@@ -303,7 +408,7 @@ function findactiveelement(doc){
"
- "javascript that finds the active element."
+ "Javascript that finds the active element."
;; Yes it's ugly, because:
;; - there is apparently no way to find the active frame other than recursion
;; - the js "for each" construct misbehaved on the "frames" collection
@@ -313,19 +418,22 @@ function findactiveelement(doc){
)
(defun xwidget-webkit-insert-string ()
- "Prompt for a string and insert it in the active field in the
-current webkit widget."
+ "Insert string into the active field in the current webkit widget."
;; Read out the string in the field first and provide for edit.
(interactive)
+ ;; As the prompt differs on JavaScript execution results,
+ ;; the function must handle the prompt itself.
(let ((xww (xwidget-webkit-current-session)))
(xwidget-webkit-execute-script
xww
(concat xwidget-webkit-activeelement-js "
(function () {
var res = findactiveelement(document);
- return [res.value, res.type];
+ if (res)
+ return [res.value, res.type];
})();")
(lambda (field)
+ "Prompt a string for the FIELD and insert in the active input."
(let ((str (pcase field
(`[,val "text"]
(read-string "Text: " val))
@@ -444,11 +552,23 @@ For example, use this to display an anchor."
(ignore-errors
(recenter-top-bottom)))
+;; Utility functions
+
+(defun xwidget-window-inside-pixel-width (window)
+ "Return Emacs WINDOW body width in pixel."
+ (let ((edges (window-inside-pixel-edges window)))
+ (- (nth 2 edges) (nth 0 edges))))
+
+(defun xwidget-window-inside-pixel-height (window)
+ "Return Emacs WINDOW body height in pixel."
+ (let ((edges (window-inside-pixel-edges window)))
+ (- (nth 3 edges) (nth 1 edges))))
+
(defun xwidget-webkit-adjust-size-to-window (xwidget &optional window)
"Adjust the size of the webkit XWIDGET to fit the WINDOW."
(xwidget-resize xwidget
- (window-pixel-width window)
- (window-pixel-height window)))
+ (xwidget-window-inside-pixel-width window)
+ (xwidget-window-inside-pixel-height window)))
(defun xwidget-webkit-adjust-size (w h)
"Manually set webkit size to width W, height H."
@@ -478,51 +598,56 @@ For example, use this to display an anchor."
(add-to-list 'window-size-change-functions
'xwidget-webkit-adjust-size-in-frame))
-(defun xwidget-webkit-new-session (url)
+(defun xwidget-webkit-new-session (url &optional callback)
"Create a new webkit session buffer with URL."
(let*
((bufname (generate-new-buffer-name "*xwidget-webkit*"))
+ (callback (or callback #'xwidget-webkit-callback))
xw)
(setq xwidget-webkit-last-session-buffer (switch-to-buffer
(get-buffer-create bufname)))
;; The xwidget id is stored in a text property, so we need to have
;; at least character in this buffer.
- (insert " ")
- (setq xw (xwidget-insert 1 'webkit bufname
- (window-pixel-width)
- (window-pixel-height)))
- (xwidget-put xw 'callback 'xwidget-webkit-callback)
+ ;; Insert invisible url, good default for next `g' to browse url.
+ (let ((start (point)))
+ (insert url)
+ (put-text-property start (+ start (length url)) 'invisible t)
+ (setq xw (xwidget-insert
+ start 'webkit bufname
+ (xwidget-window-inside-pixel-width (selected-window))
+ (xwidget-window-inside-pixel-height (selected-window)))))
+ (xwidget-put xw 'callback callback)
(xwidget-webkit-mode)
(xwidget-webkit-goto-uri (xwidget-webkit-last-session) url)))
(defun xwidget-webkit-goto-url (url)
- "Goto URL."
+ "Goto URL with xwidget webkit."
(if (xwidget-webkit-current-session)
(progn
(xwidget-webkit-goto-uri (xwidget-webkit-current-session) url))
(xwidget-webkit-new-session url)))
(defun xwidget-webkit-back ()
- "Go back in history."
+ "Go back to previous URL in xwidget webkit buffer."
(interactive)
- (xwidget-webkit-execute-script (xwidget-webkit-current-session)
- "history.go(-1);"))
+ (xwidget-webkit-goto-history (xwidget-webkit-current-session) -1))
+
+(defun xwidget-webkit-forward ()
+ "Go forward in history."
+ (interactive)
+ (xwidget-webkit-goto-history (xwidget-webkit-current-session) 1))
(defun xwidget-webkit-reload ()
- "Reload current url."
+ "Reload current URL."
(interactive)
- (xwidget-webkit-execute-script (xwidget-webkit-current-session)
- "history.go(0);"))
+ (xwidget-webkit-goto-history (xwidget-webkit-current-session) 0))
(defun xwidget-webkit-current-url ()
- "Get the webkit url and place it on the kill-ring."
+ "Display the current xwidget webkit URL and place it on the `kill-ring'."
(interactive)
- (xwidget-webkit-execute-script
- (xwidget-webkit-current-session)
- "document.URL" (lambda (rv)
- (let ((url (kill-new (or rv ""))))
- (message "url: %s" url)))))
+ (let ((url (xwidget-webkit-uri (xwidget-webkit-current-session))))
+ (message "URL: %s" (kill-new (or url "")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun xwidget-webkit-get-selection (proc)
@@ -533,10 +658,9 @@ For example, use this to display an anchor."
proc))
(defun xwidget-webkit-copy-selection-as-kill ()
- "Get the webkit selection and put it on the kill-ring."
+ "Get the webkit selection and put it on the `kill-ring'."
(interactive)
- (xwidget-webkit-get-selection (lambda (selection) (kill-new selection))))
-
+ (xwidget-webkit-get-selection #'kill-new))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Xwidget plist management (similar to the process plist functions)
diff --git a/m4/00gnulib.m4 b/m4/00gnulib.m4
index 1a1a1d74f7e..14628c363b7 100644
--- a/m4/00gnulib.m4
+++ b/m4/00gnulib.m4
@@ -1,43 +1,82 @@
-# 00gnulib.m4 serial 3
+# 00gnulib.m4 serial 8
dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
dnl This file must be named something that sorts before all other
-dnl gnulib-provided .m4 files. It is needed until such time as we can
-dnl assume Autoconf 2.64, with its improved AC_DEFUN_ONCE and
-dnl m4_divert semantics.
+dnl gnulib-provided .m4 files. It is needed until the clang fix has
+dnl been included in Autoconf.
-# Until autoconf 2.63, handling of the diversion stack required m4_init
-# to be called first; but this does not happen with aclocal. Wrapping
-# the entire execution in another layer of the diversion stack fixes this.
-# Worse, prior to autoconf 2.62, m4_wrap depended on the underlying m4
-# for whether it was FIFO or LIFO; in order to properly balance with
-# m4_init, we need to undo our push just before anything wrapped within
-# the m4_init body. The way to ensure this is to wrap both sides of
-# m4_init with a one-shot macro that does the pop at the right time.
-m4_ifndef([_m4_divert_diversion],
-[m4_divert_push([KILL])
-m4_define([gl_divert_fixup], [m4_divert_pop()m4_define([$0])])
-m4_define([m4_init],
- [gl_divert_fixup()]m4_defn([m4_init])[gl_divert_fixup()])])
-
-
-# AC_DEFUN_ONCE([NAME], VALUE)
-# ----------------------------
-# Define NAME to expand to VALUE on the first use (whether by direct
-# expansion, or by AC_REQUIRE), and to nothing on all subsequent uses.
-# Avoid bugs in AC_REQUIRE in Autoconf 2.63 and earlier. This
-# definition is slower than the version in Autoconf 2.64, because it
-# can only use interfaces that existed since 2.59; but it achieves the
-# same effect. Quoting is necessary to avoid confusing Automake.
-m4_version_prereq([2.63.263], [],
-[m4_define([AC][_DEFUN_ONCE],
- [AC][_DEFUN([$1],
- [AC_REQUIRE([_gl_DEFUN_ONCE([$1])],
- [m4_indir([_gl_DEFUN_ONCE([$1])])])])]dnl
-[AC][_DEFUN([_gl_DEFUN_ONCE([$1])], [$2])])])
+# The following definitions arrange to use a compiler option
+# -Werror=implicit-function-declaration in AC_CHECK_DECL, when the
+# compiler is clang. Without it, clang implicitly declares "known"
+# library functions in C mode, but not in C++ mode, which would cause
+# Gnulib to omit a declaration and thus later produce an error in C++
+# mode. As of clang 9.0, these "known" functions are identified through
+# LIBBUILTIN invocations in the LLVM source file
+# llvm/tools/clang/include/clang/Basic/Builtins.def.
+# It's not possible to AC_REQUIRE the extra tests from AC_CHECK_DECL,
+# because AC_CHECK_DECL, like other Autoconf built-ins, is not supposed
+# to AC_REQUIRE anything: some configure.ac files have their first
+# AC_CHECK_DECL executed conditionally. Therefore append the extra tests
+# to AC_PROG_CC.
+AC_DEFUN([gl_COMPILER_CLANG],
+[
+dnl AC_REQUIRE([AC_PROG_CC])
+ AC_CACHE_CHECK([whether the compiler is clang],
+ [gl_cv_compiler_clang],
+ [dnl Use _AC_COMPILE_IFELSE instead of AC_EGREP_CPP, to avoid error
+ dnl "circular dependency of AC_LANG_COMPILER(C)" if AC_PROG_CC has
+ dnl not yet been invoked.
+ _AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[
+ #ifdef __clang__
+ barfbarf
+ #endif
+ ]],[[]])
+ ],
+ [gl_cv_compiler_clang=no],
+ [gl_cv_compiler_clang=yes])
+ ])
+])
+AC_DEFUN([gl_COMPILER_PREPARE_CHECK_DECL],
+[
+dnl AC_REQUIRE([AC_PROG_CC])
+dnl AC_REQUIRE([gl_COMPILER_CLANG])
+ AC_CACHE_CHECK([for compiler option needed when checking for declarations],
+ [gl_cv_compiler_check_decl_option],
+ [if test $gl_cv_compiler_clang = yes; then
+ dnl Test whether the compiler supports the option
+ dnl '-Werror=implicit-function-declaration'.
+ save_ac_compile="$ac_compile"
+ ac_compile="$ac_compile -Werror=implicit-function-declaration"
+ dnl Use _AC_COMPILE_IFELSE instead of AC_COMPILE_IFELSE, to avoid a
+ dnl warning "AC_COMPILE_IFELSE was called before AC_USE_SYSTEM_EXTENSIONS".
+ _AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]],[[]])],
+ [gl_cv_compiler_check_decl_option='-Werror=implicit-function-declaration'],
+ [gl_cv_compiler_check_decl_option=none])
+ ac_compile="$save_ac_compile"
+ else
+ gl_cv_compiler_check_decl_option=none
+ fi
+ ])
+ if test "x$gl_cv_compiler_check_decl_option" != xnone; then
+ ac_compile_for_check_decl="$ac_compile $gl_cv_compiler_check_decl_option"
+ else
+ ac_compile_for_check_decl="$ac_compile"
+ fi
+])
+dnl Redefine _AC_CHECK_DECL_BODY so that it references ac_compile_for_check_decl
+dnl instead of ac_compile. If, for whatever reason, the override of AC_PROG_CC
+dnl in zzgnulib.m4 is inactive, use the original ac_compile.
+m4_define([_AC_CHECK_DECL_BODY],
+[ ac_save_ac_compile="$ac_compile"
+ if test -n "$ac_compile_for_check_decl"; then
+ ac_compile="$ac_compile_for_check_decl"
+ fi]
+m4_defn([_AC_CHECK_DECL_BODY])[ ac_compile="$ac_save_ac_compile"
+])
# gl_00GNULIB
# -----------
diff --git a/m4/absolute-header.m4 b/m4/absolute-header.m4
index 39726ba57ba..c043233de36 100644
--- a/m4/absolute-header.m4
+++ b/m4/absolute-header.m4
@@ -1,4 +1,4 @@
-# absolute-header.m4 serial 16
+# absolute-header.m4 serial 17
dnl Copyright (C) 2006-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -22,23 +22,21 @@ dnl From Derek Price.
AC_DEFUN([gl_ABSOLUTE_HEADER],
[AC_REQUIRE([AC_CANONICAL_HOST])
AC_LANG_PREPROC_REQUIRE()dnl
-dnl FIXME: gl_absolute_header and ac_header_exists must be used unquoted
-dnl until we can assume autoconf 2.64 or newer.
m4_foreach_w([gl_HEADER_NAME], [$1],
[AS_VAR_PUSHDEF([gl_absolute_header],
[gl_cv_absolute_]m4_defn([gl_HEADER_NAME]))dnl
AC_CACHE_CHECK([absolute name of <]m4_defn([gl_HEADER_NAME])[>],
- m4_defn([gl_absolute_header]),
+ [gl_absolute_header],
[AS_VAR_PUSHDEF([ac_header_exists],
[ac_cv_header_]m4_defn([gl_HEADER_NAME]))dnl
AC_CHECK_HEADERS_ONCE(m4_defn([gl_HEADER_NAME]))dnl
- if test AS_VAR_GET(ac_header_exists) = yes; then
+ if test AS_VAR_GET([ac_header_exists]) = yes; then
gl_ABSOLUTE_HEADER_ONE(m4_defn([gl_HEADER_NAME]))
fi
AS_VAR_POPDEF([ac_header_exists])dnl
])dnl
AC_DEFINE_UNQUOTED(AS_TR_CPP([ABSOLUTE_]m4_defn([gl_HEADER_NAME])),
- ["AS_VAR_GET(gl_absolute_header)"],
+ ["AS_VAR_GET([gl_absolute_header])"],
[Define this to an absolute name of <]m4_defn([gl_HEADER_NAME])[>.])
AS_VAR_POPDEF([gl_absolute_header])dnl
])dnl
diff --git a/m4/acl.m4 b/m4/acl.m4
index e459451ae31..a3dcf9357b9 100644
--- a/m4/acl.m4
+++ b/m4/acl.m4
@@ -1,5 +1,5 @@
# acl.m4 - check for access control list (ACL) primitives
-# serial 23
+# serial 24
# Copyright (C) 2002, 2004-2020 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
@@ -139,7 +139,7 @@ int type = ACL_TYPE_EXTENDED;]])],
AC_MSG_WARN([AC_PACKAGE_NAME will be built without ACL support.])
fi
fi
- test $gl_need_lib_has_acl && LIB_HAS_ACL=$LIB_ACL
+ test -n "$gl_need_lib_has_acl" && LIB_HAS_ACL=$LIB_ACL
AC_SUBST([LIB_ACL])
AC_DEFINE_UNQUOTED([USE_ACL], [$use_acl],
[Define to nonzero if you want access control list support.])
diff --git a/m4/alloca.m4 b/m4/alloca.m4
index 5f4653967d1..d8414896308 100644
--- a/m4/alloca.m4
+++ b/m4/alloca.m4
@@ -1,6 +1,6 @@
-# alloca.m4 serial 15
-dnl Copyright (C) 2002-2004, 2006-2007, 2009-2020 Free Software
-dnl Foundation, Inc.
+# alloca.m4 serial 18
+dnl Copyright (C) 2002-2004, 2006-2007, 2009-2020 Free Software Foundation,
+dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -50,13 +50,13 @@ AC_DEFUN([gl_FUNC_ALLOCA],
# STACK_DIRECTION is already handled by AC_FUNC_ALLOCA.
AC_DEFUN([gl_PREREQ_ALLOCA], [:])
-# This works around a bug in autoconf <= 2.68.
-# See <https://lists.gnu.org/r/bug-gnulib/2011-06/msg00277.html>.
+m4_version_prereq([2.70], [], [
-m4_version_prereq([2.69], [] ,[
-
-# This is taken from the following Autoconf patch:
-# https://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=6cd9f12520b0d6f76d3230d7565feba1ecf29497
+# This works around a bug in autoconf <= 2.68 and has simplifications
+# from 2.70. See:
+# https://lists.gnu.org/r/bug-gnulib/2011-06/msg00277.html
+# https://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=6cd9f12520b0d6f76d3230d7565feba1ecf29497
+# https://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=15edf7fd8094fd14a89d9891dd72a9624762597a
# _AC_LIBOBJ_ALLOCA
# -----------------
@@ -72,26 +72,6 @@ AC_LIBSOURCES(alloca.c)
AC_SUBST([ALLOCA], [\${LIBOBJDIR}alloca.$ac_objext])dnl
AC_DEFINE(C_ALLOCA, 1, [Define to 1 if using 'alloca.c'.])
-AC_CACHE_CHECK(whether 'alloca.c' needs Cray hooks, ac_cv_os_cray,
-[AC_EGREP_CPP(webecray,
-[#if defined CRAY && ! defined CRAY2
-webecray
-#else
-wenotbecray
-#endif
-], ac_cv_os_cray=yes, ac_cv_os_cray=no)])
-if test $ac_cv_os_cray = yes; then
- for ac_func in _getb67 GETB67 getb67; do
- AC_CHECK_FUNC($ac_func,
- [AC_DEFINE_UNQUOTED(CRAY_STACKSEG_END, $ac_func,
- [Define to one of '_getb67', 'GETB67',
- 'getb67' for Cray-2 and Cray-YMP
- systems. This function is required for
- 'alloca.c' support on those systems.])
- break])
- done
-fi
-
AC_CACHE_CHECK([stack direction for C alloca],
[ac_cv_c_stack_direction],
[AC_RUN_IFELSE([AC_LANG_SOURCE(
@@ -122,7 +102,7 @@ AH_VERBATIM([STACK_DIRECTION],
STACK_DIRECTION > 0 => grows toward higher addresses
STACK_DIRECTION < 0 => grows toward lower addresses
STACK_DIRECTION = 0 => direction of growth unknown */
-@%:@undef STACK_DIRECTION])dnl
+#undef STACK_DIRECTION])dnl
AC_DEFINE_UNQUOTED(STACK_DIRECTION, $ac_cv_c_stack_direction)
-])# _AC_LIBOBJ_ALLOCA
+])
])
diff --git a/m4/canonicalize.m4 b/m4/canonicalize.m4
index bdc5c8f71a7..14ea3e12fa0 100644
--- a/m4/canonicalize.m4
+++ b/m4/canonicalize.m4
@@ -1,4 +1,4 @@
-# canonicalize.m4 serial 31
+# canonicalize.m4 serial 33
dnl Copyright (C) 2003-2007, 2009-2020 Free Software Foundation, Inc.
@@ -56,7 +56,16 @@ AC_DEFUN([gl_CANONICALIZE_LGPL],
AC_DEFUN([gl_CANONICALIZE_LGPL_SEPARATE],
[
AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
- AC_CHECK_FUNCS_ONCE([canonicalize_file_name getcwd readlink])
+ AC_CHECK_FUNCS_ONCE([canonicalize_file_name readlink])
+
+ dnl On native Windows, we use _getcwd(), regardless whether getcwd() is
+ dnl available through the linker option '-loldnames'.
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ case "$host_os" in
+ mingw*) ;;
+ *) AC_CHECK_FUNCS([getcwd]) ;;
+ esac
+
AC_REQUIRE([gl_DOUBLE_SLASH_ROOT])
AC_REQUIRE([gl_FUNC_REALPATH_WORKS])
AC_CHECK_HEADERS_ONCE([sys/param.h])
@@ -70,6 +79,7 @@ AC_DEFUN([gl_FUNC_REALPATH_WORKS],
AC_CHECK_FUNCS_ONCE([realpath])
AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CACHE_CHECK([whether realpath works], [gl_cv_func_realpath_works], [
+ rm -rf conftest.a conftest.d
touch conftest.a
mkdir conftest.d
AC_RUN_IFELSE([
diff --git a/m4/count-leading-zeros.m4 b/m4/count-leading-zeros.m4
deleted file mode 100644
index 76cc876f296..00000000000
--- a/m4/count-leading-zeros.m4
+++ /dev/null
@@ -1,12 +0,0 @@
-# count-leading-zeros.m4 serial 2
-dnl Copyright (C) 2012-2020 Free Software Foundation, Inc.
-dnl This file is free software; the Free Software Foundation
-dnl gives unlimited permission to copy and/or distribute it,
-dnl with or without modifications, as long as this notice is preserved.
-
-AC_DEFUN([gl_COUNT_LEADING_ZEROS],
-[
- dnl We don't need (and can't compile) count_leading_zeros_ll
- dnl unless the type 'unsigned long long int' exists.
- AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT])
-])
diff --git a/m4/count-one-bits.m4 b/m4/count-one-bits.m4
deleted file mode 100644
index 132d52761f0..00000000000
--- a/m4/count-one-bits.m4
+++ /dev/null
@@ -1,12 +0,0 @@
-# count-one-bits.m4 serial 3
-dnl Copyright (C) 2007, 2009-2020 Free Software Foundation, Inc.
-dnl This file is free software; the Free Software Foundation
-dnl gives unlimited permission to copy and/or distribute it,
-dnl with or without modifications, as long as this notice is preserved.
-
-AC_DEFUN([gl_COUNT_ONE_BITS],
-[
- dnl We don't need (and can't compile) count_one_bits_ll
- dnl unless the type 'unsigned long long int' exists.
- AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT])
-])
diff --git a/m4/count-trailing-zeros.m4 b/m4/count-trailing-zeros.m4
deleted file mode 100644
index 0344c8ffa50..00000000000
--- a/m4/count-trailing-zeros.m4
+++ /dev/null
@@ -1,12 +0,0 @@
-# count-trailing-zeros.m4
-dnl Copyright (C) 2013-2020 Free Software Foundation, Inc.
-dnl This file is free software; the Free Software Foundation
-dnl gives unlimited permission to copy and/or distribute it,
-dnl with or without modifications, as long as this notice is preserved.
-
-AC_DEFUN([gl_COUNT_TRAILING_ZEROS],
-[
- dnl We don't need (and can't compile) count_trailing_zeros_ll
- dnl unless the type 'unsigned long long int' exists.
- AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT])
-])
diff --git a/m4/d-type.m4 b/m4/d-type.m4
index bcb179ad4e1..d40220a1b59 100644
--- a/m4/d-type.m4
+++ b/m4/d-type.m4
@@ -5,8 +5,7 @@ dnl
dnl Check whether struct dirent has a member named d_type.
dnl
-# Copyright (C) 1997, 1999-2004, 2006, 2009-2020 Free Software
-# Foundation, Inc.
+# Copyright (C) 1997, 1999-2004, 2006, 2009-2020 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/dup2.m4 b/m4/dup2.m4
index 2835bb1cf99..a82798d6bba 100644
--- a/m4/dup2.m4
+++ b/m4/dup2.m4
@@ -1,6 +1,5 @@
-#serial 25
-dnl Copyright (C) 2002, 2005, 2007, 2009-2020 Free Software Foundation,
-dnl Inc.
+#serial 27
+dnl Copyright (C) 2002, 2005, 2007, 2009-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -9,107 +8,95 @@ AC_DEFUN([gl_FUNC_DUP2],
[
AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
AC_REQUIRE([AC_CANONICAL_HOST])
- m4_ifdef([gl_FUNC_DUP2_OBSOLETE], [
- AC_CHECK_FUNCS_ONCE([dup2])
- if test $ac_cv_func_dup2 = no; then
- HAVE_DUP2=0
- fi
- ], [
- AC_DEFINE([HAVE_DUP2], [1], [Define to 1 if you have the 'dup2' function.])
- ])
- if test $HAVE_DUP2 = 1; then
- AC_CACHE_CHECK([whether dup2 works], [gl_cv_func_dup2_works],
- [AC_RUN_IFELSE([
- AC_LANG_PROGRAM(
- [[#include <errno.h>
- #include <fcntl.h>
- #include <limits.h>
- #include <sys/resource.h>
- #include <unistd.h>
- #ifndef RLIM_SAVED_CUR
- # define RLIM_SAVED_CUR RLIM_INFINITY
- #endif
- #ifndef RLIM_SAVED_MAX
- # define RLIM_SAVED_MAX RLIM_INFINITY
- #endif
- ]],
- [[int result = 0;
- int bad_fd = INT_MAX;
- struct rlimit rlim;
- if (getrlimit (RLIMIT_NOFILE, &rlim) == 0
- && 0 <= rlim.rlim_cur && rlim.rlim_cur <= INT_MAX
- && rlim.rlim_cur != RLIM_INFINITY
- && rlim.rlim_cur != RLIM_SAVED_MAX
- && rlim.rlim_cur != RLIM_SAVED_CUR)
- bad_fd = rlim.rlim_cur;
- #ifdef FD_CLOEXEC
- if (fcntl (1, F_SETFD, FD_CLOEXEC) == -1)
- result |= 1;
- #endif
- if (dup2 (1, 1) != 1)
- result |= 2;
- #ifdef FD_CLOEXEC
- if (fcntl (1, F_GETFD) != FD_CLOEXEC)
- result |= 4;
- #endif
- close (0);
- if (dup2 (0, 0) != -1)
- result |= 8;
- /* Many gnulib modules require POSIX conformance of EBADF. */
- if (dup2 (2, bad_fd) == -1 && errno != EBADF)
- result |= 16;
- /* Flush out some cygwin core dumps. */
- if (dup2 (2, -1) != -1 || errno != EBADF)
- result |= 32;
- dup2 (2, 255);
- dup2 (2, 256);
- /* On OS/2 kLIBC, dup2() does not work on a directory fd. */
- {
- int fd = open (".", O_RDONLY);
- if (fd == -1)
- result |= 64;
- else if (dup2 (fd, fd + 1) == -1)
- result |= 128;
-
- close (fd);
- }
- return result;]])
- ],
- [gl_cv_func_dup2_works=yes], [gl_cv_func_dup2_works=no],
- [case "$host_os" in
- mingw*) # on this platform, dup2 always returns 0 for success
- gl_cv_func_dup2_works="guessing no" ;;
- cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0
- gl_cv_func_dup2_works="guessing no" ;;
- aix* | freebsd*)
- # on AIX 7.1 and FreeBSD 6.1, dup2 (1,toobig) gives EMFILE,
- # not EBADF.
- gl_cv_func_dup2_works="guessing no" ;;
- haiku*) # on Haiku alpha 2, dup2(1, 1) resets FD_CLOEXEC.
- gl_cv_func_dup2_works="guessing no" ;;
- *-android*) # implemented using dup3(), which fails if oldfd == newfd
- gl_cv_func_dup2_works="guessing no" ;;
- os2*) # on OS/2 kLIBC, dup2() does not work on a directory fd.
- gl_cv_func_dup2_works="guessing no" ;;
- *) gl_cv_func_dup2_works="guessing yes" ;;
- esac])
- ])
- case "$gl_cv_func_dup2_works" in
- *yes) ;;
- *)
- REPLACE_DUP2=1
- AC_CHECK_FUNCS([setdtablesize])
- ;;
- esac
- fi
+ AC_CACHE_CHECK([whether dup2 works], [gl_cv_func_dup2_works],
+ [AC_RUN_IFELSE([
+ AC_LANG_PROGRAM(
+ [[#include <errno.h>
+ #include <fcntl.h>
+ #include <limits.h>
+ #include <sys/resource.h>
+ #include <unistd.h>
+ ]GL_MDA_DEFINES[
+ #ifndef RLIM_SAVED_CUR
+ # define RLIM_SAVED_CUR RLIM_INFINITY
+ #endif
+ #ifndef RLIM_SAVED_MAX
+ # define RLIM_SAVED_MAX RLIM_INFINITY
+ #endif
+ ]],
+ [[int result = 0;
+ int bad_fd = INT_MAX;
+ struct rlimit rlim;
+ if (getrlimit (RLIMIT_NOFILE, &rlim) == 0
+ && 0 <= rlim.rlim_cur && rlim.rlim_cur <= INT_MAX
+ && rlim.rlim_cur != RLIM_INFINITY
+ && rlim.rlim_cur != RLIM_SAVED_MAX
+ && rlim.rlim_cur != RLIM_SAVED_CUR)
+ bad_fd = rlim.rlim_cur;
+ #ifdef FD_CLOEXEC
+ if (fcntl (1, F_SETFD, FD_CLOEXEC) == -1)
+ result |= 1;
+ #endif
+ if (dup2 (1, 1) != 1)
+ result |= 2;
+ #ifdef FD_CLOEXEC
+ if (fcntl (1, F_GETFD) != FD_CLOEXEC)
+ result |= 4;
+ #endif
+ close (0);
+ if (dup2 (0, 0) != -1)
+ result |= 8;
+ /* Many gnulib modules require POSIX conformance of EBADF. */
+ if (dup2 (2, bad_fd) == -1 && errno != EBADF)
+ result |= 16;
+ /* Flush out some cygwin core dumps. */
+ if (dup2 (2, -1) != -1 || errno != EBADF)
+ result |= 32;
+ dup2 (2, 255);
+ dup2 (2, 256);
+ /* On OS/2 kLIBC, dup2() does not work on a directory fd. */
+ {
+ int fd = open (".", O_RDONLY);
+ if (fd == -1)
+ result |= 64;
+ else if (dup2 (fd, fd + 1) == -1)
+ result |= 128;
+ close (fd);
+ }
+ return result;]])
+ ],
+ [gl_cv_func_dup2_works=yes], [gl_cv_func_dup2_works=no],
+ [case "$host_os" in
+ mingw*) # on this platform, dup2 always returns 0 for success
+ gl_cv_func_dup2_works="guessing no" ;;
+ cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0
+ gl_cv_func_dup2_works="guessing no" ;;
+ aix* | freebsd*)
+ # on AIX 7.1 and FreeBSD 6.1, dup2 (1,toobig) gives EMFILE,
+ # not EBADF.
+ gl_cv_func_dup2_works="guessing no" ;;
+ haiku*) # on Haiku alpha 2, dup2(1, 1) resets FD_CLOEXEC.
+ gl_cv_func_dup2_works="guessing no" ;;
+ *-android*) # implemented using dup3(), which fails if oldfd == newfd
+ gl_cv_func_dup2_works="guessing no" ;;
+ os2*) # on OS/2 kLIBC, dup2() does not work on a directory fd.
+ gl_cv_func_dup2_works="guessing no" ;;
+ *) gl_cv_func_dup2_works="guessing yes" ;;
+ esac])
+ ])
+ case "$gl_cv_func_dup2_works" in
+ *yes) ;;
+ *)
+ REPLACE_DUP2=1
+ AC_CHECK_FUNCS([setdtablesize])
+ ;;
+ esac
dnl Replace dup2() for supporting the gnulib-defined fchdir() function,
dnl to keep fchdir's bookkeeping up-to-date.
m4_ifdef([gl_FUNC_FCHDIR], [
gl_TEST_FCHDIR
if test $HAVE_FCHDIR = 0; then
- if test $HAVE_DUP2 = 1; then
- REPLACE_DUP2=1
- fi
+ REPLACE_DUP2=1
fi
])
])
diff --git a/m4/explicit_bzero.m4 b/m4/explicit_bzero.m4
index 507816affdb..a415e7b4f5e 100644
--- a/m4/explicit_bzero.m4
+++ b/m4/explicit_bzero.m4
@@ -19,4 +19,5 @@ AC_DEFUN([gl_FUNC_EXPLICIT_BZERO],
AC_DEFUN([gl_PREREQ_EXPLICIT_BZERO],
[
AC_CHECK_FUNCS([explicit_memset])
+ AC_CHECK_FUNCS_ONCE([memset_s])
])
diff --git a/m4/fchmodat.m4 b/m4/fchmodat.m4
new file mode 100644
index 00000000000..cf5c87999c5
--- /dev/null
+++ b/m4/fchmodat.m4
@@ -0,0 +1,82 @@
+# fchmodat.m4 serial 5
+dnl Copyright (C) 2004-2020 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+# Written by Jim Meyering.
+
+AC_DEFUN([gl_FUNC_FCHMODAT],
+[
+ AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS])
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+ AC_CHECK_FUNCS_ONCE([fchmodat lchmod])
+ if test $ac_cv_func_fchmodat != yes; then
+ HAVE_FCHMODAT=0
+ else
+ AC_CACHE_CHECK(
+ [whether fchmodat+AT_SYMLINK_NOFOLLOW works on non-symlinks],
+ [gl_cv_func_fchmodat_works],
+ [dnl This test fails on GNU/Linux with glibc 2.31 (but not on
+ dnl GNU/kFreeBSD nor GNU/Hurd) and Cygwin 2.9.
+ AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM(
+ [
+ AC_INCLUDES_DEFAULT[
+ #include <fcntl.h>
+ #ifndef S_IRUSR
+ #define S_IRUSR 0400
+ #endif
+ #ifndef S_IWUSR
+ #define S_IWUSR 0200
+ #endif
+ #ifndef S_IRWXU
+ #define S_IRWXU 0700
+ #endif
+ #ifndef S_IRWXG
+ #define S_IRWXG 0070
+ #endif
+ #ifndef S_IRWXO
+ #define S_IRWXO 0007
+ #endif
+ ]GL_MDA_DEFINES],
+ [[
+ int permissive = S_IRWXU | S_IRWXG | S_IRWXO;
+ int desired = S_IRUSR | S_IWUSR;
+ static char const f[] = "conftest.fchmodat";
+ struct stat st;
+ if (creat (f, permissive) < 0)
+ return 1;
+ if (fchmodat (AT_FDCWD, f, desired, AT_SYMLINK_NOFOLLOW) != 0)
+ return 1;
+ if (stat (f, &st) != 0)
+ return 1;
+ return ! ((st.st_mode & permissive) == desired);
+ ]])],
+ [gl_cv_func_fchmodat_works=yes],
+ [gl_cv_func_fchmodat_works=no],
+ [case "$host_os" in
+ dnl Guess no on Linux with glibc and Cygwin, yes otherwise.
+ linux-gnu* | cygwin*) gl_cv_func_fchmodat_works="guessing no" ;;
+ *) gl_cv_func_fchmodat_works="$gl_cross_guess_normal" ;;
+ esac
+ ])
+ rm -f conftest.fchmodat])
+ case $gl_cv_func_fchmodat_works in
+ *yes) ;;
+ *)
+ AC_DEFINE([NEED_FCHMODAT_NONSYMLINK_FIX], [1],
+ [Define to 1 if fchmodat+AT_SYMLINK_NOFOLLOW does not work right on non-symlinks.])
+ REPLACE_FCHMODAT=1
+ ;;
+ esac
+ fi
+])
+
+# Prerequisites of lib/fchmodat.c.
+AC_DEFUN([gl_PREREQ_FCHMODAT],
+[
+ AC_CHECK_FUNCS_ONCE([lchmod])
+ :
+])
diff --git a/m4/fcntl.m4 b/m4/fcntl.m4
index 562ae2395df..ea24f3d64ef 100644
--- a/m4/fcntl.m4
+++ b/m4/fcntl.m4
@@ -1,4 +1,4 @@
-# fcntl.m4 serial 9
+# fcntl.m4 serial 10
dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -34,6 +34,7 @@ AC_DEFUN([gl_FUNC_FCNTL],
#include <limits.h>
#include <sys/resource.h>
#include <unistd.h>
+ ]GL_MDA_DEFINES[
#ifndef RLIM_SAVED_CUR
# define RLIM_SAVED_CUR RLIM_INFINITY
#endif
diff --git a/m4/fdopendir.m4 b/m4/fdopendir.m4
index d9cc1a00173..9937a74ea8d 100644
--- a/m4/fdopendir.m4
+++ b/m4/fdopendir.m4
@@ -1,4 +1,4 @@
-# serial 12
+# serial 14
# See if we need to provide fdopendir.
dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
@@ -25,10 +25,12 @@ AC_DEFUN([gl_FUNC_FDOPENDIR],
else
AC_CACHE_CHECK([whether fdopendir works],
[gl_cv_func_fdopendir_works],
- [AC_RUN_IFELSE([AC_LANG_PROGRAM([[
+ [AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM([[
#include <dirent.h>
#include <fcntl.h>
#include <unistd.h>
+]GL_MDA_DEFINES[
#if !HAVE_DECL_FDOPENDIR
extern
# ifdef __cplusplus
@@ -36,12 +38,14 @@ extern
# endif
DIR *fdopendir (int);
#endif
-]], [int result = 0;
- int fd = open ("conftest.c", O_RDONLY);
- if (fd < 0) result |= 1;
- if (fdopendir (fd)) result |= 2;
- if (close (fd)) result |= 4;
- return result;])],
+]],
+ [[int result = 0;
+ int fd = open ("conftest.c", O_RDONLY);
+ if (fd < 0) result |= 1;
+ if (fdopendir (fd)) result |= 2;
+ if (close (fd)) result |= 4;
+ return result;
+ ]])],
[gl_cv_func_fdopendir_works=yes],
[gl_cv_func_fdopendir_works=no],
[case "$host_os" in
diff --git a/m4/filemode.m4 b/m4/filemode.m4
index a1b7e105b59..5aaaa1a167d 100644
--- a/m4/filemode.m4
+++ b/m4/filemode.m4
@@ -1,6 +1,5 @@
# filemode.m4 serial 8
-dnl Copyright (C) 2002, 2005-2006, 2009-2020 Free Software Foundation,
-dnl Inc.
+dnl Copyright (C) 2002, 2005-2006, 2009-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/fpending.m4 b/m4/fpending.m4
index ea9725e4890..edabcec5f0b 100644
--- a/m4/fpending.m4
+++ b/m4/fpending.m4
@@ -1,4 +1,4 @@
-# serial 22
+# serial 23
# Copyright (C) 2000-2001, 2004-2020 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
@@ -25,7 +25,7 @@ AC_DEFUN([gl_FUNC_FPENDING],
AC_CACHE_CHECK([for __fpending], [gl_cv_func___fpending],
[
AC_LINK_IFELSE(
- [AC_LANG_PROGRAM([$fp_headers],
+ [AC_LANG_PROGRAM([[$fp_headers]],
[[return ! __fpending (stdin);]])],
[gl_cv_func___fpending=yes],
[gl_cv_func___fpending=no])
diff --git a/m4/fsusage.m4 b/m4/fsusage.m4
index 64fcf5d290d..0bc62066aab 100644
--- a/m4/fsusage.m4
+++ b/m4/fsusage.m4
@@ -1,8 +1,7 @@
# serial 34
# Obtaining file system usage information.
-# Copyright (C) 1997-1998, 2000-2001, 2003-2020 Free Software
-# Foundation, Inc.
+# Copyright (C) 1997-1998, 2000-2001, 2003-2020 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/futimens.m4 b/m4/futimens.m4
new file mode 100644
index 00000000000..145b8ff0d51
--- /dev/null
+++ b/m4/futimens.m4
@@ -0,0 +1,66 @@
+# serial 9
+# See if we need to provide futimens replacement.
+
+dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+# Written by Eric Blake.
+
+AC_DEFUN([gl_FUNC_FUTIMENS],
+[
+ AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+ AC_CHECK_FUNCS_ONCE([futimens])
+ if test $ac_cv_func_futimens = no; then
+ HAVE_FUTIMENS=0
+ else
+ AC_CACHE_CHECK([whether futimens works],
+ [gl_cv_func_futimens_works],
+ [AC_RUN_IFELSE([AC_LANG_PROGRAM([[
+#include <fcntl.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include <errno.h>
+]GL_MDA_DEFINES],
+ [[struct timespec ts[2];
+ int fd = creat ("conftest.file", 0600);
+ struct stat st;
+ if (fd < 0) return 1;
+ ts[0].tv_sec = 1;
+ ts[0].tv_nsec = UTIME_OMIT;
+ ts[1].tv_sec = 1;
+ ts[1].tv_nsec = UTIME_NOW;
+ errno = 0;
+ if (futimens (AT_FDCWD, NULL) == 0) return 2;
+ if (errno != EBADF) return 3;
+ if (futimens (fd, ts)) return 4;
+ sleep (1);
+ ts[0].tv_nsec = UTIME_NOW;
+ ts[1].tv_nsec = UTIME_OMIT;
+ if (futimens (fd, ts)) return 5;
+ if (fstat (fd, &st)) return 6;
+ if (st.st_ctime < st.st_atime) return 7;
+ ]])],
+ [gl_cv_func_futimens_works=yes],
+ [gl_cv_func_futimens_works=no],
+ [case "$host_os" in
+ # Guess no on glibc systems.
+ *-gnu* | gnu*) gl_cv_func_futimens_works="guessing no" ;;
+ # Guess no on musl systems.
+ *-musl*) gl_cv_func_futimens_works="guessing no" ;;
+ # Guess yes otherwise.
+ *) gl_cv_func_futimens_works="guessing yes" ;;
+ esac
+ ])
+ rm -f conftest.file])
+ case "$gl_cv_func_futimens_works" in
+ *yes) ;;
+ *)
+ REPLACE_FUTIMENS=1
+ ;;
+ esac
+ fi
+])
diff --git a/m4/getdtablesize.m4 b/m4/getdtablesize.m4
index ab2e3feb37b..af328644adb 100644
--- a/m4/getdtablesize.m4
+++ b/m4/getdtablesize.m4
@@ -1,4 +1,4 @@
-# getdtablesize.m4 serial 7
+# getdtablesize.m4 serial 8
dnl Copyright (C) 2008-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -29,13 +29,16 @@ AC_DEFUN([gl_FUNC_GETDTABLESIZE],
dnl correctly require setrlimit before getdtablesize() can report
dnl a larger value.
AC_RUN_IFELSE([
- AC_LANG_PROGRAM([[#include <unistd.h>]],
- [int size = getdtablesize();
- if (dup2 (0, getdtablesize()) != -1)
- return 1;
- if (size != getdtablesize())
- return 2;
- ])],
+ AC_LANG_PROGRAM(
+ [[#include <unistd.h>]
+ GL_MDA_DEFINES
+ ],
+ [[int size = getdtablesize();
+ if (dup2 (0, getdtablesize()) != -1)
+ return 1;
+ if (size != getdtablesize())
+ return 2;
+ ]])],
[gl_cv_func_getdtablesize_works=yes],
[gl_cv_func_getdtablesize_works=no],
[case "$host_os" in
diff --git a/m4/getgroups.m4 b/m4/getgroups.m4
index 79436460f30..e3441621b25 100644
--- a/m4/getgroups.m4
+++ b/m4/getgroups.m4
@@ -1,10 +1,9 @@
-# serial 23
+# serial 24
dnl From Jim Meyering.
dnl A wrapper around AC_FUNC_GETGROUPS.
-# Copyright (C) 1996-1997, 1999-2004, 2008-2020 Free Software
-# Foundation, Inc.
+# Copyright (C) 1996-1997, 1999-2004, 2008-2020 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -80,7 +79,8 @@ AC_DEFUN([gl_FUNC_GETGROUPS],
AC_DEFINE([GETGROUPS_ZERO_BUG], [1], [Define this to 1 if
getgroups(0,NULL) does not return the number of groups.])
else
- dnl Detect FreeBSD bug; POSIX requires getgroups(-1,ptr) to fail.
+ dnl Detect Mac OS X and FreeBSD bug; POSIX requires getgroups(-1,ptr)
+ dnl to fail.
AC_CACHE_CHECK([whether getgroups handles negative values],
[gl_cv_func_getgroups_works],
[AC_RUN_IFELSE([AC_LANG_PROGRAM([AC_INCLUDES_DEFAULT],
diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4
index 74a116fd10d..9fe328efc02 100644
--- a/m4/getloadavg.m4
+++ b/m4/getloadavg.m4
@@ -1,13 +1,13 @@
# Check for getloadavg.
-# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2020 Free
-# Software Foundation, Inc.
+# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2020 Free Software
+# Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
-#serial 8
+#serial 10
# Autoconf defines AC_FUNC_GETLOADAVG, but that is obsolescent.
# New applications should use gl_GETLOADAVG instead.
@@ -45,7 +45,9 @@ AC_CHECK_FUNC([getloadavg], [],
# There is a commonly available library for RS/6000 AIX.
# Since it is not a standard part of AIX, it might be installed locally.
gl_getloadavg_LIBS=$LIBS
- LIBS="-L/usr/local/lib $LIBS"
+ if test $cross_compiling != yes; then
+ LIBS="-L/usr/local/lib $LIBS"
+ fi
AC_CHECK_LIB([getloadavg], [getloadavg],
[LIBS="-lgetloadavg $LIBS" gl_func_getloadavg_done=yes],
[LIBS=$gl_getloadavg_LIBS])
@@ -145,7 +147,7 @@ fi
AC_CHECK_HEADERS([nlist.h],
[AC_CHECK_MEMBERS([struct nlist.n_un.n_name],
[], [],
- [@%:@include <nlist.h>])
+ [#include <nlist.h>])
AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <nlist.h>]],
[[struct nlist x;
#ifdef HAVE_STRUCT_NLIST_N_UN_N_NAME
diff --git a/m4/getrandom.m4 b/m4/getrandom.m4
new file mode 100644
index 00000000000..d6da71a2c83
--- /dev/null
+++ b/m4/getrandom.m4
@@ -0,0 +1,68 @@
+# getrandom.m4 serial 8
+dnl Copyright 2020 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl Written by Paul Eggert.
+
+AC_DEFUN([gl_FUNC_GETRANDOM],
+[
+ AC_REQUIRE([gl_SYS_RANDOM_H_DEFAULTS])
+ AC_CHECK_FUNCS_ONCE([getrandom])
+ if test "$ac_cv_func_getrandom" != yes; then
+ HAVE_GETRANDOM=0
+ else
+ dnl On Solaris 11.4 the return type is 'int', not 'ssize_t'.
+ AC_CACHE_CHECK([whether getrandom is compatible with its GNU+BSD signature],
+ [gl_cv_func_getrandom_ok],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[/* Additional includes are needed before <sys/random.h> on uClibc
+ and Mac OS X. */
+ #include <sys/types.h>
+ #include <stdlib.h>
+ #include <sys/random.h>
+ ssize_t getrandom (void *, size_t, unsigned int);
+ ]],
+ [[]])
+ ],
+ [gl_cv_func_getrandom_ok=yes],
+ [gl_cv_func_getrandom_ok=no])
+ ])
+ if test $gl_cv_func_getrandom_ok = no; then
+ REPLACE_GETRANDOM=1
+ fi
+ fi
+
+ case "$host_os" in
+ mingw*)
+ AC_CHECK_HEADERS([bcrypt.h], [], [],
+ [[#include <windows.h>
+ ]])
+ AC_CACHE_CHECK([whether the bcrypt library is guaranteed to be present],
+ [gl_cv_lib_assume_bcrypt],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <windows.h>]],
+ [[#if !(_WIN32_WINNT >= _WIN32_WINNT_WIN7)
+ cannot assume it
+ #endif
+ ]])
+ ],
+ [gl_cv_lib_assume_bcrypt=yes],
+ [gl_cv_lib_assume_bcrypt=no])
+ ])
+ if test $gl_cv_lib_assume_bcrypt = yes; then
+ AC_DEFINE([HAVE_LIB_BCRYPT], [1],
+ [Define to 1 if the bcrypt library is guaranteed to be present.])
+ LIB_GETRANDOM='-lbcrypt'
+ else
+ LIB_GETRANDOM='-ladvapi32'
+ fi
+ ;;
+ *)
+ LIB_GETRANDOM= ;;
+ esac
+ AC_SUBST([LIB_GETRANDOM])
+])
diff --git a/m4/gettime.m4 b/m4/gettime.m4
index 6a1f9a4157d..e65455a2ff9 100644
--- a/m4/gettime.m4
+++ b/m4/gettime.m4
@@ -1,6 +1,5 @@
# gettime.m4 serial 9
-dnl Copyright (C) 2002, 2004-2006, 2009-2020 Free Software Foundation,
-dnl Inc.
+dnl Copyright (C) 2002, 2004-2006, 2009-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/gettimeofday.m4 b/m4/gettimeofday.m4
index 443c6f9309a..578ed49b077 100644
--- a/m4/gettimeofday.m4
+++ b/m4/gettimeofday.m4
@@ -1,7 +1,6 @@
-# serial 27
+# serial 28
-# Copyright (C) 2001-2003, 2005, 2007, 2009-2020 Free Software
-# Foundation, Inc.
+# Copyright (C) 2001-2003, 2005, 2007, 2009-2020 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
@@ -20,7 +19,6 @@ AC_DEFUN([gl_FUNC_GETTIMEOFDAY],
if test $ac_cv_func_gettimeofday != yes; then
HAVE_GETTIMEOFDAY=0
else
- gl_FUNC_GETTIMEOFDAY_CLOBBER
AC_CACHE_CHECK([for gettimeofday with POSIX signature],
[gl_cv_func_gettimeofday_posix_signature],
[AC_COMPILE_IFELSE(
@@ -67,63 +65,5 @@ int gettimeofday (struct timeval *restrict, struct timezone *restrict);
declaration of the second argument to gettimeofday.])
])
-
-dnl See if gettimeofday clobbers the static buffer that localtime uses
-dnl for its return value. The gettimeofday function from Mac OS X 10.0.4
-dnl (i.e., Darwin 1.3.7) has this problem.
-dnl
-dnl If it does, then arrange to use gettimeofday and localtime only via
-dnl the wrapper functions that work around the problem.
-
-AC_DEFUN([gl_FUNC_GETTIMEOFDAY_CLOBBER],
-[
- AC_REQUIRE([gl_HEADER_SYS_TIME_H])
- AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
- AC_REQUIRE([gl_LOCALTIME_BUFFER_DEFAULTS])
-
- AC_CACHE_CHECK([whether gettimeofday clobbers localtime buffer],
- [gl_cv_func_gettimeofday_clobber],
- [AC_RUN_IFELSE(
- [AC_LANG_PROGRAM(
- [[#include <string.h>
- #include <sys/time.h>
- #include <time.h>
- #include <stdlib.h>
- ]],
- [[
- time_t t = 0;
- struct tm *lt;
- struct tm saved_lt;
- struct timeval tv;
- lt = localtime (&t);
- saved_lt = *lt;
- gettimeofday (&tv, NULL);
- return memcmp (lt, &saved_lt, sizeof (struct tm)) != 0;
- ]])],
- [gl_cv_func_gettimeofday_clobber=no],
- [gl_cv_func_gettimeofday_clobber=yes],
- [# When cross-compiling:
- case "$host_os" in
- # Guess all is fine on glibc systems.
- *-gnu* | gnu*) gl_cv_func_gettimeofday_clobber="guessing no" ;;
- # Guess all is fine on musl systems.
- *-musl*) gl_cv_func_gettimeofday_clobber="guessing no" ;;
- # Guess no on native Windows.
- mingw*) gl_cv_func_gettimeofday_clobber="guessing no" ;;
- # If we don't know, obey --enable-cross-guesses.
- *) gl_cv_func_gettimeofday_clobber="$gl_cross_guess_inverted" ;;
- esac
- ])])
-
- case "$gl_cv_func_gettimeofday_clobber" in
- *yes)
- REPLACE_GETTIMEOFDAY=1
- AC_DEFINE([GETTIMEOFDAY_CLOBBERS_LOCALTIME], [1],
- [Define if gettimeofday clobbers the localtime buffer.])
- gl_LOCALTIME_BUFFER_NEEDED
- ;;
- esac
-])
-
# Prerequisites of lib/gettimeofday.c.
AC_DEFUN([gl_PREREQ_GETTIMEOFDAY], [:])
diff --git a/m4/glibc21.m4 b/m4/glibc21.m4
index 9197d3bf45f..ece484b5ae9 100644
--- a/m4/glibc21.m4
+++ b/m4/glibc21.m4
@@ -1,6 +1,6 @@
# glibc21.m4 serial 5
-dnl Copyright (C) 2000-2002, 2004, 2008, 2010-2020 Free Software
-dnl Foundation, Inc.
+dnl Copyright (C) 2000-2002, 2004, 2008, 2010-2020 Free Software Foundation,
+dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index b617eacff01..33e56faa98e 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,4 +1,4 @@
-# gnulib-common.m4 serial 46
+# gnulib-common.m4 serial 57
dnl Copyright (C) 2007-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -12,8 +12,18 @@ AC_DEFUN([gl_COMMON], [
dnl Use AC_REQUIRE here, so that the code is expanded once only.
AC_REQUIRE([gl_00GNULIB])
AC_REQUIRE([gl_COMMON_BODY])
+ AC_REQUIRE([gl_ZZGNULIB])
])
AC_DEFUN([gl_COMMON_BODY], [
+ AH_VERBATIM([_GL_GNUC_PREREQ],
+[/* True if the compiler says it groks GNU C version MAJOR.MINOR. */
+#if defined __GNUC__ && defined __GNUC_MINOR__
+# define _GL_GNUC_PREREQ(major, minor) \
+ ((major) < __GNUC__ + ((minor) <= __GNUC_MINOR__))
+#else
+# define _GL_GNUC_PREREQ(major, minor) 0
+#endif
+])
AH_VERBATIM([_Noreturn],
[/* The _Noreturn keyword of C11. */
#ifndef _Noreturn
@@ -30,9 +40,12 @@ AC_DEFUN([gl_COMMON_BODY], [
# define _Noreturn [[noreturn]]
# elif ((!defined __cplusplus || defined __clang__) \
&& (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
- || 4 < __GNUC__ + (7 <= __GNUC_MINOR__)))
+ || _GL_GNUC_PREREQ (4, 7) \
+ || (defined __apple_build_version__ \
+ ? 6000000 <= __apple_build_version__ \
+ : 3 < __clang_major__ + (5 <= __clang_minor__))))
/* _Noreturn works as-is. */
-# elif 2 < __GNUC__ + (8 <= __GNUC_MINOR__) || 0x5110 <= __SUNPRO_C
+# elif _GL_GNUC_PREREQ (2, 8) || defined __clang__ || 0x5110 <= __SUNPRO_C
# define _Noreturn __attribute__ ((__noreturn__))
# elif 1200 <= (defined _MSC_VER ? _MSC_VER : 0)
# define _Noreturn __declspec (noreturn)
@@ -51,48 +64,216 @@ AC_DEFUN([gl_COMMON_BODY], [
#if defined __APPLE__ && defined __MACH__ && __APPLE_CC__ >= 5465 && !defined __cplusplus && __STDC_VERSION__ >= 199901L && !defined __GNUC_STDC_INLINE__
# define __GNUC_STDC_INLINE__ 1
#endif])
- AH_VERBATIM([unused_parameter],
-[/* Define as a marker that can be attached to declarations that might not
- be used. This helps to reduce warnings, such as from
- GCC -Wunused-parameter. */
-#if __GNUC__ >= 3 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
-# define _GL_UNUSED __attribute__ ((__unused__))
+ AH_VERBATIM([attribute],
+[/* Attributes. */
+#ifdef __has_attribute
+# define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__)
#else
-# define _GL_UNUSED
+# define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr
+# define _GL_ATTR_alloc_size _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_always_inline _GL_GNUC_PREREQ (3, 2)
+# define _GL_ATTR_artificial _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_cold _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_const _GL_GNUC_PREREQ (2, 95)
+# define _GL_ATTR_deprecated _GL_GNUC_PREREQ (3, 1)
+# define _GL_ATTR_diagnose_if 0
+# define _GL_ATTR_error _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_externally_visible _GL_GNUC_PREREQ (4, 1)
+# define _GL_ATTR_fallthrough _GL_GNUC_PREREQ (7, 0)
+# define _GL_ATTR_format _GL_GNUC_PREREQ (2, 7)
+# define _GL_ATTR_leaf _GL_GNUC_PREREQ (4, 6)
+# ifdef _ICC
+# define _GL_ATTR_may_alias 0
+# else
+# define _GL_ATTR_may_alias _GL_GNUC_PREREQ (3, 3)
+# endif
+# define _GL_ATTR_malloc _GL_GNUC_PREREQ (3, 0)
+# define _GL_ATTR_noinline _GL_GNUC_PREREQ (3, 1)
+# define _GL_ATTR_nonnull _GL_GNUC_PREREQ (3, 3)
+# define _GL_ATTR_nonstring _GL_GNUC_PREREQ (8, 0)
+# define _GL_ATTR_nothrow _GL_GNUC_PREREQ (3, 3)
+# define _GL_ATTR_packed _GL_GNUC_PREREQ (2, 7)
+# define _GL_ATTR_pure _GL_GNUC_PREREQ (2, 96)
+# define _GL_ATTR_returns_nonnull _GL_GNUC_PREREQ (4, 9)
+# define _GL_ATTR_sentinel _GL_GNUC_PREREQ (4, 0)
+# define _GL_ATTR_unused _GL_GNUC_PREREQ (2, 7)
+# define _GL_ATTR_warn_unused_result _GL_GNUC_PREREQ (3, 4)
#endif
-/* The name _UNUSED_PARAMETER_ is an earlier spelling, although the name
- is a misnomer outside of parameter lists. */
-#define _UNUSED_PARAMETER_ _GL_UNUSED
-
-/* gcc supports the "unused" attribute on possibly unused labels, and
- g++ has since version 4.5. Note to support C++ as well as C,
- _GL_UNUSED_LABEL should be used with a trailing ; */
-#if !defined __cplusplus || __GNUC__ > 4 \
- || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5)
-# define _GL_UNUSED_LABEL _GL_UNUSED
+
+]dnl There is no _GL_ATTRIBUTE_ALIGNED; use stdalign's _Alignas instead.
+[
+#if _GL_HAS_ATTRIBUTE (alloc_size)
+# define _GL_ATTRIBUTE_ALLOC_SIZE(args) __attribute__ ((__alloc_size__ args))
#else
-# define _GL_UNUSED_LABEL
+# define _GL_ATTRIBUTE_ALLOC_SIZE(args)
#endif
-/* The __pure__ attribute was added in gcc 2.96. */
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
-# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
+#if _GL_HAS_ATTRIBUTE (always_inline)
+# define _GL_ATTRIBUTE_ALWAYS_INLINE __attribute__ ((__always_inline__))
#else
-# define _GL_ATTRIBUTE_PURE /* empty */
+# define _GL_ATTRIBUTE_ALWAYS_INLINE
#endif
-/* The __const__ attribute was added in gcc 2.95. */
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 95)
+#if _GL_HAS_ATTRIBUTE (artificial)
+# define _GL_ATTRIBUTE_ARTIFICIAL __attribute__ ((__artificial__))
+#else
+# define _GL_ATTRIBUTE_ARTIFICIAL
+#endif
+
+/* Avoid __attribute__ ((cold)) on MinGW; see thread starting at
+ <https://lists.gnu.org/r/emacs-devel/2019-04/msg01152.html>.
+ Also, Oracle Studio 12.6 requires 'cold' not '__cold__'. */
+#if _GL_HAS_ATTRIBUTE (cold) && !defined __MINGW32__
+# ifndef __SUNPRO_C
+# define _GL_ATTRIBUTE_COLD __attribute__ ((__cold__))
+# else
+# define _GL_ATTRIBUTE_COLD __attribute__ ((cold))
+# endif
+#else
+# define _GL_ATTRIBUTE_COLD
+#endif
+
+#if _GL_HAS_ATTRIBUTE (const)
# define _GL_ATTRIBUTE_CONST __attribute__ ((__const__))
#else
-# define _GL_ATTRIBUTE_CONST /* empty */
+# define _GL_ATTRIBUTE_CONST
+#endif
+
+#if 201710L < __STDC_VERSION__
+# define _GL_ATTRIBUTE_DEPRECATED [[__deprecated__]]
+#elif _GL_HAS_ATTRIBUTE (deprecated)
+# define _GL_ATTRIBUTE_DEPRECATED __attribute__ ((__deprecated__))
+#else
+# define _GL_ATTRIBUTE_DEPRECATED
+#endif
+
+#if _GL_HAS_ATTRIBUTE (error)
+# define _GL_ATTRIBUTE_ERROR(msg) __attribute__ ((__error__ (msg)))
+# define _GL_ATTRIBUTE_WARNING(msg) __attribute__ ((__warning__ (msg)))
+#elif _GL_HAS_ATTRIBUTE (diagnose_if)
+# define _GL_ATTRIBUTE_ERROR(msg) __attribute__ ((__diagnose_if__ (1, msg, "error")))
+# define _GL_ATTRIBUTE_WARNING(msg) __attribute__ ((__diagnose_if__ (1, msg, "warning")))
+#else
+# define _GL_ATTRIBUTE_ERROR(msg)
+# define _GL_ATTRIBUTE_WARNING(msg)
+#endif
+
+#if _GL_HAS_ATTRIBUTE (externally_visible)
+# define _GL_ATTRIBUTE_EXTERNALLY_VISIBLE __attribute__ ((externally_visible))
+#else
+# define _GL_ATTRIBUTE_EXTERNALLY_VISIBLE
+#endif
+
+/* FALLTHROUGH is special, because it always expands to something. */
+#if 201710L < __STDC_VERSION__
+# define _GL_ATTRIBUTE_FALLTHROUGH [[__fallthrough__]]
+#elif _GL_HAS_ATTRIBUTE (fallthrough)
+# define _GL_ATTRIBUTE_FALLTHROUGH __attribute__ ((__fallthrough__))
+#else
+# define _GL_ATTRIBUTE_FALLTHROUGH ((void) 0)
+#endif
+
+#if _GL_HAS_ATTRIBUTE (format)
+# define _GL_ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
+#else
+# define _GL_ATTRIBUTE_FORMAT(spec)
#endif
-/* The __malloc__ attribute was added in gcc 3. */
-#if 3 <= __GNUC__
+#if _GL_HAS_ATTRIBUTE (leaf)
+# define _GL_ATTRIBUTE_LEAF __attribute__ ((__leaf__))
+#else
+# define _GL_ATTRIBUTE_LEAF
+#endif
+
+/* Oracle Studio 12.6 mishandles may_alias despite __has_attribute OK. */
+#if _GL_HAS_ATTRIBUTE (may_alias) && !defined __SUNPRO_C
+# define _GL_ATTRIBUTE_MAY_ALIAS __attribute__ ((__may_alias__))
+#else
+# define _GL_ATTRIBUTE_MAY_ALIAS
+#endif
+
+#if 201710L < __STDC_VERSION__
+# define _GL_ATTRIBUTE_MAYBE_UNUSED [[__maybe_unused__]]
+#elif _GL_HAS_ATTRIBUTE (unused)
+# define _GL_ATTRIBUTE_MAYBE_UNUSED __attribute__ ((__unused__))
+#else
+# define _GL_ATTRIBUTE_MAYBE_UNUSED
+#endif
+/* Earlier spellings of this macro. */
+#define _GL_UNUSED _GL_ATTRIBUTE_MAYBE_UNUSED
+#define _UNUSED_PARAMETER_ _GL_ATTRIBUTE_MAYBE_UNUSED
+
+#if _GL_HAS_ATTRIBUTE (malloc)
# define _GL_ATTRIBUTE_MALLOC __attribute__ ((__malloc__))
#else
-# define _GL_ATTRIBUTE_MALLOC /* empty */
+# define _GL_ATTRIBUTE_MALLOC
+#endif
+
+#if 201710L < __STDC_VERSION__
+# define _GL_ATTRIBUTE_NODISCARD [[__nodiscard__]]
+#elif _GL_HAS_ATTRIBUTE (warn_unused_result)
+# define _GL_ATTRIBUTE_NODISCARD __attribute__ ((__warn_unused_result__))
+#else
+# define _GL_ATTRIBUTE_NODISCARD
+#endif
+
+#if _GL_HAS_ATTRIBUTE (noinline)
+# define _GL_ATTRIBUTE_NOINLINE __attribute__ ((__noinline__))
+#else
+# define _GL_ATTRIBUTE_NOINLINE
+#endif
+
+#if _GL_HAS_ATTRIBUTE (nonnull)
+# define _GL_ATTRIBUTE_NONNULL(args) __attribute__ ((__nonnull__ args))
+#else
+# define _GL_ATTRIBUTE_NONNULL(args)
+#endif
+
+#if _GL_HAS_ATTRIBUTE (nonstring)
+# define _GL_ATTRIBUTE_NONSTRING __attribute__ ((__nonstring__))
+#else
+# define _GL_ATTRIBUTE_NONSTRING
+#endif
+
+/* There is no _GL_ATTRIBUTE_NORETURN; use _Noreturn instead. */
+
+#if _GL_HAS_ATTRIBUTE (nothrow) && !defined __cplusplus
+# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__))
+#else
+# define _GL_ATTRIBUTE_NOTHROW
+#endif
+
+#if _GL_HAS_ATTRIBUTE (packed)
+# define _GL_ATTRIBUTE_PACKED __attribute__ ((__packed__))
+#else
+# define _GL_ATTRIBUTE_PACKED
+#endif
+
+#if _GL_HAS_ATTRIBUTE (pure)
+# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
+#else
+# define _GL_ATTRIBUTE_PURE
+#endif
+
+#if _GL_HAS_ATTRIBUTE (returns_nonnull)
+# define _GL_ATTRIBUTE_RETURNS_NONNULL __attribute__ ((__returns_nonnull__))
+#else
+# define _GL_ATTRIBUTE_RETURNS_NONNULL
+#endif
+
+#if _GL_HAS_ATTRIBUTE (sentinel)
+# define _GL_ATTRIBUTE_SENTINEL(pos) __attribute__ ((__sentinel__ pos))
+#else
+# define _GL_ATTRIBUTE_SENTINEL(pos)
+#endif
+
+]dnl There is no _GL_ATTRIBUTE_VISIBILITY; see m4/visibility.m4 instead.
+[
+/* To support C++ as well as C, use _GL_UNUSED_LABEL with trailing ';'. */
+#if !defined __cplusplus || _GL_GNUC_PREREQ (4, 5)
+# define _GL_UNUSED_LABEL _GL_ATTRIBUTE_MAYBE_UNUSED
+#else
+# define _GL_UNUSED_LABEL
#endif
])
AH_VERBATIM([async_safe],
@@ -122,6 +303,22 @@ AC_DEFUN([gl_COMMON_BODY], [
errno. */
#define _GL_ASYNC_SAFE
])
+ AH_VERBATIM([micro_optimizations],
+[/* _GL_CMP (n1, n2) performs a three-valued comparison on n1 vs. n2, where
+ n1 and n2 are expressions without side effects, that evaluate to real
+ numbers (excluding NaN).
+ It returns
+ 1 if n1 > n2
+ 0 if n1 == n2
+ -1 if n1 < n2
+ The naïve code (n1 > n2 ? 1 : n1 < n2 ? -1 : 0) produces a conditional
+ jump with nearly all GCC versions up to GCC 10.
+ This variant (n1 < n2 ? -1 : n1 > n2) produces a conditional with many
+ GCC versions up to GCC 9.
+ The better code (n1 > n2) - (n1 < n2) from Hacker's Delight § 2-9
+ avoids conditional jumps in all GCC versions >= 3.4. */
+#define _GL_CMP(n1, n2) (((n1) > (n2)) - ((n1) < (n2)))
+])
dnl Hint which direction to take regarding cross-compilation guesses:
dnl When a user installs a program on a platform they are not intimately
dnl familiar with, --enable-cross-guesses=conservative is the appropriate
@@ -283,14 +480,6 @@ AC_DEFUN([gl_FEATURES_H],
AC_SUBST([HAVE_FEATURES_H])
])
-# AS_VAR_IF(VAR, VALUE, [IF-MATCH], [IF-NOT-MATCH])
-# ----------------------------------------------------
-# Backport of autoconf-2.63b's macro.
-# Remove this macro when we can assume autoconf >= 2.64.
-m4_ifndef([AS_VAR_IF],
-[m4_define([AS_VAR_IF],
-[AS_IF([test x"AS_VAR_GET([$1])" = x""$2], [$3], [$4])])])
-
# gl_PROG_CC_C99
# Modifies the value of the shell variable CC in an attempt to make $CC
# understand ISO C99 source code.
@@ -415,12 +604,13 @@ AC_DEFUN([AC_C_RESTRICT],
nothing if this is not supported. Do not define if restrict is
supported directly. */
#undef restrict
-/* Work around a bug in Sun C++: it does not support _Restrict or
- __restrict__, even though the corresponding Sun C compiler ends up with
- "#define restrict _Restrict" or "#define restrict __restrict__" in the
- previous line. Perhaps some future version of Sun C++ will work with
- restrict; if so, hopefully it defines __RESTRICT like Sun C does. */
-#if defined __SUNPRO_CC && !defined __RESTRICT
+/* Work around a bug in older versions of Sun C++, which did not
+ #define __restrict__ or support _Restrict or __restrict__
+ even though the corresponding Sun C compiler ended up with
+ "#define restrict _Restrict" or "#define restrict __restrict__"
+ in the previous line. This workaround can be removed once
+ we assume Oracle Developer Studio 12.5 (2016) or later. */
+#if defined __SUNPRO_CC && !defined __RESTRICT && !defined __restrict__
# define _Restrict
# define __restrict__
#endif])
@@ -440,6 +630,15 @@ AC_DEFUN([gl_BIGENDIAN],
AC_C_BIGENDIAN
])
+# gl_SILENT(command)
+# executes command, but without the normal configure output.
+AC_DEFUN([gl_SILENT],
+[
+ {
+ $1
+ } AS_MESSAGE_FD>/dev/null
+])
+
# gl_CACHE_VAL_SILENT(cache-id, command-to-set-it)
# is like AC_CACHE_VAL(cache-id, command-to-set-it), except that it does not
# output a spurious "(cached)" mark in the midst of other configure output.
@@ -453,6 +652,72 @@ AC_DEFUN([gl_CACHE_VAL_SILENT],
as_echo_n="$saved_as_echo_n"
])
-# AS_VAR_COPY was added in autoconf 2.63b
-m4_define_default([AS_VAR_COPY],
-[AS_LITERAL_IF([$1[]$2], [$1=$$2], [eval $1=\$$2])])
+dnl Expands to some code for use in .c programs that, on native Windows, defines
+dnl the Microsoft deprecated alias function names to the underscore-prefixed
+dnl actual function names. With this macro, these function names are available
+dnl without linking with '-loldnames' and without generating warnings.
+dnl Usage: Use it after all system header files are included.
+dnl #include <...>
+dnl #include <...>
+dnl ]GL_MDA_DEFINES[
+dnl ...
+AC_DEFUN([GL_MDA_DEFINES],[
+AC_REQUIRE([_GL_MDA_DEFINES])
+[$gl_mda_defines]
+])
+AC_DEFUN([_GL_MDA_DEFINES],
+[gl_mda_defines='
+#if defined _WIN32 && !defined __CYGWIN__
+#define access _access
+#define chdir _chdir
+#define chmod _chmod
+#define close _close
+#define creat _creat
+#define dup _dup
+#define dup2 _dup2
+#define ecvt _ecvt
+#define execl _execl
+#define execle _execle
+#define execlp _execlp
+#define execv _execv
+#define execve _execve
+#define execvp _execvp
+#define execvpe _execvpe
+#define fcloseall _fcloseall
+#define fcvt _fcvt
+#define fdopen _fdopen
+#define fileno _fileno
+#define gcvt _gcvt
+#define getcwd _getcwd
+#define getpid _getpid
+#define getw _getw
+#define isatty _isatty
+#define j0 _j0
+#define j1 _j1
+#define jn _jn
+#define lfind _lfind
+#define lsearch _lsearch
+#define lseek _lseek
+#define memccpy _memccpy
+#define mkdir _mkdir
+#define mktemp _mktemp
+#define open _open
+#define putenv _putenv
+#define putw _putw
+#define read _read
+#define rmdir _rmdir
+#define strdup _strdup
+#define swab _swab
+#define tempnam _tempnam
+#define tzset _tzset
+#define umask _umask
+#define unlink _unlink
+#define utime _utime
+#define wcsdup _wcsdup
+#define write _write
+#define y0 _y0
+#define y1 _y1
+#define yn _yn
+#endif
+'
+])
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index c952c9c956c..d2fdbd82e73 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -47,11 +47,13 @@ AC_DEFUN([gl_EARLY],
# Code from module alloca-opt:
# Code from module allocator:
# Code from module at-internal:
+ # Code from module attribute:
# Code from module binary-io:
# Code from module builtin-expect:
# Code from module byteswap:
# Code from module c-ctype:
# Code from module c-strcase:
+ # Code from module c99:
# Code from module canonicalize-lgpl:
# Code from module careadlinkat:
# Code from module clock-time:
@@ -69,7 +71,6 @@ AC_DEFUN([gl_EARLY],
# Code from module diffseq:
# Code from module dirent:
# Code from module dirfd:
- # Code from module dosname:
# Code from module double-slash-root:
# Code from module dtoastr:
# Code from module dtotimespec:
@@ -82,10 +83,12 @@ AC_DEFUN([gl_EARLY],
# Code from module extensions:
# Code from module extern-inline:
# Code from module faccessat:
+ # Code from module fchmodat:
# Code from module fcntl:
# Code from module fcntl-h:
# Code from module fdopendir:
# Code from module filemode:
+ # Code from module filename:
# Code from module filevercmp:
# Code from module flexmember:
# Code from module fpending:
@@ -94,11 +97,13 @@ AC_DEFUN([gl_EARLY],
# Code from module fstatat:
# Code from module fsusage:
# Code from module fsync:
+ # Code from module futimens:
# Code from module getdtablesize:
# Code from module getgroups:
# Code from module getloadavg:
# Code from module getopt-gnu:
# Code from module getopt-posix:
+ # Code from module getrandom:
# Code from module gettext-h:
# Code from module gettime:
# Code from module gettimeofday:
@@ -111,9 +116,10 @@ AC_DEFUN([gl_EARLY],
# Code from module inttypes-incomplete:
# Code from module largefile:
AC_REQUIRE([AC_SYS_LARGEFILE])
+ # Code from module lchmod:
# Code from module libc-config:
+ # Code from module libgmp:
# Code from module limits-h:
- # Code from module localtime-buffer:
# Code from module lstat:
# Code from module malloca:
# Code from module manywarnings:
@@ -133,13 +139,13 @@ AC_DEFUN([gl_EARLY],
# Code from module pipe2:
# Code from module pselect:
# Code from module pthread_sigmask:
- # Code from module putenv:
# Code from module qcopy-acl:
# Code from module readlink:
# Code from module readlinkat:
# Code from module regex:
# Code from module root-uid:
# Code from module sig2str:
+ # Code from module sigdescr_np:
# Code from module signal-h:
# Code from module snippet/_Noreturn:
# Code from module snippet/arg-nonnull:
@@ -160,6 +166,7 @@ AC_DEFUN([gl_EARLY],
# Code from module strtoimax:
# Code from module strtoll:
# Code from module symlink:
+ # Code from module sys_random:
# Code from module sys_select:
# Code from module sys_stat:
# Code from module sys_time:
@@ -178,6 +185,7 @@ AC_DEFUN([gl_EARLY],
# Code from module unlocked-io:
# Code from module update-copyright:
# Code from module utimens:
+ # Code from module utimensat:
# Code from module vararrays:
# Code from module verify:
# Code from module vla:
@@ -212,6 +220,7 @@ AC_DEFUN([gl_INIT],
gl_MODULE_INDICATOR([canonicalize-lgpl])
gl_STDLIB_MODULE_INDICATOR([canonicalize_file_name])
gl_STDLIB_MODULE_INDICATOR([realpath])
+ AC_REQUIRE([AC_C_RESTRICT])
AC_CHECK_FUNCS_ONCE([readlinkat])
gl_CLOCK_TIME
gl_MODULE_INDICATOR([close-stream])
@@ -220,18 +229,19 @@ AC_DEFUN([gl_INIT],
AC_LIBOBJ([copy-file-range])
fi
gl_UNISTD_MODULE_INDICATOR([copy-file-range])
- gl_COUNT_LEADING_ZEROS
- gl_COUNT_ONE_BITS
- gl_COUNT_TRAILING_ZEROS
+ AC_REQUIRE([AC_C_RESTRICT])
gl_MD5
+ AC_REQUIRE([AC_C_RESTRICT])
gl_SHA1
+ AC_REQUIRE([AC_C_RESTRICT])
gl_SHA256
+ AC_REQUIRE([AC_C_RESTRICT])
gl_SHA512
gl_CHECK_TYPE_STRUCT_DIRENT_D_TYPE
gl_DIRENT_H
gl_DOUBLE_SLASH_ROOT
gl_FUNC_DUP2
- if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
+ if test $REPLACE_DUP2 = 1; then
AC_LIBOBJ([dup2])
gl_PREREQ_DUP2
fi
@@ -254,6 +264,12 @@ AC_DEFUN([gl_INIT],
fi
gl_MODULE_INDICATOR([faccessat])
gl_UNISTD_MODULE_INDICATOR([faccessat])
+ gl_FUNC_FCHMODAT
+ if test $HAVE_FCHMODAT = 0 || test $REPLACE_FCHMODAT = 1; then
+ AC_LIBOBJ([fchmodat])
+ gl_PREREQ_FCHMODAT
+ fi
+ gl_SYS_STAT_MODULE_INDICATOR([fchmodat])
gl_FUNC_FCNTL
if test $HAVE_FCNTL = 0 || test $REPLACE_FCNTL = 1; then
AC_LIBOBJ([fcntl])
@@ -288,6 +304,12 @@ AC_DEFUN([gl_INIT],
gl_PREREQ_FSYNC
fi
gl_UNISTD_MODULE_INDICATOR([fsync])
+ gl_FUNC_FUTIMENS
+ if test $HAVE_FUTIMENS = 0 || test $REPLACE_FUTIMENS = 1; then
+ AC_LIBOBJ([futimens])
+ fi
+ gl_SYS_STAT_MODULE_INDICATOR([futimens])
+ AC_REQUIRE([AC_CANONICAL_HOST])
gl_GETLOADAVG
if test $HAVE_GETLOADAVG = 0; then
AC_LIBOBJ([getloadavg])
@@ -306,6 +328,13 @@ AC_DEFUN([gl_INIT],
GNULIB_GL_UNISTD_H_GETOPT=1
fi
AC_SUBST([GNULIB_GL_UNISTD_H_GETOPT])
+ gl_UNISTD_MODULE_INDICATOR([getopt-posix])
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ gl_FUNC_GETRANDOM
+ if test $HAVE_GETRANDOM = 0 || test $REPLACE_GETRANDOM = 1; then
+ AC_LIBOBJ([getrandom])
+ fi
+ gl_SYS_RANDOM_MODULE_INDICATOR([getrandom])
gl_GETTIME
gl_FUNC_GETTIMEOFDAY
if test $HAVE_GETTIMEOFDAY = 0 || test $REPLACE_GETTIMEOFDAY = 1; then
@@ -316,6 +345,11 @@ AC_DEFUN([gl_INIT],
gl_IEEE754_H
gl_INTTYPES_INCOMPLETE
AC_REQUIRE([gl_LARGEFILE])
+ gl___INLINE
+ gl_LIBGMP
+ if test $HAVE_LIBGMP != yes; then
+ AC_LIBOBJ([mini-gmp-gnulib])
+ fi
gl_LIMITS_H
gl_FUNC_LSTAT
if test $REPLACE_LSTAT = 1; then
@@ -370,12 +404,6 @@ AC_DEFUN([gl_INIT],
gl_PREREQ_PTHREAD_SIGMASK
fi
gl_SIGNAL_MODULE_INDICATOR([pthread_sigmask])
- gl_FUNC_PUTENV
- if test $REPLACE_PUTENV = 1; then
- AC_LIBOBJ([putenv])
- gl_PREREQ_PUTENV
- fi
- gl_STDLIB_MODULE_INDICATOR([putenv])
gl_FUNC_READLINK
if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
AC_LIBOBJ([readlink])
@@ -397,6 +425,11 @@ AC_DEFUN([gl_INIT],
AC_LIBOBJ([sig2str])
gl_PREREQ_SIG2STR
fi
+ gl_FUNC_SIGDESCR_NP
+ if test $HAVE_SIGDESCR_NP = 0; then
+ AC_LIBOBJ([sigdescr_np])
+ fi
+ gl_STRING_MODULE_INDICATOR([sigdescr_np])
gl_SIGNAL_H
gl_TYPE_SOCKLEN_T
gt_TYPE_SSIZE_T
@@ -431,6 +464,8 @@ AC_DEFUN([gl_INIT],
AC_LIBOBJ([symlink])
fi
gl_UNISTD_MODULE_INDICATOR([symlink])
+ gl_HEADER_SYS_RANDOM
+ AC_PROG_MKDIR_P
AC_REQUIRE([gl_HEADER_SYS_SELECT])
AC_PROG_MKDIR_P
gl_HEADER_SYS_STAT_H
@@ -440,6 +475,7 @@ AC_DEFUN([gl_INIT],
gl_SYS_TYPES_H
AC_PROG_MKDIR_P
gl_FUNC_GEN_TEMPNAME
+ gl_MODULE_INDICATOR([tempname])
gl_HEADER_TIME_H
gl_TIME_R
if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
@@ -462,7 +498,11 @@ AC_DEFUN([gl_INIT],
gl_TIMESPEC
gl_UNISTD_H
gl_FUNC_GLIBC_UNLOCKED_IO
- gl_UTIMENS
+ gl_FUNC_UTIMENSAT
+ if test $HAVE_UTIMENSAT = 0 || test $REPLACE_UTIMENSAT = 1; then
+ AC_LIBOBJ([utimensat])
+ fi
+ gl_SYS_STAT_MODULE_INDICATOR([utimensat])
AC_C_VARARRAYS
gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false
gl_gnulib_enabled_cloexec=false
@@ -472,21 +512,23 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_getgroups=false
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false
gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false
- gl_gnulib_enabled_21ee726a3540c09237a8e70c0baf7467=false
- gl_gnulib_enabled_2049e887c7e5308faad27b3f894bb8c9=false
+ gl_gnulib_enabled_lchmod=false
gl_gnulib_enabled_malloca=false
gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31=false
gl_gnulib_enabled_open=false
gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7=false
gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false
gl_gnulib_enabled_strtoll=false
+ gl_gnulib_enabled_utimens=false
gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false
func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b ()
{
if ! $gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b; then
- AC_LIBOBJ([openat-proc])
+ AC_REQUIRE([AC_CANONICAL_HOST])
gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=true
- func_gl_gnulib_m4code_open
+ if case $host_os in mingw*) false;; *) :;; esac; then
+ func_gl_gnulib_m4code_open
+ fi
fi
}
func_gl_gnulib_m4code_cloexec ()
@@ -574,19 +616,16 @@ AC_DEFUN([gl_INIT],
fi
fi
}
- func_gl_gnulib_m4code_21ee726a3540c09237a8e70c0baf7467 ()
- {
- if ! $gl_gnulib_enabled_21ee726a3540c09237a8e70c0baf7467; then
- gl___INLINE
- gl_gnulib_enabled_21ee726a3540c09237a8e70c0baf7467=true
- fi
- }
- func_gl_gnulib_m4code_2049e887c7e5308faad27b3f894bb8c9 ()
+ func_gl_gnulib_m4code_lchmod ()
{
- if ! $gl_gnulib_enabled_2049e887c7e5308faad27b3f894bb8c9; then
- AC_REQUIRE([gl_LOCALTIME_BUFFER_DEFAULTS])
- AC_LIBOBJ([localtime-buffer])
- gl_gnulib_enabled_2049e887c7e5308faad27b3f894bb8c9=true
+ if ! $gl_gnulib_enabled_lchmod; then
+ gl_FUNC_LCHMOD
+ if test $HAVE_LCHMOD = 0; then
+ AC_LIBOBJ([lchmod])
+ gl_PREREQ_LCHMOD
+ fi
+ gl_SYS_STAT_MODULE_INDICATOR([lchmod])
+ gl_gnulib_enabled_lchmod=true
fi
}
func_gl_gnulib_m4code_malloca ()
@@ -647,6 +686,13 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_strtoll=true
fi
}
+ func_gl_gnulib_m4code_utimens ()
+ {
+ if ! $gl_gnulib_enabled_utimens; then
+ gl_UTIMENS
+ gl_gnulib_enabled_utimens=true
+ fi
+ }
func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec ()
{
if ! $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then
@@ -665,6 +711,15 @@ AC_DEFUN([gl_INIT],
if test $HAVE_FACCESSAT = 0 || test $REPLACE_FACCESSAT = 1; then
func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7
fi
+ if test $HAVE_FCHMODAT = 0; then
+ func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b
+ fi
+ if test $HAVE_FCHMODAT = 0; then
+ func_gl_gnulib_m4code_lchmod
+ fi
+ if test $HAVE_FCHMODAT = 0; then
+ func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7
+ fi
if test $HAVE_FCNTL = 0 || test $REPLACE_FCNTL = 1; then
func_gl_gnulib_m4code_getdtablesize
fi
@@ -680,14 +735,17 @@ AC_DEFUN([gl_INIT],
if test $HAVE_FSTATAT = 0 || test $REPLACE_FSTATAT = 1; then
func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7
fi
+ if test $HAVE_FUTIMENS = 0 || test $REPLACE_FUTIMENS = 1; then
+ func_gl_gnulib_m4code_utimens
+ fi
+ if case $host_os in mingw*) false;; *) test $HAVE_GETLOADAVG = 0;; esac; then
+ func_gl_gnulib_m4code_open
+ fi
if test $REPLACE_GETOPT = 1; then
func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36
fi
- if test $NEED_LOCALTIME_BUFFER = 1; then
- func_gl_gnulib_m4code_2049e887c7e5308faad27b3f894bb8c9
- fi
- if test $REPLACE_MKTIME = 1; then
- func_gl_gnulib_m4code_21ee726a3540c09237a8e70c0baf7467
+ if case $host_os in mingw*) false;; *) test $HAVE_GETRANDOM = 0 || test $REPLACE_GETRANDOM = 1;; esac; then
+ func_gl_gnulib_m4code_open
fi
if test $HAVE_READLINKAT = 0; then
func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b
@@ -695,15 +753,21 @@ AC_DEFUN([gl_INIT],
if test $HAVE_READLINKAT = 0; then
func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7
fi
- if test $ac_use_included_regex = yes; then
- func_gl_gnulib_m4code_21ee726a3540c09237a8e70c0baf7467
- fi
if { test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then
func_gl_gnulib_m4code_strtoll
fi
if test $HAVE_TIMEGM = 0 || test $REPLACE_TIMEGM = 1; then
func_gl_gnulib_m4code_5264294aa0a5557541b53c8c741f7f31
fi
+ if test $HAVE_UTIMENSAT = 0 || test $REPLACE_UTIMENSAT = 1; then
+ func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b
+ fi
+ if test $HAVE_UTIMENSAT = 0 || test $REPLACE_UTIMENSAT = 1; then
+ func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7
+ fi
+ if test $HAVE_UTIMENSAT = 0 || test $REPLACE_UTIMENSAT = 1; then
+ func_gl_gnulib_m4code_utimens
+ fi
m4_pattern_allow([^gl_GNULIB_ENABLED_])
AM_CONDITIONAL([gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b], [$gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b])
AM_CONDITIONAL([gl_GNULIB_ENABLED_cloexec], [$gl_gnulib_enabled_cloexec])
@@ -713,14 +777,14 @@ AC_DEFUN([gl_INIT],
AM_CONDITIONAL([gl_GNULIB_ENABLED_getgroups], [$gl_gnulib_enabled_getgroups])
AM_CONDITIONAL([gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36], [$gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36])
AM_CONDITIONAL([gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1], [$gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1])
- AM_CONDITIONAL([gl_GNULIB_ENABLED_21ee726a3540c09237a8e70c0baf7467], [$gl_gnulib_enabled_21ee726a3540c09237a8e70c0baf7467])
- AM_CONDITIONAL([gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9], [$gl_gnulib_enabled_2049e887c7e5308faad27b3f894bb8c9])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_lchmod], [$gl_gnulib_enabled_lchmod])
AM_CONDITIONAL([gl_GNULIB_ENABLED_malloca], [$gl_gnulib_enabled_malloca])
AM_CONDITIONAL([gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31], [$gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31])
AM_CONDITIONAL([gl_GNULIB_ENABLED_open], [$gl_gnulib_enabled_open])
AM_CONDITIONAL([gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7], [$gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7])
AM_CONDITIONAL([gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c], [$gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c])
AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoll], [$gl_gnulib_enabled_strtoll])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_utimens], [$gl_gnulib_enabled_utimens])
AM_CONDITIONAL([gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec], [$gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec])
# End of code from modules
m4_ifval(gl_LIBSOURCES_LIST, [
@@ -876,6 +940,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/allocator.h
lib/arg-nonnull.h
lib/at-func.c
+ lib/attribute.h
lib/binary-io.c
lib/binary-io.h
lib/byteswap.in.h
@@ -903,7 +968,6 @@ AC_DEFUN([gl_FILE_LIST], [
lib/diffseq.h
lib/dirent.in.h
lib/dirfd.c
- lib/dosname.h
lib/dtoastr.c
lib/dtotimespec.c
lib/dup2.c
@@ -913,11 +977,13 @@ AC_DEFUN([gl_FILE_LIST], [
lib/execinfo.in.h
lib/explicit_bzero.c
lib/faccessat.c
+ lib/fchmodat.c
lib/fcntl.c
lib/fcntl.in.h
lib/fdopendir.c
lib/filemode.c
lib/filemode.h
+ lib/filename.h
lib/filevercmp.c
lib/filevercmp.h
lib/flexmember.h
@@ -929,6 +995,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/fsync.c
lib/ftoastr.c
lib/ftoastr.h
+ lib/futimens.c
lib/get-permissions.c
lib/getdtablesize.c
lib/getgroups.c
@@ -942,6 +1009,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/getopt.in.h
lib/getopt1.c
lib/getopt_int.h
+ lib/getrandom.c
lib/gettext.h
lib/gettime.c
lib/gettimeofday.c
@@ -951,10 +1019,9 @@ AC_DEFUN([gl_FILE_LIST], [
lib/ignore-value.h
lib/intprops.h
lib/inttypes.in.h
+ lib/lchmod.c
lib/libc-config.h
lib/limits.in.h
- lib/localtime-buffer.c
- lib/localtime-buffer.h
lib/lstat.c
lib/malloca.c
lib/malloca.h
@@ -963,6 +1030,9 @@ AC_DEFUN([gl_FILE_LIST], [
lib/memmem.c
lib/mempcpy.c
lib/memrchr.c
+ lib/mini-gmp-gnulib.c
+ lib/mini-gmp.c
+ lib/mini-gmp.h
lib/minmax.h
lib/mkostemp.c
lib/mktime-internal.h
@@ -976,7 +1046,6 @@ AC_DEFUN([gl_FILE_LIST], [
lib/pipe2.c
lib/pselect.c
lib/pthread_sigmask.c
- lib/putenv.c
lib/qcopy-acl.c
lib/readlink.c
lib/readlinkat.c
@@ -996,6 +1065,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/sha512.h
lib/sig2str.c
lib/sig2str.h
+ lib/sigdescr_np.c
lib/signal.in.h
lib/stat-time.c
lib/stat-time.h
@@ -1014,6 +1084,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/strtol.c
lib/strtoll.c
lib/symlink.c
+ lib/sys_random.in.h
lib/sys_select.in.h
lib/sys_stat.in.h
lib/sys_time.in.h
@@ -1036,6 +1107,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/unlocked-io.h
lib/utimens.c
lib/utimens.h
+ lib/utimensat.c
lib/verify.h
lib/vla.h
lib/warn-on-use.h
@@ -1050,9 +1122,6 @@ AC_DEFUN([gl_FILE_LIST], [
m4/canonicalize.m4
m4/clock_time.m4
m4/copy-file-range.m4
- m4/count-leading-zeros.m4
- m4/count-one-bits.m4
- m4/count-trailing-zeros.m4
m4/d-type.m4
m4/dirent_h.m4
m4/dirfd.m4
@@ -1067,6 +1136,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/extensions.m4
m4/extern-inline.m4
m4/faccessat.m4
+ m4/fchmodat.m4
m4/fcntl-o.m4
m4/fcntl.m4
m4/fcntl_h.m4
@@ -1078,10 +1148,12 @@ AC_DEFUN([gl_FILE_LIST], [
m4/fstatat.m4
m4/fsusage.m4
m4/fsync.m4
+ m4/futimens.m4
m4/getdtablesize.m4
m4/getgroups.m4
m4/getloadavg.m4
m4/getopt.m4
+ m4/getrandom.m4
m4/gettime.m4
m4/gettimeofday.m4
m4/gl-openssl.m4
@@ -1092,9 +1164,9 @@ AC_DEFUN([gl_FILE_LIST], [
m4/include_next.m4
m4/inttypes.m4
m4/largefile.m4
+ m4/lchmod.m4
+ m4/libgmp.m4
m4/limits-h.m4
- m4/localtime-buffer.m4
- m4/longlong.m4
m4/lstat.m4
m4/malloca.m4
m4/manywarnings-c++.m4
@@ -1116,10 +1188,10 @@ AC_DEFUN([gl_FILE_LIST], [
m4/open-slash.m4
m4/open.m4
m4/pathmax.m4
+ m4/pid_t.m4
m4/pipe2.m4
m4/pselect.m4
m4/pthread_sigmask.m4
- m4/putenv.m4
m4/readlink.m4
m4/readlinkat.m4
m4/regex.m4
@@ -1127,6 +1199,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/sha256.m4
m4/sha512.m4
m4/sig2str.m4
+ m4/sigdescr_np.m4
m4/signal_h.m4
m4/socklen.m4
m4/ssize_t.m4
@@ -1144,6 +1217,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/strtoimax.m4
m4/strtoll.m4
m4/symlink.m4
+ m4/sys_random_h.m4
m4/sys_select_h.m4
m4/sys_socket_h.m4
m4/sys_stat_h.m4
@@ -1160,10 +1234,12 @@ AC_DEFUN([gl_FILE_LIST], [
m4/unistd_h.m4
m4/unlocked-io.m4
m4/utimens.m4
+ m4/utimensat.m4
m4/utimes.m4
m4/vararrays.m4
m4/warn-on-use.m4
m4/warnings.m4
m4/wchar_t.m4
m4/wint_t.m4
+ m4/zzgnulib.m4
])
diff --git a/m4/group-member.m4 b/m4/group-member.m4
index 5b32b5ff498..ad7368ceecb 100644
--- a/m4/group-member.m4
+++ b/m4/group-member.m4
@@ -1,7 +1,6 @@
# serial 14
-# Copyright (C) 1999-2001, 2003-2007, 2009-2020 Free Software
-# Foundation, Inc.
+# Copyright (C) 1999-2001, 2003-2007, 2009-2020 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/include_next.m4 b/m4/include_next.m4
index 9009e293b53..9221d9f7d5f 100644
--- a/m4/include_next.m4
+++ b/m4/include_next.m4
@@ -1,4 +1,4 @@
-# include_next.m4 serial 24
+# include_next.m4 serial 26
dnl Copyright (C) 2006-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -106,19 +106,21 @@ dnl We intentionally avoid using AC_LANG_SOURCE here.
AC_SUBST([INCLUDE_NEXT])
AC_SUBST([INCLUDE_NEXT_AS_FIRST_DIRECTIVE])
AC_SUBST([PRAGMA_SYSTEM_HEADER])
- AC_CACHE_CHECK([whether system header files limit the line length],
- [gl_cv_pragma_columns],
- [dnl HP NonStop systems, which define __TANDEM, have this misfeature.
- AC_EGREP_CPP([choke me],
+
+ dnl HP NonStop systems, which define __TANDEM, limit the line length
+ dnl after including some system header files.
+ AC_CACHE_CHECK([whether source code line length is unlimited],
+ [gl_cv_source_line_length_unlimited],
+ [AC_EGREP_CPP([choke me],
[
#ifdef __TANDEM
choke me
#endif
],
- [gl_cv_pragma_columns=yes],
- [gl_cv_pragma_columns=no])
+ [gl_cv_source_line_length_unlimited=no],
+ [gl_cv_source_line_length_unlimited=yes])
])
- if test $gl_cv_pragma_columns = yes; then
+ if test $gl_cv_source_line_length_unlimited = no; then
PRAGMA_COLUMNS="#pragma COLUMNS 10000"
else
PRAGMA_COLUMNS=
@@ -176,42 +178,40 @@ AC_DEFUN([gl_NEXT_HEADERS_INTERNAL],
[AC_CHECK_HEADERS_ONCE([$1])
])
-dnl FIXME: gl_next_header and gl_header_exists must be used unquoted
-dnl until we can assume autoconf 2.64 or newer.
m4_foreach_w([gl_HEADER_NAME], [$1],
[AS_VAR_PUSHDEF([gl_next_header],
[gl_cv_next_]m4_defn([gl_HEADER_NAME]))
if test $gl_cv_have_include_next = yes; then
- AS_VAR_SET(gl_next_header, ['<'gl_HEADER_NAME'>'])
+ AS_VAR_SET([gl_next_header], ['<'gl_HEADER_NAME'>'])
else
AC_CACHE_CHECK(
[absolute name of <]m4_defn([gl_HEADER_NAME])[>],
- m4_defn([gl_next_header]),
+ [gl_next_header],
[m4_if([$2], [check],
[AS_VAR_PUSHDEF([gl_header_exists],
[ac_cv_header_]m4_defn([gl_HEADER_NAME]))
- if test AS_VAR_GET(gl_header_exists) = yes; then
+ if test AS_VAR_GET([gl_header_exists]) = yes; then
AS_VAR_POPDEF([gl_header_exists])
])
gl_ABSOLUTE_HEADER_ONE(gl_HEADER_NAME)
AS_VAR_COPY([gl_header], [gl_cv_absolute_]AS_TR_SH(gl_HEADER_NAME))
- AS_VAR_SET(gl_next_header, ['"'$gl_header'"'])
+ AS_VAR_SET([gl_next_header], ['"'$gl_header'"'])
m4_if([$2], [check],
[else
- AS_VAR_SET(gl_next_header, ['<'gl_HEADER_NAME'>'])
+ AS_VAR_SET([gl_next_header], ['<'gl_HEADER_NAME'>'])
fi
])
])
fi
AC_SUBST(
AS_TR_CPP([NEXT_]m4_defn([gl_HEADER_NAME])),
- [AS_VAR_GET(gl_next_header)])
+ [AS_VAR_GET([gl_next_header])])
if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then
# INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next'
gl_next_as_first_directive='<'gl_HEADER_NAME'>'
else
# INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include'
- gl_next_as_first_directive=AS_VAR_GET(gl_next_header)
+ gl_next_as_first_directive=AS_VAR_GET([gl_next_header])
fi
AC_SUBST(
AS_TR_CPP([NEXT_AS_FIRST_DIRECTIVE_]m4_defn([gl_HEADER_NAME])),
diff --git a/m4/inttypes.m4 b/m4/inttypes.m4
index e037be6fcc5..84b1654ea26 100644
--- a/m4/inttypes.m4
+++ b/m4/inttypes.m4
@@ -1,4 +1,4 @@
-# inttypes.m4 serial 27
+# inttypes.m4 serial 32
dnl Copyright (C) 2006-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -28,17 +28,26 @@ AC_DEFUN_ONCE([gl_INTTYPES_INCOMPLETE],
dnl corresponding gnulib module is not in use.
gl_WARN_ON_USE_PREPARE([[#include <inttypes.h>
]], [imaxabs imaxdiv strtoimax strtoumax])
+
+ AC_REQUIRE([AC_C_RESTRICT])
])
# Ensure that the PRI* and SCN* macros are defined appropriately.
AC_DEFUN([gl_INTTYPES_PRI_SCN],
[
- AC_REQUIRE([gt_INTTYPES_PRI])
-
PRIPTR_PREFIX=
if test -n "$STDINT_H"; then
- dnl Using the gnulib <stdint.h>. It always defines intptr_t to 'long'.
- PRIPTR_PREFIX='"l"'
+ dnl Using the gnulib <stdint.h>. It defines intptr_t to 'long' or
+ dnl 'long long', depending on _WIN64.
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[
+ #ifdef _WIN64
+ LLP64
+ #endif
+ ]])
+ ],
+ [PRIPTR_PREFIX='"l"'],
+ [PRIPTR_PREFIX='"ll"'])
else
dnl Using the system's <stdint.h>.
for glpfx in '' l ll I64; do
@@ -113,10 +122,8 @@ AC_DEFUN([gl_INTTYPES_CHECK_LONG_LONG_INT_CONDITION],
#if $2
#define CONDITION ($3)
- #elif HAVE_LONG_LONG_INT
- #define CONDITION ($4)
#else
- #define CONDITION 0
+ #define CONDITION ($4)
#endif
int test[CONDITION ? 1 : -1];]])],
[gl_cv_test_$1=yes],
@@ -152,7 +159,6 @@ AC_DEFUN([gl_INTTYPES_H_DEFAULTS],
REPLACE_STRTOUMAX=0; AC_SUBST([REPLACE_STRTOUMAX])
INT32_MAX_LT_INTMAX_MAX=1; AC_SUBST([INT32_MAX_LT_INTMAX_MAX])
INT64_MAX_EQ_LONG_MAX='defined _LP64'; AC_SUBST([INT64_MAX_EQ_LONG_MAX])
- PRI_MACROS_BROKEN=0; AC_SUBST([PRI_MACROS_BROKEN])
PRIPTR_PREFIX=__PRIPTR_PREFIX; AC_SUBST([PRIPTR_PREFIX])
UINT32_MAX_LT_UINTMAX_MAX=1; AC_SUBST([UINT32_MAX_LT_UINTMAX_MAX])
UINT64_MAX_EQ_ULONG_MAX='defined _LP64'; AC_SUBST([UINT64_MAX_EQ_ULONG_MAX])
diff --git a/m4/largefile.m4 b/m4/largefile.m4
index f6863e46c49..f4c5d3a5cea 100644
--- a/m4/largefile.m4
+++ b/m4/largefile.m4
@@ -1,10 +1,27 @@
# Enable large files on systems where this is not the default.
+# Enable support for files on Linux file systems with 64-bit inode numbers.
# Copyright 1992-1996, 1998-2020 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
+# The following macro works around a problem in Autoconf's AC_FUNC_FSEEKO:
+# It does not set _LARGEFILE_SOURCE=1 on HP-UX/ia64 32-bit, although this
+# setting of _LARGEFILE_SOURCE is needed so that <stdio.h> declares fseeko
+# and ftello in C++ mode as well.
+AC_DEFUN([gl_SET_LARGEFILE_SOURCE],
+[
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ AC_FUNC_FSEEKO
+ case "$host_os" in
+ hpux*)
+ AC_DEFINE([_LARGEFILE_SOURCE], [1],
+ [Define to 1 to make fseeko visible on some hosts (e.g. glibc 2.2).])
+ ;;
+ esac
+])
+
# The following implementation works around a problem in autoconf <= 2.69;
# AC_SYS_LARGEFILE does not configure for large inodes on Mac OS X 10.5,
# or configures them incorrectly in some cases.
@@ -13,12 +30,12 @@ m4_version_prereq([2.70], [] ,[
# _AC_SYS_LARGEFILE_TEST_INCLUDES
# -------------------------------
m4_define([_AC_SYS_LARGEFILE_TEST_INCLUDES],
-[@%:@include <sys/types.h>
+[#include <sys/types.h>
/* Check that off_t can represent 2**63 - 1 correctly.
We can't simply define LARGE_OFF_T to be 9223372036854775807,
since some C++ compilers masquerading as C compilers
incorrectly reject 9223372036854775807. */
-@%:@define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
+#define LARGE_OFF_T (((off_t) 1 << 31 << 31) - 1 + ((off_t) 1 << 31 << 31))
int off_t_is_large[[(LARGE_OFF_T % 2147483629 == 721
&& LARGE_OFF_T % 2147483647 == 1)
? 1 : -1]];[]dnl
@@ -37,7 +54,7 @@ m4_define([_AC_SYS_LARGEFILE_MACRO_VALUE],
[AC_LANG_PROGRAM([$5], [$6])],
[$3=no; break])
m4_ifval([$6], [AC_LINK_IFELSE], [AC_COMPILE_IFELSE])(
- [AC_LANG_PROGRAM([@%:@define $1 $2
+ [AC_LANG_PROGRAM([#define $1 $2
$5], [$6])],
[$3=$2; break])
$3=unknown
@@ -57,6 +74,9 @@ rm -rf conftest*[]dnl
# one must use special compiler options to get large-file access to work.
# For more details about this brain damage please see:
# http://www.unix.org/version2/whatsnew/lfs20mar.html
+# Additionally, on Linux file systems with 64-bit inodes a file that happens
+# to have a 64-bit inode number cannot be accessed by 32-bit applications on
+# Linux x86/x86_64. This can occur with file systems such as XFS and NFS.
AC_DEFUN([AC_SYS_LARGEFILE],
[AC_ARG_ENABLE(largefile,
[ --disable-largefile omit support for large files])
@@ -93,9 +113,6 @@ if test "$enable_largefile" != no; then
[Define for large files, on AIX-style hosts.],
[_AC_SYS_LARGEFILE_TEST_INCLUDES])
fi
-
- AC_DEFINE([_DARWIN_USE_64_BIT_INODE], [1],
- [Enable large inode numbers on Mac OS X 10.5.])
fi
])# AC_SYS_LARGEFILE
])# m4_version_prereq 2.70
diff --git a/m4/lchmod.m4 b/m4/lchmod.m4
new file mode 100644
index 00000000000..a86a304f5f1
--- /dev/null
+++ b/m4/lchmod.m4
@@ -0,0 +1,30 @@
+#serial 8
+
+dnl Copyright (C) 2005-2006, 2008-2020 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Paul Eggert.
+dnl Provide a replacement for lchmod on hosts that lack a working version.
+
+AC_DEFUN([gl_FUNC_LCHMOD],
+[
+ AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS])
+
+ dnl Persuade glibc <sys/stat.h> to declare lchmod().
+ AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
+
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+
+ AC_CHECK_FUNCS_ONCE([lchmod lstat])
+ if test "$ac_cv_func_lchmod" = no; then
+ HAVE_LCHMOD=0
+ fi
+])
+
+# Prerequisites of lib/lchmod.c.
+AC_DEFUN([gl_PREREQ_LCHMOD],
+[
+ :
+])
diff --git a/m4/libgmp.m4 b/m4/libgmp.m4
new file mode 100644
index 00000000000..1025f06a775
--- /dev/null
+++ b/m4/libgmp.m4
@@ -0,0 +1,71 @@
+# libgmp.m4 serial 5
+# Configure the GMP library or a replacement.
+dnl Copyright 2020 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl gl_LIBGMP
+dnl Search for an installed libgmp.
+dnl If found, set and AC_SUBST HAVE_LIBGMP=yes and the LIBGMP and LTLIBGMP
+dnl variables, and augment the CPPFLAGS variable, and #define HAVE_LIBGMP to 1.
+dnl Otherwise, set and AC_SUBST HAVE_LIBGMP=no and LIBGMP and LTLIBGMP to
+dnl empty.
+
+AC_DEFUN([gl_LIBGMP],
+[
+ AC_ARG_WITH([libgmp],
+ [AS_HELP_STRING([--without-libgmp],
+ [do not use the GNU Multiple Precision (GMP) library;
+ this is the default on systems lacking libgmp.])])
+ HAVE_LIBGMP=no
+ LIBGMP=
+ LTLIBGMP=
+ AS_IF([test "$with_libgmp" != no],
+ [AC_CHECK_HEADERS([gmp.h gmp/gmp.h], [break])
+ dnl Prefer AC_LIB_HAVE_LINKFLAGS if the havelib module is also in use.
+ AS_IF([test "$ac_cv_header_gmp_h" = yes ||
+ test "$ac_cv_header_gmp_gmp_h" = yes],
+ [m4_ifdef([gl_HAVE_MODULE_HAVELIB],
+ [AC_LIB_HAVE_LINKFLAGS([gmp], [],
+ [#if HAVE_GMP_H
+ # include <gmp.h>
+ #else
+ # include <gmp/gmp.h>
+ #endif],
+ [static const mp_limb_t x[2] = { 0x73, 0x55 };
+ mpz_t tmp;
+ mpz_roinit_n (tmp, x, 2);
+ ],
+ [no])],
+ [gl_saved_LIBS=$LIBS
+ AC_SEARCH_LIBS([__gmpz_roinit_n], [gmp])
+ LIBS=$gl_saved_LIBS
+ case $ac_cv_search___gmpz_roinit_n in
+ 'none needed')
+ HAVE_LIBGMP=yes;;
+ -*)
+ HAVE_LIBGMP=yes
+ LIBGMP=$ac_cv_search___gmpz_roinit_n
+ LTLIBGMP=$LIBGMP;;
+ esac
+ AC_SUBST([HAVE_LIBGMP])
+ AC_SUBST([LIBGMP])
+ AC_SUBST([LTLIBGMP])])])
+ if test "$with_libgmp,$HAVE_LIBGMP" = yes,no; then
+ AC_MSG_ERROR(
+ [GMP not found, although --with-libgmp was specified.m4_ifdef(
+ [AC_LIB_HAVE_LINKFLAGS],
+ [ Try specifying --with-libgmp-prefix=DIR.])])
+ fi])
+ if test $HAVE_LIBGMP = yes && test "$ac_cv_header_gmp_h" = yes; then
+ GMP_H=
+ else
+ GMP_H=gmp.h
+ fi
+ AC_SUBST([GMP_H])
+ AM_CONDITIONAL([GL_GENERATE_MINI_GMP_H],
+ [test $HAVE_LIBGMP != yes])
+ AM_CONDITIONAL([GL_GENERATE_GMP_GMP_H],
+ [test $HAVE_LIBGMP = yes && test "$ac_cv_header_gmp_h" != yes])
+])
diff --git a/m4/localtime-buffer.m4 b/m4/localtime-buffer.m4
deleted file mode 100644
index 09df3c97f25..00000000000
--- a/m4/localtime-buffer.m4
+++ /dev/null
@@ -1,21 +0,0 @@
-# localtime-buffer.m4 serial 1
-dnl Copyright (C) 2017-2020 Free Software Foundation, Inc.
-dnl This file is free software; the Free Software Foundation
-dnl gives unlimited permission to copy and/or distribute it,
-dnl with or without modifications, as long as this notice is preserved.
-
-AC_DEFUN([gl_LOCALTIME_BUFFER_DEFAULTS],
-[
- NEED_LOCALTIME_BUFFER=0
-])
-
-dnl Macro invoked from other modules, to signal that the compilation of
-dnl module 'localtime-buffer' is needed.
-AC_DEFUN([gl_LOCALTIME_BUFFER_NEEDED],
-[
- AC_REQUIRE([gl_LOCALTIME_BUFFER_DEFAULTS])
- AC_REQUIRE([gl_HEADER_TIME_H_DEFAULTS])
- NEED_LOCALTIME_BUFFER=1
- REPLACE_GMTIME=1
- REPLACE_LOCALTIME=1
-])
diff --git a/m4/longlong.m4 b/m4/longlong.m4
deleted file mode 100644
index e878488ad54..00000000000
--- a/m4/longlong.m4
+++ /dev/null
@@ -1,113 +0,0 @@
-# longlong.m4 serial 18
-dnl Copyright (C) 1999-2007, 2009-2020 Free Software Foundation, Inc.
-dnl This file is free software; the Free Software Foundation
-dnl gives unlimited permission to copy and/or distribute it,
-dnl with or without modifications, as long as this notice is preserved.
-
-dnl From Paul Eggert.
-
-AC_PREREQ([2.62])
-
-# Define HAVE_LONG_LONG_INT if 'long long int' works.
-# This can be faster than what's in Autoconf 2.62 through 2.68.
-
-# Note: If the type 'long long int' exists but is only 32 bits large
-# (as on some very old compilers), HAVE_LONG_LONG_INT will not be
-# defined. In this case you can treat 'long long int' like 'long int'.
-
-AC_DEFUN([AC_TYPE_LONG_LONG_INT],
-[
- AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT])
- AC_CACHE_CHECK([for long long int], [ac_cv_type_long_long_int],
- [ac_cv_type_long_long_int=yes
- if test "x${ac_cv_prog_cc_c99-no}" = xno; then
- ac_cv_type_long_long_int=$ac_cv_type_unsigned_long_long_int
- if test $ac_cv_type_long_long_int = yes; then
- dnl Catch a bug in Tandem NonStop Kernel (OSS) cc -O circa 2004.
- dnl If cross compiling, assume the bug is not important, since
- dnl nobody cross compiles for this platform as far as we know.
- AC_RUN_IFELSE(
- [AC_LANG_PROGRAM(
- [[@%:@include <limits.h>
- @%:@ifndef LLONG_MAX
- @%:@ define HALF \
- (1LL << (sizeof (long long int) * CHAR_BIT - 2))
- @%:@ define LLONG_MAX (HALF - 1 + HALF)
- @%:@endif]],
- [[long long int n = 1;
- int i;
- for (i = 0; ; i++)
- {
- long long int m = n << i;
- if (m >> i != n)
- return 1;
- if (LLONG_MAX / 2 < m)
- break;
- }
- return 0;]])],
- [],
- [ac_cv_type_long_long_int=no],
- [:])
- fi
- fi])
- if test $ac_cv_type_long_long_int = yes; then
- AC_DEFINE([HAVE_LONG_LONG_INT], [1],
- [Define to 1 if the system has the type 'long long int'.])
- fi
-])
-
-# Define HAVE_UNSIGNED_LONG_LONG_INT if 'unsigned long long int' works.
-# This can be faster than what's in Autoconf 2.62 through 2.68.
-
-# Note: If the type 'unsigned long long int' exists but is only 32 bits
-# large (as on some very old compilers), AC_TYPE_UNSIGNED_LONG_LONG_INT
-# will not be defined. In this case you can treat 'unsigned long long int'
-# like 'unsigned long int'.
-
-AC_DEFUN([AC_TYPE_UNSIGNED_LONG_LONG_INT],
-[
- AC_CACHE_CHECK([for unsigned long long int],
- [ac_cv_type_unsigned_long_long_int],
- [ac_cv_type_unsigned_long_long_int=yes
- if test "x${ac_cv_prog_cc_c99-no}" = xno; then
- AC_LINK_IFELSE(
- [_AC_TYPE_LONG_LONG_SNIPPET],
- [],
- [ac_cv_type_unsigned_long_long_int=no])
- fi])
- if test $ac_cv_type_unsigned_long_long_int = yes; then
- AC_DEFINE([HAVE_UNSIGNED_LONG_LONG_INT], [1],
- [Define to 1 if the system has the type 'unsigned long long int'.])
- fi
-])
-
-# Expands to a C program that can be used to test for simultaneous support
-# of 'long long' and 'unsigned long long'. We don't want to say that
-# 'long long' is available if 'unsigned long long' is not, or vice versa,
-# because too many programs rely on the symmetry between signed and unsigned
-# integer types (excluding 'bool').
-AC_DEFUN([_AC_TYPE_LONG_LONG_SNIPPET],
-[
- AC_LANG_PROGRAM(
- [[/* For now, do not test the preprocessor; as of 2007 there are too many
- implementations with broken preprocessors. Perhaps this can
- be revisited in 2012. In the meantime, code should not expect
- #if to work with literals wider than 32 bits. */
- /* Test literals. */
- long long int ll = 9223372036854775807ll;
- long long int nll = -9223372036854775807LL;
- unsigned long long int ull = 18446744073709551615ULL;
- /* Test constant expressions. */
- typedef int a[((-9223372036854775807LL < 0 && 0 < 9223372036854775807ll)
- ? 1 : -1)];
- typedef int b[(18446744073709551615ULL <= (unsigned long long int) -1
- ? 1 : -1)];
- int i = 63;]],
- [[/* Test availability of runtime routines for shift and division. */
- long long int llmax = 9223372036854775807ll;
- unsigned long long int ullmax = 18446744073709551615ull;
- return ((ll << 63) | (ll >> 63) | (ll < i) | (ll > i)
- | (llmax / ll) | (llmax % ll)
- | (ull << 63) | (ull >> 63) | (ull << i) | (ull >> i)
- | (ullmax / ull) | (ullmax % ull));]])
-])
diff --git a/m4/malloca.m4 b/m4/malloca.m4
index 99e9dace2c5..930199da14a 100644
--- a/m4/malloca.m4
+++ b/m4/malloca.m4
@@ -1,6 +1,6 @@
-# malloca.m4 serial 1
-dnl Copyright (C) 2003-2004, 2006-2007, 2009-2020 Free Software
-dnl Foundation, Inc.
+# malloca.m4 serial 2
+dnl Copyright (C) 2003-2004, 2006-2007, 2009-2020 Free Software Foundation,
+dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -11,5 +11,4 @@ AC_DEFUN([gl_MALLOCA],
dnl @ALLOCA@ and @LTALLOCA@.
dnl gl_FUNC_ALLOCA dnl Already brought in by the module dependencies.
AC_REQUIRE([gl_EEMALLOC])
- AC_REQUIRE([AC_TYPE_LONG_LONG_INT])
])
diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4
index 783620da3ad..a37cd15b69a 100644
--- a/m4/manywarnings.m4
+++ b/m4/manywarnings.m4
@@ -1,4 +1,4 @@
-# manywarnings.m4 serial 18
+# manywarnings.m4 serial 21
dnl Copyright (C) 2008-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -21,7 +21,7 @@ AC_DEFUN([gl_MANYWARN_COMPLEMENT],
*" $gl_warn_item "*)
;;
*)
- gl_warn_set="$gl_warn_set $gl_warn_item"
+ gl_AS_VAR_APPEND([gl_warn_set], [" $gl_warn_item"])
;;
esac
done
@@ -39,8 +39,7 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC],
[_AC_LANG_DISPATCH([$0], _AC_LANG, $@)])
# Specialization for _AC_LANG = C.
-# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b.
-m4_defun([gl_MANYWARN_ALL_GCC(C)],
+AC_DEFUN([gl_MANYWARN_ALL_GCC(C)],
[
AC_LANG_PUSH([C])
@@ -49,12 +48,12 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)],
AC_REQUIRE([AC_PROG_CC])
if test -n "$GCC"; then
- dnl Check if -W -Werror -Wno-missing-field-initializers is supported
+ dnl Check if -Wextra -Werror -Wno-missing-field-initializers is supported
dnl with the current $CC $CFLAGS $CPPFLAGS.
AC_CACHE_CHECK([whether -Wno-missing-field-initializers is supported],
[gl_cv_cc_nomfi_supported],
[gl_save_CFLAGS="$CFLAGS"
- CFLAGS="$CFLAGS -W -Werror -Wno-missing-field-initializers"
+ CFLAGS="$CFLAGS -Wextra -Werror -Wno-missing-field-initializers"
AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM([[]], [[]])],
[gl_cv_cc_nomfi_supported=yes],
@@ -68,7 +67,7 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)],
AC_CACHE_CHECK([whether -Wno-missing-field-initializers is needed],
[gl_cv_cc_nomfi_needed],
[gl_save_CFLAGS="$CFLAGS"
- CFLAGS="$CFLAGS -W -Werror"
+ CFLAGS="$CFLAGS -Wextra -Werror"
AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM(
[[int f (void)
@@ -105,133 +104,41 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)],
# To compare this list to your installed GCC's, run this Bash command:
#
# comm -3 \
- # <((sed -n 's/^ *\(-[^ 0-9][^ ]*\) .*/\1/p' manywarnings.m4; \
+ # <((sed -n 's/^ *\(-[^ 0-9][^ ]*\).*/\1/p' manywarnings.m4; \
# awk '/^[^#]/ {print $1}' ../build-aux/gcc-warning.spec) | sort) \
# <(LC_ALL=C gcc --help=warnings | sed -n 's/^ \(-[^ ]*\) .*/\1/p' | sort)
- gl_manywarn_set=
- for gl_manywarn_item in -fno-common \
- -W \
- -Wabsolute-value \
- -Waddress \
- -Waddress-of-packed-member \
- -Waggressive-loop-optimizations \
+ $1=
+ for gl_manywarn_item in -fanalyzer -fno-common \
-Wall \
- -Wattribute-warning \
- -Wattributes \
+ -Warith-conversion \
-Wbad-function-cast \
- -Wbool-compare \
- -Wbool-operation \
- -Wbuiltin-declaration-mismatch \
- -Wbuiltin-macro-redefined \
- -Wcannot-profile \
- -Wcast-align \
-Wcast-align=strict \
- -Wcast-function-type \
- -Wchar-subscripts \
- -Wclobbered \
- -Wcomment \
- -Wcomments \
- -Wcoverage-mismatch \
- -Wcpp \
- -Wdangling-else \
-Wdate-time \
- -Wdeprecated \
- -Wdeprecated-declarations \
- -Wdesignated-init \
-Wdisabled-optimization \
- -Wdiscarded-array-qualifiers \
- -Wdiscarded-qualifiers \
- -Wdiv-by-zero \
-Wdouble-promotion \
-Wduplicated-branches \
-Wduplicated-cond \
- -Wduplicate-decl-specifier \
- -Wempty-body \
- -Wendif-labels \
- -Wenum-compare \
- -Wexpansion-to-defined \
-Wextra \
- -Wformat-contains-nul \
- -Wformat-extra-args \
- -Wformat-nonliteral \
- -Wformat-security \
-Wformat-signedness \
- -Wformat-y2k \
- -Wformat-zero-length \
- -Wframe-address \
- -Wfree-nonheap-object \
- -Whsa \
- -Wif-not-aligned \
- -Wignored-attributes \
- -Wignored-qualifiers \
- -Wimplicit \
- -Wimplicit-function-declaration \
- -Wimplicit-int \
- -Wincompatible-pointer-types \
-Winit-self \
-Winline \
- -Wint-conversion \
- -Wint-in-bool-context \
- -Wint-to-pointer-cast \
- -Winvalid-memory-model \
-Winvalid-pch \
- -Wlogical-not-parentheses \
-Wlogical-op \
- -Wmain \
- -Wmaybe-uninitialized \
- -Wmemset-elt-size \
- -Wmemset-transposed-args \
- -Wmisleading-indentation \
- -Wmissing-attributes \
- -Wmissing-braces \
-Wmissing-declarations \
- -Wmissing-field-initializers \
-Wmissing-include-dirs \
- -Wmissing-parameter-type \
- -Wmissing-profile \
-Wmissing-prototypes \
- -Wmultichar \
- -Wmultistatement-macros \
- -Wnarrowing \
-Wnested-externs \
- -Wnonnull \
- -Wnonnull-compare \
-Wnull-dereference \
- -Wodr \
- -Wold-style-declaration \
-Wold-style-definition \
-Wopenmp-simd \
- -Woverflow \
-Woverlength-strings \
- -Woverride-init \
-Wpacked \
- -Wpacked-bitfield-compat \
- -Wpacked-not-aligned \
- -Wparentheses \
-Wpointer-arith \
- -Wpointer-compare \
- -Wpointer-sign \
- -Wpointer-to-int-cast \
- -Wpragmas \
- -Wpsabi \
- -Wrestrict \
- -Wreturn-local-addr \
- -Wreturn-type \
- -Wscalar-storage-order \
- -Wsequence-point \
-Wshadow \
- -Wshift-count-negative \
- -Wshift-count-overflow \
- -Wshift-negative-value \
- -Wsizeof-array-argument \
- -Wsizeof-pointer-div \
- -Wsizeof-pointer-memaccess \
-Wstack-protector \
- -Wstrict-aliasing \
-Wstrict-overflow \
-Wstrict-prototypes \
- -Wstringop-truncation \
-Wsuggest-attribute=cold \
-Wsuggest-attribute=const \
-Wsuggest-attribute=format \
@@ -240,100 +147,69 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)],
-Wsuggest-attribute=pure \
-Wsuggest-final-methods \
-Wsuggest-final-types \
- -Wswitch \
- -Wswitch-bool \
- -Wswitch-unreachable \
-Wsync-nand \
-Wsystem-headers \
- -Wtautological-compare \
-Wtrampolines \
- -Wtrigraphs \
- -Wtype-limits \
-Wuninitialized \
-Wunknown-pragmas \
-Wunsafe-loop-optimizations \
- -Wunused \
- -Wunused-but-set-parameter \
- -Wunused-but-set-variable \
- -Wunused-function \
- -Wunused-label \
- -Wunused-local-typedefs \
-Wunused-macros \
- -Wunused-parameter \
- -Wunused-result \
- -Wunused-value \
- -Wunused-variable \
- -Wvarargs \
-Wvariadic-macros \
-Wvector-operation-performance \
-Wvla \
- -Wvolatile-register-var \
-Wwrite-strings \
\
; do
- gl_manywarn_set="$gl_manywarn_set $gl_manywarn_item"
+ gl_AS_VAR_APPEND([$1], [" $gl_manywarn_item"])
done
# gcc --help=warnings outputs an unusual form for these options; list
# them here so that the above 'comm' command doesn't report a false match.
- # Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal.
- # Also, AC_COMPUTE_INT requires it to fit in a long; it is 2**63 on
- # the only platforms where it does not fit in a long, so make that
- # a special case.
- AC_MSG_CHECKING([max safe object size])
- AC_COMPUTE_INT([gl_alloc_max],
- [LONG_MAX < (PTRDIFF_MAX < (size_t) -1 ? PTRDIFF_MAX : (size_t) -1)
- ? -1
- : PTRDIFF_MAX < (size_t) -1 ? (long) PTRDIFF_MAX : (long) (size_t) -1],
- [[#include <limits.h>
- #include <stddef.h>
- #include <stdint.h>
- ]],
- [gl_alloc_max=2147483647])
- case $gl_alloc_max in
- -1) gl_alloc_max=9223372036854775807;;
- esac
- AC_MSG_RESULT([$gl_alloc_max])
- gl_manywarn_set="$gl_manywarn_set -Walloc-size-larger-than=$gl_alloc_max"
- gl_manywarn_set="$gl_manywarn_set -Warray-bounds=2"
- gl_manywarn_set="$gl_manywarn_set -Wattribute-alias=2"
- gl_manywarn_set="$gl_manywarn_set -Wformat-overflow=2"
- gl_manywarn_set="$gl_manywarn_set -Wformat-truncation=2"
- gl_manywarn_set="$gl_manywarn_set -Wimplicit-fallthrough=5"
- gl_manywarn_set="$gl_manywarn_set -Wnormalized=nfc"
- gl_manywarn_set="$gl_manywarn_set -Wshift-overflow=2"
- gl_manywarn_set="$gl_manywarn_set -Wstringop-overflow=2"
- gl_manywarn_set="$gl_manywarn_set -Wunused-const-variable=2"
- gl_manywarn_set="$gl_manywarn_set -Wvla-larger-than=4031"
+ gl_AS_VAR_APPEND([$1], [' -Warray-bounds=2'])
+ gl_AS_VAR_APPEND([$1], [' -Wattribute-alias=2'])
+ gl_AS_VAR_APPEND([$1], [' -Wformat-overflow=2'])
+ gl_AS_VAR_APPEND([$1], [' -Wformat=2'])
+ gl_AS_VAR_APPEND([$1], [' -Wformat-truncation=2'])
+ gl_AS_VAR_APPEND([$1], [' -Wimplicit-fallthrough=5'])
+ gl_AS_VAR_APPEND([$1], [' -Wshift-overflow=2'])
+ gl_AS_VAR_APPEND([$1], [' -Wunused-const-variable=2'])
+ gl_AS_VAR_APPEND([$1], [' -Wvla-larger-than=4031'])
# These are needed for older GCC versions.
if test -n "$GCC"; then
case `($CC --version) 2>/dev/null` in
'gcc (GCC) '[[0-3]].* | \
'gcc (GCC) '4.[[0-7]].*)
- gl_manywarn_set="$gl_manywarn_set -fdiagnostics-show-option"
- gl_manywarn_set="$gl_manywarn_set -funit-at-a-time"
+ gl_AS_VAR_APPEND([$1], [' -fdiagnostics-show-option'])
+ gl_AS_VAR_APPEND([$1], [' -funit-at-a-time'])
;;
esac
fi
# Disable specific options as needed.
if test "$gl_cv_cc_nomfi_needed" = yes; then
- gl_manywarn_set="$gl_manywarn_set -Wno-missing-field-initializers"
+ gl_AS_VAR_APPEND([$1], [' -Wno-missing-field-initializers'])
fi
if test "$gl_cv_cc_uninitialized_supported" = no; then
- gl_manywarn_set="$gl_manywarn_set -Wno-uninitialized"
+ gl_AS_VAR_APPEND([$1], [' -Wno-uninitialized'])
fi
- $1=$gl_manywarn_set
+ # Some warnings have too many false alarms in GCC 10.1.
+ # https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93695
+ gl_AS_VAR_APPEND([$1], [' -Wno-analyzer-double-free'])
+ # https://gcc.gnu.org/bugzilla/show_bug.cgi?id=94458
+ gl_AS_VAR_APPEND([$1], [' -Wno-analyzer-malloc-leak'])
+ # https://gcc.gnu.org/bugzilla/show_bug.cgi?id=94851
+ gl_AS_VAR_APPEND([$1], [' -Wno-analyzer-null-dereference'])
+ # https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95758
+ gl_AS_VAR_APPEND([$1], [' -Wno-analyzer-use-after-free'])
AC_LANG_POP([C])
])
# Specialization for _AC_LANG = C++.
-# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b.
-m4_defun([gl_MANYWARN_ALL_GCC(C++)],
+AC_DEFUN([gl_MANYWARN_ALL_GCC(C++)],
[
gl_MANYWARN_ALL_GCC_CXX_IMPL([$1])
])
diff --git a/m4/memmem.m4 b/m4/memmem.m4
index e034d7bd775..35a5bb19d1a 100644
--- a/m4/memmem.m4
+++ b/m4/memmem.m4
@@ -1,4 +1,4 @@
-# memmem.m4 serial 26
+# memmem.m4 serial 27
dnl Copyright (C) 2002-2004, 2007-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -37,7 +37,7 @@ AC_DEFUN([gl_FUNC_MEMMEM_SIMPLE],
/* Check for empty needle behavior. */
{
const char *haystack = "AAA";
- if (memmem (haystack, 3, NULL, 0) != haystack)
+ if (memmem (haystack, 3, (const char *) 1, 0) != haystack)
result |= 2;
}
return result;
diff --git a/m4/mempcpy.m4 b/m4/mempcpy.m4
index 63e4087784b..899f12a880a 100644
--- a/m4/mempcpy.m4
+++ b/m4/mempcpy.m4
@@ -1,6 +1,6 @@
# mempcpy.m4 serial 11
-dnl Copyright (C) 2003-2004, 2006-2007, 2009-2020 Free Software
-dnl Foundation, Inc.
+dnl Copyright (C) 2003-2004, 2006-2007, 2009-2020 Free Software Foundation,
+dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/memrchr.m4 b/m4/memrchr.m4
index 8e33fb96a07..95990ed6b76 100644
--- a/m4/memrchr.m4
+++ b/m4/memrchr.m4
@@ -1,6 +1,6 @@
# memrchr.m4 serial 10
-dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software
-dnl Foundation, Inc.
+dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software Foundation,
+dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/mktime.m4 b/m4/mktime.m4
index 5e89f20e979..4e7e423fa54 100644
--- a/m4/mktime.m4
+++ b/m4/mktime.m4
@@ -1,6 +1,6 @@
-# serial 31
-dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software
-dnl Foundation, Inc.
+# serial 35
+dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software Foundation,
+dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -31,17 +31,16 @@ AC_DEFUN([gl_FUNC_MKTIME_WORKS],
dnl in Autoconf and because it invokes AC_LIBOBJ.
AC_CHECK_HEADERS_ONCE([unistd.h])
AC_CHECK_DECLS_ONCE([alarm])
- AC_CHECK_FUNCS_ONCE([tzset])
AC_REQUIRE([gl_MULTIARCH])
- if test $APPLE_UNIVERSAL_BUILD = 1; then
- # A universal build on Apple Mac OS X platforms.
- # The test result would be 'yes' in 32-bit mode and 'no' in 64-bit mode.
- # But we need a configuration result that is valid in both modes.
- gl_cv_func_working_mktime=no
- fi
AC_CACHE_CHECK([for working mktime], [gl_cv_func_working_mktime],
- [AC_RUN_IFELSE(
- [AC_LANG_SOURCE(
+ [if test $APPLE_UNIVERSAL_BUILD = 1; then
+ # A universal build on Apple Mac OS X platforms.
+ # The test result would be 'yes' in 32-bit mode and 'no' in 64-bit mode.
+ # But we need a configuration result that is valid in both modes.
+ gl_cv_func_working_mktime="guessing no"
+ else
+ AC_RUN_IFELSE(
+ [AC_LANG_SOURCE(
[[/* Test program from Paul Eggert and Tony Leneis. */
#include <limits.h>
#include <stdlib.h>
@@ -55,13 +54,12 @@ AC_DEFUN([gl_FUNC_MKTIME_WORKS],
# include <signal.h>
#endif
+]GL_MDA_DEFINES[
+
#ifndef TIME_T_IS_SIGNED
# define TIME_T_IS_SIGNED 0
#endif
-/* Work around redefinition to rpl_putenv by other config tests. */
-#undef putenv
-
static time_t time_t_max;
static time_t time_t_min;
@@ -242,14 +240,15 @@ main ()
result |= 64;
return result;
}]])],
- [gl_cv_func_working_mktime=yes],
- [gl_cv_func_working_mktime=no],
- [case "$host_os" in
- # Guess no on native Windows.
- mingw*) gl_cv_func_working_mktime="guessing no" ;;
- *) gl_cv_func_working_mktime="$gl_cross_guess_normal" ;;
- esac
- ])
+ [gl_cv_func_working_mktime=yes],
+ [gl_cv_func_working_mktime=no],
+ [case "$host_os" in
+ # Guess no on native Windows.
+ mingw*) gl_cv_func_working_mktime="guessing no" ;;
+ *) gl_cv_func_working_mktime="$gl_cross_guess_normal" ;;
+ esac
+ ])
+ fi
])
])
diff --git a/m4/multiarch.m4 b/m4/multiarch.m4
index 3c2034c5e00..2c61afbd76e 100644
--- a/m4/multiarch.m4
+++ b/m4/multiarch.m4
@@ -1,4 +1,4 @@
-# multiarch.m4 serial 7
+# multiarch.m4 serial 9
dnl Copyright (C) 2008-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -21,37 +21,40 @@ dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN_ONCE([gl_MULTIARCH],
[
dnl Code similar to autoconf-2.63 AC_C_BIGENDIAN.
- gl_cv_c_multiarch=no
- AC_COMPILE_IFELSE(
- [AC_LANG_SOURCE(
- [[#ifndef __APPLE_CC__
- not a universal capable compiler
- #endif
- typedef int dummy;
- ]])],
- [
- dnl Check for potential -arch flags. It is not universal unless
- dnl there are at least two -arch flags with different values.
- arch=
- prev=
- for word in ${CC} ${CFLAGS} ${CPPFLAGS} ${LDFLAGS}; do
- if test -n "$prev"; then
- case $word in
- i?86 | x86_64 | ppc | ppc64)
- if test -z "$arch" || test "$arch" = "$word"; then
- arch="$word"
- else
- gl_cv_c_multiarch=yes
- fi
- ;;
- esac
- prev=
- else
- if test "x$word" = "x-arch"; then
- prev=arch
- fi
- fi
- done
+ AC_CACHE_CHECK([whether the compiler produces multi-arch binaries],
+ [gl_cv_c_multiarch],
+ [gl_cv_c_multiarch=no
+ AC_COMPILE_IFELSE(
+ [AC_LANG_SOURCE(
+ [[#ifndef __APPLE_CC__
+ not a universal capable compiler
+ #endif
+ typedef int dummy;
+ ]])],
+ [
+ dnl Check for potential -arch flags. It is not universal unless
+ dnl there are at least two -arch flags with different values.
+ arch=
+ prev=
+ for word in ${CC} ${CFLAGS} ${CPPFLAGS} ${LDFLAGS}; do
+ if test -n "$prev"; then
+ case $word in
+ i?86 | x86_64 | ppc | ppc64 | arm | arm64)
+ if test -z "$arch" || test "$arch" = "$word"; then
+ arch="$word"
+ else
+ gl_cv_c_multiarch=yes
+ fi
+ ;;
+ esac
+ prev=
+ else
+ if test "x$word" = "x-arch"; then
+ prev=arch
+ fi
+ fi
+ done
+ ])
])
if test $gl_cv_c_multiarch = yes; then
APPLE_UNIVERSAL_BUILD=1
diff --git a/m4/nstrftime.m4 b/m4/nstrftime.m4
index ec41d42f4ba..e4eb87de0b9 100644
--- a/m4/nstrftime.m4
+++ b/m4/nstrftime.m4
@@ -1,7 +1,6 @@
-# serial 34
+# serial 36
-# Copyright (C) 1996-1997, 1999-2007, 2009-2020 Free Software
-# Foundation, Inc.
+# Copyright (C) 1996-1997, 1999-2007, 2009-2020 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -11,13 +10,13 @@
AC_DEFUN([gl_FUNC_GNU_STRFTIME],
[
+ AC_REQUIRE([AC_C_RESTRICT])
+
# This defines (or not) HAVE_TZNAME and HAVE_TM_ZONE.
AC_REQUIRE([AC_STRUCT_TIMEZONE])
AC_REQUIRE([gl_TM_GMTOFF])
- AC_CHECK_FUNCS_ONCE([tzset])
-
AC_DEFINE([my_strftime], [nstrftime],
[Define to the name of the strftime replacement function.])
])
diff --git a/m4/open-slash.m4 b/m4/open-slash.m4
index 1e57c96960e..5d84f2b548a 100644
--- a/m4/open-slash.m4
+++ b/m4/open-slash.m4
@@ -1,4 +1,4 @@
-# open-slash.m4 serial 1
+# open-slash.m4 serial 2
dnl Copyright (C) 2007-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -25,6 +25,7 @@ AC_DEFUN([gl_OPEN_TRAILING_SLASH_BUG],
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
+]GL_MDA_DEFINES[
int main ()
{
int result = 0;
diff --git a/m4/pathmax.m4 b/m4/pathmax.m4
index dc6bc3bceba..bb4fdeba750 100644
--- a/m4/pathmax.m4
+++ b/m4/pathmax.m4
@@ -1,6 +1,6 @@
# pathmax.m4 serial 11
-dnl Copyright (C) 2002-2003, 2005-2006, 2009-2020 Free Software
-dnl Foundation, Inc.
+dnl Copyright (C) 2002-2003, 2005-2006, 2009-2020 Free Software Foundation,
+dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/pselect.m4 b/m4/pselect.m4
index f3e5afe0b38..08a5823c6f9 100644
--- a/m4/pselect.m4
+++ b/m4/pselect.m4
@@ -1,4 +1,4 @@
-# pselect.m4 serial 8
+# pselect.m4 serial 9
dnl Copyright (C) 2011-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -37,7 +37,8 @@ AC_DEFUN([gl_FUNC_PSELECT],
#endif
#include <unistd.h>
#include <errno.h>
-]],[[
+]GL_MDA_DEFINES],
+[[
fd_set set;
dup2(0, 16);
FD_ZERO(&set);
diff --git a/m4/pthread_sigmask.m4 b/m4/pthread_sigmask.m4
index d67511f73dd..030862de015 100644
--- a/m4/pthread_sigmask.m4
+++ b/m4/pthread_sigmask.m4
@@ -1,4 +1,4 @@
-# pthread_sigmask.m4 serial 18
+# pthread_sigmask.m4 serial 19
dnl Copyright (C) 2011-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -220,6 +220,7 @@ int main ()
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
+]GL_MDA_DEFINES[
static volatile int sigint_occurred;
static void
sigint_handler (int sig)
diff --git a/m4/putenv.m4 b/m4/putenv.m4
deleted file mode 100644
index e38f8c56940..00000000000
--- a/m4/putenv.m4
+++ /dev/null
@@ -1,60 +0,0 @@
-# putenv.m4 serial 24
-dnl Copyright (C) 2002-2020 Free Software Foundation, Inc.
-dnl This file is free software; the Free Software Foundation
-dnl gives unlimited permission to copy and/or distribute it,
-dnl with or without modifications, as long as this notice is preserved.
-
-dnl From Jim Meyering.
-dnl
-dnl Check whether putenv ("FOO") removes FOO from the environment.
-dnl The putenv in libc on at least SunOS 4.1.4 does *not* do that.
-
-AC_DEFUN([gl_FUNC_PUTENV],
-[
- AC_REQUIRE([gl_STDLIB_H_DEFAULTS])
- AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
- AC_CACHE_CHECK([for putenv compatible with GNU and SVID],
- [gl_cv_func_svid_putenv],
- [AC_RUN_IFELSE([AC_LANG_PROGRAM([AC_INCLUDES_DEFAULT],[[
- /* Put it in env. */
- if (putenv ("CONFTEST_putenv=val"))
- return 1;
-
- /* Try to remove it. */
- if (putenv ("CONFTEST_putenv"))
- return 2;
-
- /* Make sure it was deleted. */
- if (getenv ("CONFTEST_putenv") != 0)
- return 3;
-
- return 0;
- ]])],
- gl_cv_func_svid_putenv=yes,
- gl_cv_func_svid_putenv=no,
- dnl When crosscompiling, assume putenv is broken.
- [case "$host_os" in
- # Guess yes on glibc systems.
- *-gnu* | gnu*) gl_cv_func_svid_putenv="guessing yes" ;;
- # Guess yes on musl systems.
- *-musl*) gl_cv_func_svid_putenv="guessing yes" ;;
- # Guess no on native Windows.
- mingw*) gl_cv_func_svid_putenv="guessing no" ;;
- # If we don't know, obey --enable-cross-guesses.
- *) gl_cv_func_svid_putenv="$gl_cross_guess_normal" ;;
- esac
- ])
- ])
- case "$gl_cv_func_svid_putenv" in
- *yes) ;;
- *)
- REPLACE_PUTENV=1
- ;;
- esac
-])
-
-# Prerequisites of lib/putenv.c.
-AC_DEFUN([gl_PREREQ_PUTENV],
-[
- AC_CHECK_DECLS([_putenv])
-])
diff --git a/m4/regex.m4 b/m4/regex.m4
index 65f518582c1..e723f591216 100644
--- a/m4/regex.m4
+++ b/m4/regex.m4
@@ -1,4 +1,4 @@
-# serial 69
+# serial 70
# Copyright (C) 1996-2001, 2003-2020 Free Software Foundation, Inc.
#
@@ -90,11 +90,14 @@ AC_DEFUN([gl_REGEX],
s = re_compile_pattern (pat, sizeof pat - 1, &regex);
if (s)
result |= 1;
- else if (re_search (&regex, data, sizeof data - 1,
- 0, sizeof data - 1, &regs)
- != -1)
- result |= 1;
- regfree (&regex);
+ else
+ {
+ if (re_search (&regex, data, sizeof data - 1,
+ 0, sizeof data - 1, &regs)
+ != -1)
+ result |= 1;
+ regfree (&regex);
+ }
}
{
@@ -125,8 +128,8 @@ AC_DEFUN([gl_REGEX],
0, sizeof data - 1, 0);
if (i != 0 && i != 21)
result |= 1;
+ regfree (&regex);
}
- regfree (&regex);
}
if (! setlocale (LC_ALL, "C"))
@@ -139,9 +142,13 @@ AC_DEFUN([gl_REGEX],
s = re_compile_pattern ("a[^x]b", 6, &regex);
if (s)
result |= 2;
- /* This should fail, but succeeds for glibc-2.5. */
- else if (re_search (&regex, "a\nb", 3, 0, 3, &regs) != -1)
- result |= 2;
+ else
+ {
+ /* This should fail, but succeeds for glibc-2.5. */
+ if (re_search (&regex, "a\nb", 3, 0, 3, &regs) != -1)
+ result |= 2;
+ regfree (&regex);
+ }
/* This regular expression is from Spencer ere test number 75
in grep-2.3. */
@@ -153,7 +160,10 @@ AC_DEFUN([gl_REGEX],
s = re_compile_pattern ("a[[:@:>@:]]b\n", 11, &regex);
/* This should fail with _Invalid character class name_ error. */
if (!s)
- result |= 4;
+ {
+ result |= 4;
+ regfree (&regex);
+ }
/* Ensure that [b-a] is diagnosed as invalid, when
using RE_NO_EMPTY_RANGES. */
@@ -161,13 +171,18 @@ AC_DEFUN([gl_REGEX],
memset (&regex, 0, sizeof regex);
s = re_compile_pattern ("a[b-a]", 6, &regex);
if (s == 0)
- result |= 8;
+ {
+ result |= 8;
+ regfree (&regex);
+ }
/* This should succeed, but does not for glibc-2.1.3. */
memset (&regex, 0, sizeof regex);
s = re_compile_pattern ("{1", 2, &regex);
if (s)
result |= 8;
+ else
+ regfree (&regex);
/* The following example is derived from a problem report
against gawk from Jorge Stolfi <stolfi@ic.unicamp.br>. */
@@ -175,17 +190,35 @@ AC_DEFUN([gl_REGEX],
s = re_compile_pattern ("[an\371]*n", 7, &regex);
if (s)
result |= 8;
- /* This should match, but does not for glibc-2.2.1. */
- else if (re_match (&regex, "an", 2, 0, &regs) != 2)
- result |= 8;
+ else
+ {
+ /* This should match, but does not for glibc-2.2.1. */
+ if (re_match (&regex, "an", 2, 0, &regs) != 2)
+ result |= 8;
+ else
+ {
+ free (regs.start);
+ free (regs.end);
+ }
+ regfree (&regex);
+ }
memset (&regex, 0, sizeof regex);
s = re_compile_pattern ("x", 1, &regex);
if (s)
result |= 8;
- /* glibc-2.2.93 does not work with a negative RANGE argument. */
- else if (re_search (&regex, "wxy", 3, 2, -2, &regs) != 1)
- result |= 8;
+ else
+ {
+ /* glibc-2.2.93 does not work with a negative RANGE argument. */
+ if (re_search (&regex, "wxy", 3, 2, -2, &regs) != 1)
+ result |= 8;
+ else
+ {
+ free (regs.start);
+ free (regs.end);
+ }
+ regfree (&regex);
+ }
/* The version of regex.c in older versions of gnulib
ignored RE_ICASE. Detect that problem too. */
@@ -194,8 +227,17 @@ AC_DEFUN([gl_REGEX],
s = re_compile_pattern ("x", 1, &regex);
if (s)
result |= 16;
- else if (re_search (&regex, "WXY", 3, 0, 3, &regs) < 0)
- result |= 16;
+ else
+ {
+ if (re_search (&regex, "WXY", 3, 0, 3, &regs) < 0)
+ result |= 16;
+ else
+ {
+ free (regs.start);
+ free (regs.end);
+ }
+ regfree (&regex);
+ }
/* Catch a bug reported by Vin Shelton in
https://lists.gnu.org/r/bug-coreutils/2007-06/msg00089.html
@@ -207,6 +249,8 @@ AC_DEFUN([gl_REGEX],
s = re_compile_pattern ("[[:alnum:]_-]\\\\+$", 16, &regex);
if (s)
result |= 32;
+ else
+ regfree (&regex);
/* REG_STARTEND was added to glibc on 2004-01-15.
Reject older versions. */
@@ -221,8 +265,14 @@ AC_DEFUN([gl_REGEX],
re_set_syntax (RE_SYNTAX_POSIX_EGREP);
memset (&regex, 0, sizeof regex);
s = re_compile_pattern ("0|()0|\\1|0", 10, &regex);
- if (!s || strcmp (s, "Invalid back reference"))
+ if (!s)
result |= 64;
+ else
+ {
+ if (strcmp (s, "Invalid back reference"))
+ result |= 64;
+ regfree (&regex);
+ }
#if 0
/* It would be nice to reject hosts whose regoff_t values are too
diff --git a/m4/sig2str.m4 b/m4/sig2str.m4
index c9b1a860a17..415290c4dee 100644
--- a/m4/sig2str.m4
+++ b/m4/sig2str.m4
@@ -1,6 +1,5 @@
# serial 7
-dnl Copyright (C) 2002, 2005-2006, 2009-2020 Free Software Foundation,
-dnl Inc.
+dnl Copyright (C) 2002, 2005-2006, 2009-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/sigdescr_np.m4 b/m4/sigdescr_np.m4
new file mode 100644
index 00000000000..f0f3f979e83
--- /dev/null
+++ b/m4/sigdescr_np.m4
@@ -0,0 +1,17 @@
+# sigdescr_np.m4 serial 1
+dnl Copyright (C) 2020 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_SIGDESCR_NP],
+[
+ dnl Persuade glibc <string.h> to declare sigdescr_np().
+ AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
+
+ AC_REQUIRE([gl_HEADER_STRING_H_DEFAULTS])
+ AC_CHECK_FUNCS([sigdescr_np])
+ if test $ac_cv_func_sigdescr_np = no; then
+ HAVE_SIGDESCR_NP=0
+ fi
+])
diff --git a/m4/signal_h.m4 b/m4/signal_h.m4
index 08684384314..b2629809f18 100644
--- a/m4/signal_h.m4
+++ b/m4/signal_h.m4
@@ -1,4 +1,4 @@
-# signal_h.m4 serial 18
+# signal_h.m4 serial 19
dnl Copyright (C) 2007-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -34,6 +34,8 @@ AC_DEFUN([gl_SIGNAL_H],
]], [pthread_sigmask sigaction
sigaddset sigdelset sigemptyset sigfillset sigismember
sigpending sigprocmask])
+
+ AC_REQUIRE([AC_C_RESTRICT])
])
AC_DEFUN([gl_CHECK_TYPE_SIGSET_T],
diff --git a/m4/ssize_t.m4 b/m4/ssize_t.m4
index b77032b47a3..6c0a588873c 100644
--- a/m4/ssize_t.m4
+++ b/m4/ssize_t.m4
@@ -1,6 +1,5 @@
# ssize_t.m4 serial 5 (gettext-0.18.2)
-dnl Copyright (C) 2001-2003, 2006, 2010-2020 Free Software Foundation,
-dnl Inc.
+dnl Copyright (C) 2001-2003, 2006, 2010-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/st_dm_mode.m4 b/m4/st_dm_mode.m4
index 9c44ae73dc1..5dad161c3b2 100644
--- a/m4/st_dm_mode.m4
+++ b/m4/st_dm_mode.m4
@@ -1,7 +1,6 @@
# serial 6
-# Copyright (C) 1998-1999, 2001, 2009-2020 Free Software Foundation,
-# Inc.
+# Copyright (C) 1998-1999, 2001, 2009-2020 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/stat-time.m4 b/m4/stat-time.m4
index 59bd29f91ac..0ac3f7272e3 100644
--- a/m4/stat-time.m4
+++ b/m4/stat-time.m4
@@ -1,7 +1,7 @@
# Checks for stat-related time functions.
-# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2020 Free
-# Software Foundation, Inc.
+# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2020 Free Software
+# Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/std-gnu11.m4 b/m4/std-gnu11.m4
index c1ec624b3b3..db833d820f3 100644
--- a/m4/std-gnu11.m4
+++ b/m4/std-gnu11.m4
@@ -70,7 +70,7 @@ _AS_ECHO_LOG([checking for _AC_LANG compiler version])
set X $ac_compile
ac_compiler=$[2]
for ac_option in --version -v -V -qversion -version; do
- m4_ifdef([_AC_DO_LIMIT],[_AC_DO_LIMIT],[_AC_DO])([$ac_compiler $ac_option >&AS_MESSAGE_LOG_FD])
+ _AC_DO_LIMIT([$ac_compiler $ac_option >&AS_MESSAGE_LOG_FD])
done
m4_expand_once([_AC_COMPILER_EXEEXT])[]dnl
@@ -135,7 +135,7 @@ _AS_ECHO_LOG([checking for _AC_LANG compiler version])
set X $ac_compile
ac_compiler=$[2]
for ac_option in --version -v -V -qversion; do
- m4_ifdef([_AC_DO_LIMIT],[_AC_DO_LIMIT],[_AC_DO])([$ac_compiler $ac_option >&AS_MESSAGE_LOG_FD])
+ _AC_DO_LIMIT([$ac_compiler $ac_option >&AS_MESSAGE_LOG_FD])
done
m4_expand_once([_AC_COMPILER_EXEEXT])[]dnl
diff --git a/m4/stddef_h.m4 b/m4/stddef_h.m4
index 6bcfadb74ef..d8bc8ff64e4 100644
--- a/m4/stddef_h.m4
+++ b/m4/stddef_h.m4
@@ -1,5 +1,5 @@
dnl A placeholder for <stddef.h>, for platforms that have issues.
-# stddef_h.m4 serial 6
+# stddef_h.m4 serial 7
dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -19,7 +19,7 @@ AC_DEFUN([gl_STDDEF_H],
[AC_LANG_PROGRAM(
[[#include <stddef.h>
unsigned int s = sizeof (max_align_t);
- #if defined __GNUC__ || defined __IBM__ALIGNOF__
+ #if defined __GNUC__ || defined __clang__ || defined __IBM__ALIGNOF__
int check1[2 * (__alignof__ (double) <= __alignof__ (max_align_t)) - 1];
int check2[2 * (__alignof__ (long double) <= __alignof__ (max_align_t)) - 1];
#endif
diff --git a/m4/stdint.m4 b/m4/stdint.m4
index 3f75a18f32c..d5f5d6133a9 100644
--- a/m4/stdint.m4
+++ b/m4/stdint.m4
@@ -1,4 +1,4 @@
-# stdint.m4 serial 53
+# stdint.m4 serial 56
dnl Copyright (C) 2001-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -17,21 +17,12 @@ AC_DEFUN_ONCE([gl_STDINT_H],
AC_REQUIRE([gl_LIMITS_H])
AC_REQUIRE([gt_TYPE_WINT_T])
- dnl Check for long long int and unsigned long long int.
- AC_REQUIRE([AC_TYPE_LONG_LONG_INT])
- if test $ac_cv_type_long_long_int = yes; then
- HAVE_LONG_LONG_INT=1
- else
- HAVE_LONG_LONG_INT=0
- fi
- AC_SUBST([HAVE_LONG_LONG_INT])
- AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT])
- if test $ac_cv_type_unsigned_long_long_int = yes; then
- HAVE_UNSIGNED_LONG_LONG_INT=1
- else
- HAVE_UNSIGNED_LONG_LONG_INT=0
- fi
- AC_SUBST([HAVE_UNSIGNED_LONG_LONG_INT])
+ dnl For backward compatibility. Some packages may still be testing these
+ dnl macros.
+ AC_DEFINE([HAVE_LONG_LONG_INT], [1],
+ [Define to 1 if the system has the type 'long long int'.])
+ AC_DEFINE([HAVE_UNSIGNED_LONG_LONG_INT], [1],
+ [Define to 1 if the system has the type 'unsigned long long int'.])
dnl Check for <wchar.h>, in the same way as gl_WCHAR_H does.
AC_CHECK_HEADERS_ONCE([wchar.h])
@@ -161,7 +152,7 @@ uintmax_t j = UINTMAX_MAX;
/* Check that SIZE_MAX has the correct type, if possible. */
#if 201112 <= __STDC_VERSION__
int k = _Generic (SIZE_MAX, size_t: 0);
-#elif (2 <= __GNUC__ || defined __IBM__TYPEOF__ \
+#elif (2 <= __GNUC__ || 4 <= __clang_major__ || defined __IBM__TYPEOF__ \
|| (0x5110 <= __SUNPRO_C && !__STDC__))
extern size_t k;
extern __typeof__ (SIZE_MAX) k;
@@ -311,9 +302,10 @@ static const char *macro_values[] =
HAVE_C99_STDINT_H=1
dnl Now see whether the system <stdint.h> works without
dnl __STDC_CONSTANT_MACROS/__STDC_LIMIT_MACROS defined.
- AC_CACHE_CHECK([whether stdint.h predates C++11],
- [gl_cv_header_stdint_predates_cxx11_h],
- [gl_cv_header_stdint_predates_cxx11_h=yes
+ dnl If not, there would be problems when stdint.h is included from C++.
+ AC_CACHE_CHECK([whether stdint.h works without ISO C predefines],
+ [gl_cv_header_stdint_without_STDC_macros],
+ [gl_cv_header_stdint_without_STDC_macros=no
AC_COMPILE_IFELSE([
AC_LANG_PROGRAM([[
#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */
@@ -324,13 +316,14 @@ gl_STDINT_INCLUDES
intmax_t im = INTMAX_MAX;
int32_t i32 = INT32_C (0x7fffffff);
]])],
- [gl_cv_header_stdint_predates_cxx11_h=no])])
+ [gl_cv_header_stdint_without_STDC_macros=yes])
+ ])
- if test "$gl_cv_header_stdint_predates_cxx11_h" = yes; then
+ if test $gl_cv_header_stdint_without_STDC_macros = no; then
AC_DEFINE([__STDC_CONSTANT_MACROS], [1],
- [Define to 1 if the system <stdint.h> predates C++11.])
+ [Define to 1 if the system <stdint.h> predates C++11.])
AC_DEFINE([__STDC_LIMIT_MACROS], [1],
- [Define to 1 if the system <stdint.h> predates C++11.])
+ [Define to 1 if the system <stdint.h> predates C++11.])
fi
AC_CACHE_CHECK([whether stdint.h has UINTMAX_WIDTH etc.],
[gl_cv_header_stdint_width],
diff --git a/m4/stdio_h.m4 b/m4/stdio_h.m4
index c603b514d96..5f968bc26a5 100644
--- a/m4/stdio_h.m4
+++ b/m4/stdio_h.m4
@@ -1,4 +1,4 @@
-# stdio_h.m4 serial 49
+# stdio_h.m4 serial 50
dnl Copyright (C) 2007-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -107,6 +107,8 @@ AC_DEFUN([gl_STDIO_H],
gl_WARN_ON_USE_PREPARE([[#include <stdio.h>
]], [dprintf fpurge fseeko ftello getdelim getline gets pclose popen
renameat snprintf tmpfile vdprintf vsnprintf])
+
+ AC_REQUIRE([AC_C_RESTRICT])
])
AC_DEFUN([gl_STDIO_MODULE_INDICATOR],
diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4
index 61a3e31edac..743066a6336 100644
--- a/m4/stdlib_h.m4
+++ b/m4/stdlib_h.m4
@@ -1,4 +1,4 @@
-# stdlib_h.m4 serial 48
+# stdlib_h.m4 serial 49
dnl Copyright (C) 2007-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -27,6 +27,8 @@ AC_DEFUN([gl_STDLIB_H],
posix_openpt ptsname ptsname_r qsort_r random random_r reallocarray
realpath rpmatch secure_getenv setenv setstate setstate_r srandom
srandom_r strtod strtold strtoll strtoull unlockpt unsetenv])
+
+ AC_REQUIRE([AC_C_RESTRICT])
])
AC_DEFUN([gl_STDLIB_MODULE_INDICATOR],
diff --git a/m4/string_h.m4 b/m4/string_h.m4
index 4c1f685eabd..29796b8629f 100644
--- a/m4/string_h.m4
+++ b/m4/string_h.m4
@@ -5,7 +5,7 @@
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
-# serial 22
+# serial 27
# Written by Paul Eggert.
@@ -18,7 +18,6 @@ AC_DEFUN([gl_HEADER_STRING_H],
AC_DEFUN([gl_HEADER_STRING_H_BODY],
[
- AC_REQUIRE([AC_C_RESTRICT])
AC_REQUIRE([gl_HEADER_STRING_H_DEFAULTS])
gl_NEXT_HEADERS([string.h])
@@ -29,7 +28,9 @@ AC_DEFUN([gl_HEADER_STRING_H_BODY],
]],
[ffsl ffsll memmem mempcpy memrchr rawmemchr stpcpy stpncpy strchrnul
strdup strncat strndup strnlen strpbrk strsep strcasestr strtok_r
- strerror_r strsignal strverscmp])
+ strerror_r strerrorname_np sigabbrev_np sigdescr_np strsignal strverscmp])
+
+ AC_REQUIRE([AC_C_RESTRICT])
])
AC_DEFUN([gl_STRING_MODULE_INDICATOR],
@@ -43,50 +44,52 @@ AC_DEFUN([gl_STRING_MODULE_INDICATOR],
AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS],
[
- GNULIB_EXPLICIT_BZERO=0; AC_SUBST([GNULIB_EXPLICIT_BZERO])
- GNULIB_FFSL=0; AC_SUBST([GNULIB_FFSL])
- GNULIB_FFSLL=0; AC_SUBST([GNULIB_FFSLL])
- GNULIB_MEMCHR=0; AC_SUBST([GNULIB_MEMCHR])
- GNULIB_MEMMEM=0; AC_SUBST([GNULIB_MEMMEM])
- GNULIB_MEMPCPY=0; AC_SUBST([GNULIB_MEMPCPY])
- GNULIB_MEMRCHR=0; AC_SUBST([GNULIB_MEMRCHR])
- GNULIB_RAWMEMCHR=0; AC_SUBST([GNULIB_RAWMEMCHR])
- GNULIB_STPCPY=0; AC_SUBST([GNULIB_STPCPY])
- GNULIB_STPNCPY=0; AC_SUBST([GNULIB_STPNCPY])
- GNULIB_STRCHRNUL=0; AC_SUBST([GNULIB_STRCHRNUL])
- GNULIB_STRDUP=0; AC_SUBST([GNULIB_STRDUP])
- GNULIB_STRNCAT=0; AC_SUBST([GNULIB_STRNCAT])
- GNULIB_STRNDUP=0; AC_SUBST([GNULIB_STRNDUP])
- GNULIB_STRNLEN=0; AC_SUBST([GNULIB_STRNLEN])
- GNULIB_STRPBRK=0; AC_SUBST([GNULIB_STRPBRK])
- GNULIB_STRSEP=0; AC_SUBST([GNULIB_STRSEP])
- GNULIB_STRSTR=0; AC_SUBST([GNULIB_STRSTR])
- GNULIB_STRCASESTR=0; AC_SUBST([GNULIB_STRCASESTR])
- GNULIB_STRTOK_R=0; AC_SUBST([GNULIB_STRTOK_R])
- GNULIB_MBSLEN=0; AC_SUBST([GNULIB_MBSLEN])
- GNULIB_MBSNLEN=0; AC_SUBST([GNULIB_MBSNLEN])
- GNULIB_MBSCHR=0; AC_SUBST([GNULIB_MBSCHR])
- GNULIB_MBSRCHR=0; AC_SUBST([GNULIB_MBSRCHR])
- GNULIB_MBSSTR=0; AC_SUBST([GNULIB_MBSSTR])
- GNULIB_MBSCASECMP=0; AC_SUBST([GNULIB_MBSCASECMP])
- GNULIB_MBSNCASECMP=0; AC_SUBST([GNULIB_MBSNCASECMP])
- GNULIB_MBSPCASECMP=0; AC_SUBST([GNULIB_MBSPCASECMP])
- GNULIB_MBSCASESTR=0; AC_SUBST([GNULIB_MBSCASESTR])
- GNULIB_MBSCSPN=0; AC_SUBST([GNULIB_MBSCSPN])
- GNULIB_MBSPBRK=0; AC_SUBST([GNULIB_MBSPBRK])
- GNULIB_MBSSPN=0; AC_SUBST([GNULIB_MBSSPN])
- GNULIB_MBSSEP=0; AC_SUBST([GNULIB_MBSSEP])
- GNULIB_MBSTOK_R=0; AC_SUBST([GNULIB_MBSTOK_R])
- GNULIB_STRERROR=0; AC_SUBST([GNULIB_STRERROR])
- GNULIB_STRERROR_R=0; AC_SUBST([GNULIB_STRERROR_R])
- GNULIB_STRSIGNAL=0; AC_SUBST([GNULIB_STRSIGNAL])
- GNULIB_STRVERSCMP=0; AC_SUBST([GNULIB_STRVERSCMP])
- HAVE_MBSLEN=0; AC_SUBST([HAVE_MBSLEN])
+ GNULIB_EXPLICIT_BZERO=0; AC_SUBST([GNULIB_EXPLICIT_BZERO])
+ GNULIB_FFSL=0; AC_SUBST([GNULIB_FFSL])
+ GNULIB_FFSLL=0; AC_SUBST([GNULIB_FFSLL])
+ GNULIB_MEMCHR=0; AC_SUBST([GNULIB_MEMCHR])
+ GNULIB_MEMMEM=0; AC_SUBST([GNULIB_MEMMEM])
+ GNULIB_MEMPCPY=0; AC_SUBST([GNULIB_MEMPCPY])
+ GNULIB_MEMRCHR=0; AC_SUBST([GNULIB_MEMRCHR])
+ GNULIB_RAWMEMCHR=0; AC_SUBST([GNULIB_RAWMEMCHR])
+ GNULIB_STPCPY=0; AC_SUBST([GNULIB_STPCPY])
+ GNULIB_STPNCPY=0; AC_SUBST([GNULIB_STPNCPY])
+ GNULIB_STRCHRNUL=0; AC_SUBST([GNULIB_STRCHRNUL])
+ GNULIB_STRDUP=0; AC_SUBST([GNULIB_STRDUP])
+ GNULIB_STRNCAT=0; AC_SUBST([GNULIB_STRNCAT])
+ GNULIB_STRNDUP=0; AC_SUBST([GNULIB_STRNDUP])
+ GNULIB_STRNLEN=0; AC_SUBST([GNULIB_STRNLEN])
+ GNULIB_STRPBRK=0; AC_SUBST([GNULIB_STRPBRK])
+ GNULIB_STRSEP=0; AC_SUBST([GNULIB_STRSEP])
+ GNULIB_STRSTR=0; AC_SUBST([GNULIB_STRSTR])
+ GNULIB_STRCASESTR=0; AC_SUBST([GNULIB_STRCASESTR])
+ GNULIB_STRTOK_R=0; AC_SUBST([GNULIB_STRTOK_R])
+ GNULIB_MBSLEN=0; AC_SUBST([GNULIB_MBSLEN])
+ GNULIB_MBSNLEN=0; AC_SUBST([GNULIB_MBSNLEN])
+ GNULIB_MBSCHR=0; AC_SUBST([GNULIB_MBSCHR])
+ GNULIB_MBSRCHR=0; AC_SUBST([GNULIB_MBSRCHR])
+ GNULIB_MBSSTR=0; AC_SUBST([GNULIB_MBSSTR])
+ GNULIB_MBSCASECMP=0; AC_SUBST([GNULIB_MBSCASECMP])
+ GNULIB_MBSNCASECMP=0; AC_SUBST([GNULIB_MBSNCASECMP])
+ GNULIB_MBSPCASECMP=0; AC_SUBST([GNULIB_MBSPCASECMP])
+ GNULIB_MBSCASESTR=0; AC_SUBST([GNULIB_MBSCASESTR])
+ GNULIB_MBSCSPN=0; AC_SUBST([GNULIB_MBSCSPN])
+ GNULIB_MBSPBRK=0; AC_SUBST([GNULIB_MBSPBRK])
+ GNULIB_MBSSPN=0; AC_SUBST([GNULIB_MBSSPN])
+ GNULIB_MBSSEP=0; AC_SUBST([GNULIB_MBSSEP])
+ GNULIB_MBSTOK_R=0; AC_SUBST([GNULIB_MBSTOK_R])
+ GNULIB_STRERROR=0; AC_SUBST([GNULIB_STRERROR])
+ GNULIB_STRERROR_R=0; AC_SUBST([GNULIB_STRERROR_R])
+ GNULIB_STRERRORNAME_NP=0; AC_SUBST([GNULIB_STRERRORNAME_NP])
+ GNULIB_SIGABBREV_NP=0; AC_SUBST([GNULIB_SIGABBREV_NP])
+ GNULIB_SIGDESCR_NP=0; AC_SUBST([GNULIB_SIGDESCR_NP])
+ GNULIB_STRSIGNAL=0; AC_SUBST([GNULIB_STRSIGNAL])
+ GNULIB_STRVERSCMP=0; AC_SUBST([GNULIB_STRVERSCMP])
+ HAVE_MBSLEN=0; AC_SUBST([HAVE_MBSLEN])
dnl Assume proper GNU behavior unless another module says otherwise.
HAVE_EXPLICIT_BZERO=1; AC_SUBST([HAVE_EXPLICIT_BZERO])
HAVE_FFSL=1; AC_SUBST([HAVE_FFSL])
HAVE_FFSLL=1; AC_SUBST([HAVE_FFSLL])
- HAVE_MEMCHR=1; AC_SUBST([HAVE_MEMCHR])
HAVE_DECL_MEMMEM=1; AC_SUBST([HAVE_DECL_MEMMEM])
HAVE_MEMPCPY=1; AC_SUBST([HAVE_MEMPCPY])
HAVE_DECL_MEMRCHR=1; AC_SUBST([HAVE_DECL_MEMRCHR])
@@ -102,6 +105,9 @@ AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS],
HAVE_STRCASESTR=1; AC_SUBST([HAVE_STRCASESTR])
HAVE_DECL_STRTOK_R=1; AC_SUBST([HAVE_DECL_STRTOK_R])
HAVE_DECL_STRERROR_R=1; AC_SUBST([HAVE_DECL_STRERROR_R])
+ HAVE_STRERRORNAME_NP=1; AC_SUBST([HAVE_STRERRORNAME_NP])
+ HAVE_SIGABBREV_NP=1; AC_SUBST([HAVE_SIGABBREV_NP])
+ HAVE_SIGDESCR_NP=1; AC_SUBST([HAVE_SIGDESCR_NP])
HAVE_DECL_STRSIGNAL=1; AC_SUBST([HAVE_DECL_STRSIGNAL])
HAVE_STRVERSCMP=1; AC_SUBST([HAVE_STRVERSCMP])
REPLACE_MEMCHR=0; AC_SUBST([REPLACE_MEMCHR])
@@ -117,6 +123,7 @@ AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS],
REPLACE_STRTOK_R=0; AC_SUBST([REPLACE_STRTOK_R])
REPLACE_STRERROR=0; AC_SUBST([REPLACE_STRERROR])
REPLACE_STRERROR_R=0; AC_SUBST([REPLACE_STRERROR_R])
+ REPLACE_STRERRORNAME_NP=0; AC_SUBST([REPLACE_STRERRORNAME_NP])
REPLACE_STRSIGNAL=0; AC_SUBST([REPLACE_STRSIGNAL])
UNDEFINE_STRTOK_R=0; AC_SUBST([UNDEFINE_STRTOK_R])
])
diff --git a/m4/strnlen.m4 b/m4/strnlen.m4
index 67d4eb05c03..71b8e1baffe 100644
--- a/m4/strnlen.m4
+++ b/m4/strnlen.m4
@@ -1,6 +1,6 @@
# strnlen.m4 serial 13
-dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software
-dnl Foundation, Inc.
+dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software Foundation,
+dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/strtoimax.m4 b/m4/strtoimax.m4
index de97d75ce67..4958e3dcd50 100644
--- a/m4/strtoimax.m4
+++ b/m4/strtoimax.m4
@@ -1,6 +1,5 @@
-# strtoimax.m4 serial 15
-dnl Copyright (C) 2002-2004, 2006, 2009-2020 Free Software Foundation,
-dnl Inc.
+# strtoimax.m4 serial 16
+dnl Copyright (C) 2002-2004, 2006, 2009-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -86,5 +85,4 @@ int main ()
# Prerequisites of lib/strtoimax.c.
AC_DEFUN([gl_PREREQ_STRTOIMAX], [
AC_CHECK_DECLS([strtoll])
- AC_REQUIRE([AC_TYPE_LONG_LONG_INT])
])
diff --git a/m4/strtoll.m4 b/m4/strtoll.m4
index af962836ec6..edcde3b5582 100644
--- a/m4/strtoll.m4
+++ b/m4/strtoll.m4
@@ -1,6 +1,5 @@
-# strtoll.m4 serial 7
-dnl Copyright (C) 2002, 2004, 2006, 2008-2020 Free Software Foundation,
-dnl Inc.
+# strtoll.m4 serial 8
+dnl Copyright (C) 2002, 2004, 2006, 2008-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -8,14 +7,9 @@ dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_FUNC_STRTOLL],
[
AC_REQUIRE([gl_STDLIB_H_DEFAULTS])
- dnl We don't need (and can't compile) the replacement strtoll
- dnl unless the type 'long long int' exists.
- AC_REQUIRE([AC_TYPE_LONG_LONG_INT])
- if test "$ac_cv_type_long_long_int" = yes; then
- AC_CHECK_FUNCS([strtoll])
- if test $ac_cv_func_strtoll = no; then
- HAVE_STRTOLL=0
- fi
+ AC_CHECK_FUNCS([strtoll])
+ if test $ac_cv_func_strtoll = no; then
+ HAVE_STRTOLL=0
fi
])
diff --git a/m4/sys_random_h.m4 b/m4/sys_random_h.m4
new file mode 100644
index 00000000000..8c5d53703be
--- /dev/null
+++ b/m4/sys_random_h.m4
@@ -0,0 +1,53 @@
+# sys_random_h.m4 serial 5
+dnl Copyright (C) 2020 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_HEADER_SYS_RANDOM],
+[
+ AC_REQUIRE([gl_SYS_RANDOM_H_DEFAULTS])
+ dnl <sys/random.h> is always overridden, because of GNULIB_POSIXCHECK.
+ gl_CHECK_NEXT_HEADERS([sys/random.h])
+ if test $ac_cv_header_sys_random_h = yes; then
+ HAVE_SYS_RANDOM_H=1
+ else
+ HAVE_SYS_RANDOM_H=0
+ fi
+ AC_SUBST([HAVE_SYS_RANDOM_H])
+
+ m4_ifdef([gl_UNISTD_H_DEFAULTS], [AC_REQUIRE([gl_UNISTD_H_DEFAULTS])])
+ if test $ac_cv_header_sys_random_h = yes; then
+ UNISTD_H_HAVE_SYS_RANDOM_H=1
+ fi
+
+ dnl Check for declarations of anything we want to poison if the
+ dnl corresponding gnulib module is not in use.
+ gl_WARN_ON_USE_PREPARE([[
+#if HAVE_SYS_RANDOM_H
+/* Additional includes are needed before <sys/random.h> on uClibc
+ and Mac OS X. */
+# include <sys/types.h>
+# include <stdlib.h>
+# include <sys/random.h>
+#endif
+ ]],
+ [getrandom])
+])
+
+AC_DEFUN([gl_SYS_RANDOM_MODULE_INDICATOR],
+[
+ dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+ AC_REQUIRE([gl_SYS_RANDOM_H_DEFAULTS])
+ gl_MODULE_INDICATOR_SET_VARIABLE([$1])
+ dnl Define it also as a C macro, for the benefit of the unit tests.
+ gl_MODULE_INDICATOR_FOR_TESTS([$1])
+])
+
+AC_DEFUN([gl_SYS_RANDOM_H_DEFAULTS],
+[
+ GNULIB_GETRANDOM=0; AC_SUBST([GNULIB_GETRANDOM])
+ dnl Assume proper GNU behavior unless another module says otherwise.
+ HAVE_GETRANDOM=1; AC_SUBST([HAVE_GETRANDOM])
+ REPLACE_GETRANDOM=0; AC_SUBST([REPLACE_GETRANDOM])
+])
diff --git a/m4/sys_socket_h.m4 b/m4/sys_socket_h.m4
index 1471aeaec41..bf902f08108 100644
--- a/m4/sys_socket_h.m4
+++ b/m4/sys_socket_h.m4
@@ -1,4 +1,4 @@
-# sys_socket_h.m4 serial 24
+# sys_socket_h.m4 serial 25
dnl Copyright (C) 2005-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -95,6 +95,8 @@ AC_DEFUN([gl_HEADER_SYS_SOCKET],
#include <sys/socket.h>
]], [socket connect accept bind getpeername getsockname getsockopt
listen recv send recvfrom sendto setsockopt shutdown accept4])
+
+ AC_REQUIRE([AC_C_RESTRICT])
])
AC_DEFUN([gl_PREREQ_SYS_H_SOCKET],
diff --git a/m4/sys_stat_h.m4 b/m4/sys_stat_h.m4
index d63df9ebffd..929144d155b 100644
--- a/m4/sys_stat_h.m4
+++ b/m4/sys_stat_h.m4
@@ -1,4 +1,4 @@
-# sys_stat_h.m4 serial 31 -*- Autoconf -*-
+# sys_stat_h.m4 serial 34 -*- Autoconf -*-
dnl Copyright (C) 2006-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -46,9 +46,11 @@ AC_DEFUN([gl_HEADER_SYS_STAT_H],
dnl Check for declarations of anything we want to poison if the
dnl corresponding gnulib module is not in use.
gl_WARN_ON_USE_PREPARE([[#include <sys/stat.h>
- ]], [fchmodat fstat fstatat futimens lchmod lstat mkdirat mkfifo mkfifoat
- mknod mknodat stat utimensat])
-]) # gl_HEADER_SYS_STAT_H
+ ]], [fchmodat fstat fstatat futimens getumask lchmod lstat
+ mkdirat mkfifo mkfifoat mknod mknodat stat utimensat])
+
+ AC_REQUIRE([AC_C_RESTRICT])
+])
AC_DEFUN([gl_SYS_STAT_MODULE_INDICATOR],
[
@@ -66,6 +68,7 @@ AC_DEFUN([gl_SYS_STAT_H_DEFAULTS],
GNULIB_FSTAT=0; AC_SUBST([GNULIB_FSTAT])
GNULIB_FSTATAT=0; AC_SUBST([GNULIB_FSTATAT])
GNULIB_FUTIMENS=0; AC_SUBST([GNULIB_FUTIMENS])
+ GNULIB_GETUMASK=0; AC_SUBST([GNULIB_GETUMASK])
GNULIB_LCHMOD=0; AC_SUBST([GNULIB_LCHMOD])
GNULIB_LSTAT=0; AC_SUBST([GNULIB_LSTAT])
GNULIB_MKDIRAT=0; AC_SUBST([GNULIB_MKDIRAT])
@@ -80,6 +83,7 @@ AC_DEFUN([gl_SYS_STAT_H_DEFAULTS],
HAVE_FCHMODAT=1; AC_SUBST([HAVE_FCHMODAT])
HAVE_FSTATAT=1; AC_SUBST([HAVE_FSTATAT])
HAVE_FUTIMENS=1; AC_SUBST([HAVE_FUTIMENS])
+ HAVE_GETUMASK=1; AC_SUBST([HAVE_GETUMASK])
HAVE_LCHMOD=1; AC_SUBST([HAVE_LCHMOD])
HAVE_LSTAT=1; AC_SUBST([HAVE_LSTAT])
HAVE_MKDIRAT=1; AC_SUBST([HAVE_MKDIRAT])
@@ -88,6 +92,7 @@ AC_DEFUN([gl_SYS_STAT_H_DEFAULTS],
HAVE_MKNOD=1; AC_SUBST([HAVE_MKNOD])
HAVE_MKNODAT=1; AC_SUBST([HAVE_MKNODAT])
HAVE_UTIMENSAT=1; AC_SUBST([HAVE_UTIMENSAT])
+ REPLACE_FCHMODAT=0; AC_SUBST([REPLACE_FCHMODAT])
REPLACE_FSTAT=0; AC_SUBST([REPLACE_FSTAT])
REPLACE_FSTATAT=0; AC_SUBST([REPLACE_FSTATAT])
REPLACE_FUTIMENS=0; AC_SUBST([REPLACE_FUTIMENS])
diff --git a/m4/time_h.m4 b/m4/time_h.m4
index e4fe59084f8..a15c09dc07b 100644
--- a/m4/time_h.m4
+++ b/m4/time_h.m4
@@ -1,9 +1,8 @@
# Configure a more-standard replacement for <time.h>.
-# Copyright (C) 2000-2001, 2003-2007, 2009-2020 Free Software
-# Foundation, Inc.
+# Copyright (C) 2000-2001, 2003-2007, 2009-2020 Free Software Foundation, Inc.
-# serial 11
+# serial 12
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -20,10 +19,12 @@ AC_DEFUN([gl_HEADER_TIME_H],
AC_DEFUN([gl_HEADER_TIME_H_BODY],
[
- AC_REQUIRE([AC_C_RESTRICT])
AC_REQUIRE([gl_HEADER_TIME_H_DEFAULTS])
+
gl_NEXT_HEADERS([time.h])
AC_REQUIRE([gl_CHECK_TYPE_STRUCT_TIMESPEC])
+
+ AC_REQUIRE([AC_C_RESTRICT])
])
dnl Check whether 'struct timespec' is declared
@@ -120,7 +121,6 @@ AC_DEFUN([gl_HEADER_TIME_H_DEFAULTS],
HAVE_NANOSLEEP=1; AC_SUBST([HAVE_NANOSLEEP])
HAVE_STRPTIME=1; AC_SUBST([HAVE_STRPTIME])
HAVE_TIMEGM=1; AC_SUBST([HAVE_TIMEGM])
- HAVE_TZSET=1; AC_SUBST([HAVE_TZSET])
dnl Even GNU libc does not have timezone_t yet.
HAVE_TIMEZONE_T=0; AC_SUBST([HAVE_TIMEZONE_T])
dnl If another module says to replace or to not replace, do that.
diff --git a/m4/time_rz.m4 b/m4/time_rz.m4
index 2dd64b28488..30161c01e63 100644
--- a/m4/time_rz.m4
+++ b/m4/time_rz.m4
@@ -13,12 +13,12 @@ AC_DEFUN([gl_TIME_RZ],
AC_REQUIRE([gl_HEADER_TIME_H_DEFAULTS])
AC_REQUIRE([AC_STRUCT_TIMEZONE])
- # Mac OS X 10.6 loops forever with some time_t values.
+ # On Mac OS X 10.6, localtime loops forever with some time_t values.
# See Bug#27706, Bug#27736, and
# https://lists.gnu.org/r/bug-gnulib/2017-07/msg00142.html
- AC_CACHE_CHECK([whether localtime loops forever near extrema],
- [gl_cv_func_localtime_infloop_bug],
- [gl_cv_func_localtime_infloop_bug=no
+ AC_CACHE_CHECK([whether localtime works even near extrema],
+ [gl_cv_func_localtime_works],
+ [gl_cv_func_localtime_works=yes
AC_RUN_IFELSE(
[AC_LANG_PROGRAM(
[[#include <stdlib.h>
@@ -37,10 +37,10 @@ AC_DEFUN([gl_TIME_RZ],
return tm && tm->tm_isdst;
]])],
[(TZ=QQQ0 ./conftest$EXEEXT) >/dev/null 2>&1 ||
- gl_cv_func_localtime_infloop_bug=yes],
+ gl_cv_func_localtime_works=no],
[],
- [gl_cv_func_localtime_infloop_bug="guessing no"])])
- if test "$gl_cv_func_localtime_infloop_bug" = yes; then
+ [gl_cv_func_localtime_works="guessing yes"])])
+ if test "$gl_cv_func_localtime_works" = no; then
AC_DEFINE([HAVE_LOCALTIME_INFLOOP_BUG], 1,
[Define if localtime-like functions can loop forever on
extreme arguments.])
diff --git a/m4/timespec.m4 b/m4/timespec.m4
index 5ed82b109c6..e71628dc318 100644
--- a/m4/timespec.m4
+++ b/m4/timespec.m4
@@ -1,7 +1,6 @@
#serial 15
-# Copyright (C) 2000-2001, 2003-2007, 2009-2020 Free Software
-# Foundation, Inc.
+# Copyright (C) 2000-2001, 2003-2007, 2009-2020 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4
index 7453866df84..b4734daf603 100644
--- a/m4/unistd_h.m4
+++ b/m4/unistd_h.m4
@@ -1,4 +1,4 @@
-# unistd_h.m4 serial 76
+# unistd_h.m4 serial 81
dnl Copyright (C) 2006-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -43,11 +43,13 @@ AC_DEFUN([gl_UNISTD_H],
#endif
]], [access chdir chown dup dup2 dup3 environ euidaccess faccessat fchdir
fchownat fdatasync fsync ftruncate getcwd getdomainname getdtablesize
- getgroups gethostname getlogin getlogin_r getpagesize getpass
+ getentropy getgroups gethostname getlogin getlogin_r getpagesize getpass
getusershell setusershell endusershell
group_member isatty lchown link linkat lseek pipe pipe2 pread pwrite
readlink readlinkat rmdir sethostname sleep symlink symlinkat
truncate ttyname_r unlink unlinkat usleep])
+
+ AC_REQUIRE([AC_C_RESTRICT])
])
AC_DEFUN([gl_UNISTD_MODULE_INDICATOR],
@@ -80,10 +82,12 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
GNULIB_GETCWD=0; AC_SUBST([GNULIB_GETCWD])
GNULIB_GETDOMAINNAME=0; AC_SUBST([GNULIB_GETDOMAINNAME])
GNULIB_GETDTABLESIZE=0; AC_SUBST([GNULIB_GETDTABLESIZE])
+ GNULIB_GETENTROPY=0; AC_SUBST([GNULIB_GETENTROPY])
GNULIB_GETGROUPS=0; AC_SUBST([GNULIB_GETGROUPS])
GNULIB_GETHOSTNAME=0; AC_SUBST([GNULIB_GETHOSTNAME])
GNULIB_GETLOGIN=0; AC_SUBST([GNULIB_GETLOGIN])
GNULIB_GETLOGIN_R=0; AC_SUBST([GNULIB_GETLOGIN_R])
+ GNULIB_GETOPT_POSIX=0; AC_SUBST([GNULIB_GETOPT_POSIX])
GNULIB_GETPAGESIZE=0; AC_SUBST([GNULIB_GETPAGESIZE])
GNULIB_GETPASS=0; AC_SUBST([GNULIB_GETPASS])
GNULIB_GETUSERSHELL=0; AC_SUBST([GNULIB_GETUSERSHELL])
@@ -116,7 +120,6 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
dnl Assume proper GNU behavior unless another module says otherwise.
HAVE_CHOWN=1; AC_SUBST([HAVE_CHOWN])
HAVE_COPY_FILE_RANGE=1; AC_SUBST([HAVE_COPY_FILE_RANGE])
- HAVE_DUP2=1; AC_SUBST([HAVE_DUP2])
HAVE_DUP3=1; AC_SUBST([HAVE_DUP3])
HAVE_EUIDACCESS=1; AC_SUBST([HAVE_EUIDACCESS])
HAVE_FACCESSAT=1; AC_SUBST([HAVE_FACCESSAT])
@@ -126,6 +129,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
HAVE_FSYNC=1; AC_SUBST([HAVE_FSYNC])
HAVE_FTRUNCATE=1; AC_SUBST([HAVE_FTRUNCATE])
HAVE_GETDTABLESIZE=1; AC_SUBST([HAVE_GETDTABLESIZE])
+ HAVE_GETENTROPY=1; AC_SUBST([HAVE_GETENTROPY])
HAVE_GETGROUPS=1; AC_SUBST([HAVE_GETGROUPS])
HAVE_GETHOSTNAME=1; AC_SUBST([HAVE_GETHOSTNAME])
HAVE_GETLOGIN=1; AC_SUBST([HAVE_GETLOGIN])
@@ -195,6 +199,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
REPLACE_UNLINKAT=0; AC_SUBST([REPLACE_UNLINKAT])
REPLACE_USLEEP=0; AC_SUBST([REPLACE_USLEEP])
REPLACE_WRITE=0; AC_SUBST([REPLACE_WRITE])
+ UNISTD_H_HAVE_SYS_RANDOM_H=0; AC_SUBST([UNISTD_H_HAVE_SYS_RANDOM_H])
UNISTD_H_HAVE_WINSOCK2_H=0; AC_SUBST([UNISTD_H_HAVE_WINSOCK2_H])
UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS=0;
AC_SUBST([UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS])
diff --git a/m4/utimens.m4 b/m4/utimens.m4
index 65617ac862c..3d31085fc6d 100644
--- a/m4/utimens.m4
+++ b/m4/utimens.m4
@@ -3,7 +3,7 @@ dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
-dnl serial 10
+dnl serial 11
AC_DEFUN([gl_UTIMENS],
[
@@ -24,7 +24,8 @@ AC_DEFUN([gl_UTIMENS],
#include <stddef.h>
#include <sys/times.h>
#include <fcntl.h>
-]], [[ int fd = open ("conftest.file", O_RDWR);
+]GL_MDA_DEFINES],
+ [[int fd = open ("conftest.file", O_RDWR);
if (fd < 0) return 1;
if (futimesat (fd, NULL, NULL)) return 2;
]])],
diff --git a/m4/utimensat.m4 b/m4/utimensat.m4
new file mode 100644
index 00000000000..e9e4f26b1c1
--- /dev/null
+++ b/m4/utimensat.m4
@@ -0,0 +1,70 @@
+# serial 7
+# See if we need to provide utimensat replacement.
+
+dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+# Written by Eric Blake.
+
+AC_DEFUN([gl_FUNC_UTIMENSAT],
+[
+ AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS])
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+ AC_CHECK_FUNCS_ONCE([utimensat])
+ if test $ac_cv_func_utimensat = no; then
+ HAVE_UTIMENSAT=0
+ else
+ AC_CACHE_CHECK([whether utimensat works],
+ [gl_cv_func_utimensat_works],
+ [AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM([[
+#include <fcntl.h>
+#include <sys/stat.h>
+#include <unistd.h>
+]GL_MDA_DEFINES],
+ [[int result = 0;
+ const char *f = "conftest.file";
+ if (close (creat (f, 0600)))
+ return 1;
+ /* Test whether the AT_SYMLINK_NOFOLLOW flag is supported. */
+ {
+ if (utimensat (AT_FDCWD, f, NULL, AT_SYMLINK_NOFOLLOW))
+ result |= 2;
+ }
+ /* Test whether UTIME_NOW and UTIME_OMIT work. */
+ {
+ struct timespec ts[2];
+ ts[0].tv_sec = 1;
+ ts[0].tv_nsec = UTIME_OMIT;
+ ts[1].tv_sec = 1;
+ ts[1].tv_nsec = UTIME_NOW;
+ if (utimensat (AT_FDCWD, f, ts, 0))
+ result |= 4;
+ }
+ sleep (1);
+ {
+ struct stat st;
+ struct timespec ts[2];
+ ts[0].tv_sec = 1;
+ ts[0].tv_nsec = UTIME_NOW;
+ ts[1].tv_sec = 1;
+ ts[1].tv_nsec = UTIME_OMIT;
+ if (utimensat (AT_FDCWD, f, ts, 0))
+ result |= 8;
+ if (stat (f, &st))
+ result |= 16;
+ else if (st.st_ctime < st.st_atime)
+ result |= 32;
+ }
+ return result;
+ ]])],
+ [gl_cv_func_utimensat_works=yes],
+ [gl_cv_func_utimensat_works=no],
+ [gl_cv_func_utimensat_works="guessing yes"])])
+ if test "$gl_cv_func_utimensat_works" = no; then
+ REPLACE_UTIMENSAT=1
+ fi
+ fi
+])
diff --git a/m4/utimes.m4 b/m4/utimes.m4
index e1056bbba4e..877bfd2a735 100644
--- a/m4/utimes.m4
+++ b/m4/utimes.m4
@@ -1,5 +1,5 @@
# Detect some bugs in glibc's implementation of utimes.
-# serial 7
+# serial 8
dnl Copyright (C) 2003-2005, 2009-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
@@ -34,6 +34,7 @@ AC_DEFUN([gl_FUNC_UTIMES],
#include <stdio.h>
#include <utime.h>
#include <errno.h>
+]GL_MDA_DEFINES[
static int
inorder (time_t a, time_t b, time_t c)
diff --git a/m4/warnings.m4 b/m4/warnings.m4
index d272365f0a1..d4e4b073453 100644
--- a/m4/warnings.m4
+++ b/m4/warnings.m4
@@ -1,4 +1,4 @@
-# warnings.m4 serial 14
+# warnings.m4 serial 16
dnl Copyright (C) 2008-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -23,8 +23,6 @@ m4_ifdef([AS_VAR_APPEND],
# The effects of this macro depend on the current language (_AC_LANG).
AC_DEFUN([gl_COMPILER_OPTION_IF],
[
-dnl FIXME: gl_Warn must be used unquoted until we can assume Autoconf
-dnl 2.64 or newer.
AS_VAR_PUSHDEF([gl_Warn], [gl_cv_warn_[]_AC_LANG_ABBREV[]_$1])dnl
AS_VAR_PUSHDEF([gl_Flags], [_AC_LANG_PREFIX[]FLAGS])dnl
AS_LITERAL_IF([$1],
@@ -34,13 +32,13 @@ case $gl_positive in
-Wno-*) gl_positive=-W`expr "X$gl_positive" : 'X-Wno-\(.*\)'` ;;
esac
m4_pushdef([gl_Positive], [$gl_positive])])dnl
-AC_CACHE_CHECK([whether _AC_LANG compiler handles $1], m4_defn([gl_Warn]), [
+AC_CACHE_CHECK([whether _AC_LANG compiler handles $1], [gl_Warn], [
gl_save_compiler_FLAGS="$gl_Flags"
gl_AS_VAR_APPEND(m4_defn([gl_Flags]),
[" $gl_unknown_warnings_are_errors ]m4_defn([gl_Positive])["])
- AC_LINK_IFELSE([m4_default([$4], [AC_LANG_PROGRAM([])])],
- [AS_VAR_SET(gl_Warn, [yes])],
- [AS_VAR_SET(gl_Warn, [no])])
+ AC_LINK_IFELSE([m4_default([$4], [AC_LANG_PROGRAM([[]])])],
+ [AS_VAR_SET([gl_Warn], [yes])],
+ [AS_VAR_SET([gl_Warn], [no])])
gl_Flags="$gl_save_compiler_FLAGS"
])
AS_VAR_IF(gl_Warn, [yes], [$2], [$3])
@@ -59,8 +57,7 @@ AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS],
[_AC_LANG_DISPATCH([$0], _AC_LANG, $@)])
# Specialization for _AC_LANG = C. This macro can be AC_REQUIREd.
-# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b.
-m4_defun([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C)],
+AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C)],
[
AC_LANG_PUSH([C])
gl_UNKNOWN_WARNINGS_ARE_ERRORS_IMPL
@@ -68,8 +65,7 @@ m4_defun([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C)],
])
# Specialization for _AC_LANG = C++. This macro can be AC_REQUIREd.
-# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b.
-m4_defun([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C++)],
+AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C++)],
[
AC_LANG_PUSH([C++])
gl_UNKNOWN_WARNINGS_ARE_ERRORS_IMPL
@@ -77,8 +73,7 @@ m4_defun([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C++)],
])
# Specialization for _AC_LANG = Objective C. This macro can be AC_REQUIREd.
-# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b.
-m4_defun([gl_UNKNOWN_WARNINGS_ARE_ERRORS(Objective C)],
+AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS(Objective C)],
[
AC_LANG_PUSH([Objective C])
gl_UNKNOWN_WARNINGS_ARE_ERRORS_IMPL
diff --git a/m4/zzgnulib.m4 b/m4/zzgnulib.m4
new file mode 100644
index 00000000000..98fa68f51a6
--- /dev/null
+++ b/m4/zzgnulib.m4
@@ -0,0 +1,23 @@
+# zzgnulib.m4 serial 1
+dnl Copyright (C) 2020 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl This file must be named something that sorts after all other
+dnl package- or gnulib-provided .m4 files - at least for those packages
+dnl that redefine AC_PROG_CC.
+
+dnl Redefine AC_PROG_CC so that it ends with invocations of gl_COMPILER_CLANG
+dnl and gl_COMPILER_PREPARE_CHECK_DECL.
+m4_define([AC_PROG_CC],
+ m4_defn([AC_PROG_CC])[
+gl_COMPILER_CLANG
+gl_COMPILER_PREPARE_CHECK_DECL
+])
+
+# gl_ZZGNULIB
+# -----------
+# Witness macro that this file has been included. Needed to force
+# Automake to include this file after all other gnulib .m4 files.
+AC_DEFUN([gl_ZZGNULIB])
diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp
index 8191dd15cc4..e79dc4600c1 100644
--- a/msdos/sed2v2.inp
+++ b/msdos/sed2v2.inp
@@ -66,7 +66,7 @@
/^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/
/^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/
/^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/
-/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "27.1.50"/
+/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "28.0.50"/
/^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/
/^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/
/^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/
diff --git a/nextstep/templates/Info.plist.in b/nextstep/templates/Info.plist.in
index f791ade7b97..1f074b04578 100644
--- a/nextstep/templates/Info.plist.in
+++ b/nextstep/templates/Info.plist.in
@@ -675,8 +675,16 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
</array>
<key>NSAppleScriptEnabled</key>
<string>YES</string>
- <key>NSAppleEventsUsageDescription</key>
- <string>Emacs requires permission to send AppleEvents to other applications.</string>
+ <key>NSAppleEventsUsageDescription</key>
+ <string>Emacs requires permission to send AppleEvents to other applications.</string>
+ <!-- For xwidget webkit to browse remote url,
+ but this set no restriction at all. Consult apple's documentation
+ for detail information about `NSApplicationDefinedMask'. -->
+ <key>NSAppTransportSecurity</key>
+ <dict>
+ <key>NSAllowsArbitraryLoads</key>
+ <true/>
+ </dict>
<key>NSDesktopFolderUsageDescription</key>
<string>Emacs requires permission to access the Desktop folder.</string>
<key>NSDocumentsFolderUsageDescription</key>
diff --git a/nt/README.W32 b/nt/README.W32
index 3c44c583afc..9c8d20472a9 100644
--- a/nt/README.W32
+++ b/nt/README.W32
@@ -1,7 +1,7 @@
Copyright (C) 2001-2020 Free Software Foundation, Inc.
See the end of the file for license conditions.
- Emacs version 27.1.50 for MS-Windows
+ Emacs version 28.0.50 for MS-Windows
This README file describes how to set up and run a precompiled
distribution of the latest version of GNU Emacs for MS-Windows. You
diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk
index 275fa61d3ff..b84626d903d 100644
--- a/nt/gnulib-cfg.mk
+++ b/nt/gnulib-cfg.mk
@@ -64,3 +64,7 @@ OMIT_GNULIB_MODULE_sys_types = true
OMIT_GNULIB_MODULE_unistd = true
OMIT_GNULIB_MODULE_canonicalize-lgpl = true
OMIT_GNULIB_MODULE_utimens = true
+OMIT_GNULIB_MODULE_fchmodat = true
+OMIT_GNULIB_MODULE_lchmod = true
+OMIT_GNULIB_MODULE_futimens = true
+OMIT_GNULIB_MODULE_utimensat = true
diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h
index e5d9fd3e78e..2c754f93e8f 100644
--- a/nt/inc/ms-w32.h
+++ b/nt/inc/ms-w32.h
@@ -39,6 +39,32 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
# undef __POSIX_2008_DEPRECATED
# define __POSIX_2008_DEPRECATED
# endif
+/* Old versions of MinGW don't have these in the w32api headers, and
+ Gnulib uses them in some files. */
+# ifndef _WIN32_WINNT_WIN2K
+# define _WIN32_WINNT_WIN2K 0x0500
+# endif
+# ifndef _WIN32_WINNT_WINXP
+# define _WIN32_WINNT_WINXP 0x0501
+# endif
+# ifndef _WIN32_WINNT_WS03
+# define _WIN32_WINNT_WS03 0x0502
+# endif
+# ifndef _WIN32_WINNT_VISTA
+# define _WIN32_WINNT_VISTA 0x0600
+# endif
+# ifndef _WIN32_WINNT_WIN7
+# define _WIN32_WINNT_WIN7 0x0601
+# endif
+# ifndef _WIN32_WINNT_WIN8
+# define _WIN32_WINNT_WIN8 0x0602
+# endif
+# ifndef _WIN32_WINNT_WINBLUE
+# define _WIN32_WINNT_WINBLUE 0x0603
+# endif
+# ifndef _WIN32_WINNT_WIN10
+# define _WIN32_WINNT_WIN10 0x0A00
+# endif
#endif
/* #undef const */
@@ -300,22 +326,6 @@ extern int sys_umask (int);
#define execvp _execvp
#include <stdint.h> /* for intptr_t */
extern intptr_t _execvp (const char *, char **);
-#ifdef MINGW_W64
-/* GCC 6 has a builtin execve with the prototype shown below. MinGW64
- changed the prototype in its process.h to match that, although the
- library function still calls _execve, which still returns intptr_t.
- However, using the prototype with intptr_t causes GCC to emit
- warnings. Fortunately, execve is not used in the MinGW build, but
- the code that references it is still compiled. */
-extern int execve (const char *, char * const *, char * const *);
-#else
-/* mingw.org's MinGW GCC 9.x has the same built-in prototype... */
-# if __GNUC__ >= 9
-extern int execve (const char *, char * const *, char * const *);
-# else
-extern intptr_t execve (const char *, char * const *, char * const *);
-# endif
-#endif
#define tcdrain _commit
#define fdopen _fdopen
#define fsync _commit
@@ -445,6 +455,7 @@ extern int alarm (int);
extern int sys_kill (pid_t, int);
+extern void explicit_bzero (void *, size_t);
/* For integration with MSDOS support. */
#define getdisk() (_getdrive () - 1)
@@ -504,6 +515,8 @@ extern void *malloc_after_dump_9x(size_t);
extern void *realloc_after_dump_9x(void *, size_t);
extern void free_after_dump_9x(void *);
+extern void *sys_calloc(size_t, size_t);
+
extern malloc_fn the_malloc_fn;
extern realloc_fn the_realloc_fn;
extern free_fn the_free_fn;
@@ -511,6 +524,7 @@ extern free_fn the_free_fn;
#define malloc(size) (*the_malloc_fn)(size)
#define free(ptr) (*the_free_fn)(ptr)
#define realloc(ptr, size) (*the_realloc_fn)(ptr, size)
+#define calloc(num, size) sys_calloc(num, size)
#endif
diff --git a/nt/inc/sys/stat.h b/nt/inc/sys/stat.h
index 7bf780dbaa2..f58d5ab6573 100644
--- a/nt/inc/sys/stat.h
+++ b/nt/inc/sys/stat.h
@@ -164,4 +164,9 @@ int __cdecl __MINGW_NOTHROW fstatat (int, char const *,
struct stat *, int);
int __cdecl __MINGW_NOTHROW chmod (const char*, int);
+/* Provide prototypes of library functions that are emulated on w32
+ and whose prototypes are usually found in sys/stat.h on POSIX
+ platforms. */
+extern int utimensat (int, const char *, struct timespec const[2], int);
+
#endif /* INC_SYS_STAT_H_ */
diff --git a/nt/mingw-cfg.site b/nt/mingw-cfg.site
index dfdca3926f9..4a77cc20b4e 100644
--- a/nt/mingw-cfg.site
+++ b/nt/mingw-cfg.site
@@ -102,6 +102,14 @@ ac_cv_func_lstat=yes
gl_cv_func_lstat_dereferences_slashed_symlink=yes
ac_cv_func_fstatat=yes
gl_cv_func_fstatat_zero_flag=yes
+ac_cv_func_fchmodat=yes
+gl_cv_func_fchmodat_works="not-needed-so-yes"
+ac_cv_func_lchmod=yes
+ac_cv_func_futimens=not-needed
+gl_cv_func_futimens_works="not-needed-so-yes"
+ac_cv_func_utimensat=yes
+gl_cv_func_utimensat_works=yes
+ac_cv_func_explicit_bzero=yes
# Aliased to _commit in ms-w32.h
ac_cv_func_fsync=yes
ac_cv_func_fdatasync=yes
@@ -145,3 +153,6 @@ gl_cv_warn_c__Wredundant_decls=no
# missing prototype, since lib/unistd.h, where Gnulib has its
# prototype, isn't built on Windows.
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
diff --git a/src/.gdbinit b/src/.gdbinit
index 30c7b055ce0..78536fc01fb 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -500,6 +500,9 @@ define pgx
# IMAGE_GLYPH
if ($g.type == 3)
printf "IMAGE[%d]", $g.u.img_id
+ if ($g.slice.img.x || $g.slice.img.y || $g.slice.img.width || $g.slice.img.height)
+ printf " slice=%d,%d,%d,%d" ,$g.slice.img.x, $g.slice.img.y, $g.slice.img.width, $g.slice.img.height
+ end
end
# STRETCH_GLYPH
if ($g.type == 4)
@@ -551,9 +554,6 @@ define pgx
if ($g.right_box_line_p)
printf " ]"
end
- if ($g.slice.img.x || $g.slice.img.y || $g.slice.img.width || $g.slice.img.height)
- printf " slice=%d,%d,%d,%d" ,$g.slice.img.x, $g.slice.img.y, $g.slice.img.width, $g.slice.img.height
- end
printf "\n"
end
document pgx
diff --git a/src/Makefile.in b/src/Makefile.in
index ab63b926272..c5fb2ea3ab2 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -295,8 +295,8 @@ EMACSRES = @EMACSRES@
W32_RES_LINK=@W32_RES_LINK@
## Empty if !HAVE_X_WINDOWS
-## xfont.o ftfont.o xftfont.o ftxfont.o if HAVE_XFT
-## xfont.o ftfont.o ftxfont.o if HAVE_FREETYPE
+## xfont.o ftfont.o xftfont.o if HAVE_XFT
+## xfont.o ftfont.o if HAVE_FREETYPE
## xfont.o ftfont.o ftcrfont.o if USE_CAIRO
## else xfont.o
## if HAVE_HARFBUZZ, hbfont.o is added regardless of the rest
@@ -323,8 +323,7 @@ INTERVALS_H = dispextern.h intervals.h composite.h
GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
-GMP_LIB = @GMP_LIB@
-GMP_OBJ = @GMP_OBJ@
+LIBGMP = @LIBGMP@
RUN_TEMACS = ./temacs
@@ -434,9 +433,10 @@ SOME_MACHINE_OBJECTS = dosfns.o msdos.o \
xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o fringe.o image.o \
fontset.o dbusbind.o cygw32.o \
nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o macfont.o \
+ nsxwidget.o \
w32.o w32console.o w32cygwinx.o w32fns.o w32heap.o w32inevt.o w32notify.o \
w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o \
- w16select.o widget.o xfont.o ftfont.o xftfont.o ftxfont.o gtkutil.o \
+ w16select.o widget.o xfont.o ftfont.o xftfont.o gtkutil.o \
xsettings.o xgselect.o termcap.o hbfont.o
## gmalloc.o if !SYSTEM_MALLOC && !DOUG_LEA_MALLOC, else empty.
@@ -531,7 +531,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) $(GMP_LIB)
+ $(JSON_LIBS) $(LIBGMP)
## FORCE it so that admin/unidata can decide whether this file is
## up-to-date. Although since charprop depends on bootstrap-emacs,
diff --git a/src/alloc.c b/src/alloc.c
index 568fee666fe..b12922b5858 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -34,7 +34,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "bignum.h"
#include "dispextern.h"
#include "intervals.h"
-#include "ptr-bounds.h"
#include "puresize.h"
#include "sheap.h"
#include "sysstdio.h"
@@ -67,7 +66,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
# include <malloc.h>
#endif
-#if defined HAVE_VALGRIND_VALGRIND_H && !defined USE_VALGRIND
+#if (defined ENABLE_CHECKING \
+ && defined HAVE_VALGRIND_VALGRIND_H && !defined USE_VALGRIND)
# define USE_VALGRIND 1
#endif
@@ -104,6 +104,66 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "w32heap.h" /* for sbrk */
#endif
+/* A type with alignment at least as large as any object that Emacs
+ allocates. This is not max_align_t because some platforms (e.g.,
+ mingw) have buggy malloc implementations that do not align for
+ max_align_t. This union contains types of all GCALIGNED_STRUCT
+ components visible here. */
+union emacs_align_type
+{
+ struct frame frame;
+ struct Lisp_Bignum Lisp_Bignum;
+ struct Lisp_Bool_Vector Lisp_Bool_Vector;
+ struct Lisp_Char_Table Lisp_Char_Table;
+ struct Lisp_CondVar Lisp_CondVar;
+ struct Lisp_Finalizer Lisp_Finalizer;
+ struct Lisp_Float Lisp_Float;
+ struct Lisp_Hash_Table Lisp_Hash_Table;
+ struct Lisp_Marker Lisp_Marker;
+ struct Lisp_Misc_Ptr Lisp_Misc_Ptr;
+ struct Lisp_Mutex Lisp_Mutex;
+ struct Lisp_Overlay Lisp_Overlay;
+ struct Lisp_Sub_Char_Table Lisp_Sub_Char_Table;
+ struct Lisp_Subr Lisp_Subr;
+ struct Lisp_User_Ptr Lisp_User_Ptr;
+ struct Lisp_Vector Lisp_Vector;
+ struct terminal terminal;
+ struct thread_state thread_state;
+ struct window window;
+
+ /* Omit the following since they would require including process.h
+ etc. In practice their alignments never exceed that of the
+ structs already listed. */
+#if 0
+ struct Lisp_Module_Function Lisp_Module_Function;
+ struct Lisp_Process Lisp_Process;
+ struct save_window_data save_window_data;
+ struct scroll_bar scroll_bar;
+ struct xwidget_view xwidget_view;
+ struct xwidget xwidget;
+#endif
+};
+
+/* MALLOC_SIZE_NEAR (N) is a good number to pass to malloc when
+ allocating a block of memory with size close to N bytes.
+ For best results N should be a power of 2.
+
+ When calculating how much memory to allocate, GNU malloc (SIZE)
+ adds sizeof (size_t) to SIZE for internal overhead, and then rounds
+ up to a multiple of MALLOC_ALIGNMENT. Emacs can improve
+ performance a bit on GNU platforms by arranging for the resulting
+ size to be a power of two. This heuristic is good for glibc 2.26
+ (2017) and later, and does not affect correctness on other
+ platforms. */
+
+#define MALLOC_SIZE_NEAR(n) \
+ (ROUNDUP (max (n, sizeof (size_t)), MALLOC_ALIGNMENT) - sizeof (size_t))
+#ifdef __i386
+enum { MALLOC_ALIGNMENT = 16 };
+#else
+enum { MALLOC_ALIGNMENT = max (2 * sizeof (size_t), alignof (long double)) };
+#endif
+
#ifdef DOUG_LEA_MALLOC
/* Specify maximum number of areas to mmap. It would be nice to use a
@@ -412,7 +472,6 @@ inline static void set_interval_marked (INTERVAL i);
enum mem_type
{
MEM_TYPE_NON_LISP,
- MEM_TYPE_BUFFER,
MEM_TYPE_CONS,
MEM_TYPE_STRING,
MEM_TYPE_SYMBOL,
@@ -636,25 +695,19 @@ buffer_memory_full (ptrdiff_t nbytes)
#define COMMON_MULTIPLE(a, b) \
((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b))
-/* LISP_ALIGNMENT is the alignment of Lisp objects. It must be at
- least GCALIGNMENT so that pointers can be tagged. It also must be
- at least as strict as the alignment of all the C types used to
- implement Lisp objects; since pseudovectors can contain any C type,
- this is max_align_t. On recent GNU/Linux x86 and x86-64 this can
- often waste up to 8 bytes, since alignof (max_align_t) is 16 but
- typical vectors need only an alignment of 8. Although shrinking
- the alignment to 8 would save memory, it cost a 20% hit to Emacs
- CPU performance on Fedora 28 x86-64 when compiled with gcc -m32. */
-enum { LISP_ALIGNMENT = alignof (union { max_align_t x;
+/* Alignment needed for memory blocks that are allocated via malloc
+ and that contain Lisp objects. On typical hosts malloc already
+ aligns sufficiently, but extra work is needed on oddball hosts
+ where Emacs would crash if malloc returned a non-GCALIGNED pointer. */
+enum { LISP_ALIGNMENT = alignof (union { union emacs_align_type x;
GCALIGNED_UNION_MEMBER }) };
verify (LISP_ALIGNMENT % GCALIGNMENT == 0);
/* True if malloc (N) is known to return storage suitably aligned for
Lisp objects whenever N is a multiple of LISP_ALIGNMENT. In
practice this is true whenever alignof (max_align_t) is also a
- multiple of LISP_ALIGNMENT. This works even for x86, where some
- platform combinations (e.g., GCC 7 and later, glibc 2.25 and
- earlier) have bugs where alignof (max_align_t) is 16 even though
+ multiple of LISP_ALIGNMENT. This works even for buggy platforms
+ like MinGW circa 2020, where alignof (max_align_t) is 16 even though
the malloc alignment is only 8, and where Emacs still works because
it never does anything that requires an alignment of 16. */
enum { MALLOC_IS_LISP_ALIGNED = alignof (max_align_t) % LISP_ALIGNMENT == 0 };
@@ -694,7 +747,7 @@ malloc_unblock_input (void)
malloc_probe (size); \
} while (0)
-static void *lmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
+static void *lmalloc (size_t, bool) ATTRIBUTE_MALLOC_SIZE ((1));
static void *lrealloc (void *, size_t);
/* Like malloc but check for no memory and block interrupt input. */
@@ -705,7 +758,7 @@ xmalloc (size_t size)
void *val;
MALLOC_BLOCK_INPUT;
- val = lmalloc (size);
+ val = lmalloc (size, false);
MALLOC_UNBLOCK_INPUT;
if (!val && size)
@@ -722,12 +775,11 @@ xzalloc (size_t size)
void *val;
MALLOC_BLOCK_INPUT;
- val = lmalloc (size);
+ val = lmalloc (size, true);
MALLOC_UNBLOCK_INPUT;
if (!val && size)
memory_full (size);
- memset (val, 0, size);
MALLOC_PROBE (size);
return val;
}
@@ -743,7 +795,7 @@ xrealloc (void *block, size_t size)
/* We must call malloc explicitly when BLOCK is 0, since some
reallocs don't do this. */
if (! block)
- val = lmalloc (size);
+ val = lmalloc (size, false);
else
val = lrealloc (block, size);
MALLOC_UNBLOCK_INPUT;
@@ -939,7 +991,7 @@ void *lisp_malloc_loser EXTERNALLY_VISIBLE;
#endif
static void *
-lisp_malloc (size_t nbytes, enum mem_type type)
+lisp_malloc (size_t nbytes, bool clearit, enum mem_type type)
{
register void *val;
@@ -949,7 +1001,7 @@ lisp_malloc (size_t nbytes, enum mem_type type)
allocated_mem_type = type;
#endif
- val = lmalloc (nbytes);
+ val = lmalloc (nbytes, clearit);
#if ! USE_LSB_TAG
/* If the memory just allocated cannot be addressed thru a Lisp
@@ -1290,16 +1342,21 @@ laligned (void *p, size_t size)
that's never really exercised) for little benefit. */
static void *
-lmalloc (size_t size)
+lmalloc (size_t size, bool clearit)
{
#ifdef USE_ALIGNED_ALLOC
if (! MALLOC_IS_LISP_ALIGNED && size % LISP_ALIGNMENT == 0)
- return aligned_alloc (LISP_ALIGNMENT, size);
+ {
+ void *p = aligned_alloc (LISP_ALIGNMENT, size);
+ if (clearit && p)
+ memclear (p, size);
+ return p;
+ }
#endif
while (true)
{
- void *p = malloc (size);
+ void *p = clearit ? calloc (1, size) : malloc (size);
if (laligned (p, size))
return p;
free (p);
@@ -1328,11 +1385,11 @@ lrealloc (void *p, size_t size)
Interval Allocation
***********************************************************************/
-/* Number of intervals allocated in an interval_block structure.
- The 1020 is 1024 minus malloc overhead. */
+/* Number of intervals allocated in an interval_block structure. */
-#define INTERVAL_BLOCK_SIZE \
- ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval))
+enum { INTERVAL_BLOCK_SIZE
+ = ((MALLOC_SIZE_NEAR (1024) - sizeof (struct interval_block *))
+ / sizeof (struct interval)) };
/* Intervals are allocated in chunks in the form of an interval_block
structure. */
@@ -1377,7 +1434,7 @@ make_interval (void)
if (interval_block_index == INTERVAL_BLOCK_SIZE)
{
struct interval_block *newi
- = lisp_malloc (sizeof *newi, MEM_TYPE_NON_LISP);
+ = lisp_malloc (sizeof *newi, false, MEM_TYPE_NON_LISP);
newi->next = interval_block;
interval_block = newi;
@@ -1444,10 +1501,9 @@ mark_interval_tree (INTERVAL i)
longer used, can be easily recognized, and it's easy to compact the
sblocks of small strings which we do in compact_small_strings. */
-/* Size in bytes of an sblock structure used for small strings. This
- is 8192 minus malloc overhead. */
+/* Size in bytes of an sblock structure used for small strings. */
-#define SBLOCK_SIZE 8188
+enum { SBLOCK_SIZE = MALLOC_SIZE_NEAR (8192) };
/* Strings larger than this are considered large strings. String data
for large strings is allocated from individual sblocks. */
@@ -1522,11 +1578,11 @@ struct sblock
sdata data[FLEXIBLE_ARRAY_MEMBER];
};
-/* Number of Lisp strings in a string_block structure. The 1020 is
- 1024 minus malloc overhead. */
+/* Number of Lisp strings in a string_block structure. */
-#define STRING_BLOCK_SIZE \
- ((1020 - sizeof (struct string_block *)) / sizeof (struct Lisp_String))
+enum { STRING_BLOCK_SIZE
+ = ((MALLOC_SIZE_NEAR (1024) - sizeof (struct string_block *))
+ / sizeof (struct Lisp_String)) };
/* Structure describing a block from which Lisp_String structures
are allocated. */
@@ -1567,8 +1623,7 @@ static struct Lisp_String *string_free_list;
a pointer to the `u.data' member of its sdata structure; the
structure starts at a constant offset in front of that. */
-#define SDATA_OF_STRING(S) ((sdata *) ptr_bounds_init ((S)->u.s.data \
- - SDATA_DATA_OFFSET))
+#define SDATA_OF_STRING(S) ((sdata *) ((S)->u.s.data - SDATA_DATA_OFFSET))
#ifdef GC_CHECK_STRING_OVERRUN
@@ -1730,7 +1785,7 @@ allocate_string (void)
add all the Lisp_Strings in it to the free-list. */
if (string_free_list == NULL)
{
- struct string_block *b = lisp_malloc (sizeof *b, MEM_TYPE_STRING);
+ struct string_block *b = lisp_malloc (sizeof *b, false, MEM_TYPE_STRING);
int i;
b->next = string_blocks;
@@ -1742,7 +1797,7 @@ allocate_string (void)
/* Every string on a free list should have NULL data pointer. */
s->u.s.data = NULL;
NEXT_FREE_LISP_STRING (s) = string_free_list;
- string_free_list = ptr_bounds_clip (s, sizeof *s);
+ string_free_list = s;
}
}
@@ -1778,15 +1833,16 @@ allocate_string (void)
plus a NUL byte at the end. Allocate an sdata structure DATA for
S, and set S->u.s.data to SDATA->u.data. Store a NUL byte at the
end of S->u.s.data. Set S->u.s.size to NCHARS and S->u.s.size_byte
- to NBYTES. Free S->u.s.data if it was initially non-null. */
+ to NBYTES. Free S->u.s.data if it was initially non-null.
-void
+ If CLEARIT, also clear the other bytes of S->u.s.data. */
+
+static void
allocate_string_data (struct Lisp_String *s,
- EMACS_INT nchars, EMACS_INT nbytes)
+ EMACS_INT nchars, EMACS_INT nbytes, bool clearit)
{
- sdata *data, *old_data;
+ sdata *data;
struct sblock *b;
- ptrdiff_t old_nbytes;
if (STRING_BYTES_MAX < nbytes)
string_overflow ();
@@ -1794,13 +1850,6 @@ allocate_string_data (struct Lisp_String *s,
/* Determine the number of bytes needed to store NBYTES bytes
of string data. */
ptrdiff_t needed = sdata_size (nbytes);
- if (s->u.s.data)
- {
- old_data = SDATA_OF_STRING (s);
- old_nbytes = STRING_BYTES (s);
- }
- else
- old_data = NULL;
MALLOC_BLOCK_INPUT;
@@ -1813,7 +1862,7 @@ allocate_string_data (struct Lisp_String *s,
mallopt (M_MMAP_MAX, 0);
#endif
- b = lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP);
+ b = lisp_malloc (size + GC_STRING_EXTRA, clearit, MEM_TYPE_NON_LISP);
#ifdef DOUG_LEA_MALLOC
if (!mmap_lisp_allowed_p ())
@@ -1825,27 +1874,30 @@ allocate_string_data (struct Lisp_String *s,
b->next_free = data;
large_sblocks = b;
}
- else if (current_sblock == NULL
- || (((char *) current_sblock + SBLOCK_SIZE
- - (char *) current_sblock->next_free)
- < (needed + GC_STRING_EXTRA)))
- {
- /* Not enough room in the current sblock. */
- b = lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP);
- data = b->data;
- b->next = NULL;
- b->next_free = data;
-
- if (current_sblock)
- current_sblock->next = b;
- else
- oldest_sblock = b;
- current_sblock = b;
- }
else
{
b = current_sblock;
+
+ if (b == NULL
+ || (SBLOCK_SIZE - GC_STRING_EXTRA
+ < (char *) b->next_free - (char *) b + needed))
+ {
+ /* Not enough room in the current sblock. */
+ b = lisp_malloc (SBLOCK_SIZE, false, MEM_TYPE_NON_LISP);
+ data = b->data;
+ b->next = NULL;
+ b->next_free = data;
+
+ if (current_sblock)
+ current_sblock->next = b;
+ else
+ oldest_sblock = b;
+ current_sblock = b;
+ }
+
data = b->next_free;
+ if (clearit)
+ memset (SDATA_DATA (data), 0, nbytes);
}
data->string = s;
@@ -1854,7 +1906,7 @@ allocate_string_data (struct Lisp_String *s,
MALLOC_UNBLOCK_INPUT;
- s->u.s.data = ptr_bounds_clip (SDATA_DATA (data), nbytes + 1);
+ s->u.s.data = SDATA_DATA (data);
#ifdef GC_CHECK_STRING_BYTES
SDATA_NBYTES (data) = nbytes;
#endif
@@ -1866,16 +1918,58 @@ allocate_string_data (struct Lisp_String *s,
GC_STRING_OVERRUN_COOKIE_SIZE);
#endif
- /* Note that Faset may call to this function when S has already data
- assigned. In this case, mark data as free by setting it's string
- back-pointer to null, and record the size of the data in it. */
- if (old_data)
+ tally_consing (needed);
+}
+
+/* Reallocate multibyte STRING data when a single character is replaced.
+ The character is at byte offset CIDX_BYTE in the string.
+ The character being replaced is CLEN bytes long,
+ and the character that will replace it is NEW_CLEN bytes long.
+ Return the address of where the caller should store the
+ the new character. */
+
+unsigned char *
+resize_string_data (Lisp_Object string, ptrdiff_t cidx_byte,
+ int clen, int new_clen)
+{
+ eassume (STRING_MULTIBYTE (string));
+ sdata *old_sdata = SDATA_OF_STRING (XSTRING (string));
+ ptrdiff_t nchars = SCHARS (string);
+ ptrdiff_t nbytes = SBYTES (string);
+ ptrdiff_t new_nbytes = nbytes + (new_clen - clen);
+ unsigned char *data = SDATA (string);
+ unsigned char *new_charaddr;
+
+ if (sdata_size (nbytes) == sdata_size (new_nbytes))
{
- SDATA_NBYTES (old_data) = old_nbytes;
- old_data->string = NULL;
+ /* No need to reallocate, as the size change falls within the
+ alignment slop. */
+ XSTRING (string)->u.s.size_byte = new_nbytes;
+#ifdef GC_CHECK_STRING_BYTES
+ SDATA_NBYTES (old_sdata) = new_nbytes;
+#endif
+ new_charaddr = data + cidx_byte;
+ memmove (new_charaddr + new_clen, new_charaddr + clen,
+ nbytes - (cidx_byte + (clen - 1)));
+ }
+ else
+ {
+ allocate_string_data (XSTRING (string), nchars, new_nbytes, false);
+ unsigned char *new_data = SDATA (string);
+ new_charaddr = new_data + cidx_byte;
+ memcpy (new_charaddr + new_clen, data + cidx_byte + clen,
+ nbytes - (cidx_byte + clen));
+ memcpy (new_data, data, cidx_byte);
+
+ /* Mark old string data as free by setting its string back-pointer
+ to null, and record the size of the data in it. */
+ SDATA_NBYTES (old_sdata) = nbytes;
+ old_sdata->string = NULL;
}
- tally_consing (needed);
+ clear_string_char_byte_cache ();
+
+ return new_charaddr;
}
@@ -1940,7 +2034,7 @@ sweep_strings (void)
/* Put the string on the free-list. */
NEXT_FREE_LISP_STRING (s) = string_free_list;
- string_free_list = ptr_bounds_clip (s, sizeof *s);
+ string_free_list = s;
++nfree;
}
}
@@ -1948,7 +2042,7 @@ sweep_strings (void)
{
/* S was on the free-list before. Put it there again. */
NEXT_FREE_LISP_STRING (s) = string_free_list;
- string_free_list = ptr_bounds_clip (s, sizeof *s);
+ string_free_list = s;
++nfree;
}
}
@@ -2075,8 +2169,7 @@ compact_small_strings (void)
{
eassert (tb != b || to < from);
memmove (to, from, size + GC_STRING_EXTRA);
- to->string->u.s.data
- = ptr_bounds_clip (SDATA_DATA (to), nbytes + 1);
+ to->string->u.s.data = SDATA_DATA (to);
}
/* Advance past the sdata we copied to. */
@@ -2110,6 +2203,9 @@ string_overflow (void)
error ("Maximum string size exceeded");
}
+static Lisp_Object make_clear_string (EMACS_INT, bool);
+static Lisp_Object make_clear_multibyte_string (EMACS_INT, EMACS_INT, bool);
+
DEFUN ("make-string", Fmake_string, Smake_string, 2, 3, 0,
doc: /* Return a newly created string of length LENGTH, with INIT in each element.
LENGTH must be an integer.
@@ -2118,19 +2214,20 @@ If optional argument MULTIBYTE is non-nil, the result will be
a multibyte string even if INIT is an ASCII character. */)
(Lisp_Object length, Lisp_Object init, Lisp_Object multibyte)
{
- register Lisp_Object val;
- int c;
+ Lisp_Object val;
EMACS_INT nbytes;
CHECK_FIXNAT (length);
CHECK_CHARACTER (init);
- c = XFIXNAT (init);
+ int c = XFIXNAT (init);
+ bool clearit = !c;
+
if (ASCII_CHAR_P (c) && NILP (multibyte))
{
nbytes = XFIXNUM (length);
- val = make_uninit_string (nbytes);
- if (nbytes)
+ val = make_clear_string (nbytes, clearit);
+ if (nbytes && !clearit)
{
memset (SDATA (val), c, nbytes);
SDATA (val)[nbytes] = 0;
@@ -2141,26 +2238,27 @@ a multibyte string even if INIT is an ASCII character. */)
unsigned char str[MAX_MULTIBYTE_LENGTH];
ptrdiff_t len = CHAR_STRING (c, str);
EMACS_INT string_len = XFIXNUM (length);
- unsigned char *p, *beg, *end;
if (INT_MULTIPLY_WRAPV (len, string_len, &nbytes))
string_overflow ();
- val = make_uninit_multibyte_string (string_len, nbytes);
- for (beg = SDATA (val), p = beg, end = beg + nbytes; p < end; p += len)
+ val = make_clear_multibyte_string (string_len, nbytes, clearit);
+ if (!clearit)
{
- /* First time we just copy `str' to the data of `val'. */
- if (p == beg)
- memcpy (p, str, len);
- else
+ unsigned char *beg = SDATA (val), *end = beg + nbytes;
+ for (unsigned char *p = beg; p < end; p += len)
{
- /* Next time we copy largest possible chunk from
- initialized to uninitialized part of `val'. */
- len = min (p - beg, end - p);
- memcpy (p, beg, len);
+ /* First time we just copy STR to the data of VAL. */
+ if (p == beg)
+ memcpy (p, str, len);
+ else
+ {
+ /* Next time we copy largest possible chunk from
+ initialized to uninitialized part of VAL. */
+ len = min (p - beg, end - p);
+ memcpy (p, beg, len);
+ }
}
}
- if (nbytes)
- *p = 0;
}
return val;
@@ -2330,26 +2428,37 @@ make_specified_string (const char *contents,
/* Return a unibyte Lisp_String set up to hold LENGTH characters
- occupying LENGTH bytes. */
+ occupying LENGTH bytes. If CLEARIT, clear its contents to null
+ bytes; otherwise, the contents are uninitialized. */
-Lisp_Object
-make_uninit_string (EMACS_INT length)
+static Lisp_Object
+make_clear_string (EMACS_INT length, bool clearit)
{
Lisp_Object val;
if (!length)
return empty_unibyte_string;
- val = make_uninit_multibyte_string (length, length);
+ val = make_clear_multibyte_string (length, length, clearit);
STRING_SET_UNIBYTE (val);
return val;
}
+/* Return a unibyte Lisp_String set up to hold LENGTH characters
+ occupying LENGTH bytes. */
+
+Lisp_Object
+make_uninit_string (EMACS_INT length)
+{
+ return make_clear_string (length, false);
+}
+
/* Return a multibyte Lisp_String set up to hold NCHARS characters
- which occupy NBYTES bytes. */
+ which occupy NBYTES bytes. If CLEARIT, clear its contents to null
+ bytes; otherwise, the contents are uninitialized. */
-Lisp_Object
-make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
+static Lisp_Object
+make_clear_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes, bool clearit)
{
Lisp_Object string;
struct Lisp_String *s;
@@ -2361,12 +2470,21 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
s = allocate_string ();
s->u.s.intervals = NULL;
- allocate_string_data (s, nchars, nbytes);
+ allocate_string_data (s, nchars, nbytes, clearit);
XSETSTRING (string, s);
string_chars_consed += nbytes;
return string;
}
+/* Return a multibyte Lisp_String set up to hold NCHARS characters
+ which occupy NBYTES bytes. */
+
+Lisp_Object
+make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
+{
+ return make_clear_multibyte_string (nchars, nbytes, false);
+}
+
/* Print arguments to BUF according to a FORMAT, then return
a Lisp_String initialized with the data from BUF. */
@@ -2838,7 +2956,6 @@ Lisp_Object zero_vector;
static void
setup_on_free_list (struct Lisp_Vector *v, ptrdiff_t nbytes)
{
- v = ptr_bounds_clip (v, nbytes);
eassume (header_size <= nbytes);
ptrdiff_t nwords = (nbytes - header_size) / word_size;
XSETPVECTYPESIZE (v, PVEC_FREE, 0, nwords);
@@ -3023,6 +3140,14 @@ cleanup_vector (struct Lisp_Vector *vector)
if (uptr->finalizer)
uptr->finalizer (uptr->p);
}
+#ifdef HAVE_MODULES
+ else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MODULE_FUNCTION))
+ {
+ ATTRIBUTE_MAY_ALIAS struct Lisp_Module_Function *function
+ = (struct Lisp_Module_Function *) vector;
+ module_finalize_function (function);
+ }
+#endif
}
/* Reclaim space used by unmarked vectors. */
@@ -3137,7 +3262,7 @@ sweep_vectors (void)
at most VECTOR_ELTS_MAX. */
static struct Lisp_Vector *
-allocate_vectorlike (ptrdiff_t len)
+allocate_vectorlike (ptrdiff_t len, bool clearit)
{
eassert (0 < len && len <= VECTOR_ELTS_MAX);
ptrdiff_t nbytes = header_size + len * word_size;
@@ -3151,11 +3276,15 @@ allocate_vectorlike (ptrdiff_t len)
#endif
if (nbytes <= VBLOCK_BYTES_MAX)
- p = allocate_vector_from_block (vroundup (nbytes));
+ {
+ p = allocate_vector_from_block (vroundup (nbytes));
+ if (clearit)
+ memclear (p, nbytes);
+ }
else
{
struct large_vector *lv = lisp_malloc (large_vector_offset + nbytes,
- MEM_TYPE_VECTORLIKE);
+ clearit, MEM_TYPE_VECTORLIKE);
lv->next = large_vectors;
large_vectors = lv;
p = large_vector_vec (lv);
@@ -3174,24 +3303,41 @@ allocate_vectorlike (ptrdiff_t len)
MALLOC_UNBLOCK_INPUT;
- return ptr_bounds_clip (p, nbytes);
+ return p;
}
-/* Allocate a vector with LEN slots. */
+/* Allocate a vector with LEN slots. If CLEARIT, clear its slots;
+ otherwise the vector's slots are uninitialized. */
-struct Lisp_Vector *
-allocate_vector (ptrdiff_t len)
+static struct Lisp_Vector *
+allocate_clear_vector (ptrdiff_t len, bool clearit)
{
if (len == 0)
return XVECTOR (zero_vector);
if (VECTOR_ELTS_MAX < len)
memory_full (SIZE_MAX);
- struct Lisp_Vector *v = allocate_vectorlike (len);
+ struct Lisp_Vector *v = allocate_vectorlike (len, clearit);
v->header.size = len;
return v;
}
+/* Allocate a vector with LEN uninitialized slots. */
+
+struct Lisp_Vector *
+allocate_vector (ptrdiff_t len)
+{
+ return allocate_clear_vector (len, false);
+}
+
+/* Allocate a vector with LEN nil slots. */
+
+struct Lisp_Vector *
+allocate_nil_vector (ptrdiff_t len)
+{
+ return allocate_clear_vector (len, true);
+}
+
/* Allocate other vector-like structures. */
@@ -3208,7 +3354,7 @@ allocate_pseudovector (int memlen, int lisplen,
eassert (lisplen <= size_max);
eassert (memlen <= size_max + rest_max);
- struct Lisp_Vector *v = allocate_vectorlike (memlen);
+ struct Lisp_Vector *v = allocate_vectorlike (memlen, false);
/* Only the first LISPLEN slots will be traced normally by the GC. */
memclear (v->contents, zerolen * word_size);
XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen);
@@ -3218,12 +3364,10 @@ allocate_pseudovector (int memlen, int lisplen,
struct buffer *
allocate_buffer (void)
{
- struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER);
-
+ struct buffer *b
+ = ALLOCATE_PSEUDOVECTOR (struct buffer, cursor_in_non_selected_windows_,
+ PVEC_BUFFER);
BUFFER_PVEC_INIT (b);
- /* Put B on the chain of all buffers including killed ones. */
- b->next = all_buffers;
- all_buffers = b;
/* Note that the rest fields of B are not initialized. */
return b;
}
@@ -3238,7 +3382,7 @@ allocate_record (EMACS_INT count)
if (count > PSEUDOVECTOR_SIZE_MASK)
error ("Attempt to allocate a record of %"pI"d slots; max is %d",
count, PSEUDOVECTOR_SIZE_MASK);
- struct Lisp_Vector *p = allocate_vectorlike (count);
+ struct Lisp_Vector *p = allocate_vectorlike (count, false);
p->header.size = count;
XSETPVECTYPE (p, PVEC_RECORD);
return p;
@@ -3291,9 +3435,11 @@ See also the function `vector'. */)
Lisp_Object
make_vector (ptrdiff_t length, Lisp_Object init)
{
- struct Lisp_Vector *p = allocate_vector (length);
- for (ptrdiff_t i = 0; i < length; i++)
- p->contents[i] = init;
+ bool clearit = NIL_IS_ZERO && NILP (init);
+ struct Lisp_Vector *p = allocate_clear_vector (length, clearit);
+ if (!clearit)
+ for (ptrdiff_t i = 0; i < length; i++)
+ p->contents[i] = init;
return make_lisp_ptr (p, Lisp_Vectorlike);
}
@@ -3309,23 +3455,6 @@ usage: (vector &rest OBJECTS) */)
return val;
}
-void
-make_byte_code (struct Lisp_Vector *v)
-{
- /* Don't allow the global zero_vector to become a byte code object. */
- eassert (0 < v->header.size);
-
- if (v->header.size > 1 && STRINGP (v->contents[1])
- && STRING_MULTIBYTE (v->contents[1]))
- /* BYTECODE-STRING must have been produced by Emacs 20.2 or the
- earlier because they produced a raw 8-bit string for byte-code
- and now such a byte-code string is loaded as multibyte while
- raw 8-bit characters converted to multibyte form. Thus, now we
- must convert them back to the original unibyte form. */
- v->contents[1] = Fstring_as_unibyte (v->contents[1]);
- XSETPVECTYPE (v, PVEC_COMPILED);
-}
-
DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
doc: /* Create a byte-code object with specified arguments as elements.
The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant
@@ -3344,8 +3473,14 @@ stack before executing the byte-code.
usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object val = make_uninit_vector (nargs);
- struct Lisp_Vector *p = XVECTOR (val);
+ if (! ((FIXNUMP (args[COMPILED_ARGLIST])
+ || CONSP (args[COMPILED_ARGLIST])
+ || NILP (args[COMPILED_ARGLIST]))
+ && STRINGP (args[COMPILED_BYTECODE])
+ && !STRING_MULTIBYTE (args[COMPILED_BYTECODE])
+ && VECTORP (args[COMPILED_CONSTANTS])
+ && FIXNATP (args[COMPILED_STACK_DEPTH])))
+ error ("Invalid byte-code object");
/* We used to purecopy everything here, if purify-flag was set. This worked
OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
@@ -3354,10 +3489,8 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
copied into pure space, including its free variables, which is sometimes
just wasteful and other times plainly wrong (e.g. those free vars may want
to be setcar'd). */
-
- memcpy (p->contents, args, nargs * sizeof *args);
- make_byte_code (p);
- XSETCOMPILED (val, p);
+ Lisp_Object val = Fvector (nargs, args);
+ XSETPVECTYPE (XVECTOR (val), PVEC_COMPILED);
return val;
}
@@ -3442,7 +3575,7 @@ Its value is void, and its function definition and property list are nil. */)
if (symbol_block_index == SYMBOL_BLOCK_SIZE)
{
struct symbol_block *new
- = lisp_malloc (sizeof *new, MEM_TYPE_SYMBOL);
+ = lisp_malloc (sizeof *new, false, MEM_TYPE_SYMBOL);
new->next = symbol_block;
symbol_block = new;
symbol_block_index = 0;
@@ -3904,10 +4037,10 @@ refill_memory_reserve (void)
MEM_TYPE_SPARE);
if (spare_memory[5] == 0)
spare_memory[5] = lisp_malloc (sizeof (struct string_block),
- MEM_TYPE_SPARE);
+ false, MEM_TYPE_SPARE);
if (spare_memory[6] == 0)
spare_memory[6] = lisp_malloc (sizeof (struct string_block),
- MEM_TYPE_SPARE);
+ false, MEM_TYPE_SPARE);
if (spare_memory[0] && spare_memory[1] && spare_memory[5])
Vmemory_full = Qnil;
#endif
@@ -4304,7 +4437,7 @@ mem_delete_fixup (struct mem_node *x)
/* If P is a pointer into a live Lisp string object on the heap,
- return the object. Otherwise, return nil. M is a pointer to the
+ return the object's address. Otherwise, return NULL. M points to the
mem_block for P.
This and other *_holding functions look for a pointer anywhere into
@@ -4312,277 +4445,239 @@ mem_delete_fixup (struct mem_node *x)
because some compilers sometimes optimize away the latter. See
Bug#28213. */
-static Lisp_Object
+static struct Lisp_String *
live_string_holding (struct mem_node *m, void *p)
{
- if (m->type == MEM_TYPE_STRING)
- {
- struct string_block *b = m->start;
- char *cp = p;
- ptrdiff_t offset = cp - (char *) &b->strings[0];
+ eassert (m->type == MEM_TYPE_STRING);
+ struct string_block *b = m->start;
+ char *cp = p;
+ ptrdiff_t offset = cp - (char *) &b->strings[0];
- /* P must point into a Lisp_String structure, and it
- must not be on the free-list. */
- if (0 <= offset && offset < STRING_BLOCK_SIZE * sizeof b->strings[0])
+ /* P must point into a Lisp_String structure, and it
+ must not be on the free-list. */
+ if (0 <= offset && offset < sizeof b->strings)
+ {
+ ptrdiff_t off = offset % sizeof b->strings[0];
+ if (off == Lisp_String
+ || off == 0
+ || off == offsetof (struct Lisp_String, u.s.size_byte)
+ || off == offsetof (struct Lisp_String, u.s.intervals)
+ || off == offsetof (struct Lisp_String, u.s.data))
{
- cp = ptr_bounds_copy (cp, b);
- struct Lisp_String *s = p = cp -= offset % sizeof b->strings[0];
+ struct Lisp_String *s = p = cp -= off;
if (s->u.s.data)
- return make_lisp_ptr (s, Lisp_String);
+ return s;
}
}
- return Qnil;
+ return NULL;
}
static bool
live_string_p (struct mem_node *m, void *p)
{
- return !NILP (live_string_holding (m, p));
+ return live_string_holding (m, p) == p;
}
/* If P is a pointer into a live Lisp cons object on the heap, return
- the object. Otherwise, return nil. M is a pointer to the
+ the object's address. Otherwise, return NULL. M points to the
mem_block for P. */
-static Lisp_Object
+static struct Lisp_Cons *
live_cons_holding (struct mem_node *m, void *p)
{
- if (m->type == MEM_TYPE_CONS)
+ eassert (m->type == MEM_TYPE_CONS);
+ struct cons_block *b = m->start;
+ char *cp = p;
+ ptrdiff_t offset = cp - (char *) &b->conses[0];
+
+ /* P must point into a Lisp_Cons, not be
+ one of the unused cells in the current cons block,
+ and not be on the free-list. */
+ if (0 <= offset && offset < sizeof b->conses
+ && (b != cons_block
+ || offset / sizeof b->conses[0] < cons_block_index))
{
- struct cons_block *b = m->start;
- char *cp = p;
- ptrdiff_t offset = cp - (char *) &b->conses[0];
-
- /* P must point into a Lisp_Cons, not be
- one of the unused cells in the current cons block,
- and not be on the free-list. */
- if (0 <= offset && offset < CONS_BLOCK_SIZE * sizeof b->conses[0]
- && (b != cons_block
- || offset / sizeof b->conses[0] < cons_block_index))
+ ptrdiff_t off = offset % sizeof b->conses[0];
+ if (off == Lisp_Cons
+ || off == 0
+ || off == offsetof (struct Lisp_Cons, u.s.u.cdr))
{
- cp = ptr_bounds_copy (cp, b);
- struct Lisp_Cons *s = p = cp -= offset % sizeof b->conses[0];
+ struct Lisp_Cons *s = p = cp -= off;
if (!deadp (s->u.s.car))
- return make_lisp_ptr (s, Lisp_Cons);
+ return s;
}
}
- return Qnil;
+ return NULL;
}
static bool
live_cons_p (struct mem_node *m, void *p)
{
- return !NILP (live_cons_holding (m, p));
+ return live_cons_holding (m, p) == p;
}
/* If P is a pointer into a live Lisp symbol object on the heap,
- return the object. Otherwise, return nil. M is a pointer to the
+ return the object's address. Otherwise, return NULL. M points to the
mem_block for P. */
-static Lisp_Object
+static struct Lisp_Symbol *
live_symbol_holding (struct mem_node *m, void *p)
{
- if (m->type == MEM_TYPE_SYMBOL)
+ eassert (m->type == MEM_TYPE_SYMBOL);
+ struct symbol_block *b = m->start;
+ char *cp = p;
+ ptrdiff_t offset = cp - (char *) &b->symbols[0];
+
+ /* P must point into the Lisp_Symbol, not be
+ one of the unused cells in the current symbol block,
+ and not be on the free-list. */
+ if (0 <= offset && offset < sizeof b->symbols
+ && (b != symbol_block
+ || offset / sizeof b->symbols[0] < symbol_block_index))
{
- struct symbol_block *b = m->start;
- char *cp = p;
- ptrdiff_t offset = cp - (char *) &b->symbols[0];
-
- /* P must point into the Lisp_Symbol, not be
- one of the unused cells in the current symbol block,
- and not be on the free-list. */
- if (0 <= offset && offset < SYMBOL_BLOCK_SIZE * sizeof b->symbols[0]
- && (b != symbol_block
- || offset / sizeof b->symbols[0] < symbol_block_index))
+ ptrdiff_t off = offset % sizeof b->symbols[0];
+ if (off == Lisp_Symbol
+
+ /* Plain '|| off == 0' would run afoul of GCC 10.2
+ -Wlogical-op, as Lisp_Symbol happens to be zero. */
+ || (Lisp_Symbol != 0 && off == 0)
+
+ || off == offsetof (struct Lisp_Symbol, u.s.name)
+ || off == offsetof (struct Lisp_Symbol, u.s.val)
+ || off == offsetof (struct Lisp_Symbol, u.s.function)
+ || off == offsetof (struct Lisp_Symbol, u.s.plist)
+ || off == offsetof (struct Lisp_Symbol, u.s.next))
{
- cp = ptr_bounds_copy (cp, b);
- struct Lisp_Symbol *s = p = cp -= offset % sizeof b->symbols[0];
+ struct Lisp_Symbol *s = p = cp -= off;
if (!deadp (s->u.s.function))
- return make_lisp_symbol (s);
+ return s;
}
}
- return Qnil;
+ return NULL;
}
static bool
live_symbol_p (struct mem_node *m, void *p)
{
- return !NILP (live_symbol_holding (m, p));
+ return live_symbol_holding (m, p) == p;
}
-/* Return true if P is a pointer to a live Lisp float on
- the heap. M is a pointer to the mem_block for P. */
-
-static bool
-live_float_p (struct mem_node *m, void *p)
-{
- if (m->type == MEM_TYPE_FLOAT)
- {
- struct float_block *b = m->start;
- char *cp = p;
- ptrdiff_t offset = cp - (char *) &b->floats[0];
-
- /* P must point to the start of a Lisp_Float and not be
- one of the unused cells in the current float block. */
- return (offset >= 0
- && offset % sizeof b->floats[0] == 0
- && offset < (FLOAT_BLOCK_SIZE * sizeof b->floats[0])
- && (b != float_block
- || offset / sizeof b->floats[0] < float_block_index));
- }
- else
- return 0;
-}
-
-/* If P is a pointer to a live vector-like object, return the object.
- Otherwise, return nil.
+/* If P is a (possibly-tagged) pointer to a live Lisp_Float on the
+ heap, return the address of the Lisp_Float. Otherwise, return NULL.
M is a pointer to the mem_block for P. */
-static Lisp_Object
-live_vector_holding (struct mem_node *m, void *p)
+static struct Lisp_Float *
+live_float_holding (struct mem_node *m, void *p)
{
- struct Lisp_Vector *vp = p;
+ eassert (m->type == MEM_TYPE_FLOAT);
+ struct float_block *b = m->start;
+ char *cp = p;
+ ptrdiff_t offset = cp - (char *) &b->floats[0];
- if (m->type == MEM_TYPE_VECTOR_BLOCK)
+ /* P must point to (or be a tagged pointer to) the start of a
+ Lisp_Float and not be one of the unused cells in the current
+ float block. */
+ if (0 <= offset && offset < sizeof b->floats)
{
- /* This memory node corresponds to a vector block. */
- struct vector_block *block = m->start;
- struct Lisp_Vector *vector = (struct Lisp_Vector *) block->data;
-
- /* P is in the block's allocation range. Scan the block
- up to P and see whether P points to the start of some
- vector which is not on a free list. FIXME: check whether
- some allocation patterns (probably a lot of short vectors)
- may cause a substantial overhead of this loop. */
- while (VECTOR_IN_BLOCK (vector, block) && vector <= vp)
+ int off = offset % sizeof b->floats[0];
+ if ((off == Lisp_Float || off == 0)
+ && (b != float_block
+ || offset / sizeof b->floats[0] < float_block_index))
{
- struct Lisp_Vector *next = ADVANCE (vector, vector_nbytes (vector));
- if (vp < next && !PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE))
- return make_lisp_ptr (vector, Lisp_Vectorlike);
- vector = next;
+ p = cp - off;
+ return p;
}
}
- else if (m->type == MEM_TYPE_VECTORLIKE)
- {
- /* This memory node corresponds to a large vector. */
- struct Lisp_Vector *vector = large_vector_vec (m->start);
- struct Lisp_Vector *next = ADVANCE (vector, vector_nbytes (vector));
- if (vector <= vp && vp < next)
- return make_lisp_ptr (vector, Lisp_Vectorlike);
- }
- return Qnil;
+ return NULL;
}
static bool
-live_vector_p (struct mem_node *m, void *p)
+live_float_p (struct mem_node *m, void *p)
{
- return !NILP (live_vector_holding (m, p));
+ return live_float_holding (m, p) == p;
}
-/* If P is a pointer into a live buffer, return the buffer.
- Otherwise, return nil. M is a pointer to the mem_block for P. */
+/* Return VECTOR if P points within it, NULL otherwise. */
-static Lisp_Object
-live_buffer_holding (struct mem_node *m, void *p)
+static struct Lisp_Vector *
+live_vector_pointer (struct Lisp_Vector *vector, void *p)
+{
+ void *vvector = vector;
+ char *cvector = vvector;
+ char *cp = p;
+ ptrdiff_t offset = cp - cvector;
+ return ((offset == Lisp_Vectorlike
+ || offset == 0
+ || (sizeof vector->header <= offset
+ && offset < vector_nbytes (vector)
+ && (! (vector->header.size & PSEUDOVECTOR_FLAG)
+ ? (offsetof (struct Lisp_Vector, contents) <= offset
+ && (((offset - offsetof (struct Lisp_Vector, contents))
+ % word_size)
+ == 0))
+ /* For non-bool-vector pseudovectors, treat any pointer
+ past the header as valid since it's too much of a pain
+ to write special-case code for every pseudovector. */
+ : (! PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BOOL_VECTOR)
+ || offset == offsetof (struct Lisp_Bool_Vector, size)
+ || (offsetof (struct Lisp_Bool_Vector, data) <= offset
+ && (((offset
+ - offsetof (struct Lisp_Bool_Vector, data))
+ % sizeof (bits_word))
+ == 0))))))
+ ? vector : NULL);
+}
+
+/* If P is a pointer to a live, large vector-like object, return the object.
+ Otherwise, return nil.
+ M is a pointer to the mem_block for P. */
+
+static struct Lisp_Vector *
+live_large_vector_holding (struct mem_node *m, void *p)
{
- /* P must point into the block, and the buffer
- must not have been killed. */
- if (m->type == MEM_TYPE_BUFFER)
- {
- struct buffer *b = m->start;
- char *cb = m->start;
- char *cp = p;
- ptrdiff_t offset = cp - cb;
- if (0 <= offset && offset < sizeof *b && !NILP (b->name_))
- {
- Lisp_Object obj;
- XSETBUFFER (obj, b);
- return obj;
- }
- }
- return Qnil;
+ eassert (m->type == MEM_TYPE_VECTORLIKE);
+ return live_vector_pointer (large_vector_vec (m->start), p);
}
static bool
-live_buffer_p (struct mem_node *m, void *p)
+live_large_vector_p (struct mem_node *m, void *p)
{
- return !NILP (live_buffer_holding (m, p));
+ return live_large_vector_holding (m, p) == p;
}
-/* Mark OBJ if we can prove it's a Lisp_Object. */
+/* If P is a pointer to a live, small vector-like object, return the object.
+ Otherwise, return NULL.
+ M is a pointer to the mem_block for P. */
-static void
-mark_maybe_object (Lisp_Object obj)
+static struct Lisp_Vector *
+live_small_vector_holding (struct mem_node *m, void *p)
{
-#if USE_VALGRIND
- VALGRIND_MAKE_MEM_DEFINED (&obj, sizeof (obj));
-#endif
-
- if (FIXNUMP (obj))
- return;
-
- void *po = XPNTR (obj);
-
- /* If the pointer is in the dump image and the dump has a record
- of the object starting at the place where the pointer points, we
- definitely have an object. If the pointer is in the dump image
- and the dump has no idea what the pointer is pointing at, we
- definitely _don't_ have an object. */
- if (pdumper_object_p (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. */
- if (XTYPE (obj) == pdumper_find_object_type (po))
- mark_object (obj);
- return;
- }
-
- struct mem_node *m = mem_find (po);
-
- if (m != MEM_NIL)
+ eassert (m->type == MEM_TYPE_VECTOR_BLOCK);
+ struct Lisp_Vector *vp = p;
+ struct vector_block *block = m->start;
+ struct Lisp_Vector *vector = (struct Lisp_Vector *) block->data;
+
+ /* P is in the block's allocation range. Scan the block
+ up to P and see whether P points to the start of some
+ vector which is not on a free list. FIXME: check whether
+ some allocation patterns (probably a lot of short vectors)
+ may cause a substantial overhead of this loop. */
+ while (VECTOR_IN_BLOCK (vector, block) && vector <= vp)
{
- bool mark_p = false;
-
- switch (XTYPE (obj))
- {
- case Lisp_String:
- mark_p = EQ (obj, live_string_holding (m, po));
- break;
-
- case Lisp_Cons:
- mark_p = EQ (obj, live_cons_holding (m, po));
- break;
-
- case Lisp_Symbol:
- mark_p = EQ (obj, live_symbol_holding (m, po));
- break;
-
- case Lisp_Float:
- mark_p = live_float_p (m, po);
- break;
-
- case Lisp_Vectorlike:
- mark_p = (EQ (obj, live_vector_holding (m, po))
- || EQ (obj, live_buffer_holding (m, po)));
- break;
-
- default:
- break;
- }
-
- if (mark_p)
- mark_object (obj);
+ struct Lisp_Vector *next = ADVANCE (vector, vector_nbytes (vector));
+ if (vp < next && !PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE))
+ return live_vector_pointer (vector, vp);
+ vector = next;
}
+ return NULL;
}
-void
-mark_maybe_objects (Lisp_Object const *array, ptrdiff_t nelts)
+static bool
+live_small_vector_p (struct mem_node *m, void *p)
{
- for (Lisp_Object const *lim = array + nelts; array < lim; array++)
- mark_maybe_object (*array);
+ return live_small_vector_holding (m, p) == p;
}
/* If P points to Lisp data, mark that as live if it isn't already
@@ -4593,65 +4688,99 @@ mark_maybe_pointer (void *p)
{
struct mem_node *m;
-#ifdef USE_VALGRIND
+#if USE_VALGRIND
VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p));
#endif
+ /* If the pointer is in the dump image and the dump has a record
+ of the object starting at the place where the pointer points, we
+ definitely have an object. If the pointer is in the dump image
+ and the dump has no idea what the pointer is pointing at, we
+ definitely _don't_ have an object. */
if (pdumper_object_p (p))
{
+ /* 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));
- /* See mark_maybe_object for why we can confidently return. */
return;
}
m = mem_find (p);
if (m != MEM_NIL)
{
- Lisp_Object obj = Qnil;
+ Lisp_Object obj;
switch (m->type)
{
case MEM_TYPE_NON_LISP:
case MEM_TYPE_SPARE:
/* Nothing to do; not a pointer to Lisp memory. */
- break;
-
- case MEM_TYPE_BUFFER:
- obj = live_buffer_holding (m, p);
- break;
+ return;
case MEM_TYPE_CONS:
- obj = live_cons_holding (m, p);
+ {
+ struct Lisp_Cons *h = live_cons_holding (m, p);
+ if (!h)
+ return;
+ obj = make_lisp_ptr (h, Lisp_Cons);
+ }
break;
case MEM_TYPE_STRING:
- obj = live_string_holding (m, p);
+ {
+ struct Lisp_String *h = live_string_holding (m, p);
+ if (!h)
+ return;
+ obj = make_lisp_ptr (h, Lisp_String);
+ }
break;
case MEM_TYPE_SYMBOL:
- obj = live_symbol_holding (m, p);
+ {
+ struct Lisp_Symbol *h = live_symbol_holding (m, p);
+ if (!h)
+ return;
+ obj = make_lisp_symbol (h);
+ }
break;
case MEM_TYPE_FLOAT:
- if (live_float_p (m, p))
- obj = make_lisp_ptr (p, Lisp_Float);
+ {
+ struct Lisp_Float *h = live_float_holding (m, p);
+ if (!h)
+ return;
+ obj = make_lisp_ptr (h, Lisp_Float);
+ }
break;
case MEM_TYPE_VECTORLIKE:
+ {
+ struct Lisp_Vector *h = live_large_vector_holding (m, p);
+ if (!h)
+ return;
+ obj = make_lisp_ptr (h, Lisp_Vectorlike);
+ }
+ break;
+
case MEM_TYPE_VECTOR_BLOCK:
- obj = live_vector_holding (m, p);
+ {
+ struct Lisp_Vector *h = live_small_vector_holding (m, p);
+ if (!h)
+ return;
+ obj = make_lisp_ptr (h, Lisp_Vectorlike);
+ }
break;
default:
emacs_abort ();
}
- if (!NILP (obj))
- mark_object (obj);
+ mark_object (obj);
}
}
@@ -4700,7 +4829,7 @@ mark_memory (void const *start, void const *end)
for (pp = start; (void const *) pp < end; pp += GC_POINTER_ALIGNMENT)
{
- char *p = *(char *const *) pp;
+ void *p = *(void *const *) pp;
mark_maybe_pointer (p);
/* Unmask any struct Lisp_Symbol pointer that make_lisp_symbol
@@ -4708,13 +4837,9 @@ mark_memory (void const *start, void const *end)
On a host with 32-bit pointers and 64-bit Lisp_Objects,
a Lisp_Object might be split into registers saved into
non-adjacent words and P might be the low-order word's value. */
- p += (intptr_t) lispsym;
- mark_maybe_pointer (p);
-
- verify (alignof (Lisp_Object) % GC_POINTER_ALIGNMENT == 0);
- if (alignof (Lisp_Object) == GC_POINTER_ALIGNMENT
- || (uintptr_t) pp % alignof (Lisp_Object) == 0)
- mark_maybe_object (*(Lisp_Object const *) pp);
+ intptr_t ip;
+ INT_ADD_WRAPV ((intptr_t) p, (intptr_t) lispsym, &ip);
+ mark_maybe_pointer ((void *) ip);
}
}
@@ -4815,36 +4940,16 @@ test_setjmp (void)
as a stack scan limit. */
typedef union
{
- /* Align the stack top properly. Even if !HAVE___BUILTIN_UNWIND_INIT,
- jmp_buf may not be aligned enough on darwin-ppc64. */
- max_align_t o;
+ /* Make sure stack_top and m_stack_bottom are properly aligned as GC
+ expects. */
+ Lisp_Object o;
+ void *p;
#ifndef HAVE___BUILTIN_UNWIND_INIT
sys_jmp_buf j;
char c;
#endif
} stacktop_sentry;
-/* Force callee-saved registers and register windows onto the stack.
- Use the platform-defined __builtin_unwind_init if available,
- obviating the need for machine dependent methods. */
-#ifndef HAVE___BUILTIN_UNWIND_INIT
-# ifdef __sparc__
- /* This trick flushes the register windows so that all the state of
- the process is contained in the stack.
- FreeBSD does not have a ta 3 handler, so handle it specially.
- FIXME: Code in the Boehm GC suggests flushing (with 'flushrs') is
- needed on ia64 too. See mach_dep.c, where it also says inline
- assembler doesn't work with relevant proprietary compilers. */
-# if defined __sparc64__ && defined __FreeBSD__
-# define __builtin_unwind_init() asm ("flushw")
-# else
-# define __builtin_unwind_init() asm ("ta 3")
-# endif
-# else
-# define __builtin_unwind_init() ((void) 0)
-# endif
-#endif
-
/* Yield an address close enough to the top of the stack that the
garbage collector need not scan above it. Callers should be
declared NO_INLINE. */
@@ -4861,12 +4966,10 @@ typedef union
#ifdef HAVE___BUILTIN_UNWIND_INIT
# define SET_STACK_TOP_ADDRESS(p) \
stacktop_sentry sentry; \
- __builtin_unwind_init (); \
*(p) = NEAR_STACK_TOP (&sentry)
#else
# define SET_STACK_TOP_ADDRESS(p) \
stacktop_sentry sentry; \
- __builtin_unwind_init (); \
test_setjmp (); \
sys_setjmp (sentry.j); \
*(p) = NEAR_STACK_TOP (&sentry + (stack_bottom < &sentry.c))
@@ -4882,16 +4985,14 @@ typedef union
We have to mark Lisp objects in CPU registers that can hold local
variables or are used to pass parameters.
- This code assumes that calling setjmp saves registers we need
+ If __builtin_unwind_init is available, it should suffice to save
+ registers.
+
+ Otherwise, assume that calling setjmp saves registers we need
to see in a jmp_buf which itself lies on the stack. This doesn't
have to be true! It must be verified for each system, possibly
by taking a look at the source code of setjmp.
- If __builtin_unwind_init is available (defined by GCC >= 2.8) we
- can use it as a machine independent method to store all registers
- to the stack. In this case the macros described in the previous
- two paragraphs are not used.
-
Stack Layout
Architectures differ in the way their processor stack is organized.
@@ -4930,8 +5031,9 @@ mark_stack (char const *bottom, char const *end)
#endif
}
-/* This is a trampoline function that flushes registers to the stack,
- and then calls FUNC. ARG is passed through to FUNC verbatim.
+/* flush_stack_call_func is the trampoline function that flushes
+ registers to the stack, and then calls FUNC. ARG is passed through
+ to FUNC verbatim.
This function must be called whenever Emacs is about to release the
global interpreter lock. This lets the garbage collector easily
@@ -4939,10 +5041,23 @@ mark_stack (char const *bottom, char const *end)
Lisp.
It is invalid to run any Lisp code or to allocate any GC memory
- from FUNC. */
+ from FUNC.
+
+ Note: all register spilling is done in flush_stack_call_func before
+ flush_stack_call_func1 is activated.
+
+ flush_stack_call_func1 is responsible for identifying the stack
+ address range to be scanned. It *must* be carefully kept as
+ noinline to make sure that registers has been spilled before it is
+ called, otherwise given __builtin_frame_address (0) typically
+ returns the frame pointer (base pointer) and not the stack pointer
+ [1] GC will miss to scan callee-saved registers content
+ (Bug#41357).
+
+ [1] <https://gcc.gnu.org/onlinedocs/gcc/Return-Address.html>. */
NO_INLINE void
-flush_stack_call_func (void (*func) (void *arg), void *arg)
+flush_stack_call_func1 (void (*func) (void *arg), void *arg)
{
void *end;
struct thread_state *self = current_thread;
@@ -5032,9 +5147,6 @@ valid_lisp_object_p (Lisp_Object obj)
case MEM_TYPE_SPARE:
return 0;
- case MEM_TYPE_BUFFER:
- return live_buffer_p (m, p) ? 1 : 2;
-
case MEM_TYPE_CONS:
return live_cons_p (m, p);
@@ -5048,8 +5160,10 @@ valid_lisp_object_p (Lisp_Object obj)
return live_float_p (m, p);
case MEM_TYPE_VECTORLIKE:
+ return live_large_vector_p (m, p);
+
case MEM_TYPE_VECTOR_BLOCK:
- return live_vector_p (m, p);
+ return live_small_vector_p (m, p);
default:
break;
@@ -5099,7 +5213,7 @@ pure_alloc (size_t size, int type)
pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp;
if (pure_bytes_used <= pure_size)
- return ptr_bounds_clip (result, size);
+ return result;
/* Don't allocate a large amount here,
because it might get mmap'd and then its address
@@ -5190,7 +5304,7 @@ find_string_data_in_pure (const char *data, ptrdiff_t nbytes)
/* Check the remaining characters. */
if (memcmp (data, non_lisp_beg + start, nbytes) == 0)
/* Found. */
- return ptr_bounds_clip (non_lisp_beg + start, nbytes + 1);
+ return non_lisp_beg + start;
start += last_char_skip;
}
@@ -5571,7 +5685,7 @@ compact_font_cache_entry (Lisp_Object entry)
struct font *font = GC_XFONT_OBJECT (val);
if (!NILP (AREF (val, FONT_TYPE_INDEX))
- && vectorlike_marked_p(&font->header))
+ && vectorlike_marked_p (&font->header))
break;
}
if (CONSP (objlist))
@@ -5851,7 +5965,7 @@ maybe_garbage_collect (void)
void
garbage_collect (void)
{
- struct buffer *nextb;
+ Lisp_Object tail, buffer;
char stack_top_variable;
bool message_p;
ptrdiff_t count = SPECPDL_INDEX ();
@@ -5867,8 +5981,8 @@ garbage_collect (void)
/* Don't keep undo information around forever.
Do this early on, so it is no problem if the user quits. */
- FOR_EACH_BUFFER (nextb)
- compact_buffer (nextb);
+ FOR_EACH_LIVE_BUFFER (tail, buffer)
+ compact_buffer (XBUFFER (buffer));
byte_ct tot_before = (profiler_memory_running
? total_bytes_of_live_objects ()
@@ -5914,7 +6028,6 @@ garbage_collect (void)
stack_copy = xrealloc (stack_copy, stack_size);
stack_copy_size = stack_size;
}
- stack = ptr_bounds_set (stack, stack_size);
no_sanitize_memcpy (stack_copy, stack, stack_size);
}
}
@@ -5958,8 +6071,9 @@ garbage_collect (void)
compact_font_caches ();
- FOR_EACH_BUFFER (nextb)
+ FOR_EACH_LIVE_BUFFER (tail, buffer)
{
+ struct buffer *nextb = XBUFFER (buffer);
if (!EQ (BVAR (nextb, undo_list), Qt))
bset_undo_list (nextb, compact_undo_list (BVAR (nextb, undo_list)));
/* Now that we have stripped the elements that need not be
@@ -6133,7 +6247,6 @@ mark_vectorlike (union vectorlike_header *header)
{
struct Lisp_Vector *ptr = (struct Lisp_Vector *) header;
ptrdiff_t size = ptr->header.size;
- ptrdiff_t i;
eassert (!vector_marked_p (ptr));
@@ -6148,8 +6261,7 @@ mark_vectorlike (union vectorlike_header *header)
the number of Lisp_Object fields that we should trace.
The distinction is used e.g. by Lisp_Process which places extra
non-Lisp_Object fields at the end of the structure... */
- for (i = 0; i < size; i++) /* ...and then mark its elements. */
- mark_object (ptr->contents[i]);
+ mark_objects (ptr->contents, size);
}
/* Like mark_vectorlike but optimized for char-tables (and
@@ -6224,7 +6336,12 @@ mark_buffer (struct buffer *buffer)
/* For now, we just don't mark the undo_list. It's done later in
a special way just before the sweep phase, and after stripping
- some of its elements that are not needed any more. */
+ some of its elements that are not needed any more.
+ Note: this later processing is only done for live buffers, so
+ for dead buffers, the undo_list should be nil (set by Fkill_buffer),
+ but just to be on the safe side, we mark it here. */
+ if (!BUFFER_LIVE_P (buffer))
+ mark_object (BVAR (buffer, undo_list));
mark_overlay (buffer->overlays_before);
mark_overlay (buffer->overlays_after);
@@ -6243,8 +6360,7 @@ mark_face_cache (struct face_cache *c)
{
if (c)
{
- int i, j;
- for (i = 0; i < c->used; ++i)
+ for (int i = 0; i < c->used; i++)
{
struct face *face = FACE_FROM_ID_OR_NULL (c->f, i);
@@ -6253,8 +6369,7 @@ mark_face_cache (struct face_cache *c)
if (face->font && !vectorlike_marked_p (&face->font->header))
mark_vectorlike (&face->font->header);
- for (j = 0; j < LFACE_VECTOR_SIZE; ++j)
- mark_object (face->lface[j]);
+ mark_objects (face->lface, LFACE_VECTOR_SIZE);
}
}
}
@@ -6367,6 +6482,13 @@ mark_hash_table (struct Lisp_Vector *ptr)
}
}
+void
+mark_objects (Lisp_Object *obj, ptrdiff_t n)
+{
+ for (ptrdiff_t i = 0; i < n; i++)
+ mark_object (obj[i]);
+}
+
/* Determine type of generic Lisp_Object and mark it accordingly.
This function implements a straightforward depth-first marking
@@ -6404,7 +6526,7 @@ mark_object (Lisp_Object arg)
structure allocated from the heap. */
#define CHECK_ALLOCATED() \
do { \
- if (pdumper_object_p(po)) \
+ if (pdumper_object_p (po)) \
{ \
if (!pdumper_object_p_precise (po)) \
emacs_abort (); \
@@ -6417,19 +6539,19 @@ mark_object (Lisp_Object arg)
/* Check that the object pointed to by PO is live, using predicate
function LIVEP. */
-#define CHECK_LIVE(LIVEP) \
+#define CHECK_LIVE(LIVEP, MEM_TYPE) \
do { \
- if (pdumper_object_p(po)) \
+ if (pdumper_object_p (po)) \
break; \
- if (!LIVEP (m, po)) \
+ if (! (m->type == MEM_TYPE && LIVEP (m, po))) \
emacs_abort (); \
} while (0)
/* Check both of the above conditions, for non-symbols. */
-#define CHECK_ALLOCATED_AND_LIVE(LIVEP) \
+#define CHECK_ALLOCATED_AND_LIVE(LIVEP, MEM_TYPE) \
do { \
CHECK_ALLOCATED (); \
- CHECK_LIVE (LIVEP); \
+ CHECK_LIVE (LIVEP, MEM_TYPE); \
} while (false)
/* Check both of the above conditions, for symbols. */
@@ -6438,15 +6560,14 @@ mark_object (Lisp_Object arg)
if (!c_symbol_p (ptr)) \
{ \
CHECK_ALLOCATED (); \
- CHECK_LIVE (live_symbol_p); \
+ CHECK_LIVE (live_symbol_p, MEM_TYPE_SYMBOL); \
} \
} while (false)
#else /* not GC_CHECK_MARKED_OBJECTS */
-#define CHECK_LIVE(LIVEP) ((void) 0)
-#define CHECK_ALLOCATED_AND_LIVE(LIVEP) ((void) 0)
-#define CHECK_ALLOCATED_AND_LIVE_SYMBOL() ((void) 0)
+#define CHECK_ALLOCATED_AND_LIVE(LIVEP, MEM_TYPE) ((void) 0)
+#define CHECK_ALLOCATED_AND_LIVE_SYMBOL() ((void) 0)
#endif /* not GC_CHECK_MARKED_OBJECTS */
@@ -6457,7 +6578,7 @@ mark_object (Lisp_Object arg)
register struct Lisp_String *ptr = XSTRING (obj);
if (string_marked_p (ptr))
break;
- CHECK_ALLOCATED_AND_LIVE (live_string_p);
+ CHECK_ALLOCATED_AND_LIVE (live_string_p, MEM_TYPE_STRING);
set_string_marked (ptr);
mark_interval_tree (ptr->u.s.intervals);
#ifdef GC_CHECK_STRING_BYTES
@@ -6475,36 +6596,25 @@ mark_object (Lisp_Object arg)
if (vector_marked_p (ptr))
break;
+ enum pvec_type pvectype
+ = PSEUDOVECTOR_TYPE (ptr);
+
#ifdef GC_CHECK_MARKED_OBJECTS
- if (!pdumper_object_p(po))
+ if (!pdumper_object_p (po) && !SUBRP (obj) && !main_thread_p (po))
{
m = mem_find (po);
- if (m == MEM_NIL && !SUBRP (obj) && !main_thread_p (po))
+ if (m == MEM_NIL)
emacs_abort ();
+ if (m->type == MEM_TYPE_VECTORLIKE)
+ CHECK_LIVE (live_large_vector_p, MEM_TYPE_VECTORLIKE);
+ else
+ CHECK_LIVE (live_small_vector_p, MEM_TYPE_VECTOR_BLOCK);
}
-#endif /* GC_CHECK_MARKED_OBJECTS */
-
- enum pvec_type pvectype
- = PSEUDOVECTOR_TYPE (ptr);
-
- if (pvectype != PVEC_SUBR &&
- pvectype != PVEC_BUFFER &&
- !main_thread_p (po))
- CHECK_LIVE (live_vector_p);
+#endif
switch (pvectype)
{
case PVEC_BUFFER:
-#if GC_CHECK_MARKED_OBJECTS
- {
- struct buffer *b;
- FOR_EACH_BUFFER (b)
- if (b == po)
- break;
- if (b == NULL)
- emacs_abort ();
- }
-#endif /* GC_CHECK_MARKED_OBJECTS */
mark_buffer ((struct buffer *) ptr);
break;
@@ -6539,7 +6649,7 @@ mark_object (Lisp_Object arg)
/* bool vectors in a dump are permanently "marked", since
they're in the old section and don't have mark bits.
If we're looking at a dumped bool vector, we should
- have aborted above when we called vector_marked_p(), so
+ have aborted above when we called vector_marked_p, so
we should never get here. */
eassert (!pdumper_object_p (ptr));
set_vector_marked (ptr);
@@ -6570,7 +6680,7 @@ mark_object (Lisp_Object arg)
if (symbol_marked_p (ptr))
break;
CHECK_ALLOCATED_AND_LIVE_SYMBOL ();
- set_symbol_marked(ptr);
+ set_symbol_marked (ptr);
/* Attempt to catch bogus objects. */
eassert (valid_lisp_object_p (ptr->u.s.function));
mark_object (ptr->u.s.function);
@@ -6611,7 +6721,7 @@ mark_object (Lisp_Object arg)
struct Lisp_Cons *ptr = XCONS (obj);
if (cons_marked_p (ptr))
break;
- CHECK_ALLOCATED_AND_LIVE (live_cons_p);
+ CHECK_ALLOCATED_AND_LIVE (live_cons_p, MEM_TYPE_CONS);
set_cons_marked (ptr);
/* If the cdr is nil, avoid recursion for the car. */
if (NILP (ptr->u.s.u.cdr))
@@ -6629,7 +6739,7 @@ mark_object (Lisp_Object arg)
}
case Lisp_Float:
- CHECK_ALLOCATED_AND_LIVE (live_float_p);
+ CHECK_ALLOCATED_AND_LIVE (live_float_p, MEM_TYPE_FLOAT);
/* Do not mark floats stored in a dump image: these floats are
"cold" and do not have mark bits. */
if (pdumper_object_p (XFLOAT (obj)))
@@ -6756,8 +6866,7 @@ sweep_conses (void)
for (pos = start; pos < stop; pos++)
{
- struct Lisp_Cons *acons
- = ptr_bounds_copy (&cblk->conses[pos], cblk);
+ struct Lisp_Cons *acons = &cblk->conses[pos];
if (!XCONS_MARKED_P (acons))
{
this_free++;
@@ -6810,7 +6919,7 @@ sweep_floats (void)
int this_free = 0;
for (int i = 0; i < lim; i++)
{
- struct Lisp_Float *afloat = ptr_bounds_copy (&fblk->floats[i], fblk);
+ struct Lisp_Float *afloat = &fblk->floats[i];
if (!XFLOAT_MARKED_P (afloat))
{
this_free++;
@@ -6983,25 +7092,17 @@ NO_INLINE /* For better stack traces */
static void
sweep_buffers (void)
{
- struct buffer *buffer, **bprev = &all_buffers;
+ Lisp_Object tail, buf;
gcstat.total_buffers = 0;
- for (buffer = all_buffers; buffer; buffer = *bprev)
- if (!vectorlike_marked_p (&buffer->header))
- {
- *bprev = buffer->next;
- lisp_free (buffer);
- }
- else
- {
- if (!pdumper_object_p (buffer))
- XUNMARK_VECTOR (buffer);
- /* Do not use buffer_(set|get)_intervals here. */
- buffer->text->intervals = balance_intervals (buffer->text->intervals);
- unchain_dead_markers (buffer);
- gcstat.total_buffers++;
- bprev = &buffer->next;
- }
+ FOR_EACH_LIVE_BUFFER (tail, buf)
+ {
+ struct buffer *buffer = XBUFFER (buf);
+ /* Do not use buffer_(set|get)_intervals here. */
+ buffer->text->intervals = balance_intervals (buffer->text->intervals);
+ unchain_dead_markers (buffer);
+ gcstat.total_buffers++;
+ }
}
/* Sweep: find all structures not marked, and free them. */
diff --git a/src/bidi.c b/src/bidi.c
index 3abde7fcb09..1017bd2d523 100644
--- a/src/bidi.c
+++ b/src/bidi.c
@@ -109,7 +109,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
-------------------
In a nutshell, fetching the next character boils down to calling
- STRING_CHAR_AND_LENGTH, passing it the address of a buffer or
+ string_char_and_length, passing it the address of a buffer or
string position. See bidi_fetch_char. However, if the next
character is "covered" by a display property of some kind,
bidi_fetch_char returns the u+FFFC "object replacement character"
@@ -1269,7 +1269,6 @@ bidi_fetch_char (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t *disp_pos,
ptrdiff_t endpos
= (string->s || STRINGP (string->lstring)) ? string->schars : ZV;
struct text_pos pos;
- int len;
/* If we got past the last known position of display string, compute
the position of the next one. That position could be at CHARPOS. */
@@ -1341,10 +1340,10 @@ bidi_fetch_char (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t *disp_pos,
normal_char:
if (string->s)
{
-
if (!string->unibyte)
{
- ch = STRING_CHAR_AND_LENGTH (string->s + bytepos, len);
+ int len;
+ ch = string_char_and_length (string->s + bytepos, &len);
*ch_len = len;
}
else
@@ -1357,8 +1356,9 @@ bidi_fetch_char (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t *disp_pos,
{
if (!string->unibyte)
{
- ch = STRING_CHAR_AND_LENGTH (SDATA (string->lstring) + bytepos,
- len);
+ int len;
+ ch = string_char_and_length (SDATA (string->lstring) + bytepos,
+ &len);
*ch_len = len;
}
else
@@ -1369,9 +1369,11 @@ bidi_fetch_char (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t *disp_pos,
}
else
{
- ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (bytepos), len);
+ int len;
+ ch = string_char_and_length (BYTE_POS_ADDR (bytepos), &len);
*ch_len = len;
}
+
*nchars = 1;
}
@@ -1550,7 +1552,7 @@ bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte)
display string? And what if a display string covering some
of the text over which we scan back includes
paragraph_start_re? */
- DEC_BOTH (pos, pos_byte);
+ dec_both (&pos, &pos_byte);
if (bpc && region_cache_backward (cache_buffer, bpc, pos, &next))
{
pos = next, pos_byte = CHAR_TO_BYTE (pos);
@@ -1763,7 +1765,7 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, bool no_default_p)
/* FXIME: What if p is covered by a display
string? See also a FIXME inside
bidi_find_paragraph_start. */
- DEC_BOTH (p, pbyte);
+ dec_both (&p, &pbyte);
prevpbyte = bidi_find_paragraph_start (p, pbyte);
}
pstartbyte = prevpbyte;
diff --git a/src/bignum.c b/src/bignum.c
index 51d90ffaefa..669df4d9ee3 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -431,3 +431,39 @@ make_bignum_str (char const *num, int base)
eassert (check == 0);
return make_lisp_ptr (b, Lisp_Vectorlike);
}
+
+/* Check that X is a Lisp integer in the range LO..HI.
+ Return X's value as an intmax_t. */
+
+intmax_t
+check_integer_range (Lisp_Object x, intmax_t lo, intmax_t hi)
+{
+ CHECK_INTEGER (x);
+ intmax_t i;
+ if (! (integer_to_intmax (x, &i) && lo <= i && i <= hi))
+ args_out_of_range_3 (x, make_int (lo), make_int (hi));
+ return i;
+}
+
+/* Check that X is a Lisp integer in the range 0..HI.
+ Return X's value as an uintmax_t. */
+
+uintmax_t
+check_uinteger_max (Lisp_Object x, uintmax_t hi)
+{
+ CHECK_INTEGER (x);
+ uintmax_t i;
+ if (! (integer_to_uintmax (x, &i) && i <= hi))
+ args_out_of_range_3 (x, make_fixnum (0), make_uint (hi));
+ return i;
+}
+
+/* Check that X is a Lisp integer no greater than INT_MAX,
+ and return its value or zero, whichever is greater. */
+
+int
+check_int_nonnegative (Lisp_Object x)
+{
+ CHECK_INTEGER (x);
+ return NILP (Fnatnump (x)) ? 0 : check_integer_range (x, 0, INT_MAX);
+}
diff --git a/src/bignum.h b/src/bignum.h
index 0c2541a9dc7..251a19e338a 100644
--- a/src/bignum.h
+++ b/src/bignum.h
@@ -22,12 +22,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef BIGNUM_H
#define BIGNUM_H
-#ifdef HAVE_GMP
-# include <gmp.h>
-#else
-# include "mini-gmp.h"
-#endif
-
+#include <gmp.h>
#include "lisp.h"
/* Number of data bits in a limb. */
@@ -55,7 +50,7 @@ extern void emacs_mpz_mul_2exp (mpz_t, mpz_t const, EMACS_INT)
ARG_NONNULL ((1, 2));
extern void emacs_mpz_pow_ui (mpz_t, mpz_t const, unsigned long)
ARG_NONNULL ((1, 2));
-extern double mpz_get_d_rounded (mpz_t const);
+extern double mpz_get_d_rounded (mpz_t const) ATTRIBUTE_CONST;
INLINE_HEADER_BEGIN
@@ -108,7 +103,8 @@ bignum_integer (mpz_t *tmp, Lisp_Object i)
if (FIXNUMP (i))
{
mpz_set_intmax (*tmp, XFIXNUM (i));
- return tmp;
+ /* The unnecessary cast pacifies a buggy GCC 4.8.5. */
+ return (mpz_t const *) tmp;
}
return xbignum_val (i);
}
diff --git a/src/buffer.c b/src/buffer.c
index 92ed405b6f7..241f2d43a93 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -51,11 +51,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "w32heap.h" /* for mmap_* */
#endif
-/* First buffer in chain of all buffers (in reverse order of creation).
- Threaded through ->header.next.buffer. */
-
-struct buffer *all_buffers;
-
/* This structure holds the default values of the buffer-local variables
defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
The default value occupies the same slot in this structure
@@ -124,6 +119,7 @@ static void free_buffer_text (struct buffer *b);
static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *);
static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool);
+static Lisp_Object buffer_local_variables_1 (struct buffer *buf, int offset, Lisp_Object sym);
static void
CHECK_OVERLAY (Lisp_Object x)
@@ -131,6 +127,23 @@ CHECK_OVERLAY (Lisp_Object x)
CHECK_TYPE (OVERLAYP (x), Qoverlayp, x);
}
+/* Convert the position POS to an EMACS_INT that fits in a fixnum.
+ Yield POS's value if POS is already a fixnum, POS's marker position
+ if POS is a marker, and MOST_NEGATIVE_FIXNUM or
+ MOST_POSITIVE_FIXNUM if POS is a negative or positive bignum.
+ Signal an error if POS is not of the proper form. */
+
+EMACS_INT
+fix_position (Lisp_Object pos)
+{
+ if (FIXNUMP (pos))
+ return XFIXNUM (pos);
+ if (MARKERP (pos))
+ return marker_position (pos);
+ CHECK_TYPE (BIGNUMP (pos), Qinteger_or_marker_p, pos);
+ return !NILP (Fnatnump (pos)) ? MOST_POSITIVE_FIXNUM : MOST_NEGATIVE_FIXNUM;
+}
+
/* These setters are used only in this file, so they can be private.
The public setters are inline functions defined in buffer.h. */
static void
@@ -1288,6 +1301,25 @@ buffer_lisp_local_variables (struct buffer *buf, bool clone)
return result;
}
+
+/* If the variable at position index OFFSET in buffer BUF has a
+ buffer-local value, return (name . value). If SYM is non-nil,
+ it replaces name. */
+
+static Lisp_Object
+buffer_local_variables_1 (struct buffer *buf, int offset, Lisp_Object sym)
+{
+ int idx = PER_BUFFER_IDX (offset);
+ if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
+ && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
+ {
+ sym = NILP (sym) ? PER_BUFFER_SYMBOL (offset) : sym;
+ Lisp_Object val = per_buffer_value (buf, offset);
+ return EQ (val, Qunbound) ? sym : Fcons (sym, val);
+ }
+ return Qnil;
+}
+
DEFUN ("buffer-local-variables", Fbuffer_local_variables,
Sbuffer_local_variables, 0, 1, 0,
doc: /* Return an alist of variables that are buffer-local in BUFFER.
@@ -1299,25 +1331,25 @@ No argument or nil as argument means use current buffer as BUFFER. */)
{
struct buffer *buf = decode_buffer (buffer);
Lisp_Object result = buffer_lisp_local_variables (buf, 0);
+ Lisp_Object tem;
/* Add on all the variables stored in special slots. */
{
- int offset, idx;
+ int offset;
FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
{
- idx = PER_BUFFER_IDX (offset);
- if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
- && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
- {
- Lisp_Object sym = PER_BUFFER_SYMBOL (offset);
- Lisp_Object val = per_buffer_value (buf, offset);
- result = Fcons (EQ (val, Qunbound) ? sym : Fcons (sym, val),
- result);
- }
+ tem = buffer_local_variables_1 (buf, offset, Qnil);
+ if (!NILP (tem))
+ result = Fcons (tem, result);
}
}
+ tem = buffer_local_variables_1 (buf, PER_BUFFER_VAR_OFFSET (undo_list),
+ intern ("buffer-undo-list"));
+ if (!NILP (tem))
+ result = Fcons (tem, result);
+
return result;
}
@@ -1769,15 +1801,11 @@ cleaning up all windows currently displaying the buffer to be killed. */)
ask questions or their hooks get errors. */
if (!b->base_buffer && b->indirections > 0)
{
- struct buffer *other;
+ Lisp_Object tail, other;
- FOR_EACH_BUFFER (other)
- if (other->base_buffer == b)
- {
- Lisp_Object buf;
- XSETBUFFER (buf, other);
- Fkill_buffer (buf);
- }
+ FOR_EACH_LIVE_BUFFER (tail, other)
+ if (XBUFFER (other)->base_buffer == b)
+ Fkill_buffer (other);
/* Exit if we now have killed the base buffer (Bug#11665). */
if (!BUFFER_LIVE_P (b))
@@ -1832,6 +1860,9 @@ cleaning up all windows currently displaying the buffer to be killed. */)
tem = Vinhibit_quit;
Vinhibit_quit = Qt;
+ /* Once the buffer is removed from Vbuffer_alist, its undo_list field is
+ not traced by the GC in the same way. So set it to nil early. */
+ bset_undo_list (b, Qnil);
/* Remove the buffer from the list of all buffers. */
Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
/* If replace_buffer_in_windows didn't do its job fix that now. */
@@ -1946,7 +1977,6 @@ cleaning up all windows currently displaying the buffer to be killed. */)
}
bset_width_table (b, Qnil);
unblock_input ();
- bset_undo_list (b, Qnil);
/* Run buffer-list-update-hook. */
if (!NILP (Vrun_hooks) && !b->inhibit_buffer_hooks)
@@ -2257,19 +2287,20 @@ so the buffer is truly empty after this. */)
}
void
-validate_region (register Lisp_Object *b, register Lisp_Object *e)
+validate_region (Lisp_Object *b, Lisp_Object *e)
{
- CHECK_FIXNUM_COERCE_MARKER (*b);
- CHECK_FIXNUM_COERCE_MARKER (*e);
+ EMACS_INT beg = fix_position (*b), end = fix_position (*e);
- if (XFIXNUM (*b) > XFIXNUM (*e))
+ if (end < beg)
{
- Lisp_Object tem;
- tem = *b; *b = *e; *e = tem;
+ EMACS_INT tem = beg; beg = end; end = tem;
}
- if (! (BEGV <= XFIXNUM (*b) && XFIXNUM (*e) <= ZV))
+ if (! (BEGV <= beg && end <= ZV))
args_out_of_range_3 (Fcurrent_buffer (), *b, *e);
+
+ *b = make_fixnum (beg);
+ *e = make_fixnum (end);
}
/* Advance BYTE_POS up to a character boundary
@@ -2297,7 +2328,7 @@ advance_to_char_boundary (ptrdiff_t byte_pos)
c = FETCH_BYTE (byte_pos);
}
while (! CHAR_HEAD_P (c) && byte_pos > BEG);
- INC_POS (byte_pos);
+ byte_pos += next_char_len (byte_pos);
if (byte_pos < orig_byte_pos)
byte_pos = orig_byte_pos;
/* If C is a constituent of a multibyte sequence, BYTE_POS was
@@ -2333,10 +2364,10 @@ results, see Info node `(elisp)Swapping Text'. */)
error ("Cannot swap indirect buffers's text");
{ /* This is probably harder to make work. */
- struct buffer *other;
- FOR_EACH_BUFFER (other)
- if (other->base_buffer == other_buffer
- || other->base_buffer == current_buffer)
+ Lisp_Object tail, other;
+ FOR_EACH_LIVE_BUFFER (tail, other)
+ if (XBUFFER (other)->base_buffer == other_buffer
+ || XBUFFER (other)->base_buffer == current_buffer)
error ("One of the buffers to swap has indirect buffers");
}
@@ -2484,7 +2515,7 @@ current buffer is cleared. */)
(Lisp_Object flag)
{
struct Lisp_Marker *tail, *markers;
- struct buffer *other;
+ Lisp_Object btail, other;
ptrdiff_t begv, zv;
bool narrowed = (BEG != BEGV || Z != ZV);
bool modified_p = !NILP (Fbuffer_modified_p (Qnil));
@@ -2541,8 +2572,6 @@ current buffer is cleared. */)
p = BEG_ADDR;
while (1)
{
- int c, bytes;
-
if (pos == stop)
{
if (pos == Z)
@@ -2554,7 +2583,7 @@ current buffer is cleared. */)
p++, pos++;
else if (CHAR_BYTE8_HEAD_P (*p))
{
- c = STRING_CHAR_AND_LENGTH (p, bytes);
+ int bytes, c = string_char_and_length (p, &bytes);
/* Delete all bytes for this 8-bit character but the
last one, and change the last one to the character
code. */
@@ -2571,7 +2600,7 @@ current buffer is cleared. */)
}
else
{
- bytes = BYTES_BY_CHAR_HEAD (*p);
+ int bytes = BYTES_BY_CHAR_HEAD (*p);
p += bytes, pos += bytes;
}
}
@@ -2625,8 +2654,7 @@ current buffer is cleared. */)
if (ASCII_CHAR_P (*p))
p++, pos++;
else if (EQ (flag, Qt)
- && ! CHAR_BYTE8_HEAD_P (*p)
- && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0)
+ && 0 < (bytes = multibyte_length (p, pend, true, false)))
p += bytes, pos += bytes;
else
{
@@ -2737,13 +2765,16 @@ current buffer is cleared. */)
/* Copy this buffer's new multibyte status
into all of its indirect buffers. */
- FOR_EACH_BUFFER (other)
- if (other->base_buffer == current_buffer && BUFFER_LIVE_P (other))
- {
- BVAR (other, enable_multibyte_characters)
- = BVAR (current_buffer, enable_multibyte_characters);
- other->prevent_redisplay_optimizations_p = 1;
- }
+ FOR_EACH_LIVE_BUFFER (btail, other)
+ {
+ struct buffer *o = XBUFFER (other);
+ if (o->base_buffer == current_buffer && BUFFER_LIVE_P (o))
+ {
+ BVAR (o, enable_multibyte_characters)
+ = BVAR (current_buffer, enable_multibyte_characters);
+ o->prevent_redisplay_optimizations_p = true;
+ }
+ }
/* Restore the modifiedness of the buffer. */
if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
@@ -5052,6 +5083,7 @@ enlarge_buffer_text (struct buffer *b, ptrdiff_t delta)
#else
p = xrealloc (b->text->beg, new_nbytes);
#endif
+ __lsan_ignore_object (p);
if (p == NULL)
{
@@ -5309,8 +5341,6 @@ init_buffer_once (void)
Vbuffer_alist = Qnil;
current_buffer = 0;
pdumper_remember_lv_ptr_raw (&current_buffer, Lisp_Vectorlike);
- all_buffers = 0;
- pdumper_remember_lv_ptr_raw (&all_buffers, Lisp_Vectorlike);
QSFundamental = build_pure_c_string ("Fundamental");
@@ -5341,7 +5371,7 @@ init_buffer (void)
#ifdef USE_MMAP_FOR_BUFFERS
if (dumped_with_unexec_p ())
{
- struct buffer *b;
+ Lisp_Object tail, buffer;
#ifndef WINDOWSNT
/* These must be reset in the dumped Emacs, to avoid stale
@@ -5363,23 +5393,13 @@ init_buffer (void)
" *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. */
- FOR_EACH_BUFFER (b)
+ FOR_EACH_LIVE_BUFFER (tail, buffer)
{
+ struct buffer *b = XBUFFER (buffer);
b->text->beg = NULL;
enlarge_buffer_text (b, 0);
}
}
- else
- {
- struct buffer *b;
-
- /* Only buffers with allocated buffer text should be present at
- this point in temacs. */
- FOR_EACH_BUFFER (b)
- {
- eassert (b->text->beg != NULL);
- }
- }
#endif /* USE_MMAP_FOR_BUFFERS */
AUTO_STRING (scratch, "*scratch*");
@@ -6247,6 +6267,9 @@ Values are interpreted as follows:
t use the cursor specified for the frame
nil don't display a cursor
box display a filled box cursor
+ (box . SIZE) display a filled box cursor, but make it
+ hollow if cursor is under masked image larger than
+ SIZE pixels in either dimension.
hollow display a hollow box cursor
bar display a vertical bar cursor with default width
(bar . WIDTH) display a vertical bar cursor with width WIDTH
diff --git a/src/buffer.h b/src/buffer.h
index fd05fdd37de..3da49414bb8 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -570,9 +570,6 @@ struct buffer
In an indirect buffer, this is the own_text field of another buffer. */
struct buffer_text *text;
- /* Next buffer, in chain of all buffers, including killed ones. */
- struct buffer *next;
-
/* Char position of point in buffer. */
ptrdiff_t pt;
@@ -1104,15 +1101,6 @@ BUFFER_CHECK_INDIRECTION (struct buffer *b)
}
}
-/* Chain of all buffers, including killed ones. */
-
-extern struct buffer *all_buffers;
-
-/* Used to iterate over the chain above. */
-
-#define FOR_EACH_BUFFER(b) \
- for ((b) = all_buffers; (b); (b) = (b)->next)
-
/* This structure holds the default values of the buffer-local variables
that have special slots in each buffer.
The default value occupies the same slot in this structure
@@ -1150,6 +1138,8 @@ extern Lisp_Object interval_insert_behind_hooks;
extern Lisp_Object interval_insert_in_front_hooks;
+extern EMACS_INT fix_position (Lisp_Object);
+#define CHECK_FIXNUM_COERCE_MARKER(x) ((x) = make_fixnum (fix_position (x)))
extern void delete_all_overlays (struct buffer *);
extern void reset_buffer (struct buffer *);
extern void compact_buffer (struct buffer *);
@@ -1533,6 +1523,146 @@ lowercasep (int c)
return !uppercasep (c) && upcase (c) != c;
}
+/* Return a non-outlandish value for the tab width. */
+
+INLINE int
+sanitize_tab_width (Lisp_Object width)
+{
+ return (FIXNUMP (width) && 0 < XFIXNUM (width) && XFIXNUM (width) <= 1000
+ ? XFIXNUM (width) : 8);
+}
+
+INLINE int
+SANE_TAB_WIDTH (struct buffer *buf)
+{
+ return sanitize_tab_width (BVAR (buf, tab_width));
+}
+
+/* Return a non-outlandish value for a character width. */
+
+INLINE int
+sanitize_char_width (EMACS_INT width)
+{
+ return 0 <= width && width <= 1000 ? width : 1000;
+}
+
+/* Return the width of character C. The width is measured by how many
+ columns C will occupy on the screen when displayed in the current
+ buffer. The name CHARACTER_WIDTH avoids a collision with <limits.h>
+ CHAR_WIDTH. */
+
+INLINE int
+CHARACTER_WIDTH (int c)
+{
+ return (0x20 <= c && c < 0x7f ? 1
+ : 0x7f < c ? (sanitize_char_width
+ (XFIXNUM (CHAR_TABLE_REF (Vchar_width_table, c))))
+ : c == '\t' ? SANE_TAB_WIDTH (current_buffer)
+ : c == '\n' ? 0
+ : !NILP (BVAR (current_buffer, ctl_arrow)) ? 2 : 4);
+}
+
+
+/* Like fetch_string_char_advance, but fetch character from the current
+ buffer. */
+
+INLINE int
+fetch_char_advance (ptrdiff_t *charidx, ptrdiff_t *byteidx)
+{
+ int output;
+ ptrdiff_t c = *charidx, b = *byteidx;
+ c++;
+ unsigned char *chp = BYTE_POS_ADDR (b);
+ if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
+ {
+ int chlen;
+ output = string_char_and_length (chp, &chlen);
+ b += chlen;
+ }
+ else
+ {
+ output = *chp;
+ b++;
+ }
+ *charidx = c;
+ *byteidx = b;
+ return output;
+}
+
+
+/* Like fetch_char_advance, but assumes the current buffer is multibyte. */
+
+INLINE int
+fetch_char_advance_no_check (ptrdiff_t *charidx, ptrdiff_t *byteidx)
+{
+ int output;
+ ptrdiff_t c = *charidx, b = *byteidx;
+ c++;
+ unsigned char *chp = BYTE_POS_ADDR (b);
+ int chlen;
+ output = string_char_and_length (chp, &chlen);
+ b += chlen;
+ *charidx = c;
+ *byteidx = b;
+ return output;
+}
+
+/* Return the number of bytes in the multibyte character in BUF
+ that starts at position POS_BYTE. This relies on the fact that
+ *GPT_ADDR and *Z_ADDR are always accessible and the values are
+ '\0'. No range checking of POS_BYTE. */
+
+INLINE int
+buf_next_char_len (struct buffer *buf, ptrdiff_t pos_byte)
+{
+ unsigned char *chp = BUF_BYTE_ADDRESS (buf, pos_byte);
+ return BYTES_BY_CHAR_HEAD (*chp);
+}
+
+INLINE int
+next_char_len (ptrdiff_t pos_byte)
+{
+ return buf_next_char_len (current_buffer, pos_byte);
+}
+
+/* Return the number of bytes in the multibyte character in BUF just
+ before POS_BYTE. No range checking of POS_BYTE. */
+
+INLINE int
+buf_prev_char_len (struct buffer *buf, ptrdiff_t pos_byte)
+{
+ unsigned char *chp
+ = (BUF_BEG_ADDR (buf) + pos_byte - BEG_BYTE
+ + (pos_byte <= BUF_GPT_BYTE (buf) ? 0 : BUF_GAP_SIZE (buf)));
+ return raw_prev_char_len (chp);
+}
+
+INLINE int
+prev_char_len (ptrdiff_t pos_byte)
+{
+ return buf_prev_char_len (current_buffer, pos_byte);
+}
+
+/* Increment both *CHARPOS and *BYTEPOS, each in the appropriate way. */
+
+INLINE void
+inc_both (ptrdiff_t *charpos, ptrdiff_t *bytepos)
+{
+ (*charpos)++;
+ (*bytepos) += (!NILP (BVAR (current_buffer, enable_multibyte_characters))
+ ? next_char_len (*bytepos) : 1);
+}
+
+/* Decrement both *CHARPOS and *BYTEPOS, each in the appropriate way. */
+
+INLINE void
+dec_both (ptrdiff_t *charpos, ptrdiff_t *bytepos)
+{
+ (*charpos)--;
+ (*bytepos) -= (!NILP (BVAR (current_buffer, enable_multibyte_characters))
+ ? prev_char_len (*bytepos) : 1);
+}
+
INLINE_HEADER_END
#endif /* EMACS_BUFFER_H */
diff --git a/src/bytecode.c b/src/bytecode.c
index 9e75c9012e0..1c3b6eac0d1 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -24,7 +24,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "character.h"
#include "buffer.h"
#include "keyboard.h"
-#include "ptr-bounds.h"
#include "syntax.h"
#include "window.h"
@@ -47,7 +46,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
indirect threaded, using GCC's computed goto extension. This code,
as currently implemented, is incompatible with BYTE_CODE_SAFE and
BYTE_CODE_METER. */
-#if (defined __GNUC__ && !defined __STRICT_ANSI__ && !defined __CHKP__ \
+#if (defined __GNUC__ && !defined __STRICT_ANSI__ \
&& !BYTE_CODE_SAFE && !defined BYTE_CODE_METER)
#define BYTE_CODE_THREADED
#endif
@@ -220,10 +219,10 @@ DEFINE (Bdup, 0211) \
DEFINE (Bsave_excursion, 0212) \
DEFINE (Bsave_window_excursion, 0213) /* Obsolete since Emacs-24.1. */ \
DEFINE (Bsave_restriction, 0214) \
-DEFINE (Bcatch, 0215) \
+DEFINE (Bcatch, 0215) /* Obsolete since Emacs-25. */ \
\
DEFINE (Bunwind_protect, 0216) \
-DEFINE (Bcondition_case, 0217) \
+DEFINE (Bcondition_case, 0217) /* Obsolete since Emacs-25. */ \
DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1. */ \
DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \
\
@@ -319,6 +318,19 @@ the third, MAXDEPTH, the maximum stack depth used in this function.
If the third argument is incorrect, Emacs may crash. */)
(Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth)
{
+ if (! (STRINGP (bytestr) && VECTORP (vector) && FIXNATP (maxdepth)))
+ error ("Invalid byte-code");
+
+ if (STRING_MULTIBYTE (bytestr))
+ {
+ /* BYTESTR must have been produced by Emacs 20.2 or earlier
+ because it produced a raw 8-bit string for byte-code and now
+ such a byte-code string is loaded as multibyte with raw 8-bit
+ characters converted to multibyte form. Convert them back to
+ the original unibyte form. */
+ bytestr = Fstring_as_unibyte (bytestr);
+ }
+
return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL);
}
@@ -344,21 +356,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
int volatile this_op = 0;
#endif
- CHECK_STRING (bytestr);
- CHECK_VECTOR (vector);
- CHECK_FIXNAT (maxdepth);
+ eassert (!STRING_MULTIBYTE (bytestr));
ptrdiff_t const_length = ASIZE (vector);
-
- if (STRING_MULTIBYTE (bytestr))
- /* BYTESTR must have been produced by Emacs 20.2 or the earlier
- because they produced a raw 8-bit string for byte-code and now
- such a byte-code string is loaded as multibyte while raw 8-bit
- characters converted to multibyte form. Thus, now we must
- convert them back to the originally intended unibyte form. */
- bytestr = Fstring_as_unibyte (bytestr);
-
- ptrdiff_t bytestr_length = SBYTES (bytestr);
+ ptrdiff_t bytestr_length = SCHARS (bytestr);
Lisp_Object *vectorp = XVECTOR (vector)->contents;
unsigned char quitcounter = 1;
@@ -366,14 +367,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
USE_SAFE_ALLOCA;
void *alloc;
SAFE_ALLOCA_LISP_EXTRA (alloc, stack_items, bytestr_length);
- ptrdiff_t item_bytes = stack_items * word_size;
- Lisp_Object *stack_base = ptr_bounds_clip (alloc, item_bytes);
+ Lisp_Object *stack_base = alloc;
Lisp_Object *top = stack_base;
*top = vector; /* Ensure VECTOR survives GC (Bug#33014). */
Lisp_Object *stack_lim = stack_base + stack_items;
- unsigned char *bytestr_data = alloc;
- bytestr_data = ptr_bounds_clip (bytestr_data + item_bytes, bytestr_length);
- memcpy (bytestr_data, SDATA (bytestr), bytestr_length);
+ unsigned char const *bytestr_data = memcpy (stack_lim,
+ SDATA (bytestr), bytestr_length);
unsigned char const *pc = bytestr_data;
ptrdiff_t count = SPECPDL_INDEX ();
@@ -763,7 +762,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
save_restriction_save ());
NEXT;
- CASE (Bcatch): /* Obsolete since 24.4. */
+ CASE (Bcatch): /* Obsolete since 25. */
{
Lisp_Object v1 = POP;
TOP = internal_catch (TOP, eval_sub, v1);
@@ -807,7 +806,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
NEXT;
}
- CASE (Bcondition_case): /* Obsolete since 24.4. */
+ CASE (Bcondition_case): /* Obsolete since 25. */
{
Lisp_Object handlers = POP, body = POP;
TOP = internal_lisp_condition_case (TOP, body, handlers);
@@ -1172,7 +1171,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CHECK_CHARACTER (TOP);
int c = XFIXNAT (TOP);
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
- MAKE_CHAR_MULTIBYTE (c);
+ c = make_char_multibyte (c);
XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]);
}
NEXT;
@@ -1402,7 +1401,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
Lisp_Object v1 = POP;
ptrdiff_t i;
struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table);
- hash_rehash_if_needed (h);
/* h->count is a faster approximation for HASH_TABLE_SIZE (h)
here. */
diff --git a/src/callint.c b/src/callint.c
index eb916353a0c..f609c96a6fa 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -21,7 +21,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include "lisp.h"
-#include "ptr-bounds.h"
#include "character.h"
#include "buffer.h"
#include "keyboard.h"
@@ -440,9 +439,6 @@ invoke it (via an `interactive' spec that contains, for instance, an
signed char *varies = (signed char *) (visargs + nargs);
memclear (args, nargs * (2 * word_size + 1));
- args = ptr_bounds_clip (args, nargs * sizeof *args);
- visargs = ptr_bounds_clip (visargs, nargs * sizeof *visargs);
- varies = ptr_bounds_clip (varies, nargs * sizeof *varies);
if (!NILP (enable))
specbind (Qenable_recursive_minibuffers, Qt);
diff --git a/src/callproc.c b/src/callproc.c
index 8883415f3f5..e3346e2eabb 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -231,6 +231,9 @@ DESTINATION can also have the form (REAL-BUFFER STDERR-FILE); in that case,
Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
Remaining arguments ARGS are strings passed as command arguments to PROGRAM.
+If PROGRAM is not an absolute file name, `call-process' will look for
+PROGRAM in `exec-path' (which is a list of directories).
+
If executable PROGRAM can't be found as an executable, `call-process'
signals a Lisp error. `call-process' reports errors in execution of
the program only through its return and output.
@@ -1060,6 +1063,9 @@ Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
Remaining arguments ARGS are passed to PROGRAM at startup as command-line
arguments.
+If PROGRAM is not an absolute file name, `call-process-region' will
+look for PROGRAM in `exec-path' (which is a list of directories).
+
If BUFFER is 0, `call-process-region' returns immediately with value nil.
Otherwise it waits for PROGRAM to terminate
and returns a numeric exit status or a signal description string.
@@ -1099,7 +1105,17 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
}
if (nargs > 3 && !NILP (args[3]))
- Fdelete_region (start, end);
+ {
+ if (NILP (start))
+ {
+ /* No need to save restrictions since we delete everything
+ anyway. */
+ Fwiden ();
+ del_range (BEG, Z);
+ }
+ else
+ Fdelete_region (start, end);
+ }
if (nargs > 3)
{
diff --git a/src/casefiddle.c b/src/casefiddle.c
index 1945aa15e71..debd2412238 100644
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -220,6 +220,13 @@ case_character (struct casing_str_buf *buf, struct casing_context *ctx,
return changed;
}
+/* If C is not ASCII, make it unibyte. */
+static inline int
+make_char_unibyte (int c)
+{
+ return ASCII_CHAR_P (c) ? c : CHAR_TO_BYTE8 (c);
+}
+
static Lisp_Object
do_casify_natnum (struct casing_context *ctx, Lisp_Object obj)
{
@@ -229,7 +236,7 @@ do_casify_natnum (struct casing_context *ctx, Lisp_Object obj)
/* If the character has higher bits set above the flags, return it unchanged.
It is not a real character. */
- if (UNSIGNED_CMP (ch, >, flagbits))
+ if (! (0 <= ch && ch <= flagbits))
return obj;
int flags = ch & flagbits;
@@ -243,13 +250,13 @@ do_casify_natnum (struct casing_context *ctx, Lisp_Object obj)
|| !NILP (BVAR (current_buffer,
enable_multibyte_characters)));
if (! multibyte)
- MAKE_CHAR_MULTIBYTE (ch);
+ ch = make_char_multibyte (ch);
int cased = case_single_character (ctx, ch);
if (cased == ch)
return obj;
if (! multibyte)
- MAKE_CHAR_UNIBYTE (cased);
+ cased = make_char_unibyte (cased);
return make_fixed_natnum (cased | flags);
}
@@ -278,7 +285,7 @@ do_casify_multibyte_string (struct casing_context *ctx, Lisp_Object obj)
{
if (dst_end - o < sizeof (struct casing_str_buf))
string_overflow ();
- int ch = STRING_CHAR_ADVANCE (src);
+ int ch = string_char_advance (&src);
case_character ((struct casing_str_buf *) o, ctx, ch,
size > 1 ? src : NULL);
n += ((struct casing_str_buf *) o)->len_chars;
@@ -299,15 +306,14 @@ do_casify_unibyte_string (struct casing_context *ctx, Lisp_Object obj)
obj = Fcopy_sequence (obj);
for (i = 0; i < size; i++)
{
- ch = SREF (obj, i);
- MAKE_CHAR_MULTIBYTE (ch);
+ ch = make_char_multibyte (SREF (obj, i));
cased = case_single_character (ctx, ch);
if (ch == cased)
continue;
- MAKE_CHAR_UNIBYTE (cased);
+ cased = make_char_unibyte (cased);
/* If the char can't be converted to a valid byte, just don't
change it. */
- if (cased >= 0 && cased < 256)
+ if (SINGLE_BYTE_CHAR_P (cased))
SSET (obj, i, cased);
}
return obj;
@@ -397,9 +403,7 @@ do_casify_unibyte_region (struct casing_context *ctx,
for (ptrdiff_t pos = *startp; pos < end; ++pos)
{
- int ch = FETCH_BYTE (pos);
- MAKE_CHAR_MULTIBYTE (ch);
-
+ int ch = make_char_multibyte (FETCH_BYTE (pos));
int cased = case_single_character (ctx, ch);
if (cased == ch)
continue;
@@ -408,8 +412,7 @@ do_casify_unibyte_region (struct casing_context *ctx,
if (first < 0)
first = pos;
- MAKE_CHAR_UNIBYTE (cased);
- FETCH_BYTE (pos) = cased;
+ FETCH_BYTE (pos) = make_char_unibyte (cased);
}
*startp = first;
@@ -433,8 +436,7 @@ do_casify_multibyte_region (struct casing_context *ctx,
for (; size; --size)
{
- int len;
- int ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (pos_byte), len);
+ int len, ch = string_char_and_length (BYTE_POS_ADDR (pos_byte), &len);
struct casing_str_buf buf;
if (!case_character (&buf, ctx, ch,
size > 1 ? BYTE_POS_ADDR (pos_byte + len) : NULL))
diff --git a/src/ccl.c b/src/ccl.c
index ac44dc1f608..796698eb1ce 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -855,6 +855,13 @@ struct ccl_prog_stack
/* For the moment, we only support depth 256 of stack. */
static struct ccl_prog_stack ccl_prog_stack_struct[256];
+/* Return a translation table of id number ID. */
+static inline Lisp_Object
+GET_TRANSLATION_TABLE (int id)
+{
+ return XCDR (XVECTOR (Vtranslation_table_vector)->contents[id]);
+}
+
void
ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size, int dst_size, Lisp_Object charset_list)
{
@@ -1135,19 +1142,52 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
ccl_expr_self:
switch (op)
{
- case CCL_PLUS: reg[rrr] += i; break;
- case CCL_MINUS: reg[rrr] -= i; break;
- case CCL_MUL: reg[rrr] *= i; break;
- case CCL_DIV: reg[rrr] /= i; break;
+ case CCL_PLUS: INT_ADD_WRAPV (reg[rrr], i, &reg[rrr]); break;
+ case CCL_MINUS: INT_SUBTRACT_WRAPV (reg[rrr], i, &reg[rrr]); break;
+ case CCL_MUL: INT_MULTIPLY_WRAPV (reg[rrr], i, &reg[rrr]); break;
+ case CCL_DIV:
+ if (!i)
+ CCL_INVALID_CMD;
+ if (!INT_DIVIDE_OVERFLOW (reg[rrr], i))
+ reg[rrr] /= i;
+ break;
case CCL_MOD: reg[rrr] %= i; break;
+ if (!i)
+ CCL_INVALID_CMD;
+ reg[rrr] = i == -1 ? 0 : reg[rrr] % i;
+ break;
case CCL_AND: reg[rrr] &= i; break;
case CCL_OR: reg[rrr] |= i; break;
case CCL_XOR: reg[rrr] ^= i; break;
- case CCL_LSH: reg[rrr] <<= i; break;
- case CCL_RSH: reg[rrr] >>= i; break;
- case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
+ case CCL_LSH:
+ if (i < 0)
+ CCL_INVALID_CMD;
+ reg[rrr] = i < UINT_WIDTH ? (unsigned) reg[rrr] << i : 0;
+ break;
+ case CCL_RSH:
+ if (i < 0)
+ CCL_INVALID_CMD;
+ reg[rrr] = reg[rrr] >> min (i, INT_WIDTH - 1);
+ break;
+ case CCL_LSH8:
+ reg[rrr] = (unsigned) reg[rrr] << 8;
+ reg[rrr] |= i;
+ break;
case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
- case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
+ case CCL_DIVMOD:
+ if (!i)
+ CCL_INVALID_CMD;
+ if (i == -1)
+ {
+ reg[7] = 0;
+ INT_SUBTRACT_WRAPV (0, reg[rrr], &reg[rrr]);
+ }
+ else
+ {
+ reg[7] = reg[rrr] % i;
+ reg[rrr] /= i;
+ }
+ break;
case CCL_LS: reg[rrr] = reg[rrr] < i; break;
case CCL_GT: reg[rrr] = reg[rrr] > i; break;
case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
@@ -1197,19 +1237,52 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
ccl_set_expr:
switch (op)
{
- case CCL_PLUS: reg[rrr] = i + j; break;
- case CCL_MINUS: reg[rrr] = i - j; break;
- case CCL_MUL: reg[rrr] = i * j; break;
- case CCL_DIV: reg[rrr] = i / j; break;
- case CCL_MOD: reg[rrr] = i % j; break;
+ case CCL_PLUS: INT_ADD_WRAPV (i, j, &reg[rrr]); break;
+ case CCL_MINUS: INT_SUBTRACT_WRAPV (i, j, &reg[rrr]); break;
+ case CCL_MUL: INT_MULTIPLY_WRAPV (i, j, &reg[rrr]); break;
+ case CCL_DIV:
+ if (!j)
+ CCL_INVALID_CMD;
+ if (!INT_DIVIDE_OVERFLOW (i, j))
+ i /= j;
+ reg[rrr] = i;
+ break;
+ case CCL_MOD:
+ if (!j)
+ CCL_INVALID_CMD;
+ reg[rrr] = j == -1 ? 0 : i % j;
+ break;
case CCL_AND: reg[rrr] = i & j; break;
case CCL_OR: reg[rrr] = i | j; break;
case CCL_XOR: reg[rrr] = i ^ j; break;
- case CCL_LSH: reg[rrr] = i << j; break;
- case CCL_RSH: reg[rrr] = i >> j; break;
- case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
+ case CCL_LSH:
+ if (j < 0)
+ CCL_INVALID_CMD;
+ reg[rrr] = j < UINT_WIDTH ? (unsigned) i << j : 0;
+ break;
+ case CCL_RSH:
+ if (j < 0)
+ CCL_INVALID_CMD;
+ reg[rrr] = i >> min (j, INT_WIDTH - 1);
+ break;
+ case CCL_LSH8:
+ reg[rrr] = ((unsigned) i << 8) | j;
+ break;
case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
- case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
+ case CCL_DIVMOD:
+ if (!j)
+ CCL_INVALID_CMD;
+ if (j == -1)
+ {
+ INT_SUBTRACT_WRAPV (0, reg[rrr], &reg[rrr]);
+ reg[7] = 0;
+ }
+ else
+ {
+ reg[rrr] = i / j;
+ reg[7] = i % j;
+ }
+ break;
case CCL_LS: reg[rrr] = i < j; break;
case CCL_GT: reg[rrr] = i > j; break;
case CCL_EQ: reg[rrr] = i == j; break;
@@ -1218,7 +1291,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_NE: reg[rrr] = i != j; break;
case CCL_DECODE_SJIS:
{
- i = (i << 8) | j;
+ i = ((unsigned) i << 8) | j;
SJIS_TO_JIS (i);
reg[rrr] = i >> 8;
reg[7] = i & 0xFF;
@@ -1226,7 +1299,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
}
case CCL_ENCODE_SJIS:
{
- i = (i << 8) | j;
+ i = ((unsigned) i << 8) | j;
JIS_TO_SJIS (i);
reg[rrr] = i >> 8;
reg[7] = i & 0xFF;
@@ -1301,7 +1374,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
if (! (IN_INT_RANGE (eop) && CHARACTERP (opl)))
CCL_INVALID_CMD;
reg[RRR] = charset_unicode;
- reg[rrr] = eop;
+ reg[rrr] = XFIXNUM (opl);
reg[7] = 1; /* r7 true for success */
}
else
@@ -2101,7 +2174,7 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY
source[j++] = *p++;
else
while (j < CCL_EXECUTE_BUF_SIZE && p < endp)
- source[j++] = STRING_CHAR_ADVANCE (p);
+ source[j++] = string_char_advance (&p);
consumed_chars += j;
consumed_bytes = p - SDATA (str);
@@ -2126,7 +2199,7 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY
if (NILP (unibyte_p))
{
for (j = 0; j < ccl.produced; j++)
- CHAR_STRING_ADVANCE (destination[j], outp);
+ outp += CHAR_STRING (destination[j], outp);
}
else
{
@@ -2212,15 +2285,8 @@ Return index number of the registered CCL program. */)
/* Extend the table. */
Vccl_program_table = larger_vector (Vccl_program_table, 1, -1);
- {
- Lisp_Object elt = make_uninit_vector (4);
-
- ASET (elt, 0, name);
- ASET (elt, 1, ccl_prog);
- ASET (elt, 2, resolved);
- ASET (elt, 3, Qt);
- ASET (Vccl_program_table, idx, elt);
- }
+ ASET (Vccl_program_table, idx,
+ CALLN (Fvector, name, ccl_prog, resolved, Qt));
Fput (name, Qccl_program_idx, make_fixnum (idx));
return make_fixnum (idx);
diff --git a/src/character.c b/src/character.c
index 97065e17f01..5860f6a0c8c 100644
--- a/src/character.c
+++ b/src/character.c
@@ -141,58 +141,6 @@ char_string (unsigned int c, unsigned char *p)
}
-/* Return a character whose multibyte form is at P. If LEN is not
- NULL, it must be a pointer to integer. In that case, set *LEN to
- the byte length of the multibyte form. If ADVANCED is not NULL, it
- must be a pointer to unsigned char. In that case, set *ADVANCED to
- the ending address (i.e., the starting address of the next
- character) of the multibyte form. */
-
-int
-string_char (const unsigned char *p, const unsigned char **advanced, int *len)
-{
- int c;
- const unsigned char *saved_p = p;
-
- if (*p < 0x80 || ! (*p & 0x20) || ! (*p & 0x10))
- {
- /* 1-, 2-, and 3-byte sequences can be handled by the macro. */
- c = STRING_CHAR_ADVANCE (p);
- }
- else if (! (*p & 0x08))
- {
- /* A 4-byte sequence of this form:
- 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx */
- c = ((((p)[0] & 0x7) << 18)
- | (((p)[1] & 0x3F) << 12)
- | (((p)[2] & 0x3F) << 6)
- | ((p)[3] & 0x3F));
- p += 4;
- }
- else
- {
- /* A 5-byte sequence of this form:
-
- 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
-
- Note that the top 4 `x's are always 0, so shifting p[1] can
- never exceed the maximum valid character codepoint. */
- c = (/* (((p)[0] & 0x3) << 24) ... always 0, so no need to shift. */
- (((p)[1] & 0x3F) << 18)
- | (((p)[2] & 0x3F) << 12)
- | (((p)[3] & 0x3F) << 6)
- | ((p)[4] & 0x3F));
- p += 5;
- }
-
- if (len)
- *len = p - saved_p;
- if (advanced)
- *advanced = p;
- return c;
-}
-
-
/* Translate character C by translation table TABLE. If no translation is
found in TABLE, return the untranslated character. If TABLE is a list,
elements are char tables. In that case, recursively translate C by all the
@@ -248,8 +196,7 @@ DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte,
c = XFIXNAT (ch);
if (c >= 0x100)
error ("Not a unibyte character: %d", c);
- MAKE_CHAR_MULTIBYTE (c);
- return make_fixnum (c);
+ return make_fixnum (make_char_multibyte (c));
}
DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte,
@@ -340,8 +287,7 @@ c_string_width (const unsigned char *str, ptrdiff_t len, int precision,
while (i_byte < len)
{
- int bytes;
- int c = STRING_CHAR_AND_LENGTH (str + i_byte, bytes);
+ int bytes, c = string_char_and_length (str + i_byte, &bytes);
ptrdiff_t thiswidth = char_width (c, dp);
if (0 < precision && precision - width < thiswidth)
@@ -418,7 +364,7 @@ lisp_string_width (Lisp_Object string, ptrdiff_t precision,
if (multibyte)
{
int cbytes;
- c = STRING_CHAR_AND_LENGTH (str + i_byte, cbytes);
+ c = string_char_and_length (str + i_byte, &cbytes);
bytes = cbytes;
}
else
@@ -495,7 +441,7 @@ multibyte_chars_in_text (const unsigned char *ptr, ptrdiff_t nbytes)
while (ptr < endp)
{
- int len = MULTIBYTE_LENGTH (ptr, endp);
+ int len = multibyte_length (ptr, endp, true, true);
if (len == 0)
emacs_abort ();
@@ -517,16 +463,15 @@ parse_str_as_multibyte (const unsigned char *str, ptrdiff_t len,
ptrdiff_t *nchars, ptrdiff_t *nbytes)
{
const unsigned char *endp = str + len;
- int n;
ptrdiff_t chars = 0, bytes = 0;
if (len >= MAX_MULTIBYTE_LENGTH)
{
- const unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH;
+ const unsigned char *adjusted_endp = endp - (MAX_MULTIBYTE_LENGTH - 1);
while (str < adjusted_endp)
{
- if (! CHAR_BYTE8_HEAD_P (*str)
- && (n = MULTIBYTE_LENGTH_NO_CHECK (str)) > 0)
+ int n = multibyte_length (str, NULL, false, false);
+ if (0 < n)
str += n, bytes += n;
else
str++, bytes += 2;
@@ -535,8 +480,8 @@ parse_str_as_multibyte (const unsigned char *str, ptrdiff_t len,
}
while (str < endp)
{
- if (! CHAR_BYTE8_HEAD_P (*str)
- && (n = MULTIBYTE_LENGTH (str, endp)) > 0)
+ int n = multibyte_length (str, endp, true, false);
+ if (0 < n)
str += n, bytes += n;
else
str++, bytes += 2;
@@ -563,20 +508,25 @@ str_as_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t nbytes,
unsigned char *p = str, *endp = str + nbytes;
unsigned char *to;
ptrdiff_t chars = 0;
- int n;
if (nbytes >= MAX_MULTIBYTE_LENGTH)
{
- unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH;
- while (p < adjusted_endp
- && ! CHAR_BYTE8_HEAD_P (*p)
- && (n = MULTIBYTE_LENGTH_NO_CHECK (p)) > 0)
- p += n, chars++;
+ unsigned char *adjusted_endp = endp - (MAX_MULTIBYTE_LENGTH - 1);
+ while (p < adjusted_endp)
+ {
+ int n = multibyte_length (p, NULL, false, false);
+ if (n <= 0)
+ break;
+ p += n, chars++;
+ }
+ }
+ while (true)
+ {
+ int n = multibyte_length (p, endp, true, false);
+ if (n <= 0)
+ break;
+ p += n, chars++;
}
- while (p < endp
- && ! CHAR_BYTE8_HEAD_P (*p)
- && (n = MULTIBYTE_LENGTH (p, endp)) > 0)
- p += n, chars++;
if (nchars)
*nchars = chars;
if (p == endp)
@@ -590,11 +540,11 @@ str_as_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t nbytes,
if (nbytes >= MAX_MULTIBYTE_LENGTH)
{
- unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH;
+ unsigned char *adjusted_endp = endp - (MAX_MULTIBYTE_LENGTH - 1);
while (p < adjusted_endp)
{
- if (! CHAR_BYTE8_HEAD_P (*p)
- && (n = MULTIBYTE_LENGTH_NO_CHECK (p)) > 0)
+ int n = multibyte_length (p, NULL, false, false);
+ if (0 < n)
{
while (n--)
*to++ = *p++;
@@ -610,8 +560,8 @@ str_as_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t nbytes,
}
while (p < endp)
{
- if (! CHAR_BYTE8_HEAD_P (*p)
- && (n = MULTIBYTE_LENGTH (p, endp)) > 0)
+ int n = multibyte_length (p, endp, true, false);
+ if (0 < n)
{
while (n--)
*to++ = *p++;
@@ -706,7 +656,7 @@ str_as_unibyte (unsigned char *str, ptrdiff_t bytes)
len = BYTES_BY_CHAR_HEAD (c);
if (CHAR_BYTE8_HEAD_P (c))
{
- c = STRING_CHAR_ADVANCE (p);
+ c = string_char_advance (&p);
*to++ = CHAR_TO_BYTE8 (c);
}
else
@@ -730,7 +680,7 @@ str_to_unibyte (const unsigned char *src, unsigned char *dst, ptrdiff_t chars)
for (i = 0; i < chars; i++)
{
- int c = STRING_CHAR_ADVANCE (src);
+ int c = string_char_advance (&src);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
@@ -823,7 +773,7 @@ string_escape_byte8 (Lisp_Object string)
if (CHAR_BYTE8_HEAD_P (c))
{
- c = STRING_CHAR_ADVANCE (src);
+ c = string_char_advance (&src);
c = CHAR_TO_BYTE8 (c);
dst += sprintf ((char *) dst, "\\%03o", c + 0u);
}
@@ -849,24 +799,22 @@ Concatenate all the argument characters and make the result a string.
usage: (string &rest CHARACTERS) */)
(ptrdiff_t n, Lisp_Object *args)
{
- ptrdiff_t i;
- int c;
- unsigned char *buf, *p;
- Lisp_Object str;
- USE_SAFE_ALLOCA;
-
- SAFE_NALLOCA (buf, MAX_MULTIBYTE_LENGTH, n);
- p = buf;
-
- for (i = 0; i < n; i++)
+ ptrdiff_t nbytes = 0;
+ for (ptrdiff_t i = 0; i < n; i++)
{
CHECK_CHARACTER (args[i]);
- c = XFIXNUM (args[i]);
+ nbytes += CHAR_BYTES (XFIXNUM (args[i]));
+ }
+ if (nbytes == n)
+ return Funibyte_string (n, args);
+ Lisp_Object str = make_uninit_multibyte_string (n, nbytes);
+ unsigned char *p = SDATA (str);
+ for (ptrdiff_t i = 0; i < n; i++)
+ {
+ eassume (CHARACTERP (args[i]));
+ int c = XFIXNUM (args[i]);
p += CHAR_STRING (c, p);
}
-
- str = make_string_from_bytes ((char *) buf, n, p - buf);
- SAFE_FREE ();
return str;
}
@@ -875,20 +823,10 @@ DEFUN ("unibyte-string", Funibyte_string, Sunibyte_string, 0, MANY, 0,
usage: (unibyte-string &rest BYTES) */)
(ptrdiff_t n, Lisp_Object *args)
{
- ptrdiff_t i;
- Lisp_Object str;
- USE_SAFE_ALLOCA;
- unsigned char *buf = SAFE_ALLOCA (n);
- unsigned char *p = buf;
-
- for (i = 0; i < n; i++)
- {
- CHECK_RANGED_INTEGER (args[i], 0, 255);
- *p++ = XFIXNUM (args[i]);
- }
-
- str = make_string_from_bytes ((char *) buf, n, p - buf);
- SAFE_FREE ();
+ Lisp_Object str = make_uninit_string (n);
+ unsigned char *p = SDATA (str);
+ for (ptrdiff_t i = 0; i < n; i++)
+ *p++ = check_integer_range (args[i], 0, 255);
return str;
}
@@ -931,10 +869,10 @@ character is not ASCII nor 8-bit character, an error is signaled. */)
}
else
{
- CHECK_FIXNUM_COERCE_MARKER (position);
- if (XFIXNUM (position) < BEGV || XFIXNUM (position) >= ZV)
+ EMACS_INT fixed_pos = fix_position (position);
+ if (! (BEGV <= fixed_pos && fixed_pos < ZV))
args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
- pos = XFIXNAT (position);
+ pos = fixed_pos;
p = CHAR_POS_ADDR (pos);
}
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
diff --git a/src/character.h b/src/character.h
index 3642a540448..af5023f77cc 100644
--- a/src/character.h
+++ b/src/character.h
@@ -31,35 +31,39 @@ INLINE_HEADER_BEGIN
/* character code 1st byte byte sequence
-------------- -------- -------------
0-7F 00..7F 0xxxxxxx
- 80-7FF C2..DF 110xxxxx 10xxxxxx
- 800-FFFF E0..EF 1110xxxx 10xxxxxx 10xxxxxx
- 10000-1FFFFF F0..F7 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
- 200000-3FFF7F F8 11111000 1000xxxx 10xxxxxx 10xxxxxx 10xxxxxx
+ 80-7FF C2..DF 110yyyyx 10xxxxxx
+ 800-FFFF E0..EF 1110yyyy 10yxxxxx 10xxxxxx
+ 10000-1FFFFF F0..F7 11110yyy 10yyxxxx 10xxxxxx 10xxxxxx
+ 200000-3FFF7F F8 11111000 1000yxxx 10xxxxxx 10xxxxxx 10xxxxxx
3FFF80-3FFFFF C0..C1 1100000x 10xxxxxx (for eight-bit-char)
400000-... invalid
invalid 1st byte 80..BF 10xxxxxx
- F9..FF 11111xxx (xxx != 000)
+ 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.
+ In the 5-byte sequence, the 22-bit payload cannot exceed 3FFF7F.
*/
/* Maximum character code ((1 << CHARACTERBITS) - 1). */
-#define MAX_CHAR 0x3FFFFF
+enum { MAX_CHAR = 0x3FFFFF };
/* Maximum Unicode character code. */
-#define MAX_UNICODE_CHAR 0x10FFFF
+enum { MAX_UNICODE_CHAR = 0x10FFFF };
/* Maximum N-byte character codes. */
-#define MAX_1_BYTE_CHAR 0x7F
-#define MAX_2_BYTE_CHAR 0x7FF
-#define MAX_3_BYTE_CHAR 0xFFFF
-#define MAX_4_BYTE_CHAR 0x1FFFFF
-#define MAX_5_BYTE_CHAR 0x3FFF7F
+enum { MAX_1_BYTE_CHAR = 0x7F };
+enum { MAX_2_BYTE_CHAR = 0x7FF };
+enum { MAX_3_BYTE_CHAR = 0xFFFF };
+enum { MAX_4_BYTE_CHAR = 0x1FFFFF };
+enum { MAX_5_BYTE_CHAR = 0x3FFF7F };
/* Minimum leading code of multibyte characters. */
-#define MIN_MULTIBYTE_LEADING_CODE 0xC0
+enum { MIN_MULTIBYTE_LEADING_CODE = 0xC0 };
/* Maximum leading code of multibyte characters. Note: this must be
updated if we ever increase MAX_CHAR above. */
-#define MAX_MULTIBYTE_LEADING_CODE 0xF8
+enum { MAX_MULTIBYTE_LEADING_CODE = 0xF8 };
/* Unicode character values. */
enum
@@ -80,533 +84,432 @@ enum
OBJECT_REPLACEMENT_CHARACTER = 0xFFFC,
};
+extern int char_string (unsigned, unsigned char *);
+
/* UTF-8 encodings. Use \x escapes, so they are portable to pre-C11
compilers and can be concatenated with ordinary string literals. */
#define uLSQM "\xE2\x80\x98" /* U+2018 LEFT SINGLE QUOTATION MARK */
#define uRSQM "\xE2\x80\x99" /* U+2019 RIGHT SINGLE QUOTATION MARK */
-/* Nonzero iff C is a character that corresponds to a raw 8-bit
+/* True iff C is a character of code less than 0x100. */
+INLINE bool
+SINGLE_BYTE_CHAR_P (intmax_t c)
+{
+ return 0 <= c && c < 0x100;
+}
+
+/* True iff C is a character that corresponds to a raw 8-bit
byte. */
-#define CHAR_BYTE8_P(c) ((c) > MAX_5_BYTE_CHAR)
+INLINE bool
+CHAR_BYTE8_P (int c)
+{
+ return MAX_5_BYTE_CHAR < c;
+}
/* Return the character code for raw 8-bit byte BYTE. */
-#define BYTE8_TO_CHAR(byte) ((byte) + 0x3FFF00)
+INLINE int
+BYTE8_TO_CHAR (int byte)
+{
+ return byte + 0x3FFF00;
+}
-#define UNIBYTE_TO_CHAR(byte) \
- (ASCII_CHAR_P (byte) ? (byte) : BYTE8_TO_CHAR (byte))
+INLINE int
+UNIBYTE_TO_CHAR (int byte)
+{
+ return ASCII_CHAR_P (byte) ? byte : BYTE8_TO_CHAR (byte);
+}
/* Return the raw 8-bit byte for character C. */
-#define CHAR_TO_BYTE8(c) (CHAR_BYTE8_P (c) ? (c) - 0x3FFF00 : (c & 0xFF))
+INLINE int
+CHAR_TO_BYTE8 (int c)
+{
+ return CHAR_BYTE8_P (c) ? c - 0x3FFF00 : c & 0xFF;
+}
/* Return the raw 8-bit byte for character C,
or -1 if C doesn't correspond to a byte. */
-#define CHAR_TO_BYTE_SAFE(c) \
- (ASCII_CHAR_P (c) ? c : (CHAR_BYTE8_P (c) ? (c) - 0x3FFF00 : -1))
+INLINE int
+CHAR_TO_BYTE_SAFE (int c)
+{
+ return ASCII_CHAR_P (c) ? c : CHAR_BYTE8_P (c) ? c - 0x3FFF00 : -1;
+}
-/* Nonzero iff BYTE is the 1st byte of a multibyte form of a character
+/* True iff BYTE is the 1st byte of a multibyte form of a character
that corresponds to a raw 8-bit byte. */
-#define CHAR_BYTE8_HEAD_P(byte) ((byte) == 0xC0 || (byte) == 0xC1)
-
-/* If C is not ASCII, make it unibyte. */
-#define MAKE_CHAR_UNIBYTE(c) \
- do { \
- if (! ASCII_CHAR_P (c)) \
- c = CHAR_TO_BYTE8 (c); \
- } while (false)
-
+INLINE bool
+CHAR_BYTE8_HEAD_P (int byte)
+{
+ return byte == 0xC0 || byte == 0xC1;
+}
/* If C is not ASCII, make it multibyte. Assumes C < 256. */
-#define MAKE_CHAR_MULTIBYTE(c) \
- (eassert ((c) >= 0 && (c) < 256), (c) = UNIBYTE_TO_CHAR (c))
+INLINE int
+make_char_multibyte (int c)
+{
+ eassert (SINGLE_BYTE_CHAR_P (c));
+ return UNIBYTE_TO_CHAR (c);
+}
/* This is the maximum byte length of multibyte form. */
-#define MAX_MULTIBYTE_LENGTH 5
-
-/* Nonzero iff X is a character. */
-#define CHARACTERP(x) (FIXNATP (x) && XFIXNAT (x) <= MAX_CHAR)
+enum { MAX_MULTIBYTE_LENGTH = 5 };
/* Nonzero iff C is valid as a character code. */
-#define CHAR_VALID_P(c) UNSIGNED_CMP (c, <=, MAX_CHAR)
+INLINE bool
+CHAR_VALID_P (intmax_t c)
+{
+ return 0 <= c && c <= MAX_CHAR;
+}
-/* Check if Lisp object X is a character or not. */
-#define CHECK_CHARACTER(x) \
- CHECK_TYPE (CHARACTERP (x), Qcharacterp, x)
+/* Nonzero iff X is a character. */
+INLINE bool
+CHARACTERP (Lisp_Object x)
+{
+ return FIXNUMP (x) && CHAR_VALID_P (XFIXNUM (x));
+}
-#define CHECK_CHARACTER_CAR(x) \
- do { \
- Lisp_Object tmp = XCAR (x); \
- CHECK_CHARACTER (tmp); \
- } while (false)
+/* Check if Lisp object X is a character or not. */
+INLINE void
+CHECK_CHARACTER (Lisp_Object x)
+{
+ CHECK_TYPE (CHARACTERP (x), Qcharacterp, x);
+}
-#define CHECK_CHARACTER_CDR(x) \
- do { \
- Lisp_Object tmp = XCDR (x); \
- CHECK_CHARACTER (tmp); \
- } while (false)
+INLINE void
+CHECK_CHARACTER_CAR (Lisp_Object x)
+{
+ CHECK_CHARACTER (XCAR (x));
+}
-/* Nonzero iff C is a character of code less than 0x100. */
-#define SINGLE_BYTE_CHAR_P(c) UNSIGNED_CMP (c, <, 0x100)
+INLINE void
+CHECK_CHARACTER_CDR (Lisp_Object x)
+{
+ CHECK_CHARACTER (XCDR (x));
+}
-/* Nonzero if character C has a printable glyph. */
-#define CHAR_PRINTABLE_P(c) \
- (((c) >= 32 && (c) < 127) \
- || ! NILP (CHAR_TABLE_REF (Vprintable_chars, (c))))
+/* True if character C has a printable glyph. */
+INLINE bool
+CHAR_PRINTABLE_P (int c)
+{
+ return ((32 <= c && c < 127)
+ || ! NILP (CHAR_TABLE_REF (Vprintable_chars, c)));
+}
/* Return byte length of multibyte form for character C. */
-#define CHAR_BYTES(c) \
- ( (c) <= MAX_1_BYTE_CHAR ? 1 \
- : (c) <= MAX_2_BYTE_CHAR ? 2 \
- : (c) <= MAX_3_BYTE_CHAR ? 3 \
- : (c) <= MAX_4_BYTE_CHAR ? 4 \
- : (c) <= MAX_5_BYTE_CHAR ? 5 \
- : 2)
-
+INLINE int
+CHAR_BYTES (int c)
+{
+ return ((MAX_5_BYTE_CHAR < c ? -2 : 1)
+ + (MAX_1_BYTE_CHAR < c)
+ + (MAX_2_BYTE_CHAR < c)
+ + (MAX_3_BYTE_CHAR < c)
+ + (MAX_4_BYTE_CHAR < c));
+}
/* Return the leading code of multibyte form of C. */
-#define CHAR_LEADING_CODE(c) \
- ((c) <= MAX_1_BYTE_CHAR ? c \
- : (c) <= MAX_2_BYTE_CHAR ? (0xC0 | ((c) >> 6)) \
- : (c) <= MAX_3_BYTE_CHAR ? (0xE0 | ((c) >> 12)) \
- : (c) <= MAX_4_BYTE_CHAR ? (0xF0 | ((c) >> 18)) \
- : (c) <= MAX_5_BYTE_CHAR ? 0xF8 \
- : (0xC0 | (((c) >> 6) & 0x01)))
+INLINE int
+CHAR_LEADING_CODE (int c)
+{
+ return (c <= MAX_1_BYTE_CHAR ? c
+ : c <= MAX_2_BYTE_CHAR ? 0xC0 | (c >> 6)
+ : c <= MAX_3_BYTE_CHAR ? 0xE0 | (c >> 12)
+ : c <= MAX_4_BYTE_CHAR ? 0xF0 | (c >> 18)
+ : c <= MAX_5_BYTE_CHAR ? 0xF8
+ : 0xC0 | ((c >> 6) & 0x01));
+}
/* Store multibyte form of the character C in P. The caller should
allocate at least MAX_MULTIBYTE_LENGTH bytes area at P in advance.
Returns the length of the multibyte form. */
-#define CHAR_STRING(c, p) \
- (UNSIGNED_CMP (c, <=, MAX_1_BYTE_CHAR) \
- ? ((p)[0] = (c), \
- 1) \
- : UNSIGNED_CMP (c, <=, MAX_2_BYTE_CHAR) \
- ? ((p)[0] = (0xC0 | ((c) >> 6)), \
- (p)[1] = (0x80 | ((c) & 0x3F)), \
- 2) \
- : UNSIGNED_CMP (c, <=, MAX_3_BYTE_CHAR) \
- ? ((p)[0] = (0xE0 | ((c) >> 12)), \
- (p)[1] = (0x80 | (((c) >> 6) & 0x3F)), \
- (p)[2] = (0x80 | ((c) & 0x3F)), \
- 3) \
- : verify_expr (sizeof (c) <= sizeof (unsigned), char_string (c, p)))
+INLINE int
+CHAR_STRING (int c, unsigned char *p)
+{
+ eassume (0 <= c);
+ if (c <= MAX_1_BYTE_CHAR)
+ {
+ p[0] = c;
+ return 1;
+ }
+ if (c <= MAX_2_BYTE_CHAR)
+ {
+ p[0] = 0xC0 | (c >> 6);
+ p[1] = 0x80 | (c & 0x3F);
+ return 2;
+ }
+ if (c <= MAX_3_BYTE_CHAR)
+ {
+ p[0] = 0xE0 | (c >> 12);
+ p[1] = 0x80 | ((c >> 6) & 0x3F);
+ p[2] = 0x80 | (c & 0x3F);
+ return 3;
+ }
+ int len = char_string (c, p);
+ eassume (0 < len && len <= MAX_MULTIBYTE_LENGTH);
+ return len;
+}
/* Store multibyte form of byte B in P. The caller should allocate at
least MAX_MULTIBYTE_LENGTH bytes area at P in advance. Returns the
length of the multibyte form. */
-#define BYTE8_STRING(b, p) \
- ((p)[0] = (0xC0 | (((b) >> 6) & 0x01)), \
- (p)[1] = (0x80 | ((b) & 0x3F)), \
- 2)
-
-
-/* Store multibyte form of the character C in P and advance P to the
- end of the multibyte form. The caller should allocate at least
- MAX_MULTIBYTE_LENGTH bytes area at P in advance. */
-
-#define CHAR_STRING_ADVANCE(c, p) \
- do { \
- if ((c) <= MAX_1_BYTE_CHAR) \
- *(p)++ = (c); \
- else if ((c) <= MAX_2_BYTE_CHAR) \
- *(p)++ = (0xC0 | ((c) >> 6)), \
- *(p)++ = (0x80 | ((c) & 0x3F)); \
- else if ((c) <= MAX_3_BYTE_CHAR) \
- *(p)++ = (0xE0 | ((c) >> 12)), \
- *(p)++ = (0x80 | (((c) >> 6) & 0x3F)), \
- *(p)++ = (0x80 | ((c) & 0x3F)); \
- else \
- { \
- verify (sizeof (c) <= sizeof (unsigned)); \
- (p) += char_string (c, p); \
- } \
- } while (false)
-
-
-/* Nonzero iff BYTE starts a non-ASCII character in a multibyte
- form. */
-#define LEADING_CODE_P(byte) (((byte) & 0xC0) == 0xC0)
-
-/* Nonzero iff BYTE is a trailing code of a non-ASCII character in a
+INLINE int
+BYTE8_STRING (int b, unsigned char *p)
+{
+ p[0] = 0xC0 | ((b >> 6) & 0x01);
+ p[1] = 0x80 | (b & 0x3F);
+ return 2;
+}
+
+
+/* True iff BYTE starts a non-ASCII character in a multibyte form. */
+INLINE bool
+LEADING_CODE_P (int byte)
+{
+ return (byte & 0xC0) == 0xC0;
+}
+
+/* True iff BYTE is a trailing code of a non-ASCII character in a
multibyte form. */
-#define TRAILING_CODE_P(byte) (((byte) & 0xC0) == 0x80)
+INLINE bool
+TRAILING_CODE_P (int byte)
+{
+ return (byte & 0xC0) == 0x80;
+}
-/* Nonzero iff BYTE starts a character in a multibyte form.
+/* True iff BYTE starts a character in a multibyte form.
This is equivalent to:
(ASCII_CHAR_P (byte) || LEADING_CODE_P (byte)) */
-#define CHAR_HEAD_P(byte) (((byte) & 0xC0) != 0x80)
+INLINE bool
+CHAR_HEAD_P (int byte)
+{
+ return (byte & 0xC0) != 0x80;
+}
/* How many bytes a character that starts with BYTE occupies in a
- multibyte form. Unlike MULTIBYTE_LENGTH below, this macro does not
+ multibyte form. Unlike multibyte_length, this function does not
validate the multibyte form, but looks only at its first byte. */
-#define BYTES_BY_CHAR_HEAD(byte) \
- (!((byte) & 0x80) ? 1 \
- : !((byte) & 0x20) ? 2 \
- : !((byte) & 0x10) ? 3 \
- : !((byte) & 0x08) ? 4 \
- : 5)
+INLINE int
+BYTES_BY_CHAR_HEAD (int byte)
+{
+ return (!(byte & 0x80) ? 1
+ : !(byte & 0x20) ? 2
+ : !(byte & 0x10) ? 3
+ : !(byte & 0x08) ? 4
+ : 5);
+}
-/* The byte length of multibyte form at unibyte string P ending at
- PEND. If the string doesn't point to a valid multibyte form,
- return 0. Unlike BYTES_BY_CHAR_HEAD, this macro validates the
- multibyte form. */
+/* The byte length of the multibyte form at the unibyte string P,
+ ending at PEND if CHECK, and without a length check if !CHECK.
+ If ALLOW_8BIT, allow multibyte forms of eight-bit characters.
+ If the string doesn't point to a valid multibyte form, return 0.
+ Unlike BYTES_BY_CHAR_HEAD, this function validates the multibyte form. */
+
+INLINE int
+multibyte_length (unsigned char const *p, unsigned char const *pend,
+ bool check, bool allow_8bit)
+{
+ if (!check || p < pend)
+ {
+ unsigned char c = p[0];
+ if (c < 0x80)
+ return 1;
+ if (!check || p + 1 < pend)
+ {
+ unsigned char d = p[1];
+ int w = ((d & 0xC0) << 2) + c;
+ if ((allow_8bit ? 0x2C0 : 0x2C2) <= w && w <= 0x2DF)
+ return 2;
+ if (!check || p + 2 < pend)
+ {
+ unsigned char e = p[2];
+ w += (e & 0xC0) << 4;
+ int w1 = w | ((d & 0x20) >> 2);
+ if (0xAE1 <= w1 && w1 <= 0xAEF)
+ return 3;
+ if (!check || p + 3 < pend)
+ {
+ unsigned char f = p[3];
+ w += (f & 0xC0) << 6;
+ int w2 = w | ((d & 0x30) >> 3);
+ if (0x2AF1 <= w2 && w2 <= 0x2AF7)
+ return 4;
+ if (!check || p + 4 < pend)
+ {
+ int_fast64_t lw = w + ((p[4] & 0xC0) << 8),
+ w3 = (lw << 24) + (d << 16) + (e << 8) + f;
+ if (0xAAF8888080 <= w3 && w3 <= 0xAAF88FBFBD)
+ return 5;
+ }
+ }
+ }
+ }
+ }
+
+ return 0;
+}
+
-#define MULTIBYTE_LENGTH(p, pend) \
- (p >= pend ? 0 \
- : !((p)[0] & 0x80) ? 1 \
- : ((p + 1 >= pend) || (((p)[1] & 0xC0) != 0x80)) ? 0 \
- : ((p)[0] & 0xE0) == 0xC0 ? 2 \
- : ((p + 2 >= pend) || (((p)[2] & 0xC0) != 0x80)) ? 0 \
- : ((p)[0] & 0xF0) == 0xE0 ? 3 \
- : ((p + 3 >= pend) || (((p)[3] & 0xC0) != 0x80)) ? 0 \
- : ((p)[0] & 0xF8) == 0xF0 ? 4 \
- : ((p + 4 >= pend) || (((p)[4] & 0xC0) != 0x80)) ? 0 \
- : (p)[0] == 0xF8 && ((p)[1] & 0xF0) == 0x80 ? 5 \
- : 0)
-
-
-/* Like MULTIBYTE_LENGTH, but don't check the ending address. The
- multibyte form is still validated, unlike BYTES_BY_CHAR_HEAD. */
-
-#define MULTIBYTE_LENGTH_NO_CHECK(p) \
- (!((p)[0] & 0x80) ? 1 \
- : ((p)[1] & 0xC0) != 0x80 ? 0 \
- : ((p)[0] & 0xE0) == 0xC0 ? 2 \
- : ((p)[2] & 0xC0) != 0x80 ? 0 \
- : ((p)[0] & 0xF0) == 0xE0 ? 3 \
- : ((p)[3] & 0xC0) != 0x80 ? 0 \
- : ((p)[0] & 0xF8) == 0xF0 ? 4 \
- : ((p)[4] & 0xC0) != 0x80 ? 0 \
- : (p)[0] == 0xF8 && ((p)[1] & 0xF0) == 0x80 ? 5 \
- : 0)
-
-/* If P is before LIMIT, advance P to the next character boundary.
+/* Return number of bytes in the multibyte character just before P.
Assumes that P is already at a character boundary of the same
- multibyte form whose end address is LIMIT. */
+ multibyte form, and is not at the start of that form. */
-#define NEXT_CHAR_BOUNDARY(p, limit) \
- do { \
- if ((p) < (limit)) \
- (p) += BYTES_BY_CHAR_HEAD (*(p)); \
- } while (false)
+INLINE int
+raw_prev_char_len (unsigned char const *p)
+{
+ for (int len = 1; ; len++)
+ if (CHAR_HEAD_P (p[-len]))
+ return len;
+}
-/* If P is after LIMIT, advance P to the previous character boundary.
- Assumes that P is already at a character boundary of the same
- multibyte form whose beginning address is LIMIT. */
-
-#define PREV_CHAR_BOUNDARY(p, limit) \
- do { \
- if ((p) > (limit)) \
- { \
- const unsigned char *chp = (p); \
- do { \
- chp--; \
- } while (chp >= limit && ! CHAR_HEAD_P (*chp)); \
- (p) = (BYTES_BY_CHAR_HEAD (*chp) == (p) - chp) ? chp : (p) - 1; \
- } \
- } while (false)
+/* Return the character code of character whose multibyte form is at P,
+ and set *LENGTH to its length. */
+
+INLINE int
+string_char_and_length (unsigned char const *p, int *length)
+{
+ int c = p[0];
+ if (! (c & 0x80))
+ {
+ *length = 1;
+ return c;
+ }
+ eassume (0xC0 <= c);
+
+ int d = (c << 6) + p[1] - ((0xC0 << 6) + 0x80);
+ if (! (c & 0x20))
+ {
+ *length = 2;
+ return d + (c < 0xC2 ? 0x3FFF80 : 0);
+ }
+
+ d = (d << 6) + p[2] - ((0x20 << 12) + 0x80);
+ if (! (c & 0x10))
+ {
+ *length = 3;
+ eassume (MAX_2_BYTE_CHAR < d && d <= MAX_3_BYTE_CHAR);
+ return d;
+ }
+
+ d = (d << 6) + p[3] - ((0x10 << 18) + 0x80);
+ if (! (c & 0x08))
+ {
+ *length = 4;
+ eassume (MAX_3_BYTE_CHAR < d && d <= MAX_4_BYTE_CHAR);
+ return d;
+ }
+
+ d = (d << 6) + p[4] - ((0x08 << 24) + 0x80);
+ *length = 5;
+ eassume (MAX_4_BYTE_CHAR < d && d <= MAX_5_BYTE_CHAR);
+ return d;
+}
/* Return the character code of character whose multibyte form is at P. */
-#define STRING_CHAR(p) \
- (!((p)[0] & 0x80) \
- ? (p)[0] \
- : ! ((p)[0] & 0x20) \
- ? (((((p)[0] & 0x1F) << 6) \
- | ((p)[1] & 0x3F)) \
- + (((unsigned char) (p)[0]) < 0xC2 ? 0x3FFF80 : 0)) \
- : ! ((p)[0] & 0x10) \
- ? ((((p)[0] & 0x0F) << 12) \
- | (((p)[1] & 0x3F) << 6) \
- | ((p)[2] & 0x3F)) \
- : string_char ((p), NULL, NULL))
-
-
-/* Like STRING_CHAR, but set ACTUAL_LEN to the length of multibyte
- form. */
-
-#define STRING_CHAR_AND_LENGTH(p, actual_len) \
- (!((p)[0] & 0x80) \
- ? ((actual_len) = 1, (p)[0]) \
- : ! ((p)[0] & 0x20) \
- ? ((actual_len) = 2, \
- (((((p)[0] & 0x1F) << 6) \
- | ((p)[1] & 0x3F)) \
- + (((unsigned char) (p)[0]) < 0xC2 ? 0x3FFF80 : 0))) \
- : ! ((p)[0] & 0x10) \
- ? ((actual_len) = 3, \
- ((((p)[0] & 0x0F) << 12) \
- | (((p)[1] & 0x3F) << 6) \
- | ((p)[2] & 0x3F))) \
- : string_char ((p), NULL, &actual_len))
-
-
-/* Like STRING_CHAR, but advance P to the end of multibyte form. */
-
-#define STRING_CHAR_ADVANCE(p) \
- (!((p)[0] & 0x80) \
- ? *(p)++ \
- : ! ((p)[0] & 0x20) \
- ? ((p) += 2, \
- ((((p)[-2] & 0x1F) << 6) \
- | ((p)[-1] & 0x3F) \
- | ((unsigned char) ((p)[-2]) < 0xC2 ? 0x3FFF80 : 0))) \
- : ! ((p)[0] & 0x10) \
- ? ((p) += 3, \
- ((((p)[-3] & 0x0F) << 12) \
- | (((p)[-2] & 0x3F) << 6) \
- | ((p)[-1] & 0x3F))) \
- : string_char ((p), &(p), NULL))
-
-
-/* Fetch the "next" character from Lisp string STRING at byte position
- BYTEIDX, character position CHARIDX. Store it into OUTPUT.
-
- All the args must be side-effect-free.
- BYTEIDX and CHARIDX must be lvalues;
- we increment them past the character fetched. */
-
-#define FETCH_STRING_CHAR_ADVANCE(OUTPUT, STRING, CHARIDX, BYTEIDX) \
- do \
- { \
- CHARIDX++; \
- if (STRING_MULTIBYTE (STRING)) \
- { \
- unsigned char *chp = &SDATA (STRING)[BYTEIDX]; \
- int chlen; \
- \
- OUTPUT = STRING_CHAR_AND_LENGTH (chp, chlen); \
- BYTEIDX += chlen; \
- } \
- else \
- { \
- OUTPUT = SREF (STRING, BYTEIDX); \
- BYTEIDX++; \
- } \
- } \
- while (false)
-
-/* Like FETCH_STRING_CHAR_ADVANCE, but return a multibyte character
- even if STRING is unibyte. */
+INLINE int
+STRING_CHAR (unsigned char const *p)
+{
+ int len;
+ return string_char_and_length (p, &len);
+}
+
-#define FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE(OUTPUT, STRING, CHARIDX, BYTEIDX) \
- do \
- { \
- CHARIDX++; \
- if (STRING_MULTIBYTE (STRING)) \
- { \
- unsigned char *chp = &SDATA (STRING)[BYTEIDX]; \
- int chlen; \
- \
- OUTPUT = STRING_CHAR_AND_LENGTH (chp, chlen); \
- BYTEIDX += chlen; \
- } \
- else \
- { \
- OUTPUT = SREF (STRING, BYTEIDX); \
- BYTEIDX++; \
- MAKE_CHAR_MULTIBYTE (OUTPUT); \
- } \
- } \
- while (false)
-
-
-/* Like FETCH_STRING_CHAR_ADVANCE, but assumes STRING is multibyte. */
-
-#define FETCH_STRING_CHAR_ADVANCE_NO_CHECK(OUTPUT, STRING, CHARIDX, BYTEIDX) \
- do \
- { \
- unsigned char *fetch_ptr = &SDATA (STRING)[BYTEIDX]; \
- int fetch_len; \
- \
- OUTPUT = STRING_CHAR_AND_LENGTH (fetch_ptr, fetch_len); \
- BYTEIDX += fetch_len; \
- CHARIDX++; \
- } \
- while (false)
-
-
-/* Like FETCH_STRING_CHAR_ADVANCE, but fetch character from the current
- buffer. */
-
-#define FETCH_CHAR_ADVANCE(OUTPUT, CHARIDX, BYTEIDX) \
- do \
- { \
- CHARIDX++; \
- if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) \
- { \
- unsigned char *chp = BYTE_POS_ADDR (BYTEIDX); \
- int chlen; \
- \
- OUTPUT = STRING_CHAR_AND_LENGTH (chp, chlen); \
- BYTEIDX += chlen; \
- } \
- else \
- { \
- OUTPUT = *(BYTE_POS_ADDR (BYTEIDX)); \
- BYTEIDX++; \
- } \
- } \
- while (false)
-
-
-/* Like FETCH_CHAR_ADVANCE, but assumes the current buffer is multibyte. */
-
-#define FETCH_CHAR_ADVANCE_NO_CHECK(OUTPUT, CHARIDX, BYTEIDX) \
- do \
- { \
- unsigned char *chp = BYTE_POS_ADDR (BYTEIDX); \
- int chlen; \
- \
- OUTPUT = STRING_CHAR_AND_LENGTH (chp, chlen); \
- BYTEIDX += chlen; \
- CHARIDX++; \
- } \
- while (false)
-
-
-/* Increment the buffer byte position POS_BYTE of the current buffer to
- the next character boundary. No range checking of POS. */
-
-#define INC_POS(pos_byte) \
- do { \
- unsigned char *chp = BYTE_POS_ADDR (pos_byte); \
- pos_byte += BYTES_BY_CHAR_HEAD (*chp); \
- } while (false)
-
-
-/* Decrement the buffer byte position POS_BYTE of the current buffer to
- the previous character boundary. No range checking of POS. */
-
-#define DEC_POS(pos_byte) \
- do { \
- unsigned char *chp; \
- \
- pos_byte--; \
- if (pos_byte < GPT_BYTE) \
- chp = BEG_ADDR + pos_byte - BEG_BYTE; \
- else \
- chp = BEG_ADDR + GAP_SIZE + pos_byte - BEG_BYTE; \
- while (!CHAR_HEAD_P (*chp)) \
- { \
- chp--; \
- pos_byte--; \
- } \
- } while (false)
-
-/* Increment both CHARPOS and BYTEPOS, each in the appropriate way. */
-
-#define INC_BOTH(charpos, bytepos) \
- do \
- { \
- (charpos)++; \
- if (NILP (BVAR (current_buffer, enable_multibyte_characters))) \
- (bytepos)++; \
- else \
- INC_POS ((bytepos)); \
- } \
- while (false)
-
-
-/* Decrement both CHARPOS and BYTEPOS, each in the appropriate way. */
-
-#define DEC_BOTH(charpos, bytepos) \
- do \
- { \
- (charpos)--; \
- if (NILP (BVAR (current_buffer, enable_multibyte_characters))) \
- (bytepos)--; \
- else \
- DEC_POS ((bytepos)); \
- } \
- while (false)
-
-
-/* Increment the buffer byte position POS_BYTE of the current buffer to
- the next character boundary. This macro relies on the fact that
- *GPT_ADDR and *Z_ADDR are always accessible and the values are
- '\0'. No range checking of POS_BYTE. */
-
-#define BUF_INC_POS(buf, pos_byte) \
- do { \
- unsigned char *chp = BUF_BYTE_ADDRESS (buf, pos_byte); \
- pos_byte += BYTES_BY_CHAR_HEAD (*chp); \
- } while (false)
-
-
-/* Decrement the buffer byte position POS_BYTE of the current buffer to
- the previous character boundary. No range checking of POS_BYTE. */
-
-#define BUF_DEC_POS(buf, pos_byte) \
- do { \
- unsigned char *chp; \
- pos_byte--; \
- if (pos_byte < BUF_GPT_BYTE (buf)) \
- chp = BUF_BEG_ADDR (buf) + pos_byte - BEG_BYTE; \
- else \
- chp = BUF_BEG_ADDR (buf) + BUF_GAP_SIZE (buf) + pos_byte - BEG_BYTE;\
- while (!CHAR_HEAD_P (*chp)) \
- { \
- chp--; \
- pos_byte--; \
- } \
- } while (false)
-
-
-/* Return a non-outlandish value for the tab width. */
-
-#define SANE_TAB_WIDTH(buf) sanitize_tab_width (BVAR (buf, tab_width))
+/* Like STRING_CHAR (*PP), but advance *PP to the end of multibyte form. */
INLINE int
-sanitize_tab_width (Lisp_Object width)
+string_char_advance (unsigned char const **pp)
{
- return (FIXNUMP (width) && 0 < XFIXNUM (width) && XFIXNUM (width) <= 1000
- ? XFIXNUM (width) : 8);
+ unsigned char const *p = *pp;
+ int len, c = string_char_and_length (p, &len);
+ *pp = p + len;
+ return c;
}
-/* Return the width of ASCII character C. The width is measured by
- how many columns C will occupy on the screen when displayed in the
- current buffer. */
-#define ASCII_CHAR_WIDTH(c) \
- (c < 0x20 \
- ? (c == '\t' \
- ? SANE_TAB_WIDTH (current_buffer) \
- : (c == '\n' ? 0 : (NILP (BVAR (current_buffer, ctl_arrow)) ? 4 : 2))) \
- : (c < 0x7f \
- ? 1 \
- : ((NILP (BVAR (current_buffer, ctl_arrow)) ? 4 : 2))))
+/* Return the next character from Lisp string STRING at byte position
+ *BYTEIDX, character position *CHARIDX. Update *BYTEIDX and
+ *CHARIDX past the character fetched. */
+
+INLINE int
+fetch_string_char_advance (Lisp_Object string,
+ ptrdiff_t *charidx, ptrdiff_t *byteidx)
+{
+ int output;
+ ptrdiff_t b = *byteidx;
+ unsigned char *chp = SDATA (string) + b;
+ if (STRING_MULTIBYTE (string))
+ {
+ int chlen;
+ output = string_char_and_length (chp, &chlen);
+ b += chlen;
+ }
+ else
+ {
+ output = *chp;
+ b++;
+ }
+ (*charidx)++;
+ *byteidx = b;
+ return output;
+}
-/* Return a non-outlandish value for a character width. */
+/* Like fetch_string_char_advance, but return a multibyte character
+ even if STRING is unibyte. */
INLINE int
-sanitize_char_width (EMACS_INT width)
+fetch_string_char_as_multibyte_advance (Lisp_Object string,
+ ptrdiff_t *charidx, ptrdiff_t *byteidx)
{
- return 0 <= width && width <= 1000 ? width : 1000;
+ int output;
+ ptrdiff_t b = *byteidx;
+ unsigned char *chp = SDATA (string) + b;
+ if (STRING_MULTIBYTE (string))
+ {
+ int chlen;
+ output = string_char_and_length (chp, &chlen);
+ b += chlen;
+ }
+ else
+ {
+ output = make_char_multibyte (*chp);
+ b++;
+ }
+ (*charidx)++;
+ *byteidx = b;
+ return output;
}
-/* Return the width of character C. The width is measured by how many
- columns C will occupy on the screen when displayed in the current
- buffer. The name CHARACTER_WIDTH avoids a collision with <limits.h>
- CHAR_WIDTH when enabled; see ISO/IEC TS 18661-1:2014. */
-#define CHARACTER_WIDTH(c) \
- (ASCII_CHAR_P (c) \
- ? ASCII_CHAR_WIDTH (c) \
- : sanitize_char_width (XFIXNUM (CHAR_TABLE_REF (Vchar_width_table, c))))
+/* Like fetch_string_char_advance, but assumes STRING is multibyte. */
+
+INLINE int
+fetch_string_char_advance_no_check (Lisp_Object string,
+ ptrdiff_t *charidx, ptrdiff_t *byteidx)
+{
+ ptrdiff_t b = *byteidx;
+ unsigned char *chp = SDATA (string) + b;
+ int chlen, output = string_char_and_length (chp, &chlen);
+ (*charidx)++;
+ *byteidx = b + chlen;
+ return output;
+}
+
/* If C is a variation selector, return the index of the
variation selector (1..256). Otherwise, return 0. */
-#define CHAR_VARIATION_SELECTOR_P(c) \
- ((c) < 0xFE00 ? 0 \
- : (c) <= 0xFE0F ? (c) - 0xFE00 + 1 \
- : (c) < 0xE0100 ? 0 \
- : (c) <= 0xE01EF ? (c) - 0xE0100 + 17 \
- : 0)
+INLINE int
+CHAR_VARIATION_SELECTOR_P (int c)
+{
+ return (c < 0xFE00 ? 0
+ : c <= 0xFE0F ? c - 0xFE00 + 1
+ : c < 0xE0100 ? 0
+ : c <= 0xE01EF ? c - 0xE0100 + 17
+ : 0);
+}
/* Return true if C is a surrogate. */
@@ -657,9 +560,6 @@ typedef enum {
} unicode_category_t;
extern EMACS_INT char_resolve_modifier_mask (EMACS_INT) ATTRIBUTE_CONST;
-extern int char_string (unsigned, unsigned char *);
-extern int string_char (const unsigned char *,
- const unsigned char **, int *);
extern int translate_char (Lisp_Object, int c);
extern ptrdiff_t count_size_as_multibyte (const unsigned char *, ptrdiff_t);
@@ -684,10 +584,6 @@ extern bool graphicp (int);
extern bool printablep (int);
extern bool blankp (int);
-/* Return a translation table of id number ID. */
-#define GET_TRANSLATION_TABLE(id) \
- (XCDR (XVECTOR (Vtranslation_table_vector)->contents[(id)]))
-
/* Look up the element in char table OBJ at index CH, and return it as
an integer. If the element is not a character, return CH itself. */
diff --git a/src/charset.c b/src/charset.c
index 2771b0ba2ac..520dd3a9605 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -866,15 +866,10 @@ usage: (define-charset-internal ...) */)
val = args[charset_arg_code_space];
for (i = 0, dimension = 0, nchars = 1; ; i++)
{
- Lisp_Object min_byte_obj, max_byte_obj;
- int min_byte, max_byte;
-
- min_byte_obj = Faref (val, make_fixnum (i * 2));
- max_byte_obj = Faref (val, make_fixnum (i * 2 + 1));
- CHECK_RANGED_INTEGER (min_byte_obj, 0, 255);
- min_byte = XFIXNUM (min_byte_obj);
- CHECK_RANGED_INTEGER (max_byte_obj, min_byte, 255);
- max_byte = XFIXNUM (max_byte_obj);
+ Lisp_Object min_byte_obj = Faref (val, make_fixnum (i * 2));
+ Lisp_Object max_byte_obj = Faref (val, make_fixnum (i * 2 + 1));
+ int min_byte = check_integer_range (min_byte_obj, 0, 255);
+ int max_byte = check_integer_range (max_byte_obj, min_byte, 255);
charset.code_space[i * 4] = min_byte;
charset.code_space[i * 4 + 1] = max_byte;
charset.code_space[i * 4 + 2] = max_byte - min_byte + 1;
@@ -887,13 +882,8 @@ usage: (define-charset-internal ...) */)
}
val = args[charset_arg_dimension];
- if (NILP (val))
- charset.dimension = dimension;
- else
- {
- CHECK_RANGED_INTEGER (val, 1, 4);
- charset.dimension = XFIXNUM (val);
- }
+ charset.dimension
+ = !NILP (val) ? check_integer_range (val, 1, 4) : dimension;
charset.code_linear_p
= (charset.dimension == 1
@@ -979,13 +969,7 @@ usage: (define-charset-internal ...) */)
}
val = args[charset_arg_iso_revision];
- if (NILP (val))
- charset.iso_revision = -1;
- else
- {
- CHECK_RANGED_INTEGER (val, -1, 63);
- charset.iso_revision = XFIXNUM (val);
- }
+ charset.iso_revision = !NILP (val) ? check_integer_range (val, -1, 63) : -1;
val = args[charset_arg_emacs_mule_id];
if (NILP (val))
@@ -1051,12 +1035,9 @@ usage: (define-charset-internal ...) */)
CHECK_FIXNAT (parent_max_code);
parent_code_offset = Fnth (make_fixnum (3), val);
CHECK_FIXNUM (parent_code_offset);
- val = make_uninit_vector (4);
- ASET (val, 0, make_fixnum (parent_charset->id));
- ASET (val, 1, parent_min_code);
- ASET (val, 2, parent_max_code);
- ASET (val, 3, parent_code_offset);
- ASET (attrs, charset_subset, val);
+ ASET (attrs, charset_subset,
+ CALLN (Fvector, make_fixnum (parent_charset->id),
+ parent_min_code, parent_max_code, parent_code_offset));
charset.method = CHARSET_METHOD_SUBSET;
/* Here, we just copy the parent's fast_map. It's not accurate,
@@ -1090,8 +1071,7 @@ usage: (define-charset-internal ...) */)
car_part = XCAR (elt);
cdr_part = XCDR (elt);
CHECK_CHARSET_GET_ID (car_part, this_id);
- CHECK_TYPE_RANGED_INTEGER (int, cdr_part);
- offset = XFIXNUM (cdr_part);
+ offset = check_integer_range (cdr_part, INT_MIN, INT_MAX);
}
else
{
@@ -1477,7 +1457,7 @@ string_xstring_p (Lisp_Object string)
while (p < endp)
{
- int c = STRING_CHAR_ADVANCE (p);
+ int c = string_char_advance (&p);
if (c >= 0x100)
return 2;
@@ -1521,7 +1501,7 @@ find_charsets_in_text (const unsigned char *ptr, ptrdiff_t nchars,
{
while (ptr < pend)
{
- int c = STRING_CHAR_ADVANCE (ptr);
+ int c = string_char_advance (&ptr);
struct charset *charset;
if (!NILP (table))
diff --git a/src/chartab.c b/src/chartab.c
index 04205ac1032..cb2ced568d9 100644
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -1117,10 +1117,10 @@ uniprop_table_uncompress (Lisp_Object table, int idx)
{
/* SIMPLE TABLE */
p++;
- idx = STRING_CHAR_ADVANCE (p);
+ idx = string_char_advance (&p);
while (p < pend && idx < chartab_chars[2])
{
- int v = STRING_CHAR_ADVANCE (p);
+ int v = string_char_advance (&p);
set_sub_char_table_contents
(sub, idx++, v > 0 ? make_fixnum (v) : Qnil);
}
@@ -1131,13 +1131,13 @@ uniprop_table_uncompress (Lisp_Object table, int idx)
p++;
for (idx = 0; p < pend; )
{
- int v = STRING_CHAR_ADVANCE (p);
+ int v = string_char_advance (&p);
int count = 1;
- int len;
if (p < pend)
{
- count = STRING_CHAR_AND_LENGTH (p, len);
+ int len;
+ count = string_char_and_length (p, &len);
if (count < 128)
count = 1;
else
diff --git a/src/cmds.c b/src/cmds.c
index 9914b7a01f7..c29cf00dad1 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -31,15 +31,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
static int internal_self_insert (int, EMACS_INT);
-DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0,
- doc: /* Return buffer position N characters after (before if N negative) point. */)
- (Lisp_Object n)
-{
- CHECK_FIXNUM (n);
-
- return make_fixnum (PT + XFIXNUM (n));
-}
-
/* Add N to point; or subtract N if FORWARD is false. N defaults to 1.
Validate the new location. Return nil. */
static Lisp_Object
@@ -398,8 +389,8 @@ internal_self_insert (int c, EMACS_INT n)
/* We will delete too many columns. Let's fill columns
by spaces so that the remaining text won't move. */
ptrdiff_t actual = PT_BYTE;
- DEC_POS (actual);
- if (FETCH_CHAR (actual) == '\t')
+ actual -= prev_char_len (actual);
+ if (FETCH_BYTE (actual) == '\t')
/* Rather than add spaces, let's just keep the tab. */
chars_to_delete--;
else
@@ -460,7 +451,10 @@ internal_self_insert (int c, EMACS_INT n)
string = concat2 (string, tem);
}
- replace_range (PT, PT + chars_to_delete, string, 1, 1, 1, 0);
+ ptrdiff_t to;
+ if (INT_ADD_WRAPV (PT, chars_to_delete, &to))
+ to = PTRDIFF_MAX;
+ replace_range (PT, to, string, 1, 1, 1, 0);
Fforward_char (make_fixnum (n));
}
else if (n > 1)
@@ -526,7 +520,6 @@ syms_of_cmds (void)
This is run after inserting the character. */);
Vpost_self_insert_hook = Qnil;
- defsubr (&Sforward_point);
defsubr (&Sforward_char);
defsubr (&Sbackward_char);
defsubr (&Sforward_line);
diff --git a/src/coding.c b/src/coding.c
index ed755b1afcf..221a9cad898 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -643,7 +643,7 @@ growable_destination (struct coding_system *coding)
else \
{ \
src--; \
- c = - string_char (src, &src, NULL); \
+ c = - string_char_advance (&src); \
record_conversion_result \
(coding, CODING_RESULT_INVALID_SRC); \
} \
@@ -728,7 +728,7 @@ growable_destination (struct coding_system *coding)
unsigned ch = (c); \
if (ch >= 0x80) \
ch = BYTE8_TO_CHAR (ch); \
- CHAR_STRING_ADVANCE (ch, dst); \
+ dst += CHAR_STRING (ch, dst); \
} \
else \
*dst++ = (c); \
@@ -747,11 +747,11 @@ growable_destination (struct coding_system *coding)
ch = (c1); \
if (ch >= 0x80) \
ch = BYTE8_TO_CHAR (ch); \
- CHAR_STRING_ADVANCE (ch, dst); \
+ dst += CHAR_STRING (ch, dst); \
ch = (c2); \
if (ch >= 0x80) \
ch = BYTE8_TO_CHAR (ch); \
- CHAR_STRING_ADVANCE (ch, dst); \
+ dst += CHAR_STRING (ch, dst); \
} \
else \
{ \
@@ -884,18 +884,18 @@ record_conversion_result (struct coding_system *coding,
/* Store multibyte form of the character C in P, and advance P to the
- end of the multibyte form. This used to be like CHAR_STRING_ADVANCE
+ end of the multibyte form. This used to be like adding CHAR_STRING
without ever calling MAYBE_UNIFY_CHAR, but nowadays we don't call
- MAYBE_UNIFY_CHAR in CHAR_STRING_ADVANCE. */
+ MAYBE_UNIFY_CHAR in CHAR_STRING. */
-#define CHAR_STRING_ADVANCE_NO_UNIFY(c, p) CHAR_STRING_ADVANCE(c, p)
+#define CHAR_STRING_ADVANCE_NO_UNIFY(c, p) ((p) += CHAR_STRING (c, p))
/* Return the character code of character whose multibyte form is at
P, and advance P to the end of the multibyte form. This used to be
- like STRING_CHAR_ADVANCE without ever calling MAYBE_UNIFY_CHAR, but
- nowadays STRING_CHAR_ADVANCE doesn't call MAYBE_UNIFY_CHAR. */
+ like string_char_advance without ever calling MAYBE_UNIFY_CHAR, but
+ nowadays string_char_advance doesn't call MAYBE_UNIFY_CHAR. */
-#define STRING_CHAR_ADVANCE_NO_UNIFY(p) STRING_CHAR_ADVANCE(p)
+#define STRING_CHAR_ADVANCE_NO_UNIFY(p) string_char_advance (&(p))
/* Set coding->source from coding->src_object. */
@@ -5131,7 +5131,7 @@ decode_coding_ccl (struct coding_system *coding)
while (i < 1024 && p < src_end)
{
source_byteidx[i] = p - src;
- source_charbuf[i++] = STRING_CHAR_ADVANCE (p);
+ source_charbuf[i++] = string_char_advance (&p);
}
source_byteidx[i] = p - src;
}
@@ -5308,15 +5308,10 @@ encode_coding_raw_text (struct coding_system *coding)
}
else
{
- unsigned char str[MAX_MULTIBYTE_LENGTH], *p0 = str, *p1 = str;
-
- CHAR_STRING_ADVANCE (c, p1);
- do
- {
- EMIT_ONE_BYTE (*p0);
- p0++;
- }
- while (p0 < p1);
+ unsigned char str[MAX_MULTIBYTE_LENGTH];
+ int len = CHAR_STRING (c, str);
+ for (int i = 0; i < len; i++)
+ EMIT_ONE_BYTE (str[i]);
}
}
else
@@ -5342,7 +5337,7 @@ encode_coding_raw_text (struct coding_system *coding)
else if (CHAR_BYTE8_P (c))
*dst++ = CHAR_TO_BYTE8 (c);
else
- CHAR_STRING_ADVANCE (c, dst);
+ dst += CHAR_STRING (c, dst);
}
}
else
@@ -7457,7 +7452,7 @@ decode_coding (struct coding_system *coding)
if (coding->src_multibyte
&& CHAR_BYTE8_HEAD_P (*src) && nbytes > 0)
{
- c = STRING_CHAR_ADVANCE (src);
+ c = string_char_advance (&src);
nbytes--;
}
else
@@ -7551,10 +7546,8 @@ handle_composition_annotation (ptrdiff_t pos, ptrdiff_t limit,
len = SCHARS (components);
i = i_byte = 0;
while (i < len)
- {
- FETCH_STRING_CHAR_ADVANCE (*buf, components, i, i_byte);
- buf++;
- }
+ *buf++ = fetch_string_char_advance (components,
+ &i, &i_byte);
}
else if (FIXNUMP (components))
{
@@ -7677,15 +7670,17 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table,
if (! multibytep)
{
- int bytes;
-
if (coding->encoder == encode_coding_raw_text
|| coding->encoder == encode_coding_ccl)
c = *src++, pos++;
- else if ((bytes = MULTIBYTE_LENGTH (src, src_end)) > 0)
- c = STRING_CHAR_ADVANCE_NO_UNIFY (src), pos += bytes;
else
- c = BYTE8_TO_CHAR (*src), src++, pos++;
+ {
+ int bytes = multibyte_length (src, src_end, true, true);
+ if (0 < bytes)
+ c = STRING_CHAR_ADVANCE_NO_UNIFY (src), pos += bytes;
+ else
+ c = BYTE8_TO_CHAR (*src), src++, pos++;
+ }
}
else
c = STRING_CHAR_ADVANCE_NO_UNIFY (src), pos++;
@@ -7715,7 +7710,7 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table,
lookup_buf[0] = c;
for (i = 1; i < max_lookup && p < src_end; i++)
- lookup_buf[i] = STRING_CHAR_ADVANCE (p);
+ lookup_buf[i] = string_char_advance (&p);
lookup_buf_end = lookup_buf + i;
trans = get_translation (trans, lookup_buf, lookup_buf_end,
&from_nchars);
@@ -7734,7 +7729,7 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table,
for (i = 1; i < to_nchars; i++)
*buf++ = XFIXNUM (AREF (trans, i));
for (i = 1; i < from_nchars; i++, pos++)
- src += MULTIBYTE_LENGTH_NO_CHECK (src);
+ src += multibyte_length (src, NULL, false, true);
}
}
@@ -9023,23 +9018,23 @@ DEFUN ("find-coding-systems-region-internal",
}
else
{
- CHECK_FIXNUM_COERCE_MARKER (start);
- CHECK_FIXNUM_COERCE_MARKER (end);
- if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end))
+ EMACS_INT s = fix_position (start);
+ EMACS_INT e = fix_position (end);
+ if (! (BEG <= s && s <= e && e <= Z))
args_out_of_range (start, end);
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
return Qt;
- start_byte = CHAR_TO_BYTE (XFIXNUM (start));
- end_byte = CHAR_TO_BYTE (XFIXNUM (end));
- if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte)
+ start_byte = CHAR_TO_BYTE (s);
+ end_byte = CHAR_TO_BYTE (e);
+ if (e - s == end_byte - start_byte)
return Qt;
- if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT)
+ if (s < GPT && GPT < e)
{
- if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT))
- move_gap_both (XFIXNUM (start), start_byte);
+ if (GPT - s < e - GPT)
+ move_gap_both (s, start_byte);
else
- move_gap_both (XFIXNUM (end), end_byte);
+ move_gap_both (e, end_byte);
}
}
@@ -9075,7 +9070,7 @@ DEFUN ("find-coding-systems-region-internal",
p++;
else
{
- c = STRING_CHAR_ADVANCE (p);
+ c = string_char_advance (&p);
if (!NILP (char_table_ref (work_table, c)))
/* This character was already checked. Ignore it. */
continue;
@@ -9208,7 +9203,7 @@ to the string and treated as in `substring'. */)
p = GAP_END_ADDR;
}
- c = STRING_CHAR_ADVANCE (p);
+ c = string_char_advance (&p);
if (! (ASCII_CHAR_P (c) && ascii_compatible)
&& ! char_charset (translate_char (translation_table, c),
charset_list, NULL))
@@ -9277,32 +9272,35 @@ is nil. */)
}
else
{
- CHECK_FIXNUM_COERCE_MARKER (start);
- CHECK_FIXNUM_COERCE_MARKER (end);
- if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end))
+ EMACS_INT s = fix_position (start);
+ EMACS_INT e = fix_position (end);
+ if (! (BEG <= s && s <= e && e <= Z))
args_out_of_range (start, end);
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
return Qnil;
- start_byte = CHAR_TO_BYTE (XFIXNUM (start));
- end_byte = CHAR_TO_BYTE (XFIXNUM (end));
- if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte)
+ start_byte = CHAR_TO_BYTE (s);
+ end_byte = CHAR_TO_BYTE (e);
+ if (e - s == end_byte - start_byte)
return Qnil;
- if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT)
+ if (s < GPT && GPT < e)
{
- if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT))
- move_gap_both (XFIXNUM (start), start_byte);
+ if (GPT - s < e - GPT)
+ move_gap_both (s, start_byte);
else
- move_gap_both (XFIXNUM (end), end_byte);
+ move_gap_both (e, end_byte);
}
- pos = XFIXNUM (start);
+ pos = s;
}
list = Qnil;
for (tail = coding_system_list; CONSP (tail); tail = XCDR (tail))
{
elt = XCAR (tail);
- attrs = AREF (CODING_SYSTEM_SPEC (elt), 0);
+ Lisp_Object spec = CODING_SYSTEM_SPEC (elt);
+ if (!VECTORP (spec))
+ xsignal1 (Qcoding_system_error, elt);
+ attrs = AREF (spec, 0);
ASET (attrs, coding_attr_trans_tbl,
get_translation_table (attrs, 1, NULL));
list = Fcons (list2 (elt, attrs), list);
@@ -9323,7 +9321,7 @@ is nil. */)
p++;
else
{
- c = STRING_CHAR_ADVANCE (p);
+ c = string_char_advance (&p);
charset_map_loaded = 0;
for (tail = list; CONSP (tail); tail = XCDR (tail))
@@ -9471,6 +9469,17 @@ not fully specified.) */)
return code_convert_region (start, end, coding_system, destination, 1, 0);
}
+/* Whether STRING only contains chars in the 0..127 range. */
+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;
+}
+
Lisp_Object
code_convert_string (Lisp_Object string, Lisp_Object coding_system,
Lisp_Object dst_object, bool encodep, bool nocopy,
@@ -9485,7 +9494,7 @@ code_convert_string (Lisp_Object string, Lisp_Object coding_system,
if (! norecord)
Vlast_coding_system_used = Qno_conversion;
if (NILP (dst_object))
- return (nocopy ? Fcopy_sequence (string) : string);
+ return nocopy ? string : Fcopy_sequence (string);
}
if (NILP (coding_system))
@@ -9502,7 +9511,28 @@ code_convert_string (Lisp_Object string, Lisp_Object coding_system,
chars = SCHARS (string);
bytes = SBYTES (string);
- if (BUFFERP (dst_object))
+ if (EQ (dst_object, Qt))
+ {
+ /* Fast path for ASCII-only input and an ASCII-compatible coding:
+ act as identity if no EOL conversion is needed. */
+ Lisp_Object attrs = CODING_ID_ATTRS (coding.id);
+ if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs))
+ && (STRING_MULTIBYTE (string)
+ ? (chars == bytes) : string_ascii_p (string))
+ && (EQ (CODING_ID_EOL_TYPE (coding.id), Qunix)
+ || inhibit_eol_conversion
+ || ! memchr (SDATA (string), encodep ? '\n' : '\r', bytes)))
+ {
+ if (! norecord)
+ Vlast_coding_system_used = coding_system;
+ return (nocopy
+ ? string
+ : (encodep
+ ? make_unibyte_string (SSDATA (string), bytes)
+ : make_multibyte_string (SSDATA (string), bytes, bytes)));
+ }
+ }
+ else if (BUFFERP (dst_object))
{
struct buffer *buf = XBUFFER (dst_object);
ptrdiff_t buf_pt = BUF_PT (buf);
@@ -9524,10 +9554,7 @@ code_convert_string (Lisp_Object string, Lisp_Object coding_system,
/* Encode or decode STRING according to CODING_SYSTEM.
- Do not set Vlast_coding_system_used.
-
- This function is called only from macros DECODE_FILE and
- ENCODE_FILE, thus we ignore character composition. */
+ Do not set Vlast_coding_system_used. */
Lisp_Object
code_convert_string_norecord (Lisp_Object string, Lisp_Object coding_system,
@@ -9696,7 +9723,7 @@ encode_string_utf_8 (Lisp_Object string, Lisp_Object buffer,
|| (len == 2 ? ! CHAR_BYTE8_HEAD_P (c)
: (EQ (handle_over_uni, Qt)
|| (len == 4
- && string_char (p, NULL, NULL) <= MAX_UNICODE_CHAR))))
+ && STRING_CHAR (p) <= MAX_UNICODE_CHAR))))
{
p += len;
continue;
@@ -9978,8 +10005,7 @@ decode_string_utf_8 (Lisp_Object string, const char *str, ptrdiff_t str_len,
&& (len == 3
|| (UTF_8_EXTRA_OCTET_P (p[3])
&& len == 4
- && (string_char (p, NULL, NULL)
- <= MAX_UNICODE_CHAR))))))
+ && STRING_CHAR (p) <= MAX_UNICODE_CHAR)))))
{
p += len;
continue;
@@ -10116,8 +10142,7 @@ decode_string_utf_8 (Lisp_Object string, const char *str, ptrdiff_t str_len,
mlen++);
if (mlen == len
&& (len <= 3
- || (len == 4
- && string_char (p, NULL, NULL) <= MAX_UNICODE_CHAR)
+ || (len == 4 && STRING_CHAR (p) <= MAX_UNICODE_CHAR)
|| EQ (handle_over_uni, Qt)))
{
p += len;
@@ -10297,6 +10322,16 @@ DEFUN ("internal-decode-string-utf-8", Finternal_decode_string_utf_8,
#endif /* ENABLE_UTF_8_CONVERTER_TEST */
+/* Encode or decode STRING using CODING_SYSTEM, with the possibility of
+ returning STRING itself if it equals the result.
+ Do not set Vlast_coding_system_used. */
+static Lisp_Object
+convert_string_nocopy (Lisp_Object string, Lisp_Object coding_system,
+ bool encodep)
+{
+ return code_convert_string (string, coding_system, Qt, encodep, 1, 1);
+}
+
/* Encode or decode a file name, to or from a unibyte string suitable
for passing to C library functions. */
Lisp_Object
@@ -10307,14 +10342,13 @@ decode_file_name (Lisp_Object fname)
converts the file names either to UTF-16LE or to the system ANSI
codepage internally, depending on the underlying OS; see w32.c. */
if (! NILP (Fcoding_system_p (Qutf_8)))
- return code_convert_string_norecord (fname, Qutf_8, 0);
+ return convert_string_nocopy (fname, Qutf_8, 0);
return fname;
#else /* !WINDOWSNT */
if (! NILP (Vfile_name_coding_system))
- return code_convert_string_norecord (fname, Vfile_name_coding_system, 0);
+ return convert_string_nocopy (fname, Vfile_name_coding_system, 0);
else if (! NILP (Vdefault_file_name_coding_system))
- return code_convert_string_norecord (fname,
- Vdefault_file_name_coding_system, 0);
+ return convert_string_nocopy (fname, Vdefault_file_name_coding_system, 0);
else
return fname;
#endif
@@ -10334,14 +10368,13 @@ encode_file_name (Lisp_Object fname)
converts the file names either to UTF-16LE or to the system ANSI
codepage internally, depending on the underlying OS; see w32.c. */
if (! NILP (Fcoding_system_p (Qutf_8)))
- return code_convert_string_norecord (fname, Qutf_8, 1);
+ return convert_string_nocopy (fname, Qutf_8, 1);
return fname;
#else /* !WINDOWSNT */
if (! NILP (Vfile_name_coding_system))
- return code_convert_string_norecord (fname, Vfile_name_coding_system, 1);
+ return convert_string_nocopy (fname, Vfile_name_coding_system, 1);
else if (! NILP (Vdefault_file_name_coding_system))
- return code_convert_string_norecord (fname,
- Vdefault_file_name_coding_system, 1);
+ return convert_string_nocopy (fname, Vdefault_file_name_coding_system, 1);
else
return fname;
#endif
@@ -10362,7 +10395,7 @@ representation of the decoded text.
This function sets `last-coding-system-used' to the precise coding system
used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
-not fully specified.) */)
+not fully specified.) The function does not change the match data. */)
(Lisp_Object string, Lisp_Object coding_system, Lisp_Object nocopy, Lisp_Object buffer)
{
return code_convert_string (string, coding_system, buffer,
@@ -10382,7 +10415,7 @@ case, the return value is the length of the encoded text.
This function sets `last-coding-system-used' to the precise coding system
used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
-not fully specified.) */)
+not fully specified.) The function does not change the match data. */)
(Lisp_Object string, Lisp_Object coding_system, Lisp_Object nocopy, Lisp_Object buffer)
{
return code_convert_string (string, coding_system, buffer,
@@ -10823,20 +10856,17 @@ HIGHESTP non-nil means just return the highest priority one. */)
return Fnreverse (val);
}
-static const char *const suffixes[] = { "-unix", "-dos", "-mac" };
-
static Lisp_Object
make_subsidiaries (Lisp_Object base)
{
- Lisp_Object subsidiaries;
+ static char const suffixes[][8] = { "-unix", "-dos", "-mac" };
ptrdiff_t base_name_len = SBYTES (SYMBOL_NAME (base));
USE_SAFE_ALLOCA;
char *buf = SAFE_ALLOCA (base_name_len + 6);
- int i;
memcpy (buf, SDATA (SYMBOL_NAME (base)), base_name_len);
- subsidiaries = make_uninit_vector (3);
- for (i = 0; i < 3; i++)
+ Lisp_Object subsidiaries = make_nil_vector (3);
+ for (int i = 0; i < 3; i++)
{
strcpy (buf + base_name_len, suffixes[i]);
ASET (subsidiaries, i, intern (buf));
@@ -10865,7 +10895,10 @@ usage: (define-coding-system-internal ...) */)
ASET (attrs, coding_attr_base_name, name);
Lisp_Object val = args[coding_arg_mnemonic];
- if (! STRINGP (val))
+ /* decode_mode_spec_coding assumes the mnemonic is a single character. */
+ if (STRINGP (val))
+ val = make_fixnum (STRING_CHAR (SDATA (val)));
+ else
CHECK_CHARACTER (val);
ASET (attrs, coding_attr_mnemonic, val);
@@ -11061,10 +11094,8 @@ usage: (define-coding-system-internal ...) */)
else
{
CHECK_CONS (val);
- CHECK_RANGED_INTEGER (XCAR (val), 0, 255);
- from = XFIXNUM (XCAR (val));
- CHECK_RANGED_INTEGER (XCDR (val), from, 255);
- to = XFIXNUM (XCDR (val));
+ from = check_integer_range (XCAR (val), 0, 255);
+ to = check_integer_range (XCDR (val), from, 255);
}
for (int i = from; i <= to; i++)
SSET (valids, i, 1);
@@ -11149,7 +11180,7 @@ usage: (define-coding-system-internal ...) */)
val = XCAR (tail);
CHECK_CONS (val);
CHECK_CHARSET_GET_ID (XCAR (val), id);
- CHECK_RANGED_INTEGER (XCDR (val), 0, 3);
+ check_integer_range (XCDR (val), 0, 3);
XSETCAR (val, make_fixnum (id));
}
@@ -11380,7 +11411,10 @@ DEFUN ("coding-system-put", Fcoding_system_put, Scoding_system_put,
attrs = AREF (spec, 0);
if (EQ (prop, QCmnemonic))
{
- if (! STRINGP (val))
+ /* decode_mode_spec_coding assumes the mnemonic is a single character. */
+ if (STRINGP (val))
+ val = make_fixnum (STRING_CHAR (SDATA (val)));
+ else
CHECK_CHARACTER (val);
ASET (attrs, coding_attr_mnemonic, val);
}
@@ -11745,6 +11779,8 @@ syms_of_coding (void)
DEFSYM (Qignored, "ignored");
+ DEFSYM (Qutf_8_string_p, "utf-8-string-p");
+
defsubr (&Scoding_system_p);
defsubr (&Sread_coding_system);
defsubr (&Sread_non_nil_coding_system);
@@ -11796,8 +11832,7 @@ Each element is one element list of coding system name.
This variable is given to `completing-read' as COLLECTION argument.
Do not alter the value of this variable manually. This variable should be
-updated by the functions `make-coding-system' and
-`define-coding-system-alias'. */);
+updated by `define-coding-system-alias'. */);
Vcoding_system_alist = Qnil;
DEFVAR_LISP ("coding-category-list", Vcoding_category_list,
diff --git a/src/coding.h b/src/coding.h
index 91856c5702b..c2a7b2a00ff 100644
--- a/src/coding.h
+++ b/src/coding.h
@@ -642,11 +642,11 @@ struct coding_system
} while (false)
/* Encode the file name NAME using the specified coding system
- for file names, if any. */
+ for file names, if any. May return NAME itself. */
#define ENCODE_FILE(NAME) encode_file_name (NAME)
/* Decode the file name NAME using the specified coding system
- for file names, if any. */
+ for file names, if any. May return NAME itself. */
#define DECODE_FILE(NAME) decode_file_name (NAME)
/* Encode the string STR using the specified coding system
diff --git a/src/composite.c b/src/composite.c
index bbb36dcbfa2..984e0d9cda8 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -170,7 +170,6 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
ptrdiff_t hash_index;
enum composition_method method;
struct composition *cmp;
- ptrdiff_t i;
int ch;
/* Maximum length of a string of glyphs. XftGlyphExtents limits
@@ -224,15 +223,15 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
{
key = make_uninit_vector (nchars);
if (STRINGP (string))
- for (i = 0; i < nchars; i++)
+ for (ptrdiff_t i = 0; i < nchars; i++)
{
- FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos);
+ ch = fetch_string_char_advance (string, &charpos, &bytepos);
ASET (key, i, make_fixnum (ch));
}
else
- for (i = 0; i < nchars; i++)
+ for (ptrdiff_t i = 0; i < nchars; i++)
{
- FETCH_CHAR_ADVANCE (ch, charpos, bytepos);
+ ch = fetch_char_advance (&charpos, &bytepos);
ASET (key, i, make_fixnum (ch));
}
}
@@ -273,7 +272,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
/* COMPONENTS is a glyph-string. */
ptrdiff_t len = ASIZE (key);
- for (i = 1; i < len; i++)
+ for (ptrdiff_t i = 1; i < len; i++)
if (! VECTORP (AREF (key, i)))
goto invalid_composition;
}
@@ -286,7 +285,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
goto invalid_composition;
/* All elements should be integers (character or encoded
composition rule). */
- for (i = 0; i < len; i++)
+ for (ptrdiff_t i = 0; i < len; i++)
{
if (!FIXNUMP (key_contents[i]))
goto invalid_composition;
@@ -328,7 +327,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
{
/* Relative composition. */
cmp->width = 0;
- for (i = 0; i < glyph_len; i++)
+ for (ptrdiff_t i = 0; i < glyph_len; i++)
{
int this_width;
ch = XFIXNUM (key_contents[i]);
@@ -347,7 +346,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
ch = XFIXNUM (key_contents[0]);
rightmost = ch != '\t' ? CHARACTER_WIDTH (ch) : 1;
- for (i = 1; i < glyph_len; i += 2)
+ for (ptrdiff_t i = 1; i < glyph_len; i += 2)
{
int rule, gref, nref;
int this_width;
@@ -653,7 +652,6 @@ Lisp_Object
composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len)
{
struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
- hash_rehash_if_needed (h);
Lisp_Object header = LGSTRING_HEADER (gstring);
Lisp_Object hash = h->test.hashfn (header, h);
if (len < 0)
@@ -800,12 +798,10 @@ fill_gstring_header (ptrdiff_t from, ptrdiff_t from_byte,
ASET (header, 0, font_object);
for (ptrdiff_t i = 0; i < len; i++)
{
- int c;
-
- if (NILP (string))
- FETCH_CHAR_ADVANCE_NO_CHECK (c, from, from_byte);
- else
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, from, from_byte);
+ int c
+ = (NILP (string)
+ ? fetch_char_advance_no_check (&from, &from_byte)
+ : fetch_string_char_advance_no_check (string, &from, &from_byte));
ASET (header, i + 1, make_fixnum (c));
}
return header;
@@ -1012,10 +1008,9 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos,
/* Forward search. */
while (charpos < endpos)
{
- if (STRINGP (string))
- FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos);
- else
- FETCH_CHAR_ADVANCE (c, charpos, bytepos);
+ c = (STRINGP (string)
+ ? fetch_string_char_advance (string, &charpos, &bytepos)
+ : fetch_char_advance (&charpos, &bytepos));
if (c == '\n')
{
cmp_it->ch = -2;
@@ -1070,7 +1065,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos,
p = BYTE_POS_ADDR (bytepos);
else
p = SDATA (string) + bytepos;
- c = STRING_CHAR_AND_LENGTH (p, len);
+ c = string_char_and_length (p, &len);
limit = bytepos + len;
while (char_composable_p (c))
{
@@ -1132,7 +1127,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos,
}
else
{
- DEC_BOTH (charpos, bytepos);
+ dec_both (&charpos, &bytepos);
p = BYTE_POS_ADDR (bytepos);
}
c = STRING_CHAR (p);
@@ -1145,7 +1140,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos,
{
while (charpos - 1 > endpos && ! char_composable_p (c))
{
- DEC_BOTH (charpos, bytepos);
+ dec_both (&charpos, &bytepos);
c = FETCH_MULTIBYTE_CHAR (bytepos);
}
}
@@ -1303,7 +1298,7 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
{
charpos++;
if (NILP (string))
- INC_POS (bytepos);
+ bytepos += next_char_len (bytepos);
else
bytepos += BYTES_BY_CHAR_HEAD (*(SDATA (string) + bytepos));
}
@@ -1769,7 +1764,18 @@ should be ignored. */)
CHECK_STRING (string);
validate_subarray (string, from, to, SCHARS (string), &frompos, &topos);
if (! STRING_MULTIBYTE (string))
- error ("Attempt to shape unibyte text");
+ {
+ ptrdiff_t i;
+
+ for (i = SBYTES (string) - 1; i >= 0; i--)
+ if (!ASCII_CHAR_P (SREF (string, i)))
+ error ("Attempt to shape unibyte text");
+ /* STRING is a pure-ASCII string, so we can convert it (or,
+ rather, its copy) to multibyte and use that thereafter. */
+ Lisp_Object string_copy = Fconcat (1, &string);
+ STRING_SET_MULTIBYTE (string_copy);
+ string = string_copy;
+ }
frombyte = string_char_to_byte (string, frompos);
}
@@ -1841,27 +1847,24 @@ See `find-composition' for more details. */)
ptrdiff_t start, end, from, to;
int id;
- CHECK_FIXNUM_COERCE_MARKER (pos);
+ EMACS_INT fixed_pos = fix_position (pos);
if (!NILP (limit))
- {
- CHECK_FIXNUM_COERCE_MARKER (limit);
- to = min (XFIXNUM (limit), ZV);
- }
+ to = clip_to_bounds (PTRDIFF_MIN, fix_position (limit), ZV);
else
to = -1;
if (!NILP (string))
{
CHECK_STRING (string);
- if (XFIXNUM (pos) < 0 || XFIXNUM (pos) > SCHARS (string))
+ if (! (0 <= fixed_pos && fixed_pos <= SCHARS (string)))
args_out_of_range (string, pos);
}
else
{
- if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) > ZV)
+ if (! (BEGV <= fixed_pos && fixed_pos <= ZV))
args_out_of_range (Fcurrent_buffer (), pos);
}
- from = XFIXNUM (pos);
+ from = fixed_pos;
if (!find_composition (from, to, &start, &end, &prop, string))
{
@@ -1872,12 +1875,12 @@ See `find-composition' for more details. */)
return list3 (make_fixnum (start), make_fixnum (end), gstring);
return Qnil;
}
- if ((end <= XFIXNUM (pos) || start > XFIXNUM (pos)))
+ if (! (start <= fixed_pos && fixed_pos < end))
{
ptrdiff_t s, e;
if (find_automatic_composition (from, to, &s, &e, &gstring, string)
- && (e <= XFIXNUM (pos) ? e > end : s < start))
+ && (e <= fixed_pos ? e > end : s < start))
return list3 (make_fixnum (s), make_fixnum (e), gstring);
}
if (!composition_valid_p (start, end, prop))
@@ -1936,7 +1939,7 @@ syms_of_composite (void)
staticpro (&gstring_hash_table);
staticpro (&gstring_work_headers);
- gstring_work_headers = make_uninit_vector (8);
+ gstring_work_headers = make_nil_vector (8);
for (i = 0; i < 8; i++)
ASET (gstring_work_headers, i, make_nil_vector (i + 2));
staticpro (&gstring_work);
@@ -1996,7 +1999,9 @@ preceding and/or following characters, this char-table contains
a function to call to compose that character.
The element at index C in the table, if non-nil, is a list of
-composition rules of this form: ([PATTERN PREV-CHARS FUNC] ...)
+composition rules of the form ([PATTERN PREV-CHARS FUNC] ...);
+the rules must be specified in the descending order of PREV-CHARS
+values.
PATTERN is a regular expression which C and the surrounding
characters must match.
diff --git a/src/composite.h b/src/composite.h
index 62c4de40e3b..239f1e531ef 100644
--- a/src/composite.h
+++ b/src/composite.h
@@ -125,10 +125,13 @@ composition_registered_p (Lisp_Object prop)
COMPOSITION_DECODE_REFS (rule_code, gref, nref); \
} while (false)
-/* Nonzero if the global reference point GREF and new reference point NREF are
+/* True if the global reference point GREF and new reference point NREF are
valid. */
-#define COMPOSITION_ENCODE_RULE_VALID(gref, nref) \
- (UNSIGNED_CMP (gref, <, 12) && UNSIGNED_CMP (nref, <, 12))
+INLINE bool
+COMPOSITION_ENCODE_RULE_VALID (int gref, int nref)
+{
+ return 0 <= gref && gref < 12 && 0 <= nref && nref < 12;
+}
/* Return encoded composition rule for the pair of global reference
point GREF and new reference point NREF. Arguments must be valid. */
diff --git a/src/conf_post.h b/src/conf_post.h
index 2f8d19fdca8..1ef4ff33428 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -30,13 +30,15 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#endif
/* To help make dependencies clearer elsewhere, this file typically
- does not #include other files. The exceptions are first stdbool.h
+ does not #include other files. The exceptions are stdbool.h
because it is unlikely to interfere with configuration and bool is
- such a core part of the C language, and second ms-w32.h (DOS_NT
+ such a core part of the C language, attribute.h because its
+ ATTRIBUTE_* macros are used here, and ms-w32.h (DOS_NT
only) because it historically was included here and changing that
would take some work. */
#include <stdbool.h>
+#include <attribute.h>
#if defined WINDOWSNT && !defined DEFER_MS_W32_H
# include <ms-w32.h>
@@ -65,30 +67,31 @@ typedef unsigned int bool_bf;
typedef bool bool_bf;
#endif
-/* Simulate __has_attribute on compilers that lack it. It is used only
- on arguments like alloc_size that are handled in this simulation.
- __has_attribute should be used only in #if expressions, as Oracle
+/* A substitute for __has_attribute on compilers that lack it.
+ It is used only on arguments like cleanup that are handled here.
+ This macro should be used only in #if expressions, as Oracle
Studio 12.5's __has_attribute does not work in plain code. */
-#ifndef __has_attribute
-# define __has_attribute(a) __has_attribute_##a
-# define __has_attribute_alloc_size GNUC_PREREQ (4, 3, 0)
-# define __has_attribute_cleanup GNUC_PREREQ (3, 4, 0)
-# define __has_attribute_cold GNUC_PREREQ (4, 3, 0)
-# define __has_attribute_externally_visible GNUC_PREREQ (4, 1, 0)
-# define __has_attribute_no_address_safety_analysis false
-# define __has_attribute_no_sanitize_address GNUC_PREREQ (4, 8, 0)
-# define __has_attribute_no_sanitize_undefined GNUC_PREREQ (4, 9, 0)
-# define __has_attribute_warn_unused_result GNUC_PREREQ (3, 4, 0)
+#ifdef __has_attribute
+# define HAS_ATTRIBUTE(a) __has_attribute (__##a##__)
+#else
+# define HAS_ATTRIBUTE(a) HAS_ATTR_##a
+# define HAS_ATTR_cleanup GNUC_PREREQ (3, 4, 0)
+# define HAS_ATTR_no_address_safety_analysis false
+# define HAS_ATTR_no_sanitize false
+# define HAS_ATTR_no_sanitize_address GNUC_PREREQ (4, 8, 0)
+# define HAS_ATTR_no_sanitize_undefined GNUC_PREREQ (4, 9, 0)
#endif
-/* Simulate __has_feature on compilers that lack it. It is used only
+/* A substitute for __has_feature on compilers that lack it. It is used only
to define ADDRESS_SANITIZER below. */
-#ifndef __has_feature
-# define __has_feature(a) false
+#ifdef __has_feature
+# define HAS_FEATURE(a) __has_feature (a)
+#else
+# define HAS_FEATURE(a) false
#endif
/* True if addresses are being sanitized. */
-#if defined __SANITIZE_ADDRESS__ || __has_feature (address_sanitizer)
+#if defined __SANITIZE_ADDRESS__ || HAS_FEATURE (address_sanitizer)
# define ADDRESS_SANITIZER true
#else
# define ADDRESS_SANITIZER false
@@ -225,37 +228,8 @@ extern void _DebPrint (const char *fmt, ...);
extern char *emacs_getenv_TZ (void);
extern int emacs_setenv_TZ (char const *);
-/* Avoid __attribute__ ((cold)) on MinGW; see thread starting at
- <https://lists.gnu.org/r/emacs-devel/2019-04/msg01152.html>. */
-#if __has_attribute (cold) && !defined __MINGW32__
-# define ATTRIBUTE_COLD __attribute__ ((cold))
-#else
-# define ATTRIBUTE_COLD
-#endif
-
-#if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */
-#define NO_INLINE __attribute__((noinline))
-#else
-#define NO_INLINE
-#endif
-
-#if __has_attribute (externally_visible)
-#define EXTERNALLY_VISIBLE __attribute__((externally_visible))
-#else
-#define EXTERNALLY_VISIBLE
-#endif
-
-#if GNUC_PREREQ (2, 7, 0)
-# define ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
-#else
-# define ATTRIBUTE_FORMAT(spec) /* empty */
-#endif
-
-#if GNUC_PREREQ (7, 0, 0)
-# define FALLTHROUGH __attribute__ ((__fallthrough__))
-#else
-# define FALLTHROUGH ((void) 0)
-#endif
+#define NO_INLINE ATTRIBUTE_NOINLINE
+#define EXTERNALLY_VISIBLE ATTRIBUTE_EXTERNALLY_VISIBLE
#if GNUC_PREREQ (4, 4, 0) && defined __GLIBC_MINOR__
# define PRINTF_ARCHETYPE __gnu_printf__
@@ -287,15 +261,8 @@ extern int emacs_setenv_TZ (char const *);
#define ATTRIBUTE_FORMAT_PRINTF(string_index, first_to_check) \
ATTRIBUTE_FORMAT ((PRINTF_ARCHETYPE, string_index, first_to_check))
-#define ARG_NONNULL _GL_ARG_NONNULL
-#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST
-#define ATTRIBUTE_UNUSED _GL_UNUSED
-
-#if GNUC_PREREQ (3, 3, 0) && !defined __ICC
-# define ATTRIBUTE_MAY_ALIAS __attribute__ ((__may_alias__))
-#else
-# define ATTRIBUTE_MAY_ALIAS
-#endif
+#define ARG_NONNULL ATTRIBUTE_NONNULL
+#define ATTRIBUTE_UNUSED MAYBE_UNUSED
/* Declare NAME to be a pointer to an object of type TYPE, initialized
to the address ADDR, which may be of a different type. Accesses
@@ -306,19 +273,11 @@ extern int emacs_setenv_TZ (char const *);
type ATTRIBUTE_MAY_ALIAS *name = (type *) (addr)
#if 3 <= __GNUC__
-# define ATTRIBUTE_MALLOC __attribute__ ((__malloc__))
# define ATTRIBUTE_SECTION(name) __attribute__((section (name)))
#else
-# define ATTRIBUTE_MALLOC
#define ATTRIBUTE_SECTION(name)
#endif
-#if __has_attribute (alloc_size)
-# define ATTRIBUTE_ALLOC_SIZE(args) __attribute__ ((__alloc_size__ args))
-#else
-# define ATTRIBUTE_ALLOC_SIZE(args)
-#endif
-
#define ATTRIBUTE_MALLOC_SIZE(args) ATTRIBUTE_MALLOC ATTRIBUTE_ALLOC_SIZE (args)
/* Work around GCC bug 59600: when a function is inlined, the inlined
@@ -336,10 +295,10 @@ extern int emacs_setenv_TZ (char const *);
/* Attribute of functions whose code should not have addresses
sanitized. */
-#if __has_attribute (no_sanitize_address)
+#if HAS_ATTRIBUTE (no_sanitize_address)
# define ATTRIBUTE_NO_SANITIZE_ADDRESS \
__attribute__ ((no_sanitize_address)) ADDRESS_SANITIZER_WORKAROUND
-#elif __has_attribute (no_address_safety_analysis)
+#elif HAS_ATTRIBUTE (no_address_safety_analysis)
# define ATTRIBUTE_NO_SANITIZE_ADDRESS \
__attribute__ ((no_address_safety_analysis)) ADDRESS_SANITIZER_WORKAROUND
#else
@@ -348,9 +307,9 @@ extern int emacs_setenv_TZ (char const *);
/* Attribute of functions whose undefined behavior should not be sanitized. */
-#if __has_attribute (no_sanitize_undefined)
+#if HAS_ATTRIBUTE (no_sanitize_undefined)
# define ATTRIBUTE_NO_SANITIZE_UNDEFINED __attribute__ ((no_sanitize_undefined))
-#elif __has_attribute (no_sanitize)
+#elif HAS_ATTRIBUTE (no_sanitize)
# define ATTRIBUTE_NO_SANITIZE_UNDEFINED \
__attribute__ ((no_sanitize ("undefined")))
#else
@@ -425,15 +384,13 @@ extern int emacs_setenv_TZ (char const *);
#else
-/* Use 'static' instead of 'extern inline' because 'static' typically
- has better performance for Emacs. Do not use the 'inline' keyword,
- as modern compilers inline automatically. ATTRIBUTE_UNUSED
- pacifies gcc -Wunused-function. */
+/* Use 'static inline' instead of 'extern inline' because 'static inline'
+ has much better performance for Emacs when compiled with 'gcc -Og'. */
# ifndef INLINE
# define INLINE EXTERN_INLINE
# endif
-# define EXTERN_INLINE static ATTRIBUTE_UNUSED
+# define EXTERN_INLINE static inline
# define INLINE_HEADER_BEGIN
# define INLINE_HEADER_END
diff --git a/src/data.c b/src/data.c
index 0f3ac8c6571..65589856687 100644
--- a/src/data.c
+++ b/src/data.c
@@ -143,15 +143,9 @@ wrong_length_argument (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
}
AVOID
-wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
+wrong_type_argument (Lisp_Object predicate, Lisp_Object value)
{
- /* If VALUE is not even a valid Lisp object, we'd want to abort here
- where we can get a backtrace showing where it came from. We used
- to try and do that by checking the tagbits, but nowadays all
- tagbits are potentially valid. */
- /* if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit)
- * emacs_abort (); */
-
+ eassert (!TAGGEDP (value, Lisp_Type_Unused0));
xsignal2 (Qwrong_type_argument, predicate, value);
}
@@ -912,6 +906,15 @@ Value, if non-nil, is a list (interactive SPEC). */)
if (PVSIZE (fun) > COMPILED_INTERACTIVE)
return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
}
+#ifdef HAVE_MODULES
+ else if (MODULE_FUNCTIONP (fun))
+ {
+ Lisp_Object form
+ = module_function_interactive_form (XMODULE_FUNCTION (fun));
+ if (! NILP (form))
+ return form;
+ }
+#endif
else if (AUTOLOADP (fun))
return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
else if (CONSP (fun))
@@ -1790,6 +1793,7 @@ make_blv (struct Lisp_Symbol *sym, bool forwarded,
set_blv_defcell (blv, tem);
set_blv_valcell (blv, tem);
set_blv_found (blv, false);
+ __lsan_ignore_object (blv);
return blv;
}
@@ -2305,61 +2309,45 @@ bool-vector. IDX starts at 0. */)
}
else /* STRINGP */
{
- int c;
-
CHECK_IMPURE (array, XSTRING (array));
if (idxval < 0 || idxval >= SCHARS (array))
args_out_of_range (array, idx);
CHECK_CHARACTER (newelt);
- c = XFIXNAT (newelt);
+ int c = XFIXNAT (newelt);
+ ptrdiff_t idxval_byte;
+ int prev_bytes;
+ unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
if (STRING_MULTIBYTE (array))
{
- ptrdiff_t idxval_byte, nbytes;
- int prev_bytes, new_bytes;
- unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
-
- nbytes = SBYTES (array);
idxval_byte = string_char_to_byte (array, idxval);
p1 = SDATA (array) + idxval_byte;
prev_bytes = BYTES_BY_CHAR_HEAD (*p1);
- new_bytes = CHAR_STRING (c, p0);
- if (prev_bytes != new_bytes)
- {
- /* We must relocate the string data. */
- ptrdiff_t nchars = SCHARS (array);
- USE_SAFE_ALLOCA;
- unsigned char *str = SAFE_ALLOCA (nbytes);
-
- memcpy (str, SDATA (array), nbytes);
- allocate_string_data (XSTRING (array), nchars,
- nbytes + new_bytes - prev_bytes);
- memcpy (SDATA (array), str, idxval_byte);
- p1 = SDATA (array) + idxval_byte;
- memcpy (p1 + new_bytes, str + idxval_byte + prev_bytes,
- nbytes - (idxval_byte + prev_bytes));
- SAFE_FREE ();
- clear_string_char_byte_cache ();
- }
- while (new_bytes--)
- *p1++ = *p0++;
}
- else
+ else if (SINGLE_BYTE_CHAR_P (c))
{
- if (! SINGLE_BYTE_CHAR_P (c))
- {
- ptrdiff_t i;
-
- for (i = SBYTES (array) - 1; i >= 0; i--)
- if (SREF (array, i) >= 0x80)
- args_out_of_range (array, newelt);
- /* ARRAY is an ASCII string. Convert it to a multibyte
- string, and try `aset' again. */
- STRING_SET_MULTIBYTE (array);
- return Faset (array, idx, newelt);
- }
SSET (array, idxval, c);
+ return newelt;
}
+ else
+ {
+ for (ptrdiff_t i = SBYTES (array) - 1; i >= 0; i--)
+ if (!ASCII_CHAR_P (SREF (array, i)))
+ args_out_of_range (array, newelt);
+ /* ARRAY is an ASCII string. Convert it to a multibyte string. */
+ STRING_SET_MULTIBYTE (array);
+ idxval_byte = idxval;
+ p1 = SDATA (array) + idxval_byte;
+ prev_bytes = 1;
+ }
+
+ int new_bytes = CHAR_STRING (c, p0);
+ if (prev_bytes != new_bytes)
+ p1 = resize_string_data (array, idxval_byte, prev_bytes, new_bytes);
+
+ do
+ *p1++ = *p0++;
+ while (--new_bytes != 0);
}
return newelt;
@@ -2367,6 +2355,24 @@ bool-vector. IDX starts at 0. */)
/* Arithmetic functions */
+static Lisp_Object
+check_integer_coerce_marker (Lisp_Object x)
+{
+ if (MARKERP (x))
+ return make_fixnum (marker_position (x));
+ CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x);
+ return x;
+}
+
+static Lisp_Object
+check_number_coerce_marker (Lisp_Object x)
+{
+ if (MARKERP (x))
+ return make_fixnum (marker_position (x));
+ CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x);
+ return x;
+}
+
Lisp_Object
arithcompare (Lisp_Object num1, Lisp_Object num2,
enum Arith_Comparison comparison)
@@ -2375,8 +2381,8 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
bool lt, eq = true, gt;
bool test;
- CHECK_NUMBER_COERCE_MARKER (num1);
- CHECK_NUMBER_COERCE_MARKER (num2);
+ num1 = check_number_coerce_marker (num1);
+ num2 = check_number_coerce_marker (num2);
/* If the comparison is mostly done by comparing two doubles,
set LT, EQ, and GT to the <, ==, > results of that comparison,
@@ -2778,9 +2784,7 @@ floatop_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
argnum++;
if (argnum == nargs)
return make_float (accum);
- Lisp_Object val = args[argnum];
- CHECK_NUMBER_COERCE_MARKER (val);
- next = XFLOATINT (val);
+ next = XFLOATINT (check_number_coerce_marker (args[argnum]));
}
}
@@ -2842,8 +2846,7 @@ bignum_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
argnum++;
if (argnum == nargs)
return make_integer_mpz ();
- val = args[argnum];
- CHECK_NUMBER_COERCE_MARKER (val);
+ val = check_number_coerce_marker (args[argnum]);
if (FLOATP (val))
return float_arith_driver (code, nargs, args, argnum,
mpz_get_d_rounded (*accum), val);
@@ -2872,8 +2875,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
argnum++;
if (argnum == nargs)
return make_int (accum);
- val = args[argnum];
- CHECK_NUMBER_COERCE_MARKER (val);
+ val = check_number_coerce_marker (args[argnum]);
/* Set NEXT to the next value if it fits, else exit the loop. */
intmax_t next;
@@ -2920,8 +2922,7 @@ usage: (+ &rest NUMBERS-OR-MARKERS) */)
{
if (nargs == 0)
return make_fixnum (0);
- Lisp_Object a = args[0];
- CHECK_NUMBER_COERCE_MARKER (a);
+ Lisp_Object a = check_number_coerce_marker (args[0]);
return nargs == 1 ? a : arith_driver (Aadd, nargs, args, a);
}
@@ -2934,8 +2935,7 @@ usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */)
{
if (nargs == 0)
return make_fixnum (0);
- Lisp_Object a = args[0];
- CHECK_NUMBER_COERCE_MARKER (a);
+ Lisp_Object a = check_number_coerce_marker (args[0]);
if (nargs == 1)
{
if (FIXNUMP (a))
@@ -2955,8 +2955,7 @@ usage: (* &rest NUMBERS-OR-MARKERS) */)
{
if (nargs == 0)
return make_fixnum (1);
- Lisp_Object a = args[0];
- CHECK_NUMBER_COERCE_MARKER (a);
+ Lisp_Object a = check_number_coerce_marker (args[0]);
return nargs == 1 ? a : arith_driver (Amult, nargs, args, a);
}
@@ -2968,8 +2967,7 @@ The arguments must be numbers or markers.
usage: (/ NUMBER &rest DIVISORS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object a = args[0];
- CHECK_NUMBER_COERCE_MARKER (a);
+ Lisp_Object a = check_number_coerce_marker (args[0]);
if (nargs == 1)
{
if (FIXNUMP (a))
@@ -3051,10 +3049,10 @@ integer_remainder (Lisp_Object num, Lisp_Object den, bool modulo)
DEFUN ("%", Frem, Srem, 2, 2, 0,
doc: /* Return remainder of X divided by Y.
Both must be integers or markers. */)
- (register Lisp_Object x, Lisp_Object y)
+ (Lisp_Object x, Lisp_Object y)
{
- CHECK_INTEGER_COERCE_MARKER (x);
- CHECK_INTEGER_COERCE_MARKER (y);
+ x = check_integer_coerce_marker (x);
+ y = check_integer_coerce_marker (y);
return integer_remainder (x, y, false);
}
@@ -3064,8 +3062,8 @@ The result falls between zero (inclusive) and Y (exclusive).
Both X and Y must be numbers or markers. */)
(Lisp_Object x, Lisp_Object y)
{
- CHECK_NUMBER_COERCE_MARKER (x);
- CHECK_NUMBER_COERCE_MARKER (y);
+ x = check_number_coerce_marker (x);
+ y = check_number_coerce_marker (y);
if (FLOATP (x) || FLOATP (y))
return fmod_float (x, y);
return integer_remainder (x, y, true);
@@ -3075,12 +3073,10 @@ static Lisp_Object
minmax_driver (ptrdiff_t nargs, Lisp_Object *args,
enum Arith_Comparison comparison)
{
- Lisp_Object accum = args[0];
- CHECK_NUMBER_COERCE_MARKER (accum);
+ Lisp_Object accum = check_number_coerce_marker (args[0]);
for (ptrdiff_t argnum = 1; argnum < nargs; argnum++)
{
- Lisp_Object val = args[argnum];
- CHECK_NUMBER_COERCE_MARKER (val);
+ Lisp_Object val = check_number_coerce_marker (args[argnum]);
if (!NILP (arithcompare (val, accum, comparison)))
accum = val;
else if (FLOATP (val) && isnan (XFLOAT_DATA (val)))
@@ -3115,8 +3111,7 @@ usage: (logand &rest INTS-OR-MARKERS) */)
{
if (nargs == 0)
return make_fixnum (-1);
- Lisp_Object a = args[0];
- CHECK_INTEGER_COERCE_MARKER (a);
+ Lisp_Object a = check_integer_coerce_marker (args[0]);
return nargs == 1 ? a : arith_driver (Alogand, nargs, args, a);
}
@@ -3128,8 +3123,7 @@ usage: (logior &rest INTS-OR-MARKERS) */)
{
if (nargs == 0)
return make_fixnum (0);
- Lisp_Object a = args[0];
- CHECK_INTEGER_COERCE_MARKER (a);
+ Lisp_Object a = check_integer_coerce_marker (args[0]);
return nargs == 1 ? a : arith_driver (Alogior, nargs, args, a);
}
@@ -3141,8 +3135,7 @@ usage: (logxor &rest INTS-OR-MARKERS) */)
{
if (nargs == 0)
return make_fixnum (0);
- Lisp_Object a = args[0];
- CHECK_INTEGER_COERCE_MARKER (a);
+ Lisp_Object a = check_integer_coerce_marker (args[0]);
return nargs == 1 ? a : arith_driver (Alogxor, nargs, args, a);
}
@@ -3261,9 +3254,9 @@ expt_integer (Lisp_Object x, Lisp_Object y)
DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0,
doc: /* Return NUMBER plus one. NUMBER may be a number or a marker.
Markers are converted to integers. */)
- (register Lisp_Object number)
+ (Lisp_Object number)
{
- CHECK_NUMBER_COERCE_MARKER (number);
+ number = check_number_coerce_marker (number);
if (FIXNUMP (number))
return make_int (XFIXNUM (number) + 1);
@@ -3276,9 +3269,9 @@ Markers are converted to integers. */)
DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0,
doc: /* Return NUMBER minus one. NUMBER may be a number or a marker.
Markers are converted to integers. */)
- (register Lisp_Object number)
+ (Lisp_Object number)
{
- CHECK_NUMBER_COERCE_MARKER (number);
+ number = check_number_coerce_marker (number);
if (FIXNUMP (number))
return make_int (XFIXNUM (number) - 1);
@@ -3322,27 +3315,14 @@ bool_vector_spare_mask (EMACS_INT nr_bits)
return (((bits_word) 1) << (nr_bits % BITS_PER_BITS_WORD)) - 1;
}
-/* Info about unsigned long long, falling back on unsigned long
- if unsigned long long is not available. */
-
-#if HAVE_UNSIGNED_LONG_LONG_INT && defined ULLONG_WIDTH
-enum { ULL_WIDTH = ULLONG_WIDTH };
-# define ULL_MAX ULLONG_MAX
-#else
-enum { ULL_WIDTH = ULONG_WIDTH };
-# define ULL_MAX ULONG_MAX
-# define count_one_bits_ll count_one_bits_l
-# define count_trailing_zeros_ll count_trailing_zeros_l
-#endif
-
/* Shift VAL right by the width of an unsigned long long.
- ULL_WIDTH must be less than BITS_PER_BITS_WORD. */
+ ULLONG_WIDTH must be less than BITS_PER_BITS_WORD. */
static bits_word
shift_right_ull (bits_word w)
{
/* Pacify bogus GCC warning about shift count exceeding type width. */
- int shift = ULL_WIDTH - BITS_PER_BITS_WORD < 0 ? ULL_WIDTH : 0;
+ int shift = ULLONG_WIDTH - BITS_PER_BITS_WORD < 0 ? ULLONG_WIDTH : 0;
return w >> shift;
}
@@ -3359,7 +3339,7 @@ count_one_bits_word (bits_word w)
{
int i = 0, count = 0;
while (count += count_one_bits_ll (w),
- (i += ULL_WIDTH) < BITS_PER_BITS_WORD)
+ (i += ULLONG_WIDTH) < BITS_PER_BITS_WORD)
w = shift_right_ull (w);
return count;
}
@@ -3490,7 +3470,7 @@ count_trailing_zero_bits (bits_word val)
return count_trailing_zeros (val);
if (BITS_WORD_MAX == ULONG_MAX)
return count_trailing_zeros_l (val);
- if (BITS_WORD_MAX == ULL_MAX)
+ if (BITS_WORD_MAX == ULLONG_MAX)
return count_trailing_zeros_ll (val);
/* The rest of this code is for the unlikely platform where bits_word differs
@@ -3504,18 +3484,18 @@ count_trailing_zero_bits (bits_word val)
{
int count;
for (count = 0;
- count < BITS_PER_BITS_WORD - ULL_WIDTH;
- count += ULL_WIDTH)
+ count < BITS_PER_BITS_WORD - ULLONG_WIDTH;
+ count += ULLONG_WIDTH)
{
- if (val & ULL_MAX)
+ if (val & ULLONG_MAX)
return count + count_trailing_zeros_ll (val);
val = shift_right_ull (val);
}
- if (BITS_PER_BITS_WORD % ULL_WIDTH != 0
+ if (BITS_PER_BITS_WORD % ULLONG_WIDTH != 0
&& BITS_WORD_MAX == (bits_word) -1)
val |= (bits_word) 1 << pre_value (ULONG_MAX < BITS_WORD_MAX,
- BITS_PER_BITS_WORD % ULL_WIDTH);
+ BITS_PER_BITS_WORD % ULLONG_WIDTH);
return count + count_trailing_zeros_ll (val);
}
}
@@ -3528,10 +3508,8 @@ bits_word_to_host_endian (bits_word val)
#else
if (BITS_WORD_MAX >> 31 == 1)
return bswap_32 (val);
-# if HAVE_UNSIGNED_LONG_LONG
if (BITS_WORD_MAX >> 31 >> 31 >> 1 == 1)
return bswap_64 (val);
-# endif
{
int i;
bits_word r = 0;
diff --git a/src/dbusbind.c b/src/dbusbind.c
index f6a0879e6a9..cca5f13907d 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -44,7 +44,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Alist of D-Bus buses we are polling for messages.
The key is the symbol or string of the bus, and the value is the
- connection address. */
+ connection address. For every bus, just one connection is counted.
+ If there shall be a second connection to the same bus, a different
+ symbol or string for the bus must be chosen. On Lisp level, a bus
+ stands for the associated connection. */
static Lisp_Object xd_registered_buses;
/* Whether we are reading a D-Bus event. */
@@ -129,36 +132,23 @@ static bool xd_in_read_queued_messages = 0;
#define XD_BASIC_DBUS_TYPE(type) \
(dbus_type_is_valid (type) && dbus_type_is_basic (type))
#else
-#ifdef DBUS_TYPE_UNIX_FD
-#define XD_BASIC_DBUS_TYPE(type) \
- ((type == DBUS_TYPE_BYTE) \
- || (type == DBUS_TYPE_BOOLEAN) \
- || (type == DBUS_TYPE_INT16) \
- || (type == DBUS_TYPE_UINT16) \
- || (type == DBUS_TYPE_INT32) \
- || (type == DBUS_TYPE_UINT32) \
- || (type == DBUS_TYPE_INT64) \
- || (type == DBUS_TYPE_UINT64) \
- || (type == DBUS_TYPE_DOUBLE) \
- || (type == DBUS_TYPE_STRING) \
- || (type == DBUS_TYPE_OBJECT_PATH) \
- || (type == DBUS_TYPE_SIGNATURE) \
- || (type == DBUS_TYPE_UNIX_FD))
-#else
#define XD_BASIC_DBUS_TYPE(type) \
- ((type == DBUS_TYPE_BYTE) \
- || (type == DBUS_TYPE_BOOLEAN) \
- || (type == DBUS_TYPE_INT16) \
- || (type == DBUS_TYPE_UINT16) \
- || (type == DBUS_TYPE_INT32) \
- || (type == DBUS_TYPE_UINT32) \
- || (type == DBUS_TYPE_INT64) \
- || (type == DBUS_TYPE_UINT64) \
- || (type == DBUS_TYPE_DOUBLE) \
- || (type == DBUS_TYPE_STRING) \
- || (type == DBUS_TYPE_OBJECT_PATH) \
- || (type == DBUS_TYPE_SIGNATURE))
+ ((type == DBUS_TYPE_BYTE) \
+ || (type == DBUS_TYPE_BOOLEAN) \
+ || (type == DBUS_TYPE_INT16) \
+ || (type == DBUS_TYPE_UINT16) \
+ || (type == DBUS_TYPE_INT32) \
+ || (type == DBUS_TYPE_UINT32) \
+ || (type == DBUS_TYPE_INT64) \
+ || (type == DBUS_TYPE_UINT64) \
+ || (type == DBUS_TYPE_DOUBLE) \
+ || (type == DBUS_TYPE_STRING) \
+ || (type == DBUS_TYPE_OBJECT_PATH) \
+ || (type == DBUS_TYPE_SIGNATURE) \
+#ifdef DBUS_TYPE_UNIX_FD
+ || (type == DBUS_TYPE_UNIX_FD) \
#endif
+ )
#endif
/* This was a macro. On Solaris 2.11 it was said to compile for
@@ -192,9 +182,39 @@ xd_symbol_to_dbus_type (Lisp_Object object)
: DBUS_TYPE_INVALID);
}
+/* Determine the Lisp symbol of DBusType. */
+static Lisp_Object
+xd_dbus_type_to_symbol (int type)
+{
+ return
+ (type == DBUS_TYPE_BYTE) ? QCbyte
+ : (type == DBUS_TYPE_BOOLEAN) ? QCboolean
+ : (type == DBUS_TYPE_INT16) ? QCint16
+ : (type == DBUS_TYPE_UINT16) ? QCuint16
+ : (type == DBUS_TYPE_INT32) ? QCint32
+ : (type == DBUS_TYPE_UINT32) ? QCuint32
+ : (type == DBUS_TYPE_INT64) ? QCint64
+ : (type == DBUS_TYPE_UINT64) ? QCuint64
+ : (type == DBUS_TYPE_DOUBLE) ? QCdouble
+ : (type == DBUS_TYPE_STRING) ? QCstring
+ : (type == DBUS_TYPE_OBJECT_PATH) ? QCobject_path
+ : (type == DBUS_TYPE_SIGNATURE) ? QCsignature
+#ifdef DBUS_TYPE_UNIX_FD
+ : (type == DBUS_TYPE_UNIX_FD) ? QCunix_fd
+#endif
+ : (type == DBUS_TYPE_ARRAY) ? QCarray
+ : (type == DBUS_TYPE_VARIANT) ? QCvariant
+ : (type == DBUS_TYPE_STRUCT) ? QCstruct
+ : (type == DBUS_TYPE_DICT_ENTRY) ? QCdict_entry
+ : Qnil;
+}
+
+#define XD_KEYWORDP(object) !NILP (Fkeywordp (object))
+
/* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
#define XD_DBUS_TYPE_P(object) \
- (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
+ XD_KEYWORDP (object) && \
+ ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID))
/* Determine the DBusType of a given Lisp OBJECT. It is used to
convert Lisp objects, being arguments of `dbus-call-method' or
@@ -265,10 +285,13 @@ XD_OBJECT_TO_STRING (Lisp_Object object)
else \
{ \
CHECK_SYMBOL (bus); \
- if (!(EQ (bus, QCsystem) || EQ (bus, QCsession))) \
+ if (!(EQ (bus, QCsystem) || EQ (bus, QCsession) \
+ || EQ (bus, QCsystem_private) \
+ || EQ (bus, QCsession_private))) \
XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
/* We do not want to have an autolaunch for the session bus. */ \
- if (EQ (bus, QCsession) && session_bus_address == NULL) \
+ if ((EQ (bus, QCsession) || EQ (bus, QCsession_private)) \
+ && session_bus_address == NULL) \
XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
} \
} while (0)
@@ -360,7 +383,8 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
break;
case DBUS_TYPE_BOOLEAN:
- if (!EQ (object, Qt) && !NILP (object))
+ /* There must be an argument. */
+ if (EQ (QCboolean, object))
wrong_type_argument (intern ("booleanp"), object);
sprintf (signature, "%c", dtype);
break;
@@ -385,6 +409,8 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
case DBUS_TYPE_STRING:
case DBUS_TYPE_OBJECT_PATH:
case DBUS_TYPE_SIGNATURE:
+ /* We dont check the syntax of object path and signature. This
+ will be done by libdbus. */
CHECK_STRING (object);
sprintf (signature, "%c", dtype);
break;
@@ -440,6 +466,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
CHECK_CONS (object);
elt = XD_NEXT_VALUE (elt);
+ CHECK_CONS (elt);
subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
@@ -451,11 +478,12 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
break;
case DBUS_TYPE_STRUCT:
- /* A struct list might contain any number of elements with
- different types. No further check needed. */
+ /* A struct list might contain any (but zero) number of elements
+ with different types. No further check needed. */
CHECK_CONS (object);
elt = XD_NEXT_VALUE (elt);
+ CHECK_CONS (elt);
/* Compose the signature from the elements. It is enclosed by
parentheses. */
@@ -486,6 +514,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
/* First element. */
elt = XD_NEXT_VALUE (elt);
+ CHECK_CONS (elt);
subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
xd_signature_cat (signature, x);
@@ -495,6 +524,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
/* Second element. */
elt = CDR_SAFE (XD_NEXT_VALUE (elt));
+ CHECK_CONS (elt);
subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
xd_signature_cat (signature, x);
@@ -595,6 +625,9 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
}
case DBUS_TYPE_BOOLEAN:
+ /* There must be an argument. */
+ if (EQ (QCboolean, object))
+ wrong_type_argument (intern ("booleanp"), object);
{
dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
@@ -693,6 +726,8 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
case DBUS_TYPE_STRING:
case DBUS_TYPE_OBJECT_PATH:
case DBUS_TYPE_SIGNATURE:
+ /* We dont check the syntax of object path and signature.
+ This will be done by libdbus. */
CHECK_STRING (object);
{
/* We need to send a valid UTF-8 string. We could encode `object'
@@ -816,7 +851,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
val = val & 0xFF;
XD_DEBUG_MESSAGE ("%c %u", dtype, val);
- return make_fixnum (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), make_fixnum (val));
}
case DBUS_TYPE_BOOLEAN:
@@ -824,7 +859,8 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_bool_t val;
dbus_message_iter_get_basic (iter, &val);
XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
- return (val == FALSE) ? Qnil : Qt;
+ return list2 (xd_dbus_type_to_symbol (dtype),
+ (val == FALSE) ? Qnil : Qt);
}
case DBUS_TYPE_INT16:
@@ -834,7 +870,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
pval = val;
XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
- return make_fixnum (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), make_fixnum (val));
}
case DBUS_TYPE_UINT16:
@@ -844,7 +880,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
pval = val;
XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
- return make_fixnum (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), make_fixnum (val));
}
case DBUS_TYPE_INT32:
@@ -854,7 +890,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
pval = val;
XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
- return INT_TO_INTEGER (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val));
}
case DBUS_TYPE_UINT32:
@@ -867,7 +903,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
pval = val;
XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
- return INT_TO_INTEGER (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val));
}
case DBUS_TYPE_INT64:
@@ -876,7 +912,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
intmax_t pval = val;
XD_DEBUG_MESSAGE ("%c %"PRIdMAX, dtype, pval);
- return INT_TO_INTEGER (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val));
}
case DBUS_TYPE_UINT64:
@@ -885,7 +921,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
uintmax_t pval = val;
XD_DEBUG_MESSAGE ("%c %"PRIuMAX, dtype, pval);
- return INT_TO_INTEGER (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val));
}
case DBUS_TYPE_DOUBLE:
@@ -893,7 +929,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
double val;
dbus_message_iter_get_basic (iter, &val);
XD_DEBUG_MESSAGE ("%c %f", dtype, val);
- return make_float (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), make_float (val));
}
case DBUS_TYPE_STRING:
@@ -903,7 +939,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
char *val;
dbus_message_iter_get_basic (iter, &val);
XD_DEBUG_MESSAGE ("%c %s", dtype, val);
- return build_string (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), build_string (val));
}
case DBUS_TYPE_ARRAY:
@@ -923,7 +959,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_next (&subiter);
}
XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
- return Fnreverse (result);
+ return Fcons (xd_dbus_type_to_symbol (dtype), Fnreverse (result));
}
default:
@@ -953,8 +989,9 @@ xd_lisp_dbus_to_dbus (Lisp_Object bus)
return xmint_pointer (bus);
}
-/* Return D-Bus connection address. BUS is either a Lisp symbol,
- :system or :session, or a string denoting the bus address. */
+/* Return D-Bus connection address.
+ BUS is either a Lisp symbol, :system, :session, :system-private or
+ :session-private, or a string denoting the bus address. */
static DBusConnection *
xd_get_connection_address (Lisp_Object bus)
{
@@ -1016,7 +1053,8 @@ xd_add_watch (DBusWatch *watch, void *data)
}
/* Stop monitoring WATCH for possible I/O.
- DATA is the used bus, either a string or QCsystem or QCsession. */
+ DATA is the used bus, either a string or QCsystem, QCsession,
+ QCsystem_private or QCsession_private. */
static void
xd_remove_watch (DBusWatch *watch, void *data)
{
@@ -1031,7 +1069,7 @@ xd_remove_watch (DBusWatch *watch, void *data)
/* Unset session environment. */
#if 0
/* This is buggy, since unsetenv is not thread-safe. */
- if (XSYMBOL (QCsession) == data)
+ if (XSYMBOL (QCsession) == data) || (XSYMBOL (QCsession_private) == data)
{
XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
unsetenv ("DBUS_SESSION_BUS_ADDRESS");
@@ -1105,6 +1143,11 @@ can be a string denoting the address of the corresponding bus. For
the system and session buses, this function is called when loading
`dbus.el', there is no need to call it again.
+A special case is BUS being the symbol `:system-private' or
+`:session-private'. These symbols still denote the system or session
+bus, but using a private connection. They should not be used outside
+dbus.el.
+
The function returns a number, which counts the connections this Emacs
session has established to the BUS under the same unique name (see
`dbus-get-unique-name'). It depends on the libraries Emacs is linked
@@ -1127,6 +1170,10 @@ this connection to those buses. */)
ptrdiff_t refcount;
/* Check parameter. */
+ if (!NILP (private))
+ bus = EQ (bus, QCsystem)
+ ? QCsystem_private
+ : EQ (bus, QCsession) ? QCsession_private : bus;
XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
/* Close bus if it is already open. */
@@ -1154,8 +1201,9 @@ this connection to those buses. */)
else
{
- DBusBusType bustype = (EQ (bus, QCsystem)
- ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION);
+ DBusBusType bustype
+ = EQ (bus, QCsystem) || EQ (bus, QCsystem_private)
+ ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION;
if (NILP (private))
connection = dbus_bus_get (bustype, &derror);
else
@@ -1169,9 +1217,9 @@ this connection to those buses. */)
XD_SIGNAL2 (build_string ("No connection to bus"), bus);
/* If it is not the system or session bus, we must register
- ourselves. Otherwise, we have called dbus_bus_get, which has
- configured us to exit if the connection closes - we undo this
- setting. */
+ ourselves. Otherwise, we have called dbus_bus_get{_private},
+ which has configured us to exit if the connection closes - we
+ undo this setting. */
if (STRINGP (bus))
dbus_bus_register (connection, &derror);
else
@@ -1186,7 +1234,7 @@ this connection to those buses. */)
xd_add_watch,
xd_remove_watch,
xd_toggle_watch,
- SYMBOLP (bus)
+ XD_KEYWORDP (bus)
? (void *) XSYMBOL (bus)
: (void *) XSTRING (bus),
NULL))
@@ -1200,6 +1248,9 @@ this connection to those buses. */)
dbus_error_free (&derror);
}
+ XD_DEBUG_MESSAGE ("Registered buses: %s",
+ XD_OBJECT_TO_STRING (xd_registered_buses));
+
/* Return reference counter. */
refcount = xd_get_connection_references (connection);
XD_DEBUG_MESSAGE ("Bus %s, Reference counter %"pD"d",
@@ -1252,7 +1303,11 @@ The following usages are expected:
`dbus-method-error-internal':
(dbus-message-internal
- dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
+ dbus-message-type-error BUS SERVICE SERIAL ERROR-NAME &rest ARGS)
+
+`dbus-check-arguments': (does not send a message)
+ (dbus-message-internal
+ dbus-message-type-invalid BUS SERVICE &rest ARGS)
usage: (dbus-message-internal &rest REST) */)
(ptrdiff_t nargs, Lisp_Object *args)
@@ -1261,6 +1316,7 @@ usage: (dbus-message-internal &rest REST) */)
Lisp_Object path = Qnil;
Lisp_Object interface = Qnil;
Lisp_Object member = Qnil;
+ Lisp_Object error_name = Qnil;
Lisp_Object result;
DBusConnection *connection;
DBusMessage *dmessage;
@@ -1270,7 +1326,7 @@ usage: (dbus-message-internal &rest REST) */)
dbus_uint32_t serial = 0;
unsigned int ui_serial;
int timeout = -1;
- ptrdiff_t count;
+ ptrdiff_t count, count0;
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
/* Initialize parameters. */
@@ -1280,7 +1336,7 @@ usage: (dbus-message-internal &rest REST) */)
handler = Qnil;
CHECK_FIXNAT (message_type);
- if (! (DBUS_MESSAGE_TYPE_INVALID < XFIXNAT (message_type)
+ if (! (DBUS_MESSAGE_TYPE_INVALID <= XFIXNAT (message_type)
&& XFIXNAT (message_type) < DBUS_NUM_MESSAGE_TYPES))
XD_SIGNAL2 (build_string ("Invalid message type"), message_type);
mtype = XFIXNAT (message_type);
@@ -1295,11 +1351,16 @@ usage: (dbus-message-internal &rest REST) */)
handler = args[6];
count = (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) ? 7 : 6;
}
- else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
+ else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
+ || (mtype == DBUS_MESSAGE_TYPE_ERROR))
{
serial = xd_extract_unsigned (args[3], TYPE_MAXIMUM (dbus_uint32_t));
- count = 4;
+ if (mtype == DBUS_MESSAGE_TYPE_ERROR)
+ error_name = args[4];
+ count = (mtype == DBUS_MESSAGE_TYPE_ERROR) ? 5 : 4;
}
+ else /* DBUS_MESSAGE_TYPE_INVALID */
+ count = 3;
/* Check parameters. */
XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
@@ -1341,24 +1402,41 @@ usage: (dbus-message-internal &rest REST) */)
XD_OBJECT_TO_STRING (interface),
XD_OBJECT_TO_STRING (member));
break;
- default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
+ case DBUS_MESSAGE_TYPE_METHOD_RETURN:
ui_serial = serial;
XD_DEBUG_MESSAGE ("%s %s %s %u",
XD_MESSAGE_TYPE_TO_STRING (mtype),
XD_OBJECT_TO_STRING (bus),
XD_OBJECT_TO_STRING (service),
ui_serial);
+ break;
+ case DBUS_MESSAGE_TYPE_ERROR:
+ ui_serial = serial;
+ XD_DEBUG_MESSAGE ("%s %s %s %u %s",
+ XD_MESSAGE_TYPE_TO_STRING (mtype),
+ XD_OBJECT_TO_STRING (bus),
+ XD_OBJECT_TO_STRING (service),
+ ui_serial,
+ XD_OBJECT_TO_STRING (error_name));
+ break;
+ default: /* DBUS_MESSAGE_TYPE_INVALID */
+ XD_DEBUG_MESSAGE ("%s %s %s",
+ XD_MESSAGE_TYPE_TO_STRING (mtype),
+ XD_OBJECT_TO_STRING (bus),
+ XD_OBJECT_TO_STRING (service));
}
/* Retrieve bus address. */
connection = xd_get_connection_address (bus);
- /* Create the D-Bus message. */
- dmessage = dbus_message_new (mtype);
+ /* Create the D-Bus message. Since DBUS_MESSAGE_TYPE_INVALID is not
+ a valid message type, we mockup it with DBUS_MESSAGE_TYPE_SIGNAL. */
+ dmessage = dbus_message_new
+ ((mtype == DBUS_MESSAGE_TYPE_INVALID) ? DBUS_MESSAGE_TYPE_SIGNAL : mtype);
if (dmessage == NULL)
XD_SIGNAL1 (build_string ("Unable to create a new message"));
- if (STRINGP (service))
+ if ((STRINGP (service)) && (mtype != DBUS_MESSAGE_TYPE_INVALID))
{
if (mtype != DBUS_MESSAGE_TYPE_SIGNAL)
/* Set destination. */
@@ -1400,13 +1478,14 @@ usage: (dbus-message-internal &rest REST) */)
XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
}
- else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
+ else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
+ || (mtype == DBUS_MESSAGE_TYPE_ERROR))
{
if (!dbus_message_set_reply_serial (dmessage, serial))
XD_SIGNAL1 (build_string ("Unable to create a return message"));
if ((mtype == DBUS_MESSAGE_TYPE_ERROR)
- && (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED)))
+ && (!dbus_message_set_error_name (dmessage, SSDATA (error_name))))
XD_SIGNAL1 (build_string ("Unable to create an error message"));
}
@@ -1422,6 +1501,7 @@ usage: (dbus-message-internal &rest REST) */)
dbus_message_iter_init_append (dmessage, &iter);
/* Append parameters to the message. */
+ count0 = count - 1;
for (; count < nargs; ++count)
{
dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]);
@@ -1429,15 +1509,17 @@ usage: (dbus-message-internal &rest REST) */)
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", count - 4,
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d: %s Parameter%"pD"d: %s",
+ count - count0,
XD_OBJECT_TO_STRING (args[count]),
+ count + 1 - count0,
XD_OBJECT_TO_STRING (args[count+1]));
++count;
}
else
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", count - 4,
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d: %s", count - count0,
XD_OBJECT_TO_STRING (args[count]));
}
@@ -1448,7 +1530,10 @@ usage: (dbus-message-internal &rest REST) */)
xd_append_arg (dtype, args[count], &iter);
}
- if (!NILP (handler))
+ if (mtype == DBUS_MESSAGE_TYPE_INVALID)
+ result = Qt;
+
+ else if (!NILP (handler))
{
/* Send the message. The message is just added to the outgoing
message queue. */
@@ -1473,7 +1558,8 @@ usage: (dbus-message-internal &rest REST) */)
result = Qnil;
}
- XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result));
+ if (mtype != DBUS_MESSAGE_TYPE_INVALID)
+ XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result));
/* Cleanup. */
dbus_message_unref (dmessage);
@@ -1483,8 +1569,8 @@ usage: (dbus-message-internal &rest REST) */)
}
/* Read one queued incoming message of the D-Bus BUS.
- BUS is either a Lisp symbol, :system or :session, or a string denoting
- the bus address. */
+ BUS is either a Lisp symbol, :system, :session, :system-private or
+ :session-private, or a string denoting the bus address. */
static void
xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
{
@@ -1496,7 +1582,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
int mtype;
dbus_uint32_t serial;
unsigned int ui_serial;
- const char *uname, *path, *interface, *member;
+ const char *uname, *destination, *path, *interface, *member, *error_name;
dmessage = dbus_connection_pop_message (connection);
@@ -1521,7 +1607,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
}
/* Read message type, message serial, unique name, object path,
- interface and member from the message. */
+ interface, member and error name from the message. */
mtype = dbus_message_get_type (dmessage);
ui_serial = serial =
((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
@@ -1529,13 +1615,16 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
? dbus_message_get_reply_serial (dmessage)
: dbus_message_get_serial (dmessage);
uname = dbus_message_get_sender (dmessage);
+ destination = dbus_message_get_destination (dmessage);
path = dbus_message_get_path (dmessage);
interface = dbus_message_get_interface (dmessage);
member = dbus_message_get_member (dmessage);
+ error_name = dbus_message_get_error_name (dmessage);
- XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
+ XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s %s",
XD_MESSAGE_TYPE_TO_STRING (mtype),
- ui_serial, uname, path, interface, member,
+ ui_serial, uname, destination, path, interface,
+ mtype == DBUS_MESSAGE_TYPE_ERROR ? error_name : member,
XD_OBJECT_TO_STRING (args));
if (mtype == DBUS_MESSAGE_TYPE_INVALID)
@@ -1550,7 +1639,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
/* There shall be exactly one entry. Construct an event. */
if (NILP (value))
- goto cleanup;
+ goto monitor;
/* Remove the entry. */
Fremhash (key, Vdbus_registered_objects_table);
@@ -1559,6 +1648,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
EVENT_INIT (event);
event.kind = DBUS_EVENT;
event.frame_or_window = Qnil;
+ /* Handler. */
event.arg = Fcons (value, args);
}
@@ -1567,7 +1657,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
/* Vdbus_registered_objects_table requires non-nil interface and
member. */
if ((interface == NULL) || (member == NULL))
- goto cleanup;
+ goto monitor;
/* Search for a registered function of the message. */
key = list4 (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL ? QCmethod : QCsignal,
@@ -1592,6 +1682,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
EVENT_INIT (event);
event.kind = DBUS_EVENT;
event.frame_or_window = Qnil;
+ /* Handler. */
event.arg
= Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))), args);
break;
@@ -1600,16 +1691,22 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
}
if (NILP (value))
- goto cleanup;
+ goto monitor;
}
- /* Add type, serial, uname, path, interface and member to the event. */
- event.arg = Fcons ((member == NULL ? Qnil : build_string (member)),
- event.arg);
+ /* Add type, serial, uname, destination, path, interface and member
+ or error_name to the event. */
+ event.arg
+ = Fcons (mtype == DBUS_MESSAGE_TYPE_ERROR
+ ? error_name == NULL ? Qnil : build_string (error_name)
+ : member == NULL ? Qnil : build_string (member),
+ event.arg);
event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)),
event.arg);
event.arg = Fcons ((path == NULL ? Qnil : build_string (path)),
event.arg);
+ event.arg = Fcons ((destination == NULL ? Qnil : build_string (destination)),
+ event.arg);
event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
event.arg);
event.arg = Fcons (INT_TO_INTEGER (serial), event.arg);
@@ -1623,14 +1720,58 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg));
+ /* Monitor. */
+ monitor:
+ /* Search for a registered function of the message. */
+ key = list2 (QCmonitor, bus);
+ value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
+
+ /* There shall be exactly one entry. Construct an event. */
+ if (NILP (value))
+ goto cleanup;
+
+ /* Construct an event. */
+ EVENT_INIT (event);
+ event.kind = DBUS_EVENT;
+ event.frame_or_window = Qnil;
+
+ /* Add type, serial, uname, destination, path, interface, member
+ or error_name and handler to the event. */
+ event.arg
+ = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (CAR_SAFE (value))))),
+ args);
+ event.arg
+ = Fcons (mtype == DBUS_MESSAGE_TYPE_ERROR
+ ? error_name == NULL ? Qnil : build_string (error_name)
+ : member == NULL ? Qnil : build_string (member),
+ event.arg);
+ event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)),
+ event.arg);
+ event.arg = Fcons ((path == NULL ? Qnil : build_string (path)),
+ event.arg);
+ event.arg = Fcons ((destination == NULL ? Qnil : build_string (destination)),
+ event.arg);
+ event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
+ event.arg);
+ event.arg = Fcons (INT_TO_INTEGER (serial), event.arg);
+ event.arg = Fcons (make_fixnum (mtype), event.arg);
+
+ /* Add the bus symbol to the event. */
+ event.arg = Fcons (bus, event.arg);
+
+ /* Store it into the input event queue. */
+ kbd_buffer_store_event (&event);
+
+ XD_DEBUG_MESSAGE ("Monitor event stored: %s", XD_OBJECT_TO_STRING (event.arg));
+
/* Cleanup. */
cleanup:
dbus_message_unref (dmessage);
}
/* Read queued incoming messages of the D-Bus BUS.
- BUS is either a Lisp symbol, :system or :session, or a string denoting
- the bus address. */
+ BUS is either a Lisp symbol, :system, :session, :system-private or
+ :session-private, or a string denoting the bus address. */
static Lisp_Object
xd_read_message (Lisp_Object bus)
{
@@ -1659,7 +1800,7 @@ xd_read_queued_messages (int fd, void *data)
while (!NILP (busp))
{
key = CAR_SAFE (CAR_SAFE (busp));
- if ((SYMBOLP (key) && XSYMBOL (key) == data)
+ if ((XD_KEYWORDP (key) && XSYMBOL (key) == data)
|| (STRINGP (key) && XSTRING (key) == data))
bus = key;
busp = CDR_SAFE (busp);
@@ -1707,6 +1848,8 @@ syms_of_dbusbind (void)
/* Lisp symbols of the system and session buses. */
DEFSYM (QCsystem, ":system");
DEFSYM (QCsession, ":session");
+ DEFSYM (QCsystem_private, ":system-private");
+ DEFSYM (QCsession_private, ":session-private");
/* Lisp symbol for method call timeout. */
DEFSYM (QCtimeout, ":timeout");
@@ -1732,10 +1875,12 @@ syms_of_dbusbind (void)
DEFSYM (QCstruct, ":struct");
DEFSYM (QCdict_entry, ":dict-entry");
- /* Lisp symbols of objects in `dbus-registered-objects-table'. */
+ /* Lisp symbols of objects in `dbus-registered-objects-table'.
+ `:property', which does exist there as well, is not declared here. */
DEFSYM (QCserial, ":serial");
DEFSYM (QCmethod, ":method");
DEFSYM (QCsignal, ":signal");
+ DEFSYM (QCmonitor, ":monitor");
DEFVAR_LISP ("dbus-compiled-version",
Vdbus_compiled_version,
@@ -1797,21 +1942,23 @@ and for calling handlers in case of non-blocking method call returns.
In the first case, the key in the hash table is the list (TYPE BUS
INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method',
-`:signal' or `:property'. BUS is either a Lisp symbol, `:system' or
-`:session', or a string denoting the bus address. INTERFACE is a
-string which denotes a D-Bus interface, and MEMBER, also a string, is
-either a method, a signal or a property INTERFACE is offering. All
-arguments but BUS must not be nil.
+`:signal', `:property' or `:monitor'. BUS is either a Lisp symbol,
+`:system', `:session', `:system-private' or `:session-private', or a
+string denoting the bus address. INTERFACE is a string which denotes
+a D-Bus interface, and MEMBER, also a string, is either a method, a
+signal or a property INTERFACE is offering. All arguments can be nil.
The value in the hash table is a list of quadruple lists ((UNAME
SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
registered, UNAME is the corresponding unique name. In case of
registered methods and properties, UNAME is nil. PATH is the object
path of the sending object. All of them can be nil, which means a
-wildcard then. OBJECT is either the handler to be called when a D-Bus
-message, which matches the key criteria, arrives (TYPE `:method' and
-`:signal'), or a cons cell containing the value of the property (TYPE
-`:property').
+wildcard then.
+
+OBJECT is either the handler to be called when a D-Bus message, which
+matches the key criteria, arrives (TYPE `:method', `:signal' and
+`:monitor'), or a list (ACCESS EMITS-SIGNAL VALUE) for TYPE
+`:property'.
For entries of type `:signal', there is also a fifth element RULE,
which keeps the match string the signal is registered with.
diff --git a/src/deps.mk b/src/deps.mk
index a7e1b559173..4d162eeb0f2 100644
--- a/src/deps.mk
+++ b/src/deps.mk
@@ -239,9 +239,6 @@ xfont.o: dispextern.h xterm.h frame.h blockinput.h character.h charset.h \
xftfont.o: xftfont.c dispextern.h xterm.h frame.h blockinput.h character.h \
charset.h font.h lisp.h globals.h $(config_h) atimer.h systime.h \
fontset.h ccl.h ftfont.h composite.h
-ftxfont.o: ftxfont.c dispextern.h xterm.h frame.h blockinput.h character.h \
- charset.h font.h lisp.h globals.h $(config_h) atimer.h systime.h \
- fontset.h ccl.h
menu.o: menu.c lisp.h keyboard.h keymap.h frame.h termhooks.h blockinput.h \
dispextern.h $(srcdir)/../lwlib/lwlib.h xterm.h gtkutil.h menu.h \
lisp.h globals.h $(config_h) systime.h coding.h composite.h window.h \
diff --git a/src/dired.c b/src/dired.c
index 611477aa4ef..f013a4cea03 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -937,7 +937,7 @@ file_attributes (int fd, char const *name,
int err = EINVAL;
#if defined O_PATH && !defined HAVE_CYGWIN_O_PATH_BUG
- int namefd = openat (fd, name, O_PATH | O_CLOEXEC | O_NOFOLLOW);
+ int namefd = emacs_openat (fd, name, O_PATH | O_CLOEXEC | O_NOFOLLOW, 0);
if (namefd < 0)
err = errno;
else
@@ -970,7 +970,7 @@ file_attributes (int fd, char const *name,
information to be accurate. */
w32_stat_get_owner_group = 1;
#endif
- err = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0 ? 0 : errno;
+ err = emacs_fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0 ? 0 : errno;
#ifdef WINDOWSNT
w32_stat_get_owner_group = 0;
#endif
diff --git a/src/dispextern.h b/src/dispextern.h
index 6b72e68d315..0d982f79177 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -102,7 +102,7 @@ typedef XImage *Emacs_Pix_Context;
#endif
#ifdef USE_CAIRO
-/* Mininal version of XImage. */
+/* Minimal version of XImage. */
typedef struct
{
int width, height; /* size of image */
@@ -234,7 +234,7 @@ struct text_pos
{ \
++(POS).charpos; \
if (MULTIBYTE_P) \
- INC_POS ((POS).bytepos); \
+ (POS).bytepos += next_char_len ((POS).bytepos); \
else \
++(POS).bytepos; \
} \
@@ -247,7 +247,7 @@ struct text_pos
{ \
--(POS).charpos; \
if (MULTIBYTE_P) \
- DEC_POS ((POS).bytepos); \
+ (POS).bytepos -= prev_char_len ((POS).bytepos); \
else \
--(POS).bytepos; \
} \
@@ -369,7 +369,7 @@ enum glyph_type
/* Glyph describes a character. */
CHAR_GLYPH,
- /* Glyph describes a static composition. */
+ /* Glyph describes a static or automatic composition. */
COMPOSITE_GLYPH,
/* Glyph describes a glyphless character. */
@@ -1693,12 +1693,17 @@ struct face
int fontset;
/* Non-zero means characters in this face have a box of that
- thickness around them. If this value is negative, its absolute
- value indicates the thickness, and the horizontal (top and
- bottom) borders of box are drawn inside of the character glyphs'
- area. The vertical (left and right) borders of the box are drawn
- in the same way as when this value is positive. */
- int box_line_width;
+ thickness around them. Vertical (left and right) and horizontal
+ (top and bottom) borders size can be set separatedly using an
+ associated list of two ints in the form
+ (vertical_size . horizontal_size). In case one of the value is
+ negative, its absolute value indicates the thickness, and the
+ borders of box are drawn inside of the character glyphs' area
+ potentially over the glyph itself but the glyph drawing size is
+ not increase. If a (signed) int N is use instead of a list, it
+ is the same as setting ( abs(N) . N ) values. */
+ int box_vertical_line_width;
+ int box_horizontal_line_width;
/* Type of box drawn. A value of FACE_NO_BOX means no box is drawn
around text in this face. A value of FACE_SIMPLE_BOX means a box
@@ -1739,6 +1744,7 @@ struct face
bool_bf tty_italic_p : 1;
bool_bf tty_underline_p : 1;
bool_bf tty_reverse_p : 1;
+ bool_bf tty_strike_through_p : 1;
/* True means that colors of this face may not be freed because they
have been copied bitwise from a base face (see
@@ -1850,20 +1856,6 @@ struct face_cache
bool_bf menu_face_changed_p : 1;
};
-/* Return a non-null pointer to the cached face with ID on frame F. */
-
-#define FACE_FROM_ID(F, ID) \
- (eassert (UNSIGNED_CMP (ID, <, FRAME_FACE_CACHE (F)->used)), \
- FRAME_FACE_CACHE (F)->faces_by_id[ID])
-
-/* Return a pointer to the face with ID on frame F, or null if such a
- face doesn't exist. */
-
-#define FACE_FROM_ID_OR_NULL(F, ID) \
- (UNSIGNED_CMP (ID, <, FRAME_FACE_CACHE (F)->used) \
- ? FRAME_FACE_CACHE (F)->faces_by_id[ID] \
- : NULL)
-
#define FACE_EXTENSIBLE_P(F) \
(!NILP (F->lface[LFACE_EXTEND_INDEX]))
@@ -2782,7 +2774,8 @@ struct it
else \
produce_glyphs ((IT)); \
if ((IT)->glyph_row != NULL) \
- inhibit_free_realized_faces = true; \
+ inhibit_free_realized_faces =true; \
+ reset_box_start_end_flags ((IT)); \
} while (false)
/* Bit-flags indicating what operation move_it_to should perform. */
@@ -3064,9 +3057,9 @@ struct image
if necessary. */
unsigned long background;
- /* Foreground and background colors of the frame on which the image
+ /* Foreground and background colors of the face on which the image
is created. */
- unsigned long frame_foreground, frame_background;
+ unsigned long face_foreground, face_background;
/* True if this image has a `transparent' background -- that is, is
uses an image mask. The accessor macro for this is
@@ -3157,21 +3150,6 @@ struct image_cache
ptrdiff_t refcount;
};
-
-/* A non-null pointer to the image with id ID on frame F. */
-
-#define IMAGE_FROM_ID(F, ID) \
- (eassert (UNSIGNED_CMP (ID, <, FRAME_IMAGE_CACHE (F)->used)), \
- FRAME_IMAGE_CACHE (F)->images[ID])
-
-/* Value is a pointer to the image with id ID on frame F, or null if
- no image with that id exists. */
-
-#define IMAGE_OPT_FROM_ID(F, ID) \
- (UNSIGNED_CMP (ID, <, FRAME_IMAGE_CACHE (F)->used) \
- ? FRAME_IMAGE_CACHE (F)->images[ID] \
- : NULL)
-
/* Size of bucket vector of image caches. Should be prime. */
#define IMAGE_CACHE_BUCKETS_SIZE 1001
@@ -3313,6 +3291,7 @@ enum tool_bar_item_image
#define TTY_CAP_BOLD 0x04
#define TTY_CAP_DIM 0x08
#define TTY_CAP_ITALIC 0x10
+#define TTY_CAP_STRIKE_THROUGH 0x20
/***********************************************************************
@@ -3498,7 +3477,7 @@ void clear_image_caches (Lisp_Object);
void mark_image_cache (struct image_cache *);
bool valid_image_p (Lisp_Object);
void prepare_image_for_display (struct frame *, struct image *);
-ptrdiff_t lookup_image (struct frame *, Lisp_Object);
+ptrdiff_t lookup_image (struct frame *, Lisp_Object, int);
#if defined HAVE_X_WINDOWS || defined USE_CAIRO || defined HAVE_NS
#define RGB_PIXEL_COLOR unsigned long
@@ -3537,6 +3516,8 @@ void update_face_from_frame_parameter (struct frame *, Lisp_Object,
Lisp_Object);
extern bool tty_defined_color (struct frame *, const char *, Emacs_Color *,
bool, bool);
+bool parse_color_spec (const char *,
+ unsigned short *, unsigned short *, unsigned short *);
Lisp_Object tty_color_name (struct frame *, int);
void clear_face_cache (bool);
diff --git a/src/dispnew.c b/src/dispnew.c
index 5b6fa51a563..d318e26308e 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -25,7 +25,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <unistd.h>
#include "lisp.h"
-#include "ptr-bounds.h"
#include "termchar.h"
/* cm.h must come after dispextern.h on Windows. */
#include "dispextern.h"
@@ -881,7 +880,7 @@ clear_glyph_row (struct glyph_row *row)
enum { off = offsetof (struct glyph_row, used) };
/* Zero everything except pointers in `glyphs'. */
- memset (row->used, 0, sizeof *row - off);
+ memset ((char *) row + off, 0, sizeof *row - off);
}
@@ -4891,12 +4890,6 @@ scrolling (struct frame *frame)
unsigned *new_hash = old_hash + height;
int *draw_cost = (int *) (new_hash + height);
int *old_draw_cost = draw_cost + height;
- old_hash = ptr_bounds_clip (old_hash, height * sizeof *old_hash);
- new_hash = ptr_bounds_clip (new_hash, height * sizeof *new_hash);
- draw_cost = ptr_bounds_clip (draw_cost, height * sizeof *draw_cost);
- old_draw_cost = ptr_bounds_clip (old_draw_cost,
- height * sizeof *old_draw_cost);
-
eassert (current_matrix);
/* Compute hash codes of all the lines. Also calculate number of
diff --git a/src/editfns.c b/src/editfns.c
index f660513b2a4..7e1e24ef16a 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -46,7 +46,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "composite.h"
#include "intervals.h"
-#include "ptr-bounds.h"
#include "systime.h"
#include "character.h"
#include "buffer.h"
@@ -162,20 +161,14 @@ DEFUN ("byte-to-string", Fbyte_to_string, Sbyte_to_string, 1, 1, 0,
DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0,
doc: /* Return the first character in STRING. */)
- (register Lisp_Object string)
+ (Lisp_Object string)
{
- register Lisp_Object val;
CHECK_STRING (string);
- if (SCHARS (string))
- {
- if (STRING_MULTIBYTE (string))
- XSETFASTINT (val, STRING_CHAR (SDATA (string)));
- else
- XSETFASTINT (val, SREF (string, 0));
- }
- else
- XSETFASTINT (val, 0);
- return val;
+
+ /* This returns zero if STRING is empty. */
+ return make_fixnum (STRING_MULTIBYTE (string)
+ ? STRING_CHAR (SDATA (string))
+ : SREF (string, 0));
}
DEFUN ("point", Fpoint, Spoint, 0, 0, 0,
@@ -714,7 +707,8 @@ If the scan reaches the end of the buffer, return that position.
This function ignores text display directionality; it returns the
position of the first character in logical order, i.e. the smallest
-character position on the line.
+character position on the logical line. See `vertical-motion' for
+movement by screen lines.
This function constrains the returned position to the current field
unless that position would be on a different line from the original,
@@ -725,18 +719,23 @@ boundaries, bind `inhibit-field-text-motion' to t.
This function does not move point. */)
(Lisp_Object n)
{
- ptrdiff_t charpos, bytepos;
+ ptrdiff_t charpos, bytepos, count;
if (NILP (n))
- XSETFASTINT (n, 1);
+ count = 0;
+ else if (FIXNUMP (n))
+ count = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n) - 1, BUF_BYTES_MAX);
else
- CHECK_FIXNUM (n);
+ {
+ CHECK_INTEGER (n);
+ count = NILP (Fnatnump (n)) ? -BUF_BYTES_MAX : BUF_BYTES_MAX;
+ }
- scan_newline_from_point (XFIXNUM (n) - 1, &charpos, &bytepos);
+ scan_newline_from_point (count, &charpos, &bytepos);
/* Return END constrained to the current input field. */
return Fconstrain_to_field (make_fixnum (charpos), make_fixnum (PT),
- XFIXNUM (n) != 1 ? Qt : Qnil,
+ count != 0 ? Qt : Qnil,
Qt, Qnil);
}
@@ -763,11 +762,14 @@ This function does not move point. */)
ptrdiff_t orig = PT;
if (NILP (n))
- XSETFASTINT (n, 1);
+ clipped_n = 1;
+ else if (FIXNUMP (n))
+ clipped_n = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n), BUF_BYTES_MAX);
else
- CHECK_FIXNUM (n);
-
- clipped_n = clip_to_bounds (PTRDIFF_MIN + 1, XFIXNUM (n), PTRDIFF_MAX);
+ {
+ CHECK_INTEGER (n);
+ clipped_n = NILP (Fnatnump (n)) ? -BUF_BYTES_MAX : BUF_BYTES_MAX;
+ }
end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0),
NULL);
@@ -940,10 +942,10 @@ DEFUN ("position-bytes", Fposition_bytes, Sposition_bytes, 1, 1, 0,
If POSITION is out of range, the value is nil. */)
(Lisp_Object position)
{
- CHECK_FIXNUM_COERCE_MARKER (position);
- if (XFIXNUM (position) < BEG || XFIXNUM (position) > Z)
+ EMACS_INT pos = fix_position (position);
+ if (! (BEG <= pos && pos <= Z))
return Qnil;
- return make_fixnum (CHAR_TO_BYTE (XFIXNUM (position)));
+ return make_fixnum (CHAR_TO_BYTE (pos));
}
DEFUN ("byte-to-position", Fbyte_to_position, Sbyte_to_position, 1, 1, 0,
@@ -991,7 +993,7 @@ At the beginning of the buffer or accessible region, return 0. */)
else if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
ptrdiff_t pos = PT_BYTE;
- DEC_POS (pos);
+ pos -= prev_char_len (pos);
XSETFASTINT (temp, FETCH_CHAR (pos));
}
else
@@ -1060,11 +1062,11 @@ If POS is out of range, the value is nil. */)
}
else
{
- CHECK_FIXNUM_COERCE_MARKER (pos);
- if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) >= ZV)
+ EMACS_INT p = fix_position (pos);
+ if (! (BEGV <= p && p < ZV))
return Qnil;
- pos_byte = CHAR_TO_BYTE (XFIXNUM (pos));
+ pos_byte = CHAR_TO_BYTE (p);
}
return make_fixnum (FETCH_CHAR (pos_byte));
@@ -1094,17 +1096,17 @@ If POS is out of range, the value is nil. */)
}
else
{
- CHECK_FIXNUM_COERCE_MARKER (pos);
+ EMACS_INT p = fix_position (pos);
- if (XFIXNUM (pos) <= BEGV || XFIXNUM (pos) > ZV)
+ if (! (BEGV < p && p <= ZV))
return Qnil;
- pos_byte = CHAR_TO_BYTE (XFIXNUM (pos));
+ pos_byte = CHAR_TO_BYTE (p);
}
if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
- DEC_POS (pos_byte);
+ pos_byte -= prev_char_len (pos_byte);
XSETFASTINT (val, FETCH_CHAR (pos_byte));
}
else
@@ -1262,14 +1264,17 @@ name, or nil if there is no such user. */)
if (q)
{
Lisp_Object login = Fuser_login_name (INT_TO_INTEGER (pw->pw_uid));
- USE_SAFE_ALLOCA;
- char *r = SAFE_ALLOCA (strlen (p) + SBYTES (login) + 1);
- memcpy (r, p, q - p);
- char *s = lispstpcpy (&r[q - p], login);
- r[q - p] = upcase ((unsigned char) r[q - p]);
- strcpy (s, q + 1);
- full = build_string (r);
- SAFE_FREE ();
+ if (!NILP (login))
+ {
+ USE_SAFE_ALLOCA;
+ char *r = SAFE_ALLOCA (strlen (p) + SBYTES (login) + 1);
+ memcpy (r, p, q - p);
+ char *s = lispstpcpy (&r[q - p], login);
+ r[q - p] = upcase ((unsigned char) r[q - p]);
+ strcpy (s, q + 1);
+ full = build_string (r);
+ SAFE_FREE ();
+ }
}
#endif /* AMPERSAND_FULL_NAME */
@@ -1538,7 +1543,7 @@ from adjoining text, if those properties are sticky. */)
make_uninit_string, which can cause the buffer arena to be
compacted. make_string has no way of knowing that the data has
been moved, and thus copies the wrong data into the string. This
- doesn't effect most of the other users of make_string, so it should
+ doesn't affect most of the other users of make_string, so it should
be left as is. But we should use this function when conjuring
buffer substrings. */
@@ -1715,21 +1720,8 @@ using `string-make-multibyte' or `string-make-unibyte', which see. */)
if (!BUFFER_LIVE_P (bp))
error ("Selecting deleted buffer");
- if (NILP (start))
- b = BUF_BEGV (bp);
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (start);
- b = XFIXNUM (start);
- }
- if (NILP (end))
- e = BUF_ZV (bp);
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (end);
- e = XFIXNUM (end);
- }
-
+ b = !NILP (start) ? fix_position (start) : BUF_BEGV (bp);
+ e = !NILP (end) ? fix_position (end) : BUF_ZV (bp);
if (b > e)
temp = b, b = e, e = temp;
@@ -1783,21 +1775,8 @@ determines whether case is significant or ignored. */)
error ("Selecting deleted buffer");
}
- if (NILP (start1))
- begp1 = BUF_BEGV (bp1);
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (start1);
- begp1 = XFIXNUM (start1);
- }
- if (NILP (end1))
- endp1 = BUF_ZV (bp1);
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (end1);
- endp1 = XFIXNUM (end1);
- }
-
+ begp1 = !NILP (start1) ? fix_position (start1) : BUF_BEGV (bp1);
+ endp1 = !NILP (end1) ? fix_position (end1) : BUF_ZV (bp1);
if (begp1 > endp1)
temp = begp1, begp1 = endp1, endp1 = temp;
@@ -1821,21 +1800,8 @@ determines whether case is significant or ignored. */)
error ("Selecting deleted buffer");
}
- if (NILP (start2))
- begp2 = BUF_BEGV (bp2);
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (start2);
- begp2 = XFIXNUM (start2);
- }
- if (NILP (end2))
- endp2 = BUF_ZV (bp2);
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (end2);
- endp2 = XFIXNUM (end2);
- }
-
+ begp2 = !NILP (start2) ? fix_position (start2) : BUF_BEGV (bp2);
+ endp2 = !NILP (end2) ? fix_position (end2) : BUF_ZV (bp2);
if (begp2 > endp2)
temp = begp2, begp2 = endp2, endp2 = temp;
@@ -1858,26 +1824,24 @@ determines whether case is significant or ignored. */)
if (! NILP (BVAR (bp1, enable_multibyte_characters)))
{
c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte);
- BUF_INC_POS (bp1, i1_byte);
+ i1_byte += buf_next_char_len (bp1, i1_byte);
i1++;
}
else
{
- c1 = BUF_FETCH_BYTE (bp1, i1);
- MAKE_CHAR_MULTIBYTE (c1);
+ c1 = make_char_multibyte (BUF_FETCH_BYTE (bp1, i1));
i1++;
}
if (! NILP (BVAR (bp2, enable_multibyte_characters)))
{
c2 = BUF_FETCH_MULTIBYTE_CHAR (bp2, i2_byte);
- BUF_INC_POS (bp2, i2_byte);
+ i2_byte += buf_next_char_len (bp2, i2_byte);
i2++;
}
else
{
- c2 = BUF_FETCH_BYTE (bp2, i2);
- MAKE_CHAR_MULTIBYTE (c2);
+ c2 = make_char_multibyte (BUF_FETCH_BYTE (bp2, i2));
i2++;
}
@@ -1936,8 +1900,8 @@ determines whether case is significant or ignored. */)
sys_jmp_buf jmp; \
unsigned short quitcounter;
-#define NOTE_DELETE(ctx, xoff) set_bit ((ctx)->deletions, (xoff))
-#define NOTE_INSERT(ctx, yoff) set_bit ((ctx)->insertions, (yoff))
+#define NOTE_DELETE(ctx, xoff) set_bit ((ctx)->deletions, xoff)
+#define NOTE_INSERT(ctx, yoff) set_bit ((ctx)->insertions, yoff)
#define EARLY_ABORT(ctx) compareseq_early_abort (ctx)
struct context;
@@ -1990,6 +1954,28 @@ nil. */)
if (a == b)
error ("Cannot replace a buffer with itself");
+ ptrdiff_t too_expensive;
+ if (NILP (max_costs))
+ too_expensive = 1000000;
+ else if (FIXNUMP (max_costs))
+ too_expensive = clip_to_bounds (0, XFIXNUM (max_costs), PTRDIFF_MAX);
+ else
+ {
+ CHECK_INTEGER (max_costs);
+ too_expensive = NILP (Fnatnump (max_costs)) ? 0 : PTRDIFF_MAX;
+ }
+
+ struct timespec time_limit = make_timespec (0, -1);
+ if (!NILP (max_secs))
+ {
+ struct timespec
+ tlim = timespec_add (current_timespec (),
+ lisp_time_argument (max_secs)),
+ tmax = make_timespec (TYPE_MAXIMUM (time_t), TIMESPEC_HZ - 1);
+ if (timespec_cmp (tlim, tmax) < 0)
+ time_limit = tlim;
+ }
+
ptrdiff_t min_a = BEGV;
ptrdiff_t min_b = BUF_BEGV (b);
ptrdiff_t size_a = ZV - min_a;
@@ -2019,36 +2005,24 @@ nil. */)
ptrdiff_t count = SPECPDL_INDEX ();
- /* FIXME: It is not documented how to initialize the contents of the
- context structure. This code cargo-cults from the existing
- caller in src/analyze.c of GNU Diffutils, which appears to
- work. */
ptrdiff_t diags = size_a + size_b + 3;
+ ptrdiff_t del_bytes = size_a / CHAR_BIT + 1;
+ ptrdiff_t ins_bytes = size_b / CHAR_BIT + 1;
ptrdiff_t *buffer;
+ ptrdiff_t bytes_needed;
+ if (INT_MULTIPLY_WRAPV (diags, 2 * sizeof *buffer, &bytes_needed)
+ || INT_ADD_WRAPV (del_bytes + ins_bytes, bytes_needed, &bytes_needed))
+ memory_full (SIZE_MAX);
USE_SAFE_ALLOCA;
- SAFE_NALLOCA (buffer, 2, diags);
-
- if (NILP (max_costs))
- XSETFASTINT (max_costs, 1000000);
- else
- CHECK_FIXNUM (max_costs);
-
- struct timespec time_limit = make_timespec (0, -1);
- if (!NILP (max_secs))
- {
- struct timespec
- tlim = timespec_add (current_timespec (),
- lisp_time_argument (max_secs)),
- tmax = make_timespec (TYPE_MAXIMUM (time_t), TIMESPEC_HZ - 1);
- if (timespec_cmp (tlim, tmax) < 0)
- time_limit = tlim;
- }
+ buffer = SAFE_ALLOCA (bytes_needed);
+ unsigned char *deletions_insertions = memset (buffer + 2 * diags, 0,
+ del_bytes + ins_bytes);
- /* Micro-optimization: Casting to size_t generates much better
- code. */
- ptrdiff_t del_bytes = (size_t) size_a / CHAR_BIT + 1;
- ptrdiff_t ins_bytes = (size_t) size_b / CHAR_BIT + 1;
+ /* FIXME: It is not documented how to initialize the contents of the
+ context structure. This code cargo-cults from the existing
+ caller in src/analyze.c of GNU Diffutils, which appears to
+ work. */
struct context ctx = {
.buffer_a = a,
.buffer_b = b,
@@ -2056,16 +2030,14 @@ nil. */)
.beg_b = min_b,
.a_unibyte = BUF_ZV (a) == BUF_ZV_BYTE (a),
.b_unibyte = BUF_ZV (b) == BUF_ZV_BYTE (b),
- .deletions = SAFE_ALLOCA (del_bytes),
- .insertions = SAFE_ALLOCA (ins_bytes),
+ .deletions = deletions_insertions,
+ .insertions = deletions_insertions + del_bytes,
.fdiag = buffer + size_b + 1,
.bdiag = buffer + diags + size_b + 1,
.heuristic = true,
- .too_expensive = XFIXNUM (max_costs),
+ .too_expensive = too_expensive,
.time_limit = time_limit,
};
- memclear (ctx.deletions, del_bytes);
- memclear (ctx.insertions, ins_bytes);
/* compareseq requires indices to be zero-based. We add BEGV back
later. */
@@ -2110,8 +2082,8 @@ nil. */)
/* Check whether there is a change (insertion or deletion)
before the current position. */
- if ((i > 0 && bit_is_set (ctx.deletions, i - 1)) ||
- (j > 0 && bit_is_set (ctx.insertions, j - 1)))
+ if ((i > 0 && bit_is_set (ctx.deletions, i - 1))
+ || (j > 0 && bit_is_set (ctx.insertions, j - 1)))
{
ptrdiff_t end_a = min_a + i;
ptrdiff_t end_b = min_b + j;
@@ -2153,21 +2125,15 @@ nil. */)
static void
set_bit (unsigned char *a, ptrdiff_t i)
{
- eassert (i >= 0);
- /* Micro-optimization: Casting to size_t generates much better
- code. */
- size_t j = i;
- a[j / CHAR_BIT] |= (1 << (j % CHAR_BIT));
+ eassume (0 <= i);
+ a[i / CHAR_BIT] |= (1 << (i % CHAR_BIT));
}
static bool
bit_is_set (const unsigned char *a, ptrdiff_t i)
{
- eassert (i >= 0);
- /* Micro-optimization: Casting to size_t generates much better
- code. */
- size_t j = i;
- return a[j / CHAR_BIT] & (1 << (j % CHAR_BIT));
+ eassume (0 <= i);
+ return a[i / CHAR_BIT] & (1 << (i % CHAR_BIT));
}
/* Return true if the characters at position POS_A of buffer
@@ -2331,7 +2297,7 @@ Both characters must have the same length of multi-byte form. */)
}
p = BYTE_POS_ADDR (pos_byte);
if (multibyte_p)
- INC_POS (pos_byte_next);
+ pos_byte_next += next_char_len (pos_byte_next);
else
++pos_byte_next;
if (pos_byte_next - pos_byte == len
@@ -2392,7 +2358,7 @@ Both characters must have the same length of multi-byte form. */)
decrease it now. */
pos--;
else
- INC_POS (pos_byte_next);
+ pos_byte_next += next_char_len (pos_byte_next);
if (! NILP (noundo))
bset_undo_list (current_buffer, tem);
@@ -2469,7 +2435,7 @@ check_translation (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t end,
memcpy (bufalloc, buf, sizeof initial_buf);
buf = bufalloc;
}
- buf[buf_used++] = STRING_CHAR_AND_LENGTH (p, len1);
+ buf[buf_used++] = string_char_and_length (p, &len1);
pos_byte += len1;
}
if (XFIXNUM (AREF (elt, i)) != buf[i])
@@ -2528,13 +2494,13 @@ It returns the number of characters changed. */)
int len, oc;
if (multibyte)
- oc = STRING_CHAR_AND_LENGTH (p, len);
+ oc = string_char_and_length (p, &len);
else
oc = *p, len = 1;
if (oc < translatable_chars)
{
int nc; /* New character. */
- int str_len;
+ int str_len UNINIT;
Lisp_Object val;
if (STRINGP (table))
@@ -2545,7 +2511,7 @@ It returns the number of characters changed. */)
if (string_multibyte)
{
str = tt + string_char_to_byte (table, oc);
- nc = STRING_CHAR_AND_LENGTH (str, str_len);
+ nc = string_char_and_length (str, &str_len);
}
else
{
@@ -2688,29 +2654,27 @@ See also `save-restriction'.
When calling from Lisp, pass two arguments START and END:
positions (integers or markers) bounding the text that should
remain visible. */)
- (register Lisp_Object start, Lisp_Object end)
+ (Lisp_Object start, Lisp_Object end)
{
- CHECK_FIXNUM_COERCE_MARKER (start);
- CHECK_FIXNUM_COERCE_MARKER (end);
+ EMACS_INT s = fix_position (start), e = fix_position (end);
- if (XFIXNUM (start) > XFIXNUM (end))
+ if (e < s)
{
- Lisp_Object tem;
- tem = start; start = end; end = tem;
+ EMACS_INT tem = s; s = e; e = tem;
}
- if (!(BEG <= XFIXNUM (start) && XFIXNUM (start) <= XFIXNUM (end) && XFIXNUM (end) <= Z))
+ if (!(BEG <= s && s <= e && e <= Z))
args_out_of_range (start, end);
- if (BEGV != XFIXNAT (start) || ZV != XFIXNAT (end))
+ if (BEGV != s || ZV != e)
current_buffer->clip_changed = 1;
- SET_BUF_BEGV (current_buffer, XFIXNAT (start));
- SET_BUF_ZV (current_buffer, XFIXNAT (end));
- if (PT < XFIXNAT (start))
- SET_PT (XFIXNAT (start));
- if (PT > XFIXNAT (end))
- SET_PT (XFIXNAT (end));
+ SET_BUF_BEGV (current_buffer, s);
+ SET_BUF_ZV (current_buffer, e);
+ if (PT < s)
+ SET_PT (s);
+ if (e < PT)
+ SET_PT (e);
/* Changing the buffer bounds invalidates any recorded current column. */
invalidate_current_column ();
return Qnil;
@@ -3168,8 +3132,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
string was not copied into the output.
It is 2 if byte I was not the first byte of its character. */
char *discarded = (char *) &info[nspec_bound];
- info = ptr_bounds_clip (info, info_size);
- discarded = ptr_bounds_clip (discarded, formatlen);
memset (discarded, 0, formatlen);
/* Try to determine whether the result should be multibyte.
diff --git a/src/emacs-module.c b/src/emacs-module.c
index a90a9765dbf..3581daad112 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -89,6 +89,7 @@ To add a new module function, proceed as follows:
#include "dynlib.h"
#include "coding.h"
#include "keyboard.h"
+#include "process.h"
#include "syssignal.h"
#include "sysstdio.h"
#include "thread.h"
@@ -123,12 +124,6 @@ To add a new module function, proceed as follows:
/* Function prototype for the module init function. */
typedef int (*emacs_init_function) (struct emacs_runtime *);
-/* Function prototype for module user-pointer finalizers. These
- should not throw C++ exceptions, so emacs-module.h declares the
- corresponding interfaces with EMACS_NOEXCEPT. There is only C code
- in this module, though, so this constraint is not enforced here. */
-typedef void (*emacs_finalizer_function) (void *);
-
/* Memory management. */
@@ -195,7 +190,7 @@ struct emacs_runtime_private
/* Forward declarations. */
static Lisp_Object value_to_lisp (emacs_value);
-static emacs_value allocate_emacs_value (emacs_env *, struct emacs_value_storage *, Lisp_Object);
+static emacs_value allocate_emacs_value (emacs_env *, Lisp_Object);
static emacs_value lisp_to_value (emacs_env *, Lisp_Object);
static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
static void module_assert_thread (void);
@@ -220,6 +215,25 @@ static bool value_storage_contains_p (const struct emacs_value_storage *,
static bool module_assertions = false;
+
+/* Small helper functions. */
+
+/* Interprets the string at STR with length LEN as UTF-8 string.
+ Signals an error if it's not a valid UTF-8 string. */
+
+static Lisp_Object
+module_decode_utf_8 (const char *str, ptrdiff_t len)
+{
+ /* We set HANDLE-8-BIT and HANDLE-OVER-UNI to nil to signal an error
+ if the argument is not a valid UTF-8 string. While it isn't
+ documented how make_string and make_function behave in this case,
+ signaling an error is the most defensive and obvious reaction. */
+ Lisp_Object s = decode_string_utf_8 (Qnil, str, len, Qnil, false, Qnil, Qnil);
+ CHECK_TYPE (!NILP (s), Qutf_8_string_p, make_string_from_utf8 (str, len));
+ return s;
+}
+
+
/* Convenience macros for non-local exit handling. */
/* FIXME: The following implementation for non-local exit handling
@@ -235,7 +249,7 @@ static bool module_assertions = false;
of `internal_condition_case' etc., and to avoid worrying about
passing information to the handler functions. */
-#if !__has_attribute (cleanup)
+#if !HAS_ATTRIBUTE (cleanup)
#error "__attribute__ ((cleanup)) not supported by this compiler; try GCC"
#endif
@@ -334,6 +348,12 @@ static bool module_assertions = false;
MODULE_HANDLE_NONLOCAL_EXIT (error_retval)
static void
+CHECK_MODULE_FUNCTION (Lisp_Object obj)
+{
+ CHECK_TYPE (MODULE_FUNCTIONP (obj), Qmodule_function_p, obj);
+}
+
+static void
CHECK_USER_PTR (Lisp_Object obj)
{
CHECK_TYPE (USER_PTRP (obj), Quser_ptrp, obj);
@@ -344,11 +364,11 @@ CHECK_USER_PTR (Lisp_Object obj)
the Emacs main thread. */
static emacs_env *
-module_get_environment (struct emacs_runtime *ert)
+module_get_environment (struct emacs_runtime *runtime)
{
module_assert_thread ();
- module_assert_runtime (ert);
- return ert->private_members->env;
+ module_assert_runtime (runtime);
+ return runtime->private_members->env;
}
/* To make global refs (GC-protected global values) keep a hash that
@@ -404,11 +424,11 @@ module_global_reference_p (emacs_value v, ptrdiff_t *n)
}
static emacs_value
-module_make_global_ref (emacs_env *env, emacs_value ref)
+module_make_global_ref (emacs_env *env, emacs_value value)
{
MODULE_FUNCTION_BEGIN (NULL);
struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
- Lisp_Object new_obj = value_to_lisp (ref), hashcode;
+ Lisp_Object new_obj = value_to_lisp (value), hashcode;
ptrdiff_t i = hash_lookup (h, new_obj, &hashcode);
/* Note: This approach requires the garbage collector to never move
@@ -438,20 +458,20 @@ module_make_global_ref (emacs_env *env, emacs_value ref)
}
static void
-module_free_global_ref (emacs_env *env, emacs_value ref)
+module_free_global_ref (emacs_env *env, emacs_value global_value)
{
/* TODO: This probably never signals. */
/* FIXME: Wait a minute. Shouldn't this function report an error if
the hash lookup fails? */
MODULE_FUNCTION_BEGIN ();
struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
- Lisp_Object obj = value_to_lisp (ref);
+ Lisp_Object obj = value_to_lisp (global_value);
ptrdiff_t i = hash_lookup (h, obj, NULL);
if (module_assertions)
{
ptrdiff_t n = 0;
- if (! module_global_reference_p (ref, &n))
+ if (! module_global_reference_p (global_value, &n))
module_abort ("Global value was not found in list of %"pD"d globals",
n);
}
@@ -483,14 +503,15 @@ module_non_local_exit_clear (emacs_env *env)
}
static enum emacs_funcall_exit
-module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data)
+module_non_local_exit_get (emacs_env *env,
+ emacs_value *symbol, emacs_value *data)
{
module_assert_thread ();
module_assert_env (env);
struct emacs_env_private *p = env->private_members;
if (p->pending_non_local_exit != emacs_funcall_exit_return)
{
- *sym = &p->non_local_exit_symbol;
+ *symbol = &p->non_local_exit_symbol;
*data = &p->non_local_exit_data;
}
return p->pending_non_local_exit;
@@ -498,12 +519,13 @@ module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data)
/* Like for `signal', DATA must be a list. */
static void
-module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data)
+module_non_local_exit_signal (emacs_env *env,
+ emacs_value symbol, emacs_value data)
{
module_assert_thread ();
module_assert_env (env);
if (module_non_local_exit_check (env) == emacs_funcall_exit_return)
- module_non_local_exit_signal_1 (env, value_to_lisp (sym),
+ module_non_local_exit_signal_1 (env, value_to_lisp (symbol),
value_to_lisp (data));
}
@@ -517,10 +539,6 @@ module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value)
value_to_lisp (value));
}
-/* Function prototype for the module Lisp functions. */
-typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t,
- emacs_value [], void *);
-
/* Module function. */
/* A function environment is an auxiliary structure returned by
@@ -533,19 +551,20 @@ struct Lisp_Module_Function
union vectorlike_header header;
/* Fields traced by GC; these must come first. */
- Lisp_Object documentation;
+ Lisp_Object documentation, interactive_form;
/* Fields ignored by GC. */
ptrdiff_t min_arity, max_arity;
- emacs_subr subr;
+ emacs_function subr;
void *data;
+ emacs_finalizer finalizer;
} GCALIGNED_STRUCT;
static struct Lisp_Module_Function *
allocate_module_function (void)
{
return ALLOCATE_PSEUDOVECTOR (struct Lisp_Module_Function,
- documentation, PVEC_MODULE_FUNCTION);
+ interactive_form, PVEC_MODULE_FUNCTION);
}
#define XSET_MODULE_FUNCTION(var, ptr) \
@@ -556,8 +575,7 @@ allocate_module_function (void)
static emacs_value
module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
- emacs_subr subr, const char *documentation,
- void *data)
+ emacs_function func, const char *docstring, void *data)
{
MODULE_FUNCTION_BEGIN (NULL);
@@ -571,11 +589,13 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
struct Lisp_Module_Function *function = allocate_module_function ();
function->min_arity = min_arity;
function->max_arity = max_arity;
- function->subr = subr;
+ function->subr = func;
function->data = data;
+ function->finalizer = NULL;
- if (documentation)
- function->documentation = build_string_from_utf8 (documentation);
+ if (docstring)
+ function->documentation
+ = module_decode_utf_8 (docstring, strlen (docstring));
Lisp_Object result;
XSET_MODULE_FUNCTION (result, function);
@@ -584,9 +604,53 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
return lisp_to_value (env, result);
}
+static emacs_finalizer
+module_get_function_finalizer (emacs_env *env, emacs_value arg)
+{
+ MODULE_FUNCTION_BEGIN (NULL);
+ Lisp_Object lisp = value_to_lisp (arg);
+ CHECK_MODULE_FUNCTION (lisp);
+ return XMODULE_FUNCTION (lisp)->finalizer;
+}
+
+static void
+module_set_function_finalizer (emacs_env *env, emacs_value arg,
+ emacs_finalizer fin)
+{
+ MODULE_FUNCTION_BEGIN ();
+ Lisp_Object lisp = value_to_lisp (arg);
+ CHECK_MODULE_FUNCTION (lisp);
+ XMODULE_FUNCTION (lisp)->finalizer = fin;
+}
+
+void
+module_finalize_function (const struct Lisp_Module_Function *func)
+{
+ if (func->finalizer != NULL)
+ func->finalizer (func->data);
+}
+
+static void
+module_make_interactive (emacs_env *env, emacs_value function, emacs_value spec)
+{
+ MODULE_FUNCTION_BEGIN ();
+ Lisp_Object lisp_fun = value_to_lisp (function);
+ CHECK_MODULE_FUNCTION (lisp_fun);
+ Lisp_Object lisp_spec = value_to_lisp (spec);
+ /* Normalize (interactive nil) to (interactive). */
+ XMODULE_FUNCTION (lisp_fun)->interactive_form
+ = NILP (lisp_spec) ? list1 (Qinteractive) : list2 (Qinteractive, lisp_spec);
+}
+
+Lisp_Object
+module_function_interactive_form (const struct Lisp_Module_Function *fun)
+{
+ return fun->interactive_form;
+}
+
static emacs_value
-module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
- emacs_value args[])
+module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs,
+ emacs_value *args)
{
MODULE_FUNCTION_BEGIN (NULL);
@@ -598,7 +662,7 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
if (INT_ADD_WRAPV (nargs, 1, &nargs1))
overflow_error ();
SAFE_ALLOCA_LISP (newargs, nargs1);
- newargs[0] = value_to_lisp (fun);
+ newargs[0] = value_to_lisp (func);
for (ptrdiff_t i = 0; i < nargs; i++)
newargs[1 + i] = value_to_lisp (args[i]);
emacs_value result = lisp_to_value (env, Ffuncall (nargs1, newargs));
@@ -614,17 +678,17 @@ module_intern (emacs_env *env, const char *name)
}
static emacs_value
-module_type_of (emacs_env *env, emacs_value value)
+module_type_of (emacs_env *env, emacs_value arg)
{
MODULE_FUNCTION_BEGIN (NULL);
- return lisp_to_value (env, Ftype_of (value_to_lisp (value)));
+ return lisp_to_value (env, Ftype_of (value_to_lisp (arg)));
}
static bool
-module_is_not_nil (emacs_env *env, emacs_value value)
+module_is_not_nil (emacs_env *env, emacs_value arg)
{
MODULE_FUNCTION_BEGIN_NO_CATCH (false);
- return ! NILP (value_to_lisp (value));
+ return ! NILP (value_to_lisp (arg));
}
static bool
@@ -635,14 +699,14 @@ module_eq (emacs_env *env, emacs_value a, emacs_value b)
}
static intmax_t
-module_extract_integer (emacs_env *env, emacs_value n)
+module_extract_integer (emacs_env *env, emacs_value arg)
{
MODULE_FUNCTION_BEGIN (0);
- Lisp_Object l = value_to_lisp (n);
- CHECK_INTEGER (l);
+ Lisp_Object lisp = value_to_lisp (arg);
+ CHECK_INTEGER (lisp);
intmax_t i;
- if (! integer_to_intmax (l, &i))
- xsignal1 (Qoverflow_error, l);
+ if (! integer_to_intmax (lisp, &i))
+ xsignal1 (Qoverflow_error, lisp);
return i;
}
@@ -654,10 +718,10 @@ module_make_integer (emacs_env *env, intmax_t n)
}
static double
-module_extract_float (emacs_env *env, emacs_value f)
+module_extract_float (emacs_env *env, emacs_value arg)
{
MODULE_FUNCTION_BEGIN (0);
- Lisp_Object lisp = value_to_lisp (f);
+ Lisp_Object lisp = value_to_lisp (arg);
CHECK_TYPE (FLOATP (lisp), Qfloatp, lisp);
return XFLOAT_DATA (lisp);
}
@@ -670,8 +734,8 @@ module_make_float (emacs_env *env, double d)
}
static bool
-module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer,
- ptrdiff_t *length)
+module_copy_string_contents (emacs_env *env, emacs_value value, char *buf,
+ ptrdiff_t *len)
{
MODULE_FUNCTION_BEGIN (false);
Lisp_Object lisp_str = value_to_lisp (value);
@@ -695,77 +759,77 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer,
ptrdiff_t raw_size = SBYTES (lisp_str_utf8);
ptrdiff_t required_buf_size = raw_size + 1;
- if (buffer == NULL)
+ if (buf == NULL)
{
- *length = required_buf_size;
+ *len = required_buf_size;
return true;
}
- if (*length < required_buf_size)
+ if (*len < required_buf_size)
{
- ptrdiff_t actual = *length;
- *length = required_buf_size;
+ ptrdiff_t actual = *len;
+ *len = required_buf_size;
args_out_of_range_3 (INT_TO_INTEGER (actual),
INT_TO_INTEGER (required_buf_size),
INT_TO_INTEGER (PTRDIFF_MAX));
}
- *length = required_buf_size;
- memcpy (buffer, SDATA (lisp_str_utf8), raw_size + 1);
+ *len = required_buf_size;
+ memcpy (buf, SDATA (lisp_str_utf8), raw_size + 1);
return true;
}
static emacs_value
-module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
+module_make_string (emacs_env *env, const char *str, ptrdiff_t len)
{
MODULE_FUNCTION_BEGIN (NULL);
- if (! (0 <= length && length <= STRING_BYTES_BOUND))
+ if (! (0 <= len && len <= STRING_BYTES_BOUND))
overflow_error ();
- Lisp_Object lstr = make_string_from_utf8 (str, length);
+ Lisp_Object lstr = module_decode_utf_8 (str, len);
return lisp_to_value (env, lstr);
}
static emacs_value
-module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr)
+module_make_user_ptr (emacs_env *env, emacs_finalizer fin, void *ptr)
{
MODULE_FUNCTION_BEGIN (NULL);
return lisp_to_value (env, make_user_ptr (fin, ptr));
}
static void *
-module_get_user_ptr (emacs_env *env, emacs_value uptr)
+module_get_user_ptr (emacs_env *env, emacs_value arg)
{
MODULE_FUNCTION_BEGIN (NULL);
- Lisp_Object lisp = value_to_lisp (uptr);
+ Lisp_Object lisp = value_to_lisp (arg);
CHECK_USER_PTR (lisp);
return XUSER_PTR (lisp)->p;
}
static void
-module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr)
+module_set_user_ptr (emacs_env *env, emacs_value arg, void *ptr)
{
MODULE_FUNCTION_BEGIN ();
- Lisp_Object lisp = value_to_lisp (uptr);
+ Lisp_Object lisp = value_to_lisp (arg);
CHECK_USER_PTR (lisp);
XUSER_PTR (lisp)->p = ptr;
}
-static emacs_finalizer_function
-module_get_user_finalizer (emacs_env *env, emacs_value uptr)
+static emacs_finalizer
+module_get_user_finalizer (emacs_env *env, emacs_value arg)
{
MODULE_FUNCTION_BEGIN (NULL);
- Lisp_Object lisp = value_to_lisp (uptr);
+ Lisp_Object lisp = value_to_lisp (arg);
CHECK_USER_PTR (lisp);
return XUSER_PTR (lisp)->finalizer;
}
static void
-module_set_user_finalizer (emacs_env *env, emacs_value uptr,
- emacs_finalizer_function fin)
+module_set_user_finalizer (emacs_env *env, emacs_value arg,
+ emacs_finalizer fin)
{
MODULE_FUNCTION_BEGIN ();
- Lisp_Object lisp = value_to_lisp (uptr);
+ Lisp_Object lisp = value_to_lisp (arg);
CHECK_USER_PTR (lisp);
XUSER_PTR (lisp)->finalizer = fin;
}
@@ -780,30 +844,31 @@ check_vec_index (Lisp_Object lvec, ptrdiff_t i)
}
static void
-module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val)
+module_vec_set (emacs_env *env, emacs_value vector, ptrdiff_t index,
+ emacs_value value)
{
MODULE_FUNCTION_BEGIN ();
- Lisp_Object lvec = value_to_lisp (vec);
- check_vec_index (lvec, i);
- ASET (lvec, i, value_to_lisp (val));
+ Lisp_Object lisp = value_to_lisp (vector);
+ check_vec_index (lisp, index);
+ ASET (lisp, index, value_to_lisp (value));
}
static emacs_value
-module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i)
+module_vec_get (emacs_env *env, emacs_value vector, ptrdiff_t index)
{
MODULE_FUNCTION_BEGIN (NULL);
- Lisp_Object lvec = value_to_lisp (vec);
- check_vec_index (lvec, i);
- return lisp_to_value (env, AREF (lvec, i));
+ Lisp_Object lisp = value_to_lisp (vector);
+ check_vec_index (lisp, index);
+ return lisp_to_value (env, AREF (lisp, index));
}
static ptrdiff_t
-module_vec_size (emacs_env *env, emacs_value vec)
+module_vec_size (emacs_env *env, emacs_value vector)
{
MODULE_FUNCTION_BEGIN (0);
- Lisp_Object lvec = value_to_lisp (vec);
- CHECK_VECTOR (lvec);
- return ASIZE (lvec);
+ Lisp_Object lisp = value_to_lisp (vector);
+ CHECK_VECTOR (lisp);
+ return ASIZE (lisp);
}
/* This function should return true if and only if maybe_quit would
@@ -824,10 +889,10 @@ module_process_input (emacs_env *env)
}
static struct timespec
-module_extract_time (emacs_env *env, emacs_value value)
+module_extract_time (emacs_env *env, emacs_value arg)
{
MODULE_FUNCTION_BEGIN ((struct timespec) {0});
- return lisp_time_argument (value_to_lisp (value));
+ return lisp_time_argument (value_to_lisp (arg));
}
static emacs_value
@@ -984,6 +1049,13 @@ module_make_big_integer (emacs_env *env, int sign,
return lisp_to_value (env, make_integer_mpz ());
}
+static int
+module_open_channel (emacs_env *env, emacs_value pipe_process)
+{
+ MODULE_FUNCTION_BEGIN (-1);
+ return open_channel_for_module (value_to_lisp (pipe_process));
+}
+
/* Subroutines. */
@@ -1041,7 +1113,14 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
for two different runtime objects are guaranteed to be distinct,
which we can use for checking the liveness of runtime
pointers. */
- struct emacs_runtime *rt = module_assertions ? xmalloc (sizeof *rt) : &rt_pub;
+ struct emacs_runtime *rt;
+ if (module_assertions)
+ {
+ rt = xmalloc (sizeof *rt);
+ __lsan_ignore_object (rt);
+ }
+ else
+ rt = &rt_pub;
rt->size = sizeof *rt;
rt->private_members = &rt_priv;
rt->get_environment = module_get_environment;
@@ -1125,6 +1204,12 @@ module_function_address (const struct Lisp_Module_Function *function)
return (module_funcptr) function->subr;
}
+void *
+module_function_data (const struct Lisp_Module_Function *function)
+{
+ return function->data;
+}
+
/* Helper functions. */
@@ -1141,14 +1226,14 @@ module_assert_thread (void)
}
static void
-module_assert_runtime (struct emacs_runtime *ert)
+module_assert_runtime (struct emacs_runtime *runtime)
{
if (! module_assertions)
return;
ptrdiff_t count = 0;
for (Lisp_Object tail = Vmodule_runtimes; CONSP (tail); tail = XCDR (tail))
{
- if (xmint_pointer (XCAR (tail)) == ert)
+ if (xmint_pointer (XCAR (tail)) == runtime)
return;
++count;
}
@@ -1261,7 +1346,7 @@ lisp_to_value (emacs_env *env, Lisp_Object o)
struct emacs_env_private *p = env->private_members;
if (p->pending_non_local_exit != emacs_funcall_exit_return)
return NULL;
- return allocate_emacs_value (env, &p->storage, o);
+ return allocate_emacs_value (env, o);
}
/* Must be called for each frame before it can be used for allocation. */
@@ -1298,9 +1383,9 @@ finalize_storage (struct emacs_value_storage *storage)
/* Allocate a new value from STORAGE and stores OBJ in it. Return
NULL if allocation fails and use ENV for non local exit reporting. */
static emacs_value
-allocate_emacs_value (emacs_env *env, struct emacs_value_storage *storage,
- Lisp_Object obj)
+allocate_emacs_value (emacs_env *env, Lisp_Object obj)
{
+ struct emacs_value_storage *storage = &env->private_members->storage;
eassert (storage->current);
eassert (storage->current->offset < value_frame_size);
eassert (! storage->current->next);
@@ -1351,7 +1436,10 @@ static emacs_env *
initialize_environment (emacs_env *env, struct emacs_env_private *priv)
{
if (module_assertions)
+ {
env = xmalloc (sizeof *env);
+ __lsan_ignore_object (env);
+ }
priv->pending_non_local_exit = emacs_funcall_exit_return;
initialize_storage (&priv->storage);
@@ -1390,6 +1478,10 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
env->make_time = module_make_time;
env->extract_big_integer = module_extract_big_integer;
env->make_big_integer = module_make_big_integer;
+ env->get_function_finalizer = module_get_function_finalizer;
+ env->set_function_finalizer = module_set_function_finalizer;
+ env->open_channel = module_open_channel;
+ env->make_interactive = module_make_interactive;
Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
return env;
}
diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in
index 898021dc5e6..6a39d507c84 100644
--- a/src/emacs-module.h.in
+++ b/src/emacs-module.h.in
@@ -42,10 +42,20 @@ information how to write modules and use this header file.
# define EMACS_NOEXCEPT
#endif
-#ifdef __has_attribute
-#if __has_attribute(__nonnull__)
-# define EMACS_ATTRIBUTE_NONNULL(...) __attribute__((__nonnull__(__VA_ARGS__)))
+#if defined __cplusplus && __cplusplus >= 201703L
+# define EMACS_NOEXCEPT_TYPEDEF noexcept
+#else
+# define EMACS_NOEXCEPT_TYPEDEF
#endif
+
+#if 3 < __GNUC__ + (3 <= __GNUC_MINOR__)
+# define EMACS_ATTRIBUTE_NONNULL(...) \
+ __attribute__ ((__nonnull__ (__VA_ARGS__)))
+#elif defined __has_attribute
+# if __has_attribute (__nonnull__)
+# define EMACS_ATTRIBUTE_NONNULL(...) \
+ __attribute__ ((__nonnull__ (__VA_ARGS__)))
+# endif
#endif
#ifndef EMACS_ATTRIBUTE_NONNULL
# define EMACS_ATTRIBUTE_NONNULL(...)
@@ -56,7 +66,7 @@ extern "C" {
#endif
/* Current environment. */
-typedef struct emacs_env_27 emacs_env;
+typedef struct emacs_env_@emacs_major_version@ emacs_env;
/* Opaque pointer representing an Emacs Lisp value.
BEWARE: Do not assume NULL is a valid value! */
@@ -74,10 +84,25 @@ struct emacs_runtime
struct emacs_runtime_private *private_members;
/* Return an environment pointer. */
- emacs_env *(*get_environment) (struct emacs_runtime *ert)
- EMACS_ATTRIBUTE_NONNULL(1);
+ emacs_env *(*get_environment) (struct emacs_runtime *runtime)
+ EMACS_ATTRIBUTE_NONNULL (1);
};
+/* Type aliases for function pointer types used in the module API.
+ Note that we don't use these aliases directly in the API to be able
+ to mark the function arguments as 'noexcept' before C++20.
+ However, users can use them if they want. */
+
+/* Function prototype for the module Lisp functions. These must not
+ throw C++ exceptions. */
+typedef emacs_value (*emacs_function) (emacs_env *env, ptrdiff_t nargs,
+ emacs_value *args,
+ void *data)
+ EMACS_NOEXCEPT_TYPEDEF EMACS_ATTRIBUTE_NONNULL (1);
+
+/* Function prototype for module user-pointer and function finalizers.
+ These must not throw C++ exceptions. */
+typedef void (*emacs_finalizer) (void *data) EMACS_NOEXCEPT_TYPEDEF;
/* Possible Emacs function call outcomes. */
enum emacs_funcall_exit
@@ -131,10 +156,21 @@ struct emacs_env_27
@module_env_snippet_27@
};
+struct emacs_env_28
+{
+@module_env_snippet_25@
+
+@module_env_snippet_26@
+
+@module_env_snippet_27@
+
+@module_env_snippet_28@
+};
+
/* Every module should define a function as follows. */
-extern int emacs_module_init (struct emacs_runtime *ert)
+extern int emacs_module_init (struct emacs_runtime *runtime)
EMACS_NOEXCEPT
- EMACS_ATTRIBUTE_NONNULL(1);
+ EMACS_ATTRIBUTE_NONNULL (1);
#ifdef __cplusplus
}
diff --git a/src/emacs.c b/src/emacs.c
index 11dcdb33fe0..059e1c6d8f0 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -83,7 +83,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "charset.h"
#include "composite.h"
#include "dispextern.h"
-#include "ptr-bounds.h"
#include "regex-emacs.h"
#include "sheap.h"
#include "syntax.h"
@@ -938,7 +937,6 @@ main (int argc, char **argv)
for pointers. */
void *stack_bottom_variable;
- bool do_initial_setlocale;
bool no_loadup = false;
char *junk = 0;
char *dname_arg = 0;
@@ -1243,19 +1241,21 @@ main (int argc, char **argv)
set_binary_mode (STDOUT_FILENO, O_BINARY);
#endif /* MSDOS */
- /* Skip initial setlocale if LC_ALL is "C", as it's not needed in that case.
- The build procedure uses this while dumping, to ensure that the
- dumped Emacs does not have its system locale tables initialized,
- as that might cause screwups when the dumped Emacs starts up. */
- {
- char *lc_all = getenv ("LC_ALL");
- do_initial_setlocale = ! lc_all || strcmp (lc_all, "C");
- }
-
- /* Set locale now, so that initial error messages are localized properly.
- fixup_locale must wait until later, since it builds strings. */
- if (do_initial_setlocale)
- setlocale (LC_ALL, "");
+ /* Set locale, so that initial error messages are localized properly.
+ However, skip this if LC_ALL is "C", as it's not needed in that case.
+ Skipping helps if dumping with unexec, to ensure that the dumped
+ Emacs does not have its system locale tables initialized, as that
+ might cause screwups when the dumped Emacs starts up. */
+ char *lc_all = getenv ("LC_ALL");
+ if (! (lc_all && strcmp (lc_all, "C") == 0))
+ {
+ #ifdef HAVE_NS
+ ns_pool = ns_alloc_autorelease_pool ();
+ ns_init_locale ();
+ #endif
+ setlocale (LC_ALL, "");
+ fixup_locale ();
+ }
text_quoting_flag = using_utf8 ();
inhibit_window_system = 0;
@@ -1536,6 +1536,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
if (!initialized)
{
init_alloc_once ();
+ init_pdumper_once ();
init_obarray_once ();
init_eval_once ();
init_charset_once ();
@@ -1584,14 +1585,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
init_alloc ();
init_bignum ();
init_threads ();
-
- if (do_initial_setlocale)
- {
- fixup_locale ();
- Vsystem_messages_locale = Vprevious_system_messages_locale;
- Vsystem_time_locale = Vprevious_system_time_locale;
- }
-
init_eval ();
init_atimer ();
running_asynch_code = 0;
@@ -1628,12 +1621,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
#endif
#ifdef HAVE_NS
- ns_pool = ns_alloc_autorelease_pool ();
-#ifdef NS_IMPL_GNUSTEP
- /* GNUstep stupidly resets our locale settings after we made them. */
- fixup_locale ();
-#endif
-
if (!noninteractive)
{
#ifdef NS_IMPL_COCOA
@@ -1747,11 +1734,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
globals_of_gfilenotify ();
#endif
-#ifdef HAVE_NS
- /* Initialize the locale from user defaults. */
- ns_init_locale ();
-#endif
-
/* Initialize and GC-protect Vinitial_environment and
Vprocess_environment before set_initial_environment fills them
in. */
@@ -1882,7 +1864,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
syms_of_xfns ();
syms_of_xmenu ();
syms_of_fontset ();
- syms_of_xwidget ();
syms_of_xsettings ();
#ifdef HAVE_X_SM
syms_of_xsmfns ();
@@ -1959,6 +1940,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
#endif /* HAVE_W32NOTIFY */
#endif /* WINDOWSNT */
+ syms_of_xwidget ();
syms_of_threads ();
syms_of_profiler ();
syms_of_pdumper ();
@@ -1994,7 +1976,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
/* This calls putenv and so must precede init_process_emacs. */
init_timefns ();
- /* This sets Voperating_system_release, which init_process_emacs uses. */
init_editfns ();
/* These two call putenv. */
@@ -2631,25 +2612,25 @@ synchronize_locale (int category, Lisp_Object *plocale, Lisp_Object desired_loca
if (! EQ (*plocale, desired_locale))
{
*plocale = desired_locale;
-#ifdef WINDOWSNT
+ char const *locale_string
+ = STRINGP (desired_locale) ? SSDATA (desired_locale) : "";
+# ifdef WINDOWSNT
/* Changing categories like LC_TIME usually requires specifying
an encoding suitable for the new locale, but MS-Windows's
'setlocale' will only switch the encoding when LC_ALL is
specified. So we ignore CATEGORY, use LC_ALL instead, and
then restore LC_NUMERIC to "C", so reading and printing
numbers is unaffected. */
- setlocale (LC_ALL, (STRINGP (desired_locale)
- ? SSDATA (desired_locale)
- : ""));
+ setlocale (LC_ALL, locale_string);
fixup_locale ();
-#else /* !WINDOWSNT */
- setlocale (category, (STRINGP (desired_locale)
- ? SSDATA (desired_locale)
- : ""));
-#endif /* !WINDOWSNT */
+# else /* !WINDOWSNT */
+ setlocale (category, locale_string);
+# endif /* !WINDOWSNT */
}
}
+static Lisp_Object Vprevious_system_time_locale;
+
/* Set system time locale to match Vsystem_time_locale, if possible. */
void
synchronize_system_time_locale (void)
@@ -2658,15 +2639,19 @@ synchronize_system_time_locale (void)
Vsystem_time_locale);
}
+# ifdef LC_MESSAGES
+static Lisp_Object Vprevious_system_messages_locale;
+# endif
+
/* Set system messages locale to match Vsystem_messages_locale, if
possible. */
void
synchronize_system_messages_locale (void)
{
-#ifdef LC_MESSAGES
+# ifdef LC_MESSAGES
synchronize_locale (LC_MESSAGES, &Vprevious_system_messages_locale,
Vsystem_messages_locale);
-#endif
+# endif
}
#endif /* HAVE_SETLOCALE */
@@ -2988,19 +2973,16 @@ build directory. */);
DEFVAR_LISP ("system-messages-locale", Vsystem_messages_locale,
doc: /* System locale for messages. */);
Vsystem_messages_locale = Qnil;
-
- DEFVAR_LISP ("previous-system-messages-locale",
- Vprevious_system_messages_locale,
- doc: /* Most recently used system locale for messages. */);
+#ifdef LC_MESSAGES
Vprevious_system_messages_locale = Qnil;
+ staticpro (&Vprevious_system_messages_locale);
+#endif
DEFVAR_LISP ("system-time-locale", Vsystem_time_locale,
doc: /* System locale for time. */);
Vsystem_time_locale = Qnil;
-
- DEFVAR_LISP ("previous-system-time-locale", Vprevious_system_time_locale,
- doc: /* Most recently used system locale for time. */);
Vprevious_system_time_locale = Qnil;
+ staticpro (&Vprevious_system_time_locale);
DEFVAR_LISP ("before-init-time", Vbefore_init_time,
doc: /* Value of `current-time' before Emacs begins initialization. */);
diff --git a/src/eval.c b/src/eval.c
index 16c36fa284c..0b23905207d 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1948,6 +1948,15 @@ then strings and vectors are not accepted. */)
else if (COMPILEDP (fun))
return (PVSIZE (fun) > COMPILED_INTERACTIVE ? Qt : if_prop);
+#ifdef HAVE_MODULES
+ /* Module functions are interactive if their `interactive_form'
+ field is non-nil. */
+ else if (MODULE_FUNCTIONP (fun))
+ return NILP (module_function_interactive_form (XMODULE_FUNCTION (fun)))
+ ? if_prop
+ : Qt;
+#endif
+
/* Strings and vectors are keyboard macros. */
if (STRINGP (fun) || VECTORP (fun))
return (NILP (for_call_interactively) ? Qt : Qnil);
@@ -2362,6 +2371,8 @@ eval_sub (Lisp_Object form)
DEFUN ("apply", Fapply, Sapply, 1, MANY, 0,
doc: /* Call FUNCTION with our remaining args, using our last arg as list of args.
Then return the value FUNCTION returns.
+With a single argument, call the argument's first element using the
+other elements as args.
Thus, (apply \\='+ 1 2 \\='(3 4)) returns 10.
usage: (apply FUNCTION &rest ARGUMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
@@ -2375,7 +2386,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
ptrdiff_t numargs = list_length (spread_arg);
if (numargs == 0)
- return Ffuncall (nargs - 1, args);
+ return Ffuncall (max (1, nargs - 1), args);
else if (numargs == 1)
{
args [nargs - 1] = XCAR (spread_arg);
@@ -2905,6 +2916,21 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args)
}
}
+/* Call the compiled Lisp function FUN. If we have not yet read FUN's
+ bytecode string and constants vector, fetch them from the file first. */
+
+static Lisp_Object
+fetch_and_exec_byte_code (Lisp_Object fun, Lisp_Object syms_left,
+ ptrdiff_t nargs, Lisp_Object *args)
+{
+ if (CONSP (AREF (fun, COMPILED_BYTECODE)))
+ Ffetch_bytecode (fun);
+ return exec_byte_code (AREF (fun, COMPILED_BYTECODE),
+ AREF (fun, COMPILED_CONSTANTS),
+ AREF (fun, COMPILED_STACK_DEPTH),
+ syms_left, nargs, args);
+}
+
static Lisp_Object
apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count)
{
@@ -2969,9 +2995,6 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
}
else if (COMPILEDP (fun))
{
- ptrdiff_t size = PVSIZE (fun);
- if (size <= COMPILED_STACK_DEPTH)
- xsignal1 (Qinvalid_function, fun);
syms_left = AREF (fun, COMPILED_ARGLIST);
if (FIXNUMP (syms_left))
/* A byte-code object with an integer args template means we
@@ -2983,15 +3006,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
argument-binding code below instead (as do all interpreted
functions, even lexically bound ones). */
{
- /* If we have not actually read the bytecode string
- and constants vector yet, fetch them from the file. */
- if (CONSP (AREF (fun, COMPILED_BYTECODE)))
- Ffetch_bytecode (fun);
- return exec_byte_code (AREF (fun, COMPILED_BYTECODE),
- AREF (fun, COMPILED_CONSTANTS),
- AREF (fun, COMPILED_STACK_DEPTH),
- syms_left,
- nargs, arg_vector);
+ return fetch_and_exec_byte_code (fun, syms_left, nargs, arg_vector);
}
lexenv = Qnil;
}
@@ -3060,16 +3075,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
if (CONSP (fun))
val = Fprogn (XCDR (XCDR (fun)));
else
- {
- /* If we have not actually read the bytecode string
- and constants vector yet, fetch them from the file. */
- if (CONSP (AREF (fun, COMPILED_BYTECODE)))
- Ffetch_bytecode (fun);
- val = exec_byte_code (AREF (fun, COMPILED_BYTECODE),
- AREF (fun, COMPILED_CONSTANTS),
- AREF (fun, COMPILED_STACK_DEPTH),
- Qnil, 0, 0);
- }
+ val = fetch_and_exec_byte_code (fun, Qnil, 0, NULL);
return unbind_to (count, val);
}
@@ -3154,9 +3160,6 @@ lambda_arity (Lisp_Object fun)
}
else if (COMPILEDP (fun))
{
- ptrdiff_t size = PVSIZE (fun);
- if (size <= COMPILED_STACK_DEPTH)
- xsignal1 (Qinvalid_function, fun);
syms_left = AREF (fun, COMPILED_ARGLIST);
if (FIXNUMP (syms_left))
return get_byte_code_arity (syms_left);
@@ -3199,13 +3202,11 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
if (COMPILEDP (object))
{
- ptrdiff_t size = PVSIZE (object);
- if (size <= COMPILED_STACK_DEPTH)
- xsignal1 (Qinvalid_function, object);
if (CONSP (AREF (object, COMPILED_BYTECODE)))
{
tem = read_doc_string (AREF (object, COMPILED_BYTECODE));
- if (!CONSP (tem))
+ if (! (CONSP (tem) && STRINGP (XCAR (tem))
+ && VECTORP (XCDR (tem))))
{
tem = AREF (object, COMPILED_BYTECODE);
if (CONSP (tem) && STRINGP (XCAR (tem)))
@@ -3213,7 +3214,19 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
else
error ("Invalid byte code");
}
- ASET (object, COMPILED_BYTECODE, XCAR (tem));
+
+ Lisp_Object bytecode = XCAR (tem);
+ if (STRING_MULTIBYTE (bytecode))
+ {
+ /* BYTECODE must have been produced by Emacs 20.2 or earlier
+ because it produced a raw 8-bit string for byte-code and now
+ such a byte-code string is loaded as multibyte with raw 8-bit
+ characters converted to multibyte form. Convert them back to
+ the original unibyte form. */
+ bytecode = Fstring_as_unibyte (bytecode);
+ }
+
+ ASET (object, COMPILED_BYTECODE, bytecode);
ASET (object, COMPILED_CONSTANTS, XCDR (tem));
}
}
@@ -3958,7 +3971,7 @@ mark_specpdl (union specbinding *first, union specbinding *ptr)
break;
case SPECPDL_UNWIND_ARRAY:
- mark_maybe_objects (pdl->unwind_array.array, pdl->unwind_array.nelts);
+ mark_objects (pdl->unwind_array.array, pdl->unwind_array.nelts);
break;
case SPECPDL_UNWIND_EXCURSION:
@@ -3972,8 +3985,7 @@ mark_specpdl (union specbinding *first, union specbinding *ptr)
mark_object (backtrace_function (pdl));
if (nargs == UNEVALLED)
nargs = 1;
- while (nargs--)
- mark_object (backtrace_args (pdl)[nargs]);
+ mark_objects (backtrace_args (pdl), nargs);
}
break;
diff --git a/src/fileio.c b/src/fileio.c
index 482f88627a5..6d0bafa8cf9 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -96,7 +96,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <acl.h>
#include <allocator.h>
#include <careadlinkat.h>
-#include <dosname.h>
+#include <filename.h>
#include <fsusage.h>
#include <stat-time.h>
#include <tempname.h>
@@ -947,6 +947,22 @@ the root directory. */)
)
{
default_directory = Fexpand_file_name (default_directory, Qnil);
+
+ /* The above expansion might have produced a remote file name,
+ so give the handlers one last chance to DTRT. This can
+ happen when both NAME and DEFAULT-DIRECTORY arguments are
+ relative file names, and the buffer's default-directory is
+ remote. */
+ handler = Ffind_file_name_handler (default_directory,
+ Qexpand_file_name);
+ if (!NILP (handler))
+ {
+ handled_name = call3 (handler, Qexpand_file_name,
+ name, default_directory);
+ if (STRINGP (handled_name))
+ return handled_name;
+ error ("Invalid handler in `file-name-handler-alist'");
+ }
}
}
multibyte = STRING_MULTIBYTE (name);
@@ -1952,7 +1968,10 @@ barf_or_query_if_file_exists (Lisp_Object absname, bool known_to_exist,
encoded_filename = ENCODE_FILE (absname);
- if (! known_to_exist && lstat (SSDATA (encoded_filename), &statbuf) == 0)
+ if (! known_to_exist
+ && (emacs_fstatat (AT_FDCWD, SSDATA (encoded_filename),
+ &statbuf, AT_SYMLINK_NOFOLLOW)
+ == 0))
{
if (S_ISDIR (statbuf.st_mode))
xsignal2 (Qfile_error,
@@ -2028,7 +2047,7 @@ permissions. */)
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object encoded_file, encoded_newname;
#if HAVE_LIBSELINUX
- security_context_t con;
+ char *con;
int conlength = 0;
#endif
#ifdef WINDOWSNT
@@ -2074,7 +2093,7 @@ permissions. */)
report_file_error ("Copying permissions from", file);
case -3:
xsignal2 (Qfile_date_error,
- build_string ("Resetting file times"), newname);
+ build_string ("Cannot set file date"), newname);
case -4:
report_file_error ("Copying permissions to", newname);
}
@@ -2250,9 +2269,8 @@ permissions. */)
if (!NILP (keep_time))
{
- struct timespec atime = get_stat_atime (&st);
- struct timespec mtime = get_stat_mtime (&st);
- if (set_file_times (ofd, SSDATA (encoded_newname), atime, mtime) != 0)
+ struct timespec ts[] = { get_stat_atime (&st), get_stat_mtime (&st) };
+ if (futimens (ofd, ts) != 0)
xsignal2 (Qfile_date_error,
build_string ("Cannot set file date"), newname);
}
@@ -2555,7 +2573,9 @@ This is what happens in interactive use with M-x. */)
bool dirp = !NILP (Fdirectory_name_p (file));
if (!dirp)
{
- if (lstat (SSDATA (encoded_file), &file_st) != 0)
+ if (emacs_fstatat (AT_FDCWD, SSDATA (encoded_file),
+ &file_st, AT_SYMLINK_NOFOLLOW)
+ != 0)
report_file_error ("Renaming", list2 (file, newname));
dirp = S_ISDIR (file_st.st_mode) != 0;
}
@@ -2899,6 +2919,11 @@ DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
doc: /* Return t if FILENAME names an existing directory.
Return nil if FILENAME does not name a directory, or if there
was trouble determining whether FILENAME is a directory.
+
+As a special case, this function will also return t if FILENAME is the
+empty string (\"\"). This quirk is due to Emacs interpreting the
+empty string (in some cases) as the current directory.
+
Symbolic links to directories count as directories.
See `file-symlink-p' to distinguish symlinks. */)
(Lisp_Object filename)
@@ -2928,7 +2953,8 @@ file_directory_p (Lisp_Object file)
#else
# ifdef O_PATH
/* Use O_PATH if available, as it avoids races and EOVERFLOW issues. */
- int fd = openat (AT_FDCWD, SSDATA (file), O_PATH | O_CLOEXEC | O_DIRECTORY);
+ int fd = emacs_openat (AT_FDCWD, SSDATA (file),
+ O_PATH | O_CLOEXEC | O_DIRECTORY, 0);
if (0 <= fd)
{
emacs_close (fd);
@@ -2939,9 +2965,9 @@ file_directory_p (Lisp_Object file)
/* O_PATH is defined but evidently this Linux kernel predates 2.6.39.
Fall back on generic POSIX code. */
# endif
- /* Use file_accessible_directory_p, as it avoids stat EOVERFLOW
+ /* Use file_accessible_directory_p, as it avoids fstatat EOVERFLOW
problems and could be cheaper. However, if it fails because FILE
- is inaccessible, fall back on stat; if the latter fails with
+ is inaccessible, fall back on fstatat; if the latter fails with
EOVERFLOW then FILE must have been a directory unless a race
condition occurred (a problem hard to work around portably). */
if (file_accessible_directory_p (file))
@@ -2949,7 +2975,7 @@ file_directory_p (Lisp_Object file)
if (errno != EACCES)
return false;
struct stat st;
- if (stat (SSDATA (file), &st) != 0)
+ if (emacs_fstatat (AT_FDCWD, SSDATA (file), &st, 0) != 0)
return errno == EOVERFLOW;
if (S_ISDIR (st.st_mode))
return true;
@@ -3080,7 +3106,7 @@ See `file-symlink-p' to distinguish symlinks. */)
Vw32_get_true_file_attributes = Qt;
#endif
- int stat_result = stat (SSDATA (absname), &st);
+ int stat_result = emacs_fstatat (AT_FDCWD, SSDATA (absname), &st, 0);
#ifdef WINDOWSNT
Vw32_get_true_file_attributes = true_attributes;
@@ -3113,7 +3139,7 @@ or if SELinux is disabled, or if Emacs lacks SELinux support. */)
#if HAVE_LIBSELINUX
if (is_selinux_enabled ())
{
- security_context_t con;
+ char *con;
int conlength = lgetfilecon (SSDATA (ENCODE_FILE (absname)), &con);
if (conlength > 0)
{
@@ -3158,7 +3184,7 @@ or if Emacs was not compiled with SELinux support. */)
Lisp_Object role = CAR_SAFE (CDR_SAFE (context));
Lisp_Object type = CAR_SAFE (CDR_SAFE (CDR_SAFE (context)));
Lisp_Object range = CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context))));
- security_context_t con;
+ char *con;
bool fail;
int conlength;
context_t parsed_con;
@@ -3326,50 +3352,60 @@ support. */)
return Qnil;
}
-DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
+static int
+symlink_nofollow_flag (Lisp_Object flag)
+{
+ /* For now, treat all non-nil FLAGs like 'nofollow'. */
+ return !NILP (flag) ? AT_SYMLINK_NOFOLLOW : 0;
+}
+
+DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 2, 0,
doc: /* Return mode bits of file named FILENAME, as an integer.
-Return nil if FILENAME does not exist. */)
- (Lisp_Object filename)
+Return nil if FILENAME does not exist. If optional FLAG is `nofollow',
+do not follow FILENAME if it is a symbolic link. */)
+ (Lisp_Object filename, Lisp_Object flag)
{
struct stat st;
+ int nofollow = symlink_nofollow_flag (flag);
Lisp_Object absname = expand_and_dir_to_file (filename);
/* If the file name has special constructs in it,
call the corresponding file name handler. */
Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_modes);
if (!NILP (handler))
- return call2 (handler, Qfile_modes, absname);
+ return call3 (handler, Qfile_modes, absname, flag);
- if (stat (SSDATA (ENCODE_FILE (absname)), &st) != 0)
+ char *fname = SSDATA (ENCODE_FILE (absname));
+ if (emacs_fstatat (AT_FDCWD, fname, &st, nofollow) != 0)
return file_attribute_errno (absname, errno);
return make_fixnum (st.st_mode & 07777);
}
-DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2,
+DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 3,
"(let ((file (read-file-name \"File: \"))) \
(list file (read-file-modes nil file)))",
doc: /* Set mode bits of file named FILENAME to MODE (an integer).
-Only the 12 low bits of MODE are used.
+Only the 12 low bits of MODE are used. If optional FLAG is `nofollow',
+do not follow FILENAME if it is a symbolic link.
Interactively, mode bits are read by `read-file-modes', which accepts
symbolic notation, like the `chmod' command from GNU Coreutils. */)
- (Lisp_Object filename, Lisp_Object mode)
+ (Lisp_Object filename, Lisp_Object mode, Lisp_Object flag)
{
- Lisp_Object absname, encoded_absname;
- Lisp_Object handler;
-
- absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
CHECK_FIXNUM (mode);
+ int nofollow = symlink_nofollow_flag (flag);
+ Lisp_Object absname = Fexpand_file_name (filename,
+ BVAR (current_buffer, directory));
/* If the file name has special constructs in it,
call the corresponding file name handler. */
- handler = Ffind_file_name_handler (absname, Qset_file_modes);
+ Lisp_Object handler = Ffind_file_name_handler (absname, Qset_file_modes);
if (!NILP (handler))
- return call3 (handler, Qset_file_modes, absname, mode);
-
- encoded_absname = ENCODE_FILE (absname);
+ return call4 (handler, Qset_file_modes, absname, mode, flag);
- if (chmod (SSDATA (encoded_absname), XFIXNUM (mode) & 07777) < 0)
+ char *fname = SSDATA (ENCODE_FILE (absname));
+ mode_t imode = XFIXNUM (mode) & 07777;
+ if (fchmodat (AT_FDCWD, fname, imode, nofollow) != 0)
report_file_error ("Doing chmod", absname);
return Qnil;
@@ -3414,39 +3450,41 @@ The value is an integer. */)
}
-DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0,
+DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 3, 0,
doc: /* Set times of file FILENAME to TIMESTAMP.
-Set both access and modification times.
-Return t on success, else nil.
-Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
-`current-time'. */)
- (Lisp_Object filename, Lisp_Object timestamp)
+If optional FLAG is `nofollow', do not follow FILENAME if it is a
+symbolic link. Set both access and modification times. Return t on
+success, else nil. Use the current time if TIMESTAMP is nil.
+TIMESTAMP is in the format of `current-time'. */)
+ (Lisp_Object filename, Lisp_Object timestamp, Lisp_Object flag)
{
- Lisp_Object absname, encoded_absname;
- Lisp_Object handler;
- struct timespec t = lisp_time_argument (timestamp);
+ int nofollow = symlink_nofollow_flag (flag);
- absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
+ struct timespec ts[2];
+ if (!NILP (timestamp))
+ ts[0] = ts[1] = lisp_time_argument (timestamp);
+ else
+ ts[0].tv_nsec = ts[1].tv_nsec = UTIME_NOW;
/* If the file name has special constructs in it,
call the corresponding file name handler. */
- handler = Ffind_file_name_handler (absname, Qset_file_times);
+ Lisp_Object
+ absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)),
+ handler = Ffind_file_name_handler (absname, Qset_file_times);
if (!NILP (handler))
- return call3 (handler, Qset_file_times, absname, timestamp);
+ return call4 (handler, Qset_file_times, absname, timestamp, flag);
- encoded_absname = ENCODE_FILE (absname);
+ Lisp_Object encoded_absname = ENCODE_FILE (absname);
- {
- if (set_file_times (-1, SSDATA (encoded_absname), t, t) != 0)
- {
+ if (utimensat (AT_FDCWD, SSDATA (encoded_absname), ts, nofollow) != 0)
+ {
#ifdef MSDOS
- /* Setting times on a directory always fails. */
- if (file_directory_p (encoded_absname))
- return Qnil;
+ /* Setting times on a directory always fails. */
+ if (file_directory_p (encoded_absname))
+ return Qnil;
#endif
- report_file_error ("Setting file times", absname);
- }
- }
+ report_file_error ("Setting file times", absname);
+ }
return Qt;
}
@@ -3486,7 +3524,7 @@ otherwise, if FILE2 does not exist, the answer is t. */)
return call3 (handler, Qfile_newer_than_file_p, absname1, absname2);
int err1;
- if (stat (SSDATA (ENCODE_FILE (absname1)), &st1) == 0)
+ if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (absname1)), &st1, 0) == 0)
err1 = 0;
else
{
@@ -3494,7 +3532,7 @@ otherwise, if FILE2 does not exist, the answer is t. */)
if (err1 != EOVERFLOW)
return file_attribute_errno (absname1, err1);
}
- if (stat (SSDATA (ENCODE_FILE (absname2)), &st2) != 0)
+ if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (absname2)), &st2, 0) != 0)
{
file_attribute_errno (absname2, errno);
return Qt;
@@ -3880,7 +3918,7 @@ by calling `format-decode', which see. */)
if (end_offset < 0)
buffer_overflow ();
- /* The file size returned from stat may be zero, but data
+ /* The file size returned from fstat may be zero, but data
may be readable nonetheless, for example when this is a
file in the /proc filesystem. */
if (end_offset == 0)
@@ -5625,7 +5663,7 @@ See Info node `(elisp)Modification Time' for more details. */)
filename = ENCODE_FILE (BVAR (b, filename));
- mtime = (stat (SSDATA (filename), &st) == 0
+ mtime = (emacs_fstatat (AT_FDCWD, SSDATA (filename), &st, 0) == 0
? get_stat_mtime (&st)
: time_error_value (errno));
if (timespec_cmp (mtime, b->modtime) == 0
@@ -5665,8 +5703,8 @@ in `current-time' or an integer flag as returned by `visited-file-modtime'. */)
struct timespec mtime;
if (FIXNUMP (time_flag))
{
- CHECK_RANGED_INTEGER (time_flag, -1, 0);
- mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XFIXNUM (time_flag));
+ int flag = check_integer_range (time_flag, -1, 0);
+ mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - flag);
}
else
mtime = lisp_time_argument (time_flag);
@@ -5689,7 +5727,8 @@ in `current-time' or an integer flag as returned by `visited-file-modtime'. */)
/* The handler can find the file name the same way we did. */
return call2 (handler, Qset_visited_file_modtime, Qnil);
- if (stat (SSDATA (ENCODE_FILE (filename)), &st) == 0)
+ if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (filename)), &st, 0)
+ == 0)
{
current_buffer->modtime = get_stat_mtime (&st);
current_buffer->modtime_size = st.st_size;
@@ -5728,12 +5767,14 @@ auto_save_1 (void)
/* Get visited file's mode to become the auto save file's mode. */
if (! NILP (BVAR (current_buffer, filename)))
{
- if (stat (SSDATA (BVAR (current_buffer, filename)), &st) >= 0)
+ if (emacs_fstatat (AT_FDCWD, SSDATA (BVAR (current_buffer, filename)),
+ &st, 0)
+ == 0)
/* But make sure we can overwrite it later! */
auto_save_mode_bits = (st.st_mode | 0600) & 0777;
- else if (modes = Ffile_modes (BVAR (current_buffer, filename)),
+ else if (modes = Ffile_modes (BVAR (current_buffer, filename), Qnil),
FIXNUMP (modes))
- /* Remote files don't cooperate with stat. */
+ /* Remote files don't cooperate with fstatat. */
auto_save_mode_bits = (XFIXNUM (modes) | 0600) & 0777;
}
diff --git a/src/filelock.c b/src/filelock.c
index b28f16e9b5a..ee46e0e3e00 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -347,7 +347,8 @@ rename_lock_file (char const *old, char const *new, bool force)
potential race condition since some other process may create
NEW immediately after the existence check, but it's the best
we can portably do here. */
- if (lstat (new, &st) == 0 || errno == EOVERFLOW)
+ if (emacs_fstatat (AT_FDCWD, new, &st, AT_SYMLINK_NOFOLLOW) == 0
+ || errno == EOVERFLOW)
{
errno = EEXIST;
return -1;
@@ -660,7 +661,7 @@ void
lock_file (Lisp_Object fn)
{
Lisp_Object orig_fn, encoded_fn;
- char *lfname;
+ char *lfname = NULL;
lock_info_type lock_info;
USE_SAFE_ALLOCA;
@@ -679,28 +680,22 @@ lock_file (Lisp_Object fn)
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);
/* See if this file is visited and has changed on disk since it was
visited. */
- {
- register Lisp_Object subject_buf;
-
- subject_buf = get_truename_buffer (orig_fn);
-
- if (!NILP (subject_buf)
- && NILP (Fverify_visited_file_modtime (subject_buf))
- && !NILP (Ffile_exists_p (fn)))
- call1 (intern ("userlock--ask-user-about-supersession-threat"), fn);
-
- }
+ Lisp_Object subject_buf = get_truename_buffer (orig_fn);
+ if (!NILP (subject_buf)
+ && NILP (Fverify_visited_file_modtime (subject_buf))
+ && !NILP (Ffile_exists_p (fn))
+ && !(lfname && 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 (create_lockfiles)
+ if (lfname)
{
-
- /* Create the name of the lock-file for file fn */
- MAKE_LOCK_NAME (lfname, encoded_fn);
-
/* 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)
@@ -859,7 +854,7 @@ syms_of_filelock (void)
The name of the (per-buffer) lockfile is constructed by prepending a
'.#' to the name of the file being locked. See also `lock-buffer' and
Info node `(emacs)Interlocking'. */);
- create_lockfiles = 1;
+ create_lockfiles = true;
defsubr (&Sunlock_buffer);
defsubr (&Slock_buffer);
diff --git a/src/fns.c b/src/fns.c
index 392196e2c7a..f626fe11b20 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -21,6 +21,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdlib.h>
+#include <sys/random.h>
#include <unistd.h>
#include <filevercmp.h>
#include <intprops.h>
@@ -38,15 +39,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "puresize.h"
#include "gnutls.h"
-#if defined WINDOWSNT && defined HAVE_GNUTLS3
-# define gnutls_rnd w32_gnutls_rnd
-#endif
-
static void sort_vector_copy (Lisp_Object, ptrdiff_t,
Lisp_Object *restrict, Lisp_Object *restrict);
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);
+static EMACS_UINT sxhash_obj (Lisp_Object, int);
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
doc: /* Return the ARGUMENT unchanged. */
@@ -225,12 +223,12 @@ Letter-case is significant, but text properties are ignored. */)
for (x = 1; x <= len2; x++)
{
column[0] = x;
- FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte);
+ c2 = fetch_string_char_advance (string2, &i2, &i2_byte);
i1 = i1_byte = 0;
for (y = 1, lastdiag = x - 1; y <= len1; y++)
{
olddiag = column[y];
- FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte);
+ c1 = fetch_string_char_advance (string1, &i1, &i1_byte);
column[y] = min (min (column[y] + 1, column[y-1] + 1),
lastdiag + (c1 == c2 ? 0 : 1));
lastdiag = olddiag;
@@ -311,10 +309,8 @@ If string STR1 is greater, the value is a positive number N;
{
/* When we find a mismatch, we must compare the
characters, not just the bytes. */
- int c1, c2;
-
- FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c1, str1, i1, i1_byte);
- FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c2, str2, i2, i2_byte);
+ int c1 = fetch_string_char_as_multibyte_advance (str1, &i1, &i1_byte);
+ int c2 = fetch_string_char_as_multibyte_advance (str2, &i2, &i2_byte);
if (c1 == c2)
continue;
@@ -349,11 +345,8 @@ DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic order.
Case is significant.
Symbols are also allowed; their print names are used instead. */)
- (register Lisp_Object string1, Lisp_Object string2)
+ (Lisp_Object string1, Lisp_Object string2)
{
- register ptrdiff_t end;
- register ptrdiff_t i1, i1_byte, i2, i2_byte;
-
if (SYMBOLP (string1))
string1 = SYMBOL_NAME (string1);
if (SYMBOLP (string2))
@@ -361,21 +354,15 @@ Symbols are also allowed; their print names are used instead. */)
CHECK_STRING (string1);
CHECK_STRING (string2);
- i1 = i1_byte = i2 = i2_byte = 0;
-
- end = SCHARS (string1);
- if (end > SCHARS (string2))
- end = SCHARS (string2);
+ ptrdiff_t i1 = 0, i1_byte = 0, i2 = 0, i2_byte = 0;
+ ptrdiff_t end = min (SCHARS (string1), SCHARS (string2));
while (i1 < end)
{
/* When we find a mismatch, we must compare the
characters, not just the bytes. */
- int c1, c2;
-
- FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte);
- FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte);
-
+ int c1 = fetch_string_char_advance (string1, &i1, &i1_byte);
+ int c2 = fetch_string_char_advance (string2, &i2, &i2_byte);
if (c1 != c2)
return c1 < c2 ? Qt : Qnil;
}
@@ -766,8 +753,8 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
{
Lisp_Object thislen;
ptrdiff_t thisleni = 0;
- register ptrdiff_t thisindex = 0;
- register ptrdiff_t thisindex_byte = 0;
+ ptrdiff_t thisindex = 0;
+ ptrdiff_t thisindex_byte = 0;
this = args[argnum];
if (!CONSP (this))
@@ -820,9 +807,8 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
{
int c;
if (STRING_MULTIBYTE (this))
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this,
- thisindex,
- thisindex_byte);
+ c = fetch_string_char_advance_no_check (this, &thisindex,
+ &thisindex_byte);
else
{
c = SREF (this, thisindex); thisindex++;
@@ -1544,11 +1530,21 @@ same_float (Lisp_Object x, Lisp_Object y)
return !neql;
}
+/* True if X can be compared using `eq'.
+ This predicate is approximative, for maximum speed. */
+static bool
+eq_comparable_value (Lisp_Object x)
+{
+ return SYMBOLP (x) || FIXNUMP (x);
+}
+
DEFUN ("member", Fmember, Smember, 2, 2, 0,
doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
The value is actually the tail of LIST whose car is ELT. */)
(Lisp_Object elt, Lisp_Object list)
{
+ if (eq_comparable_value (elt))
+ return Fmemq (elt, list);
Lisp_Object tail = list;
FOR_EACH_TAIL (tail)
if (! NILP (Fequal (elt, XCAR (tail))))
@@ -1636,6 +1632,8 @@ 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. */)
(Lisp_Object key, Lisp_Object alist, Lisp_Object testfn)
{
+ if (eq_comparable_value (key) && NILP (testfn))
+ return Fassq (key, alist);
Lisp_Object tail = alist;
FOR_EACH_TAIL (tail)
{
@@ -1686,6 +1684,8 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
The value is actually the first element of ALIST whose cdr equals KEY. */)
(Lisp_Object key, Lisp_Object alist)
{
+ if (eq_comparable_value (key))
+ return Frassq (key, alist);
Lisp_Object tail = alist;
FOR_EACH_TAIL (tail)
{
@@ -1747,25 +1747,27 @@ changing the value of a sequence `foo'. */)
{
if (VECTORP (seq))
{
- ptrdiff_t i, n;
-
- for (i = n = 0; i < ASIZE (seq); ++i)
- if (NILP (Fequal (AREF (seq, i), elt)))
- ++n;
+ ptrdiff_t n = 0;
+ ptrdiff_t size = ASIZE (seq);
+ USE_SAFE_ALLOCA;
+ Lisp_Object *kept = SAFE_ALLOCA (size * sizeof *kept);
- if (n != ASIZE (seq))
+ for (ptrdiff_t i = 0; i < size; i++)
{
- struct Lisp_Vector *p = allocate_vector (n);
+ kept[n] = AREF (seq, i);
+ n += NILP (Fequal (AREF (seq, i), elt));
+ }
- for (i = n = 0; i < ASIZE (seq); ++i)
- if (NILP (Fequal (AREF (seq, i), elt)))
- p->contents[n++] = AREF (seq, i);
+ if (n != size)
+ seq = Fvector (n, kept);
- XSETVECTOR (seq, p);
- }
+ SAFE_FREE ();
}
else if (STRINGP (seq))
{
+ if (!CHARACTERP (elt))
+ return seq;
+
ptrdiff_t i, ibyte, nchars, nbytes, cbytes;
int c;
@@ -1784,7 +1786,7 @@ changing the value of a sequence `foo'. */)
cbytes = 1;
}
- if (!FIXNUMP (elt) || c != XFIXNUM (elt))
+ if (c != XFIXNUM (elt))
{
++nchars;
nbytes += cbytes;
@@ -1814,7 +1816,7 @@ changing the value of a sequence `foo'. */)
cbytes = 1;
}
- if (!FIXNUMP (elt) || c != XFIXNUM (elt))
+ if (c != XFIXNUM (elt))
{
unsigned char *from = SDATA (seq) + ibyte;
unsigned char *to = SDATA (tem) + nbytes;
@@ -1960,9 +1962,7 @@ See also the function `nreverse', which is used more often. */)
p = SDATA (seq), q = SDATA (new) + bytes;
while (q > SDATA (new))
{
- int ch, len;
-
- ch = STRING_CHAR_AND_LENGTH (p, len);
+ int len, ch = string_char_and_length (p, &len);
p += len, q -= len;
CHAR_STRING (ch, q);
}
@@ -2433,6 +2433,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
same size. */
if (ASIZE (o2) != size)
return false;
+
+ /* Compare bignums, overlays, markers, and boolvectors
+ specially, by comparing their values. */
if (BIGNUMP (o1))
return mpz_cmp (*xbignum_val (o1), *xbignum_val (o2)) == 0;
if (OVERLAYP (o1))
@@ -2453,21 +2456,12 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
&& (XMARKER (o1)->buffer == 0
|| XMARKER (o1)->bytepos == XMARKER (o2)->bytepos));
}
- /* Boolvectors are compared much like strings. */
if (BOOL_VECTOR_P (o1))
{
EMACS_INT size = bool_vector_size (o1);
- if (size != bool_vector_size (o2))
- return false;
- if (memcmp (bool_vector_data (o1), bool_vector_data (o2),
- bool_vector_bytes (size)))
- return false;
- return true;
- }
- if (WINDOW_CONFIGURATIONP (o1))
- {
- eassert (equal_kind != EQUAL_NO_QUIT);
- return compare_window_configurations (o1, o2, false);
+ return (size == bool_vector_size (o2)
+ && !memcmp (bool_vector_data (o1), bool_vector_data (o2),
+ bool_vector_bytes (size)));
}
/* Aside from them, only true vectors, char-tables, compiled
@@ -2493,16 +2487,11 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
break;
case Lisp_String:
- if (SCHARS (o1) != SCHARS (o2))
- return false;
- if (SBYTES (o1) != SBYTES (o2))
- return false;
- if (memcmp (SDATA (o1), SDATA (o2), SBYTES (o1)))
- return false;
- if (equal_kind == EQUAL_INCLUDING_PROPERTIES
- && !compare_string_intervals (o1, o2))
- return false;
- return true;
+ return (SCHARS (o1) == SCHARS (o2)
+ && SBYTES (o1) == SBYTES (o2)
+ && !memcmp (SDATA (o1), SDATA (o2), SBYTES (o1))
+ && (equal_kind != EQUAL_INCLUDING_PROPERTIES
+ || compare_string_intervals (o1, o2)));
default:
break;
@@ -2532,26 +2521,36 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
}
else if (STRINGP (array))
{
- register unsigned char *p = SDATA (array);
- int charval;
+ unsigned char *p = SDATA (array);
CHECK_CHARACTER (item);
- charval = XFIXNAT (item);
+ int charval = XFIXNAT (item);
size = SCHARS (array);
- if (STRING_MULTIBYTE (array))
+ if (size != 0)
{
+ CHECK_IMPURE (array, XSTRING (array));
unsigned char str[MAX_MULTIBYTE_LENGTH];
- int len = CHAR_STRING (charval, str);
- ptrdiff_t size_byte = SBYTES (array);
- ptrdiff_t product;
+ int len;
+ if (STRING_MULTIBYTE (array))
+ len = CHAR_STRING (charval, str);
+ else
+ {
+ str[0] = charval;
+ len = 1;
+ }
- if (INT_MULTIPLY_WRAPV (size, len, &product) || product != size_byte)
- error ("Attempt to change byte length of a string");
- for (idx = 0; idx < size_byte; idx++)
- *p++ = str[idx % len];
+ ptrdiff_t size_byte = SBYTES (array);
+ if (len == 1 && size == size_byte)
+ memset (p, str[0], size);
+ else
+ {
+ ptrdiff_t product;
+ if (INT_MULTIPLY_WRAPV (size, len, &product)
+ || product != size_byte)
+ error ("Attempt to change byte length of a string");
+ for (idx = 0; idx < size_byte; idx++)
+ *p++ = str[idx % len];
+ }
}
- else
- for (idx = 0; idx < size; idx++)
- p[idx] = charval;
}
else if (BOOL_VECTOR_P (array))
return bool_vector_fill (array, item);
@@ -2566,12 +2565,15 @@ DEFUN ("clear-string", Fclear_string, Sclear_string,
This makes STRING unibyte and may change its length. */)
(Lisp_Object string)
{
- ptrdiff_t len;
CHECK_STRING (string);
- len = SBYTES (string);
- memset (SDATA (string), 0, len);
- STRING_SET_CHARS (string, len);
- STRING_SET_UNIBYTE (string);
+ ptrdiff_t len = SBYTES (string);
+ if (len != 0 || STRING_MULTIBYTE (string))
+ {
+ CHECK_IMPURE (string, XSTRING (string));
+ memset (SDATA (string), 0, len);
+ STRING_SET_CHARS (string, len);
+ STRING_SET_UNIBYTE (string);
+ }
return Qnil;
}
@@ -2624,51 +2626,45 @@ usage: (nconc &rest LISTS) */)
static EMACS_INT
mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
{
- Lisp_Object tail, dummy;
- EMACS_INT i;
-
if (VECTORP (seq) || COMPILEDP (seq))
{
- for (i = 0; i < leni; i++)
+ for (ptrdiff_t i = 0; i < leni; i++)
{
- dummy = call1 (fn, AREF (seq, i));
+ Lisp_Object dummy = call1 (fn, AREF (seq, i));
if (vals)
vals[i] = dummy;
}
}
else if (BOOL_VECTOR_P (seq))
{
- for (i = 0; i < leni; i++)
+ for (EMACS_INT i = 0; i < leni; i++)
{
- dummy = call1 (fn, bool_vector_ref (seq, i));
+ Lisp_Object dummy = call1 (fn, bool_vector_ref (seq, i));
if (vals)
vals[i] = dummy;
}
}
else if (STRINGP (seq))
{
- ptrdiff_t i_byte;
+ ptrdiff_t i_byte = 0;
- for (i = 0, i_byte = 0; i < leni;)
+ for (ptrdiff_t i = 0; i < leni;)
{
- int c;
ptrdiff_t i_before = i;
-
- FETCH_STRING_CHAR_ADVANCE (c, seq, i, i_byte);
- XSETFASTINT (dummy, c);
- dummy = call1 (fn, dummy);
+ int c = fetch_string_char_advance (seq, &i, &i_byte);
+ Lisp_Object dummy = call1 (fn, make_fixnum (c));
if (vals)
vals[i_before] = dummy;
}
}
else /* Must be a list, since Flength did not get an error */
{
- tail = seq;
- for (i = 0; i < leni; i++)
+ Lisp_Object tail = seq;
+ for (ptrdiff_t i = 0; i < leni; i++)
{
if (! CONSP (tail))
return i;
- dummy = call1 (fn, XCAR (tail));
+ Lisp_Object dummy = call1 (fn, XCAR (tail));
if (vals)
vals[i] = dummy;
tail = XCDR (tail);
@@ -2853,7 +2849,7 @@ advisable. */)
while (loads-- > 0)
{
Lisp_Object load = (NILP (use_floats)
- ? make_fixnum (100.0 * load_ave[loads])
+ ? double_to_integer (100.0 * load_ave[loads])
: make_float (load_ave[loads]));
ret = Fcons (load, ret);
}
@@ -3461,7 +3457,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
{
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH ((unsigned char *) from + i, bytes);
+ c = string_char_and_length ((unsigned char *) from + i, &bytes);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
else if (c >= 256)
@@ -3504,7 +3500,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH ((unsigned char *) from + i, bytes);
+ c = string_char_and_length ((unsigned char *) from + i, &bytes);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
else if (c >= 256)
@@ -3529,7 +3525,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH ((unsigned char *) from + i, bytes);
+ c = string_char_and_length ((unsigned char *) from + i, &bytes);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
else if (c >= 256)
@@ -3710,7 +3706,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
c = value >> 16 & 0xff;
if (c & multibyte_bit)
- e += BYTE8_STRING (c, e);
+ e += BYTE8_STRING (c, (unsigned char *) e);
else
*e++ = c;
nchars++;
@@ -3752,7 +3748,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
c = value >> 8 & 0xff;
if (c & multibyte_bit)
- e += BYTE8_STRING (c, e);
+ e += BYTE8_STRING (c, (unsigned char *) e);
else
*e++ = c;
nchars++;
@@ -3782,7 +3778,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
c = value & 0xff;
if (c & multibyte_bit)
- e += BYTE8_STRING (c, e);
+ e += BYTE8_STRING (c, (unsigned char *) e);
else
*e++ = c;
nchars++;
@@ -4022,7 +4018,7 @@ hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h)
Lisp_Object
hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h)
{
- return make_ufixnum (sxhash (key, 0));
+ return make_ufixnum (sxhash (key));
}
/* Ignore HT and return a hash code for KEY which uses 'eql' to compare keys.
@@ -4042,7 +4038,7 @@ hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h)
{
Lisp_Object args[] = { h->test.user_hash_function, key };
Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h);
- return FIXNUMP (hash) ? hash : make_ufixnum (sxhash (hash, 0));
+ return FIXNUMP (hash) ? hash : make_ufixnum (sxhash (hash));
}
struct hash_table_test const
@@ -4254,50 +4250,31 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
/* Recompute the hashes (and hence also the "next" pointers).
Normally there's never a need to recompute hashes.
- This is done only on first-access to a hash-table loaded from
- the "pdump", because the object's addresses may have changed, thus
- affecting their hash. */
+ This is done only on first access to a hash-table loaded from
+ the "pdump", because the objects' addresses may have changed, thus
+ affecting their hashes. */
void
-hash_table_rehash (struct Lisp_Hash_Table *h)
+hash_table_rehash (Lisp_Object hash)
{
- ptrdiff_t size = HASH_TABLE_SIZE (h);
-
- /* These structures may have been purecopied and shared
- (bug#36447). */
- Lisp_Object hash = make_nil_vector (size);
- h->next = Fcopy_sequence (h->next);
- h->index = Fcopy_sequence (h->index);
+ struct Lisp_Hash_Table *h = XHASH_TABLE (hash);
+ ptrdiff_t i, count = h->count;
/* Recompute the actual hash codes for each entry in the table.
Order is still invalid. */
- for (ptrdiff_t i = 0; i < size; ++i)
+ for (i = 0; i < count; i++)
{
Lisp_Object key = HASH_KEY (h, i);
- if (!EQ (key, Qunbound))
- ASET (hash, i, h->test.hashfn (key, h));
+ Lisp_Object hash_code = h->test.hashfn (key, h);
+ ptrdiff_t start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index);
+ set_hash_hash_slot (h, i, hash_code);
+ set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
+ set_hash_index_slot (h, start_of_bucket, i);
+ eassert (HASH_NEXT (h, i) != i); /* Stop loops. */
}
- /* Reset the index so that any slot we don't fill below is marked
- invalid. */
- Ffillarray (h->index, make_fixnum (-1));
-
- /* Rebuild the collision chains. */
- for (ptrdiff_t i = 0; i < size; ++i)
- if (!NILP (AREF (hash, i)))
- {
- EMACS_UINT hash_code = XUFIXNUM (AREF (hash, i));
- ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index);
- set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
- set_hash_index_slot (h, start_of_bucket, i);
- eassert (HASH_NEXT (h, i) != i); /* Stop loops. */
- }
-
- /* Finally, mark the hash table as having a valid hash order.
- Do this last so that if we're interrupted, we retry on next
- access. */
- eassert (hash_rehash_needed_p (h));
- h->hash = hash;
- eassert (!hash_rehash_needed_p (h));
+ ptrdiff_t size = ASIZE (h->next);
+ for (; i + 1 < size; i++)
+ set_hash_next_slot (h, i, i + 1);
}
/* Lookup KEY in hash table H. If HASH is non-null, return in *HASH
@@ -4309,8 +4286,6 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object *hash)
{
ptrdiff_t start_of_bucket, i;
- hash_rehash_if_needed (h);
-
Lisp_Object hash_code = h->test.hashfn (key, h);
if (hash)
*hash = hash_code;
@@ -4345,8 +4320,6 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
{
ptrdiff_t start_of_bucket, i;
- hash_rehash_if_needed (h);
-
/* Increment count after resizing because resizing may fail. */
maybe_resize_hash_table (h);
h->count++;
@@ -4379,8 +4352,6 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
ptrdiff_t start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index);
ptrdiff_t prev = -1;
- hash_rehash_if_needed (h);
-
for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket);
0 <= i;
i = HASH_NEXT (h, i))
@@ -4421,8 +4392,7 @@ hash_clear (struct Lisp_Hash_Table *h)
if (h->count > 0)
{
ptrdiff_t size = HASH_TABLE_SIZE (h);
- if (!hash_rehash_needed_p (h))
- memclear (XVECTOR (h->hash)->contents, size * word_size);
+ memclear (xvector_contents (h->hash), size * word_size);
for (ptrdiff_t i = 0; i < size; i++)
{
set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1);
@@ -4458,9 +4428,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
for (ptrdiff_t bucket = 0; bucket < n; ++bucket)
{
/* Follow collision chain, removing entries that don't survive
- this garbage collection. It's okay if hash_rehash_needed_p
- (h) is true, since we're operating entirely on the cached
- hash values. */
+ this garbage collection. */
ptrdiff_t prev = -1;
ptrdiff_t next;
for (ptrdiff_t i = HASH_INDEX (h, bucket); 0 <= i; i = next)
@@ -4505,7 +4473,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
set_hash_hash_slot (h, i, Qnil);
eassert (h->count != 0);
- h->count += h->count > 0 ? -1 : 1;
+ h->count--;
}
else
{
@@ -4606,13 +4574,13 @@ sxhash_list (Lisp_Object list, int depth)
CONSP (list) && i < SXHASH_MAX_LEN;
list = XCDR (list), ++i)
{
- EMACS_UINT hash2 = sxhash (XCAR (list), depth + 1);
+ EMACS_UINT hash2 = sxhash_obj (XCAR (list), depth + 1);
hash = sxhash_combine (hash, hash2);
}
if (!NILP (list))
{
- EMACS_UINT hash2 = sxhash (list, depth + 1);
+ EMACS_UINT hash2 = sxhash_obj (list, depth + 1);
hash = sxhash_combine (hash, hash2);
}
@@ -4632,7 +4600,7 @@ sxhash_vector (Lisp_Object vec, int depth)
n = min (SXHASH_MAX_LEN, hash & PSEUDOVECTOR_FLAG ? PVSIZE (vec) : hash);
for (i = 0; i < n; ++i)
{
- EMACS_UINT hash2 = sxhash (AREF (vec, i), depth + 1);
+ EMACS_UINT hash2 = sxhash_obj (AREF (vec, i), depth + 1);
hash = sxhash_combine (hash, hash2);
}
@@ -4675,58 +4643,78 @@ sxhash_bignum (Lisp_Object bignum)
structure. Value is an unsigned integer clipped to INTMASK. */
EMACS_UINT
-sxhash (Lisp_Object obj, int depth)
+sxhash (Lisp_Object obj)
{
- EMACS_UINT hash;
+ return sxhash_obj (obj, 0);
+}
+static EMACS_UINT
+sxhash_obj (Lisp_Object obj, int depth)
+{
if (depth > SXHASH_MAX_DEPTH)
return 0;
switch (XTYPE (obj))
{
case_Lisp_Int:
- hash = XUFIXNUM (obj);
- break;
+ return XUFIXNUM (obj);
case Lisp_Symbol:
- hash = XHASH (obj);
- break;
+ return XHASH (obj);
case Lisp_String:
- hash = sxhash_string (SSDATA (obj), SBYTES (obj));
- break;
+ return sxhash_string (SSDATA (obj), SBYTES (obj));
- /* This can be everything from a vector to an overlay. */
case Lisp_Vectorlike:
- if (BIGNUMP (obj))
- hash = sxhash_bignum (obj);
- else if (VECTORP (obj) || RECORDP (obj))
- /* According to the CL HyperSpec, two arrays are equal only if
- they are `eq', except for strings and bit-vectors. In
- Emacs, this works differently. We have to compare element
- by element. Same for records. */
- hash = sxhash_vector (obj, depth);
- else if (BOOL_VECTOR_P (obj))
- hash = sxhash_bool_vector (obj);
- else
- /* Others are `equal' if they are `eq', so let's take their
- address as hash. */
- hash = XHASH (obj);
- break;
+ {
+ enum pvec_type pvec_type = PSEUDOVECTOR_TYPE (XVECTOR (obj));
+ if (! (PVEC_NORMAL_VECTOR < pvec_type && pvec_type < PVEC_COMPILED))
+ {
+ /* According to the CL HyperSpec, two arrays are equal only if
+ they are 'eq', except for strings and bit-vectors. In
+ Emacs, this works differently. We have to compare element
+ by element. Same for pseudovectors that internal_equal
+ examines the Lisp contents of. */
+ return (SUB_CHAR_TABLE_P (obj)
+ /* 'sxhash_vector' can't be applies to a sub-char-table and
+ it's probably not worth looking into them anyway! */
+ ? 42
+ : sxhash_vector (obj, depth));
+ }
+ else if (pvec_type == PVEC_BIGNUM)
+ return sxhash_bignum (obj);
+ else if (pvec_type == PVEC_MARKER)
+ {
+ ptrdiff_t bytepos
+ = XMARKER (obj)->buffer ? XMARKER (obj)->bytepos : 0;
+ EMACS_UINT hash
+ = sxhash_combine ((intptr_t) XMARKER (obj)->buffer, bytepos);
+ return SXHASH_REDUCE (hash);
+ }
+ else if (pvec_type == PVEC_BOOL_VECTOR)
+ return sxhash_bool_vector (obj);
+ else if (pvec_type == PVEC_OVERLAY)
+ {
+ EMACS_UINT hash = sxhash_obj (OVERLAY_START (obj), depth);
+ hash = sxhash_combine (hash, sxhash_obj (OVERLAY_END (obj), depth));
+ hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist, depth));
+ return SXHASH_REDUCE (hash);
+ }
+ else
+ /* Others are 'equal' if they are 'eq', so take their
+ address as hash. */
+ return XHASH (obj);
+ }
case Lisp_Cons:
- hash = sxhash_list (obj, depth);
- break;
+ return sxhash_list (obj, depth);
case Lisp_Float:
- hash = sxhash_float (XFLOAT_DATA (obj));
- break;
+ return sxhash_float (XFLOAT_DATA (obj));
default:
emacs_abort ();
}
-
- return hash;
}
@@ -4909,7 +4897,6 @@ DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,
(Lisp_Object table)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
- eassert (h->count >= 0);
return make_fixnum (h->count);
}
@@ -5177,22 +5164,8 @@ extract_data_from_object (Lisp_Object spec,
struct buffer *bp = XBUFFER (object);
set_buffer_internal (bp);
- if (NILP (start))
- b = BEGV;
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (start);
- b = XFIXNUM (start);
- }
-
- if (NILP (end))
- e = ZV;
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (end);
- e = XFIXNUM (end);
- }
-
+ b = !NILP (start) ? fix_position (start) : BEGV;
+ e = !NILP (end) ? fix_position (end) : ZV;
if (b > e)
{
EMACS_INT temp = b;
@@ -5278,7 +5251,6 @@ extract_data_from_object (Lisp_Object spec,
}
else if (EQ (object, Qiv_auto))
{
-#ifdef HAVE_GNUTLS3
/* Format: (iv-auto REQUIRED-LENGTH). */
if (! FIXNATP (start))
@@ -5287,14 +5259,19 @@ extract_data_from_object (Lisp_Object spec,
{
EMACS_INT start_hold = XFIXNAT (start);
object = make_uninit_string (start_hold);
- gnutls_rnd (GNUTLS_RND_NONCE, SSDATA (object), start_hold);
+ char *lim = SSDATA (object) + start_hold;
+ for (char *p = SSDATA (object); p < lim; p++)
+ {
+ ssize_t gotten = getrandom (p, lim - p, 0);
+ if (0 <= gotten)
+ p += gotten;
+ else if (errno != EINTR)
+ report_file_error ("Getting random data", Qnil);
+ }
*start_byte = 0;
*end_byte = start_hold;
}
-#else
- error ("GnuTLS is not available, so `iv-auto' can't be used");
-#endif
}
if (!STRINGP (object))
@@ -5477,6 +5454,95 @@ It should not be used for anything security-related. See
return make_digest_string (digest, SHA1_DIGEST_SIZE);
}
+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
+HAYSTACK, or nil if no match was found.
+
+The optional START-POS argument says where to start searching in
+HAYSTACK and defaults to zero (start at the beginning).
+It must be between zero and the length of HAYSTACK, inclusive.
+
+Case is always significant and text properties are ignored. */)
+ (register Lisp_Object needle, Lisp_Object haystack, Lisp_Object start_pos)
+{
+ ptrdiff_t start_byte = 0, haybytes;
+ char *res, *haystart;
+ EMACS_INT start = 0;
+
+ CHECK_STRING (needle);
+ CHECK_STRING (haystack);
+
+ if (!NILP (start_pos))
+ {
+ CHECK_FIXNUM (start_pos);
+ start = XFIXNUM (start_pos);
+ if (start < 0 || start > SCHARS (haystack))
+ xsignal1 (Qargs_out_of_range, start_pos);
+ start_byte = string_char_to_byte (haystack, start);
+ }
+
+ /* If NEEDLE is longer than (the remaining length of) haystack, then
+ we can't have a match, and return early. */
+ if (SCHARS (needle) > SCHARS (haystack) - start)
+ return Qnil;
+
+ haystart = SSDATA (haystack) + start_byte;
+ haybytes = SBYTES (haystack) - start_byte;
+
+ /* We can do a direct byte-string search if both strings have the
+ same multibyteness, or if at least one of them consists of ASCII
+ characters only. */
+ if (STRING_MULTIBYTE (haystack)
+ ? (STRING_MULTIBYTE (needle)
+ || SCHARS (haystack) == SBYTES (haystack) || string_ascii_p (needle))
+ : (!STRING_MULTIBYTE (needle)
+ || SCHARS (needle) == SBYTES (needle) || string_ascii_p (haystack)))
+ res = memmem (haystart, haybytes,
+ SSDATA (needle), SBYTES (needle));
+ else if (STRING_MULTIBYTE (haystack)) /* unibyte needle */
+ {
+ Lisp_Object multi_needle = string_to_multibyte (needle);
+ res = memmem (haystart, haybytes,
+ SSDATA (multi_needle), SBYTES (multi_needle));
+ }
+ else /* unibyte haystack, multibyte needle */
+ {
+ /* The only possible way we can find the multibyte needle in the
+ unibyte stack (since we know that neither are pure-ASCII) is
+ if they contain "raw bytes" (and no other non-ASCII chars.) */
+ ptrdiff_t nbytes = SBYTES (needle);
+ for (ptrdiff_t i = 0; i < nbytes; i++)
+ {
+ int c = SREF (needle, i);
+ if (CHAR_BYTE8_HEAD_P (c))
+ i++; /* Skip raw byte. */
+ else if (!ASCII_CHAR_P (c))
+ return Qnil; /* Found a char that can't be in the haystack. */
+ }
+
+ /* "Raw bytes" (aka eighth-bit) are represented differently in
+ multibyte and unibyte strings. */
+ Lisp_Object uni_needle = Fstring_to_unibyte (needle);
+ res = memmem (haystart, haybytes,
+ SSDATA (uni_needle), SBYTES (uni_needle));
+ }
+
+ if (! res)
+ return Qnil;
+
+ return make_int (string_byte_to_char (haystack, res - SSDATA (haystack)));
+}
void
@@ -5517,6 +5583,7 @@ syms_of_fns (void)
defsubr (&Sremhash);
defsubr (&Smaphash);
defsubr (&Sdefine_hash_table_test);
+ defsubr (&Sstring_search);
/* Crypto and hashing stuff. */
DEFSYM (Qiv_auto, "iv-auto");
diff --git a/src/font.c b/src/font.c
index 39ec1b3562a..beaa7be98de 100644
--- a/src/font.c
+++ b/src/font.c
@@ -2810,7 +2810,13 @@ font_list_entities (struct frame *f, Lisp_Object spec)
|| ! NILP (Vface_ignored_fonts)))
val = font_delete_unmatched (val, need_filtering ? spec : Qnil, size);
if (ASIZE (val) > 0)
- list = Fcons (val, list);
+ {
+ list = Fcons (val, list);
+ /* Querying further backends can be very slow, so we only do
+ it if the user has explicitly requested it (Bug#43177). */
+ if (query_all_font_backends == false)
+ break;
+ }
}
list = Fnreverse (list);
@@ -3856,13 +3862,10 @@ font_range (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t *limit,
while (pos < *limit)
{
- Lisp_Object category;
-
- if (NILP (string))
- FETCH_CHAR_ADVANCE_NO_CHECK (c, pos, pos_byte);
- else
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte);
- category = CHAR_TABLE_REF (Vunicode_category_table, c);
+ c = (NILP (string)
+ ? fetch_char_advance_no_check (&pos, &pos_byte)
+ : fetch_string_char_advance_no_check (string, &pos, &pos_byte));
+ Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c);
if (FIXNUMP (category)
&& (XFIXNUM (category) == UNICODE_CATEGORY_Cf
|| CHAR_VARIATION_SELECTOR_P (c)))
@@ -4606,10 +4609,10 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
Lisp_Object window;
struct window *w;
- CHECK_FIXNUM_COERCE_MARKER (position);
- if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV))
+ EMACS_INT fixed_pos = fix_position (position);
+ if (! (BEGV <= fixed_pos && fixed_pos < ZV))
args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
- pos = XFIXNUM (position);
+ pos = fixed_pos;
pos_byte = CHAR_TO_BYTE (pos);
if (NILP (ch))
c = FETCH_CHAR (pos_byte);
@@ -4850,21 +4853,18 @@ If the font is not OpenType font, CAPABILITY is nil. */)
(Lisp_Object font_object)
{
struct font *font = CHECK_FONT_GET_OBJECT (font_object);
- Lisp_Object val = make_uninit_vector (9);
-
- ASET (val, 0, AREF (font_object, FONT_NAME_INDEX));
- ASET (val, 1, AREF (font_object, FONT_FILE_INDEX));
- ASET (val, 2, make_fixnum (font->pixel_size));
- ASET (val, 3, make_fixnum (font->max_width));
- ASET (val, 4, make_fixnum (font->ascent));
- ASET (val, 5, make_fixnum (font->descent));
- ASET (val, 6, make_fixnum (font->space_width));
- ASET (val, 7, make_fixnum (font->average_width));
- if (font->driver->otf_capability)
- ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font)));
- else
- ASET (val, 8, Qnil);
- return val;
+ return CALLN (Fvector,
+ AREF (font_object, FONT_NAME_INDEX),
+ AREF (font_object, FONT_FILE_INDEX),
+ make_fixnum (font->pixel_size),
+ make_fixnum (font->max_width),
+ make_fixnum (font->ascent),
+ make_fixnum (font->descent),
+ make_fixnum (font->space_width),
+ make_fixnum (font->average_width),
+ (font->driver->otf_capability
+ ? Fcons (Qopentype, font->driver->otf_capability (font))
+ : Qnil));
}
DEFUN ("font-get-glyphs", Ffont_get_glyphs, Sfont_get_glyphs, 3, 4, 0,
@@ -4891,8 +4891,8 @@ the corresponding element is nil. */)
Lisp_Object object)
{
struct font *font = CHECK_FONT_GET_OBJECT (font_object);
- ptrdiff_t i, len;
- Lisp_Object *chars, vec;
+ ptrdiff_t len;
+ Lisp_Object *chars;
USE_SAFE_ALLOCA;
if (NILP (object))
@@ -4906,10 +4906,9 @@ the corresponding element is nil. */)
SAFE_ALLOCA_LISP (chars, len);
charpos = XFIXNAT (from);
bytepos = CHAR_TO_BYTE (charpos);
- for (i = 0; charpos < XFIXNAT (to); i++)
+ for (ptrdiff_t i = 0; charpos < XFIXNAT (to); i++)
{
- int c;
- FETCH_CHAR_ADVANCE (c, charpos, bytepos);
+ int c = fetch_char_advance (&charpos, &bytepos);
chars[i] = make_fixnum (c);
}
}
@@ -4929,18 +4928,18 @@ the corresponding element is nil. */)
int c;
/* Skip IFROM characters from the beginning. */
- for (i = 0; i < ifrom; i++)
- c = STRING_CHAR_ADVANCE (p);
+ for (ptrdiff_t i = 0; i < ifrom; i++)
+ p += BYTES_BY_CHAR_HEAD (*p);
/* Now fetch an interesting characters. */
- for (i = 0; i < len; i++)
- {
- c = STRING_CHAR_ADVANCE (p);
- chars[i] = make_fixnum (c);
- }
+ for (ptrdiff_t i = 0; i < len; i++)
+ {
+ c = string_char_advance (&p);
+ chars[i] = make_fixnum (c);
+ }
}
else
- for (i = 0; i < len; i++)
+ for (ptrdiff_t i = 0; i < len; i++)
chars[i] = make_fixnum (p[ifrom + i]);
}
else if (VECTORP (object))
@@ -4951,7 +4950,7 @@ the corresponding element is nil. */)
if (ifrom == ito)
return Qnil;
len = ito - ifrom;
- for (i = 0; i < len; i++)
+ for (ptrdiff_t i = 0; i < len; i++)
{
Lisp_Object elt = AREF (object, ifrom + i);
CHECK_CHARACTER (elt);
@@ -4961,8 +4960,8 @@ the corresponding element is nil. */)
else
wrong_type_argument (Qarrayp, object);
- vec = make_uninit_vector (len);
- for (i = 0; i < len; i++)
+ Lisp_Object vec = make_nil_vector (len);
+ for (ptrdiff_t i = 0; i < len; i++)
{
Lisp_Object g;
int c = XFIXNAT (chars[i]);
@@ -5013,24 +5012,26 @@ character at index specified by POSITION. */)
(Lisp_Object position, Lisp_Object window, Lisp_Object string)
{
struct window *w = decode_live_window (window);
+ EMACS_INT pos;
if (NILP (string))
{
if (XBUFFER (w->contents) != current_buffer)
error ("Specified window is not displaying the current buffer");
- CHECK_FIXNUM_COERCE_MARKER (position);
- if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV))
+ pos = fix_position (position);
+ if (! (BEGV <= pos && pos < ZV))
args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
}
else
{
CHECK_FIXNUM (position);
CHECK_STRING (string);
- if (! (0 <= XFIXNUM (position) && XFIXNUM (position) < SCHARS (string)))
+ pos = XFIXNUM (position);
+ if (! (0 <= pos && pos < SCHARS (string)))
args_out_of_range (string, position);
}
- return font_at (-1, XFIXNUM (position), NULL, w, string);
+ return font_at (-1, pos, NULL, w, string);
}
#if 0
@@ -5170,24 +5171,23 @@ If the named font cannot be opened and loaded, return nil. */)
return Qnil;
font = XFONT_OBJECT (font_object);
- info = make_uninit_vector (14);
- ASET (info, 0, AREF (font_object, FONT_NAME_INDEX));
- ASET (info, 1, AREF (font_object, FONT_FULLNAME_INDEX));
- ASET (info, 2, make_fixnum (font->pixel_size));
- ASET (info, 3, make_fixnum (font->height));
- ASET (info, 4, make_fixnum (font->baseline_offset));
- ASET (info, 5, make_fixnum (font->relative_compose));
- ASET (info, 6, make_fixnum (font->default_ascent));
- ASET (info, 7, make_fixnum (font->max_width));
- ASET (info, 8, make_fixnum (font->ascent));
- ASET (info, 9, make_fixnum (font->descent));
- ASET (info, 10, make_fixnum (font->space_width));
- ASET (info, 11, make_fixnum (font->average_width));
- ASET (info, 12, AREF (font_object, FONT_FILE_INDEX));
- if (font->driver->otf_capability)
- ASET (info, 13, Fcons (Qopentype, font->driver->otf_capability (font)));
- else
- ASET (info, 13, Qnil);
+ info = CALLN (Fvector,
+ AREF (font_object, FONT_NAME_INDEX),
+ AREF (font_object, FONT_FULLNAME_INDEX),
+ make_fixnum (font->pixel_size),
+ make_fixnum (font->height),
+ make_fixnum (font->baseline_offset),
+ make_fixnum (font->relative_compose),
+ make_fixnum (font->default_ascent),
+ make_fixnum (font->max_width),
+ make_fixnum (font->ascent),
+ make_fixnum (font->descent),
+ make_fixnum (font->space_width),
+ make_fixnum (font->average_width),
+ AREF (font_object, FONT_FILE_INDEX),
+ (font->driver->otf_capability
+ ? Fcons (Qopentype, font->driver->otf_capability (font))
+ : Qnil));
#if 0
/* As font_object is still in FONT_OBJLIST of the entity, we can't
@@ -5205,7 +5205,7 @@ If the named font cannot be opened and loaded, return nil. */)
static Lisp_Object
build_style_table (const struct table_entry *entry, int nelement)
{
- Lisp_Object table = make_uninit_vector (nelement);
+ Lisp_Object table = make_nil_vector (nelement);
for (int i = 0; i < nelement; i++)
{
int j;
@@ -5496,10 +5496,8 @@ This variable cannot be set; trying to do so will signal an error. */);
make_symbol_constant (intern_c_string ("font-width-table"));
staticpro (&font_style_table);
- font_style_table = make_uninit_vector (3);
- ASET (font_style_table, 0, Vfont_weight_table);
- ASET (font_style_table, 1, Vfont_slant_table);
- ASET (font_style_table, 2, Vfont_width_table);
+ font_style_table = CALLN (Fvector, Vfont_weight_table, Vfont_slant_table,
+ Vfont_width_table);
DEFVAR_LISP ("font-log", Vfont_log, doc: /*
A list that logs font-related actions and results, for debugging.
@@ -5529,11 +5527,18 @@ footprint in sessions that use lots of different fonts. */);
#endif
DEFVAR_BOOL ("xft-ignore-color-fonts",
- Vxft_ignore_color_fonts,
+ xft_ignore_color_fonts,
doc: /*
Non-nil means don't query fontconfig for color fonts, since they often
cause Xft crashes. Only has an effect in Xft builds. */);
- Vxft_ignore_color_fonts = 1;
+ xft_ignore_color_fonts = true;
+
+ DEFVAR_BOOL ("query-all-font-backends", query_all_font_backends,
+ doc: /*
+If non-nil, attempt to query all available font backends.
+By default Emacs will stop searching for a matching font at the first
+match. */);
+ query_all_font_backends = false;
#ifdef HAVE_WINDOW_SYSTEM
#ifdef HAVE_FREETYPE
@@ -5543,7 +5548,6 @@ cause Xft crashes. Only has an effect in Xft builds. */);
#ifdef USE_CAIRO
syms_of_ftcrfont ();
#else
- syms_of_ftxfont ();
#ifdef HAVE_XFT
syms_of_xftfont ();
#endif /* HAVE_XFT */
diff --git a/src/font.h b/src/font.h
index 6f4792afe55..8614e7fa10a 100644
--- a/src/font.h
+++ b/src/font.h
@@ -69,8 +69,8 @@ INLINE_HEADER_BEGIN
enum font_property_index
{
- /* FONT-TYPE is a symbol indicating a font backend; currently `x',
- `xft', and `ftx' are available on X, `uniscribe' and `gdi' on
+ /* FONT-TYPE is a symbol indicating a font backend; currently `x'
+ and `xft' are available on X, `uniscribe' and `gdi' on
Windows, and `ns' under Cocoa / GNUstep. */
FONT_TYPE_INDEX,
@@ -938,7 +938,6 @@ extern void syms_of_ftfont (void);
extern struct font_driver const xfont_driver;
extern Lisp_Object xfont_get_cache (struct frame *);
extern void syms_of_xfont (void);
-extern void syms_of_ftxfont (void);
#ifdef HAVE_XFT
extern struct font_driver const xftfont_driver;
#ifdef HAVE_HARFBUZZ
@@ -946,7 +945,6 @@ extern struct font_driver xfthbfont_driver;
#endif /* HAVE_HARFBUZZ */
#endif
#if defined HAVE_FREETYPE || defined HAVE_XFT
-extern struct font_driver const ftxfont_driver;
extern void syms_of_xftfont (void);
#endif
#ifdef HAVE_BDFFONT
diff --git a/src/fontset.c b/src/fontset.c
index c2bb8b21f26..8c86075c07e 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -252,14 +252,13 @@ set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback)
#define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
-/* Macros for FONT-DEF and RFONT-DEF of fontset. */
-#define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \
- do { \
- (font_def) = make_uninit_vector (3); \
- ASET ((font_def), 0, font_spec); \
- ASET ((font_def), 1, encoding); \
- ASET ((font_def), 2, repertory); \
- } while (0)
+/* Definitions for FONT-DEF and RFONT-DEF of fontset. */
+static Lisp_Object
+font_def_new (Lisp_Object font_spec, Lisp_Object encoding,
+ Lisp_Object repertory)
+{
+ return CALLN (Fvector, font_spec, encoding, repertory);
+}
#define FONT_DEF_SPEC(font_def) AREF (font_def, 0)
#define FONT_DEF_ENCODING(font_def) AREF (font_def, 1)
@@ -1547,7 +1546,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
repertory = CHARSET_SYMBOL_ID (repertory);
}
}
- FONT_DEF_NEW (font_def, font_spec, encoding, repertory);
+ font_def = font_def_new (font_spec, encoding, repertory);
}
else
font_def = Qnil;
@@ -1619,14 +1618,8 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
if (charset)
{
- Lisp_Object arg;
-
- arg = make_uninit_vector (5);
- ASET (arg, 0, fontset);
- ASET (arg, 1, font_def);
- ASET (arg, 2, add);
- ASET (arg, 3, ascii_changed ? Qt : Qnil);
- ASET (arg, 4, range_list);
+ Lisp_Object arg = CALLN (Fvector, fontset, font_def, add,
+ ascii_changed ? Qt : Qnil, range_list);
map_charset_chars (set_fontset_font, Qnil, arg, charset,
CHARSET_MIN_CODE (charset),
diff --git a/src/frame.c b/src/frame.c
index 255606957c2..3f934504372 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -35,7 +35,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "buffer.h"
/* These help us bind and responding to switch-frame events. */
#include "keyboard.h"
-#include "ptr-bounds.h"
#include "frame.h"
#include "blockinput.h"
#include "termchar.h"
@@ -904,7 +903,7 @@ make_frame (bool mini_p)
f->last_tool_bar_item = -1;
#endif
#ifdef NS_IMPL_COCOA
- f->ns_appearance = ns_appearance_aqua;
+ f->ns_appearance = ns_appearance_system_default;
f->ns_transparent_titlebar = false;
#endif
#endif
@@ -2558,29 +2557,26 @@ before calling this function on it, like this.
(Lisp_Object frame, Lisp_Object x, Lisp_Object y)
{
CHECK_LIVE_FRAME (frame);
- CHECK_TYPE_RANGED_INTEGER (int, x);
- CHECK_TYPE_RANGED_INTEGER (int, y);
+ int xval = check_integer_range (x, INT_MIN, INT_MAX);
+ int yval = check_integer_range (y, INT_MIN, INT_MAX);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (XFRAME (frame)))
/* Warping the mouse will cause enternotify and focus events. */
- frame_set_mouse_position (XFRAME (frame), XFIXNUM (x), XFIXNUM (y));
-#else
-#if defined (MSDOS)
+ frame_set_mouse_position (XFRAME (frame), xval, yval);
+#elif defined MSDOS
if (FRAME_MSDOS_P (XFRAME (frame)))
{
Fselect_frame (frame, Qnil);
- mouse_moveto (XFIXNUM (x), XFIXNUM (y));
+ mouse_moveto (xval, yval);
}
+#elif defined HAVE_GPM
+ Fselect_frame (frame, Qnil);
+ term_mouse_moveto (xval, yval);
#else
-#ifdef HAVE_GPM
- {
- Fselect_frame (frame, Qnil);
- term_mouse_moveto (XFIXNUM (x), XFIXNUM (y));
- }
-#endif
-#endif
+ (void) xval;
+ (void) yval;
#endif
return Qnil;
@@ -2599,29 +2595,26 @@ before calling this function on it, like this.
(Lisp_Object frame, Lisp_Object x, Lisp_Object y)
{
CHECK_LIVE_FRAME (frame);
- CHECK_TYPE_RANGED_INTEGER (int, x);
- CHECK_TYPE_RANGED_INTEGER (int, y);
+ int xval = check_integer_range (x, INT_MIN, INT_MAX);
+ int yval = check_integer_range (y, INT_MIN, INT_MAX);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (XFRAME (frame)))
/* Warping the mouse will cause enternotify and focus events. */
- frame_set_mouse_pixel_position (XFRAME (frame), XFIXNUM (x), XFIXNUM (y));
-#else
-#if defined (MSDOS)
+ frame_set_mouse_pixel_position (XFRAME (frame), xval, yval);
+#elif defined MSDOS
if (FRAME_MSDOS_P (XFRAME (frame)))
{
Fselect_frame (frame, Qnil);
- mouse_moveto (XFIXNUM (x), XFIXNUM (y));
+ mouse_moveto (xval, yval);
}
+#elif defined HAVE_GPM
+ Fselect_frame (frame, Qnil);
+ term_mouse_moveto (xval, yval);
#else
-#ifdef HAVE_GPM
- {
- Fselect_frame (frame, Qnil);
- term_mouse_moveto (XFIXNUM (x), XFIXNUM (y));
- }
-#endif
-#endif
+ (void) xval;
+ (void) yval;
#endif
return Qnil;
@@ -3545,6 +3538,21 @@ DEFUN ("frame-bottom-divider-width", Fbottom_divider_width, Sbottom_divider_widt
return make_fixnum (FRAME_BOTTOM_DIVIDER_WIDTH (decode_any_frame (frame)));
}
+static int
+check_frame_pixels (Lisp_Object size, Lisp_Object pixelwise, int 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)
+ || 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))",
doc: /* Set text height of frame FRAME to HEIGHT lines.
@@ -3562,15 +3570,9 @@ currently selected frame will be set to this height. */)
(Lisp_Object frame, Lisp_Object height, Lisp_Object pretend, Lisp_Object pixelwise)
{
struct frame *f = decode_live_frame (frame);
- int pixel_height;
-
- CHECK_TYPE_RANGED_INTEGER (int, height);
-
- pixel_height = (!NILP (pixelwise)
- ? XFIXNUM (height)
- : XFIXNUM (height) * FRAME_LINE_HEIGHT (f));
+ int pixel_height = check_frame_pixels (height, pixelwise,
+ FRAME_LINE_HEIGHT (f));
adjust_frame_size (f, -1, pixel_height, 1, !NILP (pretend), Qheight);
-
return Qnil;
}
@@ -3591,15 +3593,9 @@ currently selected frame will be set to this width. */)
(Lisp_Object frame, Lisp_Object width, Lisp_Object pretend, Lisp_Object pixelwise)
{
struct frame *f = decode_live_frame (frame);
- int pixel_width;
-
- CHECK_TYPE_RANGED_INTEGER (int, width);
-
- pixel_width = (!NILP (pixelwise)
- ? XFIXNUM (width)
- : XFIXNUM (width) * FRAME_COLUMN_WIDTH (f));
+ int pixel_width = check_frame_pixels (width, pixelwise,
+ FRAME_COLUMN_WIDTH (f));
adjust_frame_size (f, pixel_width, -1, 1, !NILP (pretend), Qwidth);
-
return Qnil;
}
@@ -3613,19 +3609,11 @@ font height. */)
(Lisp_Object frame, Lisp_Object width, Lisp_Object height, Lisp_Object pixelwise)
{
struct frame *f = decode_live_frame (frame);
- int pixel_width, pixel_height;
-
- CHECK_TYPE_RANGED_INTEGER (int, width);
- CHECK_TYPE_RANGED_INTEGER (int, height);
-
- pixel_width = (!NILP (pixelwise)
- ? XFIXNUM (width)
- : XFIXNUM (width) * FRAME_COLUMN_WIDTH (f));
- pixel_height = (!NILP (pixelwise)
- ? XFIXNUM (height)
- : XFIXNUM (height) * FRAME_LINE_HEIGHT (f));
+ 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);
-
return Qnil;
}
@@ -3655,18 +3643,17 @@ bottom edge of FRAME's display. */)
(Lisp_Object frame, Lisp_Object x, Lisp_Object y)
{
struct frame *f = decode_live_frame (frame);
-
- CHECK_TYPE_RANGED_INTEGER (int, x);
- CHECK_TYPE_RANGED_INTEGER (int, y);
+ int xval = check_integer_range (x, INT_MIN, INT_MAX);
+ int yval = check_integer_range (y, INT_MIN, INT_MAX);
if (FRAME_WINDOW_P (f))
{
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_TERMINAL (f)->set_frame_offset_hook)
- FRAME_TERMINAL (f)->set_frame_offset_hook (f,
- XFIXNUM (x),
- XFIXNUM (y),
- 1);
+ FRAME_TERMINAL (f)->set_frame_offset_hook (f, xval, yval, 1);
+#else
+ (void) xval;
+ (void) yval;
#endif
}
@@ -4641,23 +4628,22 @@ gui_set_right_fringe (struct frame *f, Lisp_Object new_value, Lisp_Object old_va
void
gui_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
- CHECK_TYPE_RANGED_INTEGER (int, arg);
+ int border_width = check_integer_range (arg, INT_MIN, INT_MAX);
- if (XFIXNUM (arg) == f->border_width)
+ if (border_width == f->border_width)
return;
if (FRAME_NATIVE_WINDOW (f) != 0)
error ("Cannot change the border width of a frame");
- f->border_width = XFIXNUM (arg);
+ f->border_width = border_width;
}
void
gui_set_right_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
int old = FRAME_RIGHT_DIVIDER_WIDTH (f);
- CHECK_TYPE_RANGED_INTEGER (int, arg);
- int new = max (0, XFIXNUM (arg));
+ int new = check_int_nonnegative (arg);
if (new != old)
{
f->right_divider_width = new;
@@ -4671,8 +4657,7 @@ void
gui_set_bottom_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
int old = FRAME_BOTTOM_DIVIDER_WIDTH (f);
- CHECK_TYPE_RANGED_INTEGER (int, arg);
- int new = max (0, XFIXNUM (arg));
+ int new = check_int_nonnegative (arg);
if (new != old)
{
f->bottom_divider_width = new;
@@ -5030,8 +5015,6 @@ gui_display_get_resource (Display_Info *dpyinfo, Lisp_Object attribute,
USE_SAFE_ALLOCA;
char *name_key = SAFE_ALLOCA (name_keysize + class_keysize);
char *class_key = name_key + name_keysize;
- name_key = ptr_bounds_clip (name_key, name_keysize);
- class_key = ptr_bounds_clip (class_key, class_keysize);
/* Start with emacs.FRAMENAME for the name (the specific one)
and with `Emacs' for the class key (the general one). */
@@ -5102,9 +5085,6 @@ x_get_resource_string (const char *attribute, const char *class)
ptrdiff_t class_keysize = sizeof (EMACS_CLASS) - 1 + strlen (class) + 2;
char *name_key = SAFE_ALLOCA (name_keysize + class_keysize);
char *class_key = name_key + name_keysize;
- name_key = ptr_bounds_clip (name_key, name_keysize);
- class_key = ptr_bounds_clip (class_key, class_keysize);
-
esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
sprintf (class_key, "%s.%s", EMACS_CLASS, class);
@@ -5651,8 +5631,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p,
f->top_pos = 0;
else
{
- CHECK_TYPE_RANGED_INTEGER (int, top);
- f->top_pos = XFIXNUM (top);
+ f->top_pos = check_integer_range (top, INT_MIN, INT_MAX);
if (f->top_pos < 0)
window_prompting |= YNegative;
}
@@ -5682,8 +5661,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p,
f->left_pos = 0;
else
{
- CHECK_TYPE_RANGED_INTEGER (int, left);
- f->left_pos = XFIXNUM (left);
+ f->left_pos = check_integer_range (left, INT_MIN, INT_MAX);
if (f->left_pos < 0)
window_prompting |= XNegative;
}
diff --git a/src/frame.h b/src/frame.h
index a54b8623e50..476bac67faf 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -69,8 +69,9 @@ enum internal_border_part
#ifdef NS_IMPL_COCOA
enum ns_appearance_type
{
- ns_appearance_aqua,
- ns_appearance_vibrant_dark
+ ns_appearance_system_default,
+ ns_appearance_aqua,
+ ns_appearance_vibrant_dark
};
#endif
#endif /* HAVE_WINDOW_SYSTEM */
@@ -1449,6 +1450,49 @@ FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f)
{
return frame_dimension (f->bottom_divider_width);
}
+
+/* Return a non-null pointer to the cached face with ID on frame F. */
+
+INLINE struct face *
+FACE_FROM_ID (struct frame *f, int id)
+{
+ eassert (0 <= id && id < FRAME_FACE_CACHE (f)->used);
+ return FRAME_FACE_CACHE (f)->faces_by_id[id];
+}
+
+/* Return a pointer to the face with ID on frame F, or null if such a
+ face doesn't exist. */
+
+INLINE struct face *
+FACE_FROM_ID_OR_NULL (struct frame *f, int id)
+{
+ int used = FRAME_FACE_CACHE (f)->used;
+ eassume (0 <= used);
+ return 0 <= id && id < used ? FRAME_FACE_CACHE (f)->faces_by_id[id] : NULL;
+}
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* A non-null pointer to the image with id ID on frame F. */
+
+INLINE struct image *
+IMAGE_FROM_ID (struct frame *f, int id)
+{
+ eassert (0 <= id && id < FRAME_IMAGE_CACHE (f)->used);
+ return FRAME_IMAGE_CACHE (f)->images[id];
+}
+
+/* Value is a pointer to the image with id ID on frame F, or null if
+ no image with that id exists. */
+
+INLINE struct image *
+IMAGE_OPT_FROM_ID (struct frame *f, int id)
+{
+ int used = FRAME_IMAGE_CACHE (f)->used;
+ eassume (0 <= used);
+ return 0 <= id && id < used ? FRAME_IMAGE_CACHE (f)->images[id] : NULL;
+}
+#endif
/***********************************************************************
Conversion between canonical units and pixels
diff --git a/src/fringe.c b/src/fringe.c
index 2a46e3c34f2..75496692d53 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -23,7 +23,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "lisp.h"
#include "frame.h"
-#include "ptr-bounds.h"
#include "window.h"
#include "dispextern.h"
#include "buffer.h"
@@ -101,7 +100,7 @@ struct fringe_bitmap
...xx...
*/
static unsigned short question_mark_bits[] = {
- 0x3c, 0x7e, 0x7e, 0x0c, 0x18, 0x18, 0x00, 0x18, 0x18};
+ 0x3c, 0x7e, 0xc3, 0xc3, 0x0c, 0x18, 0x18, 0x00, 0x18, 0x18};
/* An exclamation mark. */
/*
@@ -117,7 +116,7 @@ static unsigned short question_mark_bits[] = {
...XX...
*/
static unsigned short exclamation_mark_bits[] = {
- 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x00, 0x18};
+ 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x00, 0x18, 0x18};
/* An arrow like this: `<-'. */
/*
@@ -1607,9 +1606,7 @@ If BITMAP already exists, the existing definition is replaced. */)
fb.dynamic = true;
xfb = xmalloc (sizeof fb + fb.height * BYTES_PER_BITMAP_ROW);
- fb.bits = b = ((unsigned short *)
- ptr_bounds_clip (xfb + 1, fb.height * BYTES_PER_BITMAP_ROW));
- xfb = ptr_bounds_clip (xfb, sizeof *xfb);
+ fb.bits = b = (unsigned short *) (xfb + 1);
j = 0;
while (j < fb.height)
@@ -1675,10 +1672,10 @@ Return nil if POS is not visible in WINDOW. */)
if (!NILP (pos))
{
- CHECK_FIXNUM_COERCE_MARKER (pos);
- if (! (BEGV <= XFIXNUM (pos) && XFIXNUM (pos) <= ZV))
+ EMACS_INT p = fix_position (pos);
+ if (! (BEGV <= p && p <= ZV))
args_out_of_range (window, pos);
- textpos = XFIXNUM (pos);
+ textpos = p;
}
else if (w == XWINDOW (selected_window))
textpos = PT;
@@ -1736,11 +1733,7 @@ If nil, also continue lines which are exactly as wide as the window. */);
void
mark_fringe_data (void)
{
- int i;
-
- for (i = 0; i < max_fringe_bitmaps; i++)
- if (!NILP (fringe_faces[i]))
- mark_object (fringe_faces[i]);
+ mark_objects (fringe_faces, max_fringe_bitmaps);
}
/* Initialize this module when Emacs starts. */
diff --git a/src/ftcrfont.c b/src/ftcrfont.c
index a0e18e13cfa..7832d4f5ce0 100644
--- a/src/ftcrfont.c
+++ b/src/ftcrfont.c
@@ -328,14 +328,13 @@ ftcrfont_encode_char (struct font *font, int c)
struct font_info *ftcrfont_info = (struct font_info *) font;
unsigned code = FONT_INVALID_CODE;
unsigned char utf8[MAX_MULTIBYTE_LENGTH];
- unsigned char *p = utf8;
+ int utf8len = CHAR_STRING (c, utf8);
cairo_glyph_t stack_glyph;
cairo_glyph_t *glyphs = &stack_glyph;
int num_glyphs = 1;
- CHAR_STRING_ADVANCE (c, p);
if (cairo_scaled_font_text_to_glyphs (ftcrfont_info->cr_scaled_font, 0, 0,
- (char *) utf8, p - utf8,
+ (char *) utf8, utf8len,
&glyphs, &num_glyphs,
NULL, NULL, NULL)
== CAIRO_STATUS_SUCCESS)
diff --git a/src/ftfont.c b/src/ftfont.c
index 6b549c3ddf2..6fca9c85093 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -346,18 +346,15 @@ struct ftfont_cache_data
static Lisp_Object
ftfont_lookup_cache (Lisp_Object key, enum ftfont_cache_for cache_for)
{
- Lisp_Object cache, val, entity;
+ Lisp_Object cache, val;
struct ftfont_cache_data *cache_data;
if (FONT_ENTITY_P (key))
{
- entity = key;
- val = assq_no_quit (QCfont_entity, AREF (entity, FONT_EXTRA_INDEX));
+ val = assq_no_quit (QCfont_entity, AREF (key, FONT_EXTRA_INDEX));
eassert (CONSP (val));
key = XCDR (val);
}
- else
- entity = Qnil;
if (NILP (ft_face_cache))
cache = Qnil;
@@ -771,7 +768,7 @@ ftfont_spec_pattern (Lisp_Object spec, char *otlayout, struct OpenTypeSpec **ots
#if defined HAVE_XFT && defined FC_COLOR
/* We really don't like color fonts, they cause Xft crashes. See
Bug#30874. */
- if (Vxft_ignore_color_fonts
+ if (xft_ignore_color_fonts
&& ! FcPatternAddBool (pattern, FC_COLOR, FcFalse))
goto err;
#endif
@@ -914,7 +911,7 @@ ftfont_list (struct frame *f, Lisp_Object spec)
returns them even when it shouldn't really do so, so we
need to manually skip them here (Bug#37786). */
FcBool b;
- if (Vxft_ignore_color_fonts
+ if (xft_ignore_color_fonts
&& FcPatternGetBool (fontset->fonts[i], FC_COLOR, 0, &b)
== FcResultMatch && b != FcFalse)
continue;
@@ -2829,14 +2826,10 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font,
LGLYPH_SET_ASCENT (lglyph, g->g.ascent >> 6);
LGLYPH_SET_DESCENT (lglyph, g->g.descent >> 6);
if (g->g.adjusted)
- {
- Lisp_Object vec = make_uninit_vector (3);
-
- ASET (vec, 0, make_fixnum (g->g.xoff >> 6));
- ASET (vec, 1, make_fixnum (g->g.yoff >> 6));
- ASET (vec, 2, make_fixnum (g->g.xadv >> 6));
- LGLYPH_SET_ADJUSTMENT (lglyph, vec);
- }
+ LGLYPH_SET_ADJUSTMENT (lglyph, CALLN (Fvector,
+ make_fixnum (g->g.xoff >> 6),
+ make_fixnum (g->g.yoff >> 6),
+ make_fixnum (g->g.xadv >> 6)));
}
return make_fixnum (i);
}
diff --git a/src/ftxfont.c b/src/ftxfont.c
deleted file mode 100644
index 9bbb2c064c2..00000000000
--- a/src/ftxfont.c
+++ /dev/null
@@ -1,371 +0,0 @@
-/* ftxfont.c -- FreeType font driver on X (without using XFT).
- Copyright (C) 2006-2020 Free Software Foundation, Inc.
- Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
- National Institute of Advanced Industrial Science and Technology (AIST)
- Registration Number H13PRO009
-
-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 <X11/Xlib.h>
-
-#include "lisp.h"
-#include "xterm.h"
-#include "frame.h"
-#include "blockinput.h"
-#include "font.h"
-#include "pdumper.h"
-
-/* FTX font driver. */
-
-struct ftxfont_frame_data
-{
- /* Background and foreground colors. */
- XColor colors[2];
- /* GCs interpolating the above colors. gcs[0] is for a color
- closest to BACKGROUND, and gcs[5] is for a color closest to
- FOREGROUND. */
- GC gcs[6];
- struct ftxfont_frame_data *next;
-};
-
-
-/* Return an array of 6 GCs for antialiasing. */
-
-static GC *
-ftxfont_get_gcs (struct frame *f, unsigned long foreground, unsigned long background)
-{
- XColor color;
- XGCValues xgcv;
- int i;
- struct ftxfont_frame_data *data = font_get_frame_data (f, Qftx);
- struct ftxfont_frame_data *prev = NULL, *this = NULL, *new;
-
- if (data)
- {
- for (this = data; this; prev = this, this = this->next)
- {
- if (this->colors[0].pixel < background)
- continue;
- if (this->colors[0].pixel > background)
- break;
- if (this->colors[1].pixel < foreground)
- continue;
- if (this->colors[1].pixel > foreground)
- break;
- return this->gcs;
- }
- }
-
- new = xmalloc (sizeof *new);
- new->next = this;
- if (prev)
- prev->next = new;
- font_put_frame_data (f, Qftx, new);
-
- new->colors[0].pixel = background;
- new->colors[1].pixel = foreground;
-
- block_input ();
- XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), new->colors, 2);
- for (i = 1; i < 7; i++)
- {
- /* Interpolate colors linearly. Any better algorithm? */
- color.red
- = (new->colors[1].red * i + new->colors[0].red * (8 - i)) / 8;
- color.green
- = (new->colors[1].green * i + new->colors[0].green * (8 - i)) / 8;
- color.blue
- = (new->colors[1].blue * i + new->colors[0].blue * (8 - i)) / 8;
- if (! x_alloc_nearest_color (f, FRAME_X_COLORMAP (f), &color))
- break;
- xgcv.foreground = color.pixel;
- new->gcs[i - 1] = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
- GCForeground, &xgcv);
- }
- unblock_input ();
-
- if (i < 7)
- {
- block_input ();
- for (i--; i >= 0; i--)
- XFreeGC (FRAME_X_DISPLAY (f), new->gcs[i]);
- unblock_input ();
- if (prev)
- prev->next = new->next;
- else if (data)
- font_put_frame_data (f, Qftx, new->next);
- xfree (new);
- return NULL;
- }
- return new->gcs;
-}
-
-static int
-ftxfont_draw_bitmap (struct frame *f, GC gc_fore, GC *gcs, struct font *font,
- unsigned int code, int x, int y, XPoint *p, int size,
- int *n, bool flush)
-{
- struct font_bitmap bitmap;
- unsigned char *b;
- int i, j;
-
- if (ftfont_get_bitmap (font, code, &bitmap, size > 0x100 ? 1 : 8) < 0)
- return 0;
- if (size > 0x100)
- {
- for (i = 0, b = bitmap.buffer; i < bitmap.rows;
- i++, b += bitmap.pitch)
- {
- for (j = 0; j < bitmap.width; j++)
- if (b[j / 8] & (1 << (7 - (j % 8))))
- {
- p[n[0]].x = x + bitmap.left + j;
- p[n[0]].y = y - bitmap.top + i;
- if (++n[0] == size)
- {
- XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
- gc_fore, p, size, CoordModeOrigin);
- n[0] = 0;
- }
- }
- }
- if (flush && n[0] > 0)
- XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
- gc_fore, p, n[0], CoordModeOrigin);
- }
- else
- {
- for (i = 0, b = bitmap.buffer; i < bitmap.rows;
- i++, b += bitmap.pitch)
- {
- for (j = 0; j < bitmap.width; j++)
- {
- int idx = (bitmap.bits_per_pixel == 1
- ? ((b[j / 8] & (1 << (7 - (j % 8)))) ? 6 : -1)
- : (b[j] >> 5) - 1);
-
- if (idx >= 0)
- {
- XPoint *pp = p + size * idx;
-
- pp[n[idx]].x = x + bitmap.left + j;
- pp[n[idx]].y = y - bitmap.top + i;
- if (++(n[idx]) == size)
- {
- XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
- idx == 6 ? gc_fore : gcs[idx], pp, size,
- CoordModeOrigin);
- n[idx] = 0;
- }
- }
- }
- }
- if (flush)
- {
- for (i = 0; i < 6; i++)
- if (n[i] > 0)
- XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
- gcs[i], p + 0x100 * i, n[i], CoordModeOrigin);
- if (n[6] > 0)
- XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
- gc_fore, p + 0x600, n[6], CoordModeOrigin);
- }
- }
-
- /* There is no ftfont_free_bitmap, so do not try to free BITMAP. */
-
- return bitmap.advance;
-}
-
-static void
-ftxfont_draw_background (struct frame *f, struct font *font, GC gc, int x, int y,
- int width)
-{
- XGCValues xgcv;
-
- XGetGCValues (FRAME_X_DISPLAY (f), gc,
- GCForeground | GCBackground, &xgcv);
- XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.background);
- XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), gc,
- x, y - FONT_BASE (font), width, FONT_HEIGHT (font));
- XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.foreground);
-}
-
-static Lisp_Object
-ftxfont_list (struct frame *f, Lisp_Object spec)
-{
- return ftfont_list2 (f, spec, Qftx);
-}
-
-static Lisp_Object
-ftxfont_match (struct frame *f, Lisp_Object spec)
-{
- return ftfont_match2 (f, spec, Qftx);
-}
-
-static Lisp_Object
-ftxfont_open (struct frame *f, Lisp_Object entity, int pixel_size)
-{
- Lisp_Object font_object = ftfont_open (f, entity, pixel_size);
- if (NILP (font_object))
- return Qnil;
- struct font *font = XFONT_OBJECT (font_object);
- font->driver = &ftxfont_driver;
- return font_object;
-}
-
-static void
-ftxfont_close (struct font *font)
-{
- ftfont_close (font);
-}
-
-static int
-ftxfont_draw (struct glyph_string *s, int from, int to, int x, int y,
- bool with_background)
-{
- struct frame *f = s->f;
- struct face *face = s->face;
- struct font *font = s->font;
- XPoint p[0x700];
- int n[7];
- unsigned *code = s->char2b + from;
- int len = to - from;
- int i;
- GC *gcs;
- int xadvance;
-
- n[0] = n[1] = n[2] = n[3] = n[4] = n[5] = n[6] = 0;
-
- block_input ();
- if (with_background)
- ftxfont_draw_background (f, font, s->gc, x, y, s->width);
-
- if (face->gc == s->gc)
- {
- gcs = ftxfont_get_gcs (f, face->foreground, face->background);
- }
- else
- {
- XGCValues xgcv;
- unsigned long mask = GCForeground | GCBackground;
-
- XGetGCValues (FRAME_X_DISPLAY (f), s->gc, mask, &xgcv);
- gcs = ftxfont_get_gcs (f, xgcv.foreground, xgcv.background);
- }
-
- if (gcs)
- {
- if (s->num_clips)
- for (i = 0; i < 6; i++)
- XSetClipRectangles (FRAME_X_DISPLAY (f), gcs[i], 0, 0,
- s->clip, s->num_clips, Unsorted);
-
- for (i = 0; i < len; i++)
- {
- xadvance = ftxfont_draw_bitmap (f, s->gc, gcs, font, code[i], x, y,
- p, 0x100, n, i + 1 == len);
- x += (s->padding_p ? 1 : xadvance);
- }
- if (s->num_clips)
- for (i = 0; i < 6; i++)
- XSetClipMask (FRAME_X_DISPLAY (f), gcs[i], None);
- }
- else
- {
- /* We can't draw with antialiasing.
- s->gc should already have a proper clipping setting. */
- for (i = 0; i < len; i++)
- {
- xadvance = ftxfont_draw_bitmap (f, s->gc, NULL, font, code[i], x, y,
- p, 0x700, n, i + 1 == len);
- x += (s->padding_p ? 1 : xadvance);
- }
- }
-
- unblock_input ();
-
- return len;
-}
-
-static int
-ftxfont_end_for_frame (struct frame *f)
-{
- struct ftxfont_frame_data *data = font_get_frame_data (f, Qftx);
-
- block_input ();
- while (data)
- {
- struct ftxfont_frame_data *next = data->next;
- int i;
-
- for (i = 0; i < 6; i++)
- XFreeGC (FRAME_X_DISPLAY (f), data->gcs[i]);
- xfree (data);
- data = next;
- }
- unblock_input ();
- font_put_frame_data (f, Qftx, NULL);
- return 0;
-}
-
-
-
-static void syms_of_ftxfont_for_pdumper (void);
-
-struct font_driver const ftxfont_driver =
- {
- /* We can't draw a text without device dependent functions. */
- .type = LISPSYM_INITIALLY (Qftx),
- .get_cache = ftfont_get_cache,
- .list = ftxfont_list,
- .match = ftxfont_match,
- .list_family = ftfont_list_family,
- .open_font = ftxfont_open,
- .close_font = ftxfont_close,
- .has_char = ftfont_has_char,
- .encode_char = ftfont_encode_char,
- .text_extents = ftfont_text_extents,
- .draw = ftxfont_draw,
- .get_bitmap = ftfont_get_bitmap,
- .anchor_point = ftfont_anchor_point,
-#ifdef HAVE_LIBOTF
- .otf_capability = ftfont_otf_capability,
-#endif
- .end_for_frame = ftxfont_end_for_frame,
-#if defined HAVE_M17N_FLT && defined HAVE_LIBOTF
- .shape = ftfont_shape,
-#endif
-#if defined HAVE_OTF_GET_VARIATION_GLYPHS || defined HAVE_FT_FACE_GETCHARVARIANTINDEX
- .get_variation_glyphs = ftfont_variation_glyphs,
-#endif
- .filter_properties = ftfont_filter_properties,
- .combining_capability = ftfont_combining_capability,
- };
-
-void
-syms_of_ftxfont (void)
-{
- DEFSYM (Qftx, "ftx");
- pdumper_do_now_and_after_load (syms_of_ftxfont_for_pdumper);
-}
-
-static void
-syms_of_ftxfont_for_pdumper (void)
-{
- register_font_driver (&ftxfont_driver, NULL);
-}
diff --git a/src/gmalloc.c b/src/gmalloc.c
index 8450a639e77..3560c744539 100644
--- a/src/gmalloc.c
+++ b/src/gmalloc.c
@@ -38,8 +38,6 @@ License along with this library. If not, see <https://www.gnu.org/licenses/>.
#include "lisp.h"
-#include "ptr-bounds.h"
-
#ifdef HAVE_MALLOC_H
# if GNUC_PREREQ (4, 2, 0)
# pragma GCC diagnostic ignored "-Wdeprecated-declarations"
@@ -200,8 +198,7 @@ extern size_t _bytes_free;
/* Internal versions of `malloc', `realloc', and `free'
used when these functions need to call each other.
- They are the same but don't call the hooks
- and don't bound the resulting pointers. */
+ They are the same but don't call the hooks. */
extern void *_malloc_internal (size_t);
extern void *_realloc_internal (void *, size_t);
extern void _free_internal (void *);
@@ -551,7 +548,7 @@ malloc_initialize_1 (void)
_heapinfo[0].free.size = 0;
_heapinfo[0].free.next = _heapinfo[0].free.prev = 0;
_heapindex = 0;
- _heapbase = (char *) ptr_bounds_init (_heapinfo);
+ _heapbase = (char *) _heapinfo;
_heaplimit = BLOCK (_heapbase + heapsize * sizeof (malloc_info));
register_heapinfo ();
@@ -912,8 +909,7 @@ malloc (size_t size)
among multiple threads. We just leave it for compatibility with
glibc malloc (i.e., assignments to gmalloc_hook) for now. */
hook = gmalloc_hook;
- void *result = (hook ? hook : _malloc_internal) (size);
- return ptr_bounds_clip (result, size);
+ return (hook ? hook : _malloc_internal) (size);
}
#if !(defined (_LIBC) || defined (HYBRID_MALLOC))
@@ -991,7 +987,6 @@ _free_internal_nolock (void *ptr)
if (ptr == NULL)
return;
- ptr = ptr_bounds_init (ptr);
PROTECT_MALLOC_STATE (0);
@@ -1303,7 +1298,6 @@ _realloc_internal_nolock (void *ptr, size_t size)
else if (ptr == NULL)
return _malloc_internal_nolock (size);
- ptr = ptr_bounds_init (ptr);
block = BLOCK (ptr);
PROTECT_MALLOC_STATE (0);
@@ -1426,8 +1420,7 @@ realloc (void *ptr, size_t size)
return NULL;
hook = grealloc_hook;
- void *result = (hook ? hook : _realloc_internal) (ptr, size);
- return ptr_bounds_clip (result, size);
+ return (hook ? hook : _realloc_internal) (ptr, size);
}
/* Copyright (C) 1991, 1992, 1994 Free Software Foundation, Inc.
@@ -1601,7 +1594,6 @@ aligned_alloc (size_t alignment, size_t size)
{
l->exact = result;
result = l->aligned = (char *) result + adj;
- result = ptr_bounds_clip (result, size);
}
UNLOCK_ALIGNED_BLOCKS ();
if (l == NULL)
diff --git a/src/gnutls.c b/src/gnutls.c
index 70176c41cdd..0010553a9d4 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -230,7 +230,6 @@ DEF_DLL_FN (const char *, gnutls_compression_get_name,
DEF_DLL_FN (unsigned, gnutls_safe_renegotiation_status, (gnutls_session_t));
# ifdef HAVE_GNUTLS3
-DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t));
DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void));
# ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t));
@@ -381,7 +380,6 @@ init_gnutls_functions (void)
# endif
LOAD_DLL_FN (library, gnutls_safe_renegotiation_status);
# ifdef HAVE_GNUTLS3
- LOAD_DLL_FN (library, gnutls_rnd);
LOAD_DLL_FN (library, gnutls_mac_list);
# ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
LOAD_DLL_FN (library, gnutls_mac_get_nonce_size);
@@ -519,7 +517,6 @@ init_gnutls_functions (void)
# define gnutls_x509_crt_import fn_gnutls_x509_crt_import
# define gnutls_x509_crt_init fn_gnutls_x509_crt_init
# ifdef HAVE_GNUTLS3
-# define gnutls_rnd fn_gnutls_rnd
# define gnutls_mac_list fn_gnutls_mac_list
# ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size
@@ -573,14 +570,6 @@ init_gnutls_functions (void)
# undef gnutls_free
# define gnutls_free (*gnutls_free_func)
-/* This wrapper is called from fns.c, which doesn't know about the
- LOAD_DLL_FN stuff above. */
-int
-w32_gnutls_rnd (gnutls_rnd_level_t level, void *data, size_t len)
-{
- return gnutls_rnd (level, data, len);
-}
-
# endif /* WINDOWSNT */
@@ -2309,6 +2298,8 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca,
# endif
}
+static Lisp_Object cipher_cache;
+
static Lisp_Object
gnutls_symmetric (bool encrypting, Lisp_Object cipher,
Lisp_Object key, Lisp_Object iv,
@@ -2340,7 +2331,9 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher,
if (SYMBOLP (cipher))
{
- info = Fassq (cipher, Fgnutls_ciphers ());
+ if (NILP (cipher_cache))
+ cipher_cache = Fgnutls_ciphers ();
+ info = Fassq (cipher, cipher_cache);
if (!CONSP (info))
xsignal2 (Qerror,
build_string ("GnuTLS cipher is invalid or not found"),
@@ -2925,6 +2918,9 @@ level in the ones. For builds without libgnutls, the value is -1. */);
defsubr (&Sgnutls_hash_digest);
defsubr (&Sgnutls_symmetric_encrypt);
defsubr (&Sgnutls_symmetric_decrypt);
+
+ cipher_cache = Qnil;
+ staticpro (&cipher_cache);
#endif
DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level,
diff --git a/src/gtkutil.c b/src/gtkutil.c
index df537c515a2..fafd94c0f71 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -1411,10 +1411,15 @@ xg_free_frame_widgets (struct frame *f)
FRAME_X_WINDOW (f) = 0; /* Set to avoid XDestroyWindow in xterm.c */
FRAME_X_RAW_DRAWABLE (f) = 0;
FRAME_GTK_OUTER_WIDGET (f) = 0;
+ if (x->ttip_widget)
+ {
+ /* Remove ttip_lbl from ttip_widget's custom slot before
+ destroying it, to avoid double-free (Bug#41239). */
+ gtk_tooltip_set_custom (x->ttip_widget, NULL);
+ g_object_unref (G_OBJECT (x->ttip_widget));
+ }
if (x->ttip_lbl)
gtk_widget_destroy (x->ttip_lbl);
- if (x->ttip_widget)
- g_object_unref (G_OBJECT (x->ttip_widget));
}
}
@@ -4436,13 +4441,6 @@ xg_tool_bar_callback (GtkWidget *w, gpointer client_data)
key = AREF (f->tool_bar_items, idx + TOOL_BAR_ITEM_KEY);
XSETFRAME (frame, f);
- /* We generate two events here. The first one is to set the prefix
- to `(tool_bar)', see keyboard.c. */
- event.kind = TOOL_BAR_EVENT;
- event.frame_or_window = frame;
- event.arg = frame;
- kbd_buffer_store_event (&event);
-
event.kind = TOOL_BAR_EVENT;
event.frame_or_window = frame;
event.arg = key;
@@ -5115,7 +5113,7 @@ update_frame_tool_bar (struct frame *f)
else
idx = -1;
- img_id = lookup_image (f, image);
+ img_id = lookup_image (f, image, -1);
img = IMAGE_FROM_ID (f, img_id);
prepare_image_for_display (f, img);
diff --git a/src/hbfont.c b/src/hbfont.c
index 4b3f64ef504..82b115e6868 100644
--- a/src/hbfont.c
+++ b/src/hbfont.c
@@ -594,13 +594,10 @@ hbfont_shape (Lisp_Object lgstring, Lisp_Object direction)
yoff = - lround (pos[i].y_offset * position_unit);
wadjust = lround (pos[i].x_advance * position_unit);
if (xoff || yoff || wadjust != metrics.width)
- {
- Lisp_Object vec = make_uninit_vector (3);
- ASET (vec, 0, make_fixnum (xoff));
- ASET (vec, 1, make_fixnum (yoff));
- ASET (vec, 2, make_fixnum (wadjust));
- LGLYPH_SET_ADJUSTMENT (lglyph, vec);
- }
+ LGLYPH_SET_ADJUSTMENT (lglyph, CALLN (Fvector,
+ make_fixnum (xoff),
+ make_fixnum (yoff),
+ make_fixnum (wadjust)));
}
return make_fixnum (glyph_len);
diff --git a/src/image.c b/src/image.c
index 956fb1325ed..6ecf6a70fe2 100644
--- a/src/image.c
+++ b/src/image.c
@@ -24,7 +24,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Include this before including <setjmp.h> to work around bugs with
older libpng; see Bug#17429. */
-#if defined HAVE_PNG && !defined HAVE_NS
+#if defined HAVE_PNG
# include <png.h>
#endif
@@ -125,6 +125,7 @@ typedef struct ns_bitmap_record Bitmap_Record;
#define NO_PIXMAP 0
#define PIX_MASK_RETAIN 0
+#define PIX_MASK_DRAW 1
#endif /* HAVE_NS */
@@ -258,6 +259,8 @@ cr_put_image_to_cr_data (struct image *img)
cairo_matrix_t matrix;
cairo_pattern_get_matrix (img->cr_data, &matrix);
cairo_pattern_set_matrix (pattern, &matrix);
+ cairo_pattern_set_filter
+ (pattern, cairo_pattern_get_filter (img->cr_data));
cairo_pattern_destroy (img->cr_data);
}
cairo_surface_destroy (surface);
@@ -755,10 +758,10 @@ struct image_type
/* Load IMG which is used on frame F from information contained in
IMG->spec. Value is true if successful. */
- bool (*load) (struct frame *f, struct image *img);
+ bool (*load_img) (struct frame *f, struct image *img);
/* Free resources of image IMG which is used on frame F. */
- void (*free) (struct frame *f, struct image *img);
+ void (*free_img) (struct frame *f, struct image *img);
#ifdef WINDOWSNT
/* Initialization function (used for dynamic loading of image
@@ -800,23 +803,28 @@ valid_image_p (Lisp_Object object)
{
Lisp_Object tail = XCDR (object);
FOR_EACH_TAIL_SAFE (tail)
- if (EQ (XCAR (tail), QCtype))
- {
- tail = XCDR (tail);
- if (CONSP (tail))
- {
- struct image_type const *type = lookup_image_type (XCAR (tail));
- if (type)
- return type->valid_p (object);
- }
- break;
- }
+ {
+ if (EQ (XCAR (tail), QCtype))
+ {
+ tail = XCDR (tail);
+ if (CONSP (tail))
+ {
+ struct image_type const *type =
+ lookup_image_type (XCAR (tail));
+ if (type)
+ return type->valid_p (object);
+ }
+ break;
+ }
+ tail = XCDR (tail);
+ if (! CONSP (tail))
+ return false;
+ }
}
return false;
}
-
/* Log error message with format string FORMAT and trailing arguments.
Signaling an error, e.g. when an image cannot be loaded, is not a
good idea because this would interrupt redisplay, and the error
@@ -897,7 +905,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
return false;
plist = XCDR (spec);
- while (CONSP (plist))
+ FOR_EACH_TAIL_SAFE (plist)
{
Lisp_Object key, value;
@@ -911,7 +919,6 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
if (!CONSP (plist))
return false;
value = XCAR (plist);
- plist = XCDR (plist);
/* Find key in KEYWORDS. Error if not found. */
for (i = 0; i < nkeywords; ++i)
@@ -919,7 +926,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
break;
if (i == nkeywords)
- continue;
+ goto maybe_done;
/* Record that we recognized the keyword. If a keyword
was found more than once, it's an error. */
@@ -1004,16 +1011,23 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
break;
}
- if (EQ (key, QCtype) && !EQ (type, value))
+ if (EQ (key, QCtype)
+ && !(EQ (type, value) || EQ (type, Qnative_image)))
return false;
- }
- /* Check that all mandatory fields are present. */
- for (i = 0; i < nkeywords; ++i)
- if (keywords[i].count < keywords[i].mandatory_p)
- return false;
+ maybe_done:
+ if (EQ (XCDR (plist), Qnil))
+ {
+ /* Check that all mandatory fields are present. */
+ for (i = 0; i < nkeywords; ++i)
+ if (keywords[i].mandatory_p && keywords[i].count == 0)
+ return false;
+
+ return true;
+ }
+ }
- return NILP (plist);
+ return false;
}
@@ -1028,9 +1042,8 @@ image_spec_value (Lisp_Object spec, Lisp_Object key, bool *found)
eassert (valid_image_p (spec));
- for (tail = XCDR (spec);
- CONSP (tail) && CONSP (XCDR (tail));
- tail = XCDR (XCDR (tail)))
+ tail = XCDR (spec);
+ FOR_EACH_TAIL_SAFE (tail)
{
if (EQ (XCAR (tail), key))
{
@@ -1038,6 +1051,9 @@ image_spec_value (Lisp_Object spec, Lisp_Object key, bool *found)
*found = 1;
return XCAR (XCDR (tail));
}
+ tail = XCDR (tail);
+ if (! CONSP (tail))
+ break;
}
if (found)
@@ -1065,7 +1081,7 @@ calling this function. */)
if (valid_image_p (spec))
{
struct frame *f = decode_window_system_frame (frame);
- ptrdiff_t id = lookup_image (f, spec);
+ ptrdiff_t id = lookup_image (f, spec, -1);
struct image *img = IMAGE_FROM_ID (f, id);
int width = img->width + 2 * img->hmargin;
int height = img->height + 2 * img->vmargin;
@@ -1095,7 +1111,7 @@ or omitted means use the selected frame. */)
if (valid_image_p (spec))
{
struct frame *f = decode_window_system_frame (frame);
- ptrdiff_t id = lookup_image (f, spec);
+ ptrdiff_t id = lookup_image (f, spec, -1);
struct image *img = IMAGE_FROM_ID (f, id);
if (img->mask)
mask = Qt;
@@ -1118,7 +1134,7 @@ or omitted means use the selected frame. */)
if (valid_image_p (spec))
{
struct frame *f = decode_window_system_frame (frame);
- ptrdiff_t id = lookup_image (f, spec);
+ ptrdiff_t id = lookup_image (f, spec, -1);
struct image *img = IMAGE_FROM_ID (f, id);
ext = img->lisp_data;
}
@@ -1181,13 +1197,8 @@ free_image (struct frame *f, struct image *img)
XRenderFreePicture (FRAME_X_DISPLAY (f), img->mask_picture);
#endif
- /* Windows NT redefines 'free', but in this file, we need to
- avoid the redefinition. */
-#ifdef WINDOWSNT
-#undef free
-#endif
/* Free resources, then free IMG. */
- img->type->free (f, img);
+ img->type->free_img (f, img);
xfree (img);
}
}
@@ -1233,7 +1244,7 @@ prepare_image_for_display (struct frame *f, struct image *img)
/* If IMG doesn't have a pixmap yet, load it now, using the image
type dependent loader function. */
if (img->pixmap == NO_PIXMAP && !img->load_failed_p)
- img->load_failed_p = ! img->type->load (f, img);
+ img->load_failed_p = ! img->type->load_img (f, img);
#ifdef USE_CAIRO
if (!img->load_failed_p)
@@ -1250,7 +1261,7 @@ prepare_image_for_display (struct frame *f, struct image *img)
if (img->cr_data == NULL)
{
img->load_failed_p = 1;
- img->type->free (f, img);
+ img->type->free_img (f, img);
}
}
unblock_input ();
@@ -1581,11 +1592,23 @@ make_image_cache (void)
return c;
}
+/* Compare two lists (one of which must be proper), comparing each
+ element with `eq'. */
+static bool
+equal_lists (Lisp_Object a, Lisp_Object b)
+{
+ while (CONSP (a) && CONSP (b) && EQ (XCAR (a), XCAR (b)))
+ a = XCDR (a), b = XCDR (b);
+
+ return EQ (a, b);
+}
/* Find an image matching SPEC in the cache, and return it. If no
image is found, return NULL. */
static struct image *
-search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash)
+search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash,
+ unsigned long foreground, unsigned long background,
+ bool ignore_colors)
{
struct image *img;
struct image_cache *c = FRAME_IMAGE_CACHE (f);
@@ -1607,9 +1630,9 @@ search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash)
for (img = c->buckets[i]; img; img = img->next)
if (img->hash == hash
- && !NILP (Fequal (img->spec, spec))
- && img->frame_foreground == FRAME_FOREGROUND_PIXEL (f)
- && img->frame_background == FRAME_BACKGROUND_PIXEL (f))
+ && equal_lists (img->spec, spec)
+ && (ignore_colors || (img->face_foreground == foreground
+ && img->face_background == background)))
break;
return img;
}
@@ -1620,8 +1643,13 @@ search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash)
static void
uncache_image (struct frame *f, Lisp_Object spec)
{
- struct image *img = search_image_cache (f, spec, sxhash (spec, 0));
- if (img)
+ struct image *img;
+
+ /* Because the background colors are based on the current face, we
+ can have multiple copies of an image with the same spec. We want
+ to remove them all to ensure the user doesn't see an old version
+ of the image when the face changes. */
+ while ((img = search_image_cache (f, spec, sxhash (spec), 0, 0, true)))
{
free_image (f, img);
/* As display glyphs may still be referring to the image ID, we
@@ -2107,12 +2135,31 @@ image_set_transform (struct frame *f, struct image *img)
/* Determine size. */
int width, height;
- compute_image_size (img->width, img->height, img->spec, &width, &height);
+
+#ifdef HAVE_RSVG
+ /* SVGs are pre-scaled to the correct size. */
+ if (EQ (image_spec_value (img->spec, QCtype, NULL), Qsvg))
+ {
+ width = img->width;
+ height = img->height;
+ }
+ else
+#endif
+ compute_image_size (img->width, img->height, img->spec, &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
+ 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);
+# endif
+
/* Perform scale transformation. */
matrix3x3 matrix
@@ -2224,11 +2271,14 @@ 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);
# 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_FILTER_BEST : CAIRO_FILTER_NEAREST);
/* Dummy solid color pattern just to record pattern matrix. */
img->cr_data = pattern;
# elif defined (HAVE_XRENDER)
@@ -2245,14 +2295,14 @@ image_set_transform (struct frame *f, struct image *img)
XDoubleToFixed (matrix[1][2]),
XDoubleToFixed (matrix[2][2])}}};
- XRenderSetPictureFilter (FRAME_X_DISPLAY (f), img->picture, FilterBest,
- 0, 0);
+ XRenderSetPictureFilter (FRAME_X_DISPLAY (f), img->picture,
+ scale_down ? FilterBest : FilterNearest, 0, 0);
XRenderSetPictureTransform (FRAME_X_DISPLAY (f), img->picture, &tmat);
if (img->mask_picture)
{
XRenderSetPictureFilter (FRAME_X_DISPLAY (f), img->mask_picture,
- FilterBest, 0, 0);
+ scale_down ? FilterBest : FilterNearest, 0, 0);
XRenderSetPictureTransform (FRAME_X_DISPLAY (f), img->mask_picture,
&tmat);
}
@@ -2274,19 +2324,24 @@ image_set_transform (struct frame *f, struct image *img)
SPEC must be a valid Lisp image specification (see valid_image_p). */
ptrdiff_t
-lookup_image (struct frame *f, Lisp_Object spec)
+lookup_image (struct frame *f, Lisp_Object spec, int face_id)
{
struct image *img;
EMACS_UINT hash;
+ struct face *face = (face_id >= 0) ? FACE_FROM_ID (f, face_id)
+ : FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ unsigned long foreground = FACE_COLOR_TO_PIXEL (face->foreground, f);
+ unsigned long background = FACE_COLOR_TO_PIXEL (face->background, f);
+
/* F must be a window-system frame, and SPEC must be a valid image
specification. */
eassert (FRAME_WINDOW_P (f));
eassert (valid_image_p (spec));
/* Look up SPEC in the hash table of the image cache. */
- hash = sxhash (spec, 0);
- img = search_image_cache (f, spec, hash);
+ hash = sxhash (spec);
+ img = search_image_cache (f, spec, hash, foreground, background, true);
if (img && img->load_failed_p)
{
free_image (f, img);
@@ -2299,9 +2354,9 @@ lookup_image (struct frame *f, Lisp_Object spec)
block_input ();
img = make_image (spec, hash);
cache_image (f, img);
- img->load_failed_p = ! img->type->load (f, img);
- img->frame_foreground = FRAME_FOREGROUND_PIXEL (f);
- img->frame_background = FRAME_BACKGROUND_PIXEL (f);
+ img->face_foreground = foreground;
+ img->face_background = background;
+ 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
height, use some arbitrary width and height so that we can
@@ -2355,8 +2410,7 @@ lookup_image (struct frame *f, Lisp_Object spec)
if (!NILP (bg))
{
img->background
- = image_alloc_image_color (f, img, bg,
- FRAME_BACKGROUND_PIXEL (f));
+ = image_alloc_image_color (f, img, bg, background);
img->background_valid = 1;
}
}
@@ -3629,8 +3683,8 @@ xbm_load_image (struct frame *f, struct image *img, char *contents, char *end)
&data, 0);
if (rc)
{
- unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
- unsigned long background = FRAME_BACKGROUND_PIXEL (f);
+ unsigned long foreground = img->face_foreground;
+ unsigned long background = img->face_background;
bool non_default_colors = 0;
Lisp_Object value;
@@ -3726,8 +3780,8 @@ xbm_load (struct frame *f, struct image *img)
{
struct image_keyword fmt[XBM_LAST];
Lisp_Object data;
- unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
- unsigned long background = FRAME_BACKGROUND_PIXEL (f);
+ unsigned long foreground = img->face_foreground;
+ unsigned long background = img->face_background;
bool non_default_colors = 0;
char *bits;
bool parsed_p;
@@ -4572,8 +4626,9 @@ xpm_scan (const char **s, const char *end, const char **beg, ptrdiff_t *len)
while (*s < end)
{
/* Skip white-space. */
- while (*s < end && (c = *(*s)++, c_isspace (c)))
- ;
+ do
+ c = *(*s)++;
+ while (c_isspace (c) && *s < end);
/* gnus-pointer.xpm uses '-' in its identifier.
sb-dir-plus.xpm uses '+' in its identifier. */
@@ -6086,8 +6141,8 @@ pbm_load (struct frame *f, struct image *img)
unsigned char c = 0;
int g;
struct image_keyword fmt[PBM_LAST];
- unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
- unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
+ unsigned long fg = img->face_foreground;
+ unsigned long bg = img->face_background;
/* Parse the image specification. */
memcpy (fmt, pbm_format, sizeof fmt);
parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
@@ -6232,10 +6287,104 @@ pbm_load (struct frame *f, struct image *img)
/***********************************************************************
+ NATIVE IMAGE HANDLING
+ ***********************************************************************/
+
+#if HAVE_NATIVE_IMAGE_API
+static bool
+image_can_use_native_api (Lisp_Object type)
+{
+# ifdef HAVE_NTGUI
+ return w32_can_use_native_image_api (type);
+# elif defined HAVE_NS
+ return ns_can_use_native_image_api (type);
+# else
+ return false;
+# endif
+}
+
+/*
+ * These functions are actually defined in the OS-native implementation
+ * file. Currently, for Windows GDI+ interface, w32image.c, but other
+ * operating systems can follow suit.
+ */
+
+/* Indices of image specification fields in native format, below. */
+enum native_image_keyword_index
+{
+ NATIVE_IMAGE_TYPE,
+ NATIVE_IMAGE_DATA,
+ NATIVE_IMAGE_FILE,
+ NATIVE_IMAGE_ASCENT,
+ NATIVE_IMAGE_MARGIN,
+ NATIVE_IMAGE_RELIEF,
+ NATIVE_IMAGE_ALGORITHM,
+ NATIVE_IMAGE_HEURISTIC_MASK,
+ NATIVE_IMAGE_MASK,
+ NATIVE_IMAGE_BACKGROUND,
+ NATIVE_IMAGE_INDEX,
+ NATIVE_IMAGE_LAST
+};
+
+/* Vector of image_keyword structures describing the format
+ of valid user-defined image specifications. */
+static const struct image_keyword native_image_format[] =
+{
+ {":type", IMAGE_SYMBOL_VALUE, 1},
+ {":data", IMAGE_STRING_VALUE, 0},
+ {":file", IMAGE_STRING_VALUE, 0},
+ {":ascent", IMAGE_ASCENT_VALUE, 0},
+ {":margin", IMAGE_NON_NEGATIVE_INTEGER_VALUE_OR_PAIR, 0},
+ {":relief", IMAGE_INTEGER_VALUE, 0},
+ {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
+ {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
+ {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
+ {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
+ {":index", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
+};
+
+/* Return true if OBJECT is a valid native API image specification. */
+
+static bool
+native_image_p (Lisp_Object object)
+{
+ struct image_keyword fmt[NATIVE_IMAGE_LAST];
+ memcpy (fmt, native_image_format, sizeof fmt);
+
+ if (!parse_image_spec (object, fmt, 10, Qnative_image))
+ return 0;
+
+ /* Must specify either the :data or :file keyword. */
+ return fmt[NATIVE_IMAGE_FILE].count + fmt[NATIVE_IMAGE_DATA].count == 1;
+}
+
+static bool
+native_image_load (struct frame *f, struct image *img)
+{
+ Lisp_Object image_file = image_spec_value (img->spec, QCfile, NULL);
+
+ if (STRINGP (image_file))
+ image_file = image_find_image_file (image_file);
+
+# ifdef HAVE_NTGUI
+ return w32_load_image (f, img, image_file,
+ image_spec_value (img->spec, QCdata, NULL));
+# elif defined HAVE_NS
+ return ns_load_image (f, img, image_file,
+ image_spec_value (img->spec, QCdata, NULL));
+# else
+ return 0;
+# endif
+}
+
+#endif /* HAVE_NATIVE_IMAGE_API */
+
+
+/***********************************************************************
PNG
***********************************************************************/
-#if defined (HAVE_PNG) || defined (HAVE_NS)
+#if defined (HAVE_PNG)
/* Indices of image specification fields in png_format, below. */
@@ -6286,10 +6435,10 @@ png_image_p (Lisp_Object object)
return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
}
-#endif /* HAVE_PNG || HAVE_NS */
+#endif /* HAVE_PNG */
-#if defined HAVE_PNG && !defined HAVE_NS
+#ifdef HAVE_PNG
# ifdef WINDOWSNT
/* PNG library details. */
@@ -6879,18 +7028,7 @@ png_load (struct frame *f, struct image *img)
return png_load_body (f, img, &c);
}
-#elif defined HAVE_NS
-
-static bool
-png_load (struct frame *f, struct image *img)
-{
- return ns_load_image (f, img,
- image_spec_value (img->spec, QCfile, NULL),
- image_spec_value (img->spec, QCdata, NULL));
-}
-
-
-#endif /* HAVE_NS */
+#endif /* HAVE_PNG */
@@ -6898,7 +7036,7 @@ png_load (struct frame *f, struct image *img)
JPEG
***********************************************************************/
-#if defined (HAVE_JPEG) || defined (HAVE_NS)
+#if defined (HAVE_JPEG)
/* Indices of image specification fields in gs_format, below. */
@@ -6950,7 +7088,7 @@ jpeg_image_p (Lisp_Object object)
return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
}
-#endif /* HAVE_JPEG || HAVE_NS */
+#endif /* HAVE_JPEG */
#ifdef HAVE_JPEG
@@ -7452,18 +7590,6 @@ jpeg_load (struct frame *f, struct image *img)
return jpeg_load_body (f, img, &mgr);
}
-#else /* HAVE_JPEG */
-
-#ifdef HAVE_NS
-static bool
-jpeg_load (struct frame *f, struct image *img)
-{
- return ns_load_image (f, img,
- image_spec_value (img->spec, QCfile, NULL),
- image_spec_value (img->spec, QCdata, NULL));
-}
-#endif /* HAVE_NS */
-
#endif /* !HAVE_JPEG */
@@ -7472,7 +7598,7 @@ jpeg_load (struct frame *f, struct image *img)
TIFF
***********************************************************************/
-#if defined (HAVE_TIFF) || defined (HAVE_NS)
+#if defined (HAVE_TIFF)
/* Indices of image specification fields in tiff_format, below. */
@@ -7525,7 +7651,7 @@ tiff_image_p (Lisp_Object object)
return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
}
-#endif /* HAVE_TIFF || HAVE_NS */
+#endif /* HAVE_TIFF */
#ifdef HAVE_TIFF
@@ -7893,16 +8019,6 @@ tiff_load (struct frame *f, struct image *img)
return 1;
}
-#elif defined HAVE_NS
-
-static bool
-tiff_load (struct frame *f, struct image *img)
-{
- return ns_load_image (f, img,
- image_spec_value (img->spec, QCfile, NULL),
- image_spec_value (img->spec, QCdata, NULL));
-}
-
#endif
@@ -7911,7 +8027,7 @@ tiff_load (struct frame *f, struct image *img)
GIF
***********************************************************************/
-#if defined (HAVE_GIF) || defined (HAVE_NS)
+#if defined (HAVE_GIF)
/* Indices of image specification fields in gif_format, below. */
@@ -8215,7 +8331,10 @@ gif_load (struct frame *f, struct image *img)
rc = DGifSlurp (gif);
if (rc == GIF_ERROR || gif->ImageCount <= 0)
{
- image_error ("Error reading `%s'", img->spec);
+ if (NILP (specified_data))
+ image_error ("Error reading `%s'", img->spec);
+ else
+ image_error ("Error reading GIF data");
gif_close (gif, NULL);
return 0;
}
@@ -8494,18 +8613,6 @@ gif_load (struct frame *f, struct image *img)
return 1;
}
-#else /* !HAVE_GIF */
-
-#ifdef HAVE_NS
-static bool
-gif_load (struct frame *f, struct image *img)
-{
- return ns_load_image (f, img,
- image_spec_value (img->spec, QCfile, NULL),
- image_spec_value (img->spec, QCdata, NULL));
-}
-#endif /* HAVE_NS */
-
#endif /* HAVE_GIF */
@@ -9346,6 +9453,7 @@ enum svg_keyword_index
SVG_ALGORITHM,
SVG_HEURISTIC_MASK,
SVG_MASK,
+ SVG_FOREGROUND,
SVG_BACKGROUND,
SVG_LAST
};
@@ -9364,6 +9472,7 @@ static const struct image_keyword svg_format[SVG_LAST] =
{":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
+ {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
{":background", IMAGE_STRING_OR_NIL_VALUE, 0}
};
@@ -9628,6 +9737,8 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
int height;
const guint8 *pixels;
int rowstride;
+ char *wrapped_contents = NULL;
+ ptrdiff_t wrapped_size;
#if ! GLIB_CHECK_VERSION (2, 36, 0)
/* g_type_init is a glib function that must be called prior to
@@ -9635,6 +9746,8 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
g_type_init ();
#endif
+ /* Parse the unmodified SVG data so we can get its initial size. */
+
#if LIBRSVG_CHECK_VERSION (2, 32, 0)
GInputStream *input_stream
= g_memory_input_stream_new_from_data (contents, size, NULL);
@@ -9663,6 +9776,105 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
rsvg_handle_write (rsvg_handle, (unsigned char *) contents, size, &err);
if (err) goto rsvg_error;
+ /* The parsing is complete, rsvg_handle is ready to be used, close
+ it for further writes. */
+ rsvg_handle_close (rsvg_handle, &err);
+ if (err) goto rsvg_error;
+#endif
+
+ /* Get the image dimensions. */
+ rsvg_handle_get_dimensions (rsvg_handle, &dimension_data);
+
+ /* We are now done with the unmodified data. */
+ g_object_unref (rsvg_handle);
+
+ /* Calculate the final image size. */
+ compute_image_size (dimension_data.width, dimension_data.height,
+ img->spec, &width, &height);
+
+ /* Wrap the SVG data in another SVG. This allows us to set the
+ width and height, as well as modify the foreground and background
+ colors. */
+ {
+ Lisp_Object value;
+ unsigned long foreground = img->face_foreground;
+ unsigned long background = img->face_background;
+
+ Lisp_Object encoded_contents
+ = Fbase64_encode_string (make_unibyte_string (contents, size), Qt);
+
+ /* The wrapper sets the foreground color, width and height, and
+ viewBox must contain the dimensions of the original image. It
+ also draws a rectangle over the whole space, set to the
+ background color, before including the original image. This
+ acts to set the background color, instead of leaving it
+ transparent. */
+ const char *wrapper =
+ "<svg xmlns:xlink=\"http://www.w3.org/1999/xlink\" "
+ "xmlns:xi=\"http://www.w3.org/2001/XInclude\" "
+ "style=\"color: #%06X; fill: currentColor;\" "
+ "width=\"%d\" height=\"%d\" preserveAspectRatio=\"none\" "
+ "viewBox=\"0 0 %d %d\">"
+ "<rect width=\"100%%\" height=\"100%%\" fill=\"#%06X\"/>"
+ "<xi:include href=\"data:image/svg+xml;base64,%s\"></xi:include>"
+ "</svg>";
+
+ /* FIXME: I've added 64 in the hope it will cover the size of the
+ width and height strings and things. */
+ int buffer_size = SBYTES (encoded_contents) + strlen (wrapper) + 64;
+
+ value = image_spec_value (img->spec, QCforeground, NULL);
+ if (!NILP (value))
+ foreground = image_alloc_image_color (f, img, value, img->face_foreground);
+ value = image_spec_value (img->spec, QCbackground, NULL);
+ if (!NILP (value))
+ {
+ background = image_alloc_image_color (f, img, value, img->face_background);
+ img->background = background;
+ img->background_valid = 1;
+ }
+
+ wrapped_contents = xmalloc (buffer_size);
+
+ if (!wrapped_contents
+ || buffer_size <= snprintf (wrapped_contents, buffer_size, wrapper,
+ foreground & 0xFFFFFF, width, height,
+ dimension_data.width, dimension_data.height,
+ background & 0xFFFFFF, SSDATA (encoded_contents)))
+ goto rsvg_error;
+
+ wrapped_size = strlen (wrapped_contents);
+ }
+
+ /* Now we parse the wrapped version. */
+
+#if LIBRSVG_CHECK_VERSION (2, 32, 0)
+ input_stream = g_memory_input_stream_new_from_data (wrapped_contents, wrapped_size, NULL);
+ base_file = filename ? g_file_new_for_path (filename) : NULL;
+ rsvg_handle = rsvg_handle_new_from_stream_sync (input_stream, base_file,
+ RSVG_HANDLE_FLAGS_NONE,
+ NULL, &err);
+ if (base_file)
+ g_object_unref (base_file);
+ g_object_unref (input_stream);
+
+ /* Check rsvg_handle too, to avoid librsvg 2.40.13 bug (Bug#36773#26). */
+ if (!rsvg_handle || err) goto rsvg_error;
+#else
+ /* Make a handle to a new rsvg object. */
+ rsvg_handle = rsvg_handle_new ();
+ eassume (rsvg_handle);
+
+ /* Set base_uri for properly handling referenced images (via 'href').
+ See rsvg bug 596114 - "image refs are relative to curdir, not .svg file"
+ <https://gitlab.gnome.org/GNOME/librsvg/issues/33>. */
+ if (filename)
+ rsvg_handle_set_base_uri (rsvg_handle, filename);
+
+ /* Parse the contents argument and fill in the rsvg_handle. */
+ rsvg_handle_write (rsvg_handle, (unsigned char *) wrapped_contents, wrapped_size, &err);
+ if (err) goto rsvg_error;
+
/* The parsing is complete, rsvg_handle is ready to used, close it
for further writes. */
rsvg_handle_close (rsvg_handle, &err);
@@ -9681,6 +9893,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
pixbuf = rsvg_handle_get_pixbuf (rsvg_handle);
if (!pixbuf) goto rsvg_error;
g_object_unref (rsvg_handle);
+ xfree (wrapped_contents);
/* Extract some meta data from the svg handle. */
width = gdk_pixbuf_get_width (pixbuf);
@@ -9705,25 +9918,6 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
init_color_table ();
- /* Handle alpha channel by combining the image with a background
- color. */
- Emacs_Color background;
- Lisp_Object specified_bg = image_spec_value (img->spec, QCbackground, NULL);
- if (!STRINGP (specified_bg)
- || !FRAME_TERMINAL (f)->defined_color_hook (f,
- SSDATA (specified_bg),
- &background,
- false,
- false))
- FRAME_TERMINAL (f)->query_frame_background_color (f, &background);
-
- /* SVG pixmaps specify transparency in the last byte, so right
- shift 8 bits to get rid of it, since emacs doesn't support
- transparency. */
- background.red >>= 8;
- background.green >>= 8;
- background.blue >>= 8;
-
/* This loop handles opacity values, since Emacs assumes
non-transparent images. Each pixel must be "flattened" by
calculating the resulting color, given the transparency of the
@@ -9735,16 +9929,11 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
int red = *pixels++;
int green = *pixels++;
int blue = *pixels++;
- int opacity = *pixels++;
- red = ((red * opacity)
- + (background.red * ((1 << 8) - opacity)));
- green = ((green * opacity)
- + (background.green * ((1 << 8) - opacity)));
- blue = ((blue * opacity)
- + (background.blue * ((1 << 8) - opacity)));
+ /* Skip opacity. */
+ pixels++;
- PUT_PIXEL (ximg, x, y, lookup_rgb_color (f, red, green, blue));
+ PUT_PIXEL (ximg, x, y, lookup_rgb_color (f, red << 8, green << 8, blue << 8));
}
pixels += rowstride - 4 * width;
@@ -9774,6 +9963,8 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
rsvg_error:
if (rsvg_handle)
g_object_unref (rsvg_handle);
+ if (wrapped_contents)
+ xfree (wrapped_contents);
/* 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);
@@ -10072,7 +10263,7 @@ DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0,
ptrdiff_t id = -1;
if (valid_image_p (spec))
- id = lookup_image (SELECTED_FRAME (), spec);
+ id = lookup_image (SELECTED_FRAME (), spec, -1);
debug_print (spec);
return make_fixnum (id);
@@ -10136,6 +10327,12 @@ initialize_image_type (struct image_type const *type)
{
#ifdef WINDOWSNT
Lisp_Object typesym = builtin_lisp_symbol (type->type);
+
+# if HAVE_NATIVE_IMAGE_API
+ if (image_can_use_native_api (typesym))
+ return true;
+# endif
+
Lisp_Object tested = Fassq (typesym, Vlibrary_cache);
/* If we failed to load the library before, don't try again. */
if (CONSP (tested))
@@ -10168,19 +10365,19 @@ static struct image_type const image_types[] =
{ SYMBOL_INDEX (Qsvg), svg_image_p, svg_load, image_clear_image,
IMAGE_TYPE_INIT (init_svg_functions) },
#endif
-#if defined HAVE_PNG || defined HAVE_NS
+#if defined HAVE_PNG
{ SYMBOL_INDEX (Qpng), png_image_p, png_load, image_clear_image,
IMAGE_TYPE_INIT (init_png_functions) },
#endif
-#if defined HAVE_GIF || defined HAVE_NS
+#if defined HAVE_GIF
{ SYMBOL_INDEX (Qgif), gif_image_p, gif_load, gif_clear_image,
IMAGE_TYPE_INIT (init_gif_functions) },
#endif
-#if defined HAVE_TIFF || defined HAVE_NS
+#if defined HAVE_TIFF
{ SYMBOL_INDEX (Qtiff), tiff_image_p, tiff_load, image_clear_image,
IMAGE_TYPE_INIT (init_tiff_functions) },
#endif
-#if defined HAVE_JPEG || defined HAVE_NS
+#if defined HAVE_JPEG
{ SYMBOL_INDEX (Qjpeg), jpeg_image_p, jpeg_load, image_clear_image,
IMAGE_TYPE_INIT (init_jpeg_functions) },
#endif
@@ -10192,12 +10389,23 @@ static struct image_type const image_types[] =
{ SYMBOL_INDEX (Qpbm), pbm_image_p, pbm_load, image_clear_image },
};
+#if HAVE_NATIVE_IMAGE_API
+struct image_type native_image_type =
+ { SYMBOL_INDEX (Qnative_image), native_image_p, native_image_load,
+ image_clear_image };
+#endif
+
/* Look up image type TYPE, and return a pointer to its image_type
structure. Return 0 if TYPE is not a known image type. */
static struct image_type const *
lookup_image_type (Lisp_Object type)
{
+#if HAVE_NATIVE_IMAGE_API
+ if (image_can_use_native_api (type))
+ return &native_image_type;
+#endif
+
for (int i = 0; i < ARRAYELTS (image_types); i++)
{
struct image_type const *r = &image_types[i];
@@ -10319,22 +10527,22 @@ non-numeric, there is no explicit limit on the size of images. */);
add_image_type (Qxpm);
#endif
-#if defined (HAVE_JPEG) || defined (HAVE_NS)
+#if defined (HAVE_JPEG) || defined (HAVE_NATIVE_IMAGE_API)
DEFSYM (Qjpeg, "jpeg");
add_image_type (Qjpeg);
#endif
-#if defined (HAVE_TIFF) || defined (HAVE_NS)
+#if defined (HAVE_TIFF) || defined (HAVE_NATIVE_IMAGE_API)
DEFSYM (Qtiff, "tiff");
add_image_type (Qtiff);
#endif
-#if defined (HAVE_GIF) || defined (HAVE_NS)
+#if defined (HAVE_GIF) || defined (HAVE_NATIVE_IMAGE_API)
DEFSYM (Qgif, "gif");
add_image_type (Qgif);
#endif
-#if defined (HAVE_PNG) || defined (HAVE_NS)
+#if defined (HAVE_PNG) || defined (HAVE_NATIVE_IMAGE_API)
DEFSYM (Qpng, "png");
add_image_type (Qpng);
#endif
@@ -10358,6 +10566,14 @@ non-numeric, there is no explicit limit on the size of images. */);
#endif /* HAVE_NTGUI */
#endif /* HAVE_RSVG */
+#if HAVE_NATIVE_IMAGE_API
+ DEFSYM (Qnative_image, "native-image");
+# ifdef HAVE_NTGUI
+ DEFSYM (Qgdiplus, "gdiplus");
+ DEFSYM (Qshlwapi, "shlwapi");
+# endif
+#endif
+
defsubr (&Sinit_image_library);
#ifdef HAVE_IMAGEMAGICK
defsubr (&Simagemagick_types);
diff --git a/src/indent.c b/src/indent.c
index 939e5931db0..4ecf02b6b96 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -285,9 +285,7 @@ skip_invisible (ptrdiff_t pos, ptrdiff_t *next_boundary_p, ptrdiff_t to, Lisp_Ob
#define MULTIBYTE_BYTES_WIDTH(p, dp, bytes, width) \
do { \
- int ch; \
- \
- ch = STRING_CHAR_AND_LENGTH (p, bytes); \
+ int ch = string_char_and_length (p, &(bytes)); \
if (BYTES_BY_CHAR_HEAD (*p) != bytes) \
width = bytes * 4; \
else \
@@ -526,9 +524,11 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos)
comes first.
Return the resulting buffer position and column in ENDPOS and GOALCOL.
PREVCOL gets set to the column of the previous position (it's always
- strictly smaller than the goal column). */
+ strictly smaller than the goal column), and PREVPOS and PREVBPOS get set
+ to the corresponding buffer character and byte positions. */
static void
-scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol, ptrdiff_t *prevcol)
+scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol,
+ ptrdiff_t *prevpos, ptrdiff_t *prevbpos, ptrdiff_t *prevcol)
{
int tab_width = SANE_TAB_WIDTH (current_buffer);
bool ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
@@ -542,10 +542,12 @@ scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol, ptrdiff_t *prevcol)
register ptrdiff_t col = 0, prev_col = 0;
EMACS_INT goal = goalcol ? *goalcol : MOST_POSITIVE_FIXNUM;
ptrdiff_t end = endpos ? *endpos : PT;
- ptrdiff_t scan, scan_byte, next_boundary;
+ ptrdiff_t scan, scan_byte, next_boundary, prev_pos, prev_bpos;
scan = find_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, NULL, &scan_byte, 1);
next_boundary = scan;
+ prev_pos = scan;
+ prev_bpos = scan_byte;
window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
w = ! NILP (window) ? XWINDOW (window) : NULL;
@@ -578,6 +580,8 @@ scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol, ptrdiff_t *prevcol)
if (col >= goal)
break;
prev_col = col;
+ prev_pos = scan;
+ prev_bpos = scan_byte;
{ /* Check display property. */
ptrdiff_t endp;
@@ -707,6 +711,10 @@ scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol, ptrdiff_t *prevcol)
*goalcol = col;
if (endpos)
*endpos = scan;
+ if (prevpos)
+ *prevpos = prev_pos;
+ if (prevbpos)
+ *prevbpos = prev_bpos;
if (prevcol)
*prevcol = prev_col;
}
@@ -722,7 +730,7 @@ current_column_1 (void)
EMACS_INT col = MOST_POSITIVE_FIXNUM;
ptrdiff_t opoint = PT;
- scan_for_column (&opoint, &col, NULL);
+ scan_for_column (&opoint, &col, NULL, NULL, NULL);
return col;
}
@@ -942,7 +950,7 @@ position_indentation (ptrdiff_t pos_byte)
if (CHAR_HAS_CATEGORY (c, ' '))
{
column++;
- INC_POS (pos_byte);
+ pos_byte += next_char_len (pos_byte);
p = BYTE_POS_ADDR (pos_byte);
}
else
@@ -961,7 +969,7 @@ indented_beyond_p (ptrdiff_t pos, ptrdiff_t pos_byte, EMACS_INT column)
{
while (pos > BEGV && FETCH_BYTE (pos_byte) == '\n')
{
- DEC_BOTH (pos, pos_byte);
+ dec_both (&pos, &pos_byte);
pos = find_newline (pos, pos_byte, BEGV, BEGV_BYTE,
-1, NULL, &pos_byte, 0);
}
@@ -990,7 +998,7 @@ to reach COLUMN, add spaces/tabs to get there.
The return value is the current column. */)
(Lisp_Object column, Lisp_Object force)
{
- ptrdiff_t pos, prev_col;
+ ptrdiff_t pos, prev_pos, prev_bpos, prev_col;
EMACS_INT col;
EMACS_INT goal;
@@ -999,7 +1007,7 @@ The return value is the current column. */)
col = goal;
pos = ZV;
- scan_for_column (&pos, &col, &prev_col);
+ scan_for_column (&pos, &col, &prev_pos, &prev_bpos, &prev_col);
SET_PT (pos);
@@ -1008,18 +1016,16 @@ The return value is the current column. */)
if (!NILP (force) && col > goal)
{
int c;
- ptrdiff_t pos_byte = PT_BYTE;
- DEC_POS (pos_byte);
- c = FETCH_CHAR (pos_byte);
- if (c == '\t' && prev_col < goal)
+ c = FETCH_CHAR (prev_bpos);
+ if (c == '\t' && prev_col < goal && prev_bpos < PT_BYTE)
{
ptrdiff_t goal_pt, goal_pt_byte;
/* Insert spaces in front of the tab to reach GOAL. Do this
first so that a marker at the end of the tab gets
adjusted. */
- SET_PT_BOTH (PT - 1, PT_BYTE - 1);
+ SET_PT_BOTH (prev_pos, prev_bpos);
Finsert_char (make_fixnum (' '), make_fixnum (goal - prev_col), Qt);
/* Now delete the tab, and indent to COL. */
@@ -1605,7 +1611,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
{
pos = find_before_next_newline (pos, to, 1, &pos_byte);
if (pos < to)
- INC_BOTH (pos, pos_byte);
+ inc_both (&pos, &pos_byte);
rarely_quit (++quit_count);
}
while (pos < to
@@ -1618,7 +1624,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
if (hpos >= width)
hpos = width;
}
- DEC_BOTH (pos, pos_byte);
+ dec_both (&pos, &pos_byte);
/* We have skipped the invis text, but not the
newline after. */
}
@@ -1820,8 +1826,8 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */)
static struct position val_vmotion;
struct position *
-vmotion (register ptrdiff_t from, register ptrdiff_t from_byte,
- register EMACS_INT vtarget, struct window *w)
+vmotion (ptrdiff_t from, ptrdiff_t from_byte,
+ EMACS_INT vtarget, struct window *w)
{
ptrdiff_t hscroll = w->hscroll;
struct position pos;
@@ -1862,7 +1868,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte,
Lisp_Object propval;
prevline = from;
- DEC_BOTH (prevline, bytepos);
+ dec_both (&prevline, &bytepos);
prevline = find_newline_no_quit (prevline, bytepos, -1, &bytepos);
while (prevline > BEGV
@@ -1875,7 +1881,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte,
text_prop_object),
TEXT_PROP_MEANS_INVISIBLE (propval))))
{
- DEC_BOTH (prevline, bytepos);
+ dec_both (&prevline, &bytepos);
prevline = find_newline_no_quit (prevline, bytepos, -1, &bytepos);
}
pos = *compute_motion (prevline, bytepos, 0, lmargin, 0, from,
@@ -1925,7 +1931,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte,
text_prop_object),
TEXT_PROP_MEANS_INVISIBLE (propval))))
{
- DEC_BOTH (prevline, bytepos);
+ dec_both (&prevline, &bytepos);
prevline = find_newline_no_quit (prevline, bytepos, -1, &bytepos);
}
pos = *compute_motion (prevline, bytepos, 0, lmargin, 0, from,
@@ -2091,15 +2097,15 @@ whether or not it is currently displayed in some window. */)
struct it it;
struct text_pos pt;
struct window *w;
- Lisp_Object lcols;
+ Lisp_Object lcols = Qnil;
void *itdata = NULL;
ptrdiff_t count = SPECPDL_INDEX ();
/* Allow LINES to be of the form (HPOS . VPOS) aka (COLUMNS . LINES). */
- bool lcols_given = CONSP (lines);
- if (lcols_given)
+ if (CONSP (lines))
{
lcols = XCAR (lines);
+ CHECK_NUMBER (lcols);
lines = XCDR (lines);
}
@@ -2279,9 +2285,9 @@ whether or not it is currently displayed in some window. */)
overshoot_handled = 1;
}
- if (lcols_given)
+ if (!NILP (lcols))
to_x =
- window_column_x (w, window, extract_float (lcols), lcols)
+ window_column_x (w, window, XFLOATINT (lcols), lcols)
+ lnum_pixel_width;
if (nlines <= 0)
{
@@ -2332,7 +2338,7 @@ whether or not it is currently displayed in some window. */)
/* Move to the goal column, if one was specified. If the window
was originally hscrolled, the goal column is interpreted as
an addition to the hscroll amount. */
- if (lcols_given)
+ if (!NILP (lcols))
{
move_it_in_display_line (&it, ZV, first_x + to_x, MOVE_TO_X);
/* If we find ourselves in the middle of an overlay string
diff --git a/src/insdel.c b/src/insdel.c
index dfa1cc311ca..c37b0710783 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -382,10 +382,10 @@ count_bytes (ptrdiff_t pos, ptrdiff_t bytepos, ptrdiff_t endpos)
if (pos <= endpos)
for ( ; pos < endpos; pos++)
- INC_POS (bytepos);
+ bytepos += next_char_len (bytepos);
else
for ( ; pos > endpos; pos--)
- DEC_POS (bytepos);
+ bytepos -= prev_char_len (bytepos);
return bytepos;
}
@@ -626,8 +626,7 @@ copy_text (const unsigned char *from_addr, unsigned char *to_addr,
while (bytes_left > 0)
{
- int thislen, c;
- c = STRING_CHAR_AND_LENGTH (from_addr, thislen);
+ int thislen, c = string_char_and_length (from_addr, &thislen);
if (! ASCII_CHAR_P (c))
c &= 0xFF;
*to_addr++ = c;
diff --git a/src/intervals.c b/src/intervals.c
index 585ef18bd2e..0257591a142 100644
--- a/src/intervals.c
+++ b/src/intervals.c
@@ -117,10 +117,11 @@ create_root_interval (Lisp_Object parent)
/* Make the interval TARGET have exactly the properties of SOURCE. */
void
-copy_properties (register INTERVAL source, register INTERVAL target)
+copy_properties (INTERVAL source, INTERVAL target)
{
if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
return;
+ eassume (source && target);
COPY_INTERVAL_CACHE (source, target);
set_interval_plist (target, Fcopy_sequence (source->plist));
@@ -298,7 +299,7 @@ rotate_right (INTERVAL A)
set_interval_parent (c, A);
/* A's total length is decreased by the length of B and its left child. */
- A->total_length -= B->total_length - TOTAL_LENGTH (c);
+ A->total_length -= TOTAL_LENGTH (B) - TOTAL_LENGTH0 (c);
eassert (TOTAL_LENGTH (A) > 0);
eassert (LENGTH (A) > 0);
@@ -349,7 +350,7 @@ rotate_left (INTERVAL A)
set_interval_parent (c, A);
/* A's total length is decreased by the length of B and its right child. */
- A->total_length -= B->total_length - TOTAL_LENGTH (c);
+ A->total_length -= TOTAL_LENGTH (B) - TOTAL_LENGTH0 (c);
eassert (TOTAL_LENGTH (A) > 0);
eassert (LENGTH (A) > 0);
@@ -723,13 +724,13 @@ previous_interval (register INTERVAL interval)
i->position - LEFT_TOTAL_LENGTH (i) \
- LENGTH (INTERVAL_PARENT (i))
-/* Find the interval containing POS, given some non-NULL INTERVAL in
+/* Find the interval containing POS, given some interval I in
the same tree. Note that we update interval->position in each
interval we traverse, assuming it is already correctly set for the
argument I. We don't assume that any other interval already has a
correctly set ->position. */
INTERVAL
-update_interval (register INTERVAL i, ptrdiff_t pos)
+update_interval (INTERVAL i, ptrdiff_t pos)
{
if (!i)
return NULL;
@@ -739,7 +740,7 @@ update_interval (register INTERVAL i, ptrdiff_t pos)
if (pos < i->position)
{
/* Move left. */
- if (pos >= i->position - TOTAL_LENGTH (i->left))
+ if (pos >= i->position - LEFT_TOTAL_LENGTH (i))
{
i->left->position = i->position - TOTAL_LENGTH (i->left)
+ LEFT_TOTAL_LENGTH (i->left);
@@ -757,7 +758,7 @@ update_interval (register INTERVAL i, ptrdiff_t pos)
else if (pos >= INTERVAL_LAST_POS (i))
{
/* Move right. */
- if (pos < INTERVAL_LAST_POS (i) + TOTAL_LENGTH (i->right))
+ if (pos < INTERVAL_LAST_POS (i) + RIGHT_TOTAL_LENGTH (i))
{
i->right->position = INTERVAL_LAST_POS (i)
+ LEFT_TOTAL_LENGTH (i->right);
diff --git a/src/intervals.h b/src/intervals.h
index a93b10e9fff..9a7ba910a10 100644
--- a/src/intervals.h
+++ b/src/intervals.h
@@ -96,24 +96,27 @@ struct interval
/* True if this interval has both left and right children. */
#define BOTH_KIDS_P(i) ((i)->left != NULL && (i)->right != NULL)
-/* The total size of all text represented by this interval and all its
- children in the tree. This is zero if the interval is null. */
-#define TOTAL_LENGTH(i) ((i) == NULL ? 0 : (i)->total_length)
+/* The total size of all text represented by the nonnull interval I
+ and all its children in the tree. */
+#define TOTAL_LENGTH(i) ((i)->total_length)
+
+/* Likewise, but also defined to be zero if I is null. */
+#define TOTAL_LENGTH0(i) ((i) ? TOTAL_LENGTH (i) : 0)
/* The size of text represented by this interval alone. */
-#define LENGTH(i) ((i)->total_length \
- - TOTAL_LENGTH ((i)->right) \
- - TOTAL_LENGTH ((i)->left))
+#define LENGTH(i) (TOTAL_LENGTH (i) \
+ - RIGHT_TOTAL_LENGTH (i) \
+ - LEFT_TOTAL_LENGTH (i))
/* The position of the character just past the end of I. Note that
the position cache i->position must be valid for this to work. */
#define INTERVAL_LAST_POS(i) ((i)->position + LENGTH (i))
/* The total size of the left subtree of this interval. */
-#define LEFT_TOTAL_LENGTH(i) ((i)->left ? (i)->left->total_length : 0)
+#define LEFT_TOTAL_LENGTH(i) TOTAL_LENGTH0 ((i)->left)
/* The total size of the right subtree of this interval. */
-#define RIGHT_TOTAL_LENGTH(i) ((i)->right ? (i)->right->total_length : 0)
+#define RIGHT_TOTAL_LENGTH(i) TOTAL_LENGTH0 ((i)->right)
/* These macros are for dealing with the interval properties. */
@@ -234,7 +237,7 @@ set_interval_plist (INTERVAL i, Lisp_Object plist)
/* Declared in alloc.c. */
-extern INTERVAL make_interval (void);
+extern INTERVAL make_interval (void) ATTRIBUTE_RETURNS_NONNULL;
/* Declared in intervals.c. */
@@ -246,7 +249,8 @@ extern void traverse_intervals (INTERVAL, ptrdiff_t,
Lisp_Object);
extern void traverse_intervals_noorder (INTERVAL,
void (*) (INTERVAL, void *), void *);
-extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t);
+extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t)
+ ATTRIBUTE_RETURNS_NONNULL;
extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t);
extern INTERVAL find_interval (INTERVAL, ptrdiff_t);
extern INTERVAL next_interval (INTERVAL);
diff --git a/src/json.c b/src/json.c
index 4648cb4c3b7..8c9583631ad 100644
--- a/src/json.c
+++ b/src/json.c
@@ -479,9 +479,7 @@ lisp_to_json (Lisp_Object lisp, struct json_configuration *conf)
{
intmax_t low = TYPE_MINIMUM (json_int_t);
intmax_t high = TYPE_MAXIMUM (json_int_t);
- intmax_t value;
- if (! (integer_to_intmax (lisp, &value) && low <= value && value <= high))
- args_out_of_range_3 (lisp, make_int (low), make_int (high));
+ intmax_t value = check_integer_range (lisp, low, high);
return json_check (json_integer (value));
}
else if (FLOATP (lisp))
@@ -1123,7 +1121,6 @@ syms_of_json (void)
DEFSYM (Qstring_without_embedded_nulls_p, "string-without-embedded-nulls-p");
DEFSYM (Qjson_value_p, "json-value-p");
- DEFSYM (Qutf_8_string_p, "utf-8-string-p");
DEFSYM (Qjson_error, "json-error");
DEFSYM (Qjson_out_of_memory, "json-out-of-memory");
diff --git a/src/keyboard.c b/src/keyboard.c
index 5f136f03ecf..af075a42c76 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -103,7 +103,8 @@ static KBOARD *all_kboards;
/* True in the single-kboard state, false in the any-kboard state. */
static bool single_kboard;
-#define NUM_RECENT_KEYS (300)
+/* Minimum allowed size of the recent_keys vector. */
+#define MIN_NUM_RECENT_KEYS (100)
/* Index for storing next element into recent_keys. */
static int recent_keys_index;
@@ -111,7 +112,10 @@ static int recent_keys_index;
/* Total number of elements stored into recent_keys. */
static int total_keys;
-/* This vector holds the last NUM_RECENT_KEYS keystrokes. */
+/* Size of the recent_keys vector. */
+static int lossage_limit = 3 * MIN_NUM_RECENT_KEYS;
+
+/* This vector holds the last lossage_limit keystrokes. */
static Lisp_Object recent_keys;
/* Vector holding the key sequence that invoked the current command.
@@ -1421,10 +1425,10 @@ command_loop_1 (void)
/* Execute the command. */
{
- total_keys += total_keys < NUM_RECENT_KEYS;
+ total_keys += total_keys < lossage_limit;
ASET (recent_keys, recent_keys_index,
Fcons (Qnil, cmd));
- if (++recent_keys_index >= NUM_RECENT_KEYS)
+ if (++recent_keys_index >= lossage_limit)
recent_keys_index = 0;
}
Vthis_command = cmd;
@@ -2279,7 +2283,7 @@ 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));
+ events[n++] = make_fixnum (string_char_advance (&p));
}
}
}
@@ -2901,6 +2905,12 @@ read_char (int commandflag, Lisp_Object map,
example banishing the mouse under mouse-avoidance-mode. */
timer_resume_idle ();
+#ifdef HAVE_NS
+ if (CONSP (c)
+ && (EQ (XCAR (c), intern ("ns-unput-working-text"))))
+ input_was_pending = input_pending;
+#endif
+
if (current_buffer != prev_buffer)
{
/* The command may have changed the keymaps. Pretend there
@@ -2921,13 +2931,11 @@ read_char (int commandflag, Lisp_Object map,
goto exit;
if ((STRINGP (KVAR (current_kboard, Vkeyboard_translate_table))
- && UNSIGNED_CMP (XFIXNAT (c), <,
- SCHARS (KVAR (current_kboard,
- Vkeyboard_translate_table))))
+ && XFIXNAT (c) < SCHARS (KVAR (current_kboard,
+ Vkeyboard_translate_table)))
|| (VECTORP (KVAR (current_kboard, Vkeyboard_translate_table))
- && UNSIGNED_CMP (XFIXNAT (c), <,
- ASIZE (KVAR (current_kboard,
- Vkeyboard_translate_table))))
+ && XFIXNAT (c) < ASIZE (KVAR (current_kboard,
+ Vkeyboard_translate_table)))
|| (CHAR_TABLE_P (KVAR (current_kboard, Vkeyboard_translate_table))
&& CHARACTERP (c)))
{
@@ -3244,15 +3252,15 @@ record_char (Lisp_Object c)
int ix1, ix2, ix3;
if ((ix1 = recent_keys_index - 1) < 0)
- ix1 = NUM_RECENT_KEYS - 1;
+ ix1 = lossage_limit - 1;
ev1 = AREF (recent_keys, ix1);
if ((ix2 = ix1 - 1) < 0)
- ix2 = NUM_RECENT_KEYS - 1;
+ ix2 = lossage_limit - 1;
ev2 = AREF (recent_keys, ix2);
if ((ix3 = ix2 - 1) < 0)
- ix3 = NUM_RECENT_KEYS - 1;
+ ix3 = lossage_limit - 1;
ev3 = AREF (recent_keys, ix3);
if (EQ (XCAR (c), Qhelp_echo))
@@ -3303,12 +3311,12 @@ record_char (Lisp_Object c)
{
if (!recorded)
{
- total_keys += total_keys < NUM_RECENT_KEYS;
+ total_keys += total_keys < lossage_limit;
ASET (recent_keys, recent_keys_index,
/* Copy the event, in case it gets modified by side-effect
by some remapping function (bug#30955). */
CONSP (c) ? Fcopy_sequence (c) : c);
- if (++recent_keys_index >= NUM_RECENT_KEYS)
+ if (++recent_keys_index >= lossage_limit)
recent_keys_index = 0;
}
else if (recorded < 0)
@@ -3322,10 +3330,10 @@ record_char (Lisp_Object c)
while (recorded++ < 0 && total_keys > 0)
{
- if (total_keys < NUM_RECENT_KEYS)
+ if (total_keys < lossage_limit)
total_keys--;
if (--recent_keys_index < 0)
- recent_keys_index = NUM_RECENT_KEYS - 1;
+ recent_keys_index = lossage_limit - 1;
ASET (recent_keys, recent_keys_index, Qnil);
}
}
@@ -5688,7 +5696,7 @@ make_lispy_event (struct input_event *event)
ignore_mouse_drag_p = false;
}
- /* Now we're releasing a button - check the co-ordinates to
+ /* Now we're releasing a button - check the coordinates to
see if this was a click or a drag. */
else if (event->modifiers & up_modifier)
{
@@ -5992,24 +6000,14 @@ make_lispy_event (struct input_event *event)
return list2 (Qselect_window, list1 (event->frame_or_window));
case TAB_BAR_EVENT:
- if (EQ (event->arg, event->frame_or_window))
- /* This is the prefix key. We translate this to
- `(tab_bar)' because the code in keyboard.c for tab bar
- events, which we use, relies on this. */
- return list1 (Qtab_bar);
- else if (SYMBOLP (event->arg))
- return apply_modifiers (event->modifiers, event->arg);
- return event->arg;
-
case TOOL_BAR_EVENT:
- if (EQ (event->arg, event->frame_or_window))
- /* This is the prefix key. We translate this to
- `(tool_bar)' because the code in keyboard.c for tool bar
- events, which we use, relies on this. */
- return list1 (Qtool_bar);
- else if (SYMBOLP (event->arg))
- return apply_modifiers (event->modifiers, event->arg);
- return event->arg;
+ {
+ Lisp_Object res = event->arg;
+ Lisp_Object location
+ = event->kind == TAB_BAR_EVENT ? Qtab_bar : Qtool_bar;
+ if (SYMBOLP (res)) res = apply_modifiers (event->modifiers, res);
+ return list2 (res, list2 (event->frame_or_window, location));
+ }
case USER_SIGNAL_EVENT:
/* A user signal. */
@@ -6646,7 +6644,7 @@ has the same base event type and all the specified modifiers. */)
DEFUN ("internal-handle-focus-in", Finternal_handle_focus_in,
Sinternal_handle_focus_in, 1, 1, 0,
doc: /* Internally handle focus-in events.
-This function potentially generates an artifical switch-frame event. */)
+This function potentially generates an artificial switch-frame event. */)
(Lisp_Object event)
{
Lisp_Object frame;
@@ -8308,7 +8306,7 @@ append_tab_bar_item (void)
/* Append entries from tab_bar_item_properties to the end of
tab_bar_items_vector. */
vcopy (tab_bar_items_vector, ntab_bar_items,
- XVECTOR (tab_bar_item_properties)->contents, TAB_BAR_ITEM_NSLOTS);
+ xvector_contents (tab_bar_item_properties), TAB_BAR_ITEM_NSLOTS);
ntab_bar_items += TAB_BAR_ITEM_NSLOTS;
}
@@ -8785,7 +8783,7 @@ append_tool_bar_item (void)
/* Append entries from tool_bar_item_properties to the end of
tool_bar_items_vector. */
vcopy (tool_bar_items_vector, ntool_bar_items,
- XVECTOR (tool_bar_item_properties)->contents, TOOL_BAR_ITEM_NSLOTS);
+ xvector_contents (tool_bar_item_properties), TOOL_BAR_ITEM_NSLOTS);
ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
}
@@ -10416,6 +10414,64 @@ If CHECK-TIMERS is non-nil, timers that are ready to run will do so. */)
? Qt : Qnil);
}
+/* Reallocate recent_keys copying the recorded keystrokes
+ in the right order. */
+static void
+update_recent_keys (int new_size, int kept_keys)
+{
+ int osize = ASIZE (recent_keys);
+ eassert (recent_keys_index < osize);
+ eassert (kept_keys <= min (osize, new_size));
+ Lisp_Object v = make_nil_vector (new_size);
+ int i, idx;
+ for (i = 0; i < kept_keys; ++i)
+ {
+ idx = recent_keys_index - kept_keys + i;
+ while (idx < 0)
+ idx += osize;
+ ASET (v, i, AREF (recent_keys, idx));
+ }
+ recent_keys = v;
+ total_keys = kept_keys;
+ recent_keys_index = total_keys % new_size;
+ lossage_limit = new_size;
+
+}
+
+DEFUN ("lossage-size", Flossage_size, Slossage_size, 0, 1,
+ "(list (read-number \"new-size: \" (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.
+
+The saved keystrokes are shown by `view-lossage'. */)
+ (Lisp_Object arg)
+{
+ if (NILP(arg))
+ return make_fixnum (lossage_limit);
+
+ if (!FIXNATP (arg))
+ user_error ("Value must be a positive integer");
+ int osize = ASIZE (recent_keys);
+ eassert (lossage_limit == osize);
+ int min_size = MIN_NUM_RECENT_KEYS;
+ int new_size = XFIXNAT (arg);
+
+ if (new_size == osize)
+ return make_fixnum (lossage_limit);
+
+ if (new_size < min_size)
+ {
+ AUTO_STRING (fmt, "Value must be >= %d");
+ Fsignal (Quser_error, list1 (CALLN (Fformat, fmt, make_fixnum (min_size))));
+ }
+
+ int kept_keys = new_size > osize ? total_keys : min (new_size, total_keys);
+ update_recent_keys (new_size, kept_keys);
+
+ return make_fixnum (lossage_limit);
+}
+
DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 1, 0,
doc: /* Return vector of last few events, not counting those from keyboard macros.
If INCLUDE-CMDS is non-nil, include the commands that were run,
@@ -10425,21 +10481,21 @@ represented as pseudo-events of the form (nil . COMMAND). */)
bool cmds = !NILP (include_cmds);
if (!total_keys
- || (cmds && total_keys < NUM_RECENT_KEYS))
+ || (cmds && total_keys < lossage_limit))
return Fvector (total_keys,
XVECTOR (recent_keys)->contents);
else
{
Lisp_Object es = Qnil;
- int i = (total_keys < NUM_RECENT_KEYS
+ int i = (total_keys < lossage_limit
? 0 : recent_keys_index);
- eassert (recent_keys_index < NUM_RECENT_KEYS);
+ eassert (recent_keys_index < lossage_limit);
do
{
Lisp_Object e = AREF (recent_keys, i);
if (cmds || !CONSP (e) || !NILP (XCAR (e)))
es = Fcons (e, es);
- if (++i >= NUM_RECENT_KEYS)
+ if (++i >= lossage_limit)
i = 0;
} while (i != recent_keys_index);
es = Fnreverse (es);
@@ -10472,9 +10528,8 @@ Internal use only. */)
this_command_key_count = 0;
this_single_command_key_start = 0;
- int charidx = 0, byteidx = 0;
- int key0;
- FETCH_STRING_CHAR_ADVANCE (key0, keys, charidx, byteidx);
+ ptrdiff_t charidx = 0, byteidx = 0;
+ int key0 = fetch_string_char_advance (keys, &charidx, &byteidx);
if (CHAR_BYTE8_P (key0))
key0 = CHAR_TO_BYTE8 (key0);
@@ -10486,8 +10541,7 @@ Internal use only. */)
add_command_key (make_fixnum (key0));
for (ptrdiff_t i = 1; i < SCHARS (keys); i++)
{
- int key_i;
- FETCH_STRING_CHAR_ADVANCE (key_i, keys, charidx, byteidx);
+ int key_i = fetch_string_char_advance (keys, &charidx, &byteidx);
if (CHAR_BYTE8_P (key_i))
key_i = CHAR_TO_BYTE8 (key_i);
add_command_key (make_fixnum (key_i));
@@ -11694,7 +11748,7 @@ syms_of_keyboard (void)
staticpro (&modifier_symbols);
}
- recent_keys = make_nil_vector (NUM_RECENT_KEYS);
+ recent_keys = make_nil_vector (lossage_limit);
staticpro (&recent_keys);
this_command_keys = make_nil_vector (40);
@@ -11744,6 +11798,7 @@ syms_of_keyboard (void)
defsubr (&Srecursive_edit);
defsubr (&Sinternal_track_mouse);
defsubr (&Sinput_pending_p);
+ defsubr (&Slossage_size);
defsubr (&Srecent_keys);
defsubr (&Sthis_command_keys);
defsubr (&Sthis_command_keys_vector);
@@ -12483,13 +12538,11 @@ keys_of_keyboard (void)
void
mark_kboards (void)
{
- KBOARD *kb;
- Lisp_Object *p;
- for (kb = all_kboards; kb; kb = kb->next_kboard)
+ for (KBOARD *kb = all_kboards; kb; kb = kb->next_kboard)
{
if (kb->kbd_macro_buffer)
- for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
- mark_object (*p);
+ mark_objects (kb->kbd_macro_buffer,
+ kb->kbd_macro_ptr - kb->kbd_macro_buffer);
mark_object (KVAR (kb, Voverriding_terminal_local_map));
mark_object (KVAR (kb, Vlast_command));
mark_object (KVAR (kb, Vreal_last_command));
diff --git a/src/keymap.c b/src/keymap.c
index cfba98c72f2..0608bdddeea 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1949,8 +1949,7 @@ then the value includes only maps for prefixes that start with PREFIX. */)
for (ptrdiff_t i = 0; i < SCHARS (prefix); )
{
ptrdiff_t i_before = i;
- int c;
- FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
+ int c = fetch_string_char_advance (prefix, &i, &i_byte);
if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
c ^= 0200 | meta_modifier;
ASET (copy, i_before, make_fixnum (c));
@@ -2006,23 +2005,16 @@ For an approximate inverse of this, see `kbd'. */)
(Lisp_Object keys, Lisp_Object prefix)
{
ptrdiff_t len = 0;
- EMACS_INT i;
- ptrdiff_t i_byte;
Lisp_Object *args;
- EMACS_INT size = XFIXNUM (Flength (keys));
- Lisp_Object list;
+ EMACS_INT nkeys = XFIXNUM (Flength (keys));
+ EMACS_INT nprefix = XFIXNUM (Flength (prefix));
Lisp_Object sep = build_string (" ");
- Lisp_Object key;
- Lisp_Object result;
- bool add_meta = 0;
+ bool add_meta = false;
USE_SAFE_ALLOCA;
- if (!NILP (prefix))
- size += XFIXNUM (Flength (prefix));
-
/* This has one extra element at the end that we don't pass to Fconcat. */
- EMACS_INT size4;
- if (INT_MULTIPLY_WRAPV (size, 4, &size4))
+ ptrdiff_t size4;
+ if (INT_MULTIPLY_WRAPV (nkeys + nprefix, 4, &size4))
memory_full (SIZE_MAX);
SAFE_ALLOCA_LISP (args, size4);
@@ -2030,82 +2022,76 @@ For an approximate inverse of this, see `kbd'. */)
(mapconcat 'single-key-description keys " ")
but we shouldn't use mapconcat because it can do GC. */
- next_list:
- if (!NILP (prefix))
- list = prefix, prefix = Qnil;
- else if (!NILP (keys))
- list = keys, keys = Qnil;
- else
+ Lisp_Object lists[2] = { prefix, keys };
+ ptrdiff_t listlens[2] = { nprefix, nkeys };
+ for (int li = 0; li < ARRAYELTS (lists); li++)
{
- if (add_meta)
- {
- args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
- result = Fconcat (len + 1, args);
- }
- else if (len == 0)
- result = empty_unibyte_string;
- else
- result = Fconcat (len - 1, args);
- SAFE_FREE ();
- return result;
- }
+ Lisp_Object list = lists[li];
+ ptrdiff_t listlen = listlens[li], i_byte = 0;
- if (STRINGP (list))
- size = SCHARS (list);
- else if (VECTORP (list))
- size = ASIZE (list);
- else if (CONSP (list))
- size = list_length (list);
- else
- wrong_type_argument (Qarrayp, list);
+ if (! (NILP (list) || STRINGP (list) || VECTORP (list) || CONSP (list)))
+ wrong_type_argument (Qarrayp, list);
- i = i_byte = 0;
-
- while (i < size)
- {
- if (STRINGP (list))
+ for (ptrdiff_t i = 0; i < listlen; )
{
- int c;
- FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
- if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
- c ^= 0200 | meta_modifier;
- XSETFASTINT (key, c);
- }
- else if (VECTORP (list))
- {
- key = AREF (list, i); i++;
- }
- else
- {
- key = XCAR (list);
- list = XCDR (list);
- i++;
- }
-
- if (add_meta)
- {
- if (!FIXNUMP (key)
- || EQ (key, meta_prefix_char)
- || (XFIXNUM (key) & meta_modifier))
+ Lisp_Object key;
+ if (STRINGP (list))
{
- args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
- args[len++] = sep;
- if (EQ (key, meta_prefix_char))
- continue;
+ int c = fetch_string_char_advance (list, &i, &i_byte);
+ if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
+ c ^= 0200 | meta_modifier;
+ key = make_fixnum (c);
+ }
+ else if (VECTORP (list))
+ {
+ key = AREF (list, i);
+ i++;
}
else
- XSETINT (key, XFIXNUM (key) | meta_modifier);
- add_meta = 0;
- }
- else if (EQ (key, meta_prefix_char))
- {
- add_meta = 1;
- continue;
+ {
+ key = XCAR (list);
+ list = XCDR (list);
+ i++;
+ }
+
+ if (add_meta)
+ {
+ if (!FIXNUMP (key)
+ || EQ (key, meta_prefix_char)
+ || (XFIXNUM (key) & meta_modifier))
+ {
+ args[len++] = Fsingle_key_description (meta_prefix_char,
+ Qnil);
+ args[len++] = sep;
+ if (EQ (key, meta_prefix_char))
+ continue;
+ }
+ else
+ key = make_fixnum (XFIXNUM (key) | meta_modifier);
+ add_meta = false;
+ }
+ else if (EQ (key, meta_prefix_char))
+ {
+ add_meta = true;
+ continue;
+ }
+ args[len++] = Fsingle_key_description (key, Qnil);
+ args[len++] = sep;
}
- args[len++] = Fsingle_key_description (key, Qnil);
- args[len++] = sep;
}
- goto next_list;
+
+ Lisp_Object result;
+ if (add_meta)
+ {
+ args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
+ result = Fconcat (len + 1, args);
+ }
+ else if (len == 0)
+ result = empty_unibyte_string;
+ else
+ result = Fconcat (len - 1, args);
+ SAFE_FREE ();
+ return result;
}
@@ -2282,12 +2268,6 @@ See `text-char-description' for describing character codes. */)
static char *
push_text_char_description (register unsigned int c, register char *p)
{
- if (c >= 0200)
- {
- *p++ = 'M';
- *p++ = '-';
- c -= 0200;
- }
if (c < 040)
{
*p++ = '^';
@@ -2316,23 +2296,22 @@ characters into "C-char", and uses the 2**27 bit for Meta.
See Info node `(elisp)Describing Characters' for examples. */)
(Lisp_Object character)
{
- /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
- char str[6];
- int c;
-
CHECK_CHARACTER (character);
- c = XFIXNUM (character);
+ int c = XFIXNUM (character);
if (!ASCII_CHAR_P (c))
{
+ char str[MAX_MULTIBYTE_LENGTH];
int len = CHAR_STRING (c, (unsigned char *) str);
return make_multibyte_string (str, 1, len);
}
-
- *push_text_char_description (c & 0377, str) = 0;
-
- return build_string (str);
+ else
+ {
+ char desc[4];
+ int len = push_text_char_description (c, desc) - desc;
+ return make_string (desc, len);
+ }
}
static int where_is_preferred_modifier;
@@ -3298,7 +3277,7 @@ describe_map (Lisp_Object map, Lisp_Object prefix,
ptrdiff_t pt = max (PT - 1, BEG);
SET_PT (pt);
- insert_string ("\n (that binding is currently shadowed by another mode)");
+ insert_string ("\n (this binding is currently shadowed)");
pt = min (PT + 1, Z);
SET_PT (pt);
}
diff --git a/src/lcms.c b/src/lcms.c
index a74c5539860..924bdd299dc 100644
--- a/src/lcms.c
+++ b/src/lcms.c
@@ -254,8 +254,7 @@ parse_viewing_conditions (Lisp_Object view, const cmsCIEXYZ *wp,
#define PARSE_VIEW_CONDITION_INT(field) \
if (CONSP (view) && FIXNATP (XCAR (view))) \
{ \
- CHECK_RANGED_INTEGER (XCAR (view), 1, 4); \
- vc->field = XFIXNUM (XCAR (view)); \
+ vc->field = check_integer_range (XCAR (view), 1, 4); \
view = XCDR (view); \
} \
else \
@@ -317,7 +316,7 @@ jab_to_jch (const lcmsJab_t *jab, cmsJCh *jch, double FL, double c1, double c2)
}
DEFUN ("lcms-xyz->jch", Flcms_xyz_to_jch, Slcms_xyz_to_jch, 1, 3, 0,
- doc: /* Convert CIE CAM02 JCh to CIE XYZ.
+ doc: /* Convert CIE XYZ to CIE CAM02 JCh.
COLOR is a list (X Y Z), with Y scaled about unity.
Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs',
which see. */)
@@ -353,7 +352,7 @@ which see. */)
}
DEFUN ("lcms-jch->xyz", Flcms_jch_to_xyz, Slcms_jch_to_xyz, 1, 3, 0,
- doc: /* Convert CIE XYZ to CIE CAM02 JCh.
+ doc: /* Convert CIE CAM02 JCh to CIE XYZ.
COLOR is a list (J C h), where lightness of white is equal to 100, and hue
is given in degrees.
Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs',
diff --git a/src/lisp.h b/src/lisp.h
index 92294ac1d33..a24898004d4 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -251,12 +251,6 @@ DEFINE_GDB_SYMBOL_BEGIN (EMACS_INT, VALMASK)
# define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX)
DEFINE_GDB_SYMBOL_END (VALMASK)
-#if !USE_LSB_TAG && !defined WIDE_EMACS_INT
-# error "USE_LSB_TAG not supported on this platform; please report this." \
- "Try 'configure --with-wide-int' to work around the problem."
-error !;
-#endif
-
/* Minimum alignment requirement for Lisp objects, imposed by the
internal representation of tagged pointers. It is 2**GCTYPEBITS if
USE_LSB_TAG, 1 otherwise. It must be a literal integer constant,
@@ -277,7 +271,8 @@ error !;
allocation in a containing union that has GCALIGNED_UNION_MEMBER)
and does not contain a GC-aligned struct or union, putting
GCALIGNED_STRUCT after its closing '}' can help the compiler
- generate better code.
+ generate better code. Also, such structs should be added to the
+ emacs_align_type union in alloc.c.
Although these macros are reasonably portable, they are not
guaranteed on non-GCC platforms, as C11 does not require support
@@ -331,8 +326,8 @@ typedef EMACS_INT Lisp_Word;
used elsewhere.
FIXME: Remove the lisp_h_OP macros, and define just the inline OP
- functions, once "gcc -Og" (new to GCC 4.8) works well enough for
- Emacs developers. Maybe in the year 2020. See Bug#11935.
+ functions, once "gcc -Og" (new to GCC 4.8) or equivalent works well
+ enough for Emacs developers. Maybe in the year 2025. See Bug#11935.
For the macros that have corresponding functions (defined later),
see these functions for commentary. */
@@ -344,24 +339,20 @@ typedef EMACS_INT Lisp_Word;
# define lisp_h_XLI(o) ((EMACS_INT) (o))
# define lisp_h_XIL(i) ((Lisp_Object) (i))
# define lisp_h_XLP(o) ((void *) (o))
-# define lisp_h_XPL(p) ((Lisp_Object) (p))
# else
# define lisp_h_XLI(o) (o)
# define lisp_h_XIL(i) (i)
# define lisp_h_XLP(o) ((void *) (uintptr_t) (o))
-# define lisp_h_XPL(p) ((Lisp_Object) (uintptr_t) (p))
# endif
#else
# if LISP_WORDS_ARE_POINTERS
# define lisp_h_XLI(o) ((EMACS_INT) (o).i)
# define lisp_h_XIL(i) ((Lisp_Object) {(Lisp_Word) (i)})
# define lisp_h_XLP(o) ((void *) (o).i)
-# define lisp_h_XPL(p) lisp_h_XIL (p)
# else
# define lisp_h_XLI(o) ((o).i)
# define lisp_h_XIL(i) ((Lisp_Object) {i})
# define lisp_h_XLP(o) ((void *) (uintptr_t) (o).i)
-# define lisp_h_XPL(p) ((Lisp_Object) {(uintptr_t) (p)})
# endif
#endif
@@ -411,22 +402,25 @@ typedef EMACS_INT Lisp_Word;
# define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
#endif
-/* When compiling via gcc -O0, define the key operations as macros, as
- Emacs is too slow otherwise. To disable this optimization, compile
- with -DINLINING=false. */
-#if (defined __NO_INLINE__ \
- && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \
- && ! (defined INLINING && ! INLINING))
-# define DEFINE_KEY_OPS_AS_MACROS true
-#else
-# define DEFINE_KEY_OPS_AS_MACROS false
+/* When DEFINE_KEY_OPS_AS_MACROS, define key operations as macros to
+ cajole the compiler into inlining them; otherwise define them as
+ inline functions as this is cleaner and can be more efficient.
+ The default is true if the compiler is GCC-like and if function
+ inlining is disabled because the compiler is not optimizing or is
+ optimizing for size. Otherwise the default is false. */
+#ifndef DEFINE_KEY_OPS_AS_MACROS
+# if (defined __NO_INLINE__ \
+ && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__)
+# define DEFINE_KEY_OPS_AS_MACROS true
+# else
+# define DEFINE_KEY_OPS_AS_MACROS false
+# endif
#endif
#if DEFINE_KEY_OPS_AS_MACROS
# define XLI(o) lisp_h_XLI (o)
# define XIL(i) lisp_h_XIL (i)
# define XLP(o) lisp_h_XLP (o)
-# define XPL(p) lisp_h_XPL (p)
# define CHECK_FIXNUM(x) lisp_h_CHECK_FIXNUM (x)
# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x)
# define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x)
@@ -481,6 +475,7 @@ enum Lisp_Type
Lisp_Symbol = 0,
/* Type 1 is currently unused. */
+ Lisp_Type_Unused0 = 1,
/* Fixnum. XFIXNUM (obj) is the integer value. */
Lisp_Int0 = 2,
@@ -584,15 +579,19 @@ INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
Lisp_Object);
/* Defined in bignum.c. */
-extern double bignum_to_double (Lisp_Object);
+extern int check_int_nonnegative (Lisp_Object);
+extern intmax_t check_integer_range (Lisp_Object, intmax_t, intmax_t);
+extern double bignum_to_double (Lisp_Object) ATTRIBUTE_CONST;
extern Lisp_Object make_bigint (intmax_t);
extern Lisp_Object make_biguint (uintmax_t);
+extern uintmax_t check_uinteger_max (Lisp_Object, uintmax_t);
/* Defined in chartab.c. */
-extern Lisp_Object char_table_ref (Lisp_Object, int);
+extern Lisp_Object char_table_ref (Lisp_Object, int) ATTRIBUTE_PURE;
extern void char_table_set (Lisp_Object, int, Lisp_Object);
/* Defined in data.c. */
+extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object);
extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object);
extern Lisp_Object default_value (Lisp_Object symbol);
@@ -731,12 +730,6 @@ INLINE void *
return lisp_h_XLP (o);
}
-INLINE Lisp_Object
-(XPL) (void *p)
-{
- return lisp_h_XPL (p);
-}
-
/* Extract A's type. */
INLINE enum Lisp_Type
@@ -889,8 +882,8 @@ verify (GCALIGNED (struct Lisp_Symbol));
convert it to a Lisp_Word. */
#if LISP_WORDS_ARE_POINTERS
/* untagged_ptr is a pointer so that the compiler knows that TAG_PTR
- yields a pointer; this can help with gcc -fcheck-pointer-bounds.
- It is char * so that adding a tag uses simple machine addition. */
+ yields a pointer. It is char * so that adding a tag uses simple
+ machine addition. */
typedef char *untagged_ptr;
typedef uintptr_t Lisp_Word_tag;
#else
@@ -918,13 +911,9 @@ typedef EMACS_UINT Lisp_Word_tag;
when using a debugger like GDB, on older platforms where the debug
format does not represent C macros. However, they are unbounded
and would just be asking for trouble if checking pointer bounds. */
-#ifdef __CHKP__
-# define DEFINE_LISP_SYMBOL(name)
-#else
-# define DEFINE_LISP_SYMBOL(name) \
- DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) \
- DEFINE_GDB_SYMBOL_END (LISPSYM_INITIALLY (name))
-#endif
+#define DEFINE_LISP_SYMBOL(name) \
+ DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) \
+ DEFINE_GDB_SYMBOL_END (LISPSYM_INITIALLY (name))
/* The index of the C-defined Lisp symbol SYM.
This can be used in a static initializer. */
@@ -998,30 +987,15 @@ XSYMBOL (Lisp_Object a)
eassert (SYMBOLP (a));
intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol);
void *p = (char *) lispsym + i;
-#ifdef __CHKP__
- /* Bypass pointer checking. Although this could be improved it is
- probably not worth the trouble. */
- p = __builtin___bnd_set_ptr_bounds (p, sizeof (struct Lisp_Symbol));
-#endif
return p;
}
INLINE Lisp_Object
make_lisp_symbol (struct Lisp_Symbol *sym)
{
-#ifdef __CHKP__
- /* Although '__builtin___bnd_narrow_ptr_bounds (sym, sym, sizeof *sym)'
- should be more efficient, it runs afoul of GCC bug 83251
- <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=83251>.
- Also, attempting to call __builtin___bnd_chk_ptr_bounds (sym, sizeof *sym)
- here seems to trigger a GCC bug, as yet undiagnosed. */
- char *addr = __builtin___bnd_set_ptr_bounds (sym, sizeof *sym);
- char *symoffset = addr - (intptr_t) lispsym;
-#else
- /* If !__CHKP__, GCC 7 x86-64 generates faster code if lispsym is
+ /* GCC 7 x86-64 generates faster code if lispsym is
cast to char * rather than to intptr_t. */
char *symoffset = (char *) ((char *) sym - (char *) lispsym);
-#endif
Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset);
eassert (XSYMBOL (a) == sym);
return a;
@@ -1070,7 +1044,7 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
with PVEC_TYPE_MASK to indicate the actual type. */
enum pvec_type
{
- PVEC_NORMAL_VECTOR,
+ PVEC_NORMAL_VECTOR, /* Should be first, for sxhash_obj. */
PVEC_FREE,
PVEC_BIGNUM,
PVEC_MARKER,
@@ -1095,7 +1069,7 @@ enum pvec_type
PVEC_CONDVAR,
PVEC_MODULE_FUNCTION,
- /* These should be last, check internal_equal to see why. */
+ /* These should be last, for internal_equal and sxhash_obj. */
PVEC_COMPILED,
PVEC_CHAR_TABLE,
PVEC_SUB_CHAR_TABLE,
@@ -1332,7 +1306,6 @@ dead_object (void)
#define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
#define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
#define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
-#define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
#define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
#define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
#define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
@@ -1669,6 +1642,13 @@ ASIZE (Lisp_Object array)
}
INLINE ptrdiff_t
+gc_asize (Lisp_Object array)
+{
+ /* Like ASIZE, but also can be used in the garbage collector. */
+ return XVECTOR (array)->header.size & ~ARRAY_MARK_FLAG;
+}
+
+INLINE ptrdiff_t
PVSIZE (Lisp_Object pv)
{
return ASIZE (pv) & PSEUDOVECTOR_SIZE_MASK;
@@ -1818,7 +1798,8 @@ bool_vector_uchar_data (Lisp_Object a)
INLINE bool
bool_vector_bitref (Lisp_Object a, EMACS_INT i)
{
- eassume (0 <= i && i < bool_vector_size (a));
+ eassume (0 <= i);
+ eassert (i < bool_vector_size (a));
return !! (bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR]
& (1 << (i % BOOL_VECTOR_BITS_PER_CHAR)));
}
@@ -1834,11 +1815,11 @@ bool_vector_ref (Lisp_Object a, EMACS_INT i)
INLINE void
bool_vector_set (Lisp_Object a, EMACS_INT i, bool b)
{
- unsigned char *addr;
-
- eassume (0 <= i && i < bool_vector_size (a));
- addr = &bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR];
+ eassume (0 <= i);
+ eassert (i < bool_vector_size (a));
+ unsigned char *addr
+ = &bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR];
if (b)
*addr |= 1 << (i % BOOL_VECTOR_BITS_PER_CHAR);
else
@@ -1850,22 +1831,17 @@ bool_vector_set (Lisp_Object a, EMACS_INT i, bool b)
INLINE Lisp_Object
AREF (Lisp_Object array, ptrdiff_t idx)
{
+ eassert (0 <= idx && idx < gc_asize (array));
return XVECTOR (array)->contents[idx];
}
INLINE Lisp_Object *
aref_addr (Lisp_Object array, ptrdiff_t idx)
{
+ eassert (0 <= idx && idx <= gc_asize (array));
return & XVECTOR (array)->contents[idx];
}
-INLINE ptrdiff_t
-gc_asize (Lisp_Object array)
-{
- /* Like ASIZE, but also can be used in the garbage collector. */
- return XVECTOR (array)->header.size & ~ARRAY_MARK_FLAG;
-}
-
INLINE void
ASET (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
{
@@ -1914,18 +1890,12 @@ memclear (void *p, ptrdiff_t nbytes)
(offsetof (type, lastlispfield) + word_size < header_size \
? 0 : (offsetof (type, lastlispfield) + word_size - header_size) / word_size)
-/* Compute A OP B, using the unsigned comparison operator OP. A and B
- should be integer expressions. This is not the same as
- mathematical comparison; for example, UNSIGNED_CMP (0, <, -1)
- returns true. For efficiency, prefer plain unsigned comparison if A
- and B's sizes both fit (after integer promotion). */
-#define UNSIGNED_CMP(a, op, b) \
- (max (sizeof ((a) + 0), sizeof ((b) + 0)) <= sizeof (unsigned) \
- ? ((a) + (unsigned) 0) op ((b) + (unsigned) 0) \
- : ((a) + (uintmax_t) 0) op ((b) + (uintmax_t) 0))
-
/* True iff C is an ASCII character. */
-#define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80)
+INLINE bool
+ASCII_CHAR_P (intmax_t c)
+{
+ return 0 <= c && c < 0x80;
+}
/* A char-table is a kind of vectorlike, with contents are like a
vector but with a few other slots. For some purposes, it makes
@@ -2295,11 +2265,7 @@ struct hash_table_test
struct Lisp_Hash_Table
{
- /* Change pdumper.c if you change the fields here.
-
- IMPORTANT!!!!!!!
-
- Call hash_rehash_if_needed() before accessing. */
+ /* Change pdumper.c if you change the fields here. */
/* This is for Lisp; the hash table code does not refer to it. */
union vectorlike_header header;
@@ -2418,20 +2384,7 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
return size;
}
-void hash_table_rehash (struct Lisp_Hash_Table *h);
-
-INLINE bool
-hash_rehash_needed_p (const struct Lisp_Hash_Table *h)
-{
- return NILP (h->hash);
-}
-
-INLINE void
-hash_rehash_if_needed (struct Lisp_Hash_Table *h)
-{
- if (hash_rehash_needed_p (h))
- hash_table_rehash (h);
-}
+void hash_table_rehash (Lisp_Object);
/* Default size for hash tables if not specified. */
@@ -2798,8 +2751,10 @@ struct Lisp_Float
{
double data;
struct Lisp_Float *chain;
+ GCALIGNED_UNION_MEMBER
} u;
- } GCALIGNED_STRUCT;
+ };
+verify (GCALIGNED (struct Lisp_Float));
INLINE bool
(FLOATP) (Lisp_Object x)
@@ -2997,28 +2952,6 @@ CHECK_FIXNAT (Lisp_Object x)
CHECK_TYPE (FIXNATP (x), Qwholenump, x);
}
-#define CHECK_RANGED_INTEGER(x, lo, hi) \
- do { \
- CHECK_FIXNUM (x); \
- if (! ((lo) <= XFIXNUM (x) && XFIXNUM (x) <= (hi))) \
- args_out_of_range_3 (x, INT_TO_INTEGER (lo), INT_TO_INTEGER (hi)); \
- } while (false)
-#define CHECK_TYPE_RANGED_INTEGER(type, x) \
- do { \
- if (TYPE_SIGNED (type)) \
- CHECK_RANGED_INTEGER (x, TYPE_MINIMUM (type), TYPE_MAXIMUM (type)); \
- else \
- CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \
- } while (false)
-
-#define CHECK_FIXNUM_COERCE_MARKER(x) \
- do { \
- if (MARKERP ((x))) \
- XSETFASTINT (x, marker_position (x)); \
- else \
- CHECK_TYPE (FIXNUMP (x), Qinteger_or_marker_p, x); \
- } while (false)
-
INLINE double
XFLOATINT (Lisp_Object n)
{
@@ -3038,22 +2971,6 @@ CHECK_INTEGER (Lisp_Object x)
{
CHECK_TYPE (INTEGERP (x), Qnumberp, x);
}
-
-#define CHECK_NUMBER_COERCE_MARKER(x) \
- do { \
- if (MARKERP (x)) \
- XSETFASTINT (x, marker_position (x)); \
- else \
- CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); \
- } while (false)
-
-#define CHECK_INTEGER_COERCE_MARKER(x) \
- do { \
- if (MARKERP (x)) \
- XSETFASTINT (x, marker_position (x)); \
- else \
- CHECK_TYPE (INTEGERP (x), Qnumber_or_marker_p, x); \
- } while (false)
/* If we're not dumping using the legacy dumper and we might be using
@@ -3385,6 +3302,27 @@ struct frame;
#define HAVE_EXT_TOOL_BAR true
#endif
+/* Return the address of vector A's element at index I. */
+
+INLINE Lisp_Object *
+xvector_contents_addr (Lisp_Object a, ptrdiff_t i)
+{
+ /* This should return &XVECTOR (a)->contents[i], but that would run
+ afoul of GCC bug 95072. */
+ void *v = XVECTOR (a);
+ char *p = v;
+ void *w = p + header_size + i * word_size;
+ return w;
+}
+
+/* Return the address of vector A's elements. */
+
+INLINE Lisp_Object *
+xvector_contents (Lisp_Object a)
+{
+ return xvector_contents_addr (a, 0);
+}
+
/* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */
INLINE void
@@ -3392,7 +3330,7 @@ vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object const *args,
ptrdiff_t count)
{
eassert (0 <= offset && 0 <= count && offset + count <= ASIZE (v));
- memcpy (XVECTOR (v)->contents + offset, args, count * sizeof *args);
+ memcpy (xvector_contents_addr (v, offset), args, count * sizeof *args);
}
/* Functions to modify hash tables. */
@@ -3507,9 +3445,9 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
/* Defined in bignum.c. This part of bignum.c's API does not require
the caller to access bignum internals; see bignum.h for that. */
-extern intmax_t bignum_to_intmax (Lisp_Object);
-extern uintmax_t bignum_to_uintmax (Lisp_Object);
-extern ptrdiff_t bignum_bufsize (Lisp_Object, int);
+extern intmax_t bignum_to_intmax (Lisp_Object) ATTRIBUTE_CONST;
+extern uintmax_t bignum_to_uintmax (Lisp_Object) ATTRIBUTE_CONST;
+extern ptrdiff_t bignum_bufsize (Lisp_Object, int) ATTRIBUTE_CONST;
extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int);
extern Lisp_Object bignum_to_string (Lisp_Object, int);
extern Lisp_Object make_bignum_str (char const *, int);
@@ -3600,7 +3538,6 @@ extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t);
extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
extern AVOID args_out_of_range (Lisp_Object, Lisp_Object);
-extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object);
extern AVOID circular_list (Lisp_Object);
extern Lisp_Object do_symval_forwarding (lispfwd);
enum Set_Internal_Bind {
@@ -3653,7 +3590,7 @@ extern bool sweep_weak_table (struct Lisp_Hash_Table *, bool);
extern void hexbuf_digest (char *, void const *, int);
extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *);
EMACS_UINT hash_string (char const *, ptrdiff_t);
-EMACS_UINT sxhash (Lisp_Object, int);
+EMACS_UINT sxhash (Lisp_Object);
Lisp_Object hashfn_eql (Lisp_Object, struct Lisp_Hash_Table *);
Lisp_Object hashfn_equal (Lisp_Object, struct Lisp_Hash_Table *);
Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *);
@@ -3813,20 +3750,47 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t,
/* Defined in alloc.c. */
extern void *my_heap_start (void);
extern void check_pure_size (void);
-extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT);
+unsigned char *resize_string_data (Lisp_Object, ptrdiff_t, int, int);
extern void malloc_warning (const char *);
extern AVOID memory_full (size_t);
extern AVOID buffer_memory_full (ptrdiff_t);
extern bool survives_gc_p (Lisp_Object);
extern void mark_object (Lisp_Object);
+extern void mark_objects (Lisp_Object *, ptrdiff_t);
#if defined REL_ALLOC && !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
extern void refill_memory_reserve (void);
#endif
extern void alloc_unexec_pre (void);
extern void alloc_unexec_post (void);
-extern void mark_maybe_objects (Lisp_Object const *, ptrdiff_t);
extern void mark_stack (char const *, char const *);
-extern void flush_stack_call_func (void (*func) (void *arg), void *arg);
+extern void flush_stack_call_func1 (void (*func) (void *arg), void *arg);
+
+/* Force callee-saved registers and register windows onto the stack,
+ so that conservative garbage collection can see their values. */
+#ifndef HAVE___BUILTIN_UNWIND_INIT
+# ifdef __sparc__
+ /* This trick flushes the register windows so that all the state of
+ the process is contained in the stack.
+ FreeBSD does not have a ta 3 handler, so handle it specially.
+ FIXME: Code in the Boehm GC suggests flushing (with 'flushrs') is
+ needed on ia64 too. See mach_dep.c, where it also says inline
+ assembler doesn't work with relevant proprietary compilers. */
+# if defined __sparc64__ && defined __FreeBSD__
+# define __builtin_unwind_init() asm ("flushw")
+# else
+# define __builtin_unwind_init() asm ("ta 3")
+# endif
+# else
+# define __builtin_unwind_init() ((void) 0)
+# endif
+#endif
+INLINE void
+flush_stack_call_func (void (*func) (void *arg), void *arg)
+{
+ __builtin_unwind_init ();
+ flush_stack_call_func1 (func, arg);
+}
+
extern void garbage_collect (void);
extern void maybe_garbage_collect (void);
extern const char *pending_malloc_warning;
@@ -3941,8 +3905,7 @@ build_string (const char *str)
extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object);
-extern void make_byte_code (struct Lisp_Vector *);
-extern struct Lisp_Vector *allocate_vector (ptrdiff_t);
+extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t);
/* Make an uninitialized vector for SIZE objects. NOTE: you must
be sure that GC cannot happen until the vector is completely
@@ -3951,7 +3914,11 @@ extern struct Lisp_Vector *allocate_vector (ptrdiff_t);
v = make_uninit_vector (3);
ASET (v, 0, obj0);
ASET (v, 1, Ffunction_can_gc ());
- ASET (v, 2, obj1); */
+ ASET (v, 2, obj1);
+
+ allocate_vector has a similar problem. */
+
+extern struct Lisp_Vector *allocate_vector (ptrdiff_t);
INLINE Lisp_Object
make_uninit_vector (ptrdiff_t size)
@@ -3973,14 +3940,13 @@ make_uninit_sub_char_table (int depth, int min_char)
return v;
}
-/* Make a vector of SIZE nils. */
+/* Make a vector of SIZE nils - faster than make_vector (size, Qnil)
+ if the OS already cleared the new memory. */
INLINE Lisp_Object
make_nil_vector (ptrdiff_t size)
{
- Lisp_Object vec = make_uninit_vector (size);
- memclear (XVECTOR (vec)->contents, size * word_size);
- return vec;
+ return make_lisp_ptr (allocate_nil_vector (size), Lisp_Vectorlike);
}
extern struct Lisp_Vector *allocate_pseudovector (int, int, int,
@@ -4244,8 +4210,12 @@ extern Lisp_Object funcall_module (Lisp_Object, ptrdiff_t, Lisp_Object *);
extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *);
extern Lisp_Object module_function_documentation
(struct Lisp_Module_Function const *);
+extern Lisp_Object module_function_interactive_form
+ (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 *);
+extern void module_finalize_function (const struct Lisp_Module_Function *);
extern void mark_modules (void);
extern void init_module_assertions (bool);
extern void syms_of_module (void);
@@ -4605,6 +4575,8 @@ extern void seed_random (void *, ptrdiff_t);
extern void init_random (void);
extern void emacs_backtrace (int);
extern AVOID emacs_abort (void) NO_INLINE;
+extern int emacs_fstatat (int, char const *, void *, int);
+extern int emacs_openat (int, char const *, int, int);
extern int emacs_open (const char *, int, int);
extern int emacs_pipe (int[2]);
extern int emacs_close (int);
@@ -4777,6 +4749,17 @@ lispstpcpy (char *dest, Lisp_Object string)
return dest + len;
}
+#if (defined HAVE___LSAN_IGNORE_OBJECT \
+ && defined HAVE_SANITIZER_LSAN_INTERFACE_H)
+# include <sanitizer/lsan_interface.h>
+#else
+/* Treat *P as a non-leak. */
+INLINE void
+__lsan_ignore_object (void const *p)
+{
+}
+#endif
+
extern void xputenv (const char *);
extern char *egetenv_internal (const char *, ptrdiff_t);
@@ -4892,7 +4875,10 @@ safe_free_unbind_to (ptrdiff_t count, ptrdiff_t sa_count, Lisp_Object val)
(buf) = AVAIL_ALLOCA (alloca_nbytes); \
else \
{ \
- (buf) = xmalloc (alloca_nbytes); \
+ /* Although only the first nelt words need clearing, \
+ typically EXTRA is 0 or small so just use xzalloc; \
+ this is simpler and often faster. */ \
+ (buf) = xzalloc (alloca_nbytes); \
record_unwind_protect_array (buf, nelt); \
} \
} while (false)
diff --git a/src/lread.c b/src/lread.c
index f9a8cb3e1a0..4b788e99407 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -152,12 +152,6 @@ static ptrdiff_t prev_saved_doc_string_length;
/* This is the file position that string came from. */
static file_offset prev_saved_doc_string_position;
-/* True means inside a new-style backquote with no surrounding
- parentheses. Fread initializes this to the value of
- `force_new_style_backquotes', so we need not specbind it or worry
- about what happens to it when there is an error. */
-static bool new_backquote_flag;
-
/* A list of file names for files being loaded in Fload. Used to
check for recursive loads. */
@@ -231,8 +225,9 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
{
/* Fetch the character code from the buffer. */
unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
- BUF_INC_POS (inbuffer, pt_byte);
- c = STRING_CHAR (p);
+ int clen;
+ c = string_char_and_length (p, &clen);
+ pt_byte += clen;
if (multibyte)
*multibyte = 1;
}
@@ -260,8 +255,9 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
{
/* Fetch the character code from the buffer. */
unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
- BUF_INC_POS (inbuffer, bytepos);
- c = STRING_CHAR (p);
+ int clen;
+ c = string_char_and_length (p, &clen);
+ bytepos += clen;
if (multibyte)
*multibyte = 1;
}
@@ -300,9 +296,10 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
{
if (multibyte)
*multibyte = 1;
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun,
- read_from_string_index,
- read_from_string_index_byte);
+ c = (fetch_string_char_advance_no_check
+ (readcharfun,
+ &read_from_string_index,
+ &read_from_string_index_byte));
}
else
{
@@ -433,7 +430,7 @@ unreadchar (Lisp_Object readcharfun, int c)
ptrdiff_t bytepos = BUF_PT_BYTE (b);
if (! NILP (BVAR (b, enable_multibyte_characters)))
- BUF_DEC_POS (b, bytepos);
+ bytepos -= buf_prev_char_len (b, bytepos);
else
bytepos--;
@@ -446,7 +443,7 @@ unreadchar (Lisp_Object readcharfun, int c)
XMARKER (readcharfun)->charpos--;
if (! NILP (BVAR (b, enable_multibyte_characters)))
- BUF_DEC_POS (b, bytepos);
+ bytepos -= buf_prev_char_len (b, bytepos);
else
bytepos--;
@@ -532,13 +529,11 @@ readbyte_from_string (int c, Lisp_Object readcharfun)
= string_char_to_byte (string, read_from_string_index);
}
- if (read_from_string_index >= read_from_string_limit)
- c = -1;
- else
- FETCH_STRING_CHAR_ADVANCE (c, string,
- read_from_string_index,
- read_from_string_index_byte);
- return c;
+ return (read_from_string_index < read_from_string_limit
+ ? fetch_string_char_advance (string,
+ &read_from_string_index,
+ &read_from_string_index_byte)
+ : -1);
}
@@ -985,9 +980,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun)
/* Value is a version number of byte compiled code if the file
associated with file descriptor FD is a compiled Lisp file that's
- safe to load. Only files compiled with Emacs are safe to load.
- Files compiled with XEmacs can lead to a crash in Fbyte_code
- because of an incompatible change in the byte compiler. */
+ safe to load. Only files compiled with Emacs can be loaded. */
static int
safe_to_load_version (int fd)
@@ -1035,22 +1028,16 @@ load_error_handler (Lisp_Object data)
return Qnil;
}
-static AVOID
-load_error_old_style_backquotes (void)
-{
- if (NILP (Vload_file_name))
- xsignal1 (Qerror, build_string ("Old-style backquotes detected!"));
- else
- {
- AUTO_STRING (format, "Loading `%s': old-style backquotes detected!");
- xsignal1 (Qerror, CALLN (Fformat_message, format, Vload_file_name));
- }
-}
-
static void
load_warn_unescaped_character_literals (Lisp_Object file)
{
- Lisp_Object warning = call0 (Qbyte_run_unescaped_character_literals_warning);
+ Lisp_Object function
+ = Fsymbol_function (Qbyte_run_unescaped_character_literals_warning);
+ /* If byte-run.el is being loaded,
+ `byte-run--unescaped-character-literals-warning' isn't yet
+ defined. Since it'll be byte-compiled later, ignore potential
+ unescaped character literals. */
+ Lisp_Object warning = NILP (function) ? Qnil : call0 (function);
if (!NILP (warning))
{
AUTO_STRING (format, "Loading `%s': %s");
@@ -1153,7 +1140,6 @@ Return t if the file exists and loads successfully. */)
/* True means we are loading a compiled file. */
bool compiled = 0;
Lisp_Object handler;
- bool safe_p = 1;
const char *fmode = "r" FOPEN_TEXT;
int version;
@@ -1199,6 +1185,9 @@ Return t if the file exists and loads successfully. */)
|| suffix_p (file, ".elc")
#ifdef HAVE_MODULES
|| suffix_p (file, MODULES_SUFFIX)
+#ifdef MODULES_SECONDARY_SUFFIX
+ || suffix_p (file, MODULES_SECONDARY_SUFFIX)
+#endif
#endif
)
must_suffix = Qnil;
@@ -1268,7 +1257,12 @@ Return t if the file exists and loads successfully. */)
}
#ifdef HAVE_MODULES
- bool is_module = suffix_p (found, MODULES_SUFFIX);
+ bool is_module =
+ suffix_p (found, MODULES_SUFFIX)
+#ifdef MODULES_SECONDARY_SUFFIX
+ || suffix_p (found, MODULES_SECONDARY_SUFFIX)
+#endif
+ ;
#else
bool is_module = false;
#endif
@@ -1328,11 +1322,7 @@ Return t if the file exists and loads successfully. */)
if (version < 0
&& ! (version = safe_to_load_version (fd)))
{
- safe_p = 0;
- if (!load_dangerous_libraries)
- error ("File `%s' was not compiled in Emacs", SDATA (found));
- else if (!NILP (nomessage) && !force_load_messages)
- message_with_string ("File `%s' not compiled in Emacs", found, 1);
+ error ("File `%s' was not compiled in Emacs", SDATA (found));
}
compiled = 1;
@@ -1345,11 +1335,11 @@ Return t if the file exists and loads successfully. */)
ignores suffix order due to load_prefer_newer. */
if (!load_prefer_newer && is_elc)
{
- result = stat (SSDATA (efound), &s1);
+ result = emacs_fstatat (AT_FDCWD, SSDATA (efound), &s1, 0);
if (result == 0)
{
SSET (efound, SBYTES (efound) - 1, 0);
- result = stat (SSDATA (efound), &s2);
+ result = emacs_fstatat (AT_FDCWD, SSDATA (efound), &s2, 0);
SSET (efound, SBYTES (efound) - 1, 'c');
}
@@ -1439,10 +1429,7 @@ Return t if the file exists and loads successfully. */)
if (NILP (nomessage) || force_load_messages)
{
- if (!safe_p)
- message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
- file, 1);
- else if (is_module)
+ if (is_module)
message_with_string ("Loading %s (module)...", file, 1);
else if (!compiled)
message_with_string ("Loading %s (source)...", file, 1);
@@ -1502,10 +1489,7 @@ Return t if the file exists and loads successfully. */)
if (!noninteractive && (NILP (nomessage) || force_load_messages))
{
- if (!safe_p)
- message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
- file, 1);
- else if (is_module)
+ if (is_module)
message_with_string ("Loading %s (module)...done", file, 1);
else if (!compiled)
message_with_string ("Loading %s (source)...done", file, 1);
@@ -2275,7 +2259,6 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
Lisp_Object retval;
readchar_count = 0;
- new_backquote_flag = force_new_style_backquotes;
/* We can get called from readevalloop which may have set these
already. */
if (! HASH_TABLE_P (read_objects_map)
@@ -2983,9 +2966,46 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
struct Lisp_Vector *vec;
tmp = read_vector (readcharfun, 1);
vec = XVECTOR (tmp);
- if (vec->header.size == 0)
- invalid_syntax ("Empty byte-code object");
- make_byte_code (vec);
+ if (! (COMPILED_STACK_DEPTH < ASIZE (tmp)
+ && (FIXNUMP (AREF (tmp, COMPILED_ARGLIST))
+ || CONSP (AREF (tmp, COMPILED_ARGLIST))
+ || NILP (AREF (tmp, COMPILED_ARGLIST)))
+ && ((STRINGP (AREF (tmp, COMPILED_BYTECODE))
+ && VECTORP (AREF (tmp, COMPILED_CONSTANTS)))
+ || CONSP (AREF (tmp, COMPILED_BYTECODE)))
+ && FIXNATP (AREF (tmp, COMPILED_STACK_DEPTH))))
+ invalid_syntax ("Invalid byte-code object");
+
+ if (STRINGP (AREF (tmp, COMPILED_BYTECODE))
+ && STRING_MULTIBYTE (AREF (tmp, COMPILED_BYTECODE)))
+ {
+ /* BYTESTR must have been produced by Emacs 20.2 or earlier
+ because it produced a raw 8-bit string for byte-code and
+ now such a byte-code string is loaded as multibyte with
+ raw 8-bit characters converted to multibyte form.
+ Convert them back to the original unibyte form. */
+ ASET (tmp, COMPILED_BYTECODE,
+ Fstring_as_unibyte (AREF (tmp, COMPILED_BYTECODE)));
+ }
+
+ if (COMPILED_DOC_STRING < ASIZE (tmp)
+ && EQ (AREF (tmp, COMPILED_DOC_STRING), make_fixnum (0)))
+ {
+ /* read_list found a docstring like '(#$ . 5521)' and treated it
+ as 0. This placeholder 0 would lead to accidental sharing in
+ purecopy's hash-consing, so replace it with a (hopefully)
+ unique integer placeholder, which is negative so that it is
+ not confused with a DOC file offset (the USE_LSB_TAG shift
+ relies on the fact that VALMASK is one bit narrower than
+ INTMASK). Eventually Snarf-documentation should replace the
+ placeholder with the actual docstring. */
+ verify (INTMASK & ~VALMASK);
+ EMACS_UINT hash = ((XHASH (tmp) >> USE_LSB_TAG)
+ | (INTMASK - INTMASK / 2));
+ ASET (tmp, COMPILED_DOC_STRING, make_ufixnum (hash));
+ }
+
+ XSETPVECTYPE (vec, PVEC_COMPILED);
return tmp;
}
if (c == '(')
@@ -3263,70 +3283,24 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
return list2 (Qquote, read0 (readcharfun));
case '`':
- {
- int next_char = READCHAR;
- UNREAD (next_char);
- /* Transition from old-style to new-style:
- If we see "(`" it used to mean old-style, which usually works
- fine because ` should almost never appear in such a position
- for new-style. But occasionally we need "(`" to mean new
- style, so we try to distinguish the two by the fact that we
- can either write "( `foo" or "(` foo", where the first
- intends to use new-style whereas the second intends to use
- old-style. For Emacs-25, we should completely remove this
- first_in_list exception (old-style can still be obtained via
- "(\`" anyway). */
- if (!new_backquote_flag && first_in_list && next_char == ' ')
- load_error_old_style_backquotes ();
- else
- {
- Lisp_Object value;
- bool saved_new_backquote_flag = new_backquote_flag;
+ return list2 (Qbackquote, read0 (readcharfun));
- new_backquote_flag = 1;
- value = read0 (readcharfun);
- new_backquote_flag = saved_new_backquote_flag;
-
- return list2 (Qbackquote, value);
- }
- }
case ',':
{
- int next_char = READCHAR;
- UNREAD (next_char);
- /* Transition from old-style to new-style:
- It used to be impossible to have a new-style , other than within
- a new-style `. This is sufficient when ` and , are used in the
- normal way, but ` and , can also appear in args to macros that
- will not interpret them in the usual way, in which case , may be
- used without any ` anywhere near.
- So we now use the same heuristic as for backquote: old-style
- unquotes are only recognized when first on a list, and when
- followed by a space.
- Because it's more difficult to peek 2 chars ahead, a new-style
- ,@ can still not be used outside of a `, unless it's in the middle
- of a list. */
- if (new_backquote_flag
- || !first_in_list
- || (next_char != ' ' && next_char != '@'))
- {
- Lisp_Object comma_type = Qnil;
- Lisp_Object value;
- int ch = READCHAR;
-
- if (ch == '@')
- comma_type = Qcomma_at;
- else
- {
- if (ch >= 0) UNREAD (ch);
- comma_type = Qcomma;
- }
+ Lisp_Object comma_type = Qnil;
+ Lisp_Object value;
+ int ch = READCHAR;
- value = read0 (readcharfun);
- return list2 (comma_type, value);
- }
+ if (ch == '@')
+ comma_type = Qcomma_at;
else
- load_error_old_style_backquotes ();
+ {
+ if (ch >= 0) UNREAD (ch);
+ comma_type = Qcomma;
+ }
+
+ value = read0 (readcharfun);
+ return list2 (comma_type, value);
}
case '?':
{
@@ -3869,10 +3843,12 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag)
{
Lisp_Object tem = read_list (1, readcharfun);
ptrdiff_t size = list_length (tem);
- if (bytecodeflag && size <= COMPILED_STACK_DEPTH)
- error ("Invalid byte code");
Lisp_Object vector = make_nil_vector (size);
+ /* Avoid accessing past the end of a vector if the vector is too
+ small to be valid for bytecode. */
+ bytecodeflag &= COMPILED_STACK_DEPTH < size;
+
Lisp_Object *ptr = XVECTOR (vector)->contents;
for (ptrdiff_t i = 0; i < size; i++)
{
@@ -4128,6 +4104,9 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
{
make_symbol_constant (sym);
XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL;
+ /* Mark keywords as special. This makes (let ((:key 'foo)) ...)
+ in lexically bound elisp signal an error, as documented. */
+ XSYMBOL (sym)->u.s.declared_special = true;
SET_SYMBOL_VAL (XSYMBOL (sym), sym);
}
@@ -4856,9 +4835,16 @@ 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. */);
#ifdef HAVE_MODULES
+#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));
+#endif
#else
Vload_suffixes = list2 (build_pure_c_string (".elc"),
build_pure_c_string (".el"));
@@ -5007,7 +4993,7 @@ This overrides the value of the NOMESSAGE argument to `load'. */);
When Emacs loads a compiled Lisp file, it reads the first 512 bytes
from the file, and matches them against this regular expression.
When the regular expression matches, the file is considered to be safe
-to load. See also `load-dangerous-libraries'. */);
+to load. */);
Vbytecomp_version_regexp
= build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
@@ -5050,17 +5036,6 @@ 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 ("force-new-style-backquotes", force_new_style_backquotes,
- doc: /* Non-nil means to always use the current syntax for backquotes.
-If nil, `load' and `read' raise errors when encountering some
-old-style variants of backquote and comma. If non-nil, these
-constructs are always interpreted as described in the Info node
-`(elisp)Backquote', even if that interpretation is incompatible with
-previous versions of Emacs. Setting this variable to non-nil makes
-Emacs compatible with the behavior planned for Emacs 28. In Emacs 28,
-this variable will become obsolete. */);
- force_new_style_backquotes = false;
-
/* Vsource_directory was initialized in init_lread. */
DEFSYM (Qcurrent_load_list, "current-load-list");
diff --git a/src/macfont.m b/src/macfont.m
index c589b6685eb..904814647f9 100644
--- a/src/macfont.m
+++ b/src/macfont.m
@@ -1120,13 +1120,17 @@ struct macfont_metrics
glyph width. The `width_int' member is an integer that is
closest to the width. The `width_frac' member is the fractional
adjustment representing a value in [-.5, .5], multiplied by
- WIDTH_FRAC_SCALE. For synthetic monospace fonts, they represent
+ WIDTH_FRAC_SCALE. For monospace fonts, non-zero `width_frac'
+ means `width_int' is further adjusted to a multiple of the
+ (rounded) font width, and `width_frac' represents adjustment per
+ unit character. For synthetic monospace fonts, they represent
the advance delta for centering instead of the glyph width. */
signed width_frac : WIDTH_FRAC_BITS, width_int : 16 - WIDTH_FRAC_BITS;
};
#define METRICS_VALUE(metrics, member) \
- (((metrics)->member##_high << 8) | (metrics)->member##_low)
+ ((int) (((unsigned int) (metrics)->member##_high << 8) \
+ | (metrics)->member##_low))
#define METRICS_SET_VALUE(metrics, member, value) \
do {short tmp = (value); (metrics)->member##_low = tmp & 0xff; \
(metrics)->member##_high = tmp >> 8;} while (0)
@@ -1147,6 +1151,27 @@ enum metrics_status
#define LCD_FONT_SMOOTHING_LEFT_MARGIN (0.396f)
#define LCD_FONT_SMOOTHING_RIGHT_MARGIN (0.396f)
+/* If FONT is monospace and WIDTH can be regarded as a multiple of its
+ width where the multiplier is greater than 1, then return the
+ multiplier. Otherwise return 0. */
+static int
+macfont_monospace_width_multiplier (struct font *font, CGFloat width)
+{
+ struct macfont_info *macfont_info = (struct macfont_info *) font;
+ int multiplier = 0;
+
+ if (macfont_info->spacing == MACFONT_SPACING_MONO
+ && font->space_width != 0)
+ {
+ multiplier = lround (width / font->space_width);
+ if (multiplier == 1
+ || lround (width / multiplier) != font->space_width)
+ multiplier = 0;
+ }
+
+ return multiplier;
+}
+
static int
macfont_glyph_extents (struct font *font, CGGlyph glyph,
struct font_metrics *metrics, CGFloat *advance_delta,
@@ -1191,13 +1216,38 @@ macfont_glyph_extents (struct font *font, CGGlyph glyph,
else
fwidth = mac_font_get_advance_width_for_glyph (macfont, glyph);
- /* For synthetic mono fonts, cache->width_{int,frac} holds the
- advance delta value. */
- if (macfont_info->spacing == MACFONT_SPACING_SYNTHETIC_MONO)
- fwidth = (font->pixel_size - fwidth) / 2;
- cache->width_int = lround (fwidth);
- cache->width_frac = lround ((fwidth - cache->width_int)
- * WIDTH_FRAC_SCALE);
+ if (macfont_info->spacing == MACFONT_SPACING_MONO)
+ {
+ /* Some monospace fonts for programming languages contain
+ wider ligature glyphs consisting of multiple characters.
+ For such glyphs, simply rounding the combined fractional
+ width to an integer can result in a value that is not a
+ multiple of the (rounded) font width. */
+ int multiplier = macfont_monospace_width_multiplier (font, fwidth);
+
+ if (multiplier)
+ {
+ cache->width_int = font->space_width * multiplier;
+ cache->width_frac = lround ((fwidth / multiplier
+ - font->space_width)
+ * WIDTH_FRAC_SCALE);
+ }
+ else
+ {
+ cache->width_int = lround (fwidth);
+ cache->width_frac = 0;
+ }
+ }
+ else
+ {
+ /* For synthetic mono fonts, cache->width_{int,frac} holds
+ the advance delta value. */
+ if (macfont_info->spacing == MACFONT_SPACING_SYNTHETIC_MONO)
+ fwidth = (font->pixel_size - fwidth) / 2;
+ cache->width_int = lround (fwidth);
+ cache->width_frac = lround ((fwidth - cache->width_int)
+ * WIDTH_FRAC_SCALE);
+ }
METRICS_SET_STATUS (cache, METRICS_WIDTH_VALID);
}
if (macfont_info->spacing == MACFONT_SPACING_SYNTHETIC_MONO)
@@ -1234,6 +1284,10 @@ macfont_glyph_extents (struct font *font, CGGlyph glyph,
/ (CGFloat) (WIDTH_FRAC_SCALE * 2));
break;
case MACFONT_SPACING_MONO:
+ if (cache->width_frac)
+ bounds.origin.x += - ((cache->width_frac
+ / (CGFloat) (WIDTH_FRAC_SCALE * 2))
+ * (cache->width_int / font->space_width));
break;
case MACFONT_SPACING_SYNTHETIC_MONO:
bounds.origin.x += (cache->width_int
@@ -1270,7 +1324,16 @@ macfont_glyph_extents (struct font *font, CGGlyph glyph,
/ (CGFloat) (WIDTH_FRAC_SCALE * 2)));
break;
case MACFONT_SPACING_MONO:
- *advance_delta = 0;
+ if (cache->width_frac)
+ *advance_delta = 0;
+ else
+ {
+ CGFloat delta = - ((cache->width_frac
+ / (CGFloat) (WIDTH_FRAC_SCALE * 2))
+ * (cache->width_int / font->space_width));
+
+ *advance_delta = (force_integral_p ? round (delta) : delta);
+ }
break;
case MACFONT_SPACING_SYNTHETIC_MONO:
*advance_delta = (force_integral_p ? cache->width_int
@@ -3014,7 +3077,7 @@ macfont_shape (Lisp_Object lgstring, Lisp_Object direction)
struct mac_glyph_layout *gl = glyph_layouts + i;
EMACS_INT from, to;
struct font_metrics metrics;
- int xoff, yoff, wadjust;
+ int xoff, yoff, wadjust, multiplier;
if (NILP (lglyph))
{
@@ -3067,13 +3130,15 @@ macfont_shape (Lisp_Object lgstring, Lisp_Object direction)
xoff = lround (gl->advance_delta);
yoff = lround (- gl->baseline_delta);
- wadjust = lround (gl->advance);
+ multiplier = macfont_monospace_width_multiplier (font, gl->advance);
+ if (multiplier)
+ wadjust = font->space_width * multiplier;
+ else
+ wadjust = lround (gl->advance);
if (xoff != 0 || yoff != 0 || wadjust != metrics.width)
{
- Lisp_Object vec = make_uninit_vector (3);
- ASET (vec, 0, make_fixnum (xoff));
- ASET (vec, 1, make_fixnum (yoff));
- ASET (vec, 2, make_fixnum (wadjust));
+ Lisp_Object vec = CALLN (Fvector, make_fixnum (xoff),
+ make_fixnum (yoff), make_fixnum (wadjust));
LGLYPH_SET_ADJUSTMENT (lglyph, vec);
}
}
diff --git a/src/marker.c b/src/marker.c
index 684b7509c51..64f210db88b 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -221,7 +221,7 @@ buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos)
while (best_below != charpos)
{
best_below++;
- BUF_INC_POS (b, best_below_byte);
+ best_below_byte += buf_next_char_len (b, best_below_byte);
}
/* If this position is quite far from the nearest known position,
@@ -246,7 +246,7 @@ buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos)
while (best_above != charpos)
{
best_above--;
- BUF_DEC_POS (b, best_above_byte);
+ best_above_byte -= buf_prev_char_len (b, best_above_byte);
}
/* If this position is quite far from the nearest known position,
@@ -372,7 +372,7 @@ buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
while (best_below_byte < bytepos)
{
best_below++;
- BUF_INC_POS (b, best_below_byte);
+ best_below_byte += buf_next_char_len (b, best_below_byte);
}
/* If this position is quite far from the nearest known position,
@@ -399,7 +399,7 @@ buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
while (best_above_byte > bytepos)
{
best_above--;
- BUF_DEC_POS (b, best_above_byte);
+ best_above_byte -= buf_prev_char_len (b, best_above_byte);
}
/* If this position is quite far from the nearest known position,
@@ -804,7 +804,7 @@ verify_bytepos (ptrdiff_t charpos)
while (below != charpos)
{
below++;
- BUF_INC_POS (current_buffer, below_byte);
+ below_byte += buf_next_char_len (current_buffer, below_byte);
}
return below_byte;
diff --git a/src/menu.c b/src/menu.c
index 28bfcae05d6..e4fda572cd8 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -1036,9 +1036,7 @@ menu_item_width (const unsigned char *str)
for (len = 0, p = str; *p; )
{
- int ch_len;
- int ch = STRING_CHAR_AND_LENGTH (p, ch_len);
-
+ int ch_len, ch = string_char_and_length (p, &ch_len);
len += CHARACTER_WIDTH (ch);
p += ch_len;
}
@@ -1253,18 +1251,16 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu)
but I don't want to make one now. */
CHECK_WINDOW (window);
- CHECK_RANGED_INTEGER (x,
- (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
- ? (EMACS_INT) INT_MIN - xpos
- : MOST_NEGATIVE_FIXNUM),
- INT_MAX - xpos);
- CHECK_RANGED_INTEGER (y,
- (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
- ? (EMACS_INT) INT_MIN - ypos
- : MOST_NEGATIVE_FIXNUM),
- INT_MAX - ypos);
- xpos += XFIXNUM (x);
- ypos += XFIXNUM (y);
+ xpos += check_integer_range (x,
+ (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
+ ? (EMACS_INT) INT_MIN - xpos
+ : MOST_NEGATIVE_FIXNUM),
+ INT_MAX - xpos);
+ ypos += check_integer_range (y,
+ (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
+ ? (EMACS_INT) INT_MIN - ypos
+ : MOST_NEGATIVE_FIXNUM),
+ INT_MAX - ypos);
XSETFRAME (Vmenu_updating_frame, f);
}
diff --git a/src/mini-gmp-emacs.c b/src/mini-gmp-emacs.c
deleted file mode 100644
index b8399b075e0..00000000000
--- a/src/mini-gmp-emacs.c
+++ /dev/null
@@ -1,32 +0,0 @@
-/* Tailor mini-gmp.c for GNU Emacs
-
-Copyright 2018-2020 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software: you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or (at
-your option) any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
-
-#include <config.h>
-
-#include <stddef.h>
-
-/* Pacify GCC -Wsuggest-attribute=malloc. */
-static void *gmp_default_alloc (size_t) ATTRIBUTE_MALLOC;
-
-/* Pacify GCC -Wunused-variable for variables used only in 'assert' calls. */
-#if defined NDEBUG && GNUC_PREREQ (4, 6, 0)
-# pragma GCC diagnostic ignored "-Wunused-variable"
-#endif
-
-#include "mini-gmp.c"
diff --git a/src/minibuf.c b/src/minibuf.c
index b837cc53eb9..f957b2ae173 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -251,7 +251,7 @@ read_minibuf_noninteractive (Lisp_Object prompt, bool expflag,
else
{
xfree (line);
- error ("Error reading from stdin");
+ xsignal1 (Qend_of_file, build_string ("Error reading from stdin"));
}
/* If Lisp form desired instead of string, parse it. */
@@ -414,12 +414,13 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
if (!enable_recursive_minibuffers
&& minibuf_level > 0)
{
+ Lisp_Object str
+ = build_string ("Command attempted to use minibuffer while in minibuffer");
if (EQ (selected_window, minibuf_window))
- error ("Command attempted to use minibuffer while in minibuffer");
+ Fsignal (Quser_error, (list1 (str)));
else
/* If we're in another window, cancel the minibuffer that's active. */
- Fthrow (Qexit,
- build_string ("Command attempted to use minibuffer while in minibuffer"));
+ Fthrow (Qexit, str);
}
if ((noninteractive
@@ -1038,7 +1039,7 @@ Prompt with PROMPT. */)
DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 2, 0,
doc: /* Read the name of a user option and return it as a symbol.
Prompt with PROMPT. By default, return DEFAULT-VALUE or its first element
-if it is a list.
+if it is a list of strings.
A user option, or customizable variable, is one for which
`custom-variable-p' returns non-nil. */)
(Lisp_Object prompt, Lisp_Object default_value)
@@ -1211,9 +1212,6 @@ is used to further constrain the set of candidates. */)
bucket = AREF (collection, idx);
}
- if (HASH_TABLE_P (collection))
- hash_rehash_if_needed (XHASH_TABLE (collection));
-
while (1)
{
/* Get the next element of the alist, obarray, or hash-table. */
diff --git a/src/module-env-25.h b/src/module-env-25.h
index d8f8eb68119..01ce65e9148 100644
--- a/src/module-env-25.h
+++ b/src/module-env-25.h
@@ -6,12 +6,10 @@
/* Memory management. */
- emacs_value (*make_global_ref) (emacs_env *env,
- emacs_value any_reference)
+ emacs_value (*make_global_ref) (emacs_env *env, emacs_value value)
EMACS_ATTRIBUTE_NONNULL(1);
- void (*free_global_ref) (emacs_env *env,
- emacs_value global_reference)
+ void (*free_global_ref) (emacs_env *env, emacs_value global_value)
EMACS_ATTRIBUTE_NONNULL(1);
/* Non-local exit handling. */
@@ -23,19 +21,15 @@
EMACS_ATTRIBUTE_NONNULL(1);
enum emacs_funcall_exit (*non_local_exit_get)
- (emacs_env *env,
- emacs_value *non_local_exit_symbol_out,
- emacs_value *non_local_exit_data_out)
+ (emacs_env *env, emacs_value *symbol, emacs_value *data)
EMACS_ATTRIBUTE_NONNULL(1, 2, 3);
void (*non_local_exit_signal) (emacs_env *env,
- emacs_value non_local_exit_symbol,
- emacs_value non_local_exit_data)
+ emacs_value symbol, emacs_value data)
EMACS_ATTRIBUTE_NONNULL(1);
void (*non_local_exit_throw) (emacs_env *env,
- emacs_value tag,
- emacs_value value)
+ emacs_value tag, emacs_value value)
EMACS_ATTRIBUTE_NONNULL(1);
/* Function registration. */
@@ -43,48 +37,46 @@
emacs_value (*make_function) (emacs_env *env,
ptrdiff_t min_arity,
ptrdiff_t max_arity,
- emacs_value (*function) (emacs_env *env,
- ptrdiff_t nargs,
- emacs_value args[],
- void *)
+ emacs_value (*func) (emacs_env *env,
+ ptrdiff_t nargs,
+ emacs_value* args,
+ void *data)
EMACS_NOEXCEPT
EMACS_ATTRIBUTE_NONNULL(1),
- const char *documentation,
+ const char *docstring,
void *data)
EMACS_ATTRIBUTE_NONNULL(1, 4);
emacs_value (*funcall) (emacs_env *env,
- emacs_value function,
+ emacs_value func,
ptrdiff_t nargs,
- emacs_value args[])
+ emacs_value* args)
EMACS_ATTRIBUTE_NONNULL(1);
- emacs_value (*intern) (emacs_env *env,
- const char *symbol_name)
+ emacs_value (*intern) (emacs_env *env, const char *name)
EMACS_ATTRIBUTE_NONNULL(1, 2);
/* Type conversion. */
- emacs_value (*type_of) (emacs_env *env,
- emacs_value value)
+ emacs_value (*type_of) (emacs_env *env, emacs_value arg)
EMACS_ATTRIBUTE_NONNULL(1);
- bool (*is_not_nil) (emacs_env *env, emacs_value value)
+ bool (*is_not_nil) (emacs_env *env, emacs_value arg)
EMACS_ATTRIBUTE_NONNULL(1);
bool (*eq) (emacs_env *env, emacs_value a, emacs_value b)
EMACS_ATTRIBUTE_NONNULL(1);
- intmax_t (*extract_integer) (emacs_env *env, emacs_value value)
+ intmax_t (*extract_integer) (emacs_env *env, emacs_value arg)
EMACS_ATTRIBUTE_NONNULL(1);
- emacs_value (*make_integer) (emacs_env *env, intmax_t value)
+ emacs_value (*make_integer) (emacs_env *env, intmax_t n)
EMACS_ATTRIBUTE_NONNULL(1);
- double (*extract_float) (emacs_env *env, emacs_value value)
+ double (*extract_float) (emacs_env *env, emacs_value arg)
EMACS_ATTRIBUTE_NONNULL(1);
- emacs_value (*make_float) (emacs_env *env, double value)
+ emacs_value (*make_float) (emacs_env *env, double d)
EMACS_ATTRIBUTE_NONNULL(1);
/* Copy the content of the Lisp string VALUE to BUFFER as an utf8
@@ -101,13 +93,13 @@
bool (*copy_string_contents) (emacs_env *env,
emacs_value value,
- char *buffer,
- ptrdiff_t *size_inout)
+ char *buf,
+ ptrdiff_t *len)
EMACS_ATTRIBUTE_NONNULL(1, 4);
/* Create a Lisp string from a utf8 encoded string. */
emacs_value (*make_string) (emacs_env *env,
- const char *contents, ptrdiff_t length)
+ const char *str, ptrdiff_t len)
EMACS_ATTRIBUTE_NONNULL(1, 2);
/* Embedded pointer type. */
@@ -116,25 +108,24 @@
void *ptr)
EMACS_ATTRIBUTE_NONNULL(1);
- void *(*get_user_ptr) (emacs_env *env, emacs_value uptr)
+ void *(*get_user_ptr) (emacs_env *env, emacs_value arg)
EMACS_ATTRIBUTE_NONNULL(1);
- void (*set_user_ptr) (emacs_env *env, emacs_value uptr, void *ptr)
+ void (*set_user_ptr) (emacs_env *env, emacs_value arg, void *ptr)
EMACS_ATTRIBUTE_NONNULL(1);
void (*(*get_user_finalizer) (emacs_env *env, emacs_value uptr))
(void *) EMACS_NOEXCEPT EMACS_ATTRIBUTE_NONNULL(1);
- void (*set_user_finalizer) (emacs_env *env,
- emacs_value uptr,
+ void (*set_user_finalizer) (emacs_env *env, emacs_value arg,
void (*fin) (void *) EMACS_NOEXCEPT)
EMACS_ATTRIBUTE_NONNULL(1);
/* Vector functions. */
- emacs_value (*vec_get) (emacs_env *env, emacs_value vec, ptrdiff_t i)
+ emacs_value (*vec_get) (emacs_env *env, emacs_value vector, ptrdiff_t index)
EMACS_ATTRIBUTE_NONNULL(1);
- void (*vec_set) (emacs_env *env, emacs_value vec, ptrdiff_t i,
- emacs_value val)
+ void (*vec_set) (emacs_env *env, emacs_value vector, ptrdiff_t index,
+ emacs_value value)
EMACS_ATTRIBUTE_NONNULL(1);
- ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vec)
+ ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vector)
EMACS_ATTRIBUTE_NONNULL(1);
diff --git a/src/module-env-27.h b/src/module-env-27.h
index 0fe2557d71b..9ef3c8b33bb 100644
--- a/src/module-env-27.h
+++ b/src/module-env-27.h
@@ -3,7 +3,7 @@
enum emacs_process_input_result (*process_input) (emacs_env *env)
EMACS_ATTRIBUTE_NONNULL (1);
- struct timespec (*extract_time) (emacs_env *env, emacs_value value)
+ struct timespec (*extract_time) (emacs_env *env, emacs_value arg)
EMACS_ATTRIBUTE_NONNULL (1);
emacs_value (*make_time) (emacs_env *env, struct timespec time)
diff --git a/src/module-env-28.h b/src/module-env-28.h
new file mode 100644
index 00000000000..40b03b92b52
--- /dev/null
+++ b/src/module-env-28.h
@@ -0,0 +1,18 @@
+ /* Add module environment functions newly added in Emacs 28 here.
+ Before Emacs 28 is released, remove this comment and start
+ module-env-29.h on the master branch. */
+
+ void (*(*EMACS_ATTRIBUTE_NONNULL (1)
+ get_function_finalizer) (emacs_env *env,
+ emacs_value arg)) (void *) EMACS_NOEXCEPT;
+
+ void (*set_function_finalizer) (emacs_env *env, emacs_value arg,
+ void (*fin) (void *) EMACS_NOEXCEPT)
+ EMACS_ATTRIBUTE_NONNULL (1);
+
+ int (*open_channel) (emacs_env *env, emacs_value pipe_process)
+ EMACS_ATTRIBUTE_NONNULL (1);
+
+ void (*make_interactive) (emacs_env *env, emacs_value function,
+ emacs_value spec)
+ EMACS_ATTRIBUTE_NONNULL (1);
diff --git a/src/msdos.c b/src/msdos.c
index 6a89178a6e9..b5f06c99c3d 100644
--- a/src/msdos.c
+++ b/src/msdos.c
@@ -1794,7 +1794,7 @@ internal_terminal_init (void)
}
Vinitial_window_system = Qpc;
- Vwindow_system_version = make_fixnum (27); /* RE Emacs version */
+ Vwindow_system_version = make_fixnum (28); /* RE Emacs version */
tty->terminal->type = output_msdos_raw;
/* If Emacs was dumped on DOS/V machine, forget the stale VRAM
@@ -2905,7 +2905,7 @@ IT_menu_display (XMenu *menu, int y, int x, int pn, int *faces, int disp_help)
p++;
for (j = 0, q = menu->text[i]; *q; j++)
{
- unsigned c = STRING_CHAR_ADVANCE (q);
+ unsigned c = string_char_advance (&q);
if (c > 26)
{
diff --git a/src/nsfns.m b/src/nsfns.m
index 0f879fe390c..c7956497c4c 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -255,7 +255,10 @@ ns_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
[col getRed: &r green: &g blue: &b alpha: &alpha];
FRAME_FOREGROUND_PIXEL (f) =
- ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
+ ARGB_TO_ULONG ((unsigned long) (alpha * 0xff),
+ (unsigned long) (r * 0xff),
+ (unsigned long) (g * 0xff),
+ (unsigned long) (b * 0xff));
if (FRAME_NS_VIEW (f))
{
@@ -284,19 +287,16 @@ ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
error ("Unknown color");
}
- /* Clear the frame; in some instances the NS-internal GC appears not
- to update, or it does update and cannot clear old text
- properly. */
- if (FRAME_VISIBLE_P (f))
- ns_clear_frame (f);
-
[col retain];
[f->output_data.ns->background_color release];
f->output_data.ns->background_color = col;
[col getRed: &r green: &g blue: &b alpha: &alpha];
FRAME_BACKGROUND_PIXEL (f) =
- ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
+ ARGB_TO_ULONG ((unsigned long) (alpha * 0xff),
+ (unsigned long) (r * 0xff),
+ (unsigned long) (g * 0xff),
+ (unsigned long) (b * 0xff));
if (view != nil)
{
@@ -318,7 +318,10 @@ ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
}
if (FRAME_VISIBLE_P (f))
- SET_FRAME_GARBAGED (f);
+ {
+ SET_FRAME_GARBAGED (f);
+ ns_clear_frame (f);
+ }
}
unblock_input ();
}
@@ -387,37 +390,25 @@ ns_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
/* Don't change the name if it's already NAME. */
if ([[view window] miniwindowTitle]
&& ([[[view window] miniwindowTitle]
- isEqualToString: [NSString stringWithUTF8String:
- SSDATA (arg)]]))
+ isEqualToString: [NSString stringWithLispString:arg]]))
return;
[[view window] setMiniwindowTitle:
- [NSString stringWithUTF8String: SSDATA (arg)]];
+ [NSString stringWithLispString:arg]];
}
static void
ns_set_name_internal (struct frame *f, Lisp_Object name)
{
- Lisp_Object encoded_name, encoded_icon_name;
- NSString *str;
NSView *view = FRAME_NS_VIEW (f);
-
-
- encoded_name = ENCODE_UTF_8 (name);
-
- str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
-
+ NSString *str = [NSString stringWithLispString: name];
/* Don't change the name if it's already NAME. */
if (! [[[view window] title] isEqualToString: str])
[[view window] setTitle: str];
- if (!STRINGP (f->icon_name))
- encoded_icon_name = encoded_name;
- else
- encoded_icon_name = ENCODE_UTF_8 (f->icon_name);
-
- str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)];
+ if (STRINGP (f->icon_name))
+ str = [NSString stringWithLispString: f->icon_name];
if ([[view window] miniwindowTitle]
&& ! [[[view window] miniwindowTitle] isEqualToString: str])
@@ -445,7 +436,7 @@ ns_set_name (struct frame *f, Lisp_Object name, int explicit)
return;
if (NILP (name))
- name = build_string ([ns_app_name UTF8String]);
+ name = [ns_app_name lispString];
else
CHECK_STRING (name);
@@ -484,7 +475,7 @@ ns_set_represented_filename (struct frame *f)
{
encoded_filename = ENCODE_UTF_8 (filename);
- fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
+ fstr = [NSString stringWithLispString:encoded_filename];
if (fstr == nil) fstr = @"";
}
else
@@ -703,14 +694,11 @@ static void
ns_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
int old_width = FRAME_INTERNAL_BORDER_WIDTH (f);
+ int new_width = check_int_nonnegative (arg);
- CHECK_TYPE_RANGED_INTEGER (int, arg);
- f->internal_border_width = XFIXNUM (arg);
- if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
- f->internal_border_width = 0;
-
- if (FRAME_INTERNAL_BORDER_WIDTH (f) == old_width)
+ if (new_width == old_width)
return;
+ f->internal_border_width = new_width;
if (FRAME_NATIVE_WINDOW (f) != 0)
adjust_frame_size (f, -1, -1, 3, 0, Qinternal_border_width);
@@ -734,7 +722,7 @@ ns_implicitly_set_icon_type (struct frame *f)
block_input ();
pool = [[NSAutoreleasePool alloc] init];
if (f->output_data.ns->miniimage
- && [[NSString stringWithUTF8String: SSDATA (f->name)]
+ && [[NSString stringWithLispString:f->name]
isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
{
[pool release];
@@ -759,7 +747,7 @@ ns_implicitly_set_icon_type (struct frame *f)
if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (f->name)[0] == '/')
{
NSString *str
- = [NSString stringWithUTF8String: SSDATA (f->name)];
+ = [NSString stringWithLispString:f->name];
if ([[NSFileManager defaultManager] fileExistsAtPath: str])
image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
}
@@ -771,8 +759,7 @@ ns_implicitly_set_icon_type (struct frame *f)
image = [EmacsImage allocInitFromFile: XCDR (elt)];
if (image == nil)
image = [[NSImage imageNamed:
- [NSString stringWithUTF8String:
- SSDATA (XCDR (elt))]] retain];
+ [NSString stringWithLispString:XCDR (elt)]] retain];
}
}
@@ -816,8 +803,7 @@ ns_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
image = [EmacsImage allocInitFromFile: arg];
if (image == nil)
- image =[NSImage imageNamed: [NSString stringWithUTF8String:
- SSDATA (arg)]];
+ image =[NSImage imageNamed: [NSString stringWithLispString:arg]];
if (image == nil)
{
@@ -851,20 +837,18 @@ ns_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
static Lisp_Object
ns_appkit_version_str (void)
{
- char tmp[256];
+ NSString *tmp;
#ifdef NS_IMPL_GNUSTEP
- sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
+ tmp = [NSString stringWithFormat:@"gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION)];
#elif defined (NS_IMPL_COCOA)
- NSString *osversion
- = [[NSProcessInfo processInfo] operatingSystemVersionString];
- sprintf(tmp, "appkit-%.2f %s",
- NSAppKitVersionNumber,
- [osversion UTF8String]);
+ tmp = [NSString stringWithFormat:@"appkit-%.2f %@",
+ NSAppKitVersionNumber,
+ [[NSProcessInfo processInfo] operatingSystemVersionString]];
#else
- tmp = "ns-unknown";
+ tmp = [NSString initWithUTF8String:@"ns-unknown"];
#endif
- return build_string (tmp);
+ return [tmp lispString];
}
@@ -1168,7 +1152,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
be set. */
if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
{
- fset_name (f, build_string ([ns_app_name UTF8String]));
+ fset_name (f, [ns_app_name lispString]);
f->explicit_name = 0;
}
else
@@ -1271,14 +1255,20 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
#ifdef NS_IMPL_COCOA
tem = gui_display_get_arg (dpyinfo, parms, Qns_appearance, NULL, NULL,
RES_TYPE_SYMBOL);
- FRAME_NS_APPEARANCE (f) = EQ (tem, Qdark)
- ? ns_appearance_vibrant_dark : ns_appearance_aqua;
- store_frame_param (f, Qns_appearance, tem);
+ if (EQ (tem, Qdark))
+ FRAME_NS_APPEARANCE (f) = ns_appearance_vibrant_dark;
+ else if (EQ (tem, Qlight))
+ FRAME_NS_APPEARANCE (f) = ns_appearance_aqua;
+ else
+ FRAME_NS_APPEARANCE (f) = ns_appearance_system_default;
+ store_frame_param (f, Qns_appearance,
+ (!NILP (tem) && !EQ (tem, Qunbound)) ? tem : Qnil);
tem = gui_display_get_arg (dpyinfo, parms, Qns_transparent_titlebar,
NULL, NULL, RES_TYPE_BOOLEAN);
FRAME_NS_TRANSPARENT_TITLEBAR (f) = !NILP (tem) && !EQ (tem, Qunbound);
- store_frame_param (f, Qns_transparent_titlebar, tem);
+ store_frame_param (f, Qns_transparent_titlebar,
+ FRAME_NS_TRANSPARENT_TITLEBAR (f) ? Qt : Qnil);
#endif
parent_frame = gui_display_get_arg (dpyinfo, parms, Qparent_frame, NULL, NULL,
@@ -1603,12 +1593,12 @@ Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */)
Lisp_Object fname = Qnil;
NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
- [NSString stringWithUTF8String: SSDATA (prompt)];
+ [NSString stringWithLispString:prompt];
NSString *dirS = NILP (dir) || !STRINGP (dir) ?
- [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] :
- [NSString stringWithUTF8String: SSDATA (dir)];
+ [NSString stringWithLispString:BVAR (current_buffer, directory)] :
+ [NSString stringWithLispString:dir];
NSString *initS = NILP (init) || !STRINGP (init) ? nil :
- [NSString stringWithUTF8String: SSDATA (init)];
+ [NSString stringWithLispString:init];
NSEvent *nxev;
check_window_system (NULL);
@@ -1684,7 +1674,7 @@ Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */)
{
NSString *str = ns_filename_from_panel (panel);
if (! str) str = ns_directory_from_panel (panel);
- if (str) fname = build_string ([str UTF8String]);
+ if (str) fname = [str lispString];
}
[[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
@@ -1714,7 +1704,7 @@ If OWNER is nil, Emacs is assumed. */)
check_window_system (NULL);
if (NILP (owner))
- owner = build_string([ns_app_name UTF8String]);
+ owner = [ns_app_name lispString];
CHECK_STRING (name);
value = ns_get_defaults_value (SSDATA (name));
@@ -1733,20 +1723,19 @@ If VALUE is nil, the default is removed. */)
{
check_window_system (NULL);
if (NILP (owner))
- owner = build_string ([ns_app_name UTF8String]);
+ owner = [ns_app_name lispString];
CHECK_STRING (name);
if (NILP (value))
{
[[NSUserDefaults standardUserDefaults] removeObjectForKey:
- [NSString stringWithUTF8String: SSDATA (name)]];
+ [NSString stringWithLispString:name]];
}
else
{
CHECK_STRING (value);
[[NSUserDefaults standardUserDefaults] setObject:
- [NSString stringWithUTF8String: SSDATA (value)]
- forKey: [NSString stringWithUTF8String:
- SSDATA (name)]];
+ [NSString stringWithLispString:value]
+ forKey: [NSString stringWithLispString:name]];
}
return Qnil;
@@ -2038,7 +2027,7 @@ The optional argument FRAME is currently ignored. */)
NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
NSString *cname;
while ((cname = [cnames nextObject]))
- list = Fcons (build_string ([cname UTF8String]), list);
+ list = Fcons ([cname lispString], list);
/* for (i = [[clist allKeys] count] - 1; i >= 0; i--)
list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
UTF8String]), list); */
@@ -2086,13 +2075,11 @@ there was no result. */)
{
id pb;
NSString *svcName;
- char *utfStr;
CHECK_STRING (service);
check_window_system (NULL);
- utfStr = SSDATA (service);
- svcName = [NSString stringWithUTF8String: utfStr];
+ svcName = [NSString stringWithLispString:service];
pb =[NSPasteboard pasteboardWithUniqueName];
ns_string_to_pasteboard (pb, send);
@@ -2122,7 +2109,7 @@ ns_do_applescript (Lisp_Object script, Lisp_Object *result)
NSAppleScript *scriptObject =
[[NSAppleScript alloc] initWithSource:
- [NSString stringWithUTF8String: SSDATA (script)]];
+ [NSString stringWithLispString:script]];
returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
[scriptObject release];
@@ -2145,7 +2132,7 @@ ns_do_applescript (Lisp_Object script, Lisp_Object *result)
{
desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
if (desc)
- *result = build_string([[desc stringValue] UTF8String]);
+ *result = [[desc stringValue] lispString];
}
else
{
@@ -2323,8 +2310,8 @@ DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
[[col colorUsingDefaultColorSpace]
getRed: &red green: &green blue: &blue alpha: &alpha];
unblock_input ();
- return list3i (lrint (red * 65280), lrint (green * 65280),
- lrint (blue * 65280));
+ return list3i (lrint (red * 65535), lrint (green * 65535),
+ lrint (blue * 65535));
}
@@ -2947,16 +2934,16 @@ The coordinates X and Y are interpreted in pixels relative to a position
if (FRAME_INITIAL_P (f) || !FRAME_NS_P (f))
return Qnil;
- CHECK_TYPE_RANGED_INTEGER (int, x);
- CHECK_TYPE_RANGED_INTEGER (int, y);
+ int xval = check_integer_range (x, INT_MIN, INT_MAX);
+ int yval = check_integer_range (y, INT_MIN, INT_MAX);
- mouse_x = screen_frame.origin.x + XFIXNUM (x);
+ mouse_x = screen_frame.origin.x + xval;
if (screen == primary_screen)
- mouse_y = screen_frame.origin.y + XFIXNUM (y);
+ mouse_y = screen_frame.origin.y + yval;
else
mouse_y = (primary_screen_height - screen_frame.size.height
- - screen_frame.origin.y) + XFIXNUM (y);
+ - screen_frame.origin.y) + yval;
CGPoint mouse_pos = CGPointMake(mouse_x, mouse_y);
CGWarpMouseCursorPosition (mouse_pos);
@@ -3003,80 +2990,6 @@ DEFUN ("ns-show-character-palette",
========================================================================== */
-/*
- Handle arrow/function/control keys and copy/paste/cut in file dialogs.
- Return YES if handled, NO if not.
- */
-static BOOL
-handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
-{
- NSString *s;
- int i;
- BOOL ret = NO;
-
- if ([theEvent type] != NSEventTypeKeyDown) return NO;
- s = [theEvent characters];
-
- for (i = 0; i < [s length]; ++i)
- {
- int ch = (int) [s characterAtIndex: i];
- switch (ch)
- {
- case NSHomeFunctionKey:
- case NSDownArrowFunctionKey:
- case NSUpArrowFunctionKey:
- case NSLeftArrowFunctionKey:
- case NSRightArrowFunctionKey:
- case NSPageUpFunctionKey:
- case NSPageDownFunctionKey:
- case NSEndFunctionKey:
- /* Don't send command modified keys, as those are handled in the
- performKeyEquivalent method of the super class. */
- if (! ([theEvent modifierFlags] & NSEventModifierFlagCommand))
- {
- [panel sendEvent: theEvent];
- ret = YES;
- }
- break;
- /* As we don't have the standard key commands for
- copy/paste/cut/select-all in our edit menu, we must handle
- them here. TODO: handle Emacs key bindings for copy/cut/select-all
- here, paste works, because we have that in our Edit menu.
- I.e. refactor out code in nsterm.m, keyDown: to figure out the
- correct modifier. */
- case 'x': // Cut
- case 'c': // Copy
- case 'v': // Paste
- case 'a': // Select all
- if ([theEvent modifierFlags] & NSEventModifierFlagCommand)
- {
- [NSApp sendAction:
- (ch == 'x'
- ? @selector(cut:)
- : (ch == 'c'
- ? @selector(copy:)
- : (ch == 'v'
- ? @selector(paste:)
- : @selector(selectAll:))))
- to:nil from:panel];
- ret = YES;
- }
- default:
- // Send all control keys, as the text field supports C-a, C-f, C-e
- // C-b and more.
- if ([theEvent modifierFlags] & NSEventModifierFlagControl)
- {
- [panel sendEvent: theEvent];
- ret = YES;
- }
- break;
- }
- }
-
-
- return ret;
-}
-
@implementation EmacsFileDelegate
/* --------------------------------------------------------------------------
Delegate methods for Open/Save panels
@@ -3099,6 +3012,60 @@ handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
#endif
+/* Whether N bytes at STR are in the [0,127] range. */
+static bool
+all_nonzero_ascii (unsigned char *str, ptrdiff_t n)
+{
+ for (ptrdiff_t i = 0; i < n; i++)
+ if (str[i] < 1 || str[i] > 127)
+ return false;
+ return true;
+}
+
+@implementation NSString (EmacsString)
+/* Make an NSString from a Lisp string. */
++ (NSString *)stringWithLispString:(Lisp_Object)string
+{
+ /* Shortcut for the common case. */
+ if (all_nonzero_ascii (SDATA (string), SBYTES (string)))
+ return [NSString stringWithCString: SSDATA (string)
+ encoding: NSASCIIStringEncoding];
+ string = string_to_multibyte (string);
+
+ /* Now the string is multibyte; convert to UTF-16. */
+ unichar *chars = xmalloc (4 * SCHARS (string));
+ unichar *d = chars;
+ const unsigned char *s = SDATA (string);
+ const unsigned char *end = s + SBYTES (string);
+ while (s < end)
+ {
+ int c = string_char_advance (&s);
+ /* We pass unpaired surrogates through, because they are typically
+ handled fairly well by the NS libraries (displayed with distinct
+ glyphs etc). */
+ if (c <= 0xffff)
+ *d++ = c;
+ else if (c <= 0x10ffff)
+ {
+ *d++ = 0xd800 + ((c - 0x10000) >> 10);
+ *d++ = 0xdc00 + (c & 0x3ff);
+ }
+ else
+ *d++ = 0xfffd; /* Not valid for UTF-16. */
+ }
+ NSString *str = [NSString stringWithCharacters: chars
+ length: d - chars];
+ xfree (chars);
+ return str;
+}
+
+/* Make a Lisp string from an NSString. */
+- (Lisp_Object)lispString
+{
+ return build_string ([self UTF8String]);
+}
+@end
+
/* ==========================================================================
Lisp interface declaration
@@ -3112,6 +3079,7 @@ syms_of_nsfns (void)
DEFSYM (Qframe_title_format, "frame-title-format");
DEFSYM (Qicon_title_format, "icon-title-format");
DEFSYM (Qdark, "dark");
+ DEFSYM (Qlight, "light");
DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
diff --git a/src/nsfont.m b/src/nsfont.m
index 9bec3691786..d1543ec69ce 100644
--- a/src/nsfont.m
+++ b/src/nsfont.m
@@ -39,9 +39,7 @@ Author: Adrian Robert (arobert@cogsci.ucsd.edu)
#include "pdumper.h"
/* TODO: Drop once we can assume gnustep-gui 0.17.1. */
-#ifdef NS_IMPL_GNUSTEP
#import <AppKit/NSFontDescriptor.h>
-#endif
#define NSFONT_TRACE 0
#define LCD_SMOOTHING_MARGIN 2
@@ -237,12 +235,6 @@ ns_char_width (NSFont *sfont, int c)
CGFloat w = -1.0;
NSString *cstr = [NSString stringWithFormat: @"%c", c];
-#ifdef NS_IMPL_COCOA
- NSGlyph glyph = [sfont glyphWithName: cstr];
- if (glyph)
- w = [sfont advancementForGlyph: glyph].width;
-#endif
-
if (w < 0.0)
{
NSDictionary *attrsDictionary =
@@ -273,12 +265,6 @@ ns_ascii_average_width (NSFont *sfont)
ascii_printable = [[NSString alloc] initWithFormat: @"%s", chars];
}
-#ifdef NS_IMPL_COCOA
- NSGlyph glyph = [sfont glyphWithName: ascii_printable];
- if (glyph)
- w = [sfont advancementForGlyph: glyph].width;
-#endif
-
if (w < (CGFloat) 0.0)
{
NSDictionary *attrsDictionary =
@@ -511,10 +497,6 @@ static NSSet
}
[charset release];
}
-#ifdef NS_IMPL_COCOA
- if ([families count] == 0)
- [families addObject: @"LastResort"];
-#endif
[scriptToFamilies setObject: families forKey: script];
}
@@ -734,11 +716,6 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size)
traits: traits & ~NSItalicFontMask
weight: fixLeopardBug size: pixel_size];
}
-#ifdef NS_IMPL_COCOA
- /* LastResort not really a family */
- if (nsfont == nil && [@"LastResort" isEqualToString: family])
- nsfont = [NSFont fontWithName: @"LastResort" size: pixel_size];
-#endif
if (nsfont == nil)
{
@@ -765,12 +742,7 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size)
font_info->metrics = xzalloc (0x100 * sizeof *font_info->metrics);
/* for metrics */
-#ifdef NS_IMPL_COCOA
- sfont = [nsfont screenFontWithRenderingMode:
- NSFontAntialiasedIntegerAdvancementsRenderingMode];
-#else
sfont = [nsfont screenFont];
-#endif
if (sfont == nil)
sfont = nsfont;
@@ -797,11 +769,7 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size)
* intended. */
CGFloat adjusted_descender = [sfont descender] + 0.0001;
-#ifdef NS_IMPL_GNUSTEP
font_info->nsfont = sfont;
-#else
- font_info->nsfont = nsfont;
-#endif
[font_info->nsfont retain];
/* set up ns_font (defined in nsgui.h) */
@@ -834,32 +802,6 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size)
font_info->max_bounds.rbearing =
lrint (brect.size.width - (CGFloat) font_info->width);
-#ifdef NS_IMPL_COCOA
- /* set up synthItal and the CG font */
- font_info->synthItal = synthItal;
- {
- ATSFontRef atsFont = ATSFontFindFromPostScriptName
- ((CFStringRef)[nsfont fontName], kATSOptionFlagsDefault);
-
- if (atsFont == kATSFontRefUnspecified)
- {
- /* see if we can get it by dropping italic (then synthesizing) */
- atsFont = ATSFontFindFromPostScriptName ((CFStringRef)
- [[fontMgr convertFont: nsfont toNotHaveTrait: NSItalicFontMask]
- fontName], kATSOptionFlagsDefault);
- if (atsFont != kATSFontRefUnspecified)
- font_info->synthItal = YES;
- else
- {
- /* last resort fallback */
- atsFont = ATSFontFindFromPostScriptName
- ((CFStringRef)@"Monaco", kATSOptionFlagsDefault);
- }
- }
- font_info->cgfont = CGFontCreateWithPlatformFont ((void *) &atsFont);
- }
-#endif
-
/* set up metrics portion of font struct */
font->ascent = lrint([sfont ascender]);
font->descent = -lrint(floor(adjusted_descender));
@@ -901,9 +843,6 @@ nsfont_close (struct font *font)
xfree (font_info->glyphs);
xfree (font_info->metrics);
[font_info->nsfont release];
-#ifdef NS_IMPL_COCOA
- CGFontRelease (font_info->cgfont);
-#endif
xfree (font_info->name);
font_info->name = NULL;
}
@@ -994,7 +933,6 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
{
static unsigned char cbuf[1024];
unsigned char *c = cbuf;
-#ifdef NS_IMPL_GNUSTEP
#if GNUSTEP_GUI_MAJOR_VERSION > 0 || GNUSTEP_GUI_MINOR_VERSION > 22
static CGFloat advances[1024];
CGFloat *adv = advances;
@@ -1002,10 +940,6 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
static float advances[1024];
float *adv = advances;
#endif
-#else
- static CGSize advances[1024];
- CGSize *adv = advances;
-#endif
struct face *face;
NSRect r;
struct nsfont_info *font;
@@ -1043,7 +977,7 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
r.origin.x = s->x;
if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p)
- r.origin.x += abs (s->face->box_line_width);
+ r.origin.x += max (s->face->box_vertical_line_width, 0);
r.origin.y = s->y;
r.size.height = FONT_HEIGHT (font);
@@ -1073,11 +1007,7 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
else
{
cwidth = LGLYPH_WADJUST (glyph);
-#ifdef NS_IMPL_GNUSTEP
*(adv-1) += LGLYPH_XOFF (glyph);
-#else
- (*(adv-1)).width += LGLYPH_XOFF (glyph);
-#endif
}
}
}
@@ -1088,12 +1018,8 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
cwidth = font->metrics[hi][lo].width;
}
twidth += cwidth;
-#ifdef NS_IMPL_GNUSTEP
*adv++ = cwidth;
- CHAR_STRING_ADVANCE (*t, c); /* This converts the char to UTF-8. */
-#else
- (*adv++).width = cwidth;
-#endif
+ c += CHAR_STRING (*t, c); /* This converts the char to UTF-8. */
}
len = adv - advances;
r.size.width = twidth;
@@ -1105,7 +1031,7 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
{
NSRect br = r;
int fibw = FRAME_INTERNAL_BORDER_WIDTH (s->f);
- int mbox_line_width = max (s->face->box_line_width, 0);
+ int mbox_line_width = max (s->face->box_vertical_line_width, 0);
if (s->row->full_width_p)
{
@@ -1129,9 +1055,10 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
}
else
{
- int correction = abs (s->face->box_line_width)+1;
+ int correction = abs (s->face->box_horizontal_line_width)+1;
br.origin.y += correction;
br.size.height -= 2*correction;
+ correction = abs (s->face->box_vertical_line_width)+1;
br.origin.x += correction;
br.size.width -= 2*correction;
}
@@ -1191,61 +1118,6 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
DPSgrestore (context);
}
-#else /* NS_IMPL_COCOA */
- {
- CGContextRef gcontext =
- [[NSGraphicsContext currentContext] graphicsPort];
- static CGAffineTransform fliptf;
- static BOOL firstTime = YES;
-
- if (firstTime)
- {
- firstTime = NO;
- fliptf = CGAffineTransformMakeScale (1.0, -1.0);
- }
-
- CGContextSaveGState (gcontext);
-
- // Used to be Fix2X (kATSItalicQDSkew), but Fix2X is deprecated
- // and kATSItalicQDSkew is 0.25.
- fliptf.c = font->synthItal ? 0.25 : 0.0;
-
- CGContextSetFont (gcontext, font->cgfont);
- CGContextSetFontSize (gcontext, font->size);
- if (NILP (ns_antialias_text) || font->size <= ns_antialias_threshold)
- CGContextSetShouldAntialias (gcontext, 0);
- else
- CGContextSetShouldAntialias (gcontext, 1);
-
- CGContextSetTextMatrix (gcontext, fliptf);
-
- if (bgCol != nil)
- {
- /* foreground drawing; erase first to avoid overstrike */
- [bgCol set];
- CGContextSetTextDrawingMode (gcontext, kCGTextFillStroke);
- CGContextSetTextPosition (gcontext, r.origin.x, r.origin.y);
- CGContextShowGlyphsWithAdvances (gcontext, s->char2b, advances, len);
- CGContextSetTextDrawingMode (gcontext, kCGTextFill);
- }
-
- [col set];
-
- CGContextSetTextPosition (gcontext, r.origin.x, r.origin.y);
- CGContextShowGlyphsWithAdvances (gcontext, s->char2b + from,
- advances, len);
-
- if (face->overstrike)
- {
- CGContextSetTextPosition (gcontext, r.origin.x+0.5, r.origin.y);
- CGContextShowGlyphsWithAdvances (gcontext, s->char2b + from,
- advances, len);
- }
-
- CGContextRestoreGState (gcontext);
- }
-#endif /* NS_IMPL_COCOA */
-
unblock_input ();
return to-from;
}
@@ -1263,10 +1135,6 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
static void
ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block)
{
-#ifdef NS_IMPL_COCOA
- static EmacsGlyphStorage *glyphStorage;
- static char firstTime = 1;
-#endif
unichar *unichars = xmalloc (0x101 * sizeof (unichar));
unsigned int i, g, idx;
unsigned short *glyphs;
@@ -1277,14 +1145,6 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block)
block_input ();
-#ifdef NS_IMPL_COCOA
- if (firstTime)
- {
- firstTime = 0;
- glyphStorage = [[EmacsGlyphStorage alloc] initWithCapacity: 0x100];
- }
-#endif
-
font_info->glyphs[block] = xmalloc (0x100 * sizeof (unsigned short));
if (!unichars || !(font_info->glyphs[block]))
emacs_abort ();
@@ -1298,38 +1158,16 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block)
unichars[0x100] = 0;
{
-#ifdef NS_IMPL_COCOA
- NSString *allChars = [[NSString alloc]
- initWithCharactersNoCopy: unichars
- length: 0x100
- freeWhenDone: NO];
- NSGlyphGenerator *glyphGenerator = [NSGlyphGenerator sharedGlyphGenerator];
- /* NSCharacterSet *coveredChars = [nsfont coveredCharacterSet]; */
- unsigned int numGlyphs = [font_info->nsfont numberOfGlyphs];
- NSUInteger gInd = 0, cInd = 0;
-
- [glyphStorage setString: allChars font: font_info->nsfont];
- [glyphGenerator generateGlyphsForGlyphStorage: glyphStorage
- desiredNumberOfCharacters: glyphStorage->maxChar
- glyphIndex: &gInd characterIndex: &cInd];
-#endif
glyphs = font_info->glyphs[block];
for (i = 0; i < 0x100; i++, glyphs++)
{
-#ifdef NS_IMPL_GNUSTEP
g = unichars[i];
-#else
g = glyphStorage->cglyphs[i];
/* TODO: is this a good check? Maybe need to use coveredChars. */
if (g > numGlyphs || g == NSNullGlyph)
g = INVALID_GLYPH; /* Hopefully unused... */
-#endif
*glyphs = g;
}
-
-#ifdef NS_IMPL_COCOA
- [allChars release];
-#endif
}
unblock_input ();
@@ -1351,19 +1189,12 @@ ns_glyph_metrics (struct nsfont_info *font_info, unsigned char block)
fprintf (stderr, "%p\tComputing metrics for glyphs in block %d\n",
font_info, block);
-#ifdef NS_IMPL_GNUSTEP
/* not implemented yet (as of startup 0.18), so punt */
if (numGlyphs == 0)
numGlyphs = 0x10000;
-#endif
block_input ();
-#ifdef NS_IMPL_COCOA
- sfont = [font_info->nsfont screenFontWithRenderingMode:
- NSFontAntialiasedIntegerAdvancementsRenderingMode];
-#else
sfont = [font_info->nsfont screenFont];
-#endif
font_info->metrics[block] = xzalloc (0x100 * sizeof (struct font_metrics));
if (!(font_info->metrics[block]))
@@ -1396,76 +1227,6 @@ ns_glyph_metrics (struct nsfont_info *font_info, unsigned char block)
}
-#ifdef NS_IMPL_COCOA
-/* Helper for font glyph setup. */
-@implementation EmacsGlyphStorage
-
-- init
-{
- return [self initWithCapacity: 1024];
-}
-
-- initWithCapacity: (unsigned long) c
-{
- self = [super init];
- maxChar = 0;
- maxGlyph = 0;
- dict = [NSMutableDictionary new];
- cglyphs = xmalloc (c * sizeof (CGGlyph));
- return self;
-}
-
-- (void) dealloc
-{
- if (attrStr != nil)
- [attrStr release];
- [dict release];
- xfree (cglyphs);
- [super dealloc];
-}
-
-- (void) setString: (NSString *)str font: (NSFont *)font
-{
- [dict setObject: font forKey: NSFontAttributeName];
- if (attrStr != nil)
- [attrStr release];
- attrStr = [[NSAttributedString alloc] initWithString: str attributes: dict];
- maxChar = [str length];
- maxGlyph = 0;
-}
-
-/* NSGlyphStorage protocol */
-- (NSUInteger)layoutOptions
-{
- return 0;
-}
-
-- (NSAttributedString *)attributedString
-{
- return attrStr;
-}
-
-- (void)insertGlyphs: (const NSGlyph *)glyphs length: (NSUInteger)length
- forStartingGlyphAtIndex: (NSUInteger)glyphIndex
- characterIndex: (NSUInteger)charIndex
-{
- len = glyphIndex+length;
- for (i =glyphIndex; i<len; i++)
- cglyphs[i] = glyphs[i-glyphIndex];
- if (len > maxGlyph)
- maxGlyph = len;
-}
-
-- (void)setIntAttribute: (NSInteger)attributeTag value: (NSInteger)val
- forGlyphAtIndex: (NSUInteger)glyphIndex
-{
- return;
-}
-
-@end
-#endif /* NS_IMPL_COCOA */
-
-
/* Debugging */
void
ns_dump_glyphstring (struct glyph_string *s)
diff --git a/src/nsimage.m b/src/nsimage.m
index fa1e98b8848..da6f01cf6a3 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -36,6 +36,14 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
#include "coding.h"
+#if defined (NS_IMPL_GNUSTEP) || MAC_OS_X_VERSION_MAX_ALLOWED < 1070
+# define COLORSPACE_NAME NSCalibratedRGBColorSpace
+#else
+# define COLORSPACE_NAME \
+ ((ns_use_srgb_colorspace && NSAppKitVersionNumber >= NSAppKitVersionNumber10_7) \
+ ? NSDeviceRGBColorSpace : NSCalibratedRGBColorSpace)
+#endif
+
/* ==========================================================================
@@ -45,6 +53,55 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
========================================================================== */
+bool
+ns_can_use_native_image_api (Lisp_Object type)
+{
+ NSString *imageType = @"unknown";
+ NSArray *types;
+
+ NSTRACE ("ns_can_use_native_image_api");
+
+ if (EQ (type, Qnative_image))
+ return YES;
+
+#ifdef NS_IMPL_COCOA
+ /* Work out the UTI of the image type. */
+ if (EQ (type, Qjpeg))
+ imageType = @"public.jpeg";
+ else if (EQ (type, Qpng))
+ imageType = @"public.png";
+ else if (EQ (type, Qgif))
+ imageType = @"com.compuserve.gif";
+ else if (EQ (type, Qtiff))
+ imageType = @"public.tiff";
+ else if (EQ (type, Qsvg))
+ imageType = @"public.svg-image";
+
+ /* NSImage also supports a host of other types such as PDF and BMP,
+ but we don't yet support these in image.c. */
+
+ types = [NSImage imageTypes];
+#else
+ /* Work out the image type. */
+ if (EQ (type, Qjpeg))
+ imageType = @"jpeg";
+ else if (EQ (type, Qpng))
+ imageType = @"png";
+ else if (EQ (type, Qgif))
+ imageType = @"gif";
+ else if (EQ (type, Qtiff))
+ imageType = @"tiff";
+
+ types = [NSImage imageFileTypes];
+#endif
+
+ /* Check if the type is supported on this system. */
+ if ([types indexOfObject:imageType] != NSNotFound)
+ return YES;
+ else
+ return NO;
+}
+
void *
ns_image_from_XBM (char *bits, int width, int height,
unsigned long fg, unsigned long bg)
@@ -150,6 +207,12 @@ ns_image_set_transform (void *img, double m[3][3])
[(EmacsImage *)img setTransform:m];
}
+void
+ns_image_set_smoothing (void *img, bool smooth)
+{
+ [(EmacsImage *)img setSmoothing:smooth];
+}
+
unsigned long
ns_get_pixel (void *img, int x, int y)
{
@@ -240,7 +303,7 @@ ns_set_alpha (void *img, int x, int y, unsigned char a)
pixelsWide: w pixelsHigh: h
bitsPerSample: 8 samplesPerPixel: 4
hasAlpha: YES isPlanar: YES
- colorSpaceName: NSCalibratedRGBColorSpace
+ colorSpaceName: COLORSPACE_NAME
bytesPerRow: w bitsPerPixel: 0];
[bmRep getBitmapDataPlanes: planes];
@@ -360,7 +423,7 @@ ns_set_alpha (void *img, int x, int y, unsigned char a)
/* keep things simple for now */
bitsPerSample: 8 samplesPerPixel: 4 /*RGB+A*/
hasAlpha: YES isPlanar: YES
- colorSpaceName: NSCalibratedRGBColorSpace
+ colorSpaceName: COLORSPACE_NAME
bytesPerRow: width bitsPerPixel: 0];
[bmRep getBitmapDataPlanes: pixmapData];
@@ -407,9 +470,10 @@ ns_set_alpha (void *img, int x, int y, unsigned char a)
if (pixmapData[0] != NULL)
{
int loc = x + y * [self size].width;
- return (pixmapData[3][loc] << 24) /* alpha */
- | (pixmapData[0][loc] << 16) | (pixmapData[1][loc] << 8)
- | (pixmapData[2][loc]);
+ return (((unsigned long) pixmapData[3][loc] << 24) /* alpha */
+ | ((unsigned long) pixmapData[0][loc] << 16)
+ | ((unsigned long) pixmapData[1][loc] << 8)
+ | (unsigned long) pixmapData[2][loc]);
}
else
{
@@ -541,4 +605,10 @@ ns_set_alpha (void *img, int x, int y, unsigned char a)
[transform setTransformStruct:tm];
}
+- (void)setSmoothing: (BOOL) s
+{
+ smoothing = s;
+}
+
+
@end
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 67f9a45a401..a286a80da17 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -122,7 +122,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu)
/*fprintf (stderr, "ns_update_menubar: frame: %p\tdeep: %d\tsub: %p\n", f, deep_p, submenu); */
block_input ();
- pool = [[NSAutoreleasePool alloc] init];
/* Menu may have been created automatically; if so, discard it. */
if ([menu isKindOfClass: [EmacsMenu class]] == NO)
@@ -240,7 +239,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu)
[[submenu title] UTF8String]);
discard_menu_items ();
unbind_to (specpdl_count, Qnil);
- [pool release];
unblock_input ();
return;
}
@@ -298,7 +296,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu)
free_menubar_widget_value_tree (first_wv);
discard_menu_items ();
unbind_to (specpdl_count, Qnil);
- [pool release];
unblock_input ();
return;
}
@@ -364,7 +361,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu)
if (NILP (items))
{
free_menubar_widget_value_tree (first_wv);
- [pool release];
unblock_input ();
return;
}
@@ -395,7 +391,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu)
if (i == n)
{
free_menubar_widget_value_tree (first_wv);
- [pool release];
unblock_input ();
return;
}
@@ -454,7 +449,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu)
if (needsSet)
[NSApp setMainMenu: menu];
- [pool release];
unblock_input ();
}
@@ -1092,7 +1086,7 @@ update_frame_tool_bar (struct frame *f)
continue;
}
- img_id = lookup_image (f, image);
+ img_id = lookup_image (f, image, -1);
img = IMAGE_FROM_ID (f, img_id);
prepare_image_for_display (f, img);
@@ -1141,8 +1135,6 @@ update_frame_tool_bar (struct frame *f)
}
#endif
- if (oldh != FRAME_TOOLBAR_HEIGHT (f))
- [view updateFrameSize:YES];
if (view->wait_for_tool_bar && FRAME_TOOLBAR_HEIGHT (f) > 0)
{
view->wait_for_tool_bar = NO;
diff --git a/src/nsselect.m b/src/nsselect.m
index 38ac66e9c7b..7b1937f5d99 100644
--- a/src/nsselect.m
+++ b/src/nsselect.m
@@ -114,7 +114,7 @@ clean_local_selection_data (Lisp_Object obj)
if (size == 1)
return clean_local_selection_data (AREF (obj, 0));
- copy = make_uninit_vector (size);
+ copy = make_nil_vector (size);
for (i = 0; i < size; i++)
ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
return copy;
diff --git a/src/nsterm.h b/src/nsterm.h
index f68c3246a70..f292993d8f7 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -339,6 +339,16 @@ 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.
@@ -351,6 +361,12 @@ typedef id instancetype;
@end
+
+@interface NSString (EmacsString)
++ (NSString *)stringWithLispString:(Lisp_Object)string;
+- (Lisp_Object)lispString;
+@end
+
/* ==========================================================================
The Emacs application
@@ -417,9 +433,12 @@ typedef id instancetype;
int maximized_width, maximized_height;
NSWindow *nonfs_window;
BOOL fs_is_native;
+ BOOL in_fullscreen_transition;
+#ifdef NS_DRAW_TO_BUFFER
+ CGContextRef drawingBuffer;
+#endif
@public
struct frame *emacsframe;
- int rows, cols;
int scrollbarsNeedingUpdate;
EmacsToolbar *toolbar;
NSRect ns_userRect;
@@ -438,16 +457,16 @@ typedef id instancetype;
/* Emacs-side interface */
- (instancetype) initFrameFromEmacs: (struct frame *) f;
- (void) createToolbar: (struct frame *)f;
-- (void) setRows: (int) r andColumns: (int) c;
- (void) setWindowClosing: (BOOL)closing;
- (EmacsToolbar *) toolbar;
- (void) deleteWorkingText;
-- (void) updateFrameSize: (BOOL) delay;
- (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
@@ -457,7 +476,13 @@ typedef id instancetype;
#endif
- (int)fullscreenState;
-/* Non-notification versions of NSView methods. Used for direct calls. */
+#ifdef NS_DRAW_TO_BUFFER
+- (void)focusOnDrawingBuffer;
+- (void)createDrawingBuffer;
+#endif
+- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect;
+
+/* Non-notification versions of NSView methods. Used for direct calls. */
- (void)windowWillEnterFullScreen;
- (void)windowDidEnterFullScreen;
- (void)windowWillExitFullScreen;
@@ -471,6 +496,8 @@ typedef id instancetype;
{
NSPoint grabOffset;
}
+
+- (void)setAppearance;
@end
@@ -619,6 +646,7 @@ typedef id instancetype;
unsigned long xbm_fg;
@public
NSAffineTransform *transform;
+ BOOL smoothing;
}
+ (instancetype)allocInitFromFile: (Lisp_Object)file;
- (void)dealloc;
@@ -637,6 +665,7 @@ typedef id instancetype;
- (Lisp_Object)getMetadata;
- (BOOL)setFrame: (unsigned int) index;
- (void)setTransform: (double[3][3]) m;
+- (void)setSmoothing: (BOOL)s;
@end
@@ -689,22 +718,6 @@ typedef id instancetype;
========================================================================== */
-#ifdef NS_IMPL_COCOA
-/* rendering util */
-@interface EmacsGlyphStorage : NSObject <NSGlyphStorage>
-{
-@public
- NSAttributedString *attrStr;
- NSMutableDictionary *dict;
- CGGlyph *cglyphs;
- unsigned long maxChar, maxGlyph;
- long i, len;
-}
-- (instancetype)initWithCapacity: (unsigned long) c;
-- (void) setString: (NSString *)str font: (NSFont *)font;
-@end
-#endif /* NS_IMPL_COCOA */
-
extern NSArray *ns_send_types, *ns_return_types;
extern NSString *ns_app_name;
extern EmacsMenu *svcsMenu;
@@ -782,6 +795,7 @@ struct ns_color_table
#define GREEN16_FROM_ULONG(color) (GREEN_FROM_ULONG(color) * 0x101)
#define BLUE16_FROM_ULONG(color) (BLUE_FROM_ULONG(color) * 0x101)
+#ifdef NS_IMPL_GNUSTEP
/* this extends font backend font */
struct nsfont_info
{
@@ -798,14 +812,8 @@ struct nsfont_info
float size;
#ifdef __OBJC__
NSFont *nsfont;
-#if defined (NS_IMPL_COCOA)
- CGFontRef cgfont;
-#else /* GNUstep */
- void *cgfont;
-#endif
#else /* ! OBJC */
void *nsfont;
- void *cgfont;
#endif
char bold, ital; /* convenience flags */
char synthItal;
@@ -815,7 +823,7 @@ struct nsfont_info
unsigned short **glyphs; /* map Unicode index to glyph */
struct font_metrics **metrics;
};
-
+#endif
/* Initialized in ns_initialize_display_info (). */
struct ns_display_info
@@ -1054,18 +1062,6 @@ struct x_output
(FRAME_SCROLL_BAR_LINES (f) * FRAME_LINE_HEIGHT (f) \
- NS_SCROLL_BAR_HEIGHT (f)) : 0)
-/* Calculate system coordinates of the left and top of the parent
- window or, if there is no parent window, the screen. */
-#define NS_PARENT_WINDOW_LEFT_POS(f) \
- (FRAME_PARENT_FRAME (f) != NULL \
- ? [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window].frame.origin.x : 0)
-#define NS_PARENT_WINDOW_TOP_POS(f) \
- (FRAME_PARENT_FRAME (f) != NULL \
- ? ([FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window].frame.origin.y \
- + [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window].frame.size.height \
- - FRAME_NS_TITLEBAR_HEIGHT (FRAME_PARENT_FRAME (f))) \
- : [[[NSScreen screens] objectAtIndex: 0] frame].size.height)
-
#define FRAME_NS_FONT_TABLE(f) (FRAME_DISPLAY_INFO (f)->font_table)
#define FRAME_FONTSET(f) ((f)->output_data.ns->fontset)
@@ -1090,7 +1086,7 @@ extern void ns_term_shutdown (int sig);
#define NS_DUMPGLYPH_MOUSEFACE 3
-
+#ifdef NS_IMPL_GNUSTEP
/* In nsfont, called from fontset.c */
extern void nsfont_make_fontset_for_font (Lisp_Object name,
Lisp_Object font_object);
@@ -1098,6 +1094,7 @@ extern void nsfont_make_fontset_for_font (Lisp_Object name,
/* In nsfont, for debugging */
struct glyph_string;
void ns_dump_glyphstring (struct glyph_string *s) EXTERNALLY_VISIBLE;
+#endif
/* Implemented in nsterm, published in or needed from nsfns. */
extern Lisp_Object ns_list_fonts (struct frame *f, Lisp_Object pattern,
@@ -1180,6 +1177,7 @@ extern void syms_of_nsselect (void);
/* From nsimage.m, needed in image.c */
struct image;
+extern bool ns_can_use_native_image_api (Lisp_Object type);
extern void *ns_image_from_XBM (char *bits, int width, int height,
unsigned long fg, unsigned long bg);
extern void *ns_image_for_XPM (int width, int height, int depth);
@@ -1190,6 +1188,7 @@ extern int ns_image_width (void *img);
extern int ns_image_height (void *img);
extern void ns_image_set_size (void *img, int width, int height);
extern void ns_image_set_transform (void *img, double m[3][3]);
+extern void ns_image_set_smoothing (void *img, bool smooth);
extern unsigned long ns_get_pixel (void *img, int x, int y);
extern void ns_put_pixel (void *img, int x, int y, unsigned long argb);
extern void ns_set_alpha (void *img, int x, int y, unsigned char a);
@@ -1255,10 +1254,24 @@ extern char gnustep_base_version[]; /* version tracking */
? (min) : (((x)>(max)) ? (max) : (x)))
#define SCREENMAXBOUND(x) (IN_BOUND (-SCREENMAX, x, SCREENMAX))
+
+#ifdef NS_IMPL_COCOA
+/* Add some required AppKit version numbers if they're not defined. */
+#ifndef NSAppKitVersionNumber10_7
+#define NSAppKitVersionNumber10_7 1138
+#endif
+
+#ifndef NSAppKitVersionNumber10_10
+#define NSAppKitVersionNumber10_10 1343
+#endif
+#endif /* NS_IMPL_COCOA */
+
+
/* macOS 10.7 introduces some new constants. */
#if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_7)
#define NSFullScreenWindowMask (1 << 14)
#define NSWindowCollectionBehaviorFullScreenPrimary (1 << 7)
+#define NSWindowCollectionBehaviorFullScreenAuxiliary (1 << 8)
#define NSApplicationPresentationFullScreen (1 << 10)
#define NSApplicationPresentationAutoHideToolbar (1 << 11)
#define NSAppKitVersionNumber10_7 1138
diff --git a/src/nsterm.m b/src/nsterm.m
index 3dd915e3703..fdcd677d144 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -49,6 +49,7 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
#include "nsterm.h"
#include "systime.h"
#include "character.h"
+#include "xwidget.h"
#include "fontset.h"
#include "composite.h"
#include "ccl.h"
@@ -139,14 +140,9 @@ char const * nstrace_fullscreen_type_name (int fs_type)
+ (NSColor *)colorForEmacsRed:(CGFloat)red green:(CGFloat)green
blue:(CGFloat)blue alpha:(CGFloat)alpha
{
-#if defined (NS_IMPL_COCOA) \
- && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
if (ns_use_srgb_colorspace
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
- && [NSColor respondsToSelector:
- @selector(colorWithSRGBRed:green:blue:alpha:)]
-#endif
- )
+ && NSAppKitVersionNumber >= NSAppKitVersionNumber10_7)
return [NSColor colorWithSRGBRed: red
green: green
blue: blue
@@ -160,28 +156,12 @@ char const * nstrace_fullscreen_type_name (int fs_type)
- (NSColor *)colorUsingDefaultColorSpace
{
- /* FIXME: We're checking for colorWithSRGBRed here so this will only
- work in the same place as in the method above. It should really
- be a check whether we're on macOS 10.7 or above. */
-#if defined (NS_IMPL_COCOA) \
- && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
- if ([NSColor respondsToSelector:
- @selector(colorWithSRGBRed:green:blue:alpha:)])
-#endif
- {
- if (ns_use_srgb_colorspace)
- return [self colorUsingColorSpace: [NSColorSpace sRGBColorSpace]];
- else
- return [self colorUsingColorSpace: [NSColorSpace deviceRGBColorSpace]];
- }
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
- else
-#endif
-#endif /* NS_IMPL_COCOA && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 */
-#if defined (NS_IMPL_GNUSTEP) || MAC_OS_X_VERSION_MIN_REQUIRED < 1070
- return [self colorUsingColorSpaceName: NSCalibratedRGBColorSpace];
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+ if (ns_use_srgb_colorspace
+ && NSAppKitVersionNumber >= NSAppKitVersionNumber10_7)
+ return [self colorUsingColorSpace: [NSColorSpace sRGBColorSpace]];
#endif
+ return [self colorUsingColorSpace: [NSColorSpace deviceRGBColorSpace]];
}
@end
@@ -287,7 +267,10 @@ struct ns_display_info *x_display_list; /* Chain of existing displays */
long context_menu_value = 0;
/* display update */
+static struct frame *ns_updating_frame;
+static NSView *focus_view = NULL;
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;
@@ -840,6 +823,32 @@ ns_menu_bar_height (NSScreen *screen)
}
+/* Get the frame rect, in system coordinates, of the parent window or,
+ if there is no parent window, the main screen. */
+static inline NSRect
+ns_parent_window_rect (struct frame *f)
+{
+ NSRect parentRect;
+
+ if (FRAME_PARENT_FRAME (f) != NULL)
+ {
+ EmacsView *parentView = FRAME_NS_VIEW (FRAME_PARENT_FRAME (f));
+ parentRect = [parentView convertRect:[parentView frame]
+ toView:nil];
+ parentRect = [[parentView window] convertRectToScreen:parentRect];
+ }
+ else
+ parentRect = [[[NSScreen screens] objectAtIndex:0] frame];
+
+ return parentRect;
+}
+
+/* Calculate system coordinates of the left and top of the parent
+ window or, if there is no parent window, the main screen. */
+#define NS_PARENT_WINDOW_LEFT_POS(f) NSMinX (ns_parent_window_rect (f))
+#define NS_PARENT_WINDOW_TOP_POS(f) NSMaxY (ns_parent_window_rect (f))
+
+
static NSRect
ns_row_rect (struct window *w, struct glyph_row *row,
enum glyph_row_area area)
@@ -1097,13 +1106,12 @@ ns_update_begin (struct frame *f)
external (RIF) call; whole frame, called before gui_update_window_begin
-------------------------------------------------------------------------- */
{
-#ifdef NS_IMPL_COCOA
EmacsView *view = FRAME_NS_VIEW (f);
-
NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_begin");
ns_update_auto_hide_menu_bar ();
+#ifdef NS_IMPL_COCOA
if ([view isFullscreen] && [view fsIsNative])
{
// Fix reappearing tool bar in fullscreen for Mac OS X 10.7
@@ -1113,6 +1121,28 @@ ns_update_begin (struct frame *f)
[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
+
}
@@ -1123,57 +1153,149 @@ ns_update_end (struct frame *f)
external (RIF) call; for whole frame, called after gui_update_window_end
-------------------------------------------------------------------------- */
{
+ EmacsView *view = FRAME_NS_VIEW (f);
+
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
+ [NSGraphicsContext setCurrentContext:nil];
+ [view setNeedsDisplay:YES];
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ }
+ else
+ {
+#endif
+#endif /* NS_DRAW_TO_BUFFER */
-static BOOL
-ns_clip_to_rect (struct frame *f, NSRect *r, int n)
+#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ block_input ();
+
+ [view unlockFocus];
+ [[view window] flushWindow];
+
+ unblock_input ();
+#endif
+#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ }
+#endif
+ ns_updating_frame = NULL;
+}
+
+static void
+ns_focus (struct frame *f, NSRect *r, int n)
/* --------------------------------------------------------------------------
- Clip the drawing area to rectangle r in frame f. If drawing is not
- currently possible mark r as dirty and return NO, otherwise return
- YES.
+ Internal: Focus on given frame. During small local updates this is used to
+ draw, however during large updates, ns_update_begin and ns_update_end are
+ called to wrap the whole thing, in which case these calls are stubbed out.
+ Except, on GNUstep, we accumulate the rectangle being drawn into, because
+ the back end won't do this automatically, and will just end up flushing
+ the entire window.
-------------------------------------------------------------------------- */
{
- NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_clip_to_rect");
- if (r)
+ EmacsView *view = FRAME_NS_VIEW (f);
+
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_focus");
+ if (r != NULL)
{
NSTRACE_RECT ("r", *r);
+ }
- if ([NSView focusView] == FRAME_NS_VIEW (f))
+ if (f != ns_updating_frame)
+ {
+#ifdef NS_DRAW_TO_BUFFER
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
{
- [[NSGraphicsContext currentContext] saveGraphicsState];
- if (n == 2)
- NSRectClipList (r, 2);
- else
- NSRectClip (*r);
-
- return YES;
+#endif
+ [view focusOnDrawingBuffer];
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
else
{
- NSView *view = FRAME_NS_VIEW (f);
- int i;
- for (i = 0 ; i < n ; i++)
- [view setNeedsDisplayInRect:r[i]];
+#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
}
- return NO;
+
+ /* clipping */
+ if (r)
+ {
+ [[NSGraphicsContext currentContext] saveGraphicsState];
+ if (n == 2)
+ NSRectClipList (r, 2);
+ else
+ NSRectClip (*r);
+ gsaved = YES;
+ }
}
static void
-ns_reset_clipping (struct frame *f)
-/* Internal: Restore the previous graphics state, unsetting any
- clipping areas. */
+ns_unfocus (struct frame *f)
+/* --------------------------------------------------------------------------
+ Internal: Remove focus on given frame
+ -------------------------------------------------------------------------- */
{
- NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_reset_clipping");
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_unfocus");
- [[NSGraphicsContext currentContext] restoreGraphicsState];
+ if (gsaved)
+ {
+ [[NSGraphicsContext currentContext] restoreGraphicsState];
+ gsaved = NO;
+ }
+
+#ifdef NS_DRAW_TO_BUFFER
+ #if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
+ {
+#endif
+ [FRAME_NS_VIEW (f) setNeedsDisplay:YES];
+#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 (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
}
@@ -1513,9 +1635,12 @@ ns_make_frame_visible (struct frame *f)
/* Making a new frame from a fullscreen frame will make the new frame
fullscreen also. So skip handleFS as this will print an error. */
- if ([view fsIsNative] && f->want_fullscreen == FULLSCREEN_BOTH
- && [view isFullscreen])
- return;
+ if ([view fsIsNative] && [view isFullscreen])
+ {
+ // maybe it is not necessary to wait
+ [view waitFullScreenTransition];
+ return;
+ }
if (f->want_fullscreen != FULLSCREEN_NONE)
{
@@ -1680,61 +1805,64 @@ ns_set_offset (struct frame *f, int xoff, int yoff, int change_grav)
-------------------------------------------------------------------------- */
{
NSView *view = FRAME_NS_VIEW (f);
- NSScreen *screen = [[view window] screen];
+ NSRect windowFrame = [[view window] frame];
+ NSPoint topLeft;
NSTRACE ("ns_set_offset");
block_input ();
- f->left_pos = xoff;
- f->top_pos = yoff;
+ 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 (f->size_hint_flags & XNegative)
+ topLeft.x = NSMaxX (parentRect) - NSWidth (windowFrame) + xoff;
+ else
+ topLeft.x = NSMinX (parentRect) + xoff;
- if (view != nil)
+ if (f->size_hint_flags & YNegative)
+ topLeft.y = NSMinY (parentRect) + NSHeight (windowFrame) - yoff;
+ else
+ topLeft.y = NSMaxY (parentRect) - yoff;
+ }
+ else
{
- if (FRAME_PARENT_FRAME (f) == NULL && screen)
- {
- f->left_pos = f->size_hint_flags & XNegative
- ? [screen visibleFrame].size.width + f->left_pos - FRAME_PIXEL_WIDTH (f)
- : f->left_pos;
- /* We use visibleFrame here to take menu bar into account.
- Ideally we should also adjust left/top with visibleFrame.origin. */
-
- f->top_pos = f->size_hint_flags & YNegative
- ? ([screen visibleFrame].size.height + f->top_pos
- - FRAME_PIXEL_HEIGHT (f) - FRAME_NS_TITLEBAR_HEIGHT (f)
- - FRAME_TOOLBAR_HEIGHT (f))
- : f->top_pos;
-#ifdef NS_IMPL_GNUSTEP
- if (f->left_pos < 100)
- f->left_pos = 100; /* don't overlap menu */
-#endif
- }
- else if (FRAME_PARENT_FRAME (f) != NULL)
- {
- struct frame *parent = FRAME_PARENT_FRAME (f);
+ /* 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];
- /* On X negative values for child frames always result in
- positioning relative to the bottom right corner of the
- parent frame. */
- if (f->left_pos < 0)
- f->left_pos = FRAME_PIXEL_WIDTH (parent) - FRAME_PIXEL_WIDTH (f) + f->left_pos;
+ if (f->size_hint_flags & XNegative)
+ topLeft.x = NSMaxX (screenFrame) - NSWidth (windowFrame) + xoff;
+ else
+ topLeft.x = xoff;
- if (f->top_pos < 0)
- f->top_pos = FRAME_PIXEL_HEIGHT (parent) + FRAME_TOOLBAR_HEIGHT (parent)
- - FRAME_PIXEL_HEIGHT (f) + f->top_pos;
- }
+ if (f->size_hint_flags & YNegative)
+ topLeft.y = NSMinY (screenFrame) + NSHeight (windowFrame) - yoff;
+ else
+ topLeft.y = NSMaxY ([[[NSScreen screens] objectAtIndex:0] frame]) - yoff;
+
+#ifdef NS_IMPL_GNUSTEP
+ /* Don't overlap the menu.
- /* Constrain the setFrameTopLeftPoint so we don't move behind the
- menu bar. */
- NSPoint pt = NSMakePoint (SCREENMAXBOUND (f->left_pos
- + NS_PARENT_WINDOW_LEFT_POS (f)),
- SCREENMAXBOUND (NS_PARENT_WINDOW_TOP_POS (f)
- - f->top_pos));
- NSTRACE_POINT ("setFrameTopLeftPoint", pt);
- [[view window] setFrameTopLeftPoint: pt];
- f->size_hint_flags &= ~(XNegative|YNegative);
+ FIXME: Surely there's a better way than just hardcoding 100
+ in here? */
+ topLeft.x = 100;
+#endif
}
+ NSTRACE_POINT ("setFrameTopLeftPoint", topLeft);
+ [[view window] setFrameTopLeftPoint:topLeft];
+ f->size_hint_flags &= ~(XNegative|YNegative);
+
unblock_input ();
}
@@ -1801,9 +1929,16 @@ ns_set_window_size (struct frame *f,
make_fixnum (FRAME_NS_TITLEBAR_HEIGHT (f)),
make_fixnum (FRAME_TOOLBAR_HEIGHT (f))));
- [window setFrame: wr display: YES];
+ /* 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];
- [view updateFrameSize: NO];
unblock_input ();
}
@@ -1852,7 +1987,6 @@ ns_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu
so some key presses (TAB) are swallowed by the system. */
[window makeFirstResponder: view];
- [view updateFrameSize: NO];
unblock_input ();
}
}
@@ -1901,8 +2035,16 @@ ns_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_val
block_input ();
child = [FRAME_NS_VIEW (f) window];
+#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
@@ -1910,10 +2052,38 @@ ns_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_val
#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
@@ -2014,29 +2184,21 @@ ns_set_appearance (struct frame *f, Lisp_Object new_value, Lisp_Object old_value
{
#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
- NSWindow *window = [view window];
+ EmacsWindow *window = (EmacsWindow *)[view window];
NSTRACE ("ns_set_appearance");
-#ifndef NSAppKitVersionNumber10_10
-#define NSAppKitVersionNumber10_10 1343
-#endif
-
if (NSAppKitVersionNumber < NSAppKitVersionNumber10_10)
return;
if (EQ (new_value, Qdark))
- {
- window.appearance = [NSAppearance
- appearanceNamed: NSAppearanceNameVibrantDark];
- FRAME_NS_APPEARANCE (f) = ns_appearance_vibrant_dark;
- }
+ FRAME_NS_APPEARANCE (f) = ns_appearance_vibrant_dark;
+ else if (EQ (new_value, Qlight))
+ FRAME_NS_APPEARANCE (f) = ns_appearance_aqua;
else
- {
- window.appearance = [NSAppearance
- appearanceNamed: NSAppearanceNameAqua];
- FRAME_NS_APPEARANCE (f) = ns_appearance_aqua;
- }
+ FRAME_NS_APPEARANCE (f) = ns_appearance_system_default;
+
+ [window setAppearance];
#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 */
}
@@ -2155,9 +2317,6 @@ ns_get_color (const char *name, NSColor **col)
See https://lists.gnu.org/r/emacs-devel/2009-07/msg01203.html. */
{
NSColor *new = nil;
- static char hex[20];
- int scaling = 0;
- float r = -1.0, g, b;
NSString *nsname = [NSString stringWithUTF8String: name];
NSTRACE ("ns_get_color(%s, **)", name);
@@ -2200,48 +2359,31 @@ ns_get_color (const char *name, NSColor **col)
}
/* First, check for some sort of numeric specification. */
- hex[0] = '\0';
-
- if (name[0] == '0' || name[0] == '1' || name[0] == '.') /* RGB decimal */
- {
- NSScanner *scanner = [NSScanner scannerWithString: nsname];
- [scanner scanFloat: &r];
- [scanner scanFloat: &g];
- [scanner scanFloat: &b];
- }
- else if (!strncmp(name, "rgb:", 4)) /* A newer X11 format -- rgb:r/g/b */
- scaling = (snprintf (hex, sizeof hex, "%s", name + 4) - 2) / 3;
- else if (name[0] == '#') /* An old X11 format; convert to newer */
+ unsigned short r16, g16, b16;
+ if (parse_color_spec (name, &r16, &g16, &b16))
{
- int len = (strlen(name) - 1);
- int start = (len % 3 == 0) ? 1 : len / 4 + 1;
- int i;
- scaling = strlen(name+start) / 3;
- for (i = 0; i < 3; i++)
- sprintf (hex + i * (scaling + 1), "%.*s/", scaling,
- name + start + i * scaling);
- hex[3 * (scaling + 1) - 1] = '\0';
+ *col = [NSColor colorForEmacsRed: r16 / 65535.0
+ green: g16 / 65535.0
+ blue: b16 / 65535.0
+ alpha: 1.0];
+ unblock_input ();
+ return 0;
}
-
- if (hex[0])
+ else if (name[0] == '0' || name[0] == '1' || name[0] == '.')
{
- unsigned int rr, gg, bb;
- float fscale = scaling == 4 ? 65535.0 : (scaling == 2 ? 255.0 : 15.0);
- if (sscanf (hex, "%x/%x/%x", &rr, &gg, &bb))
+ /* RGB decimal */
+ NSScanner *scanner = [NSScanner scannerWithString: nsname];
+ float r, g, b;
+ if ( [scanner scanFloat: &r] && r >= 0 && r <= 1
+ && [scanner scanFloat: &g] && g >= 0 && g <= 1
+ && [scanner scanFloat: &b] && b >= 0 && b <= 1)
{
- r = rr / fscale;
- g = gg / fscale;
- b = bb / fscale;
+ *col = [NSColor colorForEmacsRed: r green: g blue: b alpha: 1.0];
+ unblock_input ();
+ return 0;
}
}
- if (r >= 0.0F)
- {
- *col = [NSColor colorForEmacsRed: r green: g blue: b alpha: 1.0];
- unblock_input ();
- return 0;
- }
-
/* Otherwise, color is expected to be from a list */
{
NSEnumerator *lenum, *cenum;
@@ -2302,8 +2444,10 @@ ns_color_index_to_rgba(int idx, struct frame *f)
EmacsCGFloat r, g, b, a;
[col getRed: &r green: &g blue: &b alpha: &a];
- return ARGB_TO_ULONG((int)(a*255),
- (int)(r*255), (int)(g*255), (int)(b*255));
+ return ARGB_TO_ULONG((unsigned long) (a * 255),
+ (unsigned long) (r * 255),
+ (unsigned long) (g * 255),
+ (unsigned long) (b * 255));
}
void
@@ -2323,8 +2467,10 @@ ns_query_color(void *col, Emacs_Color *color_def, bool setPixel)
if (setPixel == YES)
color_def->pixel
- = ARGB_TO_ULONG((int)(a*255),
- (int)(r*255), (int)(g*255), (int)(b*255));
+ = ARGB_TO_ULONG((unsigned long) (a * 255),
+ (unsigned long) (r * 255),
+ (unsigned long) (g * 255),
+ (unsigned long) (b * 255));
}
bool
@@ -2430,7 +2576,8 @@ frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y)
}
static int
-ns_note_mouse_movement (struct frame *frame, CGFloat x, CGFloat y)
+ns_note_mouse_movement (struct frame *frame, CGFloat x, CGFloat y,
+ BOOL dragging)
/* ------------------------------------------------------------------------
Called by EmacsView on mouseMovement events. Passes on
to emacs mainstream code if we moved off of a rect of interest
@@ -2439,17 +2586,24 @@ ns_note_mouse_movement (struct frame *frame, CGFloat x, CGFloat y)
{
struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame);
NSRect *r;
+ BOOL force_update = NO;
// NSTRACE ("note_mouse_movement");
dpyinfo->last_mouse_motion_frame = frame;
r = &dpyinfo->last_mouse_glyph;
+ /* If the last rect is too large (ex, xwidget webkit), update at
+ every move, or resizing by dragging modeline or vertical split is
+ very hard to make its way. */
+ if (dragging && (r->size.width > 32 || r->size.height > 32))
+ force_update = YES;
+
/* Note, this doesn't get called for enter/leave, since we don't have a
position. Those are taken care of in the corresponding NSView methods. */
/* Has movement gone beyond last rect we were tracking? */
- if (x < r->origin.x || x >= r->origin.x + r->size.width
+ if (force_update || x < r->origin.x || x >= r->origin.x + r->size.width
|| y < r->origin.y || y >= r->origin.y + r->size.height)
{
ns_update_begin (frame);
@@ -2478,7 +2632,7 @@ ns_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window,
id view;
NSPoint view_position;
Lisp_Object frame, tail;
- struct frame *f;
+ struct frame *f = NULL;
struct ns_display_info *dpyinfo;
NSTRACE ("ns_mouse_position");
@@ -2770,16 +2924,16 @@ ns_clear_frame (struct frame *f)
r = [view bounds];
block_input ();
- if (ns_clip_to_rect (f, &r, 1))
- {
- [ns_lookup_indexed_color (NS_FACE_BACKGROUND
- (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set];
- NSRectFill (r);
- ns_reset_clipping (f);
-
- /* as of 2006/11 or so this is now needed */
- ns_redraw_scroll_bars (f);
- }
+ ns_focus (f, &r, 1);
+ [ns_lookup_indexed_color (NS_FACE_BACKGROUND
+ (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set];
+ NSRectFill (r);
+ ns_unfocus (f);
+
+ /* as of 2006/11 or so this is now needed */
+ /* FIXME: I don't see any reason for this and removing it makes no
+ difference here. Do we need it for GNUstep? */
+ //ns_redraw_scroll_bars (f);
unblock_input ();
}
@@ -2800,46 +2954,15 @@ ns_clear_frame_area (struct frame *f, int x, int y, int width, int height)
NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_clear_frame_area");
r = NSIntersectionRect (r, [view frame]);
- if (ns_clip_to_rect (f, &r, 1))
- {
- [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set];
+ ns_focus (f, &r, 1);
+ [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set];
- NSRectFill (r);
+ NSRectFill (r);
- ns_reset_clipping (f);
- }
+ ns_unfocus (f);
+ return;
}
-static void
-ns_copy_bits (struct frame *f, NSRect src, NSRect dest)
-{
- NSSize delta = NSMakeSize (dest.origin.x - src.origin.x,
- dest.origin.y - src.origin.y);
- NSTRACE ("ns_copy_bits");
-
- if (FRAME_NS_VIEW (f))
- {
- hide_bell(); // Ensure the bell image isn't scrolled.
-
- /* FIXME: scrollRect:by: is deprecated in macOS 10.14. There is
- no obvious replacement so we may have to come up with our own. */
- [FRAME_NS_VIEW (f) scrollRect: src by: delta];
-
-#ifdef NS_IMPL_COCOA
- /* As far as I can tell from the documentation, scrollRect:by:,
- above, should copy the dirty rectangles from our source
- rectangle to our destination, however it appears it clips the
- operation to src. As a result we need to use
- translateRectsNeedingDisplayInRect:by: below, and we have to
- union src and dest so it can pick up the dirty rectangles,
- and place them, as it also clips to the rectangle.
-
- FIXME: We need a GNUstep equivalent. */
- [FRAME_NS_VIEW (f) translateRectsNeedingDisplayInRect:NSUnionRect (src, dest)
- by:delta];
-#endif
- }
-}
static void
ns_scroll_run (struct window *w, struct run *run)
@@ -2892,8 +3015,12 @@ ns_scroll_run (struct window *w, struct run *run)
{
NSRect srcRect = NSMakeRect (x, from_y, width, height);
NSRect dstRect = NSMakeRect (x, to_y, width, height);
+ EmacsView *view = FRAME_NS_VIEW (f);
- ns_copy_bits (f, srcRect , dstRect);
+ [view copyRect:srcRect to:dstRect];
+#ifdef NS_IMPL_COCOA
+ [view setNeedsDisplayInRect:srcRect];
+#endif
}
unblock_input ();
@@ -2901,6 +3028,40 @@ ns_scroll_run (struct window *w, struct run *run)
static void
+ns_clear_under_internal_border (struct frame *f)
+{
+ NSTRACE ("ns_clear_under_internal_border");
+
+ if (FRAME_INTERNAL_BORDER_WIDTH (f) > 0)
+ {
+ int border_width = FRAME_INTERNAL_BORDER_WIDTH (f);
+ NSView *view = FRAME_NS_VIEW (f);
+ NSRect edge_rect, frame_rect = [view bounds];
+ NSRectEdge edge[] = {NSMinXEdge, NSMinYEdge, NSMaxXEdge, NSMaxYEdge};
+
+ int face_id =
+ !NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
+ : INTERNAL_BORDER_FACE_ID;
+ struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
+
+ if (!face)
+ face = FRAME_DEFAULT_FACE (f);
+
+ ns_focus (f, &frame_rect, 1);
+ [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set];
+ for (int i = 0; i < 4 ; i++)
+ {
+ NSDivideRect (frame_rect, &edge_rect, &frame_rect, border_width, edge[i]);
+
+ NSRectFill (edge_rect);
+ }
+ ns_unfocus (f);
+ }
+}
+
+
+static void
ns_after_update_window_line (struct window *w, struct glyph_row *desired_row)
/* --------------------------------------------------------------------------
External (RIF): preparatory to fringe update after text was updated
@@ -2928,12 +3089,32 @@ ns_after_update_window_line (struct window *w, struct glyph_row *desired_row)
height > 0))
{
int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y));
+ int face_id =
+ !NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
+ : INTERNAL_BORDER_FACE_ID;
+ struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
block_input ();
- ns_clear_frame_area (f, 0, y, width, height);
- ns_clear_frame_area (f,
- FRAME_PIXEL_WIDTH (f) - width,
- y, width, height);
+ if (face)
+ {
+ NSRect r = NSMakeRect (0, y, FRAME_PIXEL_WIDTH (f), height);
+ ns_focus (f, &r, 1);
+
+ [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set];
+ NSRectFill (NSMakeRect (0, y, width, height));
+ NSRectFill (NSMakeRect (FRAME_PIXEL_WIDTH (f) - width,
+ y, width, height));
+
+ ns_unfocus (f);
+ }
+ else
+ {
+ ns_clear_frame_area (f, 0, y, width, height);
+ ns_clear_frame_area (f,
+ FRAME_PIXEL_WIDTH (f) - width,
+ y, width, height);
+ }
unblock_input ();
}
}
@@ -2947,20 +3128,12 @@ ns_shift_glyphs_for_insert (struct frame *f,
External (RIF): copy an area horizontally, don't worry about clearing src
-------------------------------------------------------------------------- */
{
- //NSRect srcRect = NSMakeRect (x, y, width, height);
+ NSRect srcRect = NSMakeRect (x, y, width, height);
NSRect dstRect = NSMakeRect (x+shift_by, y, width, height);
NSTRACE ("ns_shift_glyphs_for_insert");
- /* This doesn't work now as we copy the "bits" before we've had a
- chance to actually draw any changes to the screen. This means in
- certain circumstances we end up with copies of the cursor all
- over the place. Just mark the area dirty so it is redrawn later.
-
- FIXME: Work out how to do this properly. */
- // ns_copy_bits (f, srcRect, dstRect);
-
- [FRAME_NS_VIEW (f) setNeedsDisplayInRect:dstRect];
+ [FRAME_NS_VIEW (f) copyRect:srcRect to:dstRect];
}
@@ -2996,10 +3169,12 @@ ns_compute_glyph_string_overhangs (struct glyph_string *s)
else
{
s->left_overhang = 0;
+#ifdef NS_IMPL_GNUSTEP
if (EQ (font->driver->type, Qns))
s->right_overhang = ((struct nsfont_info *)font)->ital ?
FONT_HEIGHT (font) * 0.2 : 0;
else
+#endif
s->right_overhang = 0;
}
}
@@ -3080,66 +3255,64 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
/* The visible portion of imageRect will always be contained within
clearRect. */
- if (ns_clip_to_rect (f, &clearRect, 1))
+ ns_focus (f, &clearRect, 1);
+ if (! NSIsEmptyRect (clearRect))
{
- if (! NSIsEmptyRect (clearRect))
- {
- NSTRACE_RECT ("clearRect", clearRect);
+ NSTRACE_RECT ("clearRect", clearRect);
- [ns_lookup_indexed_color(face->background, f) set];
- NSRectFill (clearRect);
- }
+ [ns_lookup_indexed_color(face->background, f) set];
+ NSRectFill (clearRect);
+ }
- if (p->which)
- {
- EmacsImage *img = bimgs[p->which - 1];
+ if (p->which)
+ {
+ EmacsImage *img = bimgs[p->which - 1];
- 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);
- }
+ 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);
+ }
- {
- 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];
- }
+ {
+ 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);
+ // 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);
+ NSTRACE_RECT ("fromRect", fromRect);
- [img drawInRect: imageRect
- fromRect: fromRect
- operation: NSCompositingOperationSourceOver
- fraction: 1.0
- respectFlipped: YES
- hints: nil];
- }
- ns_reset_clipping (f);
+ [img drawInRect: imageRect
+ fromRect: fromRect
+ operation: NSCompositingOperationSourceOver
+ fraction: 1.0
+ respectFlipped: YES
+ hints: nil];
}
+ ns_unfocus (f);
}
@@ -3224,60 +3397,52 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row,
/* Prevent the cursor from being drawn outside the text area. */
r = NSIntersectionRect (r, ns_row_rect (w, glyph_row, TEXT_AREA));
- if (ns_clip_to_rect (f, &r, 1))
+ face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id);
+ if (face && NS_FACE_BACKGROUND (face)
+ == ns_index_color (FRAME_CURSOR_COLOR (f), f))
{
- face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id);
- if (face && NS_FACE_BACKGROUND (face)
- == ns_index_color (FRAME_CURSOR_COLOR (f), f))
- {
- [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set];
- hollow_color = FRAME_CURSOR_COLOR (f);
- }
- else
- [FRAME_CURSOR_COLOR (f) set];
-
- switch (cursor_type)
- {
- case DEFAULT_CURSOR:
- case NO_CURSOR:
- break;
- case FILLED_BOX_CURSOR:
- NSRectFill (r);
- break;
- case HOLLOW_BOX_CURSOR:
- NSRectFill (r);
- [hollow_color set];
- NSRectFill (NSInsetRect (r, 1, 1));
- [FRAME_CURSOR_COLOR (f) set];
- break;
- case HBAR_CURSOR:
- NSRectFill (r);
- break;
- case BAR_CURSOR:
- s = r;
- /* If the character under cursor is R2L, draw the bar cursor
- on the right of its glyph, rather than on the left. */
- cursor_glyph = get_phys_cursor_glyph (w);
- if ((cursor_glyph->resolved_level & 1) != 0)
- s.origin.x += cursor_glyph->pixel_width - s.size.width;
-
- NSRectFill (s);
- break;
- }
+ [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set];
+ hollow_color = FRAME_CURSOR_COLOR (f);
+ }
+ else
+ [FRAME_CURSOR_COLOR (f) set];
- /* Draw the character under the cursor. Other terms only draw
- the character on top of box cursors, so do the same here. */
- if (cursor_type == FILLED_BOX_CURSOR || cursor_type == HOLLOW_BOX_CURSOR)
- draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR);
+ ns_focus (f, &r, 1);
- ns_reset_clipping (f);
- }
- else if (! redisplaying_p)
+ switch (cursor_type)
{
- /* If this function is called outside redisplay, it probably
- means we need an immediate update. */
- [FRAME_NS_VIEW (f) display];
+ case DEFAULT_CURSOR:
+ case NO_CURSOR:
+ break;
+ case FILLED_BOX_CURSOR:
+ NSRectFill (r);
+ break;
+ case HOLLOW_BOX_CURSOR:
+ NSRectFill (r);
+ [hollow_color set];
+ NSRectFill (NSInsetRect (r, 1, 1));
+ [FRAME_CURSOR_COLOR (f) set];
+ break;
+ case HBAR_CURSOR:
+ NSRectFill (r);
+ break;
+ case BAR_CURSOR:
+ s = r;
+ /* If the character under cursor is R2L, draw the bar cursor
+ on the right of its glyph, rather than on the left. */
+ cursor_glyph = get_phys_cursor_glyph (w);
+ if ((cursor_glyph->resolved_level & 1) != 0)
+ s.origin.x += cursor_glyph->pixel_width - s.size.width;
+
+ NSRectFill (s);
+ break;
}
+ ns_unfocus (f);
+
+ /* Draw the character under the cursor. Other terms only draw
+ the character on top of box cursors, so do the same here. */
+ if (cursor_type == FILLED_BOX_CURSOR || cursor_type == HOLLOW_BOX_CURSOR)
+ draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR);
}
@@ -3295,14 +3460,12 @@ ns_draw_vertical_window_border (struct window *w, int x, int y0, int y1)
face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID);
- if (ns_clip_to_rect (f, &r, 1))
- {
- if (face)
- [ns_lookup_indexed_color(face->foreground, f) set];
+ ns_focus (f, &r, 1);
+ if (face)
+ [ns_lookup_indexed_color(face->foreground, f) set];
- NSRectFill(r);
- ns_reset_clipping (f);
- }
+ NSRectFill(r);
+ ns_unfocus (f);
}
@@ -3329,42 +3492,42 @@ ns_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1)
NSTRACE ("ns_draw_window_divider");
- if (ns_clip_to_rect (f, &divider, 1))
- {
- if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3))
- /* A vertical divider, at least three pixels wide: Draw first and
- last pixels differently. */
- {
- [ns_lookup_indexed_color(color_first, f) set];
- NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0));
- [ns_lookup_indexed_color(color, f) set];
- NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0));
- [ns_lookup_indexed_color(color_last, f) set];
- NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0));
- }
- else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3))
- /* A horizontal divider, at least three pixels high: Draw first and
- last pixels differently. */
- {
- [ns_lookup_indexed_color(color_first, f) set];
- NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1));
- [ns_lookup_indexed_color(color, f) set];
- NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2));
- [ns_lookup_indexed_color(color_last, f) set];
- NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1));
- }
- else
- {
- /* In any other case do not draw the first and last pixels
- differently. */
- [ns_lookup_indexed_color(color, f) set];
- NSRectFill(divider);
- }
+ ns_focus (f, &divider, 1);
- ns_reset_clipping (f);
+ if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3))
+ /* A vertical divider, at least three pixels wide: Draw first and
+ last pixels differently. */
+ {
+ [ns_lookup_indexed_color(color_first, f) set];
+ NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0));
+ [ns_lookup_indexed_color(color, f) set];
+ NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0));
+ [ns_lookup_indexed_color(color_last, f) set];
+ NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0));
+ }
+ else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3))
+ /* A horizontal divider, at least three pixels high: Draw first and
+ last pixels differently. */
+ {
+ [ns_lookup_indexed_color(color_first, f) set];
+ NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1));
+ [ns_lookup_indexed_color(color, f) set];
+ NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2));
+ [ns_lookup_indexed_color(color_last, f) set];
+ NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1));
+ }
+ else
+ {
+ /* In any other case do not draw the first and last pixels
+ differently. */
+ [ns_lookup_indexed_color(color, f) set];
+ NSRectFill(divider);
}
+
+ ns_unfocus (f);
}
+
static void
ns_show_hourglass (struct frame *f)
{
@@ -3589,8 +3752,8 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face,
}
static void
-ns_draw_box (NSRect r, CGFloat thickness, NSColor *col,
- char left_p, char right_p)
+ns_draw_box (NSRect r, CGFloat hthickness, CGFloat vthickness,
+ NSColor *col, char left_p, char right_p)
/* --------------------------------------------------------------------------
Draw an unfilled rect inside r, optionally leaving left and/or right open.
Note we can't just use an NSDrawRect command, because of the possibility
@@ -3601,28 +3764,28 @@ ns_draw_box (NSRect r, CGFloat thickness, NSColor *col,
[col set];
/* top, bottom */
- s.size.height = thickness;
+ s.size.height = hthickness;
NSRectFill (s);
- s.origin.y += r.size.height - thickness;
+ s.origin.y += r.size.height - hthickness;
NSRectFill (s);
s.size.height = r.size.height;
s.origin.y = r.origin.y;
/* left, right (optional) */
- s.size.width = thickness;
+ s.size.width = vthickness;
if (left_p)
NSRectFill (s);
if (right_p)
{
- s.origin.x += r.size.width - thickness;
+ s.origin.x += r.size.width - vthickness;
NSRectFill (s);
}
}
static void
-ns_draw_relief (NSRect r, int thickness, char raised_p,
+ns_draw_relief (NSRect r, int hthickness, int vthickness, char raised_p,
char top_p, char bottom_p, char left_p, char right_p,
struct glyph_string *s)
/* --------------------------------------------------------------------------
@@ -3672,27 +3835,27 @@ ns_draw_relief (NSRect r, int thickness, char raised_p,
/* TODO: mitering. Using NSBezierPath doesn't work because of color switch. */
/* top */
- sr.size.height = thickness;
+ sr.size.height = hthickness;
if (top_p) NSRectFill (sr);
/* left */
sr.size.height = r.size.height;
- sr.size.width = thickness;
+ sr.size.width = vthickness;
if (left_p) NSRectFill (sr);
[(raised_p ? darkCol : lightCol) set];
/* bottom */
sr.size.width = r.size.width;
- sr.size.height = thickness;
- sr.origin.y += r.size.height - thickness;
+ 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 = thickness;
- sr.origin.x += r.size.width - thickness;
+ sr.size.width = vthickness;
+ sr.origin.x += r.size.width - vthickness;
if (right_p) NSRectFill (sr);
}
@@ -3708,7 +3871,7 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s)
char left_p, right_p;
struct glyph *last_glyph;
NSRect r;
- int thickness;
+ int hthickness, vthickness;
struct face *face;
if (s->hl == DRAW_MOUSE_FACE)
@@ -3721,15 +3884,29 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s)
else
face = s->face;
- thickness = face->box_line_width;
+ vthickness = face->box_vertical_line_width;
+ hthickness = face->box_horizontal_line_width;
NSTRACE ("ns_dumpglyphs_box_or_relief");
last_x = ((s->row->full_width_p && !s->w->pseudo_window_p)
? WINDOW_RIGHT_EDGE_X (s->w)
: window_box_right (s->w, s->area));
- last_glyph = (s->cmp || s->img
- ? s->first_glyph : s->first_glyph + s->nchars-1);
+ if (s->cmp || s->img)
+ last_glyph = s->first_glyph;
+ else if (s->first_glyph->type == COMPOSITE_GLYPH
+ && s->first_glyph->u.cmp.automatic)
+ {
+ struct glyph *end = s->row->glyphs[s->area] + s->row->used[s->area];
+ struct glyph *g = s->first_glyph;
+ for (last_glyph = g++;
+ g < end && g->u.cmp.automatic && g->u.cmp.id == s->cmp_id
+ && g->slice.cmp.to < s->cmp_to;
+ last_glyph = g++)
+ ;
+ }
+ else
+ last_glyph = s->first_glyph + s->nchars - 1;
right_x = ((s->row->full_width_p && s->extends_to_end_of_line_p
? last_x - 1 : min (last_x, s->x + s->background_width) - 1));
@@ -3746,14 +3923,15 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s)
/* TODO: Sometimes box_color is 0 and this seems wrong; should investigate. */
if (s->face->box == FACE_SIMPLE_BOX && s->face->box_color)
{
- ns_draw_box (r, abs (thickness),
+ ns_draw_box (r, abs (hthickness), abs (vthickness),
ns_lookup_indexed_color (face->box_color, s->f),
- left_p, right_p);
+ left_p, right_p);
}
else
{
- ns_draw_relief (r, abs (thickness), s->face->box == FACE_RAISED_BOX,
- 1, 1, left_p, right_p, s);
+ ns_draw_relief (r, abs (hthickness), abs (vthickness),
+ s->face->box == FACE_RAISED_BOX,
+ 1, 1, left_p, right_p, s);
}
}
@@ -3769,7 +3947,7 @@ ns_maybe_dumpglyphs_background (struct glyph_string *s, char force_p)
if (!s->background_filled_p/* || s->hl == DRAW_MOUSE_FACE*/)
{
- int box_line_width = max (s->face->box_line_width, 0);
+ int box_line_width = max (s->face->box_horizontal_line_width, 0);
if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width
/* When xdisp.c ignores FONT_HEIGHT, we cannot trust font
dimensions, since the actual glyphs might be much
@@ -3820,7 +3998,7 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
-------------------------------------------------------------------------- */
{
EmacsImage *img = s->img->pixmap;
- int box_line_vwidth = max (s->face->box_line_width, 0);
+ int box_line_vwidth = max (s->face->box_horizontal_line_width, 0);
int x = s->x, y = s->ybase - image_ascent (s->img, s->face, &s->slice);
int bg_x, bg_y, bg_height;
int th;
@@ -3833,7 +4011,7 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p && s->slice.x == 0)
- x += abs (s->face->box_line_width);
+ x += max (s->face->box_vertical_line_width, 0);
bg_x = x;
bg_y = s->slice.y == 0 ? s->y : s->y + box_line_vwidth;
@@ -3888,20 +4066,39 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
[[NSGraphicsContext currentContext] saveGraphicsState];
- /* Because of the transforms it's far too difficult to work out
- what portion of the original, untransformed, image will be
- drawn, so the clipping area will ensure we draw only the
- correct bit. */
+ /* Because of the transforms it's difficult to work out what
+ portion of the original, untransformed, image will be drawn,
+ so the clipping area will ensure we draw only the correct
+ bit. */
NSRectClip (dr);
[setOrigin translateXBy:x - s->slice.x yBy:y - s->slice.y];
[setOrigin concat];
- [img->transform concat];
+
+ NSAffineTransform *doTransform = [NSAffineTransform transform];
+
+ /* ImageMagick images don't have transforms. */
+ if (img->transform)
+ [doTransform appendTransform:img->transform];
+
+ [doTransform concat];
+
+ /* Smoothing is the default, so if we don't want smoothing we
+ have to turn it off. */
+ if (! img->smoothing)
+ [[NSGraphicsContext currentContext]
+ setImageInterpolation:NSImageInterpolationNone];
[img drawInRect:ir fromRect:ir
operation:NSCompositingOperationSourceOver
fraction:1.0 respectFlipped:YES hints:nil];
+ /* Apparently image interpolation is not reset with
+ restoreGraphicsState, so we have to manually reset it. */
+ if (! img->smoothing)
+ [[NSGraphicsContext currentContext]
+ setImageInterpolation:NSImageInterpolationDefault];
+
[[NSGraphicsContext currentContext] restoreGraphicsState];
}
@@ -3946,7 +4143,7 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
r.origin.y = y - th;
r.size.width = s->slice.width + 2*th-1;
r.size.height = s->slice.height + 2*th-1;
- ns_draw_relief (r, th, raised_p,
+ ns_draw_relief (r, th, th, raised_p,
s->slice.y == 0,
s->slice.y + s->slice.height == s->img->height,
s->slice.x == 0,
@@ -3960,7 +4157,7 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
{
int thickness = abs (s->img->relief);
if (thickness == 0) thickness = 1;
- ns_draw_box (br, thickness, FRAME_CURSOR_COLOR (s->f), 1, 1);
+ ns_draw_box (br, thickness, thickness, FRAME_CURSOR_COLOR (s->f), 1, 1);
}
}
@@ -3969,89 +4166,65 @@ static void
ns_dumpglyphs_stretch (struct glyph_string *s)
{
NSRect r[2];
- int n, i;
+ NSRect glyphRect;
+ int n;
struct face *face;
NSColor *fgCol, *bgCol;
if (!s->background_filled_p)
{
n = ns_get_glyph_string_clip_rect (s, r);
+ ns_focus (s->f, r, n);
- if (ns_clip_to_rect (s->f, r, n))
+ if (s->hl == DRAW_MOUSE_FACE)
{
- /* FIXME: Why are we reusing the clipping rectangles? The
- other terms don't appear to do anything like this. */
- *r = NSMakeRect (s->x, s->y, s->background_width, s->height);
+ face = FACE_FROM_ID_OR_NULL (s->f,
+ MOUSE_HL_INFO (s->f)->mouse_face_face_id);
+ if (!face)
+ face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
+ }
+ else
+ face = FACE_FROM_ID (s->f, s->first_glyph->face_id);
- if (s->hl == DRAW_MOUSE_FACE)
- {
- face = FACE_FROM_ID_OR_NULL (s->f,
- MOUSE_HL_INFO (s->f)->mouse_face_face_id);
- if (!face)
- face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
- }
- else
- face = FACE_FROM_ID (s->f, s->first_glyph->face_id);
+ bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f);
+ fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f);
- bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f);
- fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f);
+ glyphRect = NSMakeRect (s->x, s->y, s->background_width, s->height);
- for (i = 0; i < n; ++i)
- {
- if (!s->row->full_width_p)
- {
- int overrun, leftoverrun;
-
- /* truncate to avoid overwriting fringe and/or scrollbar */
- overrun = max (0, (s->x + s->background_width)
- - (WINDOW_BOX_RIGHT_EDGE_X (s->w)
- - WINDOW_RIGHT_FRINGE_WIDTH (s->w)));
- r[i].size.width -= overrun;
-
- /* truncate to avoid overwriting to left of the window box */
- leftoverrun = (WINDOW_BOX_LEFT_EDGE_X (s->w)
- + WINDOW_LEFT_FRINGE_WIDTH (s->w)) - s->x;
-
- if (leftoverrun > 0)
- {
- r[i].origin.x += leftoverrun;
- r[i].size.width -= leftoverrun;
- }
- }
+ [bgCol set];
- [bgCol set];
+ /* NOTE: under NS this is NOT used to draw cursors, but we must avoid
+ overwriting cursor (usually when cursor on a tab) */
+ if (s->hl == DRAW_CURSOR)
+ {
+ CGFloat x, width;
- /* NOTE: under NS this is NOT used to draw cursors, but we must avoid
- overwriting cursor (usually when cursor on a tab). */
- if (s->hl == DRAW_CURSOR)
- {
- CGFloat x, width;
+ /* FIXME: This looks like it will only work for left to
+ right languages. */
+ x = NSMinX (glyphRect);
+ width = s->w->phys_cursor_width;
+ glyphRect.size.width -= width;
+ glyphRect.origin.x += width;
- x = r[i].origin.x;
- width = s->w->phys_cursor_width;
- r[i].size.width -= width;
- r[i].origin.x += width;
+ NSRectFill (glyphRect);
- NSRectFill (r[i]);
+ /* Draw overlining, etc. on the cursor. */
+ if (s->w->phys_cursor_type == FILLED_BOX_CURSOR)
+ ns_draw_text_decoration (s, face, bgCol, width, x);
+ else
+ ns_draw_text_decoration (s, face, fgCol, width, x);
+ }
+ else
+ {
+ NSRectFill (glyphRect);
+ }
- /* Draw overlining, etc. on the cursor. */
- if (s->w->phys_cursor_type == FILLED_BOX_CURSOR)
- ns_draw_text_decoration (s, face, bgCol, width, x);
- else
- ns_draw_text_decoration (s, face, fgCol, width, x);
- }
- else
- {
- NSRectFill (r[i]);
- }
+ /* Draw overlining, etc. on the stretch glyph (or the part
+ of the stretch glyph after the cursor). */
+ ns_draw_text_decoration (s, face, fgCol, NSWidth (glyphRect),
+ NSMinX (glyphRect));
- /* Draw overlining, etc. on the stretch glyph (or the part
- of the stretch glyph after the cursor). */
- ns_draw_text_decoration (s, face, fgCol, r[i].size.width,
- r[i].origin.x);
- }
- ns_reset_clipping (s->f);
- }
+ ns_unfocus (s->f);
s->background_filled_p = 1;
}
}
@@ -4067,7 +4240,7 @@ ns_draw_glyph_string_foreground (struct glyph_string *s)
of S to the right of that box line. */
if (s->face && s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -4093,7 +4266,7 @@ ns_draw_composite_glyph_string_foreground (struct glyph_string *s)
of S to the right of that box line. */
if (s->face && s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -4109,7 +4282,7 @@ ns_draw_composite_glyph_string_foreground (struct glyph_string *s)
if (s->cmp_from == 0)
{
NSRect r = NSMakeRect (s->x, s->y, s->width-1, s->height -1);
- ns_draw_box (r, 1, FRAME_CURSOR_COLOR (s->f), 1, 1);
+ ns_draw_box (r, 1, 1, FRAME_CURSOR_COLOR (s->f), 1, 1);
}
}
else if (! s->first_glyph->u.cmp.automatic)
@@ -4201,11 +4374,9 @@ ns_draw_glyph_string (struct glyph_string *s)
if (next->first_glyph->type != STRETCH_GLYPH)
{
n = ns_get_glyph_string_clip_rect (s->next, r);
- if (ns_clip_to_rect (s->f, r, n))
- {
- ns_maybe_dumpglyphs_background (s->next, 1);
- ns_reset_clipping (s->f);
- }
+ ns_focus (s->f, r, n);
+ ns_maybe_dumpglyphs_background (s->next, 1);
+ ns_unfocus (s->f);
}
else
{
@@ -4220,12 +4391,10 @@ ns_draw_glyph_string (struct glyph_string *s)
|| s->first_glyph->type == COMPOSITE_GLYPH))
{
n = ns_get_glyph_string_clip_rect (s, r);
- if (ns_clip_to_rect (s->f, r, n))
- {
- ns_maybe_dumpglyphs_background (s, 1);
- ns_dumpglyphs_box_or_relief (s);
- ns_reset_clipping (s->f);
- }
+ ns_focus (s->f, r, n);
+ ns_maybe_dumpglyphs_background (s, 1);
+ ns_dumpglyphs_box_or_relief (s);
+ ns_unfocus (s->f);
box_drawn_p = 1;
}
@@ -4234,11 +4403,13 @@ ns_draw_glyph_string (struct glyph_string *s)
case IMAGE_GLYPH:
n = ns_get_glyph_string_clip_rect (s, r);
- if (ns_clip_to_rect (s->f, r, n))
- {
- ns_dumpglyphs_image (s, r[0]);
- ns_reset_clipping (s->f);
- }
+ ns_focus (s->f, r, n);
+ ns_dumpglyphs_image (s, r[0]);
+ ns_unfocus (s->f);
+ break;
+
+ case XWIDGET_GLYPH:
+ x_draw_xwidget_glyph_string (s);
break;
case STRETCH_GLYPH:
@@ -4248,68 +4419,66 @@ ns_draw_glyph_string (struct glyph_string *s)
case CHAR_GLYPH:
case COMPOSITE_GLYPH:
n = ns_get_glyph_string_clip_rect (s, r);
- if (ns_clip_to_rect (s->f, r, n))
- {
- if (s->for_overlaps || (s->cmp_from > 0
- && ! s->first_glyph->u.cmp.automatic))
- s->background_filled_p = 1;
- else
- ns_maybe_dumpglyphs_background
- (s, s->first_glyph->type == COMPOSITE_GLYPH);
+ ns_focus (s->f, r, n);
- if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR)
- {
- unsigned long tmp = NS_FACE_BACKGROUND (s->face);
- NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face);
- NS_FACE_FOREGROUND (s->face) = tmp;
- }
+ if (s->for_overlaps || (s->cmp_from > 0
+ && ! s->first_glyph->u.cmp.automatic))
+ s->background_filled_p = 1;
+ else
+ ns_maybe_dumpglyphs_background
+ (s, s->first_glyph->type == COMPOSITE_GLYPH);
- {
- BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH;
+ if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR)
+ {
+ unsigned long tmp = NS_FACE_BACKGROUND (s->face);
+ NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face);
+ NS_FACE_FOREGROUND (s->face) = tmp;
+ }
- if (isComposite)
- ns_draw_composite_glyph_string_foreground (s);
- else
- ns_draw_glyph_string_foreground (s);
- }
+ {
+ BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH;
- {
- NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0
- ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face),
- s->f)
- : FRAME_FOREGROUND_COLOR (s->f));
- [col set];
-
- /* Draw underline, overline, strike-through. */
- ns_draw_text_decoration (s, s->face, col, s->width, s->x);
- }
+ if (isComposite)
+ ns_draw_composite_glyph_string_foreground (s);
+ else
+ ns_draw_glyph_string_foreground (s);
+ }
- if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR)
- {
- unsigned long tmp = NS_FACE_BACKGROUND (s->face);
- NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face);
- NS_FACE_FOREGROUND (s->face) = tmp;
- }
+ {
+ NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0
+ ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face),
+ s->f)
+ : FRAME_FOREGROUND_COLOR (s->f));
+ [col set];
+
+ /* Draw underline, overline, strike-through. */
+ ns_draw_text_decoration (s, s->face, col, s->width, s->x);
+ }
- ns_reset_clipping (s->f);
+ if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR)
+ {
+ unsigned long tmp = NS_FACE_BACKGROUND (s->face);
+ NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face);
+ NS_FACE_FOREGROUND (s->face) = tmp;
}
+
+ ns_unfocus (s->f);
break;
case GLYPHLESS_GLYPH:
n = ns_get_glyph_string_clip_rect (s, r);
- if (ns_clip_to_rect (s->f, r, n))
- {
- if (s->for_overlaps || (s->cmp_from > 0
- && ! s->first_glyph->u.cmp.automatic))
- s->background_filled_p = 1;
- else
- ns_maybe_dumpglyphs_background
- (s, s->first_glyph->type == COMPOSITE_GLYPH);
- /* ... */
- /* Not yet implemented. */
- /* ... */
- ns_reset_clipping (s->f);
- }
+ ns_focus (s->f, r, n);
+
+ if (s->for_overlaps || (s->cmp_from > 0
+ && ! s->first_glyph->u.cmp.automatic))
+ s->background_filled_p = 1;
+ else
+ ns_maybe_dumpglyphs_background
+ (s, s->first_glyph->type == COMPOSITE_GLYPH);
+ /* ... */
+ /* Not yet implemented. */
+ /* ... */
+ ns_unfocus (s->f);
break;
default:
@@ -4320,11 +4489,9 @@ ns_draw_glyph_string (struct glyph_string *s)
if (!s->for_overlaps && !box_drawn_p && s->face->box != FACE_NO_BOX)
{
n = ns_get_glyph_string_clip_rect (s, r);
- if (ns_clip_to_rect (s->f, r, n))
- {
- ns_dumpglyphs_box_or_relief (s);
- ns_reset_clipping (s->f);
- }
+ ns_focus (s->f, r, n);
+ ns_dumpglyphs_box_or_relief (s);
+ ns_unfocus (s->f);
}
s->num_clips = 0;
@@ -5001,9 +5168,6 @@ ns_judge_scroll_bars (struct frame *f)
if ([view judge])
removed = YES;
}
-
- if (removed)
- [eview updateFrameSize: NO];
}
/* ==========================================================================
@@ -5168,7 +5332,7 @@ static struct redisplay_interface ns_redisplay_interface =
ns_draw_glyph_string,
ns_define_frame_cursor,
ns_clear_frame_area,
- 0, /* clear_under_internal_border */
+ ns_clear_under_internal_border, /* clear_under_internal_border */
ns_draw_window_cursor,
ns_draw_vertical_window_border,
ns_draw_window_divider,
@@ -5368,7 +5532,8 @@ ns_term_init (Lisp_Object display_name)
{
NSColorList *cl = [NSColorList colorListNamed: @"Emacs"];
- if ( cl == nil )
+ /* There are 752 colors defined in rgb.txt. */
+ if ( cl == nil || [[cl allKeys] count] < 752)
{
Lisp_Object color_file, color_map, color;
unsigned long c;
@@ -5396,7 +5561,7 @@ ns_term_init (Lisp_Object display_name)
}
/* FIXME: Report any errors writing the color file below. */
-#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101100
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101100
#if MAC_OS_X_VERSION_MIN_REQUIRED < 101100
if ([cl respondsToSelector:@selector(writeToURL:error:)])
#endif
@@ -5775,7 +5940,7 @@ ns_term_shutdown (int sig)
emacs_event->kind = NS_NONKEY_EVENT;
emacs_event->code = KEY_NS_OPEN_FILE_LINE;
- ns_input_file = append2 (ns_input_file, build_string ([fileName UTF8String]));
+ ns_input_file = append2 (ns_input_file, [fileName lispString]);
ns_input_line = Qnil; /* can be start or cons start,end */
emacs_event->modifiers =0;
EV_TRAILER (theEvent);
@@ -6139,8 +6304,7 @@ not_in_argv (NSString *arg)
error: (NSString **)error
{
[ns_pending_service_names addObject: userData];
- [ns_pending_service_args addObject: [NSString stringWithUTF8String:
- SSDATA (ns_string_from_pasteboard (pboard))]];
+ [ns_pending_service_args addObject: [NSString stringWithLispString:ns_string_from_pasteboard (pboard)]];
}
@@ -6157,8 +6321,8 @@ not_in_argv (NSString *arg)
emacs_event->kind = NS_NONKEY_EVENT;
emacs_event->code = KEY_NS_SPI_SERVICE_CALL;
- ns_input_spi_name = build_string ([name UTF8String]);
- ns_input_spi_arg = build_string ([arg UTF8String]);
+ ns_input_spi_name = [name lispString];
+ ns_input_spi_arg = [arg lispString];
emacs_event->modifiers = EV_MODIFIERS (theEvent);
EV_TRAILER (theEvent);
@@ -6190,6 +6354,17 @@ not_in_argv (NSString *arg)
- (void)dealloc
{
NSTRACE ("[EmacsView dealloc]");
+
+ /* Clear the view resize notification. */
+ [[NSNotificationCenter defaultCenter]
+ removeObserver:self
+ name:NSViewFrameDidChangeNotification
+ object:nil];
+
+#ifdef NS_DRAW_TO_BUFFER
+ CGContextRelease (drawingBuffer);
+#endif
+
[toolbar release];
if (fs_state == FULLSCREEN_BOTH)
[nonfs_window release];
@@ -6229,7 +6404,7 @@ not_in_argv (NSString *arg)
size = [newFont pointSize];
ns_input_fontsize = make_fixnum (lrint (size));
- ns_input_font = build_string ([[newFont familyName] UTF8String]);
+ ns_input_font = [[newFont familyName] lispString];
EV_TRAILER (e);
}
}
@@ -6305,7 +6480,7 @@ not_in_argv (NSString *arg)
if (nsEvArray == nil)
nsEvArray = [[NSMutableArray alloc] initWithCapacity: 1];
- [NSCursor setHiddenUntilMouseMoves: YES];
+ [NSCursor setHiddenUntilMouseMoves:! NILP (Vmake_pointer_invisible)];
if (hlinfo->mouse_face_hidden && FIXNUMP (Vmouse_highlight))
{
@@ -6540,7 +6715,7 @@ not_in_argv (NSString *arg)
processingCompose = YES;
[workingText release];
workingText = [str copy];
- ns_working_text = build_string ([workingText UTF8String]);
+ ns_working_text = [workingText lispString];
emacs_event->kind = NS_TEXT_EVENT;
emacs_event->code = KEY_NS_PUT_WORKING_TEXT;
@@ -6606,13 +6781,18 @@ not_in_argv (NSString *arg)
{
NSRect rect;
NSPoint pt;
- struct window *win = XWINDOW (FRAME_SELECTED_WINDOW (emacsframe));
+ struct window *win;
NSTRACE ("[EmacsView firstRectForCharacterRange:]");
if (NS_KEYLOG)
NSLog (@"firstRectForCharRange request");
+ if (WINDOWP (echo_area_window) && ! NILP (call0 (intern ("ns-in-echo-area"))))
+ win = XWINDOW (echo_area_window);
+ else
+ win = XWINDOW (FRAME_SELECTED_WINDOW (emacsframe));
+
rect.size.width = theRange.length * FRAME_COLUMN_WIDTH (emacsframe);
rect.size.height = FRAME_LINE_HEIGHT (emacsframe);
pt.x = WINDOW_TEXT_TO_FRAME_PIXEL_X (win, win->phys_cursor.x);
@@ -6719,8 +6899,6 @@ not_in_argv (NSString *arg)
NSTRACE ("[EmacsView mouseDown:]");
- [self deleteWorkingText];
-
if (!emacs_event)
return;
@@ -6930,6 +7108,7 @@ not_in_argv (NSString *arg)
struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe);
Lisp_Object frame;
NSPoint pt;
+ BOOL dragging;
NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "[EmacsView mouseMoved:]");
@@ -6972,7 +7151,8 @@ not_in_argv (NSString *arg)
last_mouse_window = window;
}
- if (!ns_note_mouse_movement (emacsframe, pt.x, pt.y))
+ dragging = (e.type == NSEventTypeLeftMouseDragged);
+ if (!ns_note_mouse_movement (emacsframe, pt.x, pt.y, dragging))
help_echo_string = previous_help_echo_string;
XSETFRAME (frame, emacsframe);
@@ -7028,105 +7208,12 @@ not_in_argv (NSString *arg)
return NO;
}
-- (void) updateFrameSize: (BOOL) delay
-{
- NSWindow *window = [self window];
- NSRect wr = [window frame];
- int extra = 0;
- int oldc = cols, oldr = rows;
- int oldw = FRAME_PIXEL_WIDTH (emacsframe);
- int oldh = FRAME_PIXEL_HEIGHT (emacsframe);
- int neww, newh;
-
- NSTRACE ("[EmacsView updateFrameSize:]");
- NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh));
- NSTRACE_RECT ("Original frame", wr);
- NSTRACE_MSG ("Original columns: %d", cols);
- NSTRACE_MSG ("Original rows: %d", rows);
-
- if (! [self isFullscreen])
- {
- int toolbar_height;
-#ifdef NS_IMPL_GNUSTEP
- // GNUstep does not always update the tool bar height. Force it.
- if (toolbar && [toolbar isVisible])
- update_frame_tool_bar (emacsframe);
-#endif
-
- toolbar_height = FRAME_TOOLBAR_HEIGHT (emacsframe);
- if (toolbar_height < 0)
- toolbar_height = 35;
-
- extra = FRAME_NS_TITLEBAR_HEIGHT (emacsframe)
- + toolbar_height;
- }
-
- if (wait_for_tool_bar)
- {
- /* The toolbar height is always 0 in fullscreen and undecorated
- frames, so don't wait for it to become available. */
- if (FRAME_TOOLBAR_HEIGHT (emacsframe) == 0
- && FRAME_UNDECORATED (emacsframe) == false
- && ! [self isFullscreen])
- {
- NSTRACE_MSG ("Waiting for toolbar");
- return;
- }
- wait_for_tool_bar = NO;
- }
-
- neww = (int)wr.size.width - emacsframe->border_width;
- newh = (int)wr.size.height - extra;
-
- NSTRACE_SIZE ("New size", NSMakeSize (neww, newh));
- NSTRACE_MSG ("FRAME_TOOLBAR_HEIGHT: %d", FRAME_TOOLBAR_HEIGHT (emacsframe));
- NSTRACE_MSG ("FRAME_NS_TITLEBAR_HEIGHT: %d", FRAME_NS_TITLEBAR_HEIGHT (emacsframe));
-
- cols = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (emacsframe, neww);
- rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (emacsframe, newh);
-
- if (cols < MINWIDTH)
- cols = MINWIDTH;
-
- if (rows < MINHEIGHT)
- rows = MINHEIGHT;
-
- NSTRACE_MSG ("New columns: %d", cols);
- NSTRACE_MSG ("New rows: %d", rows);
-
- if (oldr != rows || oldc != cols || neww != oldw || newh != oldh)
- {
- NSView *view = FRAME_NS_VIEW (emacsframe);
-
- change_frame_size (emacsframe,
- FRAME_PIXEL_TO_TEXT_WIDTH (emacsframe, neww),
- FRAME_PIXEL_TO_TEXT_HEIGHT (emacsframe, newh),
- 0, delay, 0, 1);
- SET_FRAME_GARBAGED (emacsframe);
- cancel_mouse_face (emacsframe);
-
- /* The next two lines set the frame to the same size as we've
- already set above. We need to do this when we switch back
- from non-native fullscreen, in other circumstances it appears
- to be a noop. (bug#28872) */
- wr = NSMakeRect (0, 0, neww, newh);
- [view setFrame: wr];
-
- // To do: consider using [NSNotificationCenter postNotificationName:].
- [self windowDidMove: // Update top/left.
- [NSNotification notificationWithName:NSWindowDidMoveNotification
- object:[view window]]];
- }
- else
- {
- NSTRACE_MSG ("No change");
- }
-}
- (NSSize)windowWillResize: (NSWindow *)sender toSize: (NSSize)frameSize
/* Normalize frame to gridded text size. */
{
int extra = 0;
+ int cols, rows;
NSTRACE ("[EmacsView windowWillResize:toSize: " NSTRACE_FMT_SIZE "]",
NSTRACE_ARG_SIZE (frameSize));
@@ -7192,6 +7279,7 @@ not_in_argv (NSString *arg)
size_title = xmalloc (strlen (old_title) + 40);
esprintf (size_title, "%s — (%d x %d)", old_title, cols, rows);
[window setTitle: [NSString stringWithUTF8String: size_title]];
+ [window display];
xfree (size_title);
}
}
@@ -7262,11 +7350,6 @@ not_in_argv (NSString *arg)
sz = [self windowWillResize: theWindow toSize: sz];
#endif /* NS_IMPL_GNUSTEP */
- if (cols > 0 && rows > 0)
- {
- [self updateFrameSize: YES];
- }
-
ns_send_appdefined (-1);
}
@@ -7287,6 +7370,55 @@ not_in_argv (NSString *arg)
#endif /* NS_IMPL_COCOA */
+- (void)viewDidResize:(NSNotification *)notification
+{
+ NSRect frame = [self frame];
+ int neww, newh;
+
+ if (! FRAME_LIVE_P (emacsframe))
+ return;
+
+ NSTRACE ("[EmacsView viewDidResize]");
+
+ neww = (int)NSWidth (frame);
+ newh = (int)NSHeight (frame);
+ NSTRACE_SIZE ("New size", NSMakeSize (neww, newh));
+
+#ifdef NS_DRAW_TO_BUFFER
+ if ([self wantsUpdateLayer])
+ {
+ CGFloat scale = [[self window] backingScaleFactor];
+ int oldw = (CGFloat)CGBitmapContextGetWidth (drawingBuffer) / scale;
+ int oldh = (CGFloat)CGBitmapContextGetHeight (drawingBuffer) / scale;
+
+ NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh));
+
+ /* Don't want to do anything when the view size hasn't changed. */
+ if ((oldh == newh && oldw == neww))
+ {
+ NSTRACE_MSG ("No change");
+ return;
+ }
+ }
+#endif
+
+ /* 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);
+
+#ifdef NS_DRAW_TO_BUFFER
+ [self createDrawingBuffer];
+#endif
+ SET_FRAME_GARBAGED (emacsframe);
+ cancel_mouse_face (emacsframe);
+}
+
+
- (void)windowDidBecomeKey: (NSNotification *)notification
/* cf. x_detect_focus_change(), x_focus_changed(), x_new_focus_frame() */
{
@@ -7345,7 +7477,6 @@ not_in_argv (NSString *arg)
if (emacs_event && is_focus_frame)
{
- [self deleteWorkingText];
emacs_event->kind = FOCUS_OUT_EVENT;
EV_TRAILER ((id)nil);
}
@@ -7411,7 +7542,7 @@ not_in_argv (NSString *arg)
{
NSRect r, wr;
Lisp_Object tem;
- NSWindow *win;
+ EmacsWindow *win;
NSColor *col;
NSString *name;
@@ -7431,6 +7562,7 @@ 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;
@@ -7460,7 +7592,10 @@ not_in_argv (NSString *arg)
#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_7)
#endif
- [win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary];
+ if (FRAME_PARENT_FRAME (f))
+ [win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary];
+ else
+ [win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary];
#endif
wr = [win frame];
@@ -7489,16 +7624,8 @@ not_in_argv (NSString *arg)
if (! FRAME_UNDECORATED (f))
[self createToolbar: f];
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
-#ifndef NSAppKitVersionNumber10_10
-#define NSAppKitVersionNumber10_10 1343
-#endif
- if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_10
- && FRAME_NS_APPEARANCE (f) != ns_appearance_aqua)
- win.appearance = [NSAppearance
- appearanceNamed: NSAppearanceNameVibrantDark];
-#endif
+ [win setAppearance];
#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
if ([win respondsToSelector: @selector(titlebarAppearsTransparent)])
@@ -7508,7 +7635,7 @@ not_in_argv (NSString *arg)
tem = f->icon_name;
if (!NILP (tem))
[win setMiniwindowTitle:
- [NSString stringWithUTF8String: SSDATA (tem)]];
+ [NSString stringWithLispString:tem]];
if (FRAME_PARENT_FRAME (f) != NULL)
{
@@ -7558,14 +7685,22 @@ not_in_argv (NSString *arg)
[NSApp registerServicesMenuSendTypes: ns_send_types
returnTypes: [NSArray array]];
+#ifdef NS_DRAW_TO_BUFFER
+ [self createDrawingBuffer];
+#endif
+
+ /* Set up view resize notifications. */
+ [self setPostsFrameChangedNotifications:YES];
+ [[NSNotificationCenter defaultCenter]
+ 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. */
-#if defined (NS_IMPL_COCOA) \
- && MAC_OS_X_VERSION_MAX_ALLOWED >= 101200
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101200
+#ifdef NS_IMPL_COCOA
if ([win respondsToSelector: @selector(setTabbingMode:)])
-#endif
[win setTabbingMode: NSWindowTabbingModeDisallowed];
#endif
@@ -7587,15 +7722,15 @@ not_in_argv (NSString *arg)
return;
if (screen != nil)
{
- emacsframe->left_pos = r.origin.x - NS_PARENT_WINDOW_LEFT_POS (emacsframe);
- emacsframe->top_pos =
- NS_PARENT_WINDOW_TOP_POS (emacsframe) - (r.origin.y + r.size.height);
+ emacsframe->left_pos = NSMinX (r) - NS_PARENT_WINDOW_LEFT_POS (emacsframe);
+ emacsframe->top_pos = NS_PARENT_WINDOW_TOP_POS (emacsframe) - NSMaxY (r);
- if (emacs_event)
- {
- emacs_event->kind = MOVE_FRAME_EVENT;
- EV_TRAILER ((id)nil);
- }
+ // FIXME: after event part below didExitFullScreen is not received
+ // if (emacs_event)
+ // {
+ // emacs_event->kind = MOVE_FRAME_EVENT;
+ // EV_TRAILER ((id)nil);
+ // }
}
}
@@ -7795,6 +7930,7 @@ not_in_argv (NSString *arg)
- (void)windowWillEnterFullScreen:(NSNotification *)notification
{
NSTRACE ("[EmacsView windowWillEnterFullScreen:]");
+ in_fullscreen_transition = YES;
[self windowWillEnterFullScreen];
}
- (void)windowWillEnterFullScreen /* provided for direct calls */
@@ -7807,6 +7943,7 @@ not_in_argv (NSString *arg)
{
NSTRACE ("[EmacsView windowDidEnterFullScreen:]");
[self windowDidEnterFullScreen];
+ in_fullscreen_transition = NO;
}
- (void)windowDidEnterFullScreen /* provided for direct calls */
@@ -7845,6 +7982,7 @@ not_in_argv (NSString *arg)
- (void)windowWillExitFullScreen:(NSNotification *)notification
{
NSTRACE ("[EmacsView windowWillExitFullScreen:]");
+ in_fullscreen_transition = YES;
[self windowWillExitFullScreen];
}
@@ -7864,6 +8002,7 @@ not_in_argv (NSString *arg)
{
NSTRACE ("[EmacsView windowDidExitFullScreen:]");
[self windowDidExitFullScreen];
+ in_fullscreen_transition = NO;
}
- (void)windowDidExitFullScreen /* provided for direct calls */
@@ -7883,7 +8022,6 @@ not_in_argv (NSString *arg)
{
[toolbar setVisible:YES];
update_frame_tool_bar (emacsframe);
- [self updateFrameSize:YES];
[[self window] display];
}
else
@@ -7893,6 +8031,22 @@ not_in_argv (NSString *arg)
[[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;
@@ -7931,9 +8085,22 @@ not_in_argv (NSString *arg)
NSWindow *win = [self window];
NSWindowCollectionBehavior b = [win collectionBehavior];
if (ns_use_native_fullscreen)
- b |= NSWindowCollectionBehaviorFullScreenPrimary;
+ {
+ if ([win parentWindow])
+ {
+ b &= ~NSWindowCollectionBehaviorFullScreenPrimary;
+ b |= NSWindowCollectionBehaviorFullScreenAuxiliary;
+ }
+ else
+ {
+ b |= NSWindowCollectionBehaviorFullScreenPrimary;
+ b &= ~NSWindowCollectionBehaviorFullScreenAuxiliary;
+ }
+ }
else
- b &= ~NSWindowCollectionBehaviorFullScreenPrimary;
+ {
+ b &= ~NSWindowCollectionBehaviorFullScreenPrimary;
+ }
[win setCollectionBehavior: b];
#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
@@ -7959,8 +8126,14 @@ 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;
}
@@ -8061,11 +8234,11 @@ not_in_argv (NSString *arg)
// send notifications.
[self windowWillExitFullScreen];
- [fw setFrame: [w frame] display:YES animate:ns_use_fullscreen_animation];
+ [fw setFrame:[[w contentView] frame]
+ display:YES animate:ns_use_fullscreen_animation];
[fw close];
[w makeKeyAndOrderFront:NSApp];
[self windowDidExitFullScreen];
- [self updateFrameSize:YES];
}
}
@@ -8209,13 +8382,8 @@ not_in_argv (NSString *arg)
if (!emacs_event)
return self;
- /* Send first event (for some reason two needed). */
theEvent = [[self window] currentEvent];
emacs_event->kind = TOOL_BAR_EVENT;
- XSETFRAME (emacs_event->arg, emacsframe);
- EV_TRAILER (theEvent);
-
- emacs_event->kind = TOOL_BAR_EVENT;
/* XSETINT (emacs_event->code, 0); */
emacs_event->arg = AREF (emacsframe->tool_bar_items,
idx + TOOL_BAR_ITEM_KEY);
@@ -8239,55 +8407,165 @@ not_in_argv (NSString *arg)
}
-- (void)viewWillDraw
+#ifdef NS_DRAW_TO_BUFFER
+- (void)createDrawingBuffer
+ /* Create and store a new CGGraphicsContext for Emacs to draw into.
+
+ We can't do this in GNUstep as there's no equivalent, so under
+ GNUstep we retain the old method of drawing direct to the
+ EmacsView. */
{
- /* If the frame has been garbaged there's no point in redrawing
- anything. */
- if (FRAME_GARBAGED_P (emacsframe))
- [self setNeedsDisplay:NO];
+ NSTRACE ("EmacsView createDrawingBuffer]");
+
+ if (! [self wantsUpdateLayer])
+ return;
+
+ NSGraphicsContext *screen;
+ CGColorSpaceRef colorSpace = [[[self window] colorSpace] CGColorSpace];
+ CGFloat scale = [[self window] backingScaleFactor];
+ NSRect frame = [self frame];
+
+ if (drawingBuffer != nil)
+ CGContextRelease (drawingBuffer);
+
+ drawingBuffer = CGBitmapContextCreate (nil, NSWidth (frame) * scale, NSHeight (frame) * scale,
+ 8, 0, colorSpace,
+ kCGImageAlphaPremultipliedFirst | kCGBitmapByteOrder32Host);
+
+ /* This fixes the scale to match the backing scale factor, and flips the image. */
+ CGContextTranslateCTM(drawingBuffer, 0, NSHeight (frame) * scale);
+ CGContextScaleCTM(drawingBuffer, scale, -scale);
}
-- (void)drawRect: (NSRect)rect
+
+- (void)focusOnDrawingBuffer
{
- const NSRect *rectList;
- NSInteger numRects;
+ NSTRACE ("EmacsView focusOnDrawingBuffer]");
- NSTRACE ("[EmacsView drawRect:" NSTRACE_FMT_RECT "]",
- NSTRACE_ARG_RECT(rect));
+ NSGraphicsContext *buf =
+ [NSGraphicsContext
+ graphicsContextWithCGContext:drawingBuffer flipped:YES];
- if (!emacsframe || !emacsframe->output_data.ns)
+ [NSGraphicsContext setCurrentContext:buf];
+}
+
+
+- (void)windowDidChangeBackingProperties:(NSNotification *)notification
+ /* Update the drawing buffer when the backing properties change. */
+{
+ NSTRACE ("EmacsView windowDidChangeBackingProperties:]");
+
+ if (! [self wantsUpdateLayer])
return;
- block_input ();
+ NSRect frame = [self frame];
+ [self createDrawingBuffer];
+ ns_clear_frame (emacsframe);
+ expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame));
+}
+#endif /* NS_DRAW_TO_BUFFER */
+
- /* Get only the precise dirty rectangles to avoid redrawing
- potentially large areas of the frame that haven't changed.
+- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect
+{
+ NSTRACE ("[EmacsView copyRect:To:]");
+ NSTRACE_RECT ("Source", srcRect);
+ NSTRACE_RECT ("Destination", dstRect);
- I'm not sure this actually provides much of a performance benefit
- as it's hard to benchmark, but it certainly doesn't seem to
- hurt. */
- [self getRectsBeingDrawn:&rectList count:&numRects];
- for (int i = 0 ; i < numRects ; i++)
+#ifdef NS_DRAW_TO_BUFFER
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ if ([self wantsUpdateLayer])
{
- NSRect r = rectList[i];
+#endif
+ CGImageRef copy;
+ NSRect frame = [self frame];
+ NSAffineTransform *setOrigin = [NSAffineTransform transform];
+
+ [[NSGraphicsContext currentContext] saveGraphicsState];
+
+ /* Set the clipping before messing with the buffer's
+ orientation. */
+ NSRectClip (dstRect);
+
+ /* Unflip the buffer as the copied image will be unflipped, and
+ offset the top left so when we draw back into the buffer the
+ correct part of the image is drawn. */
+ CGContextScaleCTM(drawingBuffer, 1, -1);
+ CGContextTranslateCTM(drawingBuffer,
+ NSMinX (dstRect) - NSMinX (srcRect),
+ -NSHeight (frame) - (NSMinY (dstRect) - NSMinY (srcRect)));
- NSTRACE_RECT ("r", r);
+ /* Take a copy of the buffer and then draw it back to the buffer,
+ limited by the clipping rectangle. */
+ copy = CGBitmapContextCreateImage (drawingBuffer);
+ CGContextDrawImage (drawingBuffer, frame, copy);
- expose_frame (emacsframe,
- NSMinX (r), NSMinY (r),
- NSWidth (r), NSHeight (r));
+ CGImageRelease (copy);
+
+ [[NSGraphicsContext currentContext] restoreGraphicsState];
+ [self setNeedsDisplayInRect:dstRect];
+
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
+ else
+ {
+#endif
+#endif /* NS_DRAW_TO_BUFFER */
- unblock_input ();
+#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ hide_bell(); // Ensure the bell image isn't scrolled.
+
+ ns_focus (emacsframe, &dstRect, 1);
+ [self scrollRect: srcRect
+ by: NSMakeSize (dstRect.origin.x - srcRect.origin.x,
+ dstRect.origin.y - srcRect.origin.y)];
+ ns_unfocus (emacsframe);
+#endif
+#if defined (NS_DRAW_TO_BUFFER) && 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;
+}
- /*
- drawRect: may be called (at least in Mac OS X 10.5) for invisible
- views as well for some reason. Thus, do not infer visibility
- here.
- emacsframe->async_visible = 1;
- emacsframe->async_iconified = 0;
- */
+- (void)updateLayer
+{
+ NSTRACE ("[EmacsView updateLayer]");
+
+ CGImageRef contentsImage = CGBitmapContextCreateImage(drawingBuffer);
+ [[self layer] setContents:(id)contentsImage];
+ CGImageRelease(contentsImage);
+}
+#endif
+
+
+- (void)drawRect: (NSRect)rect
+{
+ NSTRACE ("[EmacsView drawRect:" NSTRACE_FMT_RECT "]",
+ NSTRACE_ARG_RECT(rect));
+
+ if (!emacsframe || !emacsframe->output_data.ns)
+ return;
+
+ int x = NSMinX (rect), y = NSMinY (rect);
+ int width = NSWidth (rect), height = NSHeight (rect);
+
+ ns_clear_frame_area (emacsframe, x, y, width, height);
+ block_input ();
+ expose_frame (emacsframe, x, y, width, height);
+ unblock_input ();
}
@@ -8361,7 +8639,7 @@ not_in_argv (NSString *arg)
fenum = [files objectEnumerator];
while ( (file = [fenum nextObject]) )
- strings = Fcons (build_string ([file UTF8String]), strings);
+ strings = Fcons ([file lispString], strings);
}
else if ([type isEqualToString: NSPasteboardTypeURL])
{
@@ -8370,7 +8648,7 @@ not_in_argv (NSString *arg)
type_sym = Qurl;
- strings = list1 (build_string ([[url absoluteString] UTF8String]));
+ strings = list1 ([[url absoluteString] lispString]);
}
else if ([type isEqualToString: NSPasteboardTypeString]
|| [type isEqualToString: NSPasteboardTypeTabularText])
@@ -8382,7 +8660,7 @@ not_in_argv (NSString *arg)
type_sym = Qnil;
- strings = list1 (build_string ([data UTF8String]));
+ strings = list1 ([data lispString]);
}
else
{
@@ -8488,13 +8766,6 @@ not_in_argv (NSString *arg)
}
-- (void) setRows: (int) r andColumns: (int) c
-{
- NSTRACE ("[EmacsView setRows:%d andColumns:%d]", r, c);
- rows = r;
- cols = c;
-}
-
- (int) fullscreenState
{
return fs_state;
@@ -8561,9 +8832,7 @@ not_in_argv (NSString *arg)
}
if (STRINGP (str))
{
- const char *utfStr = SSDATA (str);
- NSString *nsStr = [NSString stringWithUTF8String: utfStr];
- return nsStr;
+ return [NSString stringWithLispString:str];
}
}
@@ -8748,6 +9017,32 @@ not_in_argv (NSString *arg)
#endif
}
+- (void)setAppearance
+{
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
+ struct frame *f = ((EmacsView *)[self delegate])->emacsframe;
+ NSAppearance *appearance = nil;
+
+ NSTRACE ("[EmacsWindow setAppearance]");
+
+#ifndef NSAppKitVersionNumber10_10
+#define NSAppKitVersionNumber10_10 1343
+#endif
+
+ if (NSAppKitVersionNumber < NSAppKitVersionNumber10_10)
+ return;
+
+ if (FRAME_NS_APPEARANCE (f) == ns_appearance_vibrant_dark)
+ appearance =
+ [NSAppearance appearanceNamed:NSAppearanceNameVibrantDark];
+ else if (FRAME_NS_APPEARANCE (f) == ns_appearance_aqua)
+ appearance =
+ [NSAppearance appearanceNamed:NSAppearanceNameAqua];
+
+ [self setAppearance:appearance];
+#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 */
+}
+
- (void)setFrame:(NSRect)windowFrame
display:(BOOL)displayViews
{
diff --git a/src/nsxwidget.h b/src/nsxwidget.h
new file mode 100644
index 00000000000..3d91594c341
--- /dev/null
+++ b/src/nsxwidget.h
@@ -0,0 +1,80 @@
+/* Header for NS Cocoa part of xwidget and webkit widget.
+
+Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+
+#ifndef NSXWIDGET_H_INCLUDED
+#define NSXWIDGET_H_INCLUDED
+
+/* This file can be included from non-objc files through 'xwidget.h'. */
+#ifdef __OBJC__
+#import <AppKit/NSView.h>
+#endif
+
+#include "dispextern.h"
+#include "lisp.h"
+#include "xwidget.h"
+
+/* Functions for xwidget webkit. */
+
+bool nsxwidget_is_web_view (struct xwidget *xw);
+Lisp_Object nsxwidget_webkit_uri (struct xwidget *xw);
+Lisp_Object nsxwidget_webkit_title (struct xwidget *xw);
+void nsxwidget_webkit_goto_uri (struct xwidget *xw, const char *uri);
+void nsxwidget_webkit_goto_history (struct xwidget *xw, int rel_pos);
+void nsxwidget_webkit_zoom (struct xwidget *xw, double zoom_change);
+void nsxwidget_webkit_execute_script (struct xwidget *xw, const char *script,
+ Lisp_Object fun);
+
+/* Functions for xwidget model. */
+
+#ifdef __OBJC__
+@interface XwWindow : NSView
+@property struct xwidget *xw;
+@end
+#endif
+
+void nsxwidget_init (struct xwidget *xw);
+void nsxwidget_kill (struct xwidget *xw);
+void nsxwidget_resize (struct xwidget *xw);
+Lisp_Object nsxwidget_get_size (struct xwidget *xw);
+
+/* Functions for xwidget view. */
+
+#ifdef __OBJC__
+@interface XvWindow : NSView
+@property struct xwidget *xw;
+@property struct xwidget_view *xv;
+@end
+#endif
+
+void nsxwidget_init_view (struct xwidget_view *xv,
+ struct xwidget *xww,
+ struct glyph_string *s,
+ int x, int y);
+void nsxwidget_delete_view (struct xwidget_view *xv);
+
+void nsxwidget_show_view (struct xwidget_view *xv);
+void nsxwidget_hide_view (struct xwidget_view *xv);
+void nsxwidget_resize_view (struct xwidget_view *xv,
+ int widget, int height);
+
+void nsxwidget_move_view (struct xwidget_view *xv, int x, int y);
+void nsxwidget_move_widget_in_view (struct xwidget_view *xv, int x, int y);
+void nsxwidget_set_needsdisplay (struct xwidget_view *xv);
+
+#endif /* NSXWIDGET_H_INCLUDED */
diff --git a/src/nsxwidget.m b/src/nsxwidget.m
new file mode 100644
index 00000000000..3c6402c03ff
--- /dev/null
+++ b/src/nsxwidget.m
@@ -0,0 +1,601 @@
+/* NS Cocoa part implementation of xwidget and webkit widget.
+
+Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#include "lisp.h"
+#include "blockinput.h"
+#include "dispextern.h"
+#include "buffer.h"
+#include "frame.h"
+#include "nsterm.h"
+#include "xwidget.h"
+
+#import <AppKit/AppKit.h>
+#import <WebKit/WebKit.h>
+
+/* Thoughts on NS Cocoa xwidget and webkit2:
+
+ Webkit2 process architecture seems to be very hostile for offscreen
+ rendering techniques, which is used by GTK xwidget implementation;
+ Specifically NSView level view sharing / copying is not working.
+
+ *** So only one view can be associated with a model. ***
+
+ With this decision, implementation is plain and can expect best out
+ of webkit2's rationale. But process and session structures will
+ diverge from GTK xwidget. Though, cosmetically similar usages can
+ be presented and will be preferred, if agreeable.
+
+ For other widget types, OSR seems possible, but will not care for a
+ while. */
+
+/* Xwidget webkit. */
+
+@interface XwWebView : WKWebView
+<WKNavigationDelegate, WKUIDelegate, WKScriptMessageHandler>
+@property struct xwidget *xw;
+/* Map url to whether javascript is blocked by
+ 'Content-Security-Policy' sandbox without allow-scripts. */
+@property(retain) NSMutableDictionary *urlScriptBlocked;
+@end
+@implementation XwWebView : WKWebView
+
+- (id)initWithFrame:(CGRect)frame
+ configuration:(WKWebViewConfiguration *)configuration
+ xwidget:(struct xwidget *)xw
+{
+ /* Script controller to add script message handler and user script. */
+ WKUserContentController *scriptor = [[WKUserContentController alloc] init];
+ configuration.userContentController = scriptor;
+
+ /* Enable inspect element context menu item for debugging. */
+ [configuration.preferences setValue:@YES
+ forKey:@"developerExtrasEnabled"];
+
+ Lisp_Object enablePlugins =
+ Fintern (build_string ("xwidget-webkit-enable-plugins"), Qnil);
+ if (!EQ (Fsymbol_value (enablePlugins), Qnil))
+ configuration.preferences.plugInsEnabled = YES;
+
+ self = [super initWithFrame:frame configuration:configuration];
+ if (self)
+ {
+ self.xw = xw;
+ self.urlScriptBlocked = [[NSMutableDictionary alloc] init];
+ self.navigationDelegate = self;
+ self.UIDelegate = self;
+ self.customUserAgent =
+ @"Mozilla/5.0 (Macintosh; Intel Mac OS X 10_12_6)"
+ @" AppleWebKit/603.3.8 (KHTML, like Gecko)"
+ @" Version/11.0.1 Safari/603.3.8";
+ [scriptor addScriptMessageHandler:self name:@"keyDown"];
+ [scriptor addUserScript:[[WKUserScript alloc]
+ initWithSource:xwScript
+ injectionTime:
+ WKUserScriptInjectionTimeAtDocumentStart
+ forMainFrameOnly:NO]];
+ }
+ return self;
+}
+
+- (void)webView:(WKWebView *)webView
+didFinishNavigation:(WKNavigation *)navigation
+{
+ if (EQ (Fbuffer_live_p (self.xw->buffer), Qt))
+ store_xwidget_event_string (self.xw, "load-changed", "");
+}
+
+- (void)webView:(WKWebView *)webView
+decidePolicyForNavigationAction:(WKNavigationAction *)navigationAction
+decisionHandler:(void (^)(WKNavigationActionPolicy))decisionHandler
+{
+ switch (navigationAction.navigationType) {
+ case WKNavigationTypeLinkActivated:
+ decisionHandler (WKNavigationActionPolicyAllow);
+ break;
+ default:
+ // decisionHandler (WKNavigationActionPolicyCancel);
+ decisionHandler (WKNavigationActionPolicyAllow);
+ break;
+ }
+}
+
+- (void)webView:(WKWebView *)webView
+decidePolicyForNavigationResponse:(WKNavigationResponse *)navigationResponse
+decisionHandler:(void (^)(WKNavigationResponsePolicy))decisionHandler
+{
+ if (!navigationResponse.canShowMIMEType)
+ {
+ NSString *url = navigationResponse.response.URL.absoluteString;
+ NSString *mimetype = navigationResponse.response.MIMEType;
+ NSString *filename = navigationResponse.response.suggestedFilename;
+ decisionHandler (WKNavigationResponsePolicyCancel);
+ store_xwidget_download_callback_event (self.xw,
+ url.UTF8String,
+ mimetype.UTF8String,
+ filename.UTF8String);
+ return;
+ }
+ decisionHandler (WKNavigationResponsePolicyAllow);
+
+ self.urlScriptBlocked[navigationResponse.response.URL] =
+ [NSNumber numberWithBool:NO];
+ if ([navigationResponse.response isKindOfClass:[NSHTTPURLResponse class]])
+ {
+ NSDictionary *headers =
+ ((NSHTTPURLResponse *) navigationResponse.response).allHeaderFields;
+ NSString *value = headers[@"Content-Security-Policy"];
+ if (value)
+ {
+ /* TODO: Sloppy parsing of 'Content-Security-Policy' value. */
+ NSRange sandbox = [value rangeOfString:@"sandbox"];
+ if (sandbox.location != NSNotFound
+ && (sandbox.location == 0
+ || [value characterAtIndex:(sandbox.location - 1)] == ' '
+ || [value characterAtIndex:(sandbox.location - 1)] == ';'))
+ {
+ NSRange allowScripts = [value rangeOfString:@"allow-scripts"];
+ if (allowScripts.location == NSNotFound
+ || allowScripts.location < sandbox.location)
+ self.urlScriptBlocked[navigationResponse.response.URL] =
+ [NSNumber numberWithBool:YES];
+ }
+ }
+ }
+}
+
+/* No additional new webview or emacs window will be created
+ for <a ... target="_blank">. */
+- (WKWebView *)webView:(WKWebView *)webView
+createWebViewWithConfiguration:(WKWebViewConfiguration *)configuration
+ forNavigationAction:(WKNavigationAction *)navigationAction
+ windowFeatures:(WKWindowFeatures *)windowFeatures
+{
+ if (!navigationAction.targetFrame.isMainFrame)
+ [webView loadRequest:navigationAction.request];
+ return nil;
+}
+
+/* Open panel for file upload. */
+- (void)webView:(WKWebView *)webView
+runOpenPanelWithParameters:(WKOpenPanelParameters *)parameters
+initiatedByFrame:(WKFrameInfo *)frame
+completionHandler:(void (^)(NSArray<NSURL *> *URLs))completionHandler
+{
+ NSOpenPanel *openPanel = [NSOpenPanel openPanel];
+ openPanel.canChooseFiles = YES;
+ openPanel.canChooseDirectories = NO;
+ openPanel.allowsMultipleSelection = parameters.allowsMultipleSelection;
+ if ([openPanel runModal] == NSModalResponseOK)
+ completionHandler (openPanel.URLs);
+ else
+ completionHandler (nil);
+}
+
+/* By forwarding mouse events to emacs view (frame)
+ - Mouse click in webview selects the window contains the webview.
+ - Correct mouse hand/arrow/I-beam is displayed (TODO: not perfect yet).
+*/
+
+- (void)mouseDown:(NSEvent *)event
+{
+ [self.xw->xv->emacswindow mouseDown:event];
+ [super mouseDown:event];
+}
+
+- (void)mouseUp:(NSEvent *)event
+{
+ [self.xw->xv->emacswindow mouseUp:event];
+ [super mouseUp:event];
+}
+
+/* Basically we want keyboard events handled by emacs unless an input
+ element has focus. Especially, while incremental search, we set
+ emacs as first responder to avoid focus held in an input element
+ with matching text. */
+
+- (void)keyDown:(NSEvent *)event
+{
+ Lisp_Object var = Fintern (build_string ("isearch-mode"), Qnil);
+ Lisp_Object val = buffer_local_value (var, Fcurrent_buffer ());
+ if (!EQ (val, Qunbound) && !EQ (val, Qnil))
+ {
+ [self.window makeFirstResponder:self.xw->xv->emacswindow];
+ [self.xw->xv->emacswindow keyDown:event];
+ return;
+ }
+
+ /* Emacs handles keyboard events when javascript is blocked. */
+ if ([self.urlScriptBlocked[self.URL] boolValue])
+ {
+ [self.xw->xv->emacswindow keyDown:event];
+ return;
+ }
+
+ [self evaluateJavaScript:@"xwHasFocus()"
+ completionHandler:^(id result, NSError *error) {
+ if (error)
+ {
+ NSLog (@"xwHasFocus: %@", error);
+ [self.xw->xv->emacswindow keyDown:event];
+ }
+ else if (result)
+ {
+ NSNumber *hasFocus = result; /* __NSCFBoolean */
+ if (!hasFocus.boolValue)
+ [self.xw->xv->emacswindow keyDown:event];
+ else
+ [super keyDown:event];
+ }
+ }];
+}
+
+- (void)interpretKeyEvents:(NSArray<NSEvent *> *)eventArray
+{
+ /* We should do nothing and do not forward (default implementation
+ if we not override here) to let emacs collect key events and ask
+ interpretKeyEvents to its superclass. */
+}
+
+static NSString *xwScript;
++ (void)initialize
+{
+ /* Find out if an input element has focus.
+ Message to script message handler when 'C-g' key down. */
+ if (!xwScript)
+ xwScript =
+ @"function xwHasFocus() {"
+ @" var ae = document.activeElement;"
+ @" if (ae) {"
+ @" var name = ae.nodeName;"
+ @" return name == 'INPUT' || name == 'TEXTAREA';"
+ @" } else {"
+ @" return false;"
+ @" }"
+ @"}"
+ @"function xwKeyDown(event) {"
+ @" if (event.ctrlKey && event.key == 'g') {"
+ @" window.webkit.messageHandlers.keyDown.postMessage('C-g');"
+ @" }"
+ @"}"
+ @"document.addEventListener('keydown', xwKeyDown);"
+ ;
+}
+
+/* Confirming to WKScriptMessageHandler, listens concerning keyDown in
+ webkit. Currently 'C-g'. */
+- (void)userContentController:(WKUserContentController *)userContentController
+ didReceiveScriptMessage:(WKScriptMessage *)message
+{
+ if ([message.body isEqualToString:@"C-g"])
+ {
+ /* Just give up focus, no relay "C-g" to emacs, another "C-g"
+ follows will be handled by emacs. */
+ [self.window makeFirstResponder:self.xw->xv->emacswindow];
+ }
+}
+
+@end
+
+/* Xwidget webkit commands. */
+
+static Lisp_Object build_string_with_nsstr (NSString *nsstr);
+
+bool
+nsxwidget_is_web_view (struct xwidget *xw)
+{
+ return xw->xwWidget != NULL &&
+ [xw->xwWidget isKindOfClass:WKWebView.class];
+}
+
+Lisp_Object
+nsxwidget_webkit_uri (struct xwidget *xw)
+{
+ XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
+ return build_string_with_nsstr (xwWebView.URL.absoluteString);
+}
+
+Lisp_Object
+nsxwidget_webkit_title (struct xwidget *xw)
+{
+ XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
+ return build_string_with_nsstr (xwWebView.title);
+}
+
+/* @Note ATS - Need application transport security in 'Info.plist' or
+ remote pages will not loaded. */
+void
+nsxwidget_webkit_goto_uri (struct xwidget *xw, const char *uri)
+{
+ XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
+ NSString *urlString = [NSString stringWithUTF8String:uri];
+ NSURL *url = [NSURL URLWithString:urlString];
+ NSURLRequest *urlRequest = [NSURLRequest requestWithURL:url];
+ [xwWebView loadRequest:urlRequest];
+}
+
+void
+nsxwidget_webkit_goto_history (struct xwidget *xw, int rel_pos)
+{
+ XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
+ switch (rel_pos) {
+ case -1: [xwWebView goBack]; break;
+ case 0: [xwWebView reload]; break;
+ case 1: [xwWebView goForward]; break;
+ }
+}
+
+void
+nsxwidget_webkit_zoom (struct xwidget *xw, double zoom_change)
+{
+ XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
+ xwWebView.magnification += zoom_change;
+ /* TODO: setMagnification:centeredAtPoint. */
+}
+
+/* Build lisp string */
+static Lisp_Object
+build_string_with_nsstr (NSString *nsstr)
+{
+ const char *utfstr = [nsstr UTF8String];
+ NSUInteger bytes = [nsstr lengthOfBytesUsingEncoding:NSUTF8StringEncoding];
+ return make_string (utfstr, bytes);
+}
+
+/* Recursively convert an objc native type JavaScript value to a Lisp
+ value. Mostly copied from GTK xwidget 'webkit_js_to_lisp'. */
+static Lisp_Object
+js_to_lisp (id value)
+{
+ if (value == nil || [value isKindOfClass:NSNull.class])
+ return Qnil;
+ else if ([value isKindOfClass:NSString.class])
+ return build_string_with_nsstr ((NSString *) value);
+ else if ([value isKindOfClass:NSNumber.class])
+ {
+ NSNumber *nsnum = (NSNumber *) value;
+ char type = nsnum.objCType[0];
+ if (type == 'c') /* __NSCFBoolean has type character 'c'. */
+ return nsnum.boolValue? Qt : Qnil;
+ else
+ {
+ if (type == 'i' || type == 'l')
+ return make_int (nsnum.longValue);
+ else if (type == 'f' || type == 'd')
+ return make_float (nsnum.doubleValue);
+ /* else fall through. */
+ }
+ }
+ else if ([value isKindOfClass:NSArray.class])
+ {
+ NSArray *nsarr = (NSArray *) value;
+ EMACS_INT n = nsarr.count;
+ Lisp_Object obj;
+ struct Lisp_Vector *p = allocate_nil_vector (n);
+
+ for (ptrdiff_t i = 0; i < n; ++i)
+ p->contents[i] = js_to_lisp ([nsarr objectAtIndex:i]);
+ XSETVECTOR (obj, p);
+ return obj;
+ }
+ else if ([value isKindOfClass:NSDictionary.class])
+ {
+ NSDictionary *nsdict = (NSDictionary *) value;
+ NSArray *keys = nsdict.allKeys;
+ ptrdiff_t n = keys.count;
+ Lisp_Object obj;
+ struct Lisp_Vector *p = allocate_nil_vector (n);
+
+ for (ptrdiff_t i = 0; i < n; ++i)
+ {
+ NSString *prop_key = (NSString *) [keys objectAtIndex:i];
+ id prop_value = [nsdict valueForKey:prop_key];
+ p->contents[i] = Fcons (build_string_with_nsstr (prop_key),
+ js_to_lisp (prop_value));
+ }
+ XSETVECTOR (obj, p);
+ return obj;
+ }
+ NSLog (@"Unhandled type in javascript result");
+ return Qnil;
+}
+
+void
+nsxwidget_webkit_execute_script (struct xwidget *xw, const char *script,
+ Lisp_Object fun)
+{
+ XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
+ if ([xwWebView.urlScriptBlocked[xwWebView.URL] boolValue])
+ {
+ message ("Javascript is blocked by 'CSP: sandbox'.");
+ return;
+ }
+
+ NSString *javascriptString = [NSString stringWithUTF8String:script];
+ [xwWebView evaluateJavaScript:javascriptString
+ completionHandler:^(id result, NSError *error) {
+ if (error)
+ {
+ NSLog (@"evaluateJavaScript error : %@", error.localizedDescription);
+ NSLog (@"error script=%@", javascriptString);
+ }
+ else if (result && FUNCTIONP (fun))
+ {
+ // NSLog (@"result=%@, type=%@", result, [result class]);
+ Lisp_Object lisp_value = js_to_lisp (result);
+ store_xwidget_js_callback_event (xw, fun, lisp_value);
+ }
+ }];
+}
+
+/* Window containing an xwidget. */
+
+@implementation XwWindow
+- (BOOL)isFlipped { return YES; }
+@end
+
+/* Xwidget model, macOS Cocoa part. */
+
+void
+nsxwidget_init(struct xwidget *xw)
+{
+ block_input ();
+ NSRect rect = NSMakeRect (0, 0, xw->width, xw->height);
+ xw->xwWidget = [[XwWebView alloc]
+ initWithFrame:rect
+ configuration:[[WKWebViewConfiguration alloc] init]
+ xwidget:xw];
+ xw->xwWindow = [[XwWindow alloc]
+ initWithFrame:rect];
+ [xw->xwWindow addSubview:xw->xwWidget];
+ xw->xv = NULL; /* for 1 to 1 relationship of webkit2. */
+ unblock_input ();
+}
+
+void
+nsxwidget_kill (struct xwidget *xw)
+{
+ if (xw)
+ {
+ WKUserContentController *scriptor =
+ ((XwWebView *) xw->xwWidget).configuration.userContentController;
+ [scriptor removeAllUserScripts];
+ [scriptor removeScriptMessageHandlerForName:@"keyDown"];
+ [scriptor release];
+ if (xw->xv)
+ xw->xv->model = Qnil; /* Make sure related view stale. */
+
+ /* This stops playing audio when a xwidget-webkit buffer is
+ killed. I could not find other solution. */
+ nsxwidget_webkit_goto_uri (xw, "about:blank");
+
+ [((XwWebView *) xw->xwWidget).urlScriptBlocked release];
+ [xw->xwWidget removeFromSuperviewWithoutNeedingDisplay];
+ [xw->xwWidget release];
+ [xw->xwWindow removeFromSuperviewWithoutNeedingDisplay];
+ [xw->xwWindow release];
+ xw->xwWidget = nil;
+ }
+}
+
+void
+nsxwidget_resize (struct xwidget *xw)
+{
+ if (xw->xwWidget)
+ {
+ [xw->xwWindow setFrameSize:NSMakeSize(xw->width, xw->height)];
+ [xw->xwWidget setFrameSize:NSMakeSize(xw->width, xw->height)];
+ }
+}
+
+Lisp_Object
+nsxwidget_get_size (struct xwidget *xw)
+{
+ return list2i (xw->xwWidget.frame.size.width,
+ xw->xwWidget.frame.size.height);
+}
+
+/* Xwidget view, macOS Cocoa part. */
+
+@implementation XvWindow : NSView
+- (BOOL)isFlipped { return YES; }
+@end
+
+void
+nsxwidget_init_view (struct xwidget_view *xv,
+ struct xwidget *xw,
+ struct glyph_string *s,
+ int x, int y)
+{
+ /* 'x_draw_xwidget_glyph_string' will calculate correct position and
+ size of clip to draw in emacs buffer window. Thus, just begin at
+ origin with no crop. */
+ xv->x = x;
+ xv->y = y;
+ xv->clip_left = 0;
+ xv->clip_right = xw->width;
+ xv->clip_top = 0;
+ xv->clip_bottom = xw->height;
+
+ xv->xvWindow = [[XvWindow alloc]
+ initWithFrame:NSMakeRect (x, y, xw->width, xw->height)];
+ xv->xvWindow.xw = xw;
+ xv->xvWindow.xv = xv;
+
+ xw->xv = xv; /* For 1 to 1 relationship of webkit2. */
+ [xv->xvWindow addSubview:xw->xwWindow];
+
+ xv->emacswindow = FRAME_NS_VIEW (s->f);
+ [xv->emacswindow addSubview:xv->xvWindow];
+}
+
+void
+nsxwidget_delete_view (struct xwidget_view *xv)
+{
+ if (!EQ (xv->model, Qnil))
+ {
+ struct xwidget *xw = XXWIDGET (xv->model);
+ [xw->xwWindow removeFromSuperviewWithoutNeedingDisplay];
+ xw->xv = NULL; /* Now model has no view. */
+ }
+ [xv->xvWindow removeFromSuperviewWithoutNeedingDisplay];
+ [xv->xvWindow release];
+}
+
+void
+nsxwidget_show_view (struct xwidget_view *xv)
+{
+ xv->hidden = NO;
+ [xv->xvWindow setFrameOrigin:NSMakePoint(xv->x + xv->clip_left,
+ xv->y + xv->clip_top)];
+}
+
+void
+nsxwidget_hide_view (struct xwidget_view *xv)
+{
+ xv->hidden = YES;
+ [xv->xvWindow setFrameOrigin:NSMakePoint(10000, 10000)];
+}
+
+void
+nsxwidget_resize_view (struct xwidget_view *xv, int width, int height)
+{
+ [xv->xvWindow setFrameSize:NSMakeSize(width, height)];
+}
+
+void
+nsxwidget_move_view (struct xwidget_view *xv, int x, int y)
+{
+ [xv->xvWindow setFrameOrigin:NSMakePoint (x, y)];
+}
+
+/* Move model window in container (view window). */
+void
+nsxwidget_move_widget_in_view (struct xwidget_view *xv, int x, int y)
+{
+ struct xwidget *xww = xv->xvWindow.xw;
+ [xww->xwWindow setFrameOrigin:NSMakePoint (x, y)];
+}
+
+void
+nsxwidget_set_needsdisplay (struct xwidget_view *xv)
+{
+ xv->xvWindow.needsDisplay = YES;
+}
diff --git a/src/pdumper.c b/src/pdumper.c
index 3ee11460405..909900417d9 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -71,17 +71,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifdef HAVE_PDUMPER
#if GNUC_PREREQ (4, 7, 0)
-# pragma GCC diagnostic error "-Wconversion"
-# pragma GCC diagnostic ignored "-Wsign-conversion"
# pragma GCC diagnostic error "-Wshadow"
-# define ALLOW_IMPLICIT_CONVERSION \
- _Pragma ("GCC diagnostic push") \
- _Pragma ("GCC diagnostic ignored \"-Wconversion\"")
-# define DISALLOW_IMPLICIT_CONVERSION \
- _Pragma ("GCC diagnostic pop")
-#else
-# define ALLOW_IMPLICIT_CONVERSION ((void) 0)
-# define DISALLOW_IMPLICIT_CONVERSION ((void) 0)
#endif
#define VM_POSIX 1
@@ -105,17 +95,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
# define VM_SUPPORTED 0
#endif
-/* PDUMPER_CHECK_REHASHING being true causes the portable dumper to
- check, for each hash table it dumps, that the hash table means the
- same thing after rehashing. */
-#ifndef PDUMPER_CHECK_REHASHING
-# if ENABLE_CHECKING
-# define PDUMPER_CHECK_REHASHING 1
-# else
-# define PDUMPER_CHECK_REHASHING 0
-# endif
-#endif
-
/* Require an architecture in which pointers, ptrdiff_t and intptr_t
are the same size and have the same layout, and where bytes have
eight bits --- that is, a general-purpose computer made after 1990.
@@ -152,8 +131,11 @@ static int nr_remembered_data = 0;
typedef int_least32_t dump_off;
#define DUMP_OFF_MIN INT_LEAST32_MIN
#define DUMP_OFF_MAX INT_LEAST32_MAX
+#define PRIdDUMP_OFF PRIdLEAST32
+
+enum { EMACS_INT_XDIGITS = (EMACS_INT_WIDTH + 3) / 4 };
-static void ATTRIBUTE_FORMAT ((printf, 1, 2))
+static void ATTRIBUTE_FORMAT_PRINTF (1, 2)
dump_trace (const char *fmt, ...)
{
if (0)
@@ -324,9 +306,7 @@ static void
dump_reloc_set_offset (struct dump_reloc *reloc, dump_off offset)
{
eassert (offset >= 0);
- ALLOW_IMPLICIT_CONVERSION;
reloc->raw_offset = offset >> DUMP_RELOC_ALIGNMENT_BITS;
- DISALLOW_IMPLICIT_CONVERSION;
if (dump_reloc_get_offset (*reloc) != offset)
error ("dump relocation out of range");
}
@@ -401,6 +381,9 @@ struct dump_header
The start of the cold region is always aligned on a page
boundary. */
dump_off cold_start;
+
+ /* Offset of a vector of the dumped hash tables. */
+ dump_off hash_list;
};
/* Double-ended singly linked list. */
@@ -558,8 +541,11 @@ struct dump_context
heap objects. */
Lisp_Object bignum_data;
- unsigned number_hot_relocations;
- unsigned number_discardable_relocations;
+ /* List of hash tables that have been dumped. */
+ Lisp_Object hash_tables;
+
+ dump_off number_hot_relocations;
+ dump_off number_discardable_relocations;
};
/* These special values for use as offsets in dump_remember_object and
@@ -746,9 +732,7 @@ dump_off_from_lisp (Lisp_Object value)
{
intmax_t n = intmax_t_from_lisp (value);
eassert (DUMP_OFF_MIN <= n && n <= DUMP_OFF_MAX);
- ALLOW_IMPLICIT_CONVERSION;
return n;
- DISALLOW_IMPLICIT_CONVERSION;
}
static Lisp_Object
@@ -965,11 +949,9 @@ dump_queue_init (struct dump_queue *dump_queue)
static bool
dump_queue_empty_p (struct dump_queue *dump_queue)
{
- bool is_empty =
- EQ (Fhash_table_count (dump_queue->sequence_numbers),
- make_fixnum (0));
- eassert (EQ (Fhash_table_count (dump_queue->sequence_numbers),
- Fhash_table_count (dump_queue->link_weights)));
+ ptrdiff_t count = XHASH_TABLE (dump_queue->sequence_numbers)->count;
+ bool is_empty = count == 0;
+ eassert (count == XFIXNAT (Fhash_table_count (dump_queue->link_weights)));
if (!is_empty)
{
eassert (!dump_tailq_empty_p (&dump_queue->zero_weight_objects)
@@ -1011,9 +993,9 @@ dump_queue_enqueue (struct dump_queue *dump_queue,
if (NILP (weights))
{
/* Object is new. */
- dump_trace ("new object %016x weight=%u\n",
- (unsigned) XLI (object),
- (unsigned) weight.value);
+ EMACS_UINT uobj = XLI (object);
+ dump_trace ("new object %0*"pI"x weight=%d\n", EMACS_INT_XDIGITS, uobj,
+ weight.value);
if (weight.value == WEIGHT_NONE.value)
{
@@ -1228,17 +1210,15 @@ dump_queue_dequeue (struct dump_queue *dump_queue, dump_off basis)
+ dump_tailq_length (&dump_queue->one_weight_normal_objects)
+ dump_tailq_length (&dump_queue->one_weight_strong_objects)));
- bool dump_object_counts = true;
- if (dump_object_counts)
- dump_trace
- ("dump_queue_dequeue basis=%d fancy=%u zero=%u "
- "normal=%u strong=%u hash=%u\n",
- basis,
- (unsigned) dump_tailq_length (&dump_queue->fancy_weight_objects),
- (unsigned) dump_tailq_length (&dump_queue->zero_weight_objects),
- (unsigned) dump_tailq_length (&dump_queue->one_weight_normal_objects),
- (unsigned) dump_tailq_length (&dump_queue->one_weight_strong_objects),
- (unsigned) XFIXNUM (Fhash_table_count (dump_queue->link_weights)));
+ dump_trace
+ (("dump_queue_dequeue basis=%"PRIdDUMP_OFF" fancy=%"PRIdPTR
+ " zero=%"PRIdPTR" normal=%"PRIdPTR" strong=%"PRIdPTR" hash=%td\n"),
+ basis,
+ dump_tailq_length (&dump_queue->fancy_weight_objects),
+ dump_tailq_length (&dump_queue->zero_weight_objects),
+ dump_tailq_length (&dump_queue->one_weight_normal_objects),
+ dump_tailq_length (&dump_queue->one_weight_strong_objects),
+ XHASH_TABLE (dump_queue->link_weights)->count);
static const int nr_candidates = 3;
struct candidate
@@ -1311,10 +1291,10 @@ dump_queue_dequeue (struct dump_queue *dump_queue, dump_off basis)
else
emacs_abort ();
- dump_trace (" result score=%f src=%s object=%016x\n",
+ EMACS_UINT uresult = XLI (result);
+ dump_trace (" result score=%f src=%s object=%0*"pI"x\n",
best < 0 ? -1.0 : (double) candidates[best].score,
- src,
- (unsigned) XLI (result));
+ src, EMACS_INT_XDIGITS, uresult);
{
Lisp_Object weights = Fgethash (result, dump_queue->link_weights, Qnil);
@@ -1837,7 +1817,7 @@ dump_field_lv_or_rawptr (struct dump_context *ctx,
/* Now value is the Lisp_Object to which we want to point whether or
not the field is a raw pointer (in which case we just synthesized
- the Lisp_Object outselves) or a Lisp_Object (in which case we
+ the Lisp_Object ourselves) or a Lisp_Object (in which case we
just copied the thing). Add a fixup or relocation. */
intptr_t out_value;
@@ -1928,7 +1908,7 @@ dump_field_fixup_later (struct dump_context *ctx,
(void) field_relpos (in_start, in_field);
}
-/* Mark an output object field, which is as wide as a poiner, as being
+/* Mark an output object field, which is as wide as a pointer, as being
fixed up to point to a specific offset in the dump. */
static void
dump_field_ptr_to_dump_offset (struct dump_context *ctx,
@@ -1999,11 +1979,7 @@ static dump_off
finish_dump_pvec (struct dump_context *ctx,
union vectorlike_header *out_hdr)
{
- ALLOW_IMPLICIT_CONVERSION;
- dump_off result = dump_object_finish (ctx, out_hdr,
- vectorlike_nbytes (out_hdr));
- DISALLOW_IMPLICIT_CONVERSION;
- return result;
+ return dump_object_finish (ctx, out_hdr, vectorlike_nbytes (out_hdr));
}
static void
@@ -2239,7 +2215,7 @@ dump_bignum (struct dump_context *ctx, Lisp_Object object)
static dump_off
dump_float (struct dump_context *ctx, const struct Lisp_Float *lfloat)
{
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Float_50A7B216D9)
+#if CHECK_STRUCTS && !defined (HASH_Lisp_Float_7E7D284C02)
# error "Lisp_Float changed. See CHECK_STRUCTS comment in config.h."
#endif
eassert (ctx->header.cold_start);
@@ -2603,7 +2579,7 @@ dump_vectorlike_generic (struct dump_context *ctx,
Lisp_Object out;
const Lisp_Object *vslot = &v->contents[i];
/* In the wide case, we're always misaligned. */
-#ifndef WIDE_EMACS_INT
+#if INTPTR_MAX == EMACS_INT_MAX
eassert (ctx->offset % sizeof (out) == 0);
#endif
dump_object_start (ctx, &out, sizeof (out));
@@ -2615,78 +2591,65 @@ dump_vectorlike_generic (struct dump_context *ctx,
return offset;
}
-/* Determine whether the hash table's hash order is stable
- across dump and load. If it is, we don't have to trigger
- a rehash on access. */
-static bool
-dump_hash_table_stable_p (const struct Lisp_Hash_Table *hash)
+/* Return a vector of KEY, VALUE pairs in the given hash table H. The
+ first H->count pairs are valid, and the rest are unbound. */
+static Lisp_Object
+hash_table_contents (struct Lisp_Hash_Table *h)
{
- if (hash->test.hashfn == hashfn_user_defined)
+ if (h->test.hashfn == hashfn_user_defined)
error ("cannot dump hash tables with user-defined tests"); /* Bug#36769 */
- bool is_eql = hash->test.hashfn == hashfn_eql;
- bool is_equal = hash->test.hashfn == hashfn_equal;
- ptrdiff_t size = HASH_TABLE_SIZE (hash);
- for (ptrdiff_t i = 0; i < size; ++i)
+
+ ptrdiff_t size = HASH_TABLE_SIZE (h);
+ Lisp_Object key_and_value = make_uninit_vector (2 * size);
+ ptrdiff_t n = 0;
+
+ /* Make sure key_and_value ends up in the same order; charset.c
+ relies on it by expecting hash table indices to stay constant
+ across the dump. */
+ for (ptrdiff_t i = 0; i < size; i++)
+ if (!NILP (HASH_HASH (h, i)))
+ {
+ ASET (key_and_value, n++, HASH_KEY (h, i));
+ ASET (key_and_value, n++, HASH_VALUE (h, i));
+ }
+
+ while (n < 2 * size)
{
- Lisp_Object key = HASH_KEY (hash, i);
- if (!EQ (key, Qunbound))
- {
- bool key_stable = (dump_builtin_symbol_p (key)
- || FIXNUMP (key)
- || (is_equal
- && (STRINGP (key) || BOOL_VECTOR_P (key)))
- || ((is_equal || is_eql)
- && (FLOATP (key) || BIGNUMP (key))));
- if (!key_stable)
- return false;
- }
+ ASET (key_and_value, n++, Qunbound);
+ ASET (key_and_value, n++, Qnil);
}
- return true;
+ return key_and_value;
}
-/* Return a list of (KEY . VALUE) pairs in the given hash table. */
-static Lisp_Object
-hash_table_contents (Lisp_Object table)
+static dump_off
+dump_hash_table_list (struct dump_context *ctx)
{
- Lisp_Object contents = Qnil;
- struct Lisp_Hash_Table *h = XHASH_TABLE (table);
- for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
- {
- Lisp_Object key = HASH_KEY (h, i);
- if (!EQ (key, Qunbound))
- dump_push (&contents, Fcons (key, HASH_VALUE (h, i)));
- }
- return Fnreverse (contents);
+ if (!NILP (ctx->hash_tables))
+ return dump_object (ctx, CALLN (Fapply, Qvector, ctx->hash_tables));
+ else
+ return 0;
}
-/* Copy the given hash table, rehash it, and make sure that we can
- look up all the values in the original. */
static void
-check_hash_table_rehash (Lisp_Object table_orig)
-{
- ptrdiff_t count = XHASH_TABLE (table_orig)->count;
- hash_rehash_if_needed (XHASH_TABLE (table_orig));
- Lisp_Object table_rehashed = Fcopy_hash_table (table_orig);
- eassert (!hash_rehash_needed_p (XHASH_TABLE (table_rehashed)));
- XHASH_TABLE (table_rehashed)->hash = Qnil;
- eassert (count == 0 || hash_rehash_needed_p (XHASH_TABLE (table_rehashed)));
- hash_rehash_if_needed (XHASH_TABLE (table_rehashed));
- eassert (!hash_rehash_needed_p (XHASH_TABLE (table_rehashed)));
- Lisp_Object expected_contents = hash_table_contents (table_orig);
- while (!NILP (expected_contents))
- {
- Lisp_Object key_value_pair = dump_pop (&expected_contents);
- Lisp_Object key = XCAR (key_value_pair);
- Lisp_Object expected_value = XCDR (key_value_pair);
- Lisp_Object arbitrary = Qdump_emacs_portable__sort_predicate_copied;
- Lisp_Object found_value = Fgethash (key, table_rehashed, arbitrary);
- eassert (EQ (expected_value, found_value));
- Fremhash (key, table_rehashed);
- }
+hash_table_freeze (struct Lisp_Hash_Table *h)
+{
+ ptrdiff_t npairs = ASIZE (h->key_and_value) / 2;
+ h->key_and_value = hash_table_contents (h);
+ h->next = h->hash = make_fixnum (npairs);
+ h->index = make_fixnum (ASIZE (h->index));
+ h->next_free = (npairs == h->count ? -1 : h->count);
+}
+
+static void
+hash_table_thaw (Lisp_Object hash)
+{
+ struct Lisp_Hash_Table *h = XHASH_TABLE (hash);
+ h->hash = make_nil_vector (XFIXNUM (h->hash));
+ h->next = Fmake_vector (h->next, make_fixnum (-1));
+ h->index = Fmake_vector (h->index, make_fixnum (-1));
- eassert (EQ (Fhash_table_count (table_rehashed),
- make_fixnum (0)));
+ hash_table_rehash (hash);
}
static dump_off
@@ -2694,55 +2657,15 @@ dump_hash_table (struct dump_context *ctx,
Lisp_Object object,
dump_off offset)
{
-#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_12AFBF47AF
+#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_6D63EDB618
# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h."
#endif
const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object);
- bool is_stable = dump_hash_table_stable_p (hash_in);
- /* If the hash table is likely to be modified in memory (either
- because we need to rehash, and thus toggle hash->count, or
- because we need to assemble a list of weak tables) punt the hash
- table to the end of the dump, where we can lump all such hash
- tables together. */
- if (!(is_stable || !NILP (hash_in->weak))
- && ctx->flags.defer_hash_tables)
- {
- if (offset != DUMP_OBJECT_ON_HASH_TABLE_QUEUE)
- {
- eassert (offset == DUMP_OBJECT_ON_NORMAL_QUEUE
- || offset == DUMP_OBJECT_NOT_SEEN);
- /* We still want to dump the actual keys and values now. */
- dump_enqueue_object (ctx, hash_in->key_and_value, WEIGHT_NONE);
- /* We'll get to the rest later. */
- offset = DUMP_OBJECT_ON_HASH_TABLE_QUEUE;
- dump_remember_object (ctx, object, offset);
- dump_push (&ctx->deferred_hash_tables, object);
- }
- return offset;
- }
-
- if (PDUMPER_CHECK_REHASHING)
- check_hash_table_rehash (make_lisp_ptr ((void *) hash_in, Lisp_Vectorlike));
-
struct Lisp_Hash_Table hash_munged = *hash_in;
struct Lisp_Hash_Table *hash = &hash_munged;
- /* Remember to rehash this hash table on first access. After a
- dump reload, the hash table values will have changed, so we'll
- need to rebuild the index.
-
- TODO: for EQ and EQL hash tables, it should be possible to rehash
- here using the preferred load address of the dump, eliminating
- the need to rehash-on-access if we can load the dump where we
- want. */
- if (hash->count > 0 && !is_stable)
- /* Hash codes will have to be recomputed anyway, so let's not dump them.
- Also set `hash` to nil for hash_rehash_needed_p.
- We could also refrain from dumping the `next' and `index' vectors,
- except that `next' is currently used for HASH_TABLE_SIZE and
- we'd have to rebuild the next_free list as well as adjust
- sweep_weak_hash_table for the case where there's no `index'. */
- hash->hash = Qnil;
+ hash_table_freeze (hash);
+ dump_push (&ctx->hash_tables, object);
START_DUMP_PVEC (ctx, &hash->header, struct Lisp_Hash_Table, out);
dump_pseudovector_lisp_fields (ctx, &out->header, &hash->header);
@@ -2769,7 +2692,7 @@ dump_hash_table (struct dump_context *ctx,
static dump_off
dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
{
-#if CHECK_STRUCTS && !defined HASH_buffer_375A10F5E5
+#if CHECK_STRUCTS && !defined HASH_buffer_5DC36DBD42
# error "buffer changed. See CHECK_STRUCTS comment in config.h."
#endif
struct buffer munged_buffer = *in_buffer;
@@ -2845,8 +2768,6 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
ctx->obj_offset + dump_offsetof (struct buffer, text),
base_offset + dump_offsetof (struct buffer, own_text));
- dump_field_lv_rawptr (ctx, out, buffer, &buffer->next,
- Lisp_Vectorlike, WEIGHT_NORMAL);
DUMP_FIELD_COPY (out, buffer, pt);
DUMP_FIELD_COPY (out, buffer, pt_byte);
DUMP_FIELD_COPY (out, buffer, begv);
@@ -2961,7 +2882,7 @@ dump_vectorlike (struct dump_context *ctx,
Lisp_Object lv,
dump_off offset)
{
-#if CHECK_STRUCTS && !defined HASH_pvec_type_E55BD36F8E
+#if CHECK_STRUCTS && !defined HASH_pvec_type_A4A6E9984D
# error "pvec_type changed. See CHECK_STRUCTS comment in config.h."
#endif
const struct Lisp_Vector *v = XVECTOR (lv);
@@ -3069,7 +2990,7 @@ dump_vectorlike (struct dump_context *ctx,
static dump_off
dump_object (struct dump_context *ctx, Lisp_Object object)
{
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Type_E2AD97D3F7)
+#if CHECK_STRUCTS && !defined (HASH_Lisp_Type_45F0582FD7)
# error "Lisp_Type changed. See CHECK_STRUCTS comment in config.h."
#endif
eassert (!EQ (object, dead_object ()));
@@ -3356,9 +3277,7 @@ static void
dump_cold_charset (struct dump_context *ctx, Lisp_Object data)
{
/* Dump charset lookup tables. */
- ALLOW_IMPLICIT_CONVERSION;
int cs_i = XFIXNUM (XCAR (data));
- DISALLOW_IMPLICIT_CONVERSION;
dump_off cs_dump_offset = dump_off_from_lisp (XCDR (data));
dump_remember_fixup_ptr_raw
(ctx,
@@ -3604,14 +3523,12 @@ dump_unwind_cleanup (void *data)
Vprocess_environment = ctx->old_process_environment;
}
-/* Return DUMP_OFFSET, making sure it is within the heap. */
-static dump_off
+/* Check that DUMP_OFFSET is within the heap. */
+static void
dump_check_dump_off (struct dump_context *ctx, dump_off dump_offset)
{
eassert (dump_offset > 0);
- if (ctx)
- eassert (dump_offset < ctx->end_heap);
- return dump_offset;
+ eassert (!ctx || dump_offset < ctx->end_heap);
}
static void
@@ -3668,9 +3585,7 @@ static struct emacs_reloc
decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc)
{
struct emacs_reloc reloc = {0};
- ALLOW_IMPLICIT_CONVERSION;
int type = XFIXNUM (dump_pop (&lreloc));
- DISALLOW_IMPLICIT_CONVERSION;
reloc.emacs_offset = dump_off_from_lisp (dump_pop (&lreloc));
dump_check_emacs_off (reloc.emacs_offset);
switch (type)
@@ -3681,9 +3596,7 @@ decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc)
reloc.u.dump_offset = dump_off_from_lisp (dump_pop (&lreloc));
dump_check_dump_off (ctx, reloc.u.dump_offset);
dump_off length = dump_off_from_lisp (dump_pop (&lreloc));
- ALLOW_IMPLICIT_CONVERSION;
reloc.length = length;
- DISALLOW_IMPLICIT_CONVERSION;
if (reloc.length != length)
error ("relocation copy length too large");
}
@@ -3694,9 +3607,7 @@ decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc)
intmax_t value = intmax_t_from_lisp (dump_pop (&lreloc));
dump_off size = dump_off_from_lisp (dump_pop (&lreloc));
reloc.u.immediate = value;
- ALLOW_IMPLICIT_CONVERSION;
reloc.length = size;
- DISALLOW_IMPLICIT_CONVERSION;
eassert (reloc.length == size);
}
break;
@@ -3721,9 +3632,7 @@ decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc)
RELOC_EMACS_IMMEDIATE relocation instead. */
eassert (!dump_object_self_representing_p (target_value));
int tag_type = XTYPE (target_value);
- ALLOW_IMPLICIT_CONVERSION;
reloc.length = tag_type;
- DISALLOW_IMPLICIT_CONVERSION;
eassert (reloc.length == tag_type);
if (type == RELOC_EMACS_EMACS_LV)
@@ -3734,6 +3643,7 @@ decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc)
}
else
{
+ eassume (ctx); /* Pacify GCC 9.2.1 -O3 -Wnull-dereference. */
eassert (!dump_object_emacs_ptr (target_value));
reloc.u.dump_offset = dump_recall_object (ctx, target_value);
if (reloc.u.dump_offset <= 0)
@@ -3797,9 +3707,7 @@ dump_merge_emacs_relocs (Lisp_Object lreloc_a, Lisp_Object lreloc_b)
return Qnil;
dump_off new_length = reloc_a.length + reloc_b.length;
- ALLOW_IMPLICIT_CONVERSION;
reloc_a.length = new_length;
- DISALLOW_IMPLICIT_CONVERSION;
if (reloc_a.length != new_length)
return Qnil; /* Overflow */
@@ -4153,6 +4061,19 @@ types. */)
|| !NILP (ctx->deferred_hash_tables)
|| !NILP (ctx->deferred_symbols));
+ ctx->header.hash_list = ctx->offset;
+ dump_hash_table_list (ctx);
+
+ do
+ {
+ dump_drain_deferred_hash_tables (ctx);
+ dump_drain_deferred_symbols (ctx);
+ dump_drain_normal_queue (ctx);
+ }
+ while (!dump_queue_empty_p (&ctx->dump_queue)
+ || !NILP (ctx->deferred_hash_tables)
+ || !NILP (ctx->deferred_symbols));
+
dump_sort_copied_objects (ctx);
/* While we copy built-in symbols into the Emacs image, these
@@ -4212,9 +4133,9 @@ types. */)
of the dump. */
drain_reloc_list (ctx, dump_emit_dump_reloc, emacs_reloc_merger,
&ctx->dump_relocs, &ctx->header.dump_relocs);
- unsigned number_hot_relocations = ctx->number_hot_relocations;
+ dump_off number_hot_relocations = ctx->number_hot_relocations;
ctx->number_hot_relocations = 0;
- unsigned number_discardable_relocations = ctx->number_discardable_relocations;
+ dump_off number_discardable_relocations = ctx->number_discardable_relocations;
ctx->number_discardable_relocations = 0;
drain_reloc_list (ctx, dump_emit_dump_reloc, emacs_reloc_merger,
&ctx->object_starts, &ctx->header.object_starts);
@@ -4238,14 +4159,17 @@ types. */)
dump_seek (ctx, 0);
dump_write (ctx, &ctx->header, sizeof (ctx->header));
+ dump_off
+ header_bytes = header_end - header_start,
+ hot_bytes = hot_end - hot_start,
+ discardable_bytes = discardable_end - ctx->header.discardable_start,
+ cold_bytes = cold_end - ctx->header.cold_start;
fprintf (stderr,
("Dump complete\n"
- "Byte counts: header=%lu hot=%lu discardable=%lu cold=%lu\n"
- "Reloc counts: hot=%u discardable=%u\n"),
- (unsigned long) (header_end - header_start),
- (unsigned long) (hot_end - hot_start),
- (unsigned long) (discardable_end - ctx->header.discardable_start),
- (unsigned long) (cold_end - ctx->header.cold_start),
+ "Byte counts: header=%"PRIdDUMP_OFF" hot=%"PRIdDUMP_OFF
+ " discardable=%"PRIdDUMP_OFF" cold=%"PRIdDUMP_OFF"\n"
+ "Reloc counts: hot=%"PRIdDUMP_OFF" discardable=%"PRIdDUMP_OFF"\n"),
+ header_bytes, hot_bytes, discardable_bytes, cold_bytes,
number_hot_relocations,
number_discardable_relocations);
@@ -4682,15 +4606,15 @@ dump_mmap_contiguous_heap (struct dump_memory_map *maps, int nr_maps,
Beware: the simple patch 2019-03-11T15:20:54Z!eggert@cs.ucla.edu
is worse, as it sometimes frees this storage twice. */
struct dump_memory_map_heap_control_block *cb = calloc (1, sizeof (*cb));
-
- char *mem;
if (!cb)
goto out;
+ __lsan_ignore_object (cb);
+
cb->refcount = 1;
cb->mem = malloc (total_size);
if (!cb->mem)
goto out;
- mem = cb->mem;
+ char *mem = cb->mem;
for (int i = 0; i < nr_maps; ++i)
{
struct dump_memory_map *map = &maps[i];
@@ -4878,14 +4802,19 @@ struct dump_bitset
};
static bool
-dump_bitset_init (struct dump_bitset *bitset, size_t number_bits)
+dump_bitsets_init (struct dump_bitset bitset[2], size_t number_bits)
{
- int xword_size = sizeof (bitset->bits[0]);
+ int xword_size = sizeof (bitset[0].bits[0]);
int bits_per_word = xword_size * CHAR_BIT;
ptrdiff_t words_needed = divide_round_up (number_bits, bits_per_word);
- bitset->number_words = words_needed;
- bitset->bits = calloc (words_needed, xword_size);
- return bitset->bits != NULL;
+ dump_bitset_word *bits = calloc (words_needed, 2 * xword_size);
+ if (!bits)
+ return false;
+ bitset[0].bits = bits;
+ bitset[0].number_words = bitset[1].number_words = words_needed;
+ bitset[1].bits = memset (bits + words_needed, UCHAR_MAX,
+ words_needed * xword_size);
+ return true;
}
static dump_bitset_word *
@@ -4946,7 +4875,7 @@ struct pdumper_loaded_dump_private
/* Copy of the header we read from the dump. */
struct dump_header header;
/* Mark bits for objects in the dump; used during GC. */
- struct dump_bitset mark_bits;
+ struct dump_bitset mark_bits, last_mark_bits;
/* Time taken to load the dump. */
double load_time;
/* Dump file name. */
@@ -5069,6 +4998,10 @@ pdumper_find_object_type_impl (const void *obj)
dump_off offset = ptrdiff_t_to_dump_off ((uintptr_t) obj - dump_public.start);
if (offset % DUMP_ALIGNMENT != 0)
return PDUMPER_NO_OBJECT;
+ ptrdiff_t bitno = offset / DUMP_ALIGNMENT;
+ if (offset < dump_private.header.discardable_start
+ && !dump_bitset_bit_set_p (&dump_private.last_mark_bits, bitno))
+ return PDUMPER_NO_OBJECT;
const struct dump_reloc *reloc =
dump_find_relocation (&dump_private.header.object_starts, offset);
return (reloc != NULL && dump_reloc_get_offset (*reloc) == offset)
@@ -5097,12 +5030,16 @@ pdumper_set_marked_impl (const void *obj)
eassert (offset < dump_private.header.cold_start);
eassert (offset < dump_private.header.discardable_start);
ptrdiff_t bitno = offset / DUMP_ALIGNMENT;
+ eassert (dump_bitset_bit_set_p (&dump_private.last_mark_bits, bitno));
dump_bitset_set_bit (&dump_private.mark_bits, bitno);
}
void
pdumper_clear_marks_impl (void)
{
+ dump_bitset_word *swap = dump_private.last_mark_bits.bits;
+ dump_private.last_mark_bits.bits = dump_private.mark_bits.bits;
+ dump_private.mark_bits.bits = swap;
dump_bitset_clear (&dump_private.mark_bits);
}
@@ -5111,14 +5048,13 @@ dump_read_all (int fd, void *buf, size_t bytes_to_read)
{
/* We don't want to use emacs_read, since that relies on the lisp
world, and we're not in the lisp world yet. */
- eassert (bytes_to_read <= SSIZE_MAX);
size_t bytes_read = 0;
while (bytes_read < bytes_to_read)
{
- /* Some platforms accept only int-sized values to read. */
- unsigned chunk_to_read = INT_MAX;
- if (bytes_to_read - bytes_read < chunk_to_read)
- chunk_to_read = (unsigned) (bytes_to_read - bytes_read);
+ /* Some platforms accept only int-sized values to read.
+ Round this down to a page size (see MAX_RW_COUNT in sysdep.c). */
+ int max_rw_count = INT_MAX >> 18 << 18;
+ int chunk_to_read = min (bytes_to_read - bytes_read, max_rw_count);
ssize_t chunk = read (fd, (char *) buf + bytes_read, chunk_to_read);
if (chunk < 0)
return chunk;
@@ -5304,6 +5240,9 @@ enum dump_section
NUMBER_DUMP_SECTIONS,
};
+/* Pointer to a stack variable to avoid having to staticpro it. */
+static Lisp_Object *pdumper_hashes = &zero_vector;
+
/* Load a dump from DUMP_FILENAME. Return an error code.
N.B. We run very early in initialization, so we can't use lisp,
@@ -5317,7 +5256,7 @@ pdumper_load (const char *dump_filename)
int dump_page_size;
dump_off adj_discardable_start;
- struct dump_bitset mark_bits;
+ struct dump_bitset mark_bits[2];
size_t mark_bits_needed;
struct dump_header header_buf = { 0 };
@@ -5431,7 +5370,7 @@ pdumper_load (const char *dump_filename)
err = PDUMPER_LOAD_ERROR;
mark_bits_needed =
divide_round_up (header->discardable_start, DUMP_ALIGNMENT);
- if (!dump_bitset_init (&mark_bits, mark_bits_needed))
+ if (!dump_bitsets_init (mark_bits, mark_bits_needed))
goto out;
/* Point of no return. */
@@ -5439,7 +5378,8 @@ pdumper_load (const char *dump_filename)
dump_base = (uintptr_t) sections[DS_HOT].mapping;
gflags.dumped_with_pdumper_ = true;
dump_private.header = *header;
- dump_private.mark_bits = mark_bits;
+ dump_private.mark_bits = mark_bits[0];
+ dump_private.last_mark_bits = mark_bits[1];
dump_public.start = dump_base;
dump_public.end = dump_public.start + dump_size;
@@ -5450,6 +5390,15 @@ pdumper_load (const char *dump_filename)
for (int i = 0; i < ARRAYELTS (sections); ++i)
dump_mmap_reset (&sections[i]);
+ Lisp_Object hashes = zero_vector;
+ if (header->hash_list)
+ {
+ struct Lisp_Vector *hash_tables =
+ (struct Lisp_Vector *) (dump_base + header->hash_list);
+ hashes = make_lisp_ptr (hash_tables, Lisp_Vectorlike);
+ }
+
+ pdumper_hashes = &hashes;
/* Run the functions Emacs registered for doing post-dump-load
initialization. */
for (int i = 0; i < nr_dump_hooks; ++i)
@@ -5520,6 +5469,19 @@ Value is nil if this session was not started using a dump file.*/)
#endif /* HAVE_PDUMPER */
+static void
+thaw_hash_tables (void)
+{
+ Lisp_Object hash_tables = *pdumper_hashes;
+ for (ptrdiff_t i = 0; i < ASIZE (hash_tables); i++)
+ hash_table_thaw (AREF (hash_tables, i));
+}
+
+void
+init_pdumper_once (void)
+{
+ pdumper_do_now_and_after_load (thaw_hash_tables);
+}
void
syms_of_pdumper (void)
diff --git a/src/pdumper.h b/src/pdumper.h
index 6a99b511f2f..c793fb40580 100644
--- a/src/pdumper.h
+++ b/src/pdumper.h
@@ -256,6 +256,7 @@ pdumper_clear_marks (void)
file was loaded. */
extern void pdumper_record_wd (const char *);
+void init_pdumper_once (void);
void syms_of_pdumper (void);
INLINE_HEADER_END
diff --git a/src/print.c b/src/print.c
index 425b0dc4ee3..dca095f2812 100644
--- a/src/print.c
+++ b/src/print.c
@@ -368,8 +368,8 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte,
int len;
for (ptrdiff_t i = 0; i < size_byte; i += len)
{
- int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
- len);
+ int ch = string_char_and_length ((const unsigned char *) ptr + i,
+ &len);
printchar_to_stream (ch, stdout);
}
}
@@ -400,8 +400,8 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte,
int len;
for (i = 0; i < size_byte; i += len)
{
- int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
- len);
+ int ch = string_char_and_length ((const unsigned char *) ptr + i,
+ &len);
insert_char (ch);
}
}
@@ -426,9 +426,8 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte,
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to
PRINTCHAR. */
- int len;
- int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
- len);
+ int len, ch = (string_char_and_length
+ ((const unsigned char *) ptr + i, &len));
printchar (ch, printcharfun);
i += len;
}
@@ -510,8 +509,7 @@ print_string (Lisp_Object string, Lisp_Object printcharfun)
{
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to PRINTCHAR. */
- int len;
- int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i, len);
+ int len, ch = string_char_and_length (SDATA (string) + i, &len);
printchar (ch, printcharfun);
i += len;
}
@@ -1307,15 +1305,13 @@ print_check_string_charset_prop (INTERVAL interval, Lisp_Object string)
}
if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
{
- int i, c;
ptrdiff_t charpos = interval->position;
ptrdiff_t bytepos = string_char_to_byte (string, charpos);
- Lisp_Object charset;
+ Lisp_Object charset = XCAR (XCDR (val));
- charset = XCAR (XCDR (val));
- for (i = 0; i < LENGTH (interval); i++)
+ for (ptrdiff_t i = 0; i < LENGTH (interval); i++)
{
- FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos);
+ int c = fetch_string_char_advance (string, &charpos, &bytepos);
if (! ASCII_CHAR_P (c)
&& ! EQ (CHARSET_NAME (CHAR_CHARSET (c)), charset))
{
@@ -1365,6 +1361,22 @@ data_from_funcptr (void (*funcptr) (void))
interchangeably, so it's OK to assume that here too. */
return (void const *) funcptr;
}
+
+/* Print the value of the pointer PTR. */
+
+static void
+print_pointer (Lisp_Object printcharfun, char *buf, const char *prefix,
+ const void *ptr)
+{
+ uintptr_t ui = (uintptr_t) ptr;
+
+ /* In theory this assignment could lose info on pre-C99 hosts, but
+ in practice it doesn't. */
+ uintmax_t up = ui;
+
+ int len = sprintf (buf, "%s 0x%" PRIxMAX, prefix, up);
+ strout (buf, len, len, printcharfun);
+}
#endif
static bool
@@ -1578,27 +1590,34 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
/* Print the data here as a plist. */
ptrdiff_t real_size = HASH_TABLE_SIZE (h);
- ptrdiff_t size = real_size;
+ ptrdiff_t size = h->count;
/* Don't print more elements than the specified maximum. */
if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size)
size = XFIXNAT (Vprint_length);
printchar ('(', printcharfun);
- for (ptrdiff_t i = 0; i < size; i++)
+ ptrdiff_t j = 0;
+ for (ptrdiff_t i = 0; i < real_size; i++)
{
Lisp_Object key = HASH_KEY (h, i);
if (!EQ (key, Qunbound))
{
- if (i) printchar (' ', printcharfun);
+ if (j++) printchar (' ', printcharfun);
print_object (key, printcharfun, escapeflag);
printchar (' ', printcharfun);
print_object (HASH_VALUE (h, i), printcharfun, escapeflag);
+ if (j == size)
+ break;
}
}
- if (size < real_size)
- print_c_string (" ...", printcharfun);
+ if (j < h->count)
+ {
+ if (j)
+ printchar (' ', printcharfun);
+ print_c_string ("...", printcharfun);
+ }
print_c_string ("))", printcharfun);
}
@@ -1796,26 +1815,22 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
case PVEC_MODULE_FUNCTION:
{
print_c_string ("#<module function ", printcharfun);
- module_funcptr ptr = module_function_address (XMODULE_FUNCTION (obj));
+ const struct Lisp_Module_Function *function = XMODULE_FUNCTION (obj);
+ module_funcptr ptr = module_function_address (function);
char const *file;
char const *symbol;
dynlib_addr (ptr, &file, &symbol);
if (symbol == NULL)
- {
- uintptr_t ui = (uintptr_t) data_from_funcptr (ptr);
-
- /* In theory this assignment could lose info on pre-C99
- hosts, but in practice it doesn't. */
- uintmax_t up = ui;
-
- int len = sprintf (buf, "at 0x%"PRIxMAX, up);
- strout (buf, len, len, printcharfun);
- }
- else
+ print_pointer (printcharfun, buf, "at", data_from_funcptr (ptr));
+ else
print_c_string (symbol, printcharfun);
- if (file != NULL)
+ void *data = module_function_data (function);
+ if (data != NULL)
+ print_pointer (printcharfun, buf, " with data", data);
+
+ if (file != NULL)
{
print_c_string (" from ", printcharfun);
print_c_string (file, printcharfun);
@@ -1838,7 +1853,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
{
char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT),
max (sizeof " . #" + INT_STRLEN_BOUND (intmax_t),
- max ((sizeof "at 0x"
+ max ((sizeof " with data 0x"
+ (sizeof (uintmax_t) * CHAR_BIT + 4 - 1) / 4),
40)))];
current_thread->stack_top = buf;
@@ -1914,7 +1929,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
ptrdiff_t i, i_byte;
ptrdiff_t size_byte;
/* True means we must ensure that the next character we output
- cannot be taken as part of a hex character escape. */
+ cannot be taken as part of a hex character escape. */
bool need_nonhex = false;
bool multibyte = STRING_MULTIBYTE (obj);
@@ -1931,9 +1946,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
{
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to printchar. */
- int c;
-
- FETCH_STRING_CHAR_ADVANCE (c, obj, i, i_byte);
+ int c = fetch_string_char_advance (obj, &i, &i_byte);
maybe_quit ();
@@ -1963,25 +1976,29 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
/* If we just had a hex escape, and this character
could be taken as part of it,
output `\ ' to prevent that. */
- if (c_isxdigit (c))
- {
- if (need_nonhex)
- print_c_string ("\\ ", printcharfun);
- printchar (c, printcharfun);
- }
- else if (c == '\n' && print_escape_newlines
- ? (c = 'n', true)
- : c == '\f' && print_escape_newlines
- ? (c = 'f', true)
- : c == '\"' || c == '\\')
- {
- printchar ('\\', printcharfun);
- printchar (c, printcharfun);
- }
- else if (print_escape_control_characters && c_iscntrl (c))
+ if (c_isxdigit (c))
+ {
+ if (need_nonhex)
+ print_c_string ("\\ ", printcharfun);
+ printchar (c, printcharfun);
+ }
+ else if (c == '\n' && print_escape_newlines
+ ? (c = 'n', true)
+ : c == '\f' && print_escape_newlines
+ ? (c = 'f', true)
+ : c == '\"' || c == '\\')
+ {
+ printchar ('\\', printcharfun);
+ printchar (c, printcharfun);
+ }
+ else if (print_escape_control_characters && c_iscntrl (c))
octalout (c, SDATA (obj), i_byte, size_byte, printcharfun);
- else
- printchar (c, printcharfun);
+ else if (!multibyte
+ && SINGLE_BYTE_CHAR_P (c)
+ && !ASCII_CHAR_P (c))
+ printchar (BYTE8_TO_CHAR (c), printcharfun);
+ else
+ printchar (c, printcharfun);
need_nonhex = false;
}
}
@@ -2011,7 +2028,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
&& len == size_byte);
if (! NILP (Vprint_gensym)
- && !SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (obj))
+ && !SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (obj))
print_c_string ("#:", printcharfun);
else if (size_byte == 0)
{
@@ -2024,8 +2041,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
{
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to PRINTCHAR. */
- int c;
- FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
+ int c = fetch_string_char_advance (name, &i, &i_byte);
maybe_quit ();
if (escapeflag)
@@ -2035,7 +2051,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
|| c == ',' || c == '.' || c == '`'
|| c == '[' || c == ']' || c == '?' || c <= 040
|| c == NO_BREAK_SPACE
- || confusing)
+ || confusing)
{
printchar ('\\', printcharfun);
confusing = false;
@@ -2100,7 +2116,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
if (!NILP (Vprint_circle))
{
- /* With the print-circle feature. */
+ /* With the print-circle feature. */
Lisp_Object num = Fgethash (obj, Vprint_number_table,
Qnil);
if (FIXNUMP (num))
@@ -2152,7 +2168,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
{
int len;
/* We're in trouble if this happens!
- Probably should just emacs_abort (). */
+ Probably should just emacs_abort (). */
print_c_string ("#<EMACS BUG: INVALID DATATYPE ", printcharfun);
if (VECTORLIKEP (obj))
len = sprintf (buf, "(PVEC 0x%08zx)", (size_t) ASIZE (obj));
diff --git a/src/process.c b/src/process.c
index 91d426103d8..50c425077a9 100644
--- a/src/process.c
+++ b/src/process.c
@@ -1205,6 +1205,16 @@ not the name of the pty that Emacs uses to talk with that terminal. */)
return XPROCESS (process)->tty_name;
}
+static void
+update_process_mark (struct Lisp_Process *p)
+{
+ Lisp_Object buffer = p->buffer;
+ if (BUFFERP (buffer))
+ set_marker_both (p->mark, buffer,
+ BUF_ZV (XBUFFER (buffer)),
+ BUF_ZV_BYTE (XBUFFER (buffer)));
+}
+
DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
2, 2, 0,
doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
@@ -1217,7 +1227,11 @@ Return BUFFER. */)
if (!NILP (buffer))
CHECK_BUFFER (buffer);
p = XPROCESS (process);
- pset_buffer (p, buffer);
+ if (!EQ (p->buffer, buffer))
+ {
+ pset_buffer (p, buffer);
+ update_process_mark (p);
+ }
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer));
setup_process_coding_systems (process);
@@ -1392,14 +1406,12 @@ nil otherwise. */)
CHECK_PROCESS (process);
/* All known platforms store window sizes as 'unsigned short'. */
- CHECK_RANGED_INTEGER (height, 0, USHRT_MAX);
- CHECK_RANGED_INTEGER (width, 0, USHRT_MAX);
+ unsigned short h = check_uinteger_max (height, USHRT_MAX);
+ unsigned short w = check_uinteger_max (width, USHRT_MAX);
if (NETCONN_P (process)
|| XPROCESS (process)->infd < 0
- || (set_window_size (XPROCESS (process)->infd,
- XFIXNUM (height), XFIXNUM (width))
- < 0))
+ || set_window_size (XPROCESS (process)->infd, h, w) < 0)
return Qnil;
else
return Qt;
@@ -1639,6 +1651,7 @@ DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
return Fmapcar (Qcdr, Vprocess_alist);
}
+
/* Starting asynchronous inferior processes. */
DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
@@ -1656,7 +1669,10 @@ you specify a filter function to handle the output. BUFFER may be
also nil, meaning that this process is not associated with any buffer.
:command COMMAND -- COMMAND is a list starting with the program file
-name, followed by strings to give to the program as arguments.
+name, followed by strings to give to the program as arguments. If the
+program file name is not an absolute file name, `make-process' will
+look for the program file name in `exec-path' (which is a list of
+directories).
:coding CODING -- If CODING is a symbol, it specifies the coding
system used for both reading and writing for this process. If CODING
@@ -1804,10 +1820,7 @@ usage: (make-process &rest ARGS) */)
: EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
/* Make the process marker point into the process buffer (if any). */
- if (BUFFERP (buffer))
- set_marker_both (XPROCESS (proc)->mark, buffer,
- BUF_ZV (XBUFFER (buffer)),
- BUF_ZV_BYTE (XBUFFER (buffer)));
+ update_process_mark (XPROCESS (proc));
USE_SAFE_ALLOCA;
@@ -2452,10 +2465,7 @@ usage: (make-pipe-process &rest ARGS) */)
: EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
/* Make the process marker point into the process buffer (if any). */
- if (BUFFERP (buffer))
- set_marker_both (p->mark, buffer,
- BUF_ZV (XBUFFER (buffer)),
- BUF_ZV_BYTE (XBUFFER (buffer)));
+ update_process_mark (p);
{
/* Setup coding systems for communicating with the network stream. */
@@ -3181,21 +3191,14 @@ usage: (make-serial-process &rest ARGS) */)
if (!EQ (p->command, Qt))
add_process_read_fd (fd);
- if (BUFFERP (buffer))
- {
- set_marker_both (p->mark, buffer,
- BUF_ZV (XBUFFER (buffer)),
- BUF_ZV_BYTE (XBUFFER (buffer)));
- }
+ update_process_mark (p);
- tem = Fplist_member (contact, QCcoding);
- if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
- tem = Qnil;
+ tem = Fplist_get (contact, QCcoding);
val = Qnil;
if (!NILP (tem))
{
- val = XCAR (XCDR (tem));
+ val = tem;
if (CONSP (val))
val = XCAR (val);
}
@@ -3209,7 +3212,7 @@ usage: (make-serial-process &rest ARGS) */)
val = Qnil;
if (!NILP (tem))
{
- val = XCAR (XCDR (tem));
+ val = tem;
if (CONSP (val))
val = XCDR (val);
}
@@ -3244,16 +3247,14 @@ set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host,
Lisp_Object coding_systems = Qt;
Lisp_Object val;
- tem = Fplist_member (contact, QCcoding);
- if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
- tem = Qnil; /* No error message (too late!). */
+ tem = Fplist_get (contact, QCcoding);
/* Setup coding systems for communicating with the network stream. */
/* Qt denotes we have not yet called Ffind_operation_coding_system. */
if (!NILP (tem))
{
- val = XCAR (XCDR (tem));
+ val = tem;
if (CONSP (val))
val = XCAR (val);
}
@@ -3287,7 +3288,7 @@ set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host,
if (!NILP (tem))
{
- val = XCAR (XCDR (tem));
+ val = tem;
if (CONSP (val))
val = XCDR (val);
}
@@ -3667,10 +3668,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
pset_status (p, Qlisten);
/* Make the process marker point into the process buffer (if any). */
- if (BUFFERP (p->buffer))
- set_marker_both (p->mark, p->buffer,
- BUF_ZV (XBUFFER (p->buffer)),
- BUF_ZV_BYTE (XBUFFER (p->buffer)));
+ update_process_mark (p);
if (p->is_non_blocking_client)
{
@@ -5416,14 +5414,16 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
/* If data can be read from the process, do so until exhausted. */
if (wait_proc->infd >= 0)
{
+ unsigned int count = 0;
XSETPROCESS (proc, wait_proc);
while (true)
{
int nread = read_process_output (proc, wait_proc->infd);
+ rarely_quit (++count);
if (nread < 0)
{
- if (errno == EIO || would_block (errno))
+ if (errno != EINTR)
break;
}
else
@@ -5497,6 +5497,10 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
}
else
{
+#ifdef HAVE_GNUTLS
+ int tls_nfds;
+ fd_set tls_available;
+#endif
/* Set the timeout for adaptive read buffering if any
process has non-zero read_output_skip and non-zero
read_output_delay, and we are not reading output for a
@@ -5566,7 +5570,36 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
}
#endif
-/* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */
+#ifdef HAVE_GNUTLS
+ /* GnuTLS buffers data internally. We need to check if some
+ data is available in the buffers manually before the select.
+ And if so, we need to skip the select which could block. */
+ FD_ZERO (&tls_available);
+ tls_nfds = 0;
+ for (channel = 0; channel < FD_SETSIZE; ++channel)
+ if (! NILP (chan_process[channel])
+ && FD_ISSET (channel, &Available))
+ {
+ struct Lisp_Process *p = XPROCESS (chan_process[channel]);
+ if (p
+ && p->gnutls_p && p->gnutls_state
+ && emacs_gnutls_record_check_pending (p->gnutls_state) > 0)
+ {
+ tls_nfds++;
+ eassert (p->infd == channel);
+ FD_SET (p->infd, &tls_available);
+ }
+ }
+ /* If wait_proc is somebody else, we have to wait in select
+ as usual. Otherwise, clobber the timeout. */
+ if (tls_nfds > 0
+ && (!wait_proc ||
+ (wait_proc->infd >= 0
+ && FD_ISSET (wait_proc->infd, &tls_available))))
+ timeout = make_timespec (0, 0);
+#endif
+
+ /* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */
#if defined HAVE_GLIB && !defined HAVE_NS
nfds = xg_select (max_desc + 1,
&Available, (check_write ? &Writeok : 0),
@@ -5584,59 +5617,21 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
#endif /* !HAVE_GLIB */
#ifdef HAVE_GNUTLS
- /* GnuTLS buffers data internally. In lowat mode it leaves
- some data in the TCP buffers so that select works, but
- with custom pull/push functions we need to check if some
- data is available in the buffers manually. */
- if (nfds == 0)
+ /* Merge tls_available into Available. */
+ if (tls_nfds > 0)
{
- fd_set tls_available;
- int set = 0;
-
- FD_ZERO (&tls_available);
- if (! wait_proc)
+ if (nfds == 0 || (nfds < 0 && errno == EINTR))
{
- /* We're not waiting on a specific process, so loop
- through all the channels and check for data.
- This is a workaround needed for some versions of
- the gnutls library -- 2.12.14 has been confirmed
- to need it. */
- for (channel = 0; channel < FD_SETSIZE; ++channel)
- if (! NILP (chan_process[channel]))
- {
- struct Lisp_Process *p =
- XPROCESS (chan_process[channel]);
- if (p && p->gnutls_p && p->gnutls_state
- && ((emacs_gnutls_record_check_pending
- (p->gnutls_state))
- > 0))
- {
- nfds++;
- eassert (p->infd == channel);
- FD_SET (p->infd, &tls_available);
- set++;
- }
- }
- }
- else
- {
- /* Check this specific channel. */
- if (wait_proc->gnutls_p /* Check for valid process. */
- && wait_proc->gnutls_state
- /* Do we have pending data? */
- && ((emacs_gnutls_record_check_pending
- (wait_proc->gnutls_state))
- > 0))
- {
- nfds = 1;
- eassert (0 <= wait_proc->infd);
- /* Set to Available. */
- FD_SET (wait_proc->infd, &tls_available);
- set++;
- }
+ /* Fast path, just copy. */
+ nfds = tls_nfds;
+ Available = tls_available;
}
- if (set)
- Available = tls_available;
+ else if (nfds > 0)
+ /* Slow path, merge one by one. Note: nfds does not need
+ to be accurate, just positive is enough. */
+ for (channel = 0; channel < FD_SETSIZE; ++channel)
+ if (FD_ISSET(channel, &tls_available))
+ FD_SET(channel, &Available);
}
#endif
}
@@ -7079,10 +7074,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */)
}
if (FIXNUMP (sigcode))
- {
- CHECK_TYPE_RANGED_INTEGER (int, sigcode);
- signo = XFIXNUM (sigcode);
- }
+ signo = check_integer_range (sigcode, INT_MIN, INT_MAX);
else
{
char *name;
@@ -8200,6 +8192,17 @@ restore_nofile_limit (void)
#endif
}
+int
+open_channel_for_module (Lisp_Object process)
+{
+ CHECK_PROCESS (process);
+ CHECK_TYPE (PIPECONN_P (process), Qpipe_process_p, process);
+ int fd = dup (XPROCESS (process)->open_fd[SUBPROCESS_STDOUT]);
+ if (fd == -1)
+ report_file_error ("Cannot duplicate file descriptor", Qnil);
+ return fd;
+}
+
/* This is not called "init_process" because that is the name of a
Mach system call, so it would cause problems on Darwin systems. */
@@ -8277,19 +8280,6 @@ init_process_emacs (int sockfd)
memset (datagram_address, 0, sizeof datagram_address);
#endif
-#if defined (DARWIN_OS)
- /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
- processes. As such, we only change the default value. */
- if (initialized)
- {
- char const *release = (STRINGP (Voperating_system_release)
- ? SSDATA (Voperating_system_release)
- : 0);
- if (!release || !release[0] || (release[0] < '7' && release[1] == '.')) {
- Vprocess_connection_type = Qnil;
- }
- }
-#endif
#endif /* subprocesses */
kbd_is_on_hold = 0;
}
@@ -8459,6 +8449,7 @@ amounts of data in one go. */);
DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
DEFSYM (Qnull, "null");
+ DEFSYM (Qpipe_process_p, "pipe-process-p");
defsubr (&Sprocessp);
defsubr (&Sget_process);
diff --git a/src/process.h b/src/process.h
index 7884efc5494..a783a31cb86 100644
--- a/src/process.h
+++ b/src/process.h
@@ -300,6 +300,8 @@ extern Lisp_Object remove_slash_colon (Lisp_Object);
extern void update_processes_for_thread_death (Lisp_Object);
extern void dissociate_controlling_tty (void);
+extern int open_channel_for_module (Lisp_Object);
+
INLINE_HEADER_END
#endif /* EMACS_PROCESS_H */
diff --git a/src/ptr-bounds.h b/src/ptr-bounds.h
deleted file mode 100644
index 22d49f25b6c..00000000000
--- a/src/ptr-bounds.h
+++ /dev/null
@@ -1,79 +0,0 @@
-/* Pointer bounds checking for GNU Emacs
-
-Copyright 2017-2020 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software: you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or (at
-your option) any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
-
-/* Pointer bounds checking is a no-op unless running on hardware
- supporting Intel MPX (Intel Skylake or better). Also, it requires
- GCC 5 and Linux kernel 3.19, or later. Configure with
- CFLAGS='-fcheck-pointer-bounds -mmpx', perhaps with
- -fchkp-first-field-has-own-bounds thrown in.
-
- Although pointer bounds checking can help during debugging, it is
- disabled by default because it hurts performance significantly.
- The checking does not detect all pointer errors. For example, a
- dumped Emacs might not detect a bounds violation of a pointer that
- was created before Emacs was dumped. */
-
-#ifndef PTR_BOUNDS_H
-#define PTR_BOUNDS_H
-
-#include <stddef.h>
-
-/* When not checking pointer bounds, the following macros simply
- return their first argument. These macros return either void *, or
- the same type as their first argument. */
-
-INLINE_HEADER_BEGIN
-
-/* Return a copy of P, with bounds narrowed to [P, P + N). */
-#ifdef __CHKP__
-INLINE void *
-ptr_bounds_clip (void const *p, size_t n)
-{
- return __builtin___bnd_narrow_ptr_bounds (p, p, n);
-}
-#else
-# define ptr_bounds_clip(p, n) ((void) (size_t) {n}, p)
-#endif
-
-/* Return a copy of P, but with the bounds of Q. */
-#ifdef __CHKP__
-# define ptr_bounds_copy(p, q) __builtin___bnd_copy_ptr_bounds (p, q)
-#else
-# define ptr_bounds_copy(p, q) ((void) (void const *) {q}, p)
-#endif
-
-/* Return a copy of P, but with infinite bounds.
- This is a loophole in pointer bounds checking. */
-#ifdef __CHKP__
-# define ptr_bounds_init(p) __builtin___bnd_init_ptr_bounds (p)
-#else
-# define ptr_bounds_init(p) (p)
-#endif
-
-/* Return a copy of P, but with bounds [P, P + N).
- This is a loophole in pointer bounds checking. */
-#ifdef __CHKP__
-# define ptr_bounds_set(p, n) __builtin___bnd_set_ptr_bounds (p, n)
-#else
-# define ptr_bounds_set(p, n) ((void) (size_t) {n}, p)
-#endif
-
-INLINE_HEADER_END
-
-#endif /* PTR_BOUNDS_H */
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index 5e23fc94e4f..971a5f63749 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -58,7 +58,7 @@
#define RE_STRING_CHAR(p, multibyte) \
(multibyte ? STRING_CHAR (p) : *(p))
#define RE_STRING_CHAR_AND_LENGTH(p, len, multibyte) \
- (multibyte ? STRING_CHAR_AND_LENGTH (p, len) : ((len) = 1, *(p)))
+ (multibyte ? string_char_and_length (p, &(len)) : ((len) = 1, *(p)))
#define RE_CHAR_TO_MULTIBYTE(c) UNIBYTE_TO_CHAR (c)
@@ -89,7 +89,7 @@
#define GET_CHAR_AFTER(c, p, len) \
do { \
if (target_multibyte) \
- (c) = STRING_CHAR_AND_LENGTH (p, len); \
+ (c) = string_char_and_length (p, &(len)); \
else \
{ \
(c) = *p; \
@@ -929,7 +929,7 @@ typedef struct
? 0 \
: ((fail_stack).stack \
= REGEX_REALLOCATE ((fail_stack).stack, \
- (fail_stack).size * sizeof (fail_stack_elt_t), \
+ (fail_stack).avail * sizeof (fail_stack_elt_t), \
min (emacs_re_max_failures * TYPICAL_FAILURE_SIZE, \
((fail_stack).size * FAIL_STACK_GROWTH_FACTOR)) \
* sizeof (fail_stack_elt_t)), \
@@ -969,7 +969,11 @@ typedef struct
#define ENSURE_FAIL_STACK(space) \
while (REMAINING_AVAIL_SLOTS <= space) { \
if (!GROW_FAIL_STACK (fail_stack)) \
- return -2; \
+ { \
+ unbind_to (count, Qnil); \
+ SAFE_FREE (); \
+ return -2; \
+ } \
DEBUG_PRINT ("\n Doubled stack; size now: %td\n", fail_stack.size); \
DEBUG_PRINT (" slots available: %td\n", REMAINING_AVAIL_SLOTS);\
}
@@ -979,6 +983,8 @@ while (REMAINING_AVAIL_SLOTS <= space) { \
do { \
char *destination; \
intptr_t n = num; \
+ eassert (0 < n && n < num_regs); \
+ eassert (REG_UNSET (regstart[n]) <= REG_UNSET (regend[n])); \
ENSURE_FAIL_STACK(3); \
DEBUG_PRINT (" Push reg %"PRIdPTR" (spanning %p -> %p)\n", \
n, regstart[n], regend[n]); \
@@ -1017,8 +1023,10 @@ do { \
} \
else \
{ \
+ eassert (0 < pfreg && pfreg < num_regs); \
regend[pfreg] = POP_FAILURE_POINTER (); \
regstart[pfreg] = POP_FAILURE_POINTER (); \
+ eassert (REG_UNSET (regstart[pfreg]) <= REG_UNSET (regend[pfreg])); \
DEBUG_PRINT (" Pop reg %ld (spanning %p -> %p)\n", \
pfreg, regstart[pfreg], regend[pfreg]); \
} \
@@ -1757,6 +1765,7 @@ regex_compile (re_char *pattern, ptrdiff_t size,
/* Initialize the compile stack. */
compile_stack.stack = xmalloc (INIT_COMPILE_STACK_SIZE
* sizeof *compile_stack.stack);
+ __lsan_ignore_object (compile_stack.stack);
compile_stack.size = INIT_COMPILE_STACK_SIZE;
compile_stack.avail = 0;
@@ -2113,17 +2122,20 @@ regex_compile (re_char *pattern, ptrdiff_t size,
if (CHAR_BYTE8_P (c1))
c = BYTE8_TO_CHAR (128);
}
- if (CHAR_BYTE8_P (c))
- {
- c = CHAR_TO_BYTE8 (c);
- c1 = CHAR_TO_BYTE8 (c1);
- for (; c <= c1; c++)
- SET_LIST_BIT (c);
- }
- else if (multibyte)
- SETUP_MULTIBYTE_RANGE (range_table_work, c, c1);
- else
- SETUP_UNIBYTE_RANGE (range_table_work, c, c1);
+ if (c <= c1)
+ {
+ if (CHAR_BYTE8_P (c))
+ {
+ c = CHAR_TO_BYTE8 (c);
+ c1 = CHAR_TO_BYTE8 (c1);
+ for (; c <= c1; c++)
+ SET_LIST_BIT (c);
+ }
+ else if (multibyte)
+ SETUP_MULTIBYTE_RANGE (range_table_work, c, c1);
+ else
+ SETUP_UNIBYTE_RANGE (range_table_work, c, c1);
+ }
}
}
@@ -3164,10 +3176,6 @@ re_search (struct re_pattern_buffer *bufp, const char *string, ptrdiff_t size,
regs, size);
}
-/* Head address of virtual concatenation of string. */
-#define HEAD_ADDR_VSTRING(P) \
- (((P) >= size1 ? string2 : string1))
-
/* Address of POS in the concatenation of virtual string. */
#define POS_ADDR_VSTRING(POS) \
(((POS) >= size1 ? string2 - size1 : string1) + (POS))
@@ -3297,7 +3305,7 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, ptrdiff_t size1,
{
int buf_charlen;
- buf_ch = STRING_CHAR_AND_LENGTH (d, buf_charlen);
+ buf_ch = string_char_and_length (d, &buf_charlen);
buf_ch = RE_TRANSLATE (translate, buf_ch);
if (fastmap[CHAR_LEADING_CODE (buf_ch)])
break;
@@ -3327,7 +3335,7 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, ptrdiff_t size1,
{
int buf_charlen;
- buf_ch = STRING_CHAR_AND_LENGTH (d, buf_charlen);
+ buf_ch = string_char_and_length (d, &buf_charlen);
if (fastmap[CHAR_LEADING_CODE (buf_ch)])
break;
range -= buf_charlen;
@@ -3410,16 +3418,12 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, ptrdiff_t size1,
if (multibyte)
{
re_char *p = POS_ADDR_VSTRING (startpos) + 1;
- re_char *p0 = p;
- re_char *phead = HEAD_ADDR_VSTRING (startpos);
+ int len = raw_prev_char_len (p);
- /* Find the head of multibyte form. */
- PREV_CHAR_BOUNDARY (p, phead);
- range += p0 - 1 - p;
+ range += len - 1;
if (range > 0)
break;
-
- startpos -= p0 - 1 - p;
+ startpos -= len - 1;
}
}
}
@@ -3868,6 +3872,10 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string2, ptrdiff_t size2,
ptrdiff_t pos, struct re_registers *regs, ptrdiff_t stop)
{
+ eassume (0 <= size1);
+ eassume (0 <= size2);
+ eassume (0 <= pos && pos <= stop && stop <= size1 + size2);
+
/* General temporaries. */
int mcnt;
@@ -3923,8 +3931,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
attempt) by a subexpression part of the pattern, that is, the
regnum-th regstart pointer points to where in the pattern we began
matching and the regnum-th regend points to right after where we
- stopped matching the regnum-th subexpression. (The zeroth register
- keeps track of what the whole pattern matches.) */
+ stopped matching the regnum-th subexpression. */
re_char **regstart UNINIT, **regend UNINIT;
/* The following record the register info as found in the above
@@ -3973,29 +3980,22 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
/* Do not bother to initialize all the register variables if there are
no groups in the pattern, as it takes a fair amount of time. If
there are groups, we include space for register 0 (the whole
- pattern), even though we never use it, since it simplifies the
- array indexing. We should fix this. */
- if (bufp->re_nsub)
+ pattern) in REGSTART[0], even though we never use it, to avoid
+ the undefined behavior of subtracting 1 from REGSTART. */
+ ptrdiff_t re_nsub = num_regs - 1;
+ if (0 < re_nsub)
{
- regstart = SAFE_ALLOCA (num_regs * 4 * sizeof *regstart);
+ regstart = SAFE_ALLOCA ((re_nsub * 4 + 1) * sizeof *regstart);
regend = regstart + num_regs;
- best_regstart = regend + num_regs;
- best_regend = best_regstart + num_regs;
- }
+ best_regstart = regend + re_nsub;
+ best_regend = best_regstart + re_nsub;
- /* The starting position is bogus. */
- if (pos < 0 || pos > size1 + size2)
- {
- unbind_to (count, Qnil);
- SAFE_FREE ();
- return -1;
+ /* Initialize subexpression text positions to unset, to mark ones
+ that no start_memory/stop_memory has been seen for. */
+ for (re_char **apos = regstart + 1; apos < best_regstart + 1; apos++)
+ *apos = NULL;
}
- /* Initialize subexpression text positions to -1 to mark ones that no
- start_memory/stop_memory has been seen for. */
- for (ptrdiff_t reg = 1; reg < num_regs; reg++)
- regstart[reg] = regend[reg] = NULL;
-
/* We move 'string1' into 'string2' if the latter's empty -- but not if
'string1' is null. */
if (size2 == 0 && string1 != NULL)
@@ -4130,6 +4130,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
{
regstart[reg] = best_regstart[reg];
regend[reg] = best_regend[reg];
+ eassert (REG_UNSET (regstart[reg])
+ <= REG_UNSET (regend[reg]));
}
}
} /* d != end_match_2 */
@@ -4177,7 +4179,9 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
for (ptrdiff_t reg = 1; reg < num_regs; reg++)
{
- if (REG_UNSET (regstart[reg]) || REG_UNSET (regend[reg]))
+ eassert (REG_UNSET (regstart[reg])
+ <= REG_UNSET (regend[reg]));
+ if (REG_UNSET (regend[reg]))
regs->start[reg] = regs->end[reg] = -1;
else
{
@@ -4238,13 +4242,13 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
PREFETCH ();
if (multibyte)
- pat_ch = STRING_CHAR_AND_LENGTH (p, pat_charlen);
+ pat_ch = string_char_and_length (p, &pat_charlen);
else
{
pat_ch = RE_CHAR_TO_MULTIBYTE (*p);
pat_charlen = 1;
}
- buf_ch = STRING_CHAR_AND_LENGTH (d, buf_charlen);
+ buf_ch = string_char_and_length (d, &buf_charlen);
if (TRANSLATE (buf_ch) != pat_ch)
{
@@ -4266,7 +4270,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
PREFETCH ();
if (multibyte)
{
- pat_ch = STRING_CHAR_AND_LENGTH (p, pat_charlen);
+ pat_ch = string_char_and_length (p, &pat_charlen);
pat_ch = RE_CHAR_TO_UNIBYTE (pat_ch);
}
else
@@ -4377,12 +4381,12 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
registers data structure) under the register number. */
case start_memory:
DEBUG_PRINT ("EXECUTING start_memory %d:\n", *p);
+ eassert (0 < *p && *p < num_regs);
/* In case we need to undo this operation (via backtracking). */
PUSH_FAILURE_REG (*p);
regstart[*p] = d;
- regend[*p] = NULL; /* probably unnecessary. -sm */
DEBUG_PRINT (" regstart: %td\n", POINTER_TO_OFFSET (regstart[*p]));
/* Move past the register number and inner group count. */
@@ -4395,6 +4399,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
case stop_memory:
DEBUG_PRINT ("EXECUTING stop_memory %d:\n", *p);
+ eassert (0 < *p && *p < num_regs);
eassert (!REG_UNSET (regstart[*p]));
/* Strictly speaking, there should be code such as:
@@ -4427,7 +4432,9 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
DEBUG_PRINT ("EXECUTING duplicate %d.\n", regno);
/* Can't back reference a group which we've never matched. */
- if (REG_UNSET (regstart[regno]) || REG_UNSET (regend[regno]))
+ eassert (0 < regno && regno < num_regs);
+ eassert (REG_UNSET (regstart[regno]) <= REG_UNSET (regend[regno]));
+ if (REG_UNSET (regend[regno]))
goto fail;
/* Where in input to try to start matching. */
diff --git a/src/search.c b/src/search.c
index 818bb4af246..6fb3716cd43 100644
--- a/src/search.c
+++ b/src/search.c
@@ -353,8 +353,8 @@ data if you want to preserve them. */)
}
DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 1, 0,
- doc: /* Return t if text after point matches regular expression REGEXP.
-Find the longest match, in accord with Posix regular expression rules.
+ doc: /* Return t if text after point matches REGEXP according to Posix rules.
+Find the longest match, in accordance with Posix regular expression rules.
This function modifies the match data that `match-beginning',
`match-end' and `match-data' access; save and restore the match
data if you want to preserve them. */)
@@ -449,7 +449,7 @@ matched by the parenthesis constructions in REGEXP. */)
}
DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 3, 0,
- doc: /* Return index of start of first match for REGEXP in STRING, or nil.
+ doc: /* Return index of start of first match for Posix REGEXP in STRING, or nil.
Find the longest match, in accord with Posix regular expression rules.
Case is ignored if `case-fold-search' is non-nil in the current buffer.
If third arg START is non-nil, start search at that index in STRING.
@@ -613,7 +613,10 @@ newline_cache_on_off (struct buffer *buf)
{
/* It should be on. */
if (base_buf->newline_cache == 0)
- base_buf->newline_cache = new_region_cache ();
+ {
+ base_buf->newline_cache = new_region_cache ();
+ __lsan_ignore_object (base_buf->newline_cache);
+ }
}
return base_buf->newline_cache;
}
@@ -994,7 +997,7 @@ find_before_next_newline (ptrdiff_t from, ptrdiff_t to,
if (counted == cnt)
{
if (bytepos)
- DEC_BOTH (pos, *bytepos);
+ dec_both (&pos, &*bytepos);
else
pos--;
}
@@ -1028,8 +1031,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror,
}
else
{
- CHECK_FIXNUM_COERCE_MARKER (bound);
- lim = XFIXNUM (bound);
+ lim = fix_position (bound);
if (n > 0 ? lim < PT : lim > PT)
error ("Invalid search bound (wrong side of point)");
if (lim > ZV)
@@ -1354,8 +1356,8 @@ search_buffer_non_re (Lisp_Object string, ptrdiff_t pos,
while (--len >= 0)
{
unsigned char str_base[MAX_MULTIBYTE_LENGTH], *str;
- int c, translated, inverse;
- int in_charlen, charlen;
+ int translated, inverse;
+ int charlen;
/* If we got here and the RE flag is set, it's because we're
dealing with a regexp known to be trivial, so the backslash
@@ -1368,7 +1370,7 @@ search_buffer_non_re (Lisp_Object string, ptrdiff_t pos,
base_pat++;
}
- c = STRING_CHAR_AND_LENGTH (base_pat, in_charlen);
+ int in_charlen, c = string_char_and_length (base_pat, &in_charlen);
if (NILP (trt))
{
@@ -1551,12 +1553,10 @@ simple_search (EMACS_INT n, unsigned char *pat,
while (this_len > 0)
{
- int charlen, buf_charlen;
- int pat_ch, buf_ch;
-
- pat_ch = STRING_CHAR_AND_LENGTH (p, charlen);
- buf_ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (this_pos_byte),
- buf_charlen);
+ int charlen, pat_ch = string_char_and_length (p, &charlen);
+ int buf_charlen, buf_ch
+ = string_char_and_length (BYTE_POS_ADDR (this_pos_byte),
+ &buf_charlen);
TRANSLATE (buf_ch, trt, buf_ch);
if (buf_ch != pat_ch)
@@ -1577,7 +1577,7 @@ simple_search (EMACS_INT n, unsigned char *pat,
break;
}
- INC_BOTH (pos, pos_byte);
+ inc_both (&pos, &pos_byte);
}
n--;
@@ -1639,8 +1639,8 @@ simple_search (EMACS_INT n, unsigned char *pat,
{
int pat_ch, buf_ch;
- DEC_BOTH (this_pos, this_pos_byte);
- PREV_CHAR_BOUNDARY (p, pat);
+ dec_both (&this_pos, &this_pos_byte);
+ p -= raw_prev_char_len (p);
pat_ch = STRING_CHAR (p);
buf_ch = STRING_CHAR (BYTE_POS_ADDR (this_pos_byte));
TRANSLATE (buf_ch, trt, buf_ch);
@@ -1659,7 +1659,7 @@ simple_search (EMACS_INT n, unsigned char *pat,
break;
}
- DEC_BOTH (pos, pos_byte);
+ dec_both (&pos, &pos_byte);
}
n++;
@@ -2279,7 +2279,7 @@ and `replace-match'. */)
DEFUN ("posix-search-backward", Fposix_search_backward, Sposix_search_backward, 1, 4,
"sPosix search backward: ",
- doc: /* Search backward from point for match for regular expression REGEXP.
+ doc: /* Search backward from point for match for REGEXP according to Posix rules.
Find the longest match in accord with Posix regular expression rules.
Set point to the beginning of the occurrence found, and return point.
An optional second argument bounds the search; it is a buffer position.
@@ -2307,7 +2307,7 @@ and `replace-match'. */)
DEFUN ("posix-search-forward", Fposix_search_forward, Sposix_search_forward, 1, 4,
"sPosix search: ",
- doc: /* Search forward from point for regular expression REGEXP.
+ doc: /* Search forward from point for REGEXP according to Posix rules.
Find the longest match in accord with Posix regular expression rules.
Set point to the end of the occurrence found, and return point.
An optional second argument bounds the search; it is a buffer position.
@@ -2393,14 +2393,7 @@ since only regular expressions have distinguished subexpressions. */)
if (num_regs <= 0)
error ("`replace-match' called before any match found");
- if (NILP (subexp))
- sub = 0;
- else
- {
- CHECK_RANGED_INTEGER (subexp, 0, num_regs - 1);
- sub = XFIXNUM (subexp);
- }
-
+ sub = !NILP (subexp) ? check_integer_range (subexp, 0, num_regs - 1) : 0;
ptrdiff_t sub_start = search_regs.start[sub];
ptrdiff_t sub_end = search_regs.end[sub];
eassert (sub_start <= sub_end);
@@ -2445,10 +2438,11 @@ since only regular expressions have distinguished subexpressions. */)
if (NILP (string))
{
c = FETCH_CHAR_AS_MULTIBYTE (pos_byte);
- INC_BOTH (pos, pos_byte);
+ inc_both (&pos, &pos_byte);
}
else
- FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, pos, pos_byte);
+ c = fetch_string_char_as_multibyte_advance (string,
+ &pos, &pos_byte);
if (lowercasep (c))
{
@@ -2521,11 +2515,11 @@ since only regular expressions have distinguished subexpressions. */)
ptrdiff_t subend = 0;
bool delbackslash = 0;
- FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
+ c = fetch_string_char_advance (newtext, &pos, &pos_byte);
if (c == '\\')
{
- FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
+ c = fetch_string_char_advance (newtext, &pos, &pos_byte);
if (c == '&')
{
@@ -2633,7 +2627,8 @@ since only regular expressions have distinguished subexpressions. */)
if (str_multibyte)
{
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext, pos, pos_byte);
+ c = fetch_string_char_advance_no_check (newtext,
+ &pos, &pos_byte);
if (!buf_multibyte)
c = CHAR_TO_BYTE8 (c);
}
@@ -2642,7 +2637,7 @@ since only regular expressions have distinguished subexpressions. */)
/* Note that we don't have to increment POS. */
c = SREF (newtext, pos_byte++);
if (buf_multibyte)
- MAKE_CHAR_MULTIBYTE (c);
+ c = make_char_multibyte (c);
}
/* Either set ADD_STUFF and ADD_LEN to the text to put in SUBSTED,
@@ -2655,8 +2650,8 @@ since only regular expressions have distinguished subexpressions. */)
if (str_multibyte)
{
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext,
- pos, pos_byte);
+ c = fetch_string_char_advance_no_check (newtext,
+ &pos, &pos_byte);
if (!buf_multibyte && !ASCII_CHAR_P (c))
c = CHAR_TO_BYTE8 (c);
}
@@ -2664,7 +2659,7 @@ since only regular expressions have distinguished subexpressions. */)
{
c = SREF (newtext, pos_byte++);
if (buf_multibyte)
- MAKE_CHAR_MULTIBYTE (c);
+ c = make_char_multibyte (c);
}
if (c == '&')
@@ -3276,7 +3271,7 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */)
TYPE_MAXIMUM (ptrdiff_t), &nl_count_cache, NULL, true);
/* Create vector and populate it. */
- cache_newlines = make_uninit_vector (nl_count_cache);
+ cache_newlines = make_vector (nl_count_cache, make_fixnum (-1));
if (nl_count_cache)
{
@@ -3290,15 +3285,12 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */)
break;
ASET (cache_newlines, i, make_fixnum (found - 1));
}
- /* Fill the rest of slots with an invalid position. */
- for ( ; i < nl_count_cache; i++)
- ASET (cache_newlines, i, make_fixnum (-1));
}
/* Now do the same, but without using the cache. */
find_newline1 (BEGV, BEGV_BYTE, ZV, ZV_BYTE,
TYPE_MAXIMUM (ptrdiff_t), &nl_count_buf, NULL, true);
- buf_newlines = make_uninit_vector (nl_count_buf);
+ buf_newlines = make_vector (nl_count_buf, make_fixnum (-1));
if (nl_count_buf)
{
for (from = BEGV, found = from, i = 0; from < ZV; from = found, i++)
@@ -3311,14 +3303,10 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */)
break;
ASET (buf_newlines, i, make_fixnum (found - 1));
}
- for ( ; i < nl_count_buf; i++)
- ASET (buf_newlines, i, make_fixnum (-1));
}
/* Construct the value and return it. */
- val = make_uninit_vector (2);
- ASET (val, 0, cache_newlines);
- ASET (val, 1, buf_newlines);
+ val = CALLN (Fvector, cache_newlines, buf_newlines);
if (old != NULL)
set_buffer_internal_1 (old);
diff --git a/src/syntax.c b/src/syntax.c
index e8b32f5a445..066972e6d88 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -535,7 +535,7 @@ char_quoted (ptrdiff_t charpos, ptrdiff_t bytepos)
while (charpos > beg)
{
int c;
- DEC_BOTH (charpos, bytepos);
+ dec_both (&charpos, &bytepos);
UPDATE_SYNTAX_TABLE_BACKWARD (charpos);
c = FETCH_CHAR_AS_MULTIBYTE (bytepos);
@@ -556,11 +556,9 @@ char_quoted (ptrdiff_t charpos, ptrdiff_t bytepos)
static ptrdiff_t
dec_bytepos (ptrdiff_t bytepos)
{
- if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
- return bytepos - 1;
-
- DEC_POS (bytepos);
- return bytepos;
+ return (bytepos
+ - (!NILP (BVAR (current_buffer, enable_multibyte_characters))
+ ? prev_char_len (bytepos) : 1));
}
/* Return a defun-start position before POS and not too far before.
@@ -667,7 +665,7 @@ prev_char_comend_first (ptrdiff_t pos, ptrdiff_t pos_byte)
int c;
bool val;
- DEC_BOTH (pos, pos_byte);
+ dec_both (&pos, &pos_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (pos);
c = FETCH_CHAR (pos_byte);
val = SYNTAX_COMEND_FIRST (c);
@@ -738,7 +736,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
bool com2start, com2end, comstart;
/* Move back and examine a character. */
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
prev_syntax = syntax;
@@ -773,7 +771,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
{
ptrdiff_t next = from, next_byte = from_byte;
int next_c, next_syntax;
- DEC_BOTH (next, next_byte);
+ dec_both (&next, &next_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (next);
next_c = FETCH_CHAR_AS_MULTIBYTE (next_byte);
next_syntax = SYNTAX_WITH_FLAGS (next_c);
@@ -809,7 +807,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
/* Ignore escaped characters, except comment-enders which cannot
be escaped. */
- if ((Vcomment_end_can_be_escaped || code != Sendcomment)
+ if ((comment_end_can_be_escaped || code != Sendcomment)
&& char_quoted (from, from_byte))
continue;
@@ -1150,8 +1148,7 @@ the value of a `syntax-table' text property. */)
if (*p)
{
- int len;
- int character = STRING_CHAR_AND_LENGTH (p, len);
+ int len, character = string_char_and_length (p, &len);
XSETINT (match, character);
if (XFIXNAT (match) == ' ')
match = Qnil;
@@ -1444,7 +1441,7 @@ scan_words (ptrdiff_t from, EMACS_INT count)
int ch0, ch1;
Lisp_Object func, pos;
- SETUP_SYNTAX_TABLE (from, count);
+ SETUP_SYNTAX_TABLE (from, clip_to_bounds (PTRDIFF_MIN, count, PTRDIFF_MAX));
while (count > 0)
{
@@ -1455,7 +1452,7 @@ scan_words (ptrdiff_t from, EMACS_INT count)
UPDATE_SYNTAX_TABLE_FORWARD (from);
ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
code = SYNTAX (ch0);
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
if (words_include_escapes
&& (code == Sescape || code == Scharquote))
break;
@@ -1488,7 +1485,7 @@ scan_words (ptrdiff_t from, EMACS_INT count)
|| (code != Sescape && code != Scharquote)))
|| word_boundary_p (ch0, ch1))
break;
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
ch0 = ch1;
rarely_quit (from);
}
@@ -1501,7 +1498,7 @@ scan_words (ptrdiff_t from, EMACS_INT count)
{
if (from == beg)
return 0;
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
code = SYNTAX (ch1);
@@ -1530,7 +1527,7 @@ scan_words (ptrdiff_t from, EMACS_INT count)
{
if (from == beg)
break;
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
code = SYNTAX (ch0);
@@ -1539,7 +1536,7 @@ scan_words (ptrdiff_t from, EMACS_INT count)
|| (code != Sescape && code != Scharquote)))
|| word_boundary_p (ch0, ch1))
{
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
break;
}
ch1 = ch0;
@@ -1818,7 +1815,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
leading_code = str[i_byte];
}
- c = STRING_CHAR_AND_LENGTH (str + i_byte, len);
+ c = string_char_and_length (str + i_byte, &len);
i_byte += len;
@@ -1834,14 +1831,14 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
/* Get the end of the range. */
leading_code2 = str[i_byte];
- c2 = STRING_CHAR_AND_LENGTH (str + i_byte, len);
+ c2 = string_char_and_length (str + i_byte, &len);
i_byte += len;
if (c2 == '\\'
&& i_byte < size_byte)
{
leading_code2 = str[i_byte];
- c2 = STRING_CHAR_AND_LENGTH (str + i_byte, len);
+ c2 = string_char_and_length (str + i_byte, &len);
i_byte += len;
}
@@ -1953,7 +1950,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
p = GAP_END_ADDR;
stop = endp;
}
- c = STRING_CHAR_AND_LENGTH (p, nbytes);
+ c = string_char_and_length (p, &nbytes);
if (! NILP (iso_classes) && in_classes (c, iso_classes))
{
if (negate)
@@ -2175,7 +2172,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
stop = endp;
}
if (multibyte)
- c = STRING_CHAR_AND_LENGTH (p, nbytes);
+ c = string_char_and_length (p, &nbytes);
else
c = *p, nbytes = 1;
if (! fastmap[SYNTAX (c)])
@@ -2339,7 +2336,7 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
&& SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0) == style
&& (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ?
(nesting > 0 && --nesting == 0) : nesting < 0)
- && !(Vcomment_end_can_be_escaped && char_quoted (from, from_byte)))
+ && !(comment_end_can_be_escaped && char_quoted (from, from_byte)))
/* We have encountered a comment end of the same style
as the comment sequence which began this comment
section. */
@@ -2357,7 +2354,14 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
/* We have encountered a nested comment of the same style
as the comment sequence which began this comment section. */
nesting++;
- INC_BOTH (from, from_byte);
+ if (comment_end_can_be_escaped
+ && (code == Sescape || code == Scharquote))
+ {
+ inc_both (&from, &from_byte);
+ UPDATE_SYNTAX_TABLE_FORWARD (from);
+ if (from == stop) continue; /* Failure */
+ }
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
forw_incomment:
@@ -2378,7 +2382,7 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
break;
else
{
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
}
}
@@ -2395,7 +2399,7 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
as the comment sequence which began this comment section. */
{
syntax = Smax; /* So that "#|#" isn't also a comment ender. */
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
nesting++;
}
@@ -2437,7 +2441,7 @@ between them, return t; otherwise return nil. */)
from = PT;
from_byte = PT_BYTE;
- SETUP_SYNTAX_TABLE (from, count1);
+ SETUP_SYNTAX_TABLE (from, clip_to_bounds (PTRDIFF_MIN, count1, PTRDIFF_MAX));
while (count1 > 0)
{
do
@@ -2456,7 +2460,7 @@ between them, return t; otherwise return nil. */)
comstart_first = SYNTAX_FLAGS_COMSTART_FIRST (syntax);
comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax);
comstyle = SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0);
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
if (from < stop && comstart_first
&& (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte),
@@ -2471,7 +2475,7 @@ between them, return t; otherwise return nil. */)
code = Scomment;
comstyle = SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax);
comnested |= SYNTAX_FLAGS_COMMENT_NESTED (other_syntax);
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
}
rarely_quit (++quit_count);
@@ -2482,7 +2486,7 @@ between them, return t; otherwise return nil. */)
comstyle = ST_COMMENT_STYLE;
else if (code != Scomment)
{
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
SET_PT_BOTH (from, from_byte);
return Qnil;
}
@@ -2495,7 +2499,7 @@ between them, return t; otherwise return nil. */)
SET_PT_BOTH (from, from_byte);
return Qnil;
}
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
/* We have skipped one comment. */
count1--;
@@ -2511,7 +2515,7 @@ between them, return t; otherwise return nil. */)
return Qnil;
}
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
/* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */
bool quoted = char_quoted (from, from_byte);
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -2529,7 +2533,7 @@ between them, return t; otherwise return nil. */)
/* We must record the comment style encountered so that
later, we can match only the proper comment begin
sequence of the same style. */
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
code = Sendcomment;
/* Calling char_quoted, above, set up global syntax position
at the new value of FROM. */
@@ -2549,7 +2553,7 @@ between them, return t; otherwise return nil. */)
{
while (1)
{
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
if (SYNTAX (c) == Scomment_fence
@@ -2575,8 +2579,9 @@ between them, return t; otherwise return nil. */)
}
else if (code == Sendcomment)
{
- found = back_comment (from, from_byte, stop, comnested, comstyle,
- &out_charpos, &out_bytepos);
+ found = (!quoted || !comment_end_can_be_escaped)
+ && back_comment (from, from_byte, stop, comnested, comstyle,
+ &out_charpos, &out_bytepos);
if (!found)
{
if (c == '\n')
@@ -2590,7 +2595,7 @@ between them, return t; otherwise return nil. */)
not-quite-endcomment. */
if (SYNTAX (c) != code)
/* It was a two-char Sendcomment. */
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
goto leave;
}
}
@@ -2604,7 +2609,7 @@ between them, return t; otherwise return nil. */)
else if (code != Swhitespace || quoted)
{
leave:
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
SET_PT_BOTH (from, from_byte);
return Qnil;
}
@@ -2629,7 +2634,7 @@ syntax_multibyte (int c, bool multibyte_symbol_p)
}
static Lisp_Object
-scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
+scan_lists (EMACS_INT from0, EMACS_INT count, EMACS_INT depth, bool sexpflag)
{
Lisp_Object val;
ptrdiff_t stop = count > 0 ? ZV : BEGV;
@@ -2642,7 +2647,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
int comstyle = 0; /* Style of comment encountered. */
bool comnested = 0; /* Whether the comment is nestable or not. */
ptrdiff_t temp_pos;
- EMACS_INT last_good = from;
+ EMACS_INT last_good = from0;
bool found;
ptrdiff_t from_byte;
ptrdiff_t out_bytepos, out_charpos;
@@ -2653,14 +2658,13 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
if (depth > 0) min_depth = 0;
- if (from > ZV) from = ZV;
- if (from < BEGV) from = BEGV;
+ ptrdiff_t from = clip_to_bounds (BEGV, from0, ZV);
from_byte = CHAR_TO_BYTE (from);
maybe_quit ();
- SETUP_SYNTAX_TABLE (from, count);
+ SETUP_SYNTAX_TABLE (from, clip_to_bounds (PTRDIFF_MIN, count, PTRDIFF_MAX));
while (count > 0)
{
while (from < stop)
@@ -2678,7 +2682,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
prefix = SYNTAX_FLAGS_PREFIX (syntax);
if (depth == min_depth)
last_good = from;
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
if (from < stop && comstart_first
&& (c = FETCH_CHAR_AS_MULTIBYTE (from_byte),
@@ -2694,7 +2698,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
code = Scomment;
comstyle = SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax);
comnested |= SYNTAX_FLAGS_COMMENT_NESTED (other_syntax);
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
}
@@ -2707,7 +2711,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
case Scharquote:
if (from == stop)
goto lose;
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
/* Treat following character as a word constituent. */
FALLTHROUGH;
case Sword:
@@ -2723,7 +2727,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
{
case Scharquote:
case Sescape:
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
if (from == stop)
goto lose;
break;
@@ -2734,7 +2738,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
default:
goto done;
}
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
rarely_quit (++quit_count);
}
goto done;
@@ -2756,7 +2760,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
goto done;
goto lose;
}
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
break;
@@ -2765,7 +2769,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
break;
if (from != stop && c == FETCH_CHAR_AS_MULTIBYTE (from_byte))
{
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
}
if (mathexit)
{
@@ -2805,11 +2809,11 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
break;
if (c_code == Scharquote || c_code == Sescape)
- INC_BOTH (from, from_byte);
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
+ inc_both (&from, &from_byte);
rarely_quit (++quit_count);
}
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
if (!depth && sexpflag) goto done;
break;
default:
@@ -2834,7 +2838,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
while (from > stop)
{
rarely_quit (++quit_count);
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
int syntax = SYNTAX_WITH_FLAGS (c);
@@ -2853,7 +2857,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
later, we can match only the proper comment begin
sequence of the same style. */
int c2, other_syntax;
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
code = Sendcomment;
c2 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -2867,7 +2871,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
if we decremented FROM in the if-statement above. */
if (code != Sendcomment && char_quoted (from, from_byte))
{
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
code = Sword;
}
else if (SYNTAX_FLAGS_PREFIX (syntax))
@@ -2884,11 +2888,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
after passing it. */
while (from > stop)
{
- temp_pos = from_byte;
- if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
- DEC_POS (temp_pos);
- else
- temp_pos--;
+ temp_pos = dec_bytepos (from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
c1 = FETCH_CHAR_AS_MULTIBYTE (temp_pos);
/* Don't allow comment-end to be quoted. */
@@ -2897,7 +2897,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
quoted = char_quoted (from - 1, temp_pos);
if (quoted)
{
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
temp_pos = dec_bytepos (temp_pos);
UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
}
@@ -2908,7 +2908,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
case Sword: case Ssymbol: case Squote: break;
default: goto done2;
}
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
rarely_quit (++quit_count);
}
goto done2;
@@ -2921,7 +2921,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
temp_pos = dec_bytepos (from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
if (from != stop && c == FETCH_CHAR_AS_MULTIBYTE (temp_pos))
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
}
if (mathexit)
{
@@ -2964,7 +2964,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
{
if (from == stop)
goto lose;
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
if (!char_quoted (from, from_byte))
{
@@ -2983,7 +2983,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
{
if (from == stop)
goto lose;
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
if (!char_quoted (from, from_byte))
{
@@ -3093,7 +3093,7 @@ the prefix syntax flag (p). */)
SETUP_SYNTAX_TABLE (pos, -1);
- DEC_BOTH (pos, pos_byte);
+ dec_both (&pos, &pos_byte);
while (!char_quoted (pos, pos_byte)
/* Previous statement updates syntax table. */
@@ -3105,7 +3105,7 @@ the prefix syntax flag (p). */)
if (pos <= beg)
break;
- DEC_BOTH (pos, pos_byte);
+ dec_both (&pos, &pos_byte);
rarely_quit (pos);
}
@@ -3182,7 +3182,7 @@ scan_sexps_forward (struct lisp_parse_state *state,
prev_from = from;
prev_from_byte = from_byte;
if (from != BEGV)
- DEC_BOTH (prev_from, prev_from_byte);
+ dec_both (&prev_from, &prev_from_byte);
/* Use this macro instead of `from++'. */
#define INC_FROM \
@@ -3191,7 +3191,7 @@ do { prev_from = from; \
temp = FETCH_CHAR_AS_MULTIBYTE (prev_from_byte); \
prev_prev_from_syntax = prev_from_syntax; \
prev_from_syntax = SYNTAX_WITH_FLAGS (temp); \
- INC_BOTH (from, from_byte); \
+ inc_both (&from, &from_byte); \
if (from < end) \
UPDATE_SYNTAX_TABLE_FORWARD (from); \
} while (0)
@@ -3627,9 +3627,9 @@ init_syntax_once (void)
DEFSYM (Qsyntax_table, "syntax-table");
/* Create objects which can be shared among syntax tables. */
- Vsyntax_code_object = make_uninit_vector (Smax);
+ Vsyntax_code_object = make_nil_vector (Smax);
for (i = 0; i < Smax; i++)
- ASET (Vsyntax_code_object, i, Fcons (make_fixnum (i), Qnil));
+ ASET (Vsyntax_code_object, i, list1 (make_fixnum (i)));
/* Now we are ready to set up this property, so we can
create syntax tables. */
@@ -3770,9 +3770,9 @@ character of that word.
In both cases, LIMIT bounds the search. */);
Vfind_word_boundary_function_table = Fmake_char_table (Qnil, Qnil);
- DEFVAR_BOOL ("comment-end-can-be-escaped", Vcomment_end_can_be_escaped,
+ DEFVAR_BOOL ("comment-end-can-be-escaped", comment_end_can_be_escaped,
doc: /* Non-nil means an escaped ender inside a comment doesn't end the comment. */);
- Vcomment_end_can_be_escaped = 0;
+ comment_end_can_be_escaped = false;
DEFSYM (Qcomment_end_can_be_escaped, "comment-end-can-be-escaped");
Fmake_variable_buffer_local (Qcomment_end_can_be_escaped);
diff --git a/src/sysdep.c b/src/sysdep.c
index cb2f7f2f23c..e161172a79b 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -27,6 +27,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#endif /* HAVE_PWD_H */
#include <limits.h>
#include <stdlib.h>
+#include <sys/random.h>
#include <unistd.h>
#include <c-ctype.h>
@@ -48,10 +49,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
# include <cygwin/fs.h>
#endif
-#if defined DARWIN_OS || defined __FreeBSD__
+#if defined DARWIN_OS || defined __FreeBSD__ || defined __OpenBSD__
# include <sys/sysctl.h>
#endif
+#ifdef DARWIN_OS
+# include <libproc.h>
+#endif
+
#ifdef __FreeBSD__
/* Sparc/ARM machine/frame.h has 'struct frame' which conflicts with Emacs's
'struct frame', so rename it. */
@@ -115,16 +120,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "process.h"
#include "cm.h"
-#include "gnutls.h"
-/* MS-Windows loads GnuTLS at run time, if available; we don't want to
- do that during startup just to call gnutls_rnd. */
-#if defined HAVE_GNUTLS && !defined WINDOWSNT
-# include <gnutls/crypto.h>
-#else
-# define emacs_gnutls_global_init() Qnil
-# define gnutls_rnd(level, data, len) (-1)
-#endif
-
#ifdef WINDOWSNT
# include <direct.h>
/* In process.h which conflicts with the local copy. */
@@ -135,11 +130,6 @@ int _cdecl _spawnlp (int, const char *, const char *, ...);
# include <sys/socket.h>
#endif
-/* ULLONG_MAX is missing on Red Hat Linux 7.3; see Bug#11781. */
-#ifndef ULLONG_MAX
-#define ULLONG_MAX TYPE_MAXIMUM (unsigned long long int)
-#endif
-
/* Declare here, including term.h is problematic on some systems. */
extern void tputs (const char *, int, int (*)(int));
@@ -204,6 +194,7 @@ maybe_disable_address_randomization (int argc, char **argv)
}
#endif
+#ifndef WINDOWSNT
/* Execute the program in FILE, with argument vector ARGV and environ
ENVP. Return an error number if unsuccessful. This is like execve
except it reenables ASLR in the executed program if necessary, and
@@ -220,6 +211,8 @@ emacs_exec_file (char const *file, char *const *argv, char *const *envp)
return errno;
}
+#endif /* !WINDOWSNT */
+
/* If FD is not already open, arrange for it to be open with FLAGS. */
static void
force_open (int fd, int flags)
@@ -317,8 +310,8 @@ get_current_dir_name_or_unreachable (void)
if (pwd
&& (pwdlen = strnlen (pwd, bufsize_max)) < bufsize_max
&& IS_DIRECTORY_SEP (pwd[pwdlen && IS_DEVICE_SEP (pwd[1]) ? 2 : 0])
- && stat (pwd, &pwdstat) == 0
- && stat (".", &dotstat) == 0
+ && emacs_fstatat (AT_FDCWD, pwd, &pwdstat, 0) == 0
+ && emacs_fstatat (AT_FDCWD, ".", &dotstat, 0) == 0
&& dotstat.st_ino == pwdstat.st_ino
&& dotstat.st_dev == pwdstat.st_dev)
{
@@ -1768,24 +1761,6 @@ deliver_thread_signal (int sig, signal_handler_t handler)
errno = old_errno;
}
-#if !HAVE_DECL_SYS_SIGLIST
-# undef sys_siglist
-# ifdef _sys_siglist
-# define sys_siglist _sys_siglist
-# elif HAVE_DECL___SYS_SIGLIST
-# define sys_siglist __sys_siglist
-# else
-# define sys_siglist my_sys_siglist
-static char const *sys_siglist[NSIG];
-# endif
-#endif
-
-#ifdef _sys_nsig
-# define sys_siglist_entries _sys_nsig
-#else
-# define sys_siglist_entries NSIG
-#endif
-
/* Handle bus errors, invalid instruction, etc. */
static void
handle_fatal_signal (int sig)
@@ -1977,143 +1952,6 @@ init_signals (void)
main_thread_id = pthread_self ();
#endif
-#if !HAVE_DECL_SYS_SIGLIST && !defined _sys_siglist
- if (! initialized)
- {
- sys_siglist[SIGABRT] = "Aborted";
-# ifdef SIGAIO
- sys_siglist[SIGAIO] = "LAN I/O interrupt";
-# endif
- sys_siglist[SIGALRM] = "Alarm clock";
-# ifdef SIGBUS
- sys_siglist[SIGBUS] = "Bus error";
-# endif
-# ifdef SIGCHLD
- sys_siglist[SIGCHLD] = "Child status changed";
-# endif
-# ifdef SIGCONT
- sys_siglist[SIGCONT] = "Continued";
-# endif
-# ifdef SIGDANGER
- sys_siglist[SIGDANGER] = "Swap space dangerously low";
-# endif
-# ifdef SIGDGNOTIFY
- sys_siglist[SIGDGNOTIFY] = "Notification message in queue";
-# endif
-# ifdef SIGEMT
- sys_siglist[SIGEMT] = "Emulation trap";
-# endif
- sys_siglist[SIGFPE] = "Arithmetic exception";
-# ifdef SIGFREEZE
- sys_siglist[SIGFREEZE] = "SIGFREEZE";
-# endif
-# ifdef SIGGRANT
- sys_siglist[SIGGRANT] = "Monitor mode granted";
-# endif
- sys_siglist[SIGHUP] = "Hangup";
- sys_siglist[SIGILL] = "Illegal instruction";
- sys_siglist[SIGINT] = "Interrupt";
-# ifdef SIGIO
- sys_siglist[SIGIO] = "I/O possible";
-# endif
-# ifdef SIGIOINT
- sys_siglist[SIGIOINT] = "I/O intervention required";
-# endif
-# ifdef SIGIOT
- sys_siglist[SIGIOT] = "IOT trap";
-# endif
- sys_siglist[SIGKILL] = "Killed";
-# ifdef SIGLOST
- sys_siglist[SIGLOST] = "Resource lost";
-# endif
-# ifdef SIGLWP
- sys_siglist[SIGLWP] = "SIGLWP";
-# endif
-# ifdef SIGMSG
- sys_siglist[SIGMSG] = "Monitor mode data available";
-# endif
-# ifdef SIGPHONE
- sys_siglist[SIGWIND] = "SIGPHONE";
-# endif
- sys_siglist[SIGPIPE] = "Broken pipe";
-# ifdef SIGPOLL
- sys_siglist[SIGPOLL] = "Pollable event occurred";
-# endif
-# ifdef SIGPROF
- sys_siglist[SIGPROF] = "Profiling timer expired";
-# endif
-# ifdef SIGPTY
- sys_siglist[SIGPTY] = "PTY I/O interrupt";
-# endif
-# ifdef SIGPWR
- sys_siglist[SIGPWR] = "Power-fail restart";
-# endif
- sys_siglist[SIGQUIT] = "Quit";
-# ifdef SIGRETRACT
- sys_siglist[SIGRETRACT] = "Need to relinquish monitor mode";
-# endif
-# ifdef SIGSAK
- sys_siglist[SIGSAK] = "Secure attention";
-# endif
- sys_siglist[SIGSEGV] = "Segmentation violation";
-# ifdef SIGSOUND
- sys_siglist[SIGSOUND] = "Sound completed";
-# endif
-# ifdef SIGSTOP
- sys_siglist[SIGSTOP] = "Stopped (signal)";
-# endif
-# ifdef SIGSTP
- sys_siglist[SIGSTP] = "Stopped (user)";
-# endif
-# ifdef SIGSYS
- sys_siglist[SIGSYS] = "Bad argument to system call";
-# endif
- sys_siglist[SIGTERM] = "Terminated";
-# ifdef SIGTHAW
- sys_siglist[SIGTHAW] = "SIGTHAW";
-# endif
-# ifdef SIGTRAP
- sys_siglist[SIGTRAP] = "Trace/breakpoint trap";
-# endif
-# ifdef SIGTSTP
- sys_siglist[SIGTSTP] = "Stopped (user)";
-# endif
-# ifdef SIGTTIN
- sys_siglist[SIGTTIN] = "Stopped (tty input)";
-# endif
-# ifdef SIGTTOU
- sys_siglist[SIGTTOU] = "Stopped (tty output)";
-# endif
-# ifdef SIGURG
- sys_siglist[SIGURG] = "Urgent I/O condition";
-# endif
-# ifdef SIGUSR1
- sys_siglist[SIGUSR1] = "User defined signal 1";
-# endif
-# ifdef SIGUSR2
- sys_siglist[SIGUSR2] = "User defined signal 2";
-# endif
-# ifdef SIGVTALRM
- sys_siglist[SIGVTALRM] = "Virtual timer expired";
-# endif
-# ifdef SIGWAITING
- sys_siglist[SIGWAITING] = "Process's LWPs are blocked";
-# endif
-# ifdef SIGWINCH
- sys_siglist[SIGWINCH] = "Window size changed";
-# endif
-# ifdef SIGWIND
- sys_siglist[SIGWIND] = "SIGWIND";
-# endif
-# ifdef SIGXCPU
- sys_siglist[SIGXCPU] = "CPU time limit exceeded";
-# endif
-# ifdef SIGXFSZ
- sys_siglist[SIGXFSZ] = "File size limit exceeded";
-# endif
- }
-#endif /* !HAVE_DECL_SYS_SIGLIST && !_sys_siglist */
-
/* Don't alter signal handlers if dumping. On some machines,
changing signal handlers sets static data that would make signals
fail to work right when the dumped Emacs is run. */
@@ -2280,9 +2118,7 @@ init_signals (void)
typedef unsigned int random_seed;
static void set_random_seed (random_seed arg) { srandom (arg); }
#elif defined HAVE_LRAND48
-/* Although srand48 uses a long seed, this is unsigned long to avoid
- undefined behavior on signed integer overflow in init_random. */
-typedef unsigned long int random_seed;
+typedef long int random_seed;
static void set_random_seed (random_seed arg) { srand48 (arg); }
#else
typedef unsigned int random_seed;
@@ -2309,23 +2145,14 @@ init_random (void)
/* First, try seeding the PRNG from the operating system's entropy
source. This approach is both fast and secure. */
#ifdef WINDOWSNT
+ /* FIXME: Perhaps getrandom can be used here too? */
success = w32_init_random (&v, sizeof v) == 0;
#else
- int fd = emacs_open ("/dev/urandom", O_RDONLY, 0);
- if (0 <= fd)
- {
- success = emacs_read (fd, &v, sizeof v) == sizeof v;
- close (fd);
- }
+ verify (sizeof v <= 256);
+ success = getrandom (&v, sizeof v, 0) == sizeof v;
#endif
- /* If that didn't work, try using GnuTLS, which is secure, but on
- some systems, can be somewhat slow. */
- if (!success)
- success = EQ (emacs_gnutls_global_init (), Qt)
- && gnutls_rnd (GNUTLS_RND_NONCE, &v, sizeof v) == 0;
-
- /* If _that_ didn't work, just use the current time value and PID.
+ /* If that didn't work, just use the current time value and PID.
It's at least better than XKCD 221. */
if (!success)
{
@@ -2454,7 +2281,27 @@ emacs_abort (void)
}
#endif
-/* Open FILE for Emacs use, using open flags OFLAG and mode MODE.
+/* Assuming the directory DIRFD, store information about FILENAME into *ST,
+ using FLAGS to control how the status is obtained.
+ Do not fail merely because fetching info was interrupted by a signal.
+ Allow the user to quit.
+
+ The type of ST is void * instead of struct stat * because the
+ latter type would be problematic in lisp.h. Some platforms may
+ play tricks like "#define stat stat64" in <sys/stat.h>, and lisp.h
+ does not include <sys/stat.h>. */
+
+int
+emacs_fstatat (int dirfd, char const *filename, void *st, int flags)
+{
+ int r;
+ while ((r = fstatat (dirfd, filename, st, flags)) != 0 && errno == EINTR)
+ maybe_quit ();
+ return r;
+}
+
+/* Assuming the directory DIRFD, open FILE for Emacs use,
+ using open flags OFLAGS and mode MODE.
Use binary I/O on systems that care about text vs binary I/O.
Arrange for subprograms to not inherit the file descriptor.
Prefer a method that is multithread-safe, if available.
@@ -2462,17 +2309,23 @@ emacs_abort (void)
Allow the user to quit. */
int
-emacs_open (const char *file, int oflags, int mode)
+emacs_openat (int dirfd, char const *file, int oflags, int mode)
{
int fd;
if (! (oflags & O_TEXT))
oflags |= O_BINARY;
oflags |= O_CLOEXEC;
- while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR)
+ while ((fd = openat (dirfd, file, oflags, mode)) < 0 && errno == EINTR)
maybe_quit ();
return fd;
}
+int
+emacs_open (char const *file, int oflags, int mode)
+{
+ return emacs_openat (AT_FDCWD, file, oflags, mode);
+}
+
/* Open FILE as a stream for Emacs use, with mode MODE.
Act like emacs_open with respect to threads, signals, and quits. */
@@ -2731,21 +2584,6 @@ emacs_perror (char const *message)
errno = err;
}
-/* Set the access and modification time stamps of FD (a.k.a. FILE) to be
- ATIME and MTIME, respectively.
- FD must be either negative -- in which case it is ignored --
- or a file descriptor that is open on FILE.
- If FD is nonnegative, then FILE can be NULL. */
-int
-set_file_times (int fd, const char *filename,
- struct timespec atime, struct timespec mtime)
-{
- struct timespec timespec[2];
- timespec[0] = atime;
- timespec[1] = mtime;
- return fdutimens (fd, filename, timespec);
-}
-
/* Rename directory SRCFD's entry SRC to directory DSTFD's entry DST.
This is like renameat except that it fails if DST already exists,
or if this operation is not supported atomically. Return 0 if
@@ -2769,15 +2607,13 @@ renameat_noreplace (int srcfd, char const *src, int dstfd, char const *dst)
#endif
}
-/* Like strsignal, except async-signal-safe, and this function typically
+/* Like strsignal, except async-signal-safe, and this function
returns a string in the C locale rather than the current locale. */
char const *
safe_strsignal (int code)
{
- char const *signame = 0;
+ char const *signame = sigdescr_np (code);
- if (0 <= code && code < sys_siglist_entries)
- signame = sys_siglist[code];
if (! signame)
signame = "Unknown signal";
@@ -3072,37 +2908,43 @@ list_system_processes (void)
return proclist;
}
-#elif defined DARWIN_OS || defined __FreeBSD__
+#elif defined DARWIN_OS || defined __FreeBSD__ || defined __OpenBSD__
Lisp_Object
list_system_processes (void)
{
#ifdef DARWIN_OS
int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_ALL};
+#elif defined __OpenBSD__
+ int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_ALL, 0,
+ sizeof (struct kinfo_proc), 4096};
#else
int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_PROC};
#endif
size_t len;
+ size_t mibsize = sizeof mib / sizeof mib[0];
struct kinfo_proc *procs;
size_t i;
Lisp_Object proclist = Qnil;
- if (sysctl (mib, 3, NULL, &len, NULL, 0) != 0 || len == 0)
+ if (sysctl (mib, mibsize, NULL, &len, NULL, 0) != 0 || len == 0)
return proclist;
procs = xmalloc (len);
- if (sysctl (mib, 3, procs, &len, NULL, 0) != 0 || len == 0)
+ if (sysctl (mib, mibsize, procs, &len, NULL, 0) != 0 || len == 0)
{
xfree (procs);
return proclist;
}
- len /= sizeof (struct kinfo_proc);
+ len /= sizeof procs[0];
for (i = 0; i < len; i++)
{
#ifdef DARWIN_OS
proclist = Fcons (INT_TO_INTEGER (procs[i].kp_proc.p_pid), proclist);
+#elif defined __OpenBSD__
+ proclist = Fcons (INT_TO_INTEGER (procs[i].p_pid), proclist);
#else
proclist = Fcons (INT_TO_INTEGER (procs[i].ki_pid), proclist);
#endif
@@ -3141,7 +2983,7 @@ make_lisp_timeval (struct timeval t)
#endif
-#if defined GNU_LINUX && defined HAVE_LONG_LONG_INT
+#ifdef GNU_LINUX
static struct timespec
time_from_jiffies (unsigned long long tval, long hz)
{
@@ -3876,8 +3718,21 @@ system_process_attributes (Lisp_Object pid)
if (gr)
attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
+ char pathbuf[PROC_PIDPATHINFO_MAXSIZE];
+ char *comm;
+
+ if (proc_pidpath (proc_id, pathbuf, sizeof(pathbuf)) > 0)
+ {
+ if ((comm = strrchr (pathbuf, '/')))
+ comm++;
+ else
+ comm = pathbuf;
+ }
+ else
+ comm = proc.kp_proc.p_comm;
+
decoded_comm = (code_convert_string_norecord
- (build_unibyte_string (proc.kp_proc.p_comm),
+ (build_unibyte_string (comm),
Vlocale_coding_system, 0));
attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs);
@@ -4127,14 +3982,20 @@ str_collate (Lisp_Object s1, Lisp_Object s2,
len = SCHARS (s1); i = i_byte = 0;
SAFE_NALLOCA (p1, 1, len + 1);
while (i < len)
- FETCH_STRING_CHAR_ADVANCE (*(p1+i-1), s1, i, i_byte);
- *(p1+len) = 0;
+ {
+ wchar_t *p = &p1[i];
+ *p = fetch_string_char_advance (s1, &i, &i_byte);
+ }
+ p1[len] = 0;
len = SCHARS (s2); i = i_byte = 0;
SAFE_NALLOCA (p2, 1, len + 1);
while (i < len)
- FETCH_STRING_CHAR_ADVANCE (*(p2+i-1), s2, i, i_byte);
- *(p2+len) = 0;
+ {
+ wchar_t *p = &p2[i];
+ *p = fetch_string_char_advance (s2, &i, &i_byte);
+ }
+ p2[len] = 0;
if (STRINGP (locale))
{
diff --git a/src/systhread.c b/src/systhread.c
index 0d600d6895e..ebd75526495 100644
--- a/src/systhread.c
+++ b/src/systhread.c
@@ -26,6 +26,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "nsterm.h"
#endif
+#ifdef HAVE_PTHREAD_SET_NAME_NP
+#include <pthread_np.h>
+#endif
+
#ifndef THREADS_ENABLED
void
@@ -221,6 +225,10 @@ sys_thread_set_name (const char *name)
# else
pthread_setname_np (pthread_self (), p_name);
# endif
+#elif HAVE_PTHREAD_SET_NAME_NP
+ /* The name will automatically be truncated if it exceeds a
+ system-specific length. */
+ pthread_set_name_np (pthread_self (), name);
#endif
}
diff --git a/src/systhread.h b/src/systhread.h
index 005388fd5a4..73c764a9401 100644
--- a/src/systhread.h
+++ b/src/systhread.h
@@ -21,12 +21,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <stdbool.h>
-#if __has_attribute (warn_unused_result)
-# define ATTRIBUTE_WARN_UNUSED_RESULT __attribute__ ((warn_unused_result))
-#else
-# define ATTRIBUTE_WARN_UNUSED_RESULT
-#endif
-
#ifdef THREADS_ENABLED
#ifdef HAVE_PTHREAD
@@ -108,13 +102,13 @@ extern void sys_cond_broadcast (sys_cond_t *);
extern void sys_cond_destroy (sys_cond_t *);
extern sys_thread_t sys_thread_self (void)
- ATTRIBUTE_WARN_UNUSED_RESULT;
+ NODISCARD;
extern bool sys_thread_equal (sys_thread_t, sys_thread_t)
- ATTRIBUTE_WARN_UNUSED_RESULT;
+ NODISCARD;
extern bool sys_thread_create (sys_thread_t *, thread_creation_function *,
void *)
- ATTRIBUTE_WARN_UNUSED_RESULT;
+ NODISCARD;
extern void sys_thread_yield (void);
extern void sys_thread_set_name (const char *);
diff --git a/src/systime.h b/src/systime.h
index 00ca4a1c58d..b59a3d1c690 100644
--- a/src/systime.h
+++ b/src/systime.h
@@ -67,9 +67,6 @@ timespec_valid_p (struct timespec t)
return t.tv_nsec >= 0;
}
-/* defined in sysdep.c */
-extern int set_file_times (int, const char *, struct timespec, struct timespec);
-
/* defined in keyboard.c */
extern void set_waiting_for_input (struct timespec *);
diff --git a/src/term.c b/src/term.c
index 94bf013f4a0..36776448451 100644
--- a/src/term.c
+++ b/src/term.c
@@ -105,14 +105,14 @@ struct tty_display_info *tty_list;
enum no_color_bit
{
- NC_STANDOUT = 1 << 0,
- NC_UNDERLINE = 1 << 1,
- NC_REVERSE = 1 << 2,
- NC_ITALIC = 1 << 3,
- NC_DIM = 1 << 4,
- NC_BOLD = 1 << 5,
- NC_INVIS = 1 << 6,
- NC_PROTECT = 1 << 7
+ NC_STANDOUT = 1 << 0,
+ NC_UNDERLINE = 1 << 1,
+ NC_REVERSE = 1 << 2,
+ NC_ITALIC = 1 << 3,
+ NC_DIM = 1 << 4,
+ NC_BOLD = 1 << 5,
+ NC_STRIKE_THROUGH = 1 << 6,
+ NC_PROTECT = 1 << 7
};
/* internal state */
@@ -1931,6 +1931,10 @@ turn_on_face (struct frame *f, int face_id)
if (face->tty_underline_p && MAY_USE_WITH_COLORS_P (tty, NC_UNDERLINE))
OUTPUT1_IF (tty, tty->TS_enter_underline_mode);
+ if (face->tty_strike_through_p
+ && MAY_USE_WITH_COLORS_P (tty, NC_STRIKE_THROUGH))
+ OUTPUT1_IF (tty, tty->TS_enter_strike_through_mode);
+
if (tty->TN_max_colors > 0)
{
const char *ts;
@@ -1971,7 +1975,8 @@ turn_off_face (struct frame *f, int face_id)
if (face->tty_bold_p
|| face->tty_italic_p
|| face->tty_reverse_p
- || face->tty_underline_p)
+ || face->tty_underline_p
+ || face->tty_strike_through_p)
{
OUTPUT1_IF (tty, tty->TS_exit_attribute_mode);
if (strcmp (tty->TS_exit_attribute_mode, tty->TS_end_standout_mode) == 0)
@@ -2006,11 +2011,20 @@ tty_capable_p (struct tty_display_info *tty, unsigned int caps)
if ((caps & (cap)) && (!(TS) || !MAY_USE_WITH_COLORS_P(tty, NC_bit))) \
return 0;
- TTY_CAPABLE_P_TRY (tty, TTY_CAP_INVERSE, tty->TS_standout_mode, NC_REVERSE);
- TTY_CAPABLE_P_TRY (tty, TTY_CAP_UNDERLINE, tty->TS_enter_underline_mode, NC_UNDERLINE);
- TTY_CAPABLE_P_TRY (tty, TTY_CAP_BOLD, tty->TS_enter_bold_mode, NC_BOLD);
- TTY_CAPABLE_P_TRY (tty, TTY_CAP_DIM, tty->TS_enter_dim_mode, NC_DIM);
- TTY_CAPABLE_P_TRY (tty, TTY_CAP_ITALIC, tty->TS_enter_italic_mode, NC_ITALIC);
+ TTY_CAPABLE_P_TRY (tty,
+ TTY_CAP_INVERSE, tty->TS_standout_mode, NC_REVERSE);
+ TTY_CAPABLE_P_TRY (tty,
+ TTY_CAP_UNDERLINE, tty->TS_enter_underline_mode,
+ NC_UNDERLINE);
+ TTY_CAPABLE_P_TRY (tty,
+ TTY_CAP_BOLD, tty->TS_enter_bold_mode, NC_BOLD);
+ TTY_CAPABLE_P_TRY (tty,
+ TTY_CAP_DIM, tty->TS_enter_dim_mode, NC_DIM);
+ TTY_CAPABLE_P_TRY (tty,
+ TTY_CAP_ITALIC, tty->TS_enter_italic_mode, NC_ITALIC);
+ TTY_CAPABLE_P_TRY (tty,
+ TTY_CAP_STRIKE_THROUGH, tty->TS_enter_strike_through_mode,
+ NC_STRIKE_THROUGH);
/* We can do it! */
return 1;
@@ -2402,7 +2416,7 @@ tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row,
pos_y = row->y + WINDOW_TOP_EDGE_Y (w);
pos_x = row->used[LEFT_MARGIN_AREA] + start_hpos + WINDOW_LEFT_EDGE_X (w);
- /* Save current cursor co-ordinates. */
+ /* Save current cursor coordinates. */
save_y = curY (tty);
save_x = curX (tty);
cursor_to (f, pos_y, pos_x);
@@ -4124,6 +4138,7 @@ use the Bourne shell command 'TERM=...; export TERM' (C-shell:\n\
tty->TS_enter_alt_charset_mode = tgetstr ("as", address);
tty->TS_exit_alt_charset_mode = tgetstr ("ae", address);
tty->TS_exit_attribute_mode = tgetstr ("me", address);
+ tty->TS_enter_strike_through_mode = tgetstr ("smxx", address);
MultiUp (tty) = tgetstr ("UP", address);
MultiDown (tty) = tgetstr ("DO", address);
@@ -4168,6 +4183,15 @@ use the Bourne shell command 'TERM=...; export TERM' (C-shell:\n\
could return 32767. */
tty->TN_max_colors = 16777216;
}
+ /* Fall back to xterm+direct (semicolon version) if requested
+ by the COLORTERM environment variable. */
+ else if ((bg = getenv("COLORTERM")) != NULL
+ && strcasecmp(bg, "truecolor") == 0)
+ {
+ tty->TS_set_foreground = "\033[%?%p1%{8}%<%t3%p1%d%e38;2;%p1%{65536}%/%d;%p1%{256}%/%{255}%&%d;%p1%{255}%&%d%;m";
+ tty->TS_set_background = "\033[%?%p1%{8}%<%t4%p1%d%e48;2;%p1%{65536}%/%d;%p1%{256}%/%{255}%&%d;%p1%{255}%&%d%;m";
+ tty->TN_max_colors = 16777216;
+ }
}
#endif
diff --git a/src/termchar.h b/src/termchar.h
index c96b81913b0..c967e7d04f4 100644
--- a/src/termchar.h
+++ b/src/termchar.h
@@ -136,6 +136,8 @@ struct tty_display_info
const char *TS_enter_reverse_mode; /* "mr" -- enter reverse video mode. */
const char *TS_exit_underline_mode; /* "us" -- start underlining. */
const char *TS_enter_underline_mode; /* "ue" -- end underlining. */
+ const char *TS_enter_strike_through_mode; /* "smxx" -- turn on strike-through
+ mode. */
/* "as"/"ae" -- start/end alternate character set. Not really
supported, yet. */
diff --git a/src/textprop.c b/src/textprop.c
index ee048336ac0..0876badc873 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -131,6 +131,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin,
{
INTERVAL i;
ptrdiff_t searchpos;
+ Lisp_Object begin0 = *begin, end0 = *end;
CHECK_STRING_OR_BUFFER (object);
CHECK_FIXNUM_COERCE_MARKER (*begin);
@@ -155,7 +156,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin,
if (!(BUF_BEGV (b) <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end)
&& XFIXNUM (*end) <= BUF_ZV (b)))
- args_out_of_range (*begin, *end);
+ args_out_of_range (begin0, end0);
i = buffer_intervals (b);
/* If there's no text, there are no properties. */
@@ -170,7 +171,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin,
if (! (0 <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end)
&& XFIXNUM (*end) <= len))
- args_out_of_range (*begin, *end);
+ args_out_of_range (begin0, end0);
i = string_intervals (object);
if (len == 0)
@@ -611,7 +612,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop,
{
struct window *w = 0;
- CHECK_FIXNUM_COERCE_MARKER (position);
+ EMACS_INT pos = fix_position (position);
if (NILP (object))
XSETBUFFER (object, current_buffer);
@@ -628,14 +629,14 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop,
Lisp_Object *overlay_vec;
struct buffer *obuf = current_buffer;
- if (XFIXNUM (position) < BUF_BEGV (XBUFFER (object))
- || XFIXNUM (position) > BUF_ZV (XBUFFER (object)))
+ if (! (BUF_BEGV (XBUFFER (object)) <= pos
+ && pos <= BUF_ZV (XBUFFER (object))))
xsignal1 (Qargs_out_of_range, position);
set_buffer_temp (XBUFFER (object));
USE_SAFE_ALLOCA;
- GET_OVERLAYS_AT (XFIXNUM (position), overlay_vec, noverlays, NULL, false);
+ GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, false);
noverlays = sort_overlays (overlay_vec, noverlays, w);
set_buffer_temp (obuf);
@@ -662,7 +663,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop,
/* Not a buffer, or no appropriate overlay, so fall through to the
simpler case. */
- return Fget_text_property (position, prop, object);
+ return Fget_text_property (make_fixnum (pos), prop, object);
}
DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
@@ -765,14 +766,13 @@ the current buffer), POSITION is a buffer position (integer or marker).
If OBJECT is a string, POSITION is a 0-based index into it.
In a string, scan runs to the end of the string, unless LIMIT is non-nil.
-In a buffer, if LIMIT is nil or omitted, it runs to (point-max), and the
-value cannot exceed that.
+In a buffer, scan runs to end of buffer, unless LIMIT is non-nil.
If the optional fourth argument LIMIT is non-nil, don't search
past position LIMIT; return LIMIT if nothing is found before LIMIT.
+However, if OBJECT is a buffer and LIMIT is beyond the end of the
+buffer, this function returns `point-max', not LIMIT.
-The property values are compared with `eq'.
-If the property is constant all the way to the end of OBJECT, return the
-last valid position in OBJECT. */)
+The property values are compared with `eq'. */)
(Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
{
if (STRINGP (object))
@@ -831,6 +831,9 @@ last valid position in OBJECT. */)
value = Fget_char_property (position, prop, object);
if (!EQ (value, initial_value))
break;
+
+ if (XFIXNAT (position) >= ZV)
+ break;
}
position = unbind_to (count, position);
diff --git a/src/thread.c b/src/thread.c
index c7fe0614269..7ab1e6de1fc 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -28,6 +28,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "pdumper.h"
#include "keyboard.h"
+#if defined HAVE_GLIB && ! defined (HAVE_NS)
+#include <xgselect.h>
+#else
+#define release_select_lock() do { } while (0)
+#endif
+
union aligned_thread_state
{
struct thread_state s;
@@ -586,6 +592,8 @@ really_call_select (void *arg)
sa->result = (sa->func) (sa->max_fds, sa->rfds, sa->wfds, sa->efds,
sa->timeout, sa->sigmask);
+ release_select_lock ();
+
block_interrupt_signal (&oldset);
/* If we were interrupted by C-g while inside sa->func above, the
signal handler could have called maybe_reacquire_global_lock, in
@@ -717,12 +725,17 @@ run_thread (void *state)
{
/* Make sure stack_top and m_stack_bottom are properly aligned as GC
expects. */
- max_align_t stack_pos;
+ union
+ {
+ Lisp_Object o;
+ void *p;
+ char c;
+ } stack_pos;
struct thread_state *self = state;
struct thread_state **iter;
- self->m_stack_bottom = self->stack_top = (char *) &stack_pos;
+ self->m_stack_bottom = self->stack_top = &stack_pos.c;
self->thread_id = sys_thread_self ();
if (self->thread_name)
@@ -1114,9 +1127,6 @@ syms_of_threads (void)
staticpro (&last_thread_error);
last_thread_error = Qnil;
- Fdefalias (intern_c_string ("thread-alive-p"),
- intern_c_string ("thread-live-p"), Qnil);
-
Fprovide (intern_c_string ("threads"), Qnil);
}
diff --git a/src/timefns.c b/src/timefns.c
index 553daf6e6a9..71d5e10872a 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -593,31 +593,29 @@ timespec_to_lisp (struct timespec t)
}
/* Return NUMERATOR / DENOMINATOR, rounded to the nearest double.
- Arguments must be Lisp integers, and DENOMINATOR must be nonzero. */
+ Arguments must be Lisp integers, and DENOMINATOR must be positive. */
static double
frac_to_double (Lisp_Object numerator, Lisp_Object denominator)
{
- intmax_t intmax_numerator;
- if (FASTER_TIMEFNS && EQ (denominator, make_fixnum (1))
- && integer_to_intmax (numerator, &intmax_numerator))
- return intmax_numerator;
+ intmax_t intmax_numerator, intmax_denominator;
+ if (FASTER_TIMEFNS
+ && integer_to_intmax (numerator, &intmax_numerator)
+ && integer_to_intmax (denominator, &intmax_denominator)
+ && intmax_numerator % intmax_denominator == 0)
+ return intmax_numerator / intmax_denominator;
/* Compute number of base-FLT_RADIX digits in numerator and denominator. */
mpz_t const *n = bignum_integer (&mpz[0], numerator);
mpz_t const *d = bignum_integer (&mpz[1], denominator);
- ptrdiff_t nbits = mpz_sizeinbase (*n, 2);
- ptrdiff_t dbits = mpz_sizeinbase (*d, 2);
- eassume (0 < nbits);
- eassume (0 < dbits);
- ptrdiff_t ndig = (nbits + LOG2_FLT_RADIX - 1) / LOG2_FLT_RADIX;
- ptrdiff_t ddig = (dbits + LOG2_FLT_RADIX - 1) / LOG2_FLT_RADIX;
+ ptrdiff_t ndig = mpz_sizeinbase (*n, FLT_RADIX);
+ ptrdiff_t ddig = mpz_sizeinbase (*d, FLT_RADIX);
/* Scale with SCALE when doing integer division. That is, compute
(N * FLT_RADIX**SCALE) / D [or, if SCALE is negative, N / (D *
FLT_RADIX**-SCALE)] as a bignum, convert the bignum to double,
then divide the double by FLT_RADIX**SCALE. First scale N
(or scale D, if SCALE is negative) ... */
- ptrdiff_t scale = ddig - ndig + DBL_MANT_DIG + 1;
+ ptrdiff_t scale = ddig - ndig + DBL_MANT_DIG;
if (scale < 0)
{
mpz_mul_2exp (mpz[1], *d, - (scale * LOG2_FLT_RADIX));
@@ -645,7 +643,7 @@ frac_to_double (Lisp_Object numerator, Lisp_Object denominator)
round to the nearest integer; otherwise, it is less than
FLT_RADIX ** (DBL_MANT_DIG + 1) and round it to the nearest
multiple of FLT_RADIX. Break ties to even. */
- if (mpz_sizeinbase (*q, 2) < DBL_MANT_DIG * LOG2_FLT_RADIX)
+ if (mpz_sizeinbase (*q, FLT_RADIX) <= DBL_MANT_DIG)
{
/* Converting to double will use the whole quotient so add 1 to
its absolute value as per round-to-even; i.e., if the doubled
@@ -770,44 +768,48 @@ decode_time_components (enum timeform form,
/* Normalize out-of-range lower-order components by carrying
each overflow into the next higher-order component. */
us += ps / 1000000 - (ps % 1000000 < 0);
- mpz_set_intmax (mpz[0], us / 1000000 - (us % 1000000 < 0));
- mpz_add (mpz[0], mpz[0], *bignum_integer (&mpz[1], low));
- mpz_addmul_ui (mpz[0], *bignum_integer (&mpz[1], high), 1 << LO_TIME_BITS);
+ mpz_t *s = &mpz[1];
+ mpz_set_intmax (*s, us / 1000000 - (us % 1000000 < 0));
+ mpz_add (*s, *s, *bignum_integer (&mpz[0], low));
+ mpz_addmul_ui (*s, *bignum_integer (&mpz[0], high), 1 << LO_TIME_BITS);
ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0);
us = us % 1000000 + 1000000 * (us % 1000000 < 0);
- if (result)
+ Lisp_Object hz;
+ switch (form)
{
- switch (form)
- {
- case TIMEFORM_HI_LO:
- /* Floats and nil were handled above, so it was an integer. */
- result->hz = make_fixnum (1);
- break;
-
- case TIMEFORM_HI_LO_US:
- mpz_mul_ui (mpz[0], mpz[0], 1000000);
- mpz_add_ui (mpz[0], mpz[0], us);
- result->hz = make_fixnum (1000000);
- break;
-
- case TIMEFORM_HI_LO_US_PS:
- mpz_mul_ui (mpz[0], mpz[0], 1000000);
- mpz_add_ui (mpz[0], mpz[0], us);
- mpz_mul_ui (mpz[0], mpz[0], 1000000);
- mpz_add_ui (mpz[0], mpz[0], ps);
- result->hz = trillion;
- break;
-
- default:
- eassume (false);
- }
- result->ticks = make_integer_mpz ();
+ case TIMEFORM_HI_LO:
+ /* Floats and nil were handled above, so it was an integer. */
+ mpz_swap (mpz[0], *s);
+ hz = make_fixnum (1);
+ break;
+
+ case TIMEFORM_HI_LO_US:
+ mpz_set_ui (mpz[0], us);
+ mpz_addmul_ui (mpz[0], *s, 1000000);
+ hz = make_fixnum (1000000);
+ break;
+
+ case TIMEFORM_HI_LO_US_PS:
+ {
+ #if FASTER_TIMEFNS && TRILLION <= ULONG_MAX
+ unsigned long i = us;
+ mpz_set_ui (mpz[0], i * 1000000 + ps);
+ mpz_addmul_ui (mpz[0], *s, TRILLION);
+ #else
+ intmax_t i = us;
+ mpz_set_intmax (mpz[0], i * 1000000 + ps);
+ mpz_addmul (mpz[0], *s, ztrillion);
+ #endif
+ hz = trillion;
+ }
+ break;
+
+ default:
+ eassume (false);
}
- else
- *dresult = mpz_get_d (mpz[0]) + (us * 1e6L + ps) / 1e12L;
- return 0;
+ return decode_ticks_hz (make_integer_mpz (), hz, result, dresult);
}
enum { DECODE_SECS_ONLY = WARN_OBSOLETE_TIMESTAMPS + 1 };
@@ -1310,11 +1312,12 @@ or (if you need time as a string) `format-time-string'. */)
((size_t) -1) for MAXSIZE.
This function behaves like nstrftime, except it allows NUL
- bytes in FORMAT and it does not support nanoseconds. */
+ bytes in FORMAT. */
static size_t
emacs_nmemftime (char *s, size_t maxsize, const char *format,
size_t format_len, const struct tm *tp, timezone_t tz, int ns)
{
+ int saved_errno = errno;
size_t total = 0;
/* Loop through all the NUL-terminated strings in the format
@@ -1324,30 +1327,25 @@ emacs_nmemftime (char *s, size_t maxsize, const char *format,
'\0' byte so we must invoke it separately for each such string. */
for (;;)
{
- size_t len;
- size_t result;
-
+ errno = 0;
+ size_t result = nstrftime (s, maxsize, format, tp, tz, ns);
+ if (result == 0 && errno != 0)
+ return result;
if (s)
- s[0] = '\1';
-
- result = nstrftime (s, maxsize, format, tp, tz, ns);
-
- if (s)
- {
- if (result == 0 && s[0] != '\0')
- return 0;
- s += result + 1;
- }
+ s += result + 1;
maxsize -= result + 1;
total += result;
- len = strlen (format);
+ size_t len = strlen (format);
if (len == format_len)
- return total;
+ break;
total++;
format += len + 1;
format_len -= len + 1;
}
+
+ errno = saved_errno;
+ return total;
}
static Lisp_Object
@@ -1377,10 +1375,11 @@ format_time_string (char const *format, ptrdiff_t formatlen,
while (true)
{
- buf[0] = '\1';
+ errno = 0;
len = emacs_nmemftime (buf, size, format, formatlen, tmp, tz, ns);
- if ((0 < len && len < size) || (len == 0 && buf[0] == '\0'))
+ if (len != 0 || errno == 0)
break;
+ eassert (errno == ERANGE);
/* Buffer was too small, so make it bigger and try again. */
len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tmp, tz, ns);
@@ -2046,7 +2045,7 @@ syms_of_timefns (void)
defsubr (&Scurrent_time_zone);
defsubr (&Sset_time_zone_rule);
- flt_radix_power = make_vector (flt_radix_power_size, Qnil);
+ flt_radix_power = make_nil_vector (flt_radix_power_size);
staticpro (&flt_radix_power);
#ifdef NEED_ZTRILLION_INIT
diff --git a/src/w32.c b/src/w32.c
index 6fed5ba8d3d..7b8a116d7ad 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -2370,6 +2370,26 @@ srandom (int seed)
iz = rand () % RAND_MAX_Z;
}
+/* Emulate explicit_bzero. This is to avoid using the Gnulib version,
+ because it calls SecureZeroMemory at will, disregarding systems
+ older than Windows XP, which didn't have that function. We want to
+ avoid having that function as dependency in builds that need to
+ support systems older than Windows XP, otherwise Emacs will refuse
+ to start on those systems. */
+void
+explicit_bzero (void *buf, size_t len)
+{
+#if _WIN32_WINNT >= 0x0501
+ /* We are compiling for XP or newer, most probably with MinGW64.
+ We can use SecureZeroMemory. */
+ SecureZeroMemory (buf, len);
+#else
+ memset (buf, 0, len);
+ /* Compiler barrier. */
+ asm volatile ("" ::: "memory");
+#endif
+}
+
/* Return the maximum length in bytes of a multibyte character
sequence encoded in the current ANSI codepage. This is required to
correctly walk the encoded file names one character at a time. */
@@ -3178,18 +3198,9 @@ fdutimens (int fd, char const *file, struct timespec const timespec[2])
return _futime (fd, &_ut);
}
else
- {
- struct utimbuf ut;
-
- ut.actime = timespec[0].tv_sec;
- ut.modtime = timespec[1].tv_sec;
- /* Call 'utime', which is implemented below, not the MS library
- function, which fails on directories. */
- return utime (file, &ut);
- }
+ return utimensat (fd, file, timespec, 0);
}
-
/* ------------------------------------------------------------------------- */
/* IO support and wrapper functions for the Windows API. */
/* ------------------------------------------------------------------------- */
@@ -3450,8 +3461,6 @@ is_fat_volume (const char * name, const char ** pPath)
/* Convert all slashes in a filename to backslashes, and map filename
to a valid 8.3 name if necessary. The result is a pointer to a
static buffer, so CAVEAT EMPTOR! */
-const char *map_w32_filename (const char *, const char **);
-
const char *
map_w32_filename (const char * name, const char ** pPath)
{
@@ -4320,10 +4329,9 @@ sys_chdir (const char * path)
}
}
-int
-sys_chmod (const char * path, int mode)
+static int
+chmod_worker (const char * path, int mode)
{
- path = chase_symlinks (map_w32_filename (path, NULL));
if (w32_unicode_filenames)
{
wchar_t path_w[MAX_PATH];
@@ -4341,6 +4349,20 @@ sys_chmod (const char * path, int mode)
}
int
+sys_chmod (const char * path, int mode)
+{
+ path = chase_symlinks (map_w32_filename (path, NULL));
+ return chmod_worker (path, mode);
+}
+
+int
+lchmod (const char * path, mode_t mode)
+{
+ path = map_w32_filename (path, NULL);
+ return chmod_worker (path, mode);
+}
+
+int
sys_creat (const char * path, int mode)
{
path = map_w32_filename (path, NULL);
@@ -4592,12 +4614,55 @@ sys_open (const char * path, int oflag, int mode)
}
int
+openat (int fd, const char * path, int oflag, int mode)
+{
+ /* Rely on a hack: an open directory is modeled as file descriptor 0,
+ as in fstatat. FIXME: Add proper support for openat. */
+ char fullname[MAX_UTF8_PATH];
+
+ if (fd != AT_FDCWD)
+ {
+ if (_snprintf (fullname, sizeof fullname, "%s/%s", dir_pathname, path)
+ < 0)
+ {
+ errno = ENAMETOOLONG;
+ return -1;
+ }
+ path = fullname;
+ }
+
+ return sys_open (path, oflag, mode);
+}
+
+int
fchmod (int fd, mode_t mode)
{
return 0;
}
int
+fchmodat (int fd, char const *path, mode_t mode, int flags)
+{
+ /* Rely on a hack: an open directory is modeled as file descriptor 0,
+ as in fstatat. FIXME: Add proper support for fchmodat. */
+ char fullname[MAX_UTF8_PATH];
+
+ if (fd != AT_FDCWD)
+ {
+ if (_snprintf (fullname, sizeof fullname, "%s/%s", dir_pathname, path)
+ < 0)
+ {
+ errno = ENAMETOOLONG;
+ return -1;
+ }
+ path = fullname;
+ }
+
+ return
+ flags == AT_SYMLINK_NOFOLLOW ? lchmod (path, mode) : sys_chmod (path, mode);
+}
+
+int
sys_rename_replace (const char *oldname, const char *newname, BOOL force)
{
BOOL result;
@@ -4914,7 +4979,7 @@ convert_time (FILETIME ft)
}
static void
-convert_from_time_t (time_t time, FILETIME * pft)
+convert_from_timespec (struct timespec time, FILETIME * pft)
{
ULARGE_INTEGER tmp;
@@ -4925,7 +4990,8 @@ convert_from_time_t (time_t time, FILETIME * pft)
}
/* time in 100ns units since 1-Jan-1601 */
- tmp.QuadPart = (ULONGLONG) time * 10000000L + utc_base;
+ tmp.QuadPart =
+ (ULONGLONG) time.tv_sec * 10000000L + time.tv_nsec / 100 + utc_base;
pft->dwHighDateTime = tmp.HighPart;
pft->dwLowDateTime = tmp.LowPart;
}
@@ -5592,8 +5658,8 @@ fstatat (int fd, char const *name, struct stat *st, int flags)
return stat_worker (name, st, ! (flags & AT_SYMLINK_NOFOLLOW));
}
-/* Provide fstat and utime as well as stat for consistent handling of
- file timestamps. */
+/* Provide fstat and utimensat as well as stat for consistent handling
+ of file timestamps. */
int
fstat (int desc, struct stat * buf)
{
@@ -5704,23 +5770,65 @@ fstat (int desc, struct stat * buf)
return 0;
}
-/* A version of 'utime' which handles directories as well as
- files. */
+/* Emulate utimensat. */
int
-utime (const char *name, struct utimbuf *times)
+utimensat (int fd, const char *name, const struct timespec times[2], int flag)
{
- struct utimbuf deftime;
+ struct timespec ltimes[2];
HANDLE fh;
FILETIME mtime;
FILETIME atime;
+ DWORD flags_and_attrs = FILE_FLAG_BACKUP_SEMANTICS;
+
+ /* Rely on a hack: an open directory is modeled as file descriptor 0.
+ This is good enough for the current usage in Emacs, but is fragile.
+
+ FIXME: Add proper support for utimensat.
+ Gnulib does this and can serve as a model. */
+ char fullname[MAX_UTF8_PATH];
+
+ if (fd != AT_FDCWD)
+ {
+ char lastc = dir_pathname[strlen (dir_pathname) - 1];
+
+ if (_snprintf (fullname, sizeof fullname, "%s%s%s",
+ dir_pathname, IS_DIRECTORY_SEP (lastc) ? "" : "/", name)
+ < 0)
+ {
+ errno = ENAMETOOLONG;
+ return -1;
+ }
+ name = fullname;
+ }
if (times == NULL)
{
- deftime.modtime = deftime.actime = time (NULL);
- times = &deftime;
+ memset (ltimes, 0, sizeof (ltimes));
+ ltimes[0] = ltimes[1] = current_timespec ();
+ }
+ else
+ {
+ if (times[0].tv_nsec == UTIME_OMIT && times[1].tv_nsec == UTIME_OMIT)
+ return 0; /* nothing to do */
+ if ((times[0].tv_nsec != UTIME_NOW && times[0].tv_nsec != UTIME_OMIT
+ && !(0 <= times[0].tv_nsec && times[0].tv_nsec < 1000000000))
+ || (times[1].tv_nsec != UTIME_NOW && times[1].tv_nsec != UTIME_OMIT
+ && !(0 <= times[1].tv_nsec && times[1].tv_nsec < 1000000000)))
+ {
+ errno = EINVAL; /* reject invalid timespec values */
+ return -1;
+ }
+
+ memcpy (ltimes, times, sizeof (ltimes));
+ if (ltimes[0].tv_nsec == UTIME_NOW)
+ ltimes[0] = current_timespec ();
+ if (ltimes[1].tv_nsec == UTIME_NOW)
+ ltimes[1] = current_timespec ();
}
+ if (flag == AT_SYMLINK_NOFOLLOW)
+ flags_and_attrs |= FILE_FLAG_OPEN_REPARSE_POINT;
if (w32_unicode_filenames)
{
wchar_t name_utf16[MAX_PATH];
@@ -5734,7 +5842,7 @@ utime (const char *name, struct utimbuf *times)
allows other processes to delete files inside it,
while we have the directory open. */
FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
- 0, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ 0, OPEN_EXISTING, flags_and_attrs, NULL);
}
else
{
@@ -5745,13 +5853,26 @@ utime (const char *name, struct utimbuf *times)
fh = CreateFileA (name_ansi, FILE_WRITE_ATTRIBUTES,
FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
- 0, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ 0, OPEN_EXISTING, flags_and_attrs, NULL);
}
if (fh != INVALID_HANDLE_VALUE)
{
- convert_from_time_t (times->actime, &atime);
- convert_from_time_t (times->modtime, &mtime);
- if (!SetFileTime (fh, NULL, &atime, &mtime))
+ FILETIME *patime, *pmtime;
+ if (ltimes[0].tv_nsec == UTIME_OMIT)
+ patime = NULL;
+ else
+ {
+ convert_from_timespec (ltimes[0], &atime);
+ patime = &atime;
+ }
+ if (ltimes[1].tv_nsec == UTIME_OMIT)
+ pmtime = NULL;
+ else
+ {
+ convert_from_timespec (ltimes[1], &mtime);
+ pmtime = &mtime;
+ }
+ if (!SetFileTime (fh, NULL, patime, pmtime))
{
CloseHandle (fh);
errno = EACCES;
@@ -6685,16 +6806,16 @@ w32_copy_file (const char *from, const char *to,
FIXME? */
else if (!keep_time)
{
- struct timespec now;
+ struct timespec tnow[2];
DWORD attributes;
+ tnow[0] = tnow[1] = current_timespec ();
if (w32_unicode_filenames)
{
/* Ensure file is writable while its times are set. */
attributes = GetFileAttributesW (to_w);
SetFileAttributesW (to_w, attributes & ~FILE_ATTRIBUTE_READONLY);
- now = current_timespec ();
- if (set_file_times (-1, to, now, now))
+ if (utimensat (AT_FDCWD, to, tnow, 0))
{
/* Restore original attributes. */
SetFileAttributesW (to_w, attributes);
@@ -6709,8 +6830,7 @@ w32_copy_file (const char *from, const char *to,
{
attributes = GetFileAttributesA (to_a);
SetFileAttributesA (to_a, attributes & ~FILE_ATTRIBUTE_READONLY);
- now = current_timespec ();
- if (set_file_times (-1, to, now, now))
+ if (utimensat (AT_FDCWD, to, tnow, 0))
{
SetFileAttributesA (to_a, attributes);
if (acl)
@@ -10138,6 +10258,10 @@ term_ntproc (int ignored)
term_winsock ();
term_w32select ();
+
+#if HAVE_NATIVE_IMAGE_API
+ w32_gdiplus_shutdown ();
+#endif
}
void
diff --git a/src/w32.h b/src/w32.h
index b8655ec788c..1afb8ad0873 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -194,6 +194,7 @@ extern void syms_of_ntproc (void);
extern void syms_of_ntterm (void);
extern void dostounix_filename (register char *);
extern void unixtodos_filename (register char *);
+extern const char *map_w32_filename (const char *, const char **);
extern int filename_from_ansi (const char *, char *);
extern int filename_to_ansi (const char *, char *);
extern int filename_from_utf16 (const wchar_t *, char *);
@@ -221,6 +222,9 @@ extern void register_child (pid_t, int);
extern void sys_sleep (int);
extern int sys_link (const char *, const char *);
+extern int openat (int, const char *, int, int);
+extern int fchmodat (int, char const *, mode_t, int);
+extern int lchmod (char const *, mode_t);
/* Return total and free memory info. */
extern int w32_memory_info (unsigned long long *, unsigned long long *,
diff --git a/src/w32fns.c b/src/w32fns.c
index 2f01fb52e92..3134f678f39 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -80,7 +80,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
extern int w32_console_toggle_lock_key (int, Lisp_Object);
extern void w32_menu_display_help (HWND, HMENU, UINT, UINT);
extern void w32_free_menu_strings (HWND);
-extern const char *map_w32_filename (const char *, const char **);
#ifndef IDC_HAND
#define IDC_HAND MAKEINTRESOURCE(32649)
@@ -166,6 +165,10 @@ typedef HIMC (WINAPI * ImmGetContext_Proc) (IN HWND window);
typedef BOOL (WINAPI * ImmReleaseContext_Proc) (IN HWND wnd, IN HIMC context);
typedef BOOL (WINAPI * ImmSetCompositionWindow_Proc) (IN HIMC context,
IN COMPOSITIONFORM *form);
+/* For toggling IME status. */
+typedef BOOL (WINAPI * ImmGetOpenStatus_Proc) (IN HIMC);
+typedef BOOL (WINAPI * ImmSetOpenStatus_Proc) (IN HIMC, IN BOOL);
+
typedef HMONITOR (WINAPI * MonitorFromPoint_Proc) (IN POINT pt, IN DWORD flags);
typedef BOOL (WINAPI * GetMonitorInfo_Proc)
(IN HMONITOR monitor, OUT struct MONITOR_INFO* info);
@@ -185,6 +188,8 @@ typedef HRESULT (WINAPI *SetThreadDescription_Proc)
TrackMouseEvent_Proc track_mouse_event_fn = NULL;
ImmGetCompositionString_Proc get_composition_string_fn = NULL;
ImmGetContext_Proc get_ime_context_fn = NULL;
+ImmGetOpenStatus_Proc get_ime_open_status_fn = NULL;
+ImmSetOpenStatus_Proc set_ime_open_status_fn = NULL;
ImmReleaseContext_Proc release_ime_context_fn = NULL;
ImmSetCompositionWindow_Proc set_ime_composition_window_fn = NULL;
MonitorFromPoint_Proc monitor_from_point_fn = NULL;
@@ -859,161 +864,14 @@ x_to_w32_color (const char * colorname)
block_input ();
- if (colorname[0] == '#')
+ unsigned short r, g, b;
+ if (parse_color_spec (colorname, &r, &g, &b))
{
- /* Could be an old-style RGB Device specification. */
- int size = strlen (colorname + 1);
- char *color = alloca (size + 1);
-
- strcpy (color, colorname + 1);
- if (size == 3 || size == 6 || size == 9 || size == 12)
- {
- UINT colorval;
- int i, pos;
- pos = 0;
- size /= 3;
- colorval = 0;
-
- for (i = 0; i < 3; i++)
- {
- char *end;
- char t;
- unsigned long value;
-
- /* The check for 'x' in the following conditional takes into
- account the fact that strtol allows a "0x" in front of
- our numbers, and we don't. */
- if (!isxdigit (color[0]) || color[1] == 'x')
- break;
- t = color[size];
- color[size] = '\0';
- value = strtoul (color, &end, 16);
- color[size] = t;
- if (errno == ERANGE || end - color != size)
- break;
- switch (size)
- {
- case 1:
- value = value * 0x10;
- break;
- case 2:
- break;
- case 3:
- value /= 0x10;
- break;
- case 4:
- value /= 0x100;
- break;
- }
- colorval |= (value << pos);
- pos += 0x8;
- if (i == 2)
- {
- unblock_input ();
- XSETINT (ret, colorval);
- return ret;
- }
- color = end;
- }
- }
- }
- else if (strnicmp (colorname, "rgb:", 4) == 0)
- {
- const char *color;
- UINT colorval;
- int i, pos;
- pos = 0;
-
- colorval = 0;
- color = colorname + 4;
- for (i = 0; i < 3; i++)
- {
- char *end;
- unsigned long value;
-
- /* The check for 'x' in the following conditional takes into
- account the fact that strtol allows a "0x" in front of
- our numbers, and we don't. */
- if (!isxdigit (color[0]) || color[1] == 'x')
- break;
- value = strtoul (color, &end, 16);
- if (errno == ERANGE)
- break;
- switch (end - color)
- {
- case 1:
- value = value * 0x10 + value;
- break;
- case 2:
- break;
- case 3:
- value /= 0x10;
- break;
- case 4:
- value /= 0x100;
- break;
- default:
- value = ULONG_MAX;
- }
- if (value == ULONG_MAX)
- break;
- colorval |= (value << pos);
- pos += 0x8;
- if (i == 2)
- {
- if (*end != '\0')
- break;
- unblock_input ();
- XSETINT (ret, colorval);
- return ret;
- }
- if (*end != '/')
- break;
- color = end + 1;
- }
+ unblock_input ();
+ /* Throw away the low 8 bits and return 0xBBGGRR. */
+ return make_fixnum ((b & 0xff00) << 8 | (g & 0xff00) | r >> 8);
}
- else if (strnicmp (colorname, "rgbi:", 5) == 0)
- {
- /* This is an RGB Intensity specification. */
- const char *color;
- UINT colorval;
- int i, pos;
- pos = 0;
-
- colorval = 0;
- color = colorname + 5;
- for (i = 0; i < 3; i++)
- {
- char *end;
- double value;
- UINT val;
- value = strtod (color, &end);
- if (errno == ERANGE)
- break;
- if (value < 0.0 || value > 1.0)
- break;
- val = (UINT)(0x100 * value);
- /* We used 0x100 instead of 0xFF to give a continuous
- range between 0.0 and 1.0 inclusive. The next statement
- fixes the 1.0 case. */
- if (val == 0x100)
- val = 0xFF;
- colorval |= (val << pos);
- pos += 0x8;
- if (i == 2)
- {
- if (*end != '\0')
- break;
- unblock_input ();
- XSETINT (ret, colorval);
- return ret;
- }
- if (*end != '/')
- break;
- color = end + 1;
- }
- }
/* I am not going to attempt to handle any of the CIE color schemes
or TekHVC, since I don't know the algorithms for conversion to
RGB. */
@@ -1700,10 +1558,8 @@ w32_clear_under_internal_border (struct frame *f)
static void
w32_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
- int border;
-
- CHECK_TYPE_RANGED_INTEGER (int, arg);
- border = max (XFIXNUM (arg), 0);
+ int argval = check_integer_range (arg, INT_MIN, INT_MAX);
+ int border = max (argval, 0);
if (border != FRAME_INTERNAL_BORDER_WIDTH (f))
{
@@ -3307,6 +3163,7 @@ w32_name_of_message (UINT msg)
M (WM_EMACS_SETCURSOR),
M (WM_EMACS_SHOWCURSOR),
M (WM_EMACS_PAINT),
+ M (WM_EMACS_IME_STATUS),
M (WM_CHAR),
#undef M
{ 0, 0 }
@@ -3444,6 +3301,21 @@ w32_msg_pump (deferred_msg * msg_buf)
emacs_abort ();
}
break;
+ case WM_EMACS_IME_STATUS:
+ {
+ focus_window = GetFocus ();
+ if (!set_ime_open_status_fn || !focus_window)
+ break;
+
+ HIMC context = get_ime_context_fn (focus_window);
+ if (!context)
+ break;
+
+ set_ime_open_status_fn (context, msg.wParam != 0);
+ release_ime_context_fn (focus_window, context);
+ break;
+ }
+
#ifdef MSG_DEBUG
/* Broadcast messages make it here, so you need to be looking
for something in particular for this to be useful. */
@@ -3768,7 +3640,7 @@ get_wm_chars (HWND aWnd, int *buf, int buflen, int ignore_ctrl, int ctrl,
non-Emacs window with the same language environment, and using (dead)keys
there would change the value stored in the kernel, but not this value. */
/* A layout may emit deadkey=0. It looks like this would reset the state
- of the kernel's finite automaton (equivalent to emiting 0-length string,
+ of the kernel's finite automaton (equivalent to emitting 0-length string,
which is otherwise impossible in the dead-key map of a layout).
Be ready to treat the case when this delivers WM_(SYS)DEADCHAR. */
static int after_deadkey = -1;
@@ -3829,7 +3701,7 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam,
of w32_get_key_modifiers (). */
wmsg.dwModifiers = w32_kbd_mods_to_emacs (console_modifiers, wParam);
- /* What follows is just heuristics; the correct treatement requires
+ /* What follows is just heuristics; the correct treatment requires
non-destructive ToUnicode():
http://search.cpan.org/~ilyaz/UI-KeyboardLayout/lib/UI/KeyboardLayout.pm#Can_an_application_on_Windows_accept_keyboard_events?_Part_IV:_application-specific_modifiers
@@ -7129,7 +7001,7 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms)
Frame parameters may be changed if .Xdefaults contains
specifications for the default font. For example, if there is an
`Emacs.default.attributeBackground: pink', the `background-color'
- attribute of the frame get's set, which let's the internal border
+ attribute of the frame gets set, which let's the internal border
of the tooltip frame appear in pink. Prevent this. */
{
Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
@@ -7213,7 +7085,7 @@ compute_tip_xy (struct frame *f,
/* If multiple monitor support is available, constrain the tip onto
the current monitor. This improves the above by allowing negative
- co-ordinates if monitor positions are such that they are valid, and
+ coordinates if monitor positions are such that they are valid, and
snaps a tooltip onto a single monitor if we are close to the edge
where it would otherwise flow onto the other monitor (or into
nothingness if there is a gap in the overlap). */
@@ -8207,7 +8079,7 @@ operations:
\"pastelink\"
- create a shortcut in DOCUMENT (which must be a directory)
the file or directory whose name is in the clipboard.
- \"runas\" - run DOCUMENT, which must be an excutable file, with
+ \"runas\" - run DOCUMENT, which must be an executable file, with
elevated privileges (a.k.a. \"as Administrator\").
\"properties\"
- open the property sheet dialog for DOCUMENT.
@@ -8260,7 +8132,6 @@ a ShowWindow flag:
/* Encode filename, current directory and parameters. */
current_dir = GUI_ENCODE_FILE (current_dir);
document = GUI_ENCODE_FILE (document);
- doc_w = GUI_SDATA (document);
if (STRINGP (parameters))
{
parameters = GUI_ENCODE_SYSTEM (parameters);
@@ -8271,6 +8142,7 @@ a ShowWindow flag:
operation = GUI_ENCODE_SYSTEM (operation);
ops_w = GUI_SDATA (operation);
}
+ doc_w = GUI_SDATA (document);
result = (intptr_t) ShellExecuteW (NULL, ops_w, doc_w, params_w,
GUI_SDATA (current_dir),
(FIXNUMP (show_flag)
@@ -8355,7 +8227,7 @@ a ShowWindow flag:
handler = Ffind_file_name_handler (absdoc, Qfile_exists_p);
if (NILP (handler))
{
- Lisp_Object absdoc_encoded = ENCODE_FILE (absdoc);
+ Lisp_Object absdoc_encoded = Fcopy_sequence (ENCODE_FILE (absdoc));
if (faccessat (AT_FDCWD, SSDATA (absdoc_encoded), F_OK, AT_EACCESS) == 0)
{
@@ -9203,8 +9075,8 @@ The coordinates X and Y are interpreted in pixels relative to a position
UINT trail_num = 0;
BOOL ret = false;
- CHECK_TYPE_RANGED_INTEGER (int, x);
- CHECK_TYPE_RANGED_INTEGER (int, y);
+ int xval = check_integer_range (x, INT_MIN, INT_MAX);
+ int yval = check_integer_range (y, INT_MIN, INT_MAX);
block_input ();
/* When "mouse trails" are in effect, moving the mouse cursor
@@ -9213,7 +9085,7 @@ The coordinates X and Y are interpreted in pixels relative to a position
if (os_subtype == OS_NT
&& w32_major_version + w32_minor_version >= 6)
ret = SystemParametersInfo (SPI_GETMOUSETRAILS, 0, &trail_num, 0);
- SetCursorPos (XFIXNUM (x), XFIXNUM (y));
+ SetCursorPos (xval, yval);
if (ret)
SystemParametersInfo (SPI_SETMOUSETRAILS, trail_num, NULL, 0);
unblock_input ();
@@ -10220,6 +10092,51 @@ DEFUN ("w32-notification-close",
#endif /* WINDOWSNT && !HAVE_DBUS */
+DEFUN ("w32-get-ime-open-status",
+ Fw32_get_ime_open_status, Sw32_get_ime_open_status,
+ 0, 0, 0,
+ doc: /* Return non-nil if IME is active, otherwise return nil.
+
+IME, the MS-Windows Input Method Editor, can be active or inactive.
+This function returns non-nil if the IME is active, otherwise nil. */)
+ (void)
+{
+ struct frame *sf =
+ FRAMEP (selected_frame) && FRAME_LIVE_P (XFRAME (selected_frame))
+ ? XFRAME (selected_frame)
+ : NULL;
+
+ if (sf)
+ {
+ HWND current_window = FRAME_W32_WINDOW (sf);
+ HIMC context = get_ime_context_fn (current_window);
+ if (context)
+ {
+ BOOL retval = get_ime_open_status_fn (context);
+ release_ime_context_fn (current_window, context);
+
+ return retval ? Qt : Qnil;
+ }
+ }
+
+ return Qnil;
+}
+
+DEFUN ("w32-set-ime-open-status",
+ Fw32_set_ime_open_status, Sw32_set_ime_open_status,
+ 1, 1, 0,
+ doc: /* Open or close the IME according to STATUS.
+
+This function activates the IME, the MS-Windows Input Method Editor,
+if STATUS is non-nil, otherwise it deactivates the IME. */)
+ (Lisp_Object status)
+{
+ unsigned ime_status = NILP (status) ? 0 : 1;
+
+ PostThreadMessage (dwWindowsThreadId, WM_EMACS_IME_STATUS, ime_status, 0);
+ return Qnil;
+}
+
#ifdef WINDOWSNT
/***********************************************************************
@@ -10746,6 +10663,8 @@ tip frame. */);
defsubr (&Sw32_notification_notify);
defsubr (&Sw32_notification_close);
#endif
+ defsubr (&Sw32_get_ime_open_status);
+ defsubr (&Sw32_set_ime_open_status);
#ifdef WINDOWSNT
defsubr (&Sw32_read_registry);
@@ -11034,6 +10953,11 @@ globals_of_w32fns (void)
get_proc_addr (imm32_lib, "ImmReleaseContext");
set_ime_composition_window_fn = (ImmSetCompositionWindow_Proc)
get_proc_addr (imm32_lib, "ImmSetCompositionWindow");
+
+ get_ime_open_status_fn = (ImmGetOpenStatus_Proc)
+ get_proc_addr (imm32_lib, "ImmGetOpenStatus");
+ set_ime_open_status_fn = (ImmSetOpenStatus_Proc)
+ get_proc_addr (imm32_lib, "ImmSetOpenStatus");
}
HMODULE hm_kernel32 = GetModuleHandle ("kernel32.dll");
diff --git a/src/w32gui.h b/src/w32gui.h
index 5cc64287291..dfec1f08617 100644
--- a/src/w32gui.h
+++ b/src/w32gui.h
@@ -41,6 +41,12 @@ typedef struct _XImage
/* Optional RGBQUAD array for palette follows (see BITMAPINFO docs). */
} XImage;
+struct image;
+extern int w32_load_image (struct frame *f, struct image *img,
+ Lisp_Object spec_file, Lisp_Object spec_data);
+extern bool w32_can_use_native_image_api (Lisp_Object);
+extern void w32_gdiplus_shutdown (void);
+
#define FACE_DEFAULT (~0)
extern HINSTANCE hinst;
diff --git a/src/w32heap.c b/src/w32heap.c
index 3a6c7804675..ba3550b6e9b 100644
--- a/src/w32heap.c
+++ b/src/w32heap.c
@@ -597,6 +597,16 @@ free_after_dump_9x (void *ptr)
}
}
+void *
+sys_calloc (size_t number, size_t size)
+{
+ size_t nbytes = number * size;
+ void *ptr = (*the_malloc_fn) (nbytes);
+ if (ptr)
+ memset (ptr, 0, nbytes);
+ return ptr;
+}
+
#if defined HAVE_UNEXEC && defined ENABLE_CHECKING
void
report_temacs_memory_usage (void)
@@ -874,7 +884,7 @@ setrlimit (rlimit_resource_t rltype, const struct rlimit *rlp)
{
case RLIMIT_STACK:
case RLIMIT_NOFILE:
- /* We cannot modfy these limits, so we always fail. */
+ /* We cannot modify these limits, so we always fail. */
errno = EPERM;
break;
default:
diff --git a/src/w32image.c b/src/w32image.c
new file mode 100644
index 00000000000..70b2eb29b87
--- /dev/null
+++ b/src/w32image.c
@@ -0,0 +1,477 @@
+/* Implementation of MS-Windows native image API via the GDI+ library.
+
+Copyright (C) 2020 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
+
+/* Written by Juan Jose Garcia-Ripoll <juanjose.garciaripoll@gmail.com>. */
+
+#include <config.h>
+#include "lisp.h"
+#include "dispextern.h"
+#define COBJMACROS
+#ifdef MINGW_W64
+/* FIXME: Do we need to include objidl.h? */
+#include <objidl.h>
+#endif
+#include <wtypes.h>
+#include <gdiplus.h>
+#include <shlwapi.h>
+#include "w32common.h"
+#include "w32term.h"
+#ifdef WINDOWSNT
+#include "w32.h" /* for map_w32_filename, filename_to_utf16 */
+#endif
+#include "frame.h"
+#include "coding.h"
+
+#ifdef WINDOWSNT
+
+typedef GpStatus (WINGDIPAPI *GdiplusStartup_Proc)
+ (ULONG_PTR *, GdiplusStartupInput *, GdiplusStartupOutput *);
+typedef VOID (WINGDIPAPI *GdiplusShutdown_Proc) (ULONG_PTR);
+typedef GpStatus (WINGDIPAPI *GdipGetPropertyItemSize_Proc)
+ (GpImage *, PROPID, UINT *);
+typedef GpStatus (WINGDIPAPI *GdipGetPropertyItem_Proc)
+ (GpImage *, PROPID, UINT, PropertyItem *);
+typedef GpStatus (WINGDIPAPI *GdipImageGetFrameDimensionsCount_Proc)
+ (GpImage *, UINT *);
+typedef GpStatus (WINGDIPAPI *GdipImageGetFrameDimensionsList_Proc)
+ (GpImage *, GUID *, UINT);
+typedef GpStatus (WINGDIPAPI *GdipImageGetFrameCount_Proc)
+ (GpImage *, GDIPCONST GUID *, UINT *);
+typedef GpStatus (WINGDIPAPI *GdipImageSelectActiveFrame_Proc)
+ (GpImage*, GDIPCONST GUID *, UINT);
+typedef GpStatus (WINGDIPAPI *GdipCreateBitmapFromFile_Proc)
+ (WCHAR *, GpBitmap **);
+typedef GpStatus (WINGDIPAPI *GdipCreateBitmapFromStream_Proc)
+ (IStream *, GpBitmap **);
+typedef IStream * (WINAPI *SHCreateMemStream_Proc) (const BYTE *, UINT);
+typedef GpStatus (WINGDIPAPI *GdipCreateHBITMAPFromBitmap_Proc)
+ (GpBitmap *, HBITMAP *, ARGB);
+typedef GpStatus (WINGDIPAPI *GdipDisposeImage_Proc) (GpImage *);
+typedef GpStatus (WINGDIPAPI *GdipGetImageHeight_Proc) (GpImage *, UINT *);
+typedef GpStatus (WINGDIPAPI *GdipGetImageWidth_Proc) (GpImage *, UINT *);
+
+GdiplusStartup_Proc fn_GdiplusStartup;
+GdiplusShutdown_Proc fn_GdiplusShutdown;
+GdipGetPropertyItemSize_Proc fn_GdipGetPropertyItemSize;
+GdipGetPropertyItem_Proc fn_GdipGetPropertyItem;
+GdipImageGetFrameDimensionsCount_Proc fn_GdipImageGetFrameDimensionsCount;
+GdipImageGetFrameDimensionsList_Proc fn_GdipImageGetFrameDimensionsList;
+GdipImageGetFrameCount_Proc fn_GdipImageGetFrameCount;
+GdipImageSelectActiveFrame_Proc fn_GdipImageSelectActiveFrame;
+GdipCreateBitmapFromFile_Proc fn_GdipCreateBitmapFromFile;
+GdipCreateBitmapFromStream_Proc fn_GdipCreateBitmapFromStream;
+SHCreateMemStream_Proc fn_SHCreateMemStream;
+GdipCreateHBITMAPFromBitmap_Proc fn_GdipCreateHBITMAPFromBitmap;
+GdipDisposeImage_Proc fn_GdipDisposeImage;
+GdipGetImageHeight_Proc fn_GdipGetImageHeight;
+GdipGetImageWidth_Proc fn_GdipGetImageWidth;
+
+static bool
+gdiplus_init (void)
+{
+ HANDLE gdiplus_lib, shlwapi_lib;
+
+ if (!((gdiplus_lib = w32_delayed_load (Qgdiplus))
+ && (shlwapi_lib = w32_delayed_load (Qshlwapi))))
+ return false;
+
+ fn_GdiplusStartup = (GdiplusStartup_Proc)
+ get_proc_addr (gdiplus_lib, "GdiplusStartup");
+ if (!fn_GdiplusStartup)
+ return false;
+ fn_GdiplusShutdown = (GdiplusShutdown_Proc)
+ get_proc_addr (gdiplus_lib, "GdiplusShutdown");
+ if (!fn_GdiplusShutdown)
+ return false;
+ fn_GdipGetPropertyItemSize = (GdipGetPropertyItemSize_Proc)
+ get_proc_addr (gdiplus_lib, "GdipGetPropertyItemSize");
+ if (!fn_GdipGetPropertyItemSize)
+ return false;
+ fn_GdipGetPropertyItem = (GdipGetPropertyItem_Proc)
+ get_proc_addr (gdiplus_lib, "GdipGetPropertyItem");
+ if (!fn_GdipGetPropertyItem)
+ return false;
+ fn_GdipImageGetFrameDimensionsCount = (GdipImageGetFrameDimensionsCount_Proc)
+ get_proc_addr (gdiplus_lib, "GdipImageGetFrameDimensionsCount");
+ if (!fn_GdipImageGetFrameDimensionsCount)
+ return false;
+ fn_GdipImageGetFrameDimensionsList = (GdipImageGetFrameDimensionsList_Proc)
+ get_proc_addr (gdiplus_lib, "GdipImageGetFrameDimensionsList");
+ if (!fn_GdipImageGetFrameDimensionsList)
+ return false;
+ fn_GdipImageGetFrameCount = (GdipImageGetFrameCount_Proc)
+ get_proc_addr (gdiplus_lib, "GdipImageGetFrameCount");
+ if (!fn_GdipImageGetFrameCount)
+ return false;
+ fn_GdipImageSelectActiveFrame = (GdipImageSelectActiveFrame_Proc)
+ get_proc_addr (gdiplus_lib, "GdipImageSelectActiveFrame");
+ if (!fn_GdipImageSelectActiveFrame)
+ return false;
+ fn_GdipCreateBitmapFromFile = (GdipCreateBitmapFromFile_Proc)
+ get_proc_addr (gdiplus_lib, "GdipCreateBitmapFromFile");
+ if (!fn_GdipCreateBitmapFromFile)
+ return false;
+ fn_GdipCreateBitmapFromStream = (GdipCreateBitmapFromStream_Proc)
+ get_proc_addr (gdiplus_lib, "GdipCreateBitmapFromStream");
+ if (!fn_GdipCreateBitmapFromStream)
+ return false;
+ fn_GdipCreateHBITMAPFromBitmap = (GdipCreateHBITMAPFromBitmap_Proc)
+ get_proc_addr (gdiplus_lib, "GdipCreateHBITMAPFromBitmap");
+ if (!fn_GdipCreateHBITMAPFromBitmap)
+ return false;
+ fn_GdipDisposeImage = (GdipDisposeImage_Proc)
+ get_proc_addr (gdiplus_lib, "GdipDisposeImage");
+ if (!fn_GdipDisposeImage)
+ return false;
+ fn_GdipGetImageHeight = (GdipGetImageHeight_Proc)
+ get_proc_addr (gdiplus_lib, "GdipGetImageHeight");
+ if (!fn_GdipGetImageHeight)
+ return false;
+ fn_GdipGetImageWidth = (GdipGetImageWidth_Proc)
+ get_proc_addr (gdiplus_lib, "GdipGetImageWidth");
+ if (!fn_GdipGetImageWidth)
+ return false;
+ /* LOAD_DLL_FN (shlwapi_lib, SHCreateMemStream); */
+
+ /* The following terrible kludge is required to use native image API
+ on Windows before Vista, because SHCreateMemStream was not
+ exported by name in those versions, only by ordinal number. */
+ fn_SHCreateMemStream = (SHCreateMemStream_Proc)
+ get_proc_addr (shlwapi_lib, "SHCreateMemStream");
+ if (!fn_SHCreateMemStream)
+ {
+ fn_SHCreateMemStream = (SHCreateMemStream_Proc)
+ get_proc_addr (shlwapi_lib, MAKEINTRESOURCEA (12));
+ if (!fn_SHCreateMemStream)
+ return false;
+ }
+
+ return true;
+}
+
+# undef GdiplusStartup
+# undef GdiplusShutdown
+# undef GdipGetPropertyItemSize
+# undef GdipGetPropertyItem
+# undef GdipImageGetFrameDimensionsCount
+# undef GdipImageGetFrameDimensionsList
+# undef GdipImageGetFrameCount
+# undef GdipImageSelectActiveFrame
+# undef GdipCreateBitmapFromFile
+# undef GdipCreateBitmapFromStream
+# undef SHCreateMemStream
+# undef GdipCreateHBITMAPFromBitmap
+# undef GdipDisposeImage
+# undef GdipGetImageHeight
+# undef GdipGetImageWidth
+
+# define GdiplusStartup fn_GdiplusStartup
+# define GdiplusShutdown fn_GdiplusShutdown
+# define GdipGetPropertyItemSize fn_GdipGetPropertyItemSize
+# define GdipGetPropertyItem fn_GdipGetPropertyItem
+# define GdipImageGetFrameDimensionsCount fn_GdipImageGetFrameDimensionsCount
+# define GdipImageGetFrameDimensionsList fn_GdipImageGetFrameDimensionsList
+# define GdipImageGetFrameCount fn_GdipImageGetFrameCount
+# define GdipImageSelectActiveFrame fn_GdipImageSelectActiveFrame
+# define GdipCreateBitmapFromFile fn_GdipCreateBitmapFromFile
+# define GdipCreateBitmapFromStream fn_GdipCreateBitmapFromStream
+# define SHCreateMemStream fn_SHCreateMemStream
+# define GdipCreateHBITMAPFromBitmap fn_GdipCreateHBITMAPFromBitmap
+# define GdipDisposeImage fn_GdipDisposeImage
+# define GdipGetImageHeight fn_GdipGetImageHeight
+# define GdipGetImageWidth fn_GdipGetImageWidth
+
+#endif /* WINDOWSNT */
+
+static int gdip_initialized;
+static bool gdiplus_started;
+static ULONG_PTR token;
+static GdiplusStartupInput input;
+static GdiplusStartupOutput output;
+
+
+/* Initialize GDI+, return true if successful. */
+static bool
+gdiplus_startup (void)
+{
+ GpStatus status;
+
+ if (gdiplus_started)
+ return true;
+#ifdef WINDOWSNT
+ if (!gdip_initialized)
+ gdip_initialized = gdiplus_init () ? 1 : -1;
+#else
+ gdip_initialized = 1;
+#endif
+ if (gdip_initialized > 0)
+ {
+ input.GdiplusVersion = 1;
+ input.DebugEventCallback = NULL;
+ input.SuppressBackgroundThread = FALSE;
+ input.SuppressExternalCodecs = FALSE;
+
+ status = GdiplusStartup (&token, &input, &output);
+ if (status == Ok)
+ gdiplus_started = true;
+ return (status == Ok);
+ }
+ return false;
+}
+
+/* This is called from term_ntproc. */
+void
+w32_gdiplus_shutdown (void)
+{
+ if (gdiplus_started)
+ GdiplusShutdown (token);
+ gdiplus_started = false;
+}
+
+bool
+w32_can_use_native_image_api (Lisp_Object type)
+{
+ if (!w32_use_native_image_api)
+ return false;
+ if (!(EQ (type, Qjpeg)
+ || EQ (type, Qpng)
+ || EQ (type, Qgif)
+ || EQ (type, Qtiff)
+ || EQ (type, Qnative_image)))
+ {
+ /* GDI+ can also display BMP, Exif, ICON, WMF, and EMF images.
+ But we don't yet support these in image.c. */
+ return false;
+ }
+ return gdiplus_startup ();
+}
+
+enum PropertyItem_type {
+ PI_BYTE = 1,
+ PI_ASCIIZ = 2,
+ PI_USHORT = 3,
+ PI_ULONG = 4,
+ PI_ULONG_PAIR = 5,
+ PI_BYTE_ANY = 6,
+ PI_LONG = 7,
+ PI_LONG_PAIR = 10
+};
+
+static double
+decode_delay (PropertyItem *propertyItem, int frame)
+{
+ enum PropertyItem_type type = propertyItem[0].type;
+ unsigned long udelay;
+ double retval;
+
+ switch (type)
+ {
+ case PI_BYTE:
+ case PI_BYTE_ANY:
+ udelay = ((unsigned char *)propertyItem[0].value)[frame];
+ retval = udelay;
+ break;
+ case PI_USHORT:
+ udelay = ((unsigned short *)propertyItem[0].value)[frame];
+ retval = udelay;
+ break;
+ case PI_ULONG:
+ case PI_LONG: /* delay should always be positive */
+ udelay = ((unsigned long *)propertyItem[0].value)[frame];
+ retval = udelay;
+ break;
+ default:
+ /* This negative value will cause the caller to disregard the
+ delay if we cannot determine it reliably. */
+ add_to_log ("Invalid or unknown propertyItem type in w32image.c");
+ retval = -1.0;
+ }
+
+ return retval;
+}
+
+static double
+w32_frame_delay (GpBitmap *pBitmap, int frame)
+{
+ UINT size;
+ PropertyItem *propertyItem;
+ double delay = -1.0;
+
+ /* Assume that the image has a property item of type PropertyItemEquipMake.
+ Get the size of that property item. This can fail for multi-frame TIFF
+ images. */
+ GpStatus status = GdipGetPropertyItemSize (pBitmap, PropertyTagFrameDelay,
+ &size);
+
+ if (status == Ok)
+ {
+ /* Allocate a buffer to receive the property item. */
+ propertyItem = malloc (size);
+ if (propertyItem != NULL)
+ {
+ /* Get the property item. */
+ GdipGetPropertyItem (pBitmap, PropertyTagFrameDelay, size,
+ propertyItem);
+ delay = decode_delay (propertyItem, frame);
+ if (delay <= 0)
+ {
+ /* In GIF files, unfortunately, delay is only specified
+ for the first frame. */
+ delay = decode_delay (propertyItem, 0);
+ }
+ delay /= 100.0;
+ free (propertyItem);
+ }
+ }
+ return delay;
+}
+
+static GpStatus
+w32_select_active_frame (GpBitmap *pBitmap, int frame, int *nframes,
+ double *delay)
+{
+ UINT count, frameCount;
+ GUID pDimensionIDs[1];
+ GpStatus status = Ok;
+
+ status = GdipImageGetFrameDimensionsCount (pBitmap, &count);
+ frameCount = *nframes = 0;
+ *delay = -1.0;
+ if (count)
+ {
+ /* The following call will fill pDimensionIDs[0] with the
+ FrameDimensionTime GUID for GIF images, and
+ FrameDimensionPage GUID for other image types. Multi-page
+ GIF and TIFF images expect these values in the
+ GdipImageSelectActiveFrame call below. */
+ status = GdipImageGetFrameDimensionsList (pBitmap, pDimensionIDs, 1);
+ status = GdipImageGetFrameCount (pBitmap, &pDimensionIDs[0], &frameCount);
+ if (status == Ok && frameCount > 1)
+ {
+ if (frame < 0 || frame >= frameCount)
+ status = GenericError;
+ else
+ {
+ status = GdipImageSelectActiveFrame (pBitmap, &pDimensionIDs[0],
+ frame);
+ *delay = w32_frame_delay (pBitmap, frame);
+ *nframes = frameCount;
+ }
+ }
+ }
+ return status;
+}
+
+static ARGB
+w32_image_bg_color (struct frame *f, struct image *img)
+{
+ Lisp_Object specified_bg = Fplist_get (XCDR (img->spec), QCbackground);
+ Emacs_Color color;
+
+ /* If the user specified a color, try to use it; if not, use the
+ current frame background, ignoring any default background
+ color set by the image. */
+ if (STRINGP (specified_bg)
+ ? w32_defined_color (f, SSDATA (specified_bg), &color, false, false)
+ : (w32_query_frame_background_color (f, &color), true))
+ /* The user specified ':background', use that. */
+ {
+ DWORD red = (((DWORD) color.red) & 0xff00) << 8;
+ DWORD green = ((DWORD) color.green) & 0xff00;
+ DWORD blue = ((DWORD) color.blue) >> 8;
+ return (ARGB) (red | green | blue);
+ }
+ return (ARGB) 0xff000000;
+}
+
+int
+w32_load_image (struct frame *f, struct image *img,
+ Lisp_Object spec_file, Lisp_Object spec_data)
+{
+ GpStatus status = GenericError;
+ GpBitmap *pBitmap;
+ Lisp_Object metadata;
+
+ eassert (valid_image_p (img->spec));
+
+ /* This function only gets called if w32_gdiplus_startup was invoked
+ and succeeded. We have a valid token and GDI+ is active. */
+ if (STRINGP (spec_file))
+ {
+ const char *fn = map_w32_filename (SSDATA (spec_file), NULL);
+ wchar_t filename_w[MAX_PATH];
+ filename_to_utf16 (fn, filename_w);
+ status = GdipCreateBitmapFromFile (filename_w, &pBitmap);
+ }
+ else if (STRINGP (spec_data))
+ {
+ IStream *pStream = SHCreateMemStream ((BYTE *) SDATA (spec_data),
+ SBYTES (spec_data));
+ if (pStream != NULL)
+ {
+ status = GdipCreateBitmapFromStream (pStream, &pBitmap);
+ IStream_Release (pStream);
+ }
+ }
+
+ metadata = Qnil;
+ if (status == Ok)
+ {
+ /* In multiframe pictures, select the first frame. */
+ Lisp_Object lisp_index = Fplist_get (XCDR (img->spec), QCindex);
+ int index = FIXNATP (lisp_index) ? XFIXNAT (lisp_index) : 0;
+ int nframes;
+ double delay;
+ status = w32_select_active_frame (pBitmap, index, &nframes, &delay);
+ if (status == Ok)
+ {
+ if (nframes > 1)
+ metadata = Fcons (Qcount, Fcons (make_fixnum (nframes), metadata));
+ if (delay >= 0)
+ metadata = Fcons (Qdelay, Fcons (make_float (delay), metadata));
+ }
+ }
+
+ if (status == Ok)
+ {
+ ARGB bg_color = w32_image_bg_color (f, img);
+ Emacs_Pixmap pixmap;
+
+ status = GdipCreateHBITMAPFromBitmap (pBitmap, &pixmap, bg_color);
+ if (status == Ok)
+ {
+ UINT width, height;
+ GdipGetImageWidth (pBitmap, &width);
+ GdipGetImageHeight (pBitmap, &height);
+ img->width = width;
+ img->height = height;
+ img->pixmap = pixmap;
+ img->lisp_data = metadata;
+ }
+
+ GdipDisposeImage (pBitmap);
+ }
+
+ if (status != Ok)
+ {
+ add_to_log ("Unable to load image %s", img->spec);
+ return 0;
+ }
+ return 1;
+}
diff --git a/src/w32menu.c b/src/w32menu.c
index e076043f7b7..da2db78a940 100644
--- a/src/w32menu.c
+++ b/src/w32menu.c
@@ -1485,7 +1485,7 @@ w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
crash Emacs when we try to display those "strings". It
is unclear why we get these dwItemData, or what they are:
sometimes they point to a wchar_t string that is the menu
- title, sometimes to someting that doesn't look like text
+ title, sometimes to something that doesn't look like text
at all. (The problematic data also comes with the 0x0800
bit set, but this bit is not documented, so we don't want
to depend on it.) */
diff --git a/src/w32proc.c b/src/w32proc.c
index 62d7377130f..c50f246a454 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -3231,7 +3231,7 @@ such programs cannot be invoked by Emacs anyway. */)
char *progname, progname_a[MAX_PATH];
program = Fexpand_file_name (program, Qnil);
- encoded_progname = ENCODE_FILE (program);
+ encoded_progname = Fcopy_sequence (ENCODE_FILE (program));
progname = SSDATA (encoded_progname);
unixtodos_filename (progname);
filename_to_ansi (progname, progname_a);
diff --git a/src/w32term.c b/src/w32term.c
index 76cf6bd6964..e0618e4f52d 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -888,10 +888,10 @@ static void w32_draw_image_foreground_1 (struct glyph_string *, HBITMAP);
static void w32_clear_glyph_string_rect (struct glyph_string *, int,
int, int, int);
static void w32_draw_relief_rect (struct frame *, int, int, int, int,
- int, int, int, int, int, int,
+ int, int, int, int, int, int, int,
RECT *);
static void w32_draw_box_rect (struct glyph_string *, int, int, int, int,
- int, bool, bool, RECT *);
+ int, int, bool, bool, RECT *);
/* Set S->gc to a suitable GC for drawing glyph string S in cursor
@@ -1101,19 +1101,28 @@ w32_set_glyph_string_clipping_exactly (struct glyph_string *src,
static void
w32_compute_glyph_string_overhangs (struct glyph_string *s)
{
- if (s->cmp == NULL
- && s->first_glyph->type == CHAR_GLYPH
- && !s->font_not_found_p)
+ if (s->cmp == NULL)
{
- struct font *font = s->font;
struct font_metrics metrics;
+ if (s->first_glyph->type == CHAR_GLYPH && !s->font_not_found_p)
+ {
+ struct font *font = s->font;
+ font->driver->text_extents (font, s->char2b, s->nchars, &metrics);
+ s->right_overhang = (metrics.rbearing > metrics.width
+ ? metrics.rbearing - metrics.width : 0);
+ s->left_overhang = metrics.lbearing < 0 ? -metrics.lbearing : 0;
+ }
+ else if (s->first_glyph->type == COMPOSITE_GLYPH)
+ {
+ Lisp_Object gstring = composition_gstring_from_id (s->cmp_id);
- font->driver->text_extents (font, s->char2b, s->nchars, &metrics);
- s->right_overhang = (metrics.rbearing > metrics.width
- ? metrics.rbearing - metrics.width : 0);
- s->left_overhang = metrics.lbearing < 0 ? -metrics.lbearing : 0;
+ composition_gstring_width (gstring, s->cmp_from, s->cmp_to, &metrics);
+ s->right_overhang = (metrics.rbearing > metrics.width
+ ? metrics.rbearing - metrics.width : 0);
+ s->left_overhang = metrics.lbearing < 0 ? -metrics.lbearing : 0;
+ }
}
- else if (s->cmp)
+ else
{
s->right_overhang = s->cmp->rbearing - s->cmp->pixel_width;
s->left_overhang = -s->cmp->lbearing;
@@ -1160,7 +1169,7 @@ w32_draw_glyph_string_background (struct glyph_string *s, bool force_p)
shouldn't be drawn in the first place. */
if (!s->background_filled_p)
{
- int box_line_width = max (s->face->box_line_width, 0);
+ int box_line_width = max (s->face->box_horizontal_line_width, 0);
#if 0 /* TODO: stipple */
if (s->stippled_p)
@@ -1206,7 +1215,7 @@ w32_draw_glyph_string_foreground (struct glyph_string *s)
of S to the right of that box line. */
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -1264,7 +1273,7 @@ w32_draw_composite_glyph_string_foreground (struct glyph_string *s)
of S to the right of that box line. */
if (s->face && s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -1361,7 +1370,7 @@ w32_draw_glyphless_glyph_string_foreground (struct glyph_string *s)
of S to the right of that box line. */
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -1529,7 +1538,7 @@ w32_query_colors (struct frame *f, Emacs_Color *colors, int ncolors)
/* Store F's background color into *BGCOLOR. */
-static void
+void
w32_query_frame_background_color (struct frame *f, Emacs_Color *bgcolor)
{
bgcolor->pixel = FRAME_BACKGROUND_PIXEL (f);
@@ -1617,7 +1626,7 @@ w32_setup_relief_colors (struct glyph_string *s)
static void
w32_draw_relief_rect (struct frame *f,
int left_x, int top_y, int right_x, int bottom_y,
- int width, int raised_p,
+ int hwidth, int vwidth, int raised_p,
int top_p, int bot_p, int left_p, int right_p,
RECT *clip_rect)
{
@@ -1634,14 +1643,14 @@ w32_draw_relief_rect (struct frame *f,
/* Top. */
if (top_p)
- for (i = 0; i < width; ++i)
+ for (i = 0; i < hwidth; ++i)
w32_fill_area (f, hdc, gc.foreground,
left_x + i * left_p, top_y + i,
right_x - left_x - i * (left_p + right_p ) + 1, 1);
/* Left. */
if (left_p)
- for (i = 0; i < width; ++i)
+ for (i = 0; i < vwidth; ++i)
w32_fill_area (f, hdc, gc.foreground,
left_x + i, top_y + (i + 1) * top_p, 1,
bottom_y - top_y - (i + 1) * (bot_p + top_p) + 1);
@@ -1653,14 +1662,14 @@ w32_draw_relief_rect (struct frame *f,
/* Bottom. */
if (bot_p)
- for (i = 0; i < width; ++i)
+ for (i = 0; i < hwidth; ++i)
w32_fill_area (f, hdc, gc.foreground,
left_x + i * left_p, bottom_y - i,
right_x - left_x - i * (left_p + right_p) + 1, 1);
/* Right. */
if (right_p)
- for (i = 0; i < width; ++i)
+ for (i = 0; i < vwidth; ++i)
w32_fill_area (f, hdc, gc.foreground,
right_x - i, top_y + (i + 1) * top_p, 1,
bottom_y - top_y - (i + 1) * (bot_p + top_p) + 1);
@@ -1680,31 +1689,31 @@ w32_draw_relief_rect (struct frame *f,
static void
w32_draw_box_rect (struct glyph_string *s,
- int left_x, int top_y, int right_x, int bottom_y, int width,
- bool left_p, bool right_p, RECT *clip_rect)
+ int left_x, int top_y, int right_x, int bottom_y, int hwidth,
+ int vwidth, bool left_p, bool right_p, RECT *clip_rect)
{
w32_set_clip_rectangle (s->hdc, clip_rect);
/* Top. */
w32_fill_area (s->f, s->hdc, s->face->box_color,
- left_x, top_y, right_x - left_x + 1, width);
+ left_x, top_y, right_x - left_x + 1, hwidth);
/* Left. */
if (left_p)
{
w32_fill_area (s->f, s->hdc, s->face->box_color,
- left_x, top_y, width, bottom_y - top_y + 1);
+ left_x, top_y, vwidth, bottom_y - top_y + 1);
}
/* Bottom. */
w32_fill_area (s->f, s->hdc, s->face->box_color,
- left_x, bottom_y - width + 1, right_x - left_x + 1, width);
+ left_x, bottom_y - hwidth + 1, right_x - left_x + 1, hwidth);
/* Right. */
if (right_p)
{
w32_fill_area (s->f, s->hdc, s->face->box_color,
- right_x - width + 1, top_y, width, bottom_y - top_y + 1);
+ right_x - vwidth + 1, top_y, vwidth, bottom_y - top_y + 1);
}
w32_set_clip_rectangle (s->hdc, NULL);
@@ -1716,7 +1725,7 @@ w32_draw_box_rect (struct glyph_string *s,
static void
w32_draw_glyph_string_box (struct glyph_string *s)
{
- int width, left_x, right_x, top_y, bottom_y, last_x;
+ int hwidth, vwidth, left_x, right_x, top_y, bottom_y, last_x;
bool left_p, right_p, raised_p;
struct glyph *last_glyph;
RECT clip_rect;
@@ -1725,12 +1734,29 @@ w32_draw_glyph_string_box (struct glyph_string *s)
? WINDOW_RIGHT_EDGE_X (s->w)
: window_box_right (s->w, s->area));
- /* The glyph that may have a right box line. */
- last_glyph = (s->cmp || s->img
- ? s->first_glyph
- : s->first_glyph + s->nchars - 1);
+ /* The glyph that may have a right box line. For static
+ compositions and images, the right-box flag is on the first glyph
+ of the glyph string; for other types it's on the last glyph. */
+ if (s->cmp || s->img)
+ last_glyph = s->first_glyph;
+ else if (s->first_glyph->type == COMPOSITE_GLYPH
+ && s->first_glyph->u.cmp.automatic)
+ {
+ /* For automatic compositions, we need to look up the last glyph
+ in the composition. */
+ struct glyph *end = s->row->glyphs[s->area] + s->row->used[s->area];
+ struct glyph *g = s->first_glyph;
+ for (last_glyph = g++;
+ g < end && g->u.cmp.automatic && g->u.cmp.id == s->cmp_id
+ && g->slice.cmp.to < s->cmp_to;
+ last_glyph = g++)
+ ;
+ }
+ else
+ last_glyph = s->first_glyph + s->nchars - 1;
- width = eabs (s->face->box_line_width);
+ vwidth = eabs (s->face->box_vertical_line_width);
+ hwidth = eabs (s->face->box_horizontal_line_width);
raised_p = s->face->box == FACE_RAISED_BOX;
left_x = s->x;
right_x = ((s->row->full_width_p && s->extends_to_end_of_line_p
@@ -1751,13 +1777,13 @@ w32_draw_glyph_string_box (struct glyph_string *s)
get_glyph_string_clip_rect (s, &clip_rect);
if (s->face->box == FACE_SIMPLE_BOX)
- w32_draw_box_rect (s, left_x, top_y, right_x, bottom_y, width,
- left_p, right_p, &clip_rect);
+ w32_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth,
+ vwidth, left_p, right_p, &clip_rect);
else
{
w32_setup_relief_colors (s);
- w32_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y,
- width, raised_p, 1, 1, left_p, right_p, &clip_rect);
+ w32_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y, hwidth,
+ vwidth, raised_p, 1, 1, left_p, right_p, &clip_rect);
}
}
@@ -1795,7 +1821,7 @@ w32_draw_image_foreground (struct glyph_string *s)
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
- x += eabs (s->face->box_line_width);
+ x += max (s->face->box_vertical_line_width, 0);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
@@ -1982,7 +2008,7 @@ w32_draw_image_relief (struct glyph_string *s)
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
- x += eabs (s->face->box_line_width);
+ x += max (s->face->box_vertical_line_width, 0);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
@@ -2034,7 +2060,7 @@ w32_draw_image_relief (struct glyph_string *s)
w32_setup_relief_colors (s);
get_glyph_string_clip_rect (s, &r);
- w32_draw_relief_rect (s->f, x, y, x1, y1, thick, raised_p,
+ w32_draw_relief_rect (s->f, x, y, x1, y1, thick, thick, raised_p,
top_p, bot_p, left_p, right_p, &r);
}
@@ -2054,7 +2080,7 @@ w32_draw_image_foreground_1 (struct glyph_string *s, HBITMAP pixmap)
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
- x += eabs (s->face->box_line_width);
+ x += max (s->face->box_vertical_line_width, 0);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
@@ -2167,8 +2193,8 @@ static void
w32_draw_image_glyph_string (struct glyph_string *s)
{
int x, y;
- int box_line_hwidth = eabs (s->face->box_line_width);
- int box_line_vwidth = max (s->face->box_line_width, 0);
+ int box_line_hwidth = max (s->face->box_vertical_line_width, 0);
+ int box_line_vwidth = max (s->face->box_horizontal_line_width, 0);
int height, width;
HBITMAP pixmap = 0;
@@ -5452,15 +5478,15 @@ w32_read_socket (struct terminal *terminal,
/* Windows can send us a SIZE_MAXIMIZED message even
when fullscreen is fullboth. The following is a
simple hack to check that based on the fact that
- only a maximized fullscreen frame should have both
- top/left outside the screen. */
+ only a maximized fullscreen frame should have top
+ or left outside the screen. */
if (EQ (fullscreen, Qfullwidth) || EQ (fullscreen, Qfullheight)
|| NILP (fullscreen))
{
int x, y;
w32_real_positions (f, &x, &y);
- if (x < 0 && y < 0)
+ if (x < 0 || y < 0)
store_frame_param (f, Qfullscreen, Qmaximized);
}
}
@@ -6851,7 +6877,7 @@ w32_make_frame_visible (struct frame *f)
/* According to a report in emacs-devel 2008-06-03, SW_SHOWNORMAL
causes unexpected behavior when unminimizing frames that were
previously maximized. But only SW_SHOWNORMAL works properly for
- frames that were truely hidden (using make-frame-invisible), so
+ frames that were truly hidden (using make-frame-invisible), so
we need it to avoid Bug#5482. It seems that iconified is only
set for minimized windows that are still visible, so use that to
determine the appropriate flag to pass ShowWindow. */
@@ -7657,6 +7683,25 @@ Windows 8. It is set to nil on Windows 9X. */);
else
w32_unicode_filenames = 1;
+ DEFVAR_BOOL ("w32-use-native-image-API",
+ w32_use_native_image_api,
+ doc: /* Non-nil means use the native MS-Windows image API to display images.
+
+A value of nil means displaying images other than PBM and XBM requires
+optional supporting libraries to be installed.
+The native image API library used is GDI+ via GDIPLUS.DLL. This
+library is available only since W2K, therefore this variable is
+unconditionally set to nil on older systems. */);
+
+ /* For now, disabled by default, since this is an experimental feature. */
+#if 0 && HAVE_NATIVE_IMAGE_API
+ if (os_subtype == OS_9X)
+ w32_use_native_image_api = 0;
+ else
+ w32_use_native_image_api = 1;
+#else
+ w32_use_native_image_api = 0;
+#endif
/* FIXME: The following variable will be (hopefully) removed
before Emacs 25.1 gets released. */
diff --git a/src/w32term.h b/src/w32term.h
index f8a8a727e8a..694493c6c82 100644
--- a/src/w32term.h
+++ b/src/w32term.h
@@ -75,7 +75,6 @@ struct w32_palette_entry {
extern void w32_regenerate_palette (struct frame *f);
extern void w32_fullscreen_rect (HWND hwnd, int fsmode, RECT normal,
RECT *rect);
-
/* For each display (currently only one on w32), we have a structure that
records information about it. */
@@ -248,6 +247,8 @@ extern int w32_display_pixel_height (struct w32_display_info *);
extern int w32_display_pixel_width (struct w32_display_info *);
extern void initialize_frame_menubar (struct frame *);
extern void w32_dialog_in_progress (Lisp_Object in_progress);
+extern void w32_query_frame_background_color (struct frame *f,
+ Emacs_Color *bgcolor);
extern void w32_make_frame_visible (struct frame *f);
extern void w32_make_frame_invisible (struct frame *f);
@@ -475,7 +476,7 @@ struct scroll_bar {
editing large files, we establish a minimum height by always
drawing handle bottoms VERTICAL_SCROLL_BAR_MIN_HANDLE pixels below
where they would be normally; the bottom and top are in a
- different co-ordinate system. */
+ different coordinate system. */
int start, end;
/* If the scroll bar handle is currently being dragged by the user,
@@ -670,7 +671,8 @@ do { \
#define WM_EMACS_BRINGTOTOP (WM_EMACS_START + 23)
#define WM_EMACS_INPUT_READY (WM_EMACS_START + 24)
#define WM_EMACS_FILENOTIFY (WM_EMACS_START + 25)
-#define WM_EMACS_END (WM_EMACS_START + 26)
+#define WM_EMACS_IME_STATUS (WM_EMACS_START + 26)
+#define WM_EMACS_END (WM_EMACS_START + 27)
#define WND_FONTWIDTH_INDEX (0)
#define WND_LINEHEIGHT_INDEX (4)
diff --git a/src/window.c b/src/window.c
index ff17cd88f38..e7433969d29 100644
--- a/src/window.c
+++ b/src/window.c
@@ -1895,10 +1895,7 @@ POS, ROWH is the visible height of that row, and VPOS is the row number
if (EQ (pos, Qt))
posint = -1;
else if (!NILP (pos))
- {
- CHECK_FIXNUM_COERCE_MARKER (pos);
- posint = XFIXNUM (pos);
- }
+ posint = fix_position (pos);
else if (w == XWINDOW (selected_window))
posint = PT;
else
@@ -2111,30 +2108,20 @@ though when run from an idle timer with a delay of zero seconds. */)
|| window_outdated (w))
return Qnil;
- if (NILP (first))
- row = (NILP (body)
- ? MATRIX_ROW (w->current_matrix, 0)
- : MATRIX_FIRST_TEXT_ROW (w->current_matrix));
- else if (FIXNUMP (first))
- {
- CHECK_RANGED_INTEGER (first, 0, w->current_matrix->nrows);
- row = MATRIX_ROW (w->current_matrix, XFIXNUM (first));
- }
- else
- error ("Invalid specification of first line");
-
- if (NILP (last))
-
- end_row = (NILP (body)
- ? MATRIX_ROW (w->current_matrix, w->current_matrix->nrows)
- : MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w));
- else if (FIXNUMP (last))
- {
- CHECK_RANGED_INTEGER (last, 0, w->current_matrix->nrows);
- end_row = MATRIX_ROW (w->current_matrix, XFIXNUM (last));
- }
- else
- error ("Invalid specification of last line");
+ row = (!NILP (first)
+ ? MATRIX_ROW (w->current_matrix,
+ check_integer_range (first, 0,
+ w->current_matrix->nrows))
+ : NILP (body)
+ ? MATRIX_ROW (w->current_matrix, 0)
+ : MATRIX_FIRST_TEXT_ROW (w->current_matrix));
+ end_row = (!NILP (last)
+ ? MATRIX_ROW (w->current_matrix,
+ check_integer_range (last, 0,
+ w->current_matrix->nrows))
+ : NILP (body)
+ ? MATRIX_ROW (w->current_matrix, w->current_matrix->nrows)
+ : MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w));
while (row <= end_row && row->enabled_p
&& row->y + row->height < max_y)
@@ -4328,11 +4315,11 @@ Note: This function does not operate on any child windows of WINDOW. */)
EMACS_INT size_min = NILP (add) ? 0 : - XFIXNUM (w->new_pixel);
EMACS_INT size_max = size_min + min (INT_MAX, MOST_POSITIVE_FIXNUM);
- CHECK_RANGED_INTEGER (size, size_min, size_max);
+ int checked_size = check_integer_range (size, size_min, size_max);
if (NILP (add))
wset_new_pixel (w, size);
else
- wset_new_pixel (w, make_fixnum (XFIXNUM (w->new_pixel) + XFIXNUM (size)));
+ wset_new_pixel (w, make_fixnum (XFIXNUM (w->new_pixel) + checked_size));
return w->new_pixel;
}
@@ -5475,7 +5462,7 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror)
wset_redisplay (XWINDOW (window));
- if (whole && Vfast_but_imprecise_scrolling)
+ if (whole && fast_but_imprecise_scrolling)
specbind (Qfontification_functions, Qnil);
/* On GUI frames, use the pixel-based version which is much slower
@@ -7478,7 +7465,7 @@ saved by this function. */)
data->minibuf_selected_window = minibuf_level > 0 ? minibuf_selected_window : Qnil;
data->root_window = FRAME_ROOT_WINDOW (f);
data->focus_frame = FRAME_FOCUS_FRAME (f);
- Lisp_Object tem = make_uninit_vector (n_windows);
+ Lisp_Object tem = make_nil_vector (n_windows);
data->saved_windows = tem;
for (ptrdiff_t i = 0; i < n_windows; i++)
ASET (tem, i, make_nil_vector (VECSIZE (struct saved_window)));
@@ -7509,8 +7496,7 @@ extract_dimension (Lisp_Object dimension)
{
if (NILP (dimension))
return -1;
- CHECK_RANGED_INTEGER (dimension, 0, INT_MAX);
- return XFIXNUM (dimension);
+ return check_integer_range (dimension, 0, INT_MAX);
}
static struct window *
@@ -7976,19 +7962,17 @@ foreach_window_1 (struct window *w, bool (*fn) (struct window *, void *),
/* Return true if window configurations CONFIGURATION1 and CONFIGURATION2
describe the same state of affairs. This is used by Fequal.
- IGNORE_POSITIONS means ignore non-matching scroll positions
- and the like.
+ Ignore non-matching scroll positions and the like.
This ignores a couple of things like the dedication status of
window, combination_limit and the like. This might have to be
fixed. */
-bool
+static bool
compare_window_configurations (Lisp_Object configuration1,
- Lisp_Object configuration2,
- bool ignore_positions)
+ Lisp_Object configuration2)
{
- register struct save_window_data *d1, *d2;
+ struct save_window_data *d1, *d2;
struct Lisp_Vector *sws1, *sws2;
ptrdiff_t i;
@@ -8006,9 +7990,6 @@ compare_window_configurations (Lisp_Object configuration1,
|| d1->frame_menu_bar_lines != d2->frame_menu_bar_lines
|| !EQ (d1->selected_frame, d2->selected_frame)
|| !EQ (d1->f_current_buffer, d2->f_current_buffer)
- || (!ignore_positions
- && (!EQ (d1->minibuf_scroll_window, d2->minibuf_scroll_window)
- || !EQ (d1->minibuf_selected_window, d2->minibuf_selected_window)))
|| !EQ (d1->focus_frame, d2->focus_frame)
/* Verify that the two configurations have the same number of windows. */
|| sws1->header.size != sws2->header.size)
@@ -8041,12 +8022,6 @@ compare_window_configurations (Lisp_Object configuration1,
equality. */
|| !EQ (sw1->parent, sw2->parent)
|| !EQ (sw1->prev, sw2->prev)
- || (!ignore_positions
- && (!EQ (sw1->hscroll, sw2->hscroll)
- || !EQ (sw1->min_hscroll, sw2->min_hscroll)
- || !EQ (sw1->start_at_line_beg, sw2->start_at_line_beg)
- || NILP (Fequal (sw1->start, sw2->start))
- || NILP (Fequal (sw1->pointm, sw2->pointm))))
|| !EQ (sw1->left_margin_cols, sw2->left_margin_cols)
|| !EQ (sw1->right_margin_cols, sw2->right_margin_cols)
|| !EQ (sw1->left_fringe_width, sw2->left_fringe_width)
@@ -8071,7 +8046,7 @@ This function ignores details such as the values of point
and scrolling positions. */)
(Lisp_Object x, Lisp_Object y)
{
- if (compare_window_configurations (x, y, true))
+ if (compare_window_configurations (x, y))
return Qt;
return Qnil;
}
@@ -8423,7 +8398,7 @@ pixelwise even if this option is nil. */);
window_resize_pixelwise = false;
DEFVAR_BOOL ("fast-but-imprecise-scrolling",
- Vfast_but_imprecise_scrolling,
+ fast_but_imprecise_scrolling,
doc: /* When non-nil, accelerate scrolling operations.
This comes into play when scrolling rapidly over previously
unfontified buffer regions. Only those portions of the buffer which
@@ -8431,7 +8406,7 @@ are actually going to be displayed get fontified.
Note that this optimization can cause the portion of the buffer
displayed after a scrolling operation to be somewhat inaccurate. */);
- Vfast_but_imprecise_scrolling = false;
+ fast_but_imprecise_scrolling = false;
defsubr (&Sselected_window);
defsubr (&Sold_selected_window);
diff --git a/src/window.h b/src/window.h
index aa8d2c8d1d2..167d1be7abb 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1184,7 +1184,6 @@ extern Lisp_Object window_list (void);
extern Lisp_Object window_parameter (struct window *, Lisp_Object parameter);
extern struct window *decode_live_window (Lisp_Object);
extern struct window *decode_any_window (Lisp_Object);
-extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool);
extern void mark_window_cursors_off (struct window *);
extern bool window_wants_mode_line (struct window *);
extern bool window_wants_header_line (struct window *);
diff --git a/src/xdisp.c b/src/xdisp.c
index 2af6144975a..d9101592b2a 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -447,6 +447,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "termchar.h"
#include "dispextern.h"
#include "character.h"
+#include "category.h"
#include "buffer.h"
#include "charset.h"
#include "indent.h"
@@ -508,13 +509,87 @@ static Lisp_Object list_of_error;
&& (*BYTE_POS_ADDR (IT_BYTEPOS (*it)) == ' ' \
|| *BYTE_POS_ADDR (IT_BYTEPOS (*it)) == '\t'))))
+/* These are the category sets we use. They are defined by
+ kinsoku.el and characters.el. */
+#define NOT_AT_EOL '<'
+#define NOT_AT_BOL '>'
+#define LINE_BREAKABLE '|'
+
+static bool
+it_char_has_category(struct it *it, int cat)
+{
+ int ch = 0;
+ if (it->what == IT_CHARACTER)
+ ch = it->c;
+ else if (STRINGP (it->string))
+ ch = SREF (it->string, IT_STRING_BYTEPOS (*it));
+ else if (it->s)
+ ch = it->s[IT_BYTEPOS (*it)];
+ else if (IT_BYTEPOS (*it) < ZV_BYTE)
+ ch = *BYTE_POS_ADDR (IT_BYTEPOS (*it));
+
+ if (ch == 0)
+ return false;
+ else
+ return CHAR_HAS_CATEGORY (ch, cat);
+}
+
+/* Return true if the current character allows wrapping before it. */
+static bool
+char_can_wrap_before (struct it *it)
+{
+ if (!word_wrap_by_category)
+ return !IT_DISPLAYING_WHITESPACE (it);
+
+ /* For CJK (LTR) text in RTL paragraph, EOL and BOL are flipped.
+ Because in RTL paragraph, each glyph is prepended to the last
+ one, effectively drawing right to left. */
+ int not_at_bol;
+ if (it->glyph_row && it->glyph_row->reversed_p)
+ not_at_bol = NOT_AT_EOL;
+ else
+ not_at_bol = NOT_AT_BOL;
+ /* You cannot wrap before a space or tab because that way you'll
+ have space and tab at the beginning of next line. */
+ return (!IT_DISPLAYING_WHITESPACE (it)
+ /* Can be at BOL. */
+ && !it_char_has_category (it, not_at_bol));
+}
+
+/* Return true if the current character allows wrapping after it. */
+static bool
+char_can_wrap_after (struct it *it)
+{
+ if (!word_wrap_by_category)
+ return IT_DISPLAYING_WHITESPACE (it);
+
+ /* For CJK (LTR) text in RTL paragraph, EOL and BOL are flipped.
+ Because in RTL paragraph, each glyph is prepended to the last
+ one, effectively drawing right to left. */
+ int not_at_eol;
+ if (it->glyph_row && it->glyph_row->reversed_p)
+ not_at_eol = NOT_AT_BOL;
+ else
+ not_at_eol = NOT_AT_EOL;
+
+ return (IT_DISPLAYING_WHITESPACE (it)
+ /* Can break after && can be at EOL. */
+ || (it_char_has_category (it, LINE_BREAKABLE)
+ && !it_char_has_category (it, not_at_eol)));
+}
+
+#undef IT_DISPLAYING_WHITESPACE
+#undef NOT_AT_EOL
+#undef NOT_AT_BOL
+#undef LINE_BREAKABLE
+
/* If all the conditions needed to print the fill column indicator are
met, return the (nonnegative) column number, else return a negative
value. */
static int
fill_column_indicator_column (struct it *it, int char_width)
{
- if (Vdisplay_fill_column_indicator
+ if (display_fill_column_indicator
&& !it->w->pseudo_window_p
&& it->continuation_lines_width == 0
&& CHARACTERP (Vdisplay_fill_column_indicator_character))
@@ -896,11 +971,6 @@ static struct props it_props[] =
{0, 0, NULL}
};
-/* Value is the position described by X. If X is a marker, value is
- the marker_position of X. Otherwise, value is X. */
-
-#define COERCE_MARKER(X) (MARKERP ((X)) ? Fmarker_position (X) : (X))
-
/* Enumeration returned by some move_it_.* functions internally. */
enum move_it_result
@@ -998,12 +1068,12 @@ static void handle_line_prefix (struct it *);
static void handle_stop_backwards (struct it *, ptrdiff_t);
static void unwind_with_echo_area_buffer (Lisp_Object);
static Lisp_Object with_echo_area_buffer_unwind_data (struct window *);
-static bool current_message_1 (ptrdiff_t, Lisp_Object);
-static bool truncate_message_1 (ptrdiff_t, Lisp_Object);
+static bool current_message_1 (void *, Lisp_Object);
+static bool truncate_message_1 (void *, Lisp_Object);
static void set_message (Lisp_Object);
-static bool set_message_1 (ptrdiff_t, Lisp_Object);
-static bool display_echo_area_1 (ptrdiff_t, Lisp_Object);
-static bool resize_mini_window_1 (ptrdiff_t, Lisp_Object);
+static bool set_message_1 (void *, Lisp_Object);
+static bool display_echo_area_1 (void *, Lisp_Object);
+static bool resize_mini_window_1 (void *, Lisp_Object);
static void unwind_redisplay (void);
static void extend_face_to_end_of_line (struct it *);
static intmax_t message_log_check_duplicate (ptrdiff_t, ptrdiff_t);
@@ -1101,6 +1171,7 @@ static Lisp_Object calc_line_height_property (struct it *, Lisp_Object,
static void produce_special_glyphs (struct it *, enum display_element_type);
static void show_mouse_face (Mouse_HLInfo *, enum draw_glyphs_face);
static bool coords_in_mouse_face_p (struct window *, int, int);
+static void reset_box_start_end_flags (struct it *);
@@ -1419,6 +1490,7 @@ Value is the height in pixels of the line at point. */)
set_buffer_internal_1 (XBUFFER (w->contents));
}
SET_TEXT_POS (pt, PT, PT_BYTE);
+ void *itdata = bidi_shelve_cache ();
start_display (&it, w, pt);
/* Start from the beginning of the screen line, to make sure we
traverse all of its display elements, and thus capture the
@@ -1430,6 +1502,7 @@ Value is the height in pixels of the line at point. */)
if (old_buffer)
set_buffer_internal_1 (old_buffer);
+ bidi_unshelve_cache (itdata, false);
return result;
}
@@ -1516,6 +1589,29 @@ window_hscroll_limited (struct window *w, struct frame *f)
return window_hscroll;
}
+/* Reset the box-face start and end flags in the iterator. This is
+ called after producing glyphs, such that we reset these flags only
+ after producing a glyph with the flag set. */
+
+static void
+reset_box_start_end_flags (struct it *it)
+{
+ /* Don't reset if we've drawn the glyph in the display margins --
+ those don't count as "produced glyphs". */
+ if (it->area == TEXT_AREA
+ /* Don't reset if we displayed a fringe bitmap. */
+ && !(it->what == IT_IMAGE && it->image_id < 0))
+ {
+ /* Don't reset if the face is not a box face: that might mean we
+ are iterating some overlay or display string, and the first
+ character to have the box face is yet to be seen, when we pop
+ the iterator stack. */
+ if (it->face_box_p)
+ it->start_of_box_run_p = false;
+ it->end_of_box_run_p = false;
+ }
+}
+
/* Return true if position CHARPOS is visible in window W.
CHARPOS < 0 means return info about WINDOW_END position.
If visible, set *X and *Y to pixel coordinates of top left corner.
@@ -1967,16 +2063,14 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
/* Return the next character from STR. Return in *LEN the length of
- the character. This is like STRING_CHAR_AND_LENGTH but never
+ the character. This is like string_char_and_length but never
returns an invalid character. If we find one, we return a `?', but
with the length of the invalid character. */
static int
-string_char_and_length (const unsigned char *str, int *len)
+check_char_and_length (const unsigned char *str, int *len)
{
- int c;
-
- c = STRING_CHAR_AND_LENGTH (str, *len);
+ int c = string_char_and_length (str, len);
if (!CHAR_VALID_P (c))
/* We may not change the length here because other places in Emacs
don't use this function, i.e. they silently accept invalid
@@ -1999,11 +2093,10 @@ string_pos_nchars_ahead (struct text_pos pos, Lisp_Object string, ptrdiff_t ncha
if (STRING_MULTIBYTE (string))
{
const unsigned char *p = SDATA (string) + BYTEPOS (pos);
- int len;
while (nchars--)
{
- string_char_and_length (p, &len);
+ int len = BYTES_BY_CHAR_HEAD (*p);
p += len;
CHARPOS (pos) += 1;
BYTEPOS (pos) += len;
@@ -2044,12 +2137,10 @@ c_string_pos (ptrdiff_t charpos, const char *s, bool multibyte_p)
if (multibyte_p)
{
- int len;
-
SET_TEXT_POS (pos, 0, 0);
while (charpos--)
{
- string_char_and_length ((const unsigned char *) s, &len);
+ int len = BYTES_BY_CHAR_HEAD (*s);
s += len;
CHARPOS (pos) += 1;
BYTEPOS (pos) += len;
@@ -2073,12 +2164,11 @@ number_of_chars (const char *s, bool multibyte_p)
if (multibyte_p)
{
ptrdiff_t rest = strlen (s);
- int len;
const unsigned char *p = (const unsigned char *) s;
for (nchars = 0; rest > 0; ++nchars)
{
- string_char_and_length (p, &len);
+ int len = BYTES_BY_CHAR_HEAD (*p);
rest -= len, p += len;
}
}
@@ -2127,8 +2217,8 @@ estimate_mode_line_height (struct frame *f, enum face_id face_id)
{
if (face->font)
height = normal_char_height (face->font, -1);
- if (face->box_line_width > 0)
- height += 2 * face->box_line_width;
+ if (face->box_horizontal_line_width > 0)
+ height += 2 * face->box_horizontal_line_width;
}
}
@@ -2140,7 +2230,7 @@ estimate_mode_line_height (struct frame *f, enum face_id face_id)
}
/* Given a pixel position (PIX_X, PIX_Y) on frame F, return glyph
- co-ordinates in (*X, *Y). Set *BOUNDS to the rectangle that the
+ coordinates in (*X, *Y). Set *BOUNDS to the rectangle that the
glyph at X, Y occupies, if BOUNDS != 0. If NOCLIP, do
not force the value into range. */
@@ -3284,7 +3374,10 @@ init_iterator (struct it *it, struct window *w,
with a left box line. */
face = FACE_FROM_ID_OR_NULL (it->f, remapped_base_face_id);
if (face && face->box != FACE_NO_BOX)
- it->start_of_box_run_p = true;
+ {
+ it->face_box_p = true;
+ it->start_of_box_run_p = true;
+ }
}
/* If a buffer position was specified, set the iterator there,
@@ -3651,7 +3744,7 @@ init_to_row_end (struct it *it, struct window *w, struct glyph_row *row)
it->continuation_lines_width
= row->continuation_lines_width + row->pixel_width;
CHECK_IT (it);
- /* Initializing IT in the presense of compositions in reordered
+ /* Initializing IT in the presence of compositions in reordered
rows is tricky: row->end above will generally cause us to
start at position that is not the first one in the logical
order, and we might therefore miss the composition earlier in
@@ -3882,8 +3975,7 @@ compute_stop_pos (struct it *it)
ptrdiff_t bpos = CHAR_TO_BYTE (pos);
while (pos < endpos)
{
- int ch;
- FETCH_CHAR_ADVANCE_NO_CHECK (ch, pos, bpos);
+ int ch = fetch_char_advance_no_check (&pos, &bpos);
if (ch == ' ' || ch == '\t' || ch == '\n' || ch == '\f')
{
found = true;
@@ -4400,8 +4492,11 @@ handle_face_prop (struct it *it)
this is the start of a run of characters with box face,
i.e. this character has a shadow on the left side. */
it->face_id = new_face_id;
- it->start_of_box_run_p = (new_face->box != FACE_NO_BOX
- && (old_face == NULL || !old_face->box));
+ /* Don't reset the start_of_box_run_p flag, only set it if
+ needed. */
+ if (!(it->start_of_box_run_p && old_face && old_face->box))
+ it->start_of_box_run_p = (new_face->box != FACE_NO_BOX
+ && (old_face == NULL || !old_face->box));
it->face_box_p = new_face->box != FACE_NO_BOX;
}
@@ -4539,10 +4634,8 @@ face_before_or_after_it_pos (struct it *it, bool before_p)
{
struct text_pos pos1 = string_pos (charpos, it->string);
const unsigned char *p = SDATA (it->string) + BYTEPOS (pos1);
- int c, len;
struct face *face = FACE_FROM_ID (it->f, face_id);
-
- c = string_char_and_length (p, &len);
+ int len, c = check_char_and_length (p, &len);
face_id = FACE_FOR_CHAR (it->f, face, c, charpos, it->string);
}
}
@@ -5678,7 +5771,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
else
{
it->what = IT_IMAGE;
- it->image_id = lookup_image (it->f, value);
+ it->image_id = lookup_image (it->f, value, it->face_id);
it->position = start_pos;
it->object = NILP (object) ? it->w->contents : object;
it->method = GET_FROM_IMAGE;
@@ -6542,7 +6635,16 @@ pop_it (struct it *it)
it->object = p->u.stretch.object;
break;
case GET_FROM_BUFFER:
- it->object = it->w->contents;
+ {
+ struct face *face = FACE_FROM_ID_OR_NULL (it->f, it->face_id);
+
+ /* Restore the face_box_p flag, since it could have been
+ overwritten by the face of the object that we just finished
+ displaying. */
+ if (face)
+ it->face_box_p = face->box != FACE_NO_BOX;
+ it->object = it->w->contents;
+ }
break;
case GET_FROM_STRING:
{
@@ -6628,7 +6730,7 @@ back_to_previous_line_start (struct it *it)
{
ptrdiff_t cp = IT_CHARPOS (*it), bp = IT_BYTEPOS (*it);
- DEC_BOTH (cp, bp);
+ dec_both (&cp, &bp);
IT_CHARPOS (*it) = find_newline_no_quit (cp, bp, -1, &IT_BYTEPOS (*it));
}
@@ -7528,7 +7630,7 @@ get_next_display_element (struct it *it)
/* Merge `nobreak-space' into the current face. */
face_id = merge_faces (it->w, Qnobreak_space, 0,
it->face_id);
- XSETINT (it->ctl_chars[0], ' ');
+ XSETINT (it->ctl_chars[0], it->c);
ctl_len = 1;
goto display_control;
}
@@ -7541,7 +7643,7 @@ get_next_display_element (struct it *it)
/* Merge `nobreak-space' into the current face. */
face_id = merge_faces (it->w, Qnobreak_hyphen, 0,
it->face_id);
- XSETINT (it->ctl_chars[0], '-');
+ XSETINT (it->ctl_chars[0], it->c);
ctl_len = 1;
goto display_control;
}
@@ -7671,14 +7773,19 @@ get_next_display_element (struct it *it)
/* If the box comes from face properties in a
display string, check faces in that string. */
int string_face_id = face_after_it_pos (it);
- it->end_of_box_run_p
- = (FACE_FROM_ID (it->f, string_face_id)->box
- == FACE_NO_BOX);
+ if (FACE_FROM_ID (it->f, string_face_id)->box == FACE_NO_BOX)
+ it->end_of_box_run_p = true;
}
/* Otherwise, the box comes from the underlying face.
If this is the last string character displayed, check
the next buffer location. */
- else if ((IT_STRING_CHARPOS (*it) >= SCHARS (it->string) - 1)
+ else if (((IT_STRING_CHARPOS (*it) >= SCHARS (it->string) - 1)
+ /* For a composition, see if the string ends
+ at the last character included in the
+ composition. */
+ || (it->what == IT_COMPOSITION
+ && (IT_STRING_CHARPOS (*it) + it->cmp_it.nchars
+ >= SCHARS (it->string))))
/* n_overlay_strings is unreliable unless
overlay_string_index is non-negative. */
&& ((it->current.overlay_string_index >= 0
@@ -7742,9 +7849,9 @@ get_next_display_element (struct it *it)
CHARPOS (pos), 0,
&ignore, face_id,
false, 0);
- it->end_of_box_run_p
- = (FACE_FROM_ID (it->f, next_face_id)->box
- == FACE_NO_BOX);
+ if (FACE_FROM_ID (it->f, next_face_id)->box
+ == FACE_NO_BOX)
+ it->end_of_box_run_p = true;
}
}
else if (CHARPOS (pos) >= ZV)
@@ -7757,9 +7864,9 @@ get_next_display_element (struct it *it)
CHARPOS (pos)
+ TEXT_PROP_DISTANCE_LIMIT,
false, -1, 0);
- it->end_of_box_run_p
- = (FACE_FROM_ID (it->f, next_face_id)->box
- == FACE_NO_BOX);
+ if (FACE_FROM_ID (it->f, next_face_id)->box
+ == FACE_NO_BOX)
+ it->end_of_box_run_p = true;
}
}
}
@@ -7769,9 +7876,9 @@ get_next_display_element (struct it *it)
else if (it->method != GET_FROM_DISPLAY_VECTOR)
{
int face_id = face_after_it_pos (it);
- it->end_of_box_run_p
- = (face_id != it->face_id
- && FACE_FROM_ID (it->f, face_id)->box == FACE_NO_BOX);
+ if (face_id != it->face_id
+ && FACE_FROM_ID (it->f, face_id)->box == FACE_NO_BOX)
+ it->end_of_box_run_p = true;
}
}
/* If we reached the end of the object we've been iterating (e.g., a
@@ -7808,10 +7915,6 @@ get_next_display_element (struct it *it)
void
set_iterator_to_next (struct it *it, bool reseat_p)
{
- /* Reset flags indicating start and end of a sequence of characters
- with box. Reset them at the start of this function because
- moving the iterator to a new position might set them. */
- it->start_of_box_run_p = it->end_of_box_run_p = false;
switch (it->method)
{
@@ -8223,9 +8326,9 @@ next_element_from_display_vector (struct it *it)
}
}
next_face = FACE_FROM_ID_OR_NULL (it->f, next_face_id);
- it->end_of_box_run_p = (this_face && this_face->box != FACE_NO_BOX
- && (!next_face
- || next_face->box == FACE_NO_BOX));
+ if (this_face && this_face->box != FACE_NO_BOX
+ && (!next_face || next_face->box == FACE_NO_BOX))
+ it->end_of_box_run_p = true;
it->face_box_p = this_face && this_face->box != FACE_NO_BOX;
}
else
@@ -8447,7 +8550,7 @@ next_element_from_string (struct it *it)
{
const unsigned char *s = (SDATA (it->string)
+ IT_STRING_BYTEPOS (*it));
- it->c = string_char_and_length (s, &it->len);
+ it->c = check_char_and_length (s, &it->len);
}
else
{
@@ -8485,7 +8588,7 @@ next_element_from_string (struct it *it)
{
const unsigned char *s = (SDATA (it->string)
+ IT_STRING_BYTEPOS (*it));
- it->c = string_char_and_length (s, &it->len);
+ it->c = check_char_and_length (s, &it->len);
}
else
{
@@ -8543,7 +8646,7 @@ next_element_from_c_string (struct it *it)
BYTEPOS (it->position) = CHARPOS (it->position) = -1;
}
else if (it->multibyte_p)
- it->c = string_char_and_length (it->s + IT_BYTEPOS (*it), &it->len);
+ it->c = check_char_and_length (it->s + IT_BYTEPOS (*it), &it->len);
else
it->c = it->s[IT_BYTEPOS (*it)], it->len = 1;
@@ -8658,7 +8761,7 @@ compute_stop_pos_backwards (struct it *it)
position before that. This is called when we bump into a stop
position while reordering bidirectional text. CHARPOS should be
the last previously processed stop_pos (or BEGV/0, if none were
- processed yet) whose position is less that IT's current
+ processed yet) whose position is less than IT's current
position. */
static void
@@ -8668,6 +8771,7 @@ handle_stop_backwards (struct it *it, ptrdiff_t charpos)
ptrdiff_t where_we_are = (bufp ? IT_CHARPOS (*it) : IT_STRING_CHARPOS (*it));
struct display_pos save_current = it->current;
struct text_pos save_position = it->position;
+ struct composition_it save_cmp_it = it->cmp_it;
struct text_pos pos1;
ptrdiff_t next_stop;
@@ -8695,6 +8799,7 @@ handle_stop_backwards (struct it *it, ptrdiff_t charpos)
it->bidi_p = true;
it->current = save_current;
it->position = save_position;
+ it->cmp_it = save_cmp_it;
next_stop = it->stop_charpos;
it->stop_charpos = it->prev_stop;
handle_stop (it);
@@ -8840,7 +8945,7 @@ next_element_from_buffer (struct it *it)
/* Get the next character, maybe multibyte. */
p = BYTE_POS_ADDR (IT_BYTEPOS (*it));
if (it->multibyte_p && !ASCII_CHAR_P (*p))
- it->c = STRING_CHAR_AND_LENGTH (p, it->len);
+ it->c = string_char_and_length (p, &it->len);
else
it->c = *p, it->len = 1;
@@ -9163,13 +9268,20 @@ move_it_in_display_line_to (struct it *it,
{
if (it->line_wrap == WORD_WRAP && it->area == TEXT_AREA)
{
- if (IT_DISPLAYING_WHITESPACE (it))
- may_wrap = true;
- else if (may_wrap)
+ bool next_may_wrap = may_wrap;
+ /* Can we wrap after this character? */
+ if (char_can_wrap_after (it))
+ next_may_wrap = true;
+ else
+ next_may_wrap = false;
+ /* Can we wrap here? */
+ if (may_wrap && char_can_wrap_before (it))
{
/* We have reached a glyph that follows one or more
- whitespace characters. If the position is
- already found, we are done. */
+ whitespace characters or a character that allows
+ wrapping after it. If this character allows
+ wrapping before it, save this position as a
+ wrapping point. */
if (atpos_it.sp >= 0)
{
RESTORE_IT (it, &atpos_it, atpos_data);
@@ -9184,8 +9296,10 @@ move_it_in_display_line_to (struct it *it,
}
/* Otherwise, we can wrap here. */
SAVE_IT (wrap_it, *it, wrap_data);
- may_wrap = false;
+ next_may_wrap = false;
}
+ /* Update may_wrap for the next iteration. */
+ may_wrap = next_may_wrap;
}
}
@@ -9313,10 +9427,10 @@ move_it_in_display_line_to (struct it *it,
{
bool can_wrap = true;
- /* If we are at a whitespace character
- that barely fits on this screen line,
- but the next character is also
- whitespace, we cannot wrap here. */
+ /* If the previous character says we can
+ wrap after it, but the current
+ character says we can't wrap before
+ it, then we can't wrap here. */
if (it->line_wrap == WORD_WRAP
&& wrap_it.sp >= 0
&& may_wrap
@@ -9328,7 +9442,7 @@ move_it_in_display_line_to (struct it *it,
SAVE_IT (tem_it, *it, tem_data);
set_iterator_to_next (it, true);
if (get_next_display_element (it)
- && IT_DISPLAYING_WHITESPACE (it))
+ && !char_can_wrap_before (it))
can_wrap = false;
RESTORE_IT (it, &tem_it, tem_data);
}
@@ -9407,19 +9521,18 @@ move_it_in_display_line_to (struct it *it,
else
IT_RESET_X_ASCENT_DESCENT (it);
- /* If the screen line ends with whitespace, and we
- are under word-wrap, don't use wrap_it: it is no
- longer relevant, but we won't have an opportunity
- to update it, since we are done with this screen
- line. */
+ /* If the screen line ends with whitespace (or
+ wrap-able character), and we are under word-wrap,
+ don't use wrap_it: it is no longer relevant, but
+ we won't have an opportunity to update it, since
+ we are done with this screen line. */
if (may_wrap && IT_OVERFLOW_NEWLINE_INTO_FRINGE (it)
/* If the character after the one which set the
- may_wrap flag is also whitespace, we can't
- wrap here, since the screen line cannot be
- wrapped in the middle of whitespace.
- Therefore, wrap_it _is_ relevant in that
- case. */
- && !(moved_forward && IT_DISPLAYING_WHITESPACE (it)))
+ may_wrap flag says we can't wrap before it,
+ we can't wrap here. Therefore, wrap_it
+ (previously found wrap-point) _is_ relevant
+ in that case. */
+ && (!moved_forward || char_can_wrap_before (it)))
{
/* If we've found TO_X, go back there, as we now
know the last word fits on this screen line. */
@@ -9718,9 +9831,13 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos
int line_height, line_start_x = 0, reached = 0;
int max_current_x = 0;
void *backup_data = NULL;
+ ptrdiff_t orig_charpos = -1;
+ enum it_method orig_method = NUM_IT_METHODS;
for (;;)
{
+ orig_charpos = IT_CHARPOS (*it);
+ orig_method = it->method;
if (op & MOVE_TO_VPOS)
{
/* If no TO_CHARPOS and no TO_X specified, stop at the
@@ -9954,7 +10071,21 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos
}
}
else
- it->continuation_lines_width += it->current_x;
+ {
+ /* Make sure we do advance, otherwise we might infloop.
+ This could happen when the first display element is
+ wider than the window, or if we have a wrap-prefix
+ that doesn't leave enough space after it to display
+ even a single character. We only do this for moving
+ through buffer text, as with display/overlay strings
+ we'd need to also compare it->object's, and this is
+ unlikely to happen in that case anyway. */
+ if (IT_CHARPOS (*it) == orig_charpos
+ && it->method == orig_method
+ && orig_method == GET_FROM_BUFFER)
+ set_iterator_to_next (it, false);
+ it->continuation_lines_width += it->current_x;
+ }
break;
default:
@@ -10115,7 +10246,7 @@ move_it_vertically_backward (struct it *it, int dy)
{
ptrdiff_t cp = IT_CHARPOS (*it), bp = IT_BYTEPOS (*it);
- DEC_BOTH (cp, bp);
+ dec_both (&cp, &bp);
cp = find_newline_no_quit (cp, bp, -1, NULL);
move_it_to (it, cp, -1, -1, -1, MOVE_TO_POS);
}
@@ -10481,22 +10612,21 @@ include the height of both, if present, in the return value. */)
bpos = BEGV_BYTE;
while (bpos < ZV_BYTE)
{
- FETCH_CHAR_ADVANCE (c, start, bpos);
+ c = fetch_char_advance (&start, &bpos);
if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r'))
break;
}
while (bpos > BEGV_BYTE)
{
- DEC_BOTH (start, bpos);
- c = FETCH_CHAR (bpos);
+ dec_both (&start, &bpos);
+ c = FETCH_BYTE (bpos);
if (!(c == ' ' || c == '\t'))
break;
}
}
else
{
- CHECK_FIXNUM_COERCE_MARKER (from);
- start = min (max (XFIXNUM (from), BEGV), ZV);
+ start = clip_to_bounds (BEGV, fix_position (from), ZV);
bpos = CHAR_TO_BYTE (start);
}
@@ -10510,23 +10640,20 @@ include the height of both, if present, in the return value. */)
bpos = ZV_BYTE;
while (bpos > BEGV_BYTE)
{
- DEC_BOTH (end, bpos);
- c = FETCH_CHAR (bpos);
+ dec_both (&end, &bpos);
+ c = FETCH_BYTE (bpos);
if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r'))
break;
}
while (bpos < ZV_BYTE)
{
- FETCH_CHAR_ADVANCE (c, end, bpos);
+ c = fetch_char_advance (&end, &bpos);
if (!(c == ' ' || c == '\t'))
break;
}
}
else
- {
- CHECK_FIXNUM_COERCE_MARKER (to);
- end = max (start, min (XFIXNUM (to), ZV));
- }
+ end = clip_to_bounds (start, fix_position (to), ZV);
if (!NILP (x_limit) && RANGED_FIXNUMP (0, x_limit, INT_MAX))
max_x = XFIXNUM (x_limit);
@@ -10748,32 +10875,26 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte)
if (multibyte
&& NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
- ptrdiff_t i;
- int c, char_bytes;
- char work[1];
-
/* Convert a multibyte string to single-byte
for the *Message* buffer. */
- for (i = 0; i < nbytes; i += char_bytes)
+ for (ptrdiff_t i = 0; i < nbytes; )
{
- c = string_char_and_length (msg + i, &char_bytes);
- work[0] = CHAR_TO_BYTE8 (c);
- insert_1_both (work, 1, 1, true, false, false);
+ int char_bytes, c = check_char_and_length (msg + i, &char_bytes);
+ char work = CHAR_TO_BYTE8 (c);
+ insert_1_both (&work, 1, 1, true, false, false);
+ i += char_bytes;
}
}
else if (! multibyte
&& ! NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
- ptrdiff_t i;
- int c, char_bytes;
- unsigned char str[MAX_MULTIBYTE_LENGTH];
/* Convert a single-byte string to multibyte
for the *Message* buffer. */
- for (i = 0; i < nbytes; i++)
+ for (ptrdiff_t i = 0; i < nbytes; i++)
{
- c = msg[i];
- MAKE_CHAR_MULTIBYTE (c);
- char_bytes = CHAR_STRING (c, str);
+ int c = make_char_multibyte (msg[i]);
+ unsigned char str[MAX_MULTIBYTE_LENGTH];
+ int char_bytes = CHAR_STRING (c, str);
insert_1_both ((char *) str, 1, char_bytes, true, false, false);
}
}
@@ -11240,8 +11361,8 @@ ensure_echo_area_buffers (void)
static bool
with_echo_area_buffer (struct window *w, int which,
- bool (*fn) (ptrdiff_t, Lisp_Object),
- ptrdiff_t a1, Lisp_Object a2)
+ bool (*fn) (void *, Lisp_Object),
+ void *a1, Lisp_Object a2)
{
Lisp_Object buffer;
bool this_one, the_other, clear_buffer_p, rc;
@@ -11512,8 +11633,7 @@ display_echo_area (struct window *w)
window_height_changed_p
= with_echo_area_buffer (w, display_last_displayed_message_p,
- display_echo_area_1,
- (intptr_t) w, Qnil);
+ display_echo_area_1, w, Qnil);
if (no_message_p)
echo_area_buffer[i] = Qnil;
@@ -11530,10 +11650,9 @@ display_echo_area (struct window *w)
Value is true if height of W was changed. */
static bool
-display_echo_area_1 (ptrdiff_t a1, Lisp_Object a2)
+display_echo_area_1 (void *a1, Lisp_Object a2)
{
- intptr_t i1 = a1;
- struct window *w = (struct window *) i1;
+ struct window *w = a1;
Lisp_Object window;
struct text_pos start;
@@ -11574,7 +11693,7 @@ resize_echo_area_exactly (void)
struct window *w = XWINDOW (echo_area_window);
Lisp_Object resize_exactly = (minibuf_level == 0 ? Qt : Qnil);
bool resized_p = with_echo_area_buffer (w, 0, resize_mini_window_1,
- (intptr_t) w, resize_exactly);
+ w, resize_exactly);
if (resized_p)
{
windows_or_buffers_changed = 42;
@@ -11592,10 +11711,9 @@ resize_echo_area_exactly (void)
returns. */
static bool
-resize_mini_window_1 (ptrdiff_t a1, Lisp_Object exactly)
+resize_mini_window_1 (void *a1, Lisp_Object exactly)
{
- intptr_t i1 = a1;
- return resize_mini_window ((struct window *) i1, !NILP (exactly));
+ return resize_mini_window (a1, !NILP (exactly));
}
@@ -11691,7 +11809,20 @@ resize_mini_window (struct window *w, bool exact_p)
height = (max_height / unit) * unit;
init_iterator (&it, w, ZV, ZV_BYTE, NULL, DEFAULT_FACE_ID);
move_it_vertically_backward (&it, height - unit);
+ /* The following move is usually a no-op when the stuff
+ displayed in the mini-window comes entirely from buffer
+ text, but it is needed when some of it comes from overlay
+ strings, especially when there's an after-string at ZV.
+ This happens with some completion packages, like
+ icomplete, ido-vertical, etc. With those packages, if we
+ don't force w->start to be at the beginning of a screen
+ line, important parts of the stuff in the mini-window,
+ such as user prompt, will be hidden from view. */
+ move_it_by_lines (&it, 0);
start = it.current.pos;
+ /* Prevent redisplay_window from recentering, and thus from
+ overriding the window-start point we computed here. */
+ w->start_at_line_beg = false;
}
else
SET_TEXT_POS (start, BEGV, BEGV_BYTE);
@@ -11731,8 +11862,7 @@ current_message (void)
msg = Qnil;
else
{
- with_echo_area_buffer (0, 0, current_message_1,
- (intptr_t) &msg, Qnil);
+ with_echo_area_buffer (0, 0, current_message_1, &msg, Qnil);
if (NILP (msg))
echo_area_buffer[0] = Qnil;
}
@@ -11742,10 +11872,9 @@ current_message (void)
static bool
-current_message_1 (ptrdiff_t a1, Lisp_Object a2)
+current_message_1 (void *a1, Lisp_Object a2)
{
- intptr_t i1 = a1;
- Lisp_Object *msg = (Lisp_Object *) i1;
+ Lisp_Object *msg = a1;
if (Z > BEG)
*msg = make_buffer_string (BEG, Z, true);
@@ -11819,7 +11948,8 @@ truncate_echo_area (ptrdiff_t nchars)
just an informative message; if the frame hasn't really been
initialized yet, just toss it. */
if (sf->glyphs_initialized_p)
- with_echo_area_buffer (0, 0, truncate_message_1, nchars, Qnil);
+ with_echo_area_buffer (0, 0, truncate_message_1,
+ (void *) (intptr_t) nchars, Qnil);
}
}
@@ -11828,8 +11958,9 @@ truncate_echo_area (ptrdiff_t nchars)
message to at most NCHARS characters. */
static bool
-truncate_message_1 (ptrdiff_t nchars, Lisp_Object a2)
+truncate_message_1 (void *a1, Lisp_Object a2)
{
+ intptr_t nchars = (intptr_t) a1;
if (BEG + nchars < Z)
del_range (BEG + nchars, Z);
if (Z == BEG)
@@ -11881,7 +12012,7 @@ set_message (Lisp_Object string)
This function is called with the echo area buffer being current. */
static bool
-set_message_1 (ptrdiff_t a1, Lisp_Object string)
+set_message_1 (void *a1, Lisp_Object string)
{
eassert (STRINGP (string));
@@ -12269,12 +12400,12 @@ unwind_format_mode_line (Lisp_Object vector)
mode_line_string_face_prop = AREF (vector, 5);
/* Select window before buffer, since it may change the buffer. */
- if (!NILP (old_window))
+ if (WINDOW_LIVE_P (old_window))
{
/* If the operation that we are unwinding had selected a window
on a different frame, reset its frame-selected-window. For a
text terminal, reset its top-frame if necessary. */
- if (!NILP (target_frame_window))
+ if (WINDOW_LIVE_P (target_frame_window))
{
Lisp_Object frame
= WINDOW_FRAME (XWINDOW (target_frame_window));
@@ -12291,7 +12422,7 @@ unwind_format_mode_line (Lisp_Object vector)
/* Restore point of target_frame_window's buffer (Bug#32777).
But do this only after old_window has been reselected to
avoid that the window point of target_frame_window moves. */
- if (!NILP (target_frame_window))
+ if (WINDOW_LIVE_P (target_frame_window))
{
Lisp_Object buffer = AREF (vector, 10);
@@ -12447,6 +12578,11 @@ gui_consider_frame_title (Lisp_Object frame)
display_mode_element (&it, 0, -1, -1, fmt, Qnil, false);
len = MODE_LINE_NOPROP_LEN (title_start);
title = mode_line_noprop_buf + title_start;
+ /* Make sure that any raw bytes in the title are properly
+ represented by their multibyte sequences. */
+ ptrdiff_t nchars = 0;
+ len = str_as_multibyte ((unsigned char *)title,
+ mode_line_noprop_buf_end - title, len, &nchars);
unbind_to (count, Qnil);
/* Set the title only if it's changed. This avoids consing in
@@ -12458,9 +12594,10 @@ gui_consider_frame_title (Lisp_Object frame)
|| SBYTES (f->name) != len
|| memcmp (title, SDATA (f->name), len) != 0)
&& FRAME_TERMINAL (f)->implicit_set_name_hook)
- FRAME_TERMINAL (f)->implicit_set_name_hook (f,
- make_string (title, len),
- Qnil);
+ {
+ Lisp_Object title_string = make_multibyte_string (title, nchars, len);
+ FRAME_TERMINAL (f)->implicit_set_name_hook (f, title_string, Qnil);
+ }
}
}
@@ -12527,7 +12664,6 @@ prepare_menu_bars (void)
continue;
if (!FRAME_TOOLTIP_P (f)
- && !FRAME_PARENT_FRAME (f)
&& (FRAME_ICONIFIED_P (f)
|| FRAME_VISIBLE_P (f) == 1
/* Exclude TTY frames that are obscured because they
@@ -12573,10 +12709,9 @@ prepare_menu_bars (void)
&& !XBUFFER (w->contents)->text->redisplay)
continue;
- if (FRAME_PARENT_FRAME (f))
- continue;
+ if (!FRAME_PARENT_FRAME (f))
+ menu_bar_hooks_run = update_menu_bar (f, false, menu_bar_hooks_run);
- menu_bar_hooks_run = update_menu_bar (f, false, menu_bar_hooks_run);
update_tab_bar (f, false);
#ifdef HAVE_WINDOW_SYSTEM
update_tool_bar (f, false);
@@ -12588,7 +12723,10 @@ prepare_menu_bars (void)
else
{
struct frame *sf = SELECTED_FRAME ();
- update_menu_bar (sf, true, false);
+
+ if (!FRAME_PARENT_FRAME (sf))
+ update_menu_bar (sf, true, false);
+
update_tab_bar (sf, true);
#ifdef HAVE_WINDOW_SYSTEM
update_tool_bar (sf, true);
@@ -12712,23 +12850,68 @@ update_menu_bar (struct frame *f, bool save_match_data, bool hooks_run)
Tab-bars
***********************************************************************/
-#ifdef HAVE_WINDOW_SYSTEM
-
-/* Select `frame' temporarily without running all the code in
- do_switch_frame.
- FIXME: Maybe do_switch_frame should be trimmed down similarly
- when `norecord' is set. */
+/* Restore WINDOW as the selected window and its frame as the selected
+ frame. If WINDOW is dead but the selected frame is live, make the
+ latter's selected window the selected window. If both, WINDOW and
+ the selected frame, are dead, assign selected frame and window from
+ some arbitrary live frame. Abort if no such frame can be found. */
static void
-fast_set_selected_frame (Lisp_Object frame)
+restore_selected_window (Lisp_Object window)
{
- if (!EQ (selected_frame, frame))
+ if (WINDOW_LIVE_P (window))
+ /* If WINDOW is live, make it the selected window and its frame's
+ selected window and set the selected frame to its frame. */
{
- selected_frame = frame;
- selected_window = XFRAME (frame)->selected_window;
+ selected_window = window;
+ selected_frame = XWINDOW (window)->frame;
+ FRAME_SELECTED_WINDOW (XFRAME (selected_frame)) = window;
+ }
+ else if (FRAMEP (selected_frame) && FRAME_LIVE_P (XFRAME (selected_frame)))
+ /* If WINDOW is dead but the selected frame is still live, make the
+ latter's selected window the selected one. */
+ selected_window = FRAME_SELECTED_WINDOW (XFRAME (selected_frame));
+ else
+ /* If WINDOW and the selected frame are dead, choose some live,
+ non-child and non-tooltip frame as the new selected frame and
+ make its selected window the selected window. */
+ {
+ Lisp_Object tail;
+ Lisp_Object frame UNINIT;
+
+ FOR_EACH_FRAME (tail, frame)
+ {
+ struct frame *f = XFRAME (frame);
+
+ if (!FRAME_PARENT_FRAME (f) && !FRAME_TOOLTIP_P (f))
+ {
+ selected_frame = frame;
+ selected_window = FRAME_SELECTED_WINDOW (f);
+
+ return;
+ }
+ }
+
+ /* Abort if we cannot find a live frame. */
+ emacs_abort ();
}
}
-#endif /* HAVE_WINDOW_SYSTEM */
+/* Restore WINDOW, if live, as its frame's selected window. */
+static void
+restore_frame_selected_window (Lisp_Object window)
+{
+ if (WINDOW_LIVE_P (window))
+ /* If WINDOW is live, make it its frame's selected window. If that
+ frame is the selected frame, make WINDOW the selected window as
+ well. */
+ {
+ Lisp_Object frame = XWINDOW (window)->frame;
+
+ FRAME_SELECTED_WINDOW (XFRAME (frame)) = window;
+ if (EQ (frame, selected_frame))
+ selected_window = window;
+ }
+}
/* Update the tab-bar item list for frame F. This has to be done
before we start to fill in any display lines. Called from
@@ -12801,9 +12984,10 @@ update_tab_bar (struct frame *f, bool save_match_data)
XFRAME (selected_frame)->selected_window));
#ifdef HAVE_WINDOW_SYSTEM
Lisp_Object frame;
- record_unwind_protect (fast_set_selected_frame, selected_frame);
+ record_unwind_protect (restore_selected_window, selected_window);
XSETFRAME (frame, f);
- fast_set_selected_frame (frame);
+ selected_frame = frame;
+ selected_window = FRAME_SELECTED_WINDOW (f);
#endif
/* Build desired tab-bar items from keymaps. */
@@ -13478,11 +13662,6 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p,
XSETFRAME (frame, f);
event.kind = TAB_BAR_EVENT;
event.frame_or_window = frame;
- event.arg = frame;
- kbd_buffer_store_event (&event);
-
- event.kind = TAB_BAR_EVENT;
- event.frame_or_window = frame;
event.arg = key;
event.modifiers = close_p ? ctrl_modifier | modifiers : modifiers;
kbd_buffer_store_event (&event);
@@ -13658,11 +13837,6 @@ tty_handle_tab_bar_click (struct frame *f, int x, int y, bool down_p,
XSETFRAME (frame, f);
event->kind = TAB_BAR_EVENT;
event->frame_or_window = frame;
- event->arg = frame;
- kbd_buffer_store_event (event);
-
- event->kind = TAB_BAR_EVENT;
- event->frame_or_window = frame;
event->arg = key;
if (close_p)
event->modifiers |= ctrl_modifier;
@@ -13745,9 +13919,10 @@ update_tool_bar (struct frame *f, bool save_match_data)
/* Since we only explicitly preserve selected_frame,
check that selected_window would be redundant. */
XFRAME (selected_frame)->selected_window));
- record_unwind_protect (fast_set_selected_frame, selected_frame);
+ record_unwind_protect (restore_selected_window, selected_window);
XSETFRAME (frame, f);
- fast_set_selected_frame (frame);
+ selected_frame = frame;
+ selected_window = FRAME_SELECTED_WINDOW (f);
/* Build desired tool-bar items from keymaps. */
new_tool_bar
@@ -14444,11 +14619,6 @@ handle_tool_bar_click (struct frame *f, int x, int y, bool down_p,
XSETFRAME (frame, f);
event.kind = TOOL_BAR_EVENT;
event.frame_or_window = frame;
- event.arg = frame;
- kbd_buffer_store_event (&event);
-
- event.kind = TOOL_BAR_EVENT;
- event.frame_or_window = frame;
event.arg = key;
event.modifiers = modifiers;
kbd_buffer_store_event (&event);
@@ -15048,7 +15218,7 @@ overlay_arrows_changed_p (bool set_redisplay)
val = find_symbol_value (var);
if (!MARKERP (val))
continue;
- if (! EQ (COERCE_MARKER (val),
+ if (! EQ (Fmarker_position (val),
/* FIXME: Don't we have a problem, using such a global
* "last-position" if the variable is buffer-local? */
Fget (var, Qlast_arrow_position))
@@ -15091,8 +15261,7 @@ update_overlay_arrows (int up_to_date)
Lisp_Object val = find_symbol_value (var);
if (!MARKERP (val))
continue;
- Fput (var, Qlast_arrow_position,
- COERCE_MARKER (val));
+ Fput (var, Qlast_arrow_position, Fmarker_position (val));
Fput (var, Qlast_arrow_string,
overlay_arrow_string_or_property (var));
}
@@ -15563,6 +15732,12 @@ redisplay_internal (void)
if (it.current_x != this_line_start_x)
goto cancel;
+ /* Give up on this optimization if the line starts with a
+ string with display property that draws on the fringes,
+ as that might interfere with line-prefix display. */
+ if (it.sp > 1
+ && it.method == GET_FROM_IMAGE && it.image_id == -1)
+ goto cancel;
redisplay_trace ("trying display optimization 1\n");
w->cursor.vpos = -1;
overlay_arrow_seen = false;
@@ -19193,19 +19368,21 @@ try_window (Lisp_Object window, struct text_pos pos, int flags)
if ((flags & TRY_WINDOW_CHECK_MARGINS)
&& !MINI_WINDOW_P (w))
{
- int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
+ int top_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
+ int bot_scroll_margin = top_scroll_margin;
+ if (window_wants_header_line (w))
+ top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w);
start_display (&it, w, pos);
if ((w->cursor.y >= 0 /* not vscrolled */
- && w->cursor.y < this_scroll_margin
- && CHARPOS (pos) > BEGV
- && it_charpos < ZV)
+ && w->cursor.y < top_scroll_margin
+ && CHARPOS (pos) > BEGV)
/* rms: considering make_cursor_line_fully_visible_p here
seems to give wrong results. We don't want to recenter
when the last line is partly visible, we want to allow
that case to be handled in the usual way. */
- || w->cursor.y > (it.last_visible_y - partial_line_height (&it)
- - this_scroll_margin - 1))
+ || w->cursor.y > (it.last_visible_y - partial_line_height (&it)
+ - bot_scroll_margin - 1))
{
w->cursor.vpos = -1;
clear_glyph_matrix (w->desired_matrix);
@@ -20335,6 +20512,12 @@ try_window_id (struct window *w)
if (! init_to_row_end (&it, w, last_unchanged_at_beg_row))
GIVE_UP (18);
+ /* Give up if the row starts with a display property that draws
+ on the fringes, since that could prevent correct display of
+ line-prefix and wrap-prefix. */
+ if (it.sp > 1
+ && it.method == GET_FROM_IMAGE && it.image_id == -1)
+ GIVE_UP (26);
start_pos = it.current.pos;
/* Start displaying new lines in the desired matrix at the same
@@ -21250,7 +21433,7 @@ get_overlay_arrow_glyph_row (struct window *w, Lisp_Object overlay_arrow_string)
/* Get the next character. */
if (multibyte_p)
- it.c = it.char_to_display = string_char_and_length (p, &it.len);
+ it.c = it.char_to_display = check_char_and_length (p, &it.len);
else
{
it.c = it.char_to_display = *p, it.len = 1;
@@ -21620,6 +21803,8 @@ append_space_for_newline (struct it *it, bool default_face_p)
const int indicator_column =
fill_column_indicator_column (it, char_width);
+ int saved_end_of_box_run = it->end_of_box_run_p;
+ bool should_keep_end_of_box_run = false;
if (it->current_x == indicator_column)
{
@@ -21642,14 +21827,18 @@ append_space_for_newline (struct it *it, bool default_face_p)
have the end_of_box_run_p flag set for it, so there's no
need for the appended newline glyph to have that flag
set. */
- if (it->glyph_row->reversed_p
- /* But if the appended newline glyph goes all the way to
- the end of the row, there will be no stretch glyph,
- so leave the box flag set. */
- && saved_x + FRAME_COLUMN_WIDTH (it->f) < it->last_visible_x)
- it->end_of_box_run_p = false;
+ if (!(it->glyph_row->reversed_p
+ /* But if the appended newline glyph goes all the way to
+ the end of the row, there will be no stretch glyph,
+ so leave the box flag set. */
+ && saved_x + FRAME_COLUMN_WIDTH (it->f) < it->last_visible_x))
+ should_keep_end_of_box_run = true;
}
PRODUCE_GLYPHS (it);
+ /* Restore the end_of_box_run_p flag which was reset by
+ PRODUCE_GLYPHS. */
+ if (should_keep_end_of_box_run)
+ it->end_of_box_run_p = saved_end_of_box_run;
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (it->f))
{
@@ -21801,7 +21990,7 @@ extend_face_to_end_of_line (struct it *it)
&& !face->stipple
#endif
&& !it->glyph_row->reversed_p
- && !Vdisplay_fill_column_indicator)
+ && !display_fill_column_indicator)
return;
/* Set the glyph row flag indicating that the face of the last glyph
@@ -22135,7 +22324,7 @@ trailing_whitespace_p (ptrdiff_t charpos)
int c = 0;
while (bytepos < ZV_BYTE
- && (c = FETCH_CHAR (bytepos),
+ && (c = FETCH_BYTE (bytepos),
c == ' ' || c == '\t'))
++bytepos;
@@ -22395,7 +22584,7 @@ push_prefix_prop (struct it *it, Lisp_Object prop)
else if (IMAGEP (prop))
{
it->what = IT_IMAGE;
- it->image_id = lookup_image (it->f, prop);
+ it->image_id = lookup_image (it->f, prop, it->face_id);
it->method = GET_FROM_IMAGE;
}
#endif /* HAVE_WINDOW_SYSTEM */
@@ -22597,7 +22786,7 @@ find_row_edges (struct it *it, struct glyph_row *row,
required when scanning back, because max_pos will already
have a much larger value. */
if (CHARPOS (row->end.pos) > max_pos)
- INC_BOTH (max_pos, max_bpos);
+ inc_both (&max_pos, &max_bpos);
SET_TEXT_POS (row->maxpos, max_pos, max_bpos);
}
else if (CHARPOS (it->eol_pos) > 0)
@@ -22615,7 +22804,7 @@ find_row_edges (struct it *it, struct glyph_row *row,
SET_TEXT_POS (row->maxpos, max_pos, max_bpos);
else
{
- INC_BOTH (max_pos, max_bpos);
+ inc_both (&max_pos, &max_bpos);
SET_TEXT_POS (row->maxpos, max_pos, max_bpos);
}
}
@@ -23284,9 +23473,14 @@ display_line (struct it *it, int cursor_vpos)
if (it->line_wrap == WORD_WRAP && it->area == TEXT_AREA)
{
- if (IT_DISPLAYING_WHITESPACE (it))
- may_wrap = true;
- else if (may_wrap)
+ bool next_may_wrap = may_wrap;
+ /* Can we wrap after this character? */
+ if (char_can_wrap_after (it))
+ next_may_wrap = true;
+ else
+ next_may_wrap = false;
+ /* Can we wrap here? */
+ if (may_wrap && char_can_wrap_before (it))
{
SAVE_IT (wrap_it, *it, wrap_data);
wrap_x = x;
@@ -23300,8 +23494,9 @@ display_line (struct it *it, int cursor_vpos)
wrap_row_min_bpos = min_bpos;
wrap_row_max_pos = max_pos;
wrap_row_max_bpos = max_bpos;
- may_wrap = false;
}
+ /* Update may_wrap for the next iteration. */
+ may_wrap = next_may_wrap;
}
}
@@ -23425,14 +23620,18 @@ display_line (struct it *it, int cursor_vpos)
/* If line-wrap is on, check if a previous
wrap point was found. */
if (!IT_OVERFLOW_NEWLINE_INTO_FRINGE (it)
- && wrap_row_used > 0
+ && wrap_row_used > 0 /* Found. */
/* Even if there is a previous wrap
point, continue the line here as
usual, if (i) the previous character
- was a space or tab AND (ii) the
- current character is not. */
- && (!may_wrap
- || IT_DISPLAYING_WHITESPACE (it)))
+ allows wrapping after it, AND (ii)
+ the current character allows wrapping
+ before it. Because this is a valid
+ break point, we can just continue to
+ the next line at here, there is no
+ need to wrap early at the previous
+ wrap point. */
+ && (!may_wrap || !char_can_wrap_before (it)))
goto back_to_wrap;
/* Record the maximum and minimum buffer
@@ -23460,13 +23659,16 @@ display_line (struct it *it, int cursor_vpos)
/* If line-wrap is on, check if a
previous wrap point was found. */
else if (wrap_row_used > 0
- /* Even if there is a previous wrap
- point, continue the line here as
- usual, if (i) the previous character
- was a space or tab AND (ii) the
- current character is not. */
- && (!may_wrap
- || IT_DISPLAYING_WHITESPACE (it)))
+ /* Even if there is a previous
+ wrap point, continue the
+ line here as usual, if (i)
+ the previous character was a
+ space or tab AND (ii) the
+ current character is not,
+ AND (iii) the current
+ character allows wrapping
+ before it. */
+ && (!may_wrap || !char_can_wrap_before (it)))
goto back_to_wrap;
}
@@ -24026,7 +24228,7 @@ See also `bidi-paragraph-direction'. */)
to make sure we are within that paragraph. To that end, find
the previous non-empty line. */
if (pos >= ZV && pos > BEGV)
- DEC_BOTH (pos, bytepos);
+ dec_both (&pos, &bytepos);
AUTO_STRING (trailing_white_space, "[\f\t ]*\n");
if (fast_looking_at (trailing_white_space,
pos, bytepos, ZV, ZV_BYTE, Qnil) > 0)
@@ -24422,6 +24624,7 @@ Value is the new character position of point. */)
bool at_eol_p;
bool overshoot_expected = false;
bool target_is_eol_p = false;
+ void *itdata = bidi_shelve_cache ();
/* Setup the arena. */
SET_TEXT_POS (pt, PT, PT_BYTE);
@@ -24650,6 +24853,7 @@ Value is the new character position of point. */)
/* Move point to that position. */
SET_PT_BOTH (IT_CHARPOS (it), IT_BYTEPOS (it));
+ bidi_unshelve_cache (itdata, false);
}
return make_fixnum (PT);
@@ -25060,11 +25264,14 @@ static int
display_mode_lines (struct window *w)
{
Lisp_Object old_selected_window = selected_window;
- Lisp_Object old_selected_frame = selected_frame;
Lisp_Object new_frame = w->frame;
- Lisp_Object old_frame_selected_window = XFRAME (new_frame)->selected_window;
+ ptrdiff_t count = SPECPDL_INDEX ();
int n = 0;
+ record_unwind_protect (restore_selected_window, selected_window);
+ record_unwind_protect
+ (restore_frame_selected_window, XFRAME (new_frame)->selected_window);
+
if (window_wants_mode_line (w))
{
Lisp_Object window;
@@ -25130,9 +25337,8 @@ display_mode_lines (struct window *w)
++n;
}
- XFRAME (new_frame)->selected_window = old_frame_selected_window;
- selected_frame = old_selected_frame;
- selected_window = old_selected_window;
+ unbind_to (count, Qnil);
+
if (n > 0)
w->must_be_updated_p = true;
return n;
@@ -25495,6 +25701,14 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
spec = decode_mode_spec (it->w, c, field, &string);
eassert (NILP (string) || STRINGP (string));
multibyte = !NILP (string) && STRING_MULTIBYTE (string);
+ /* Non-ASCII characters in SPEC should cause mode-line
+ element be displayed as a multibyte string. */
+ ptrdiff_t nbytes = strlen (spec);
+ ptrdiff_t nchars, mb_nbytes;
+ parse_str_as_multibyte ((const unsigned char *)spec, nbytes,
+ &nchars, &mb_nbytes);
+ if (!(nbytes == nchars || nbytes != mb_nbytes))
+ multibyte = true;
switch (mode_line_target)
{
@@ -26113,9 +26327,11 @@ decode_mode_spec_coding (Lisp_Object coding_system, char *buf, bool eol_flag)
attrs = AREF (val, 0);
eolvalue = AREF (val, 2);
- *buf++ = multibyte
- ? XFIXNAT (CODING_ATTR_MNEMONIC (attrs))
- : ' ';
+ if (multibyte)
+ buf += CHAR_STRING (XFIXNAT (CODING_ATTR_MNEMONIC (attrs)),
+ (unsigned char *) buf);
+ else
+ *buf++ = ' ';
if (eol_flag)
{
@@ -27295,7 +27511,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
if (FRAME_WINDOW_P (it->f)
&& valid_image_p (prop))
{
- ptrdiff_t id = lookup_image (it->f, prop);
+ ptrdiff_t id = lookup_image (it->f, prop, it->face_id);
struct image *img = IMAGE_FROM_ID (it->f, id);
return OK_PIXELS (width_p ? img->width : img->height);
@@ -27677,22 +27893,32 @@ fill_gstring_glyph_string (struct glyph_string *s, int face_id,
struct glyph *glyph, *last;
Lisp_Object lgstring;
int i;
+ bool glyph_not_available_p;
s->for_overlaps = overlaps;
glyph = s->row->glyphs[s->area] + start;
last = s->row->glyphs[s->area] + end;
+ glyph_not_available_p = glyph->glyph_not_available_p;
s->cmp_id = glyph->u.cmp.id;
s->cmp_from = glyph->slice.cmp.from;
s->cmp_to = glyph->slice.cmp.to + 1;
s->face = FACE_FROM_ID (s->f, face_id);
lgstring = composition_gstring_from_id (s->cmp_id);
s->font = XFONT_OBJECT (LGSTRING_FONT (lgstring));
+ /* The width of a composition glyph string is the sum of the
+ composition's glyph widths. */
+ s->width = s->first_glyph->pixel_width;
glyph++;
while (glyph < last
&& glyph->u.cmp.automatic
&& glyph->u.cmp.id == s->cmp_id
- && s->cmp_to == glyph->slice.cmp.from)
- s->cmp_to = (glyph++)->slice.cmp.to + 1;
+ && glyph->face_id == face_id
+ && s->cmp_to == glyph->slice.cmp.from
+ && glyph->glyph_not_available_p == glyph_not_available_p)
+ {
+ s->width += glyph->pixel_width;
+ s->cmp_to = (glyph++)->slice.cmp.to + 1;
+ }
for (i = s->cmp_from; i < s->cmp_to; i++)
{
@@ -27702,7 +27928,13 @@ fill_gstring_glyph_string (struct glyph_string *s, int face_id,
/* Ensure that the code is only 2 bytes wide. */
s->char2b[i] = code & 0xFFFF;
}
- s->width = composition_gstring_width (lgstring, s->cmp_from, s->cmp_to, NULL);
+
+ /* If the specified font could not be loaded, record that fact in
+ S->font_not_found_p so that we can draw rectangles for the
+ characters of the glyph string. */
+ if (glyph_not_available_p)
+ s->font_not_found_p = true;
+
return glyph - s->row->glyphs[s->area];
}
@@ -28899,7 +29131,7 @@ append_composite_glyph (struct it *it)
glyph->overlaps_vertically_p = (it->phys_ascent > it->ascent
|| it->phys_descent > it->descent);
glyph->padding_p = false;
- glyph->glyph_not_available_p = false;
+ glyph->glyph_not_available_p = it->glyph_not_available_p;
glyph->face_id = it->face_id;
glyph->font_type = FONT_TYPE_UNKNOWN;
if (it->bidi_p)
@@ -29027,18 +29259,21 @@ produce_image_glyph (struct it *it)
if (face->box != FACE_NO_BOX)
{
- if (face->box_line_width > 0)
+ if (face->box_horizontal_line_width > 0)
{
if (slice.y == 0)
- it->ascent += face->box_line_width;
+ it->ascent += face->box_horizontal_line_width;
if (slice.y + slice.height == img->height)
- it->descent += face->box_line_width;
+ it->descent += face->box_horizontal_line_width;
}
- if (it->start_of_box_run_p && slice.x == 0)
- it->pixel_width += eabs (face->box_line_width);
- if (it->end_of_box_run_p && slice.x + slice.width == img->width)
- it->pixel_width += eabs (face->box_line_width);
+ if (face->box_vertical_line_width > 0)
+ {
+ if (it->start_of_box_run_p && slice.x == 0)
+ it->pixel_width += face->box_vertical_line_width;
+ if (it->end_of_box_run_p && slice.x + slice.width == img->width)
+ it->pixel_width += face->box_vertical_line_width;
+ }
}
take_vertical_position_into_account (it);
@@ -29136,15 +29371,18 @@ produce_xwidget_glyph (struct it *it)
if (face->box != FACE_NO_BOX)
{
- if (face->box_line_width > 0)
+ if (face->box_horizontal_line_width > 0)
{
- it->ascent += face->box_line_width;
- it->descent += face->box_line_width;
+ it->ascent += face->box_horizontal_line_width;
+ it->descent += face->box_horizontal_line_width;
}
- if (it->start_of_box_run_p)
- it->pixel_width += eabs (face->box_line_width);
- it->pixel_width += eabs (face->box_line_width);
+ if (face->box_vertical_line_width > 0)
+ {
+ if (it->start_of_box_run_p)
+ it->pixel_width += face->box_vertical_line_width;
+ it->pixel_width += face->box_vertical_line_width;
+ }
}
take_vertical_position_into_account (it);
@@ -29367,7 +29605,7 @@ produce_stretch_glyph (struct it *it)
/* Compute the width of the stretch. */
if ((prop = Fplist_get (plist, QCwidth), !NILP (prop))
- && calc_pixel_width_or_height (&tem, it, prop, font, true, 0))
+ && calc_pixel_width_or_height (&tem, it, prop, font, true, NULL))
{
/* Absolute width `:width WIDTH' specified and valid. */
zero_width_ok_p = true;
@@ -29383,7 +29621,7 @@ produce_stretch_glyph (struct it *it)
it2 = *it;
if (it->multibyte_p)
- it2.c = it2.char_to_display = STRING_CHAR_AND_LENGTH (p, it2.len);
+ it2.c = it2.char_to_display = string_char_and_length (p, &it2.len);
else
{
it2.c = it2.char_to_display = *p, it2.len = 1;
@@ -29423,7 +29661,7 @@ produce_stretch_glyph (struct it *it)
int default_height = normal_char_height (font, ' ');
if ((prop = Fplist_get (plist, QCheight), !NILP (prop))
- && calc_pixel_width_or_height (&tem, it, prop, font, false, 0))
+ && calc_pixel_width_or_height (&tem, it, prop, font, false, NULL))
{
height = (int)tem;
zero_height_ok_p = true;
@@ -29907,6 +30145,31 @@ produce_glyphless_glyph (struct it *it, bool for_no_font, Lisp_Object acronym)
}
+/* If face has a box, add the box thickness to the character
+ height. If character has a box line to the left and/or
+ right, add the box line width to the character's width. */
+#define IT_APPLY_FACE_BOX(it, face) \
+ do { \
+ if (face->box != FACE_NO_BOX) \
+ { \
+ int thick = face->box_horizontal_line_width; \
+ if (thick > 0) \
+ { \
+ it->ascent += thick; \
+ it->descent += thick; \
+ } \
+ \
+ thick = face->box_vertical_line_width; \
+ if (thick > 0) \
+ { \
+ if (it->start_of_box_run_p) \
+ it->pixel_width += thick; \
+ if (it->end_of_box_run_p) \
+ it->pixel_width += thick; \
+ } \
+ } \
+ } while (false)
+
/* RIF:
Produce glyphs/get display metrics for the display element IT is
loaded with. See the description of struct it in dispextern.h
@@ -30022,26 +30285,7 @@ gui_produce_glyphs (struct it *it)
if (stretched_p)
it->pixel_width *= XFLOATINT (it->space_width);
- /* If face has a box, add the box thickness to the character
- height. If character has a box line to the left and/or
- right, add the box line width to the character's width. */
- if (face->box != FACE_NO_BOX)
- {
- int thick = face->box_line_width;
-
- if (thick > 0)
- {
- it->ascent += thick;
- it->descent += thick;
- }
- else
- thick = -thick;
-
- if (it->start_of_box_run_p)
- it->pixel_width += thick;
- if (it->end_of_box_run_p)
- it->pixel_width += thick;
- }
+ IT_APPLY_FACE_BOX(it, face);
/* If face has an overline, add the height of the overline
(1 pixel) and a 1 pixel margin to the character height. */
@@ -30156,10 +30400,10 @@ gui_produce_glyphs (struct it *it)
if ((it->max_ascent > 0 || it->max_descent > 0)
&& face->box != FACE_NO_BOX
- && face->box_line_width > 0)
+ && face->box_horizontal_line_width > 0)
{
- it->ascent += face->box_line_width;
- it->descent += face->box_line_width;
+ it->ascent += face->box_horizontal_line_width;
+ it->descent += face->box_horizontal_line_width;
}
if (!NILP (height)
&& XFIXNUM (height) > it->ascent + it->descent)
@@ -30566,23 +30810,7 @@ gui_produce_glyphs (struct it *it)
it->pixel_width = cmp->pixel_width;
it->ascent = it->phys_ascent = cmp->ascent;
it->descent = it->phys_descent = cmp->descent;
- if (face->box != FACE_NO_BOX)
- {
- int thick = face->box_line_width;
-
- if (thick > 0)
- {
- it->ascent += thick;
- it->descent += thick;
- }
- else
- thick = - thick;
-
- if (it->start_of_box_run_p)
- it->pixel_width += thick;
- if (it->end_of_box_run_p)
- it->pixel_width += thick;
- }
+ IT_APPLY_FACE_BOX(it, face);
/* If face has an overline, add the height of the overline
(1 pixel) and a 1 pixel margin to the character height. */
@@ -30611,28 +30839,23 @@ gui_produce_glyphs (struct it *it)
it->pixel_width
= composition_gstring_width (gstring, it->cmp_it.from, it->cmp_it.to,
&metrics);
- if (it->glyph_row
- && (metrics.lbearing < 0 || metrics.rbearing > metrics.width))
- it->glyph_row->contains_overlapping_glyphs_p = true;
- it->ascent = it->phys_ascent = metrics.ascent;
- it->descent = it->phys_descent = metrics.descent;
- if (face->box != FACE_NO_BOX)
+ if (it->pixel_width == 0)
{
- int thick = face->box_line_width;
-
- if (thick > 0)
- {
- it->ascent += thick;
- it->descent += thick;
- }
- else
- thick = - thick;
-
- if (it->start_of_box_run_p)
- it->pixel_width += thick;
- if (it->end_of_box_run_p)
- it->pixel_width += thick;
+ it->glyph_not_available_p = true;
+ it->phys_ascent = it->ascent;
+ it->phys_descent = it->descent;
+ it->pixel_width = face->font->space_width;
}
+ else
+ {
+ if (it->glyph_row
+ && (metrics.lbearing < 0 || metrics.rbearing > metrics.width))
+ it->glyph_row->contains_overlapping_glyphs_p = true;
+ it->ascent = it->phys_ascent = metrics.ascent;
+ it->descent = it->phys_descent = metrics.descent;
+ }
+ IT_APPLY_FACE_BOX(it, face);
+
/* If face has an overline, add the height of the overline
(1 pixel) and a 1 pixel margin to the character height. */
if (face->overline_p)
@@ -30878,14 +31101,6 @@ get_specified_cursor_type (Lisp_Object arg, int *width)
return BAR_CURSOR;
}
- if (CONSP (arg)
- && EQ (XCAR (arg), Qbar)
- && RANGED_FIXNUMP (0, XCDR (arg), INT_MAX))
- {
- *width = XFIXNUM (XCDR (arg));
- return BAR_CURSOR;
- }
-
if (EQ (arg, Qhbar))
{
*width = 2;
@@ -30893,11 +31108,16 @@ get_specified_cursor_type (Lisp_Object arg, int *width)
}
if (CONSP (arg)
- && EQ (XCAR (arg), Qhbar)
&& RANGED_FIXNUMP (0, XCDR (arg), INT_MAX))
{
*width = XFIXNUM (XCDR (arg));
- return HBAR_CURSOR;
+
+ if (EQ (XCAR (arg), Qbox))
+ return FILLED_BOX_CURSOR;
+ else if (EQ (XCAR (arg), Qbar))
+ return BAR_CURSOR;
+ else if (EQ (XCAR (arg), Qhbar))
+ return HBAR_CURSOR;
}
/* Treat anything unknown as "hollow box cursor".
@@ -31024,23 +31244,28 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width,
if (!w->cursor_off_p)
{
if (glyph != NULL && glyph->type == XWIDGET_GLYPH)
- return NO_CURSOR;
+ return NO_CURSOR;
if (glyph != NULL && glyph->type == IMAGE_GLYPH)
{
if (cursor_type == FILLED_BOX_CURSOR)
{
- /* Using a block cursor on large images can be very annoying.
- So use a hollow cursor for "large" images.
- If image is not transparent (no mask), also use hollow cursor. */
+ /* Using a block cursor on large images can be very
+ annoying. So use a hollow cursor for "large" images.
+ If image is not transparent (no mask), also use
+ hollow cursor. */
struct image *img = IMAGE_OPT_FROM_ID (f, glyph->u.img_id);
if (img != NULL && IMAGEP (img->spec))
{
- /* Arbitrarily, interpret "Large" as >32x32 and >NxN
- where N = size of default frame font size.
- This should cover most of the "tiny" icons people may use. */
+ /* Interpret "large" as >SIZExSIZE and >NxN where
+ SIZE is the value from cursor-type of the form
+ (box . SIZE), where N = size of default frame
+ font size. So, setting cursor-type to (box . 32)
+ should cover most of the "tiny" icons people may
+ use. */
if (!img->mask
- || img->width > max (32, WINDOW_FRAME_COLUMN_WIDTH (w))
- || img->height > max (32, WINDOW_FRAME_LINE_HEIGHT (w)))
+ || (CONSP (BVAR (b, cursor_type))
+ && img->width > max (*width, WINDOW_FRAME_COLUMN_WIDTH (w))
+ && img->height > max (*width, WINDOW_FRAME_LINE_HEIGHT (w))))
cursor_type = HOLLOW_BOX_CURSOR;
}
}
@@ -34613,6 +34838,23 @@ A value of nil means to respect the value of `truncate-lines'.
If `word-wrap' is enabled, you might want to reduce this. */);
Vtruncate_partial_width_windows = make_fixnum (50);
+ DEFVAR_BOOL("word-wrap-by-category", word_wrap_by_category, doc: /*
+ Non-nil means also wrap after characters of a certain category.
+Normally when `word-wrap' is on, Emacs only breaks lines after
+whitespace characters. When this option is turned on, Emacs also
+breaks lines after characters that have the "|" category (defined in
+characters.el). This is useful for allowing breaking after CJK
+characters and improves the word-wrapping for CJK text mixed with
+Latin text.
+
+If this variable is set using Customize, Emacs automatically loads
+kinsoku.el. When 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., FULLWIDTH COMMA), and
+characters with the "<" category don't appear at the end of a line
+(e.g., LEFT DOUBLE ANGLE BRACKET). */);
+ word_wrap_by_category = false;
+
DEFVAR_LISP ("line-number-display-limit", Vline_number_display_limit,
doc: /* Maximum buffer size for which line number should be displayed.
If the buffer is bigger than this, the line number does not appear
@@ -34654,8 +34896,7 @@ and is used only on frames for which no explicit name has been set
Oracle Developer Studio 12.6. */
Lisp_Object icon_title_name_format
= pure_list (empty_unibyte_string,
- intern_c_string ("invocation-name"),
- build_pure_c_string ("@"),
+ build_pure_c_string ("%b - GNU Emacs at "),
intern_c_string ("system-name"));
Vicon_title_format
= Vframe_title_format
@@ -35010,10 +35251,10 @@ It has no effect when set to 0, or when line numbers are not absolute. */);
DEFSYM (Qdisplay_line_numbers_offset, "display-line-numbers-offset");
Fmake_variable_buffer_local (Qdisplay_line_numbers_offset);
- DEFVAR_BOOL ("display-fill-column-indicator", Vdisplay_fill_column_indicator,
+ DEFVAR_BOOL ("display-fill-column-indicator", display_fill_column_indicator,
doc: /* Non-nil means display the fill column indicator.
See Info node `Displaying Boundaries' for details. */);
- Vdisplay_fill_column_indicator = false;
+ display_fill_column_indicator = false;
DEFSYM (Qdisplay_fill_column_indicator, "display-fill-column-indicator");
Fmake_variable_buffer_local (Qdisplay_fill_column_indicator);
diff --git a/src/xfaces.c b/src/xfaces.c
index 66d6c340302..73a536b19c6 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -220,6 +220,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "sysstdio.h"
#include <sys/types.h>
#include <sys/stat.h>
+#include <math.h>
#include "lisp.h"
#include "character.h"
@@ -819,6 +820,128 @@ load_pixmap (struct frame *f, Lisp_Object name)
Color Handling
***********************************************************************/
+/* Parse hex color component specification that starts at S and ends
+ right before E. Set *DST to the parsed value normalized so that
+ the maximum value for the number of hex digits given becomes 65535,
+ and return true on success, false otherwise. */
+static bool
+parse_hex_color_comp (const char *s, const char *e, unsigned short *dst)
+{
+ int n = e - s;
+ if (n <= 0 || n > 4)
+ return false;
+ int val = 0;
+ for (; s < e; s++)
+ {
+ int digit;
+ if (*s >= '0' && *s <= '9')
+ digit = *s - '0';
+ else if (*s >= 'A' && *s <= 'F')
+ digit = *s - 'A' + 10;
+ else if (*s >= 'a' && *s <= 'f')
+ digit = *s - 'a' + 10;
+ else
+ return false;
+ val = (val << 4) | digit;
+ }
+ int maxval = (1 << (n * 4)) - 1;
+ *dst = (unsigned)val * 65535 / maxval;
+ return true;
+}
+
+/* Parse floating-point color component specification that starts at S
+ and ends right before E. Return the parsed number if in the range
+ [0,1]; otherwise return -1. */
+static double
+parse_float_color_comp (const char *s, const char *e)
+{
+ char *end;
+ double x = strtod (s, &end);
+ return (end == e && x >= 0 && x <= 1) ? x : -1;
+}
+
+/* Parse SPEC as a numeric color specification and set *R, *G and *B.
+ Return true on success, false on failure.
+
+ Recognized formats of SPEC:
+
+ "#RGB", with R, G and B hex strings of equal length, 1-4 digits each.
+ "rgb:R/G/B", with R, G and B hex strings, 1-4 digits each.
+ "rgbi:R/G/B", with R, G and B numbers in [0,1].
+
+ If the function succeeds, it assigns to each of the components *R,
+ *G, and *B a value normalized to be in the [0, 65535] range. If
+ the function fails, some or all of the components remain unassigned. */
+bool
+parse_color_spec (const char *spec,
+ unsigned short *r, unsigned short *g, unsigned short *b)
+{
+ int len = strlen (spec);
+ if (spec[0] == '#')
+ {
+ if ((len - 1) % 3 == 0)
+ {
+ int n = (len - 1) / 3;
+ return ( parse_hex_color_comp (spec + 1 + 0 * n,
+ spec + 1 + 1 * n, r)
+ && parse_hex_color_comp (spec + 1 + 1 * n,
+ spec + 1 + 2 * n, g)
+ && parse_hex_color_comp (spec + 1 + 2 * n,
+ spec + 1 + 3 * n, b));
+ }
+ }
+ else if (strncmp (spec, "rgb:", 4) == 0)
+ {
+ char *sep1, *sep2;
+ return ((sep1 = strchr (spec + 4, '/')) != NULL
+ && (sep2 = strchr (sep1 + 1, '/')) != NULL
+ && parse_hex_color_comp (spec + 4, sep1, r)
+ && parse_hex_color_comp (sep1 + 1, sep2, g)
+ && parse_hex_color_comp (sep2 + 1, spec + len, b));
+ }
+ else if (strncmp (spec, "rgbi:", 5) == 0)
+ {
+ char *sep1, *sep2;
+ double red, green, blue;
+ if ((sep1 = strchr (spec + 5, '/')) != NULL
+ && (sep2 = strchr (sep1 + 1, '/')) != NULL
+ && (red = parse_float_color_comp (spec + 5, sep1)) >= 0
+ && (green = parse_float_color_comp (sep1 + 1, sep2)) >= 0
+ && (blue = parse_float_color_comp (sep2 + 1, spec + len)) >= 0)
+ {
+ *r = lrint (red * 65535);
+ *g = lrint (green * 65535);
+ *b = lrint (blue * 65535);
+ return true;
+ }
+ }
+ return false;
+}
+
+DEFUN ("color-values-from-color-spec",
+ Fcolor_values_from_color_spec,
+ Scolor_values_from_color_spec,
+ 1, 1, 0,
+ doc: /* Parse color SPEC as a numeric color and return (RED GREEN BLUE).
+This function recognises the following formats for SPEC:
+
+ #RGB, where R, G and B are hex numbers of equal length, 1-4 digits each.
+ rgb:R/G/B, where R, G, and B are hex numbers, 1-4 digits each.
+ rgbi:R/G/B, where R, G and B are floating-point numbers in [0,1].
+
+If SPEC is not in one of the above forms, return nil.
+
+Each of the 3 integer members of the resulting list, RED, GREEN, and BLUE,
+is normalized to have its value in [0,65535]. */)
+ (Lisp_Object spec)
+{
+ CHECK_STRING (spec);
+ unsigned short r, g, b;
+ return (parse_color_spec (SSDATA (spec), &r, &g, &b)
+ ? list3i (r, g, b)
+ : Qnil);
+}
+
/* Parse RGB_LIST, and fill in the RGB fields of COLOR.
RGB_LIST should contain (at least) 3 lisp integers.
Return true iff RGB_LIST is OK. */
@@ -1449,22 +1572,18 @@ the face font sort order. */)
for (i = nfonts - 1; i >= 0; --i)
{
Lisp_Object font = AREF (vec, i);
- Lisp_Object v = make_uninit_vector (8);
- int point;
- Lisp_Object spacing;
-
- ASET (v, 0, AREF (font, FONT_FAMILY_INDEX));
- ASET (v, 1, FONT_WIDTH_SYMBOLIC (font));
- point = PIXEL_TO_POINT (XFIXNUM (AREF (font, FONT_SIZE_INDEX)) * 10,
- FRAME_RES_Y (f));
- ASET (v, 2, make_fixnum (point));
- ASET (v, 3, FONT_WEIGHT_SYMBOLIC (font));
- ASET (v, 4, FONT_SLANT_SYMBOLIC (font));
- spacing = Ffont_get (font, QCspacing);
- ASET (v, 5, (NILP (spacing) || EQ (spacing, Qp)) ? Qnil : Qt);
- ASET (v, 6, Ffont_xlfd_name (font, Qnil));
- ASET (v, 7, AREF (font, FONT_REGISTRY_INDEX));
-
+ int point = PIXEL_TO_POINT (XFIXNUM (AREF (font, FONT_SIZE_INDEX)) * 10,
+ FRAME_RES_Y (f));
+ Lisp_Object spacing = Ffont_get (font, QCspacing);
+ Lisp_Object v = CALLN (Fvector,
+ AREF (font, FONT_FAMILY_INDEX),
+ FONT_WIDTH_SYMBOLIC (font),
+ make_fixnum (point),
+ FONT_WEIGHT_SYMBOLIC (font),
+ FONT_SLANT_SYMBOLIC (font),
+ NILP (spacing) || EQ (spacing, Qp) ? Qnil : Qt,
+ Ffont_xlfd_name (font, Qnil),
+ AREF (font, FONT_REGISTRY_INDEX));
result = Fcons (v, result);
}
@@ -1888,7 +2007,7 @@ get_lface_attributes_no_remap (struct frame *f, Lisp_Object face_name,
lface = lface_from_face_name_no_resolve (f, face_name, signal_p);
if (! NILP (lface))
- memcpy (attrs, XVECTOR (lface)->contents,
+ memcpy (attrs, xvector_contents (lface),
LFACE_VECTOR_SIZE * sizeof *attrs);
return !NILP (lface);
@@ -2874,7 +2993,7 @@ The value is TO. */)
f = XFRAME (new_frame);
}
- vcopy (copy, 0, XVECTOR (lface)->contents, LFACE_VECTOR_SIZE);
+ vcopy (copy, 0, xvector_contents (lface), LFACE_VECTOR_SIZE);
/* Changing a named face means that all realized faces depending on
that face are invalid. Since we cannot tell which realized faces
@@ -3142,6 +3261,8 @@ FRAME 0 means change the face on all frames, and change the default
valid_p = XFIXNUM (value) != 0;
else if (STRINGP (value))
valid_p = SCHARS (value) > 0;
+ else if (CONSP (value) && FIXNUMP (XCAR (value)) && FIXNUMP (XCDR (value)))
+ valid_p = true;
else if (CONSP (value))
{
Lisp_Object tem;
@@ -3160,7 +3281,9 @@ FRAME 0 means change the face on all frames, and change the default
if (EQ (k, QCline_width))
{
- if (!FIXNUMP (v) || XFIXNUM (v) == 0)
+ if ((!CONSP(v) || !FIXNUMP (XCAR (v)) || XFIXNUM (XCAR (v)) == 0
+ || !FIXNUMP (XCDR (v)) || XFIXNUM (XCDR (v)) == 0)
+ && (!FIXNUMP (v) || XFIXNUM (v) == 0))
break;
}
else if (EQ (k, QCcolor))
@@ -4366,15 +4489,15 @@ color_distance (Emacs_Color *x, Emacs_Color *y)
See <https://www.compuphase.com/cmetric.htm> for more info. */
- long r = (x->red - y->red) >> 8;
- long g = (x->green - y->green) >> 8;
- long b = (x->blue - y->blue) >> 8;
- long r_mean = (x->red + y->red) >> 9;
+ long long r = x->red - y->red;
+ long long g = x->green - y->green;
+ long long b = x->blue - y->blue;
+ long long r_mean = (x->red + y->red) >> 1;
- return
- (((512 + r_mean) * r * r) >> 8)
- + 4 * g * g
- + (((767 - r_mean) * b * b) >> 8);
+ return (((((2 * 65536 + r_mean) * r * r) >> 16)
+ + 4 * g * g
+ + (((2 * 65536 + 65535 - r_mean) * b * b) >> 16))
+ >> 16);
}
@@ -4384,7 +4507,9 @@ COLOR1 and COLOR2 may be either strings containing the color name,
or lists of the form (RED GREEN BLUE), each in the range 0 to 65535 inclusive.
If FRAME is unspecified or nil, the current frame is used.
If METRIC is specified, it should be a function that accepts
-two lists of the form (RED GREEN BLUE) aforementioned. */)
+two lists of the form (RED GREEN BLUE) aforementioned.
+Despite the name, this is not a true distance metric as it does not satisfy
+the triangle inequality. */)
(Lisp_Object color1, Lisp_Object color2, Lisp_Object frame,
Lisp_Object metric)
{
@@ -4941,7 +5066,7 @@ DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector,
/* If the distance (as returned by color_distance) between two colors is
less than this, then they are considered the same, for determining
- whether a color is supported or not. The range of values is 0-65535. */
+ whether a color is supported or not. */
#define TTY_SAME_COLOR_THRESHOLD 10000
@@ -5092,7 +5217,6 @@ tty_supports_face_attributes_p (struct frame *f,
|| !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
- || !UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_BOX_INDEX]))
return false;
@@ -5157,6 +5281,15 @@ tty_supports_face_attributes_p (struct frame *f,
test_caps |= TTY_CAP_INVERSE;
}
+ /* strike through */
+ val = attrs[LFACE_STRIKE_THROUGH_INDEX];
+ if (!UNSPECIFIEDP (val))
+ {
+ if (face_attr_equal_p (val, def_attrs[LFACE_STRIKE_THROUGH_INDEX]))
+ return false; /* same as default */
+ else
+ test_caps |= TTY_CAP_STRIKE_THROUGH;
+ }
/* Color testing. */
@@ -5608,7 +5741,7 @@ realize_default_face (struct frame *f)
/* Realize the face; it must be fully-specified now. */
eassert (lface_fully_specified_p (XVECTOR (lface)->contents));
check_lface (lface);
- memcpy (attrs, XVECTOR (lface)->contents, sizeof attrs);
+ memcpy (attrs, xvector_contents (lface), sizeof attrs);
struct face *face = realize_face (c, attrs, DEFAULT_FACE_ID);
#ifndef HAVE_WINDOW_SYSTEM
@@ -5829,7 +5962,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]
face->box_color = load_color (f, face, attrs[LFACE_BOX_INDEX],
LFACE_BOX_INDEX);
face->box = FACE_SIMPLE_BOX;
- face->box_line_width = 1;
+ face->box_vertical_line_width = face->box_horizontal_line_width = 1;
}
else if (FIXNUMP (box))
{
@@ -5837,9 +5970,19 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]
face. */
eassert (XFIXNUM (box) != 0);
face->box = FACE_SIMPLE_BOX;
- face->box_line_width = XFIXNUM (box);
+ face->box_vertical_line_width = eabs(XFIXNUM (box));
+ face->box_horizontal_line_width = XFIXNUM (box);
+ face->box_color = face->foreground;
+ face->box_color_defaulted_p = true;
+ }
+ else if (CONSP (box) && FIXNUMP (XCAR (box)) && FIXNUMP (XCDR (box)))
+ {
+ /* `(VWIDTH . HWIDTH)'. */
+ face->box = FACE_SIMPLE_BOX;
face->box_color = face->foreground;
face->box_color_defaulted_p = true;
+ face->box_vertical_line_width = XFIXNUM (XCAR (box));
+ face->box_horizontal_line_width = XFIXNUM (XCDR (box));
}
else if (CONSP (box))
{
@@ -5848,7 +5991,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]
face->box = FACE_SIMPLE_BOX;
face->box_color = face->foreground;
face->box_color_defaulted_p = true;
- face->box_line_width = 1;
+ face->box_vertical_line_width = face->box_horizontal_line_width = 1;
while (CONSP (box))
{
@@ -5864,8 +6007,14 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]
if (EQ (keyword, QCline_width))
{
- if (FIXNUMP (value) && XFIXNUM (value) != 0)
- face->box_line_width = XFIXNUM (value);
+ if (CONSP (value) && FIXNUMP (XCAR (value)) && FIXNUMP (XCDR (value))) {
+ face->box_vertical_line_width = XFIXNUM (XCAR (value));
+ face->box_horizontal_line_width = XFIXNUM (XCDR (value));
+ }
+ else if (FIXNUMP (value) && XFIXNUM (value) != 0) {
+ face->box_vertical_line_width = eabs (XFIXNUM (value));
+ face->box_horizontal_line_width = XFIXNUM (value);
+ }
}
else if (EQ (keyword, QCcolor))
{
@@ -6103,6 +6252,8 @@ realize_tty_face (struct face_cache *cache,
face->tty_underline_p = true;
if (!NILP (attrs[LFACE_INVERSE_INDEX]))
face->tty_reverse_p = true;
+ if (!NILP (attrs[LFACE_STRIKE_THROUGH_INDEX]))
+ face->tty_strike_through_p = true;
/* Map color names to color indices. */
map_tty_color (f, face, LFACE_FOREGROUND_INDEX, &face_colors_defaulted);
@@ -7011,4 +7162,5 @@ clear the face cache, see `clear-face-cache'. */);
defsubr (&Sinternal_face_x_get_resource);
defsubr (&Sx_family_fonts);
#endif
+ defsubr (&Scolor_values_from_color_spec);
}
diff --git a/src/xfns.c b/src/xfns.c
index 6f7c590ecee..46e4bd73a6b 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1236,13 +1236,10 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
for (i = 0; i < mouse_cursor_max; i++)
{
Lisp_Object shape_var = *mouse_cursor_types[i].shape_var_ptr;
- if (!NILP (shape_var))
- {
- CHECK_TYPE_RANGED_INTEGER (unsigned, shape_var);
- cursor_data.cursor_num[i] = XFIXNUM (shape_var);
- }
- else
- cursor_data.cursor_num[i] = mouse_cursor_types[i].default_shape;
+ cursor_data.cursor_num[i]
+ = (!NILP (shape_var)
+ ? check_uinteger_max (shape_var, UINT_MAX)
+ : mouse_cursor_types[i].default_shape);
}
block_input ();
@@ -1807,10 +1804,7 @@ x_change_tool_bar_height (struct frame *f, int height)
static void
x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
- int border;
-
- CHECK_TYPE_RANGED_INTEGER (int, arg);
- border = max (XFIXNUM (arg), 0);
+ int border = check_int_nonnegative (arg);
if (border != FRAME_INTERNAL_BORDER_WIDTH (f))
{
@@ -3382,10 +3376,12 @@ x_icon (struct frame *f, Lisp_Object parms)
= gui_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
Lisp_Object icon_y
= 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))
{
- CHECK_TYPE_RANGED_INTEGER (int, icon_x);
- CHECK_TYPE_RANGED_INTEGER (int, icon_y);
+ 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");
@@ -3393,7 +3389,7 @@ x_icon (struct frame *f, Lisp_Object parms)
block_input ();
if (! EQ (icon_x, Qunbound))
- x_wm_set_icon_position (f, XFIXNUM (icon_x), XFIXNUM (icon_y));
+ x_wm_set_icon_position (f, icon_xval, icon_yval);
#if false /* gui_display_get_arg removes the visibility parameter as a
side effect, but x_create_frame still needs it. */
@@ -3884,8 +3880,6 @@ This function is an internal primitive--use `make-frame' instead. */)
#ifdef HAVE_HARFBUZZ
register_font_driver (&xfthbfont_driver, f);
#endif
-#else /* not HAVE_XFT */
- register_font_driver (&ftxfont_driver, f);
#endif /* not HAVE_XFT */
#endif /* HAVE_FREETYPE */
#endif /* not USE_CAIRO */
@@ -5563,12 +5557,12 @@ The coordinates X and Y are interpreted in pixels relative to a position
if (FRAME_INITIAL_P (f) || !FRAME_X_P (f))
return Qnil;
- CHECK_TYPE_RANGED_INTEGER (int, x);
- CHECK_TYPE_RANGED_INTEGER (int, y);
+ int xval = check_integer_range (x, INT_MIN, INT_MAX);
+ int yval = check_integer_range (y, INT_MIN, INT_MAX);
block_input ();
XWarpPointer (FRAME_X_DISPLAY (f), None, DefaultRootWindow (FRAME_X_DISPLAY (f)),
- 0, 0, 0, 0, XFIXNUM (x), XFIXNUM (y));
+ 0, 0, 0, 0, xval, yval);
unblock_input ();
return Qnil;
@@ -5896,7 +5890,8 @@ If WINDOW-ID is non-nil, change the property of that window instead
elsize = element_format == 32 ? sizeof (long) : element_format >> 3;
data = xnmalloc (nelements, elsize);
- x_fill_property_data (FRAME_X_DISPLAY (f), value, data, element_format);
+ x_fill_property_data (FRAME_X_DISPLAY (f), value, data, nelements,
+ element_format);
}
else
{
@@ -6202,10 +6197,10 @@ Otherwise, the return value is a vector with the following fields:
{
XFree (tmp_data);
- prop_attr = make_uninit_vector (3);
- ASET (prop_attr, 0, make_fixnum (actual_type));
- ASET (prop_attr, 1, make_fixnum (actual_format));
- ASET (prop_attr, 2, make_fixnum (bytes_remaining / (actual_format >> 3)));
+ prop_attr = CALLN (Fvector,
+ make_fixnum (actual_type),
+ make_fixnum (actual_format),
+ make_fixnum (bytes_remaining / (actual_format >> 3)));
}
unblock_input ();
@@ -6375,8 +6370,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms)
#ifdef HAVE_HARFBUZZ
register_font_driver (&xfthbfont_driver, f);
#endif
-#else /* not HAVE_XFT */
- register_font_driver (&ftxfont_driver, f);
#endif /* not HAVE_XFT */
#endif /* HAVE_FREETYPE */
#endif /* not USE_CAIRO */
@@ -6542,7 +6535,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms)
Frame parameters may be changed if .Xdefaults contains
specifications for the default font. For example, if there is an
`Emacs.default.attributeBackground: pink', the `background-color'
- attribute of the frame get's set, which let's the internal border
+ attribute of the frame gets set, which let's the internal border
of the tooltip frame appear in pink. Prevent this. */
{
Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
diff --git a/src/xfont.c b/src/xfont.c
index f6131dcec5a..1563b43bf97 100644
--- a/src/xfont.c
+++ b/src/xfont.c
@@ -166,7 +166,7 @@ xfont_encode_coding_xlfd (char *xlfd)
while (*p0)
{
- int c = STRING_CHAR_ADVANCE (p0);
+ int c = string_char_advance (&p0);
if (c >= 0x100)
return -1;
diff --git a/src/xgselect.c b/src/xgselect.c
index f8d0bac7fac..be70107b756 100644
--- a/src/xgselect.c
+++ b/src/xgselect.c
@@ -29,6 +29,27 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "blockinput.h"
#include "systime.h"
+static ptrdiff_t threads_holding_glib_lock;
+static GMainContext *glib_main_context;
+
+void release_select_lock (void)
+{
+ if (--threads_holding_glib_lock == 0)
+ g_main_context_release (glib_main_context);
+}
+
+static void acquire_select_lock (GMainContext *context)
+{
+ if (threads_holding_glib_lock++ == 0)
+ {
+ glib_main_context = context;
+ while (!g_main_context_acquire (context))
+ {
+ /* Spin. */
+ }
+ }
+}
+
/* `xg_select' is a `pselect' replacement. Why do we need a separate function?
1. Timeouts. Glib and Gtk rely on timer events. If we did pselect
with a greater timeout then the one scheduled by Glib, we would
@@ -54,26 +75,19 @@ xg_select (int fds_lim, fd_set *rfds, fd_set *wfds, fd_set *efds,
GPollFD *gfds = gfds_buf;
int gfds_size = ARRAYELTS (gfds_buf);
int n_gfds, retval = 0, our_fds = 0, max_fds = fds_lim - 1;
- bool context_acquired = false;
int i, nfds, tmo_in_millisec, must_free = 0;
bool need_to_dispatch;
context = g_main_context_default ();
- context_acquired = g_main_context_acquire (context);
- /* FIXME: If we couldn't acquire the context, we just silently proceed
- because this function handles more than just glib file descriptors.
- Note that, as implemented, this failure is completely silent: there is
- no feedback to the caller. */
+ acquire_select_lock (context);
if (rfds) all_rfds = *rfds;
else FD_ZERO (&all_rfds);
if (wfds) all_wfds = *wfds;
else FD_ZERO (&all_wfds);
- n_gfds = (context_acquired
- ? g_main_context_query (context, G_PRIORITY_LOW, &tmo_in_millisec,
- gfds, gfds_size)
- : -1);
+ n_gfds = g_main_context_query (context, G_PRIORITY_LOW, &tmo_in_millisec,
+ gfds, gfds_size);
if (gfds_size < n_gfds)
{
@@ -151,8 +165,10 @@ xg_select (int fds_lim, fd_set *rfds, fd_set *wfds, fd_set *efds,
#else
need_to_dispatch = true;
#endif
- if (need_to_dispatch && context_acquired)
+ if (need_to_dispatch)
{
+ acquire_select_lock (context);
+
int pselect_errno = errno;
/* Prevent g_main_dispatch recursion, that would occur without
block_input wrapper, because event handlers call
@@ -162,11 +178,9 @@ xg_select (int fds_lim, fd_set *rfds, fd_set *wfds, fd_set *efds,
g_main_context_dispatch (context);
unblock_input ();
errno = pselect_errno;
+ release_select_lock ();
}
- if (context_acquired)
- g_main_context_release (context);
-
/* To not have to recalculate timeout, return like this. */
if ((our_fds > 0 || (nfds == 0 && tmop == &tmo)) && (retval == 0))
{
diff --git a/src/xgselect.h b/src/xgselect.h
index a38591f3296..512bf3ad85f 100644
--- a/src/xgselect.h
+++ b/src/xgselect.h
@@ -29,4 +29,6 @@ extern int xg_select (int max_fds,
fd_set *rfds, fd_set *wfds, fd_set *efds,
struct timespec *timeout, sigset_t *sigmask);
+extern void release_select_lock (void);
+
#endif /* XGSELECT_H */
diff --git a/src/xmenu.c b/src/xmenu.c
index 9201a283b47..dba7e88f486 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -763,7 +763,7 @@ set_frame_menubar (struct frame *f, bool first_time, bool deep_p)
/* Save the frame's previous menu bar contents data. */
if (previous_menu_items_used)
- memcpy (previous_items, XVECTOR (f->menu_bar_vector)->contents,
+ memcpy (previous_items, xvector_contents (f->menu_bar_vector),
previous_menu_items_used * word_size);
/* Fill in menu_items with the current menu bar contents.
diff --git a/src/xrdb.c b/src/xrdb.c
index d3ac1175521..3d7f715c88f 100644
--- a/src/xrdb.c
+++ b/src/xrdb.c
@@ -353,7 +353,7 @@ get_environ_db (void)
p = filename = xmalloc (strlen (home) + 1 + sizeof xdefaults
+ 1 + SBYTES (system_name));
char *e = splice_dir_file (p, home, xdefaults);
- *e++ = '/';
+ *e++ = '-';
lispstpcpy (e, system_name);
}
}
diff --git a/src/xselect.c b/src/xselect.c
index 48d6215a7bb..383aebf96c8 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -1594,7 +1594,7 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo,
return x_atom_to_symbol (dpyinfo, (Atom) idata[0]);
else
{
- Lisp_Object v = make_uninit_vector (size / sizeof (int));
+ Lisp_Object v = make_nil_vector (size / sizeof (int));
for (i = 0; i < size / sizeof (int); i++)
ASET (v, i, x_atom_to_symbol (dpyinfo, (Atom) idata[i]));
@@ -1653,7 +1653,7 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo,
else
{
ptrdiff_t i;
- Lisp_Object v = make_uninit_vector (size / X_LONG_SIZE);
+ Lisp_Object v = make_nil_vector (size / X_LONG_SIZE);
if (type == XA_INTEGER)
{
@@ -1860,7 +1860,7 @@ clean_local_selection_data (Lisp_Object obj)
Lisp_Object copy;
if (size == 1)
return clean_local_selection_data (AREF (obj, 0));
- copy = make_uninit_vector (size);
+ copy = make_nil_vector (size);
for (i = 0; i < size; i++)
ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
return copy;
@@ -2276,23 +2276,28 @@ x_check_property_data (Lisp_Object data)
DPY is the display use to look up X atoms.
DATA is a Lisp list of values to be converted.
- RET is the C array that contains the converted values. It is assumed
- it is big enough to hold all values.
+ RET is the C array that contains the converted values.
+ NELEMENTS_MAX is the number of values that will fit in RET.
+ Any excess values in DATA are ignored.
FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
be stored in RET. Note that long is used for 32 even if long is more
than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
XClientMessageEvent). */
void
-x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, int format)
+x_fill_property_data (Display *dpy, Lisp_Object data, void *ret,
+ int nelements_max, int format)
{
unsigned long val;
unsigned long *d32 = (unsigned long *) ret;
unsigned short *d16 = (unsigned short *) ret;
unsigned char *d08 = (unsigned char *) ret;
+ int nelements;
Lisp_Object iter;
- for (iter = data; CONSP (iter); iter = XCDR (iter))
+ for (iter = data, nelements = 0;
+ CONSP (iter) && nelements < nelements_max;
+ iter = XCDR (iter), nelements++)
{
Lisp_Object o = XCAR (iter);
@@ -2593,7 +2598,9 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from,
event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest;
memset (event.xclient.data.l, 0, sizeof (event.xclient.data.l));
+ /* event.xclient.data can hold 20 chars, 10 shorts, or 5 longs. */
x_fill_property_data (dpyinfo->display, values, event.xclient.data.b,
+ 5 * 32 / event.xclient.format,
event.xclient.format);
/* If event mask is 0 the event is sent to the client that created
diff --git a/src/xterm.c b/src/xterm.c
index a567ab163af..2e0407aff40 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -1750,7 +1750,7 @@ x_draw_glyph_string_background (struct glyph_string *s, bool force_p)
shouldn't be drawn in the first place. */
if (!s->background_filled_p)
{
- int box_line_width = max (s->face->box_line_width, 0);
+ int box_line_width = max (s->face->box_horizontal_line_width, 0);
if (s->stippled_p)
{
@@ -1795,7 +1795,7 @@ x_draw_glyph_string_foreground (struct glyph_string *s)
of S to the right of that box line. */
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -1845,7 +1845,7 @@ x_draw_glyph_string_foreground (struct glyph_string *s)
if (!(s->for_overlaps
|| (s->background_filled_p && s->hl != DRAW_CURSOR)))
{
- int box_line_width = max (s->face->box_line_width, 0);
+ int box_line_width = max (s->face->box_horizontal_line_width, 0);
if (s->stippled_p)
{
@@ -1889,7 +1889,7 @@ x_draw_composite_glyph_string_foreground (struct glyph_string *s)
of S to the right of that box line. */
if (s->face && s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -2000,7 +2000,7 @@ x_draw_glyphless_glyph_string_foreground (struct glyph_string *s)
of S to the right of that box line. */
if (s->face && s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -2376,8 +2376,6 @@ x_query_frame_background_color (struct frame *f, XColor *bgcolor)
x_query_colors (f, bgcolor, 1);
}
-#define HEX_COLOR_NAME_LENGTH 32
-
/* On frame F, translate the color name to RGB values. Use cached
information, if possible.
@@ -2389,44 +2387,23 @@ x_query_frame_background_color (struct frame *f, XColor *bgcolor)
Status x_parse_color (struct frame *f, const char *color_name,
XColor *color)
{
+ /* Don't pass #RGB strings directly to XParseColor, because that
+ follows the X convention of zero-extending each channel
+ value: #f00 means #f00000. We want the convention of scaling
+ channel values, so #f00 means #ff0000, just as it does for
+ HTML, SVG, and CSS. */
+ unsigned short r, g, b;
+ if (parse_color_spec (color_name, &r, &g, &b))
+ {
+ color->red = r;
+ color->green = g;
+ color->blue = b;
+ return 1;
+ }
+
Display *dpy = FRAME_X_DISPLAY (f);
Colormap cmap = FRAME_X_COLORMAP (f);
struct color_name_cache_entry *cache_entry;
-
- if (color_name[0] == '#')
- {
- /* Don't pass #RGB strings directly to XParseColor, because that
- follows the X convention of zero-extending each channel
- value: #f00 means #f00000. We want the convention of scaling
- channel values, so #f00 means #ff0000, just as it does for
- HTML, SVG, and CSS.
-
- So we translate #f00 to rgb:f/0/0, which X handles
- differently. */
- char rgb_color_name[HEX_COLOR_NAME_LENGTH];
- int len = strlen (color_name);
- int digits_per_channel;
- if (len == 4)
- digits_per_channel = 1;
- else if (len == 7)
- digits_per_channel = 2;
- else if (len == 10)
- digits_per_channel = 3;
- else if (len == 13)
- digits_per_channel = 4;
- else
- return 0;
-
- snprintf (rgb_color_name, sizeof rgb_color_name, "rgb:%.*s/%.*s/%.*s",
- digits_per_channel, color_name + 1,
- digits_per_channel, color_name + digits_per_channel + 1,
- digits_per_channel, color_name + 2 * digits_per_channel + 1);
-
- /* The rgb form is parsed directly by XParseColor without
- talking to the X server. No need for caching. */
- return XParseColor (dpy, cmap, rgb_color_name, color);
- }
-
for (cache_entry = FRAME_DISPLAY_INFO (f)->color_names; cache_entry;
cache_entry = cache_entry->next)
{
@@ -2765,7 +2742,7 @@ x_setup_relief_colors (struct glyph_string *s)
static void
x_draw_relief_rect (struct frame *f,
int left_x, int top_y, int right_x, int bottom_y,
- int width, bool raised_p, bool top_p, bool bot_p,
+ int hwidth, int vwidth, bool raised_p, bool top_p, bool bot_p,
bool left_p, bool right_p,
XRectangle *clip_rect)
{
@@ -2790,7 +2767,7 @@ x_draw_relief_rect (struct frame *f,
if (left_p)
{
x_fill_rectangle (f, top_left_gc, left_x, top_y,
- width, bottom_y + 1 - top_y);
+ vwidth, bottom_y + 1 - top_y);
if (top_p)
corners |= 1 << CORNER_TOP_LEFT;
if (bot_p)
@@ -2798,8 +2775,8 @@ x_draw_relief_rect (struct frame *f,
}
if (right_p)
{
- x_fill_rectangle (f, bottom_right_gc, right_x + 1 - width, top_y,
- width, bottom_y + 1 - top_y);
+ x_fill_rectangle (f, bottom_right_gc, right_x + 1 - vwidth, top_y,
+ vwidth, bottom_y + 1 - top_y);
if (top_p)
corners |= 1 << CORNER_TOP_RIGHT;
if (bot_p)
@@ -2809,25 +2786,25 @@ x_draw_relief_rect (struct frame *f,
{
if (!right_p)
x_fill_rectangle (f, top_left_gc, left_x, top_y,
- right_x + 1 - left_x, width);
+ right_x + 1 - left_x, hwidth);
else
x_fill_trapezoid_for_relief (f, top_left_gc, left_x, top_y,
- right_x + 1 - left_x, width, 1);
+ right_x + 1 - left_x, hwidth, 1);
}
if (bot_p)
{
if (!left_p)
- x_fill_rectangle (f, bottom_right_gc, left_x, bottom_y + 1 - width,
- right_x + 1 - left_x, width);
+ x_fill_rectangle (f, bottom_right_gc, left_x, bottom_y + 1 - hwidth,
+ right_x + 1 - left_x, hwidth);
else
x_fill_trapezoid_for_relief (f, bottom_right_gc,
- left_x, bottom_y + 1 - width,
- right_x + 1 - left_x, width, 0);
+ left_x, bottom_y + 1 - hwidth,
+ right_x + 1 - left_x, hwidth, 0);
}
- if (left_p && width != 1)
+ if (left_p && vwidth > 1)
x_fill_rectangle (f, bottom_right_gc, left_x, top_y,
1, bottom_y + 1 - top_y);
- if (top_p && width != 1)
+ if (top_p && hwidth > 1)
x_fill_rectangle (f, bottom_right_gc, left_x, top_y,
right_x + 1 - left_x, 1);
if (corners)
@@ -2861,12 +2838,12 @@ x_draw_relief_rect (struct frame *f,
/* Top. */
if (top_p)
{
- if (width == 1)
+ if (hwidth == 1)
XDrawLine (dpy, drawable, gc,
left_x + left_p, top_y,
right_x + !right_p, top_y);
- for (i = 1; i < width; ++i)
+ for (i = 1; i < hwidth; ++i)
XDrawLine (dpy, drawable, gc,
left_x + i * left_p, top_y + i,
right_x + 1 - i * right_p, top_y + i);
@@ -2875,13 +2852,10 @@ x_draw_relief_rect (struct frame *f,
/* Left. */
if (left_p)
{
- if (width == 1)
+ if (vwidth == 1)
XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y);
- x_clear_area(f, left_x, top_y, 1, 1);
- x_clear_area(f, left_x, bottom_y, 1, 1);
-
- for (i = (width > 1 ? 1 : 0); i < width; ++i)
+ for (i = 1; i < vwidth; ++i)
XDrawLine (dpy, drawable, gc,
left_x + i, top_y + (i + 1) * top_p,
left_x + i, bottom_y + 1 - (i + 1) * bot_p);
@@ -2894,26 +2868,25 @@ x_draw_relief_rect (struct frame *f,
gc = f->output_data.x->white_relief.gc;
XSetClipRectangles (dpy, gc, 0, 0, clip_rect, 1, Unsorted);
- if (width > 1)
- {
- /* Outermost top line. */
- if (top_p)
- XDrawLine (dpy, drawable, gc,
- left_x + left_p, top_y,
- right_x + !right_p, top_y);
+ /* Outermost top line. */
+ if (top_p && hwidth > 1)
+ XDrawLine (dpy, drawable, gc,
+ left_x + left_p, top_y,
+ right_x + !right_p, top_y);
- /* Outermost left line. */
- if (left_p)
- XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y);
- }
+ /* Outermost left line. */
+ if (left_p && vwidth > 1)
+ XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y);
/* Bottom. */
if (bot_p)
{
- XDrawLine (dpy, drawable, gc,
- left_x + left_p, bottom_y,
- right_x + !right_p, bottom_y);
- for (i = 1; i < width; ++i)
+ if (hwidth >= 1)
+ XDrawLine (dpy, drawable, gc,
+ left_x + left_p, bottom_y,
+ right_x + !right_p, bottom_y);
+
+ for (i = 1; i < hwidth; ++i)
XDrawLine (dpy, drawable, gc,
left_x + i * left_p, bottom_y - i,
right_x + 1 - i * right_p, bottom_y - i);
@@ -2922,9 +2895,7 @@ x_draw_relief_rect (struct frame *f,
/* Right. */
if (right_p)
{
- x_clear_area(f, right_x, top_y, 1, 1);
- x_clear_area(f, right_x, bottom_y, 1, 1);
- for (i = 0; i < width; ++i)
+ for (i = 0; i < vwidth; ++i)
XDrawLine (dpy, drawable, gc,
right_x - i, top_y + (i + 1) * top_p,
right_x - i, bottom_y + 1 - (i + 1) * bot_p);
@@ -2945,8 +2916,8 @@ x_draw_relief_rect (struct frame *f,
static void
x_draw_box_rect (struct glyph_string *s,
- int left_x, int top_y, int right_x, int bottom_y, int width,
- bool left_p, bool right_p, XRectangle *clip_rect)
+ int left_x, int top_y, int right_x, int bottom_y, int hwidth,
+ int vwidth, bool left_p, bool right_p, XRectangle *clip_rect)
{
Display *display = FRAME_X_DISPLAY (s->f);
XGCValues xgcv;
@@ -2957,21 +2928,21 @@ x_draw_box_rect (struct glyph_string *s,
/* Top. */
x_fill_rectangle (s->f, s->gc,
- left_x, top_y, right_x - left_x + 1, width);
+ left_x, top_y, right_x - left_x + 1, hwidth);
/* Left. */
if (left_p)
x_fill_rectangle (s->f, s->gc,
- left_x, top_y, width, bottom_y - top_y + 1);
+ left_x, top_y, vwidth, bottom_y - top_y + 1);
/* Bottom. */
x_fill_rectangle (s->f, s->gc,
- left_x, bottom_y - width + 1, right_x - left_x + 1, width);
+ left_x, bottom_y - hwidth + 1, right_x - left_x + 1, hwidth);
/* Right. */
if (right_p)
x_fill_rectangle (s->f, s->gc,
- right_x - width + 1, top_y, width, bottom_y - top_y + 1);
+ right_x - vwidth + 1, top_y, vwidth, bottom_y - top_y + 1);
XSetForeground (display, s->gc, xgcv.foreground);
x_reset_clip_rectangles (s->f, s->gc);
@@ -2983,7 +2954,7 @@ x_draw_box_rect (struct glyph_string *s,
static void
x_draw_glyph_string_box (struct glyph_string *s)
{
- int width, left_x, right_x, top_y, bottom_y, last_x;
+ int hwidth, vwidth, left_x, right_x, top_y, bottom_y, last_x;
bool raised_p, left_p, right_p;
struct glyph *last_glyph;
XRectangle clip_rect;
@@ -2992,12 +2963,29 @@ x_draw_glyph_string_box (struct glyph_string *s)
? WINDOW_RIGHT_EDGE_X (s->w)
: window_box_right (s->w, s->area));
- /* The glyph that may have a right box line. */
- last_glyph = (s->cmp || s->img
- ? s->first_glyph
- : s->first_glyph + s->nchars - 1);
+ /* The glyph that may have a right box line. For static
+ compositions and images, the right-box flag is on the first glyph
+ of the glyph string; for other types it's on the last glyph. */
+ if (s->cmp || s->img)
+ last_glyph = s->first_glyph;
+ else if (s->first_glyph->type == COMPOSITE_GLYPH
+ && s->first_glyph->u.cmp.automatic)
+ {
+ /* For automatic compositions, we need to look up the last glyph
+ in the composition. */
+ struct glyph *end = s->row->glyphs[s->area] + s->row->used[s->area];
+ struct glyph *g = s->first_glyph;
+ for (last_glyph = g++;
+ g < end && g->u.cmp.automatic && g->u.cmp.id == s->cmp_id
+ && g->slice.cmp.to < s->cmp_to;
+ last_glyph = g++)
+ ;
+ }
+ else
+ last_glyph = s->first_glyph + s->nchars - 1;
- width = eabs (s->face->box_line_width);
+ vwidth = eabs (s->face->box_vertical_line_width);
+ hwidth = eabs (s->face->box_horizontal_line_width);
raised_p = s->face->box == FACE_RAISED_BOX;
left_x = s->x;
right_x = (s->row->full_width_p && s->extends_to_end_of_line_p
@@ -3018,13 +3006,13 @@ x_draw_glyph_string_box (struct glyph_string *s)
get_glyph_string_clip_rect (s, &clip_rect);
if (s->face->box == FACE_SIMPLE_BOX)
- x_draw_box_rect (s, left_x, top_y, right_x, bottom_y, width,
- left_p, right_p, &clip_rect);
+ x_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth,
+ vwidth, left_p, right_p, &clip_rect);
else
{
x_setup_relief_colors (s);
- x_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y,
- width, raised_p, true, true, left_p, right_p,
+ x_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y, hwidth,
+ vwidth, raised_p, true, true, left_p, right_p,
&clip_rect);
}
}
@@ -3082,7 +3070,7 @@ x_draw_image_foreground (struct glyph_string *s)
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
- x += eabs (s->face->box_line_width);
+ x += max (s->face->box_vertical_line_width, 0);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
@@ -3201,7 +3189,7 @@ x_draw_image_relief (struct glyph_string *s)
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
- x += eabs (s->face->box_line_width);
+ x += max (s->face->box_vertical_line_width, 0);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
@@ -3269,7 +3257,7 @@ x_draw_image_relief (struct glyph_string *s)
x_setup_relief_colors (s);
get_glyph_string_clip_rect (s, &r);
- x_draw_relief_rect (s->f, x, y, x1, y1, thick, raised_p,
+ x_draw_relief_rect (s->f, x, y, x1, y1, thick, thick, raised_p,
top_p, bot_p, left_p, right_p, &r);
}
@@ -3288,7 +3276,7 @@ x_draw_image_foreground_1 (struct glyph_string *s, Pixmap pixmap)
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
- x += eabs (s->face->box_line_width);
+ x += max (s->face->box_vertical_line_width, 0);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
@@ -3390,8 +3378,8 @@ x_draw_glyph_string_bg_rect (struct glyph_string *s, int x, int y, int w, int h)
static void
x_draw_image_glyph_string (struct glyph_string *s)
{
- int box_line_hwidth = eabs (s->face->box_line_width);
- int box_line_vwidth = max (s->face->box_line_width, 0);
+ int box_line_hwidth = max (s->face->box_vertical_line_width, 0);
+ int box_line_vwidth = max (s->face->box_horizontal_line_width, 0);
int height;
#ifndef USE_CAIRO
Display *display = FRAME_X_DISPLAY (s->f);
@@ -4786,6 +4774,16 @@ x_detect_focus_change (struct x_display_info *dpyinfo, struct frame *frame,
case FocusIn:
case FocusOut:
+ /* Ignore transient focus events from hotkeys, window manager
+ gadgets, and other odd sources. Some buggy window managers
+ (e.g., Muffin 4.2.4) send FocusIn events of this type without
+ corresponding FocusOut events even when some other window
+ really has focus, and these kinds of focus event don't
+ correspond to real user input changes. GTK+ uses the same
+ filtering. */
+ if (event->xfocus.mode == NotifyGrab ||
+ event->xfocus.mode == NotifyUngrab)
+ return;
x_focus_changed (event->type,
(event->xfocus.detail == NotifyPointer ?
FOCUS_IMPLICIT : FOCUS_EXPLICIT),
@@ -8701,7 +8699,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (nchars == nbytes)
ch = copy_bufptr[i], len = 1;
else
- ch = STRING_CHAR_AND_LENGTH (copy_bufptr + i, len);
+ ch = string_char_and_length (copy_bufptr + i, &len);
inev.ie.kind = (SINGLE_BYTE_CHAR_P (ch)
? ASCII_KEYSTROKE_EVENT
: MULTIBYTE_CHAR_KEYSTROKE_EVENT);
@@ -9923,6 +9921,13 @@ x_uncatch_errors (void)
{
struct x_error_message_stack *tmp;
+ /* In rare situations when running Emacs run in daemon mode,
+ shutting down an emacsclient via delete-frame can cause
+ x_uncatch_errors to be called when x_error_message is set to
+ NULL. */
+ if (x_error_message == NULL)
+ return;
+
block_input ();
/* The display may have been closed before this function is called.
diff --git a/src/xterm.h b/src/xterm.h
index bc10043c54c..0f8ba5e82b4 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -890,7 +890,7 @@ struct scroll_bar
editing large files, we establish a minimum height by always
drawing handle bottoms VERTICAL_SCROLL_BAR_MIN_HANDLE pixels below
where they would be normally; the bottom and top are in a
- different co-ordinate system. */
+ different coordinate system. */
int start, end;
/* If the scroll bar handle is currently being dragged by the user,
@@ -1207,6 +1207,7 @@ extern int x_check_property_data (Lisp_Object);
extern void x_fill_property_data (Display *,
Lisp_Object,
void *,
+ int,
int);
extern Lisp_Object x_property_data_to_lisp (struct frame *,
const unsigned char *,
diff --git a/src/xwidget.c b/src/xwidget.c
index ea8987f5b3b..154b3e9c82c 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -23,13 +23,21 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "lisp.h"
#include "blockinput.h"
+#include "dispextern.h"
#include "frame.h"
#include "keyboard.h"
#include "gtkutil.h"
#include "sysstdio.h"
+#include "termhooks.h"
+#include "window.h"
+/* Include xwidget bottom end headers. */
+#ifdef USE_GTK
#include <webkit2/webkit2.h>
#include <JavaScriptCore/JavaScript.h>
+#elif defined NS_IMPL_COCOA
+#include "nsxwidget.h"
+#endif
static struct xwidget *
allocate_xwidget (void)
@@ -48,6 +56,7 @@ allocate_xwidget_view (void)
static struct xwidget_view *xwidget_view_lookup (struct xwidget *,
struct window *);
+#ifdef USE_GTK
static void webkit_view_load_changed_cb (WebKitWebView *,
WebKitLoadEvent,
gpointer);
@@ -61,6 +70,7 @@ webkit_decide_policy_cb (WebKitWebView *,
WebKitPolicyDecision *,
WebKitPolicyDecisionType,
gpointer);
+#endif
DEFUN ("make-xwidget",
@@ -78,8 +88,10 @@ Returns the newly constructed xwidget, or nil if construction fails. */)
Lisp_Object title, Lisp_Object width, Lisp_Object height,
Lisp_Object arguments, Lisp_Object buffer)
{
+#ifdef USE_GTK
if (!xg_gtk_initialized)
error ("make-xwidget: GTK has not been initialized");
+#endif
CHECK_SYMBOL (type);
CHECK_FIXNAT (width);
CHECK_FIXNAT (height);
@@ -94,10 +106,11 @@ Returns the newly constructed xwidget, or nil if construction fails. */)
xw->kill_without_query = false;
XSETXWIDGET (val, xw);
Vxwidget_list = Fcons (val, Vxwidget_list);
- xw->widgetwindow_osr = NULL;
- xw->widget_osr = NULL;
xw->plist = Qnil;
+#ifdef USE_GTK
+ xw->widgetwindow_osr = NULL;
+ xw->widget_osr = NULL;
if (EQ (xw->type, Qwebkit))
{
block_input ();
@@ -152,6 +165,9 @@ Returns the newly constructed xwidget, or nil if construction fails. */)
unblock_input ();
}
+#elif defined NS_IMPL_COCOA
+ nsxwidget_init (xw);
+#endif
return val;
}
@@ -187,6 +203,7 @@ xwidget_hidden (struct xwidget_view *xv)
return xv->hidden;
}
+#ifdef USE_GTK
static void
xwidget_show_view (struct xwidget_view *xv)
{
@@ -220,13 +237,14 @@ offscreen_damage_event (GtkWidget *widget, GdkEvent *event,
if (GTK_IS_WIDGET (xv_widget))
gtk_widget_queue_draw (GTK_WIDGET (xv_widget));
else
- printf ("Warning, offscreen_damage_event received invalid xv pointer:%p\n",
- xv_widget);
+ message ("Warning, offscreen_damage_event received invalid xv pointer:%p\n",
+ xv_widget);
return FALSE;
}
+#endif /* USE_GTK */
-static void
+void
store_xwidget_event_string (struct xwidget *xw, const char *eventname,
const char *eventstr)
{
@@ -240,7 +258,27 @@ store_xwidget_event_string (struct xwidget *xw, const char *eventname,
kbd_buffer_store_event (&event);
}
-static void
+void
+store_xwidget_download_callback_event (struct xwidget *xw,
+ const char *url,
+ const char *mimetype,
+ const char *filename)
+{
+ struct input_event event;
+ Lisp_Object xwl;
+ XSETXWIDGET (xwl, xw);
+ EVENT_INIT (event);
+ event.kind = XWIDGET_EVENT;
+ event.frame_or_window = Qnil;
+ event.arg = list5 (intern ("download-callback"),
+ xwl,
+ build_string (url),
+ build_string (mimetype),
+ build_string (filename));
+ kbd_buffer_store_event (&event);
+}
+
+void
store_xwidget_js_callback_event (struct xwidget *xw,
Lisp_Object proc,
Lisp_Object argument)
@@ -256,6 +294,7 @@ store_xwidget_js_callback_event (struct xwidget *xw,
}
+#ifdef USE_GTK
void
webkit_view_load_changed_cb (WebKitWebView *webkitwebview,
WebKitLoadEvent load_event,
@@ -304,7 +343,7 @@ webkit_js_to_lisp (JSCValue *value)
memory_full (SIZE_MAX);
ptrdiff_t n = dlen;
- struct Lisp_Vector *p = allocate_vector (n);
+ struct Lisp_Vector *p = allocate_nil_vector (n);
for (ptrdiff_t i = 0; i < n; ++i)
{
@@ -322,7 +361,7 @@ webkit_js_to_lisp (JSCValue *value)
Lisp_Object obj;
if (PTRDIFF_MAX < n)
memory_full (n);
- struct Lisp_Vector *p = allocate_vector (n);
+ struct Lisp_Vector *p = allocate_nil_vector (n);
for (ptrdiff_t i = 0; i < n; ++i)
{
@@ -486,6 +525,7 @@ xwidget_osr_event_set_embedder (GtkWidget *widget, GdkEvent *event,
gtk_widget_get_window (xv->widget));
return FALSE;
}
+#endif /* USE_GTK */
/* Initializes and does initial placement of an xwidget view on screen. */
@@ -495,8 +535,10 @@ xwidget_init_view (struct xwidget *xww,
int x, int y)
{
+#ifdef USE_GTK
if (!xg_gtk_initialized)
error ("xwidget_init_view: GTK has not been initialized");
+#endif
struct xwidget_view *xv = allocate_xwidget_view ();
Lisp_Object val;
@@ -507,6 +549,7 @@ xwidget_init_view (struct xwidget *xww,
XSETWINDOW (xv->w, s->w);
XSETXWIDGET (xv->model, xww);
+#ifdef USE_GTK
if (EQ (xww->type, Qwebkit))
{
xv->widget = gtk_drawing_area_new ();
@@ -564,6 +607,10 @@ xwidget_init_view (struct xwidget *xww,
xv->x = x;
xv->y = y;
gtk_widget_show_all (xv->widgetwindow);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_init_view (xv, xww, s, x, y);
+ nsxwidget_resize_view(xv, xww->width, xww->height);
+#endif
return xv;
}
@@ -576,6 +623,7 @@ x_draw_xwidget_glyph_string (struct glyph_string *s)
initialization. */
struct xwidget *xww = s->xwidget;
struct xwidget_view *xv = xwidget_view_lookup (xww, s->w);
+ int text_area_x, text_area_y, text_area_width, text_area_height;
int clip_right;
int clip_bottom;
int clip_top;
@@ -587,13 +635,47 @@ x_draw_xwidget_glyph_string (struct glyph_string *s)
/* Do initialization here in the display loop because there is no
other time to know things like window placement etc. Do not
create a new view if we have found one that is usable. */
+#ifdef USE_GTK
if (!xv)
xv = xwidget_init_view (xww, s, x, y);
-
- int text_area_x, text_area_y, text_area_width, text_area_height;
+#elif defined NS_IMPL_COCOA
+ if (!xv)
+ {
+ /* Enforce 1 to 1, model and view for macOS Cocoa webkit2. */
+ if (xww->xv)
+ {
+ if (xwidget_hidden (xww->xv))
+ {
+ Lisp_Object xvl;
+ XSETXWIDGET_VIEW (xvl, xww->xv);
+ Fdelete_xwidget_view (xvl);
+ }
+ else
+ {
+ message ("You can't share an xwidget (webkit2) among windows.");
+ return;
+ }
+ }
+ xv = xwidget_init_view (xww, s, x, y);
+ }
+#endif
window_box (s->w, TEXT_AREA, &text_area_x, &text_area_y,
&text_area_width, &text_area_height);
+
+ /* Resize xwidget webkit if its container window size is changed in
+ some ways, for example, a buffer became hidden in small split
+ window, then it can appear front in merged whole window. */
+ if (EQ (xww->type, Qwebkit)
+ && (xww->width != text_area_width || xww->height != text_area_height))
+ {
+ Lisp_Object xwl;
+ XSETXWIDGET (xwl, xww);
+ Fxwidget_resize (xwl,
+ make_int (text_area_width),
+ make_int (text_area_height));
+ }
+
clip_left = max (0, text_area_x - x);
clip_right = max (clip_left,
min (xww->width, text_area_x + text_area_width - x));
@@ -616,8 +698,14 @@ x_draw_xwidget_glyph_string (struct glyph_string *s)
/* Has it moved? */
if (moved)
- gtk_fixed_move (GTK_FIXED (FRAME_GTK_WIDGET (s->f)),
- xv->widgetwindow, x + clip_left, y + clip_top);
+ {
+#ifdef USE_GTK
+ gtk_fixed_move (GTK_FIXED (FRAME_GTK_WIDGET (s->f)),
+ xv->widgetwindow, x + clip_left, y + clip_top);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_move_view (xv, x + clip_left, y + clip_top);
+#endif
+ }
/* Clip the widget window if some parts happen to be outside
drawable area. An Emacs window is not a gtk window. A gtk window
@@ -628,10 +716,16 @@ x_draw_xwidget_glyph_string (struct glyph_string *s)
|| xv->clip_bottom != clip_bottom
|| xv->clip_top != clip_top || xv->clip_left != clip_left)
{
+#ifdef USE_GTK
gtk_widget_set_size_request (xv->widgetwindow, clip_right - clip_left,
clip_bottom - clip_top);
gtk_fixed_move (GTK_FIXED (xv->widgetwindow), xv->widget, -clip_left,
-clip_top);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_resize_view (xv, clip_right - clip_left,
+ clip_bottom - clip_top);
+ nsxwidget_move_widget_in_view (xv, -clip_left, -clip_top);
+#endif
xv->clip_right = clip_right;
xv->clip_bottom = clip_bottom;
@@ -645,22 +739,66 @@ x_draw_xwidget_glyph_string (struct glyph_string *s)
xwidgets background. It's just a visual glitch though. */
if (!xwidget_hidden (xv))
{
+#ifdef USE_GTK
gtk_widget_queue_draw (xv->widgetwindow);
gtk_widget_queue_draw (xv->widget);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_set_needsdisplay (xv);
+#endif
}
}
-/* Macro that checks WEBKIT_IS_WEB_VIEW (xw->widget_osr) first. */
+static bool
+xwidget_is_web_view (struct xwidget *xw)
+{
+#ifdef USE_GTK
+ return xw->widget_osr != NULL && WEBKIT_IS_WEB_VIEW (xw->widget_osr);
+#elif defined NS_IMPL_COCOA
+ return nsxwidget_is_web_view (xw);
+#endif
+}
+
+/* Macro that checks xwidget hold webkit web view first. */
#define WEBKIT_FN_INIT() \
CHECK_XWIDGET (xwidget); \
struct xwidget *xw = XXWIDGET (xwidget); \
- if (!xw->widget_osr || !WEBKIT_IS_WEB_VIEW (xw->widget_osr)) \
+ if (!xwidget_is_web_view (xw)) \
{ \
fputs ("ERROR xw->widget_osr does not hold a webkit instance\n", \
stdout); \
return Qnil; \
}
+DEFUN ("xwidget-webkit-uri",
+ Fxwidget_webkit_uri, Sxwidget_webkit_uri,
+ 1, 1, 0,
+ doc: /* Get the current URL of XWIDGET webkit. */)
+ (Lisp_Object xwidget)
+{
+ WEBKIT_FN_INIT ();
+#ifdef USE_GTK
+ WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr);
+ return build_string (webkit_web_view_get_uri (wkwv));
+#elif defined NS_IMPL_COCOA
+ return nsxwidget_webkit_uri (xw);
+#endif
+}
+
+DEFUN ("xwidget-webkit-title",
+ Fxwidget_webkit_title, Sxwidget_webkit_title,
+ 1, 1, 0,
+ doc: /* Get the current title of XWIDGET webkit. */)
+ (Lisp_Object xwidget)
+{
+ WEBKIT_FN_INIT ();
+#ifdef USE_GTK
+ WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr);
+ return build_string (webkit_web_view_get_title (wkwv));
+#elif defined NS_IMPL_COCOA
+ return nsxwidget_webkit_title (xw);
+#endif
+}
+
DEFUN ("xwidget-webkit-goto-uri",
Fxwidget_webkit_goto_uri, Sxwidget_webkit_goto_uri,
2, 2, 0,
@@ -670,7 +808,36 @@ DEFUN ("xwidget-webkit-goto-uri",
WEBKIT_FN_INIT ();
CHECK_STRING (uri);
uri = ENCODE_FILE (uri);
+#ifdef USE_GTK
webkit_web_view_load_uri (WEBKIT_WEB_VIEW (xw->widget_osr), SSDATA (uri));
+#elif defined NS_IMPL_COCOA
+ nsxwidget_webkit_goto_uri (xw, SSDATA (uri));
+#endif
+ return Qnil;
+}
+
+DEFUN ("xwidget-webkit-goto-history",
+ Fxwidget_webkit_goto_history, Sxwidget_webkit_goto_history,
+ 2, 2, 0,
+ doc: /* Make the XWIDGET webkit load REL-POS (-1, 0, 1) page in browse history. */)
+ (Lisp_Object xwidget, Lisp_Object rel_pos)
+{
+ WEBKIT_FN_INIT ();
+ /* Should be one of -1, 0, 1 */
+ if (XFIXNUM (rel_pos) < -1 || XFIXNUM (rel_pos) > 1)
+ args_out_of_range_3 (rel_pos, make_fixnum (-1), make_fixnum (1));
+
+#ifdef USE_GTK
+ WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr);
+ switch (XFIXNAT (rel_pos))
+ {
+ case -1: webkit_web_view_go_back (wkwv); break;
+ case 0: webkit_web_view_reload (wkwv); break;
+ case 1: webkit_web_view_go_forward (wkwv); break;
+ }
+#elif defined NS_IMPL_COCOA
+ nsxwidget_webkit_goto_history (xw, XFIXNAT (rel_pos));
+#endif
return Qnil;
}
@@ -684,14 +851,19 @@ DEFUN ("xwidget-webkit-zoom",
if (FLOATP (factor))
{
double zoom_change = XFLOAT_DATA (factor);
+#ifdef USE_GTK
webkit_web_view_set_zoom_level
(WEBKIT_WEB_VIEW (xw->widget_osr),
webkit_web_view_get_zoom_level
(WEBKIT_WEB_VIEW (xw->widget_osr)) + zoom_change);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_webkit_zoom (xw, zoom_change);
+#endif
}
return Qnil;
}
+#ifdef USE_GTK
/* Save script and fun in the script/callback save vector and return
its index. */
static ptrdiff_t
@@ -713,6 +885,7 @@ save_script_callback (struct xwidget *xw, Lisp_Object script, Lisp_Object fun)
ASET (cbs, idx, Fcons (make_mint_ptr (xlispstrdup (script)), fun));
return idx;
}
+#endif
DEFUN ("xwidget-webkit-execute-script",
Fxwidget_webkit_execute_script, Sxwidget_webkit_execute_script,
@@ -729,6 +902,7 @@ argument procedure FUN.*/)
script = ENCODE_SYSTEM (script);
+#ifdef USE_GTK
/* Protect script and fun during GC. */
intptr_t idx = save_script_callback (xw, script, fun);
@@ -742,6 +916,9 @@ argument procedure FUN.*/)
NULL, /* cancelable */
webkit_javascript_finished_cb,
(gpointer) idx);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_webkit_execute_script (xw, SSDATA (script), fun);
+#endif
return Qnil;
}
@@ -750,16 +927,15 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0,
(Lisp_Object xwidget, Lisp_Object new_width, Lisp_Object new_height)
{
CHECK_XWIDGET (xwidget);
- CHECK_RANGED_INTEGER (new_width, 0, INT_MAX);
- CHECK_RANGED_INTEGER (new_height, 0, INT_MAX);
+ int w = check_integer_range (new_width, 0, INT_MAX);
+ int h = check_integer_range (new_height, 0, INT_MAX);
struct xwidget *xw = XXWIDGET (xwidget);
- int w = XFIXNAT (new_width);
- int h = XFIXNAT (new_height);
xw->width = w;
xw->height = h;
/* If there is an offscreen widget resize it first. */
+#ifdef USE_GTK
if (xw->widget_osr)
{
gtk_window_resize (GTK_WINDOW (xw->widgetwindow_osr), xw->width,
@@ -768,6 +944,9 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0,
gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width,
xw->height);
}
+#elif defined NS_IMPL_COCOA
+ nsxwidget_resize (xw);
+#endif
for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); tail = XCDR (tail))
{
@@ -775,8 +954,14 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0,
{
struct xwidget_view *xv = XXWIDGET_VIEW (XCAR (tail));
if (XXWIDGET (xv->model) == xw)
+ {
+#ifdef USE_GTK
gtk_widget_set_size_request (GTK_WIDGET (xv->widget), xw->width,
xw->height);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_resize_view(xv, xw->width, xw->height);
+#endif
+ }
}
}
@@ -795,9 +980,13 @@ Emacs allocated area accordingly. */)
(Lisp_Object xwidget)
{
CHECK_XWIDGET (xwidget);
+#ifdef USE_GTK
GtkRequisition requisition;
gtk_widget_size_request (XXWIDGET (xwidget)->widget_osr, &requisition);
return list2i (requisition.width, requisition.height);
+#elif defined NS_IMPL_COCOA
+ return nsxwidget_get_size (XXWIDGET (xwidget));
+#endif
}
DEFUN ("xwidgetp",
@@ -874,14 +1063,19 @@ DEFUN ("delete-xwidget-view",
{
CHECK_XWIDGET_VIEW (xwidget_view);
struct xwidget_view *xv = XXWIDGET_VIEW (xwidget_view);
+#ifdef USE_GTK
gtk_widget_destroy (xv->widgetwindow);
- Vxwidget_view_list = Fdelq (xwidget_view, Vxwidget_view_list);
/* xv->model still has signals pointing to the view. There can be
several views. Find the matching signals and delete them all. */
g_signal_handlers_disconnect_matched (XXWIDGET (xv->model)->widgetwindow_osr,
G_SIGNAL_MATCH_DATA,
0, 0, 0, 0,
xv->widget);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_delete_view (xv);
+#endif
+
+ Vxwidget_view_list = Fdelq (xwidget_view, Vxwidget_view_list);
return Qnil;
}
@@ -987,7 +1181,10 @@ syms_of_xwidget (void)
defsubr (&Sxwidget_query_on_exit_flag);
defsubr (&Sset_xwidget_query_on_exit_flag);
+ defsubr (&Sxwidget_webkit_uri);
+ defsubr (&Sxwidget_webkit_title);
defsubr (&Sxwidget_webkit_goto_uri);
+ defsubr (&Sxwidget_webkit_goto_history);
defsubr (&Sxwidget_webkit_zoom);
defsubr (&Sxwidget_webkit_execute_script);
DEFSYM (Qwebkit, "webkit");
@@ -1158,11 +1355,19 @@ xwidget_end_redisplay (struct window *w, struct glyph_matrix *matrix)
xwidget_end_redisplay (w->current_matrix); */
struct xwidget_view *xv
= xwidget_view_lookup (glyph->u.xwidget, w);
+#ifdef USE_GTK
/* FIXME: Is it safe to assume xwidget_view_lookup
always succeeds here? If so, this comment can be removed.
If not, the code probably needs fixing. */
eassume (xv);
xwidget_touch (xv);
+#elif defined NS_IMPL_COCOA
+ /* In NS xwidget, xv can be NULL for the second or
+ later views for a model, the result of 1 to 1
+ model view relation enforcement. */
+ if (xv)
+ xwidget_touch (xv);
+#endif
}
}
}
@@ -1179,9 +1384,21 @@ xwidget_end_redisplay (struct window *w, struct glyph_matrix *matrix)
if (XWINDOW (xv->w) == w)
{
if (xwidget_touched (xv))
- xwidget_show_view (xv);
+ {
+#ifdef USE_GTK
+ xwidget_show_view (xv);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_show_view (xv);
+#endif
+ }
else
- xwidget_hide_view (xv);
+ {
+#ifdef USE_GTK
+ xwidget_hide_view (xv);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_hide_view (xv);
+#endif
+ }
}
}
}
@@ -1200,6 +1417,7 @@ kill_buffer_xwidgets (Lisp_Object buffer)
{
CHECK_XWIDGET (xwidget);
struct xwidget *xw = XXWIDGET (xwidget);
+#ifdef USE_GTK
if (xw->widget_osr && xw->widgetwindow_osr)
{
gtk_widget_destroy (xw->widget_osr);
@@ -1213,6 +1431,9 @@ kill_buffer_xwidgets (Lisp_Object buffer)
xfree (xmint_pointer (XCAR (cb)));
ASET (xw->script_callbacks, idx, Qnil);
}
+#elif defined NS_IMPL_COCOA
+ nsxwidget_kill (xw);
+#endif
}
}
}
diff --git a/src/xwidget.h b/src/xwidget.h
index 99fa8bbd612..40ad8ae8334 100644
--- a/src/xwidget.h
+++ b/src/xwidget.h
@@ -29,7 +29,13 @@ struct xwidget_view;
struct window;
#ifdef HAVE_XWIDGETS
-# include <gtk/gtk.h>
+
+#if defined (USE_GTK)
+#include <gtk/gtk.h>
+#elif defined (NS_IMPL_COCOA) && defined (__OBJC__)
+#import <AppKit/NSView.h>
+#import "nsxwidget.h"
+#endif
struct xwidget
{
@@ -54,9 +60,25 @@ struct xwidget
int height;
int width;
+#if defined (USE_GTK)
/* For offscreen widgets, unused if not osr. */
GtkWidget *widget_osr;
GtkWidget *widgetwindow_osr;
+#elif defined (NS_IMPL_COCOA)
+# ifdef __OBJC__
+ /* For offscreen widgets, unused if not osr. */
+ NSView *xwWidget;
+ XwWindow *xwWindow;
+
+ /* Used only for xwidget types (such as webkit2) enforcing 1 to 1
+ relationship between model and view. */
+ struct xwidget_view *xv;
+# else
+ void *xwWidget;
+ void *xwWindow;
+ struct xwidget_view *xv;
+# endif
+#endif
/* Kill silently if Emacs is exited. */
bool_bf kill_without_query : 1;
@@ -75,9 +97,20 @@ struct xwidget_view
/* The "live" instance isn't drawn. */
bool hidden;
+#if defined (USE_GTK)
GtkWidget *widget;
GtkWidget *widgetwindow;
GtkWidget *emacswindow;
+#elif defined (NS_IMPL_COCOA)
+# ifdef __OBJC__
+ XvWindow *xvWindow;
+ NSView *emacswindow;
+# else
+ void *xvWindow;
+ void *emacswindow;
+# endif
+#endif
+
int x;
int y;
int clip_right;
@@ -116,6 +149,19 @@ void x_draw_xwidget_glyph_string (struct glyph_string *);
struct xwidget *lookup_xwidget (Lisp_Object spec);
void xwidget_end_redisplay (struct window *, struct glyph_matrix *);
void kill_buffer_xwidgets (Lisp_Object);
+/* Defined in 'xwidget.c'. */
+void store_xwidget_event_string (struct xwidget *xw,
+ const char *eventname,
+ const char *eventstr);
+
+void store_xwidget_download_callback_event (struct xwidget *xw,
+ const char *url,
+ const char *mimetype,
+ const char *filename);
+
+void store_xwidget_js_callback_event (struct xwidget *xw,
+ Lisp_Object proc,
+ Lisp_Object argument);
#else
INLINE_HEADER_BEGIN
INLINE void syms_of_xwidget (void) {}
diff --git a/test/ChangeLog.1 b/test/ChangeLog.1
index c364219c362..2bf014d0a95 100644
--- a/test/ChangeLog.1
+++ b/test/ChangeLog.1
@@ -1754,7 +1754,7 @@
* indent/prolog.prolog: Test alignment of ->; with operator at bol.
- * indent/css-mode.css (.x2): Test alignement inside braces.
+ * indent/css-mode.css (.x2): Test alignment inside braces.
2013-10-26 Dmitry Gutov <dgutov@yandex.ru>
diff --git a/test/Makefile.in b/test/Makefile.in
index 0003e763abe..9974eb54b03 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -89,11 +89,6 @@ unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS
## To run tests under a debugger, set this to eg: "gdb --args".
GDB =
-# The locale to run tests under. Tests should work if this is set to
-# any supported locale. Use the C locale by default, as it should be
-# supported everywhere.
-TEST_LOCALE = C
-
# Set this to 'yes' to run the tests in an interactive instance.
TEST_INTERACTIVE ?= no
@@ -128,7 +123,7 @@ endif
# The actual Emacs command run in the targets below.
# Prevent any setting of EMACSLOADPATH in user environment causing problems.
-emacs = EMACSLOADPATH= LC_ALL=$(TEST_LOCALE) \
+emacs = EMACSLOADPATH= \
EMACS_TEST_DIRECTORY=$(abspath $(srcdir)) \
$(GDB) "$(EMACS)" $(MODULES_EMACSOPT) $(EMACSOPT)
@@ -255,8 +250,8 @@ else
FPIC_CFLAGS = -fPIC
endif
-GMP_LIB = @GMP_LIB@
-GMP_OBJ = $(if @GMP_OBJ@, ../src/@GMP_OBJ@)
+GMP_H = @GMP_H@
+LIBGMP = @LIBGMP@
MODULE_CFLAGS = -I../src -I$(srcdir)/../src -I../lib -I$(srcdir)/../lib \
$(FPIC_CFLAGS) $(PROFILING_CFLAGS) \
@@ -271,7 +266,8 @@ src/emacs-module-tests.log src/emacs-module-tests.elc: $(test_module)
$(test_module): $(test_module:${SO}=.c) ../src/emacs-module.h
$(AM_V_at)${MKDIR_P} $(dir $@)
$(AM_V_CCLD)$(CC) -shared $(CPPFLAGS) $(MODULE_CFLAGS) $(LDFLAGS) \
- -o $@ $< $(GMP_LIB) $(GMP_OBJ:.o=.c) \
+ -o $@ $< $(LIBGMP) \
+ $(and $(GMP_H),$(srcdir)/../lib/mini-gmp-gnulib.c) \
$(srcdir)/../lib/timespec.c $(srcdir)/../lib/gettime.c
endif
diff --git a/test/README b/test/README
index 1f69f7142c1..fe05b5403b1 100644
--- a/test/README
+++ b/test/README
@@ -64,6 +64,11 @@ protect against "make" variable expansion):
make <filename> SELECTOR='"foo$$"'
+In case you want to use the symbol name of a test as selector, you can
+use it directly:
+
+ make <filename> SELECTOR='test-foo-remote'
+
Note that although the test files are always compiled (unless they set
no-byte-compile), the source files will be run when expensive or
unstable tests are involved, to give nicer backtraces. To run the
diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index 8d1b421bb40..da298d4e398 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -24,17 +24,26 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <errno.h>
#include <limits.h>
+#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
-#ifdef HAVE_GMP
-#include <gmp.h>
-#else
-#include "mini-gmp.h"
+#ifdef WINDOWSNT
+/* Cannot include <process.h> because of the local header by the same
+ name, sigh. */
+uintptr_t _beginthread (void (__cdecl *)(void *), unsigned, void *);
+# if !defined __x86_64__
+# define ALIGN_STACK __attribute__((force_align_arg_pointer))
+# endif
+# include <windows.h> /* for Sleep */
+#else /* !WINDOWSNT */
+# include <pthread.h>
+# include <unistd.h>
#endif
+#include <gmp.h>
#include <emacs-module.h>
#include "timespec.h"
@@ -86,6 +95,7 @@ static emacs_value
Fmod_test_sum (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data)
{
assert (nargs == 2);
+ assert ((uintptr_t) data == 0x1234);
intmax_t a = env->extract_integer (env, args[0]);
intmax_t b = env->extract_integer (env, args[1]);
@@ -252,7 +262,9 @@ Fmod_test_string_a_to_b (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
if (buf[i] == 'a')
buf[i] = 'b';
- return env->make_string (env, buf, size - 1);
+ emacs_value ret = env->make_string (env, buf, size - 1);
+ free (buf);
+ return ret;
}
@@ -354,7 +366,7 @@ Fmod_test_invalid_store_copy (emacs_env *env, ptrdiff_t nargs,
}
/* An invalid finalizer: Finalizers are run during garbage collection,
- where Lisp code can’t be executed. -module-assertions tests for
+ where Lisp code can't be executed. -module-assertions tests for
this case. */
static emacs_env *current_env;
@@ -375,9 +387,9 @@ Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
}
static void
-signal_errno (emacs_env *env, const char *function)
+signal_system_error (emacs_env *env, int error, const char *function)
{
- const char *message = strerror (errno);
+ const char *message = strerror (error);
emacs_value message_value = env->make_string (env, message, strlen (message));
emacs_value symbol = env->intern (env, "file-error");
emacs_value elements[2]
@@ -386,6 +398,12 @@ signal_errno (emacs_env *env, const char *function)
env->non_local_exit_signal (env, symbol, data);
}
+static void
+signal_errno (emacs_env *env, const char *function)
+{
+ signal_system_error (env, errno, function);
+}
+
/* A long-running operation that occasionally calls `should_quit' or
`process_input'. */
@@ -430,15 +448,20 @@ Fmod_test_add_nanosecond (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
}
static void
-memory_full (emacs_env *env)
+signal_error (emacs_env *env, const char *message)
{
- const char *message = "Memory exhausted";
emacs_value data = env->make_string (env, message, strlen (message));
env->non_local_exit_signal (env, env->intern (env, "error"),
env->funcall (env, env->intern (env, "list"), 1,
&data));
}
+static void
+memory_full (emacs_env *env)
+{
+ signal_error (env, "Memory exhausted");
+}
+
enum
{
max_count = ((SIZE_MAX < PTRDIFF_MAX ? SIZE_MAX : PTRDIFF_MAX)
@@ -547,6 +570,117 @@ Fmod_test_double (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
return result;
}
+static int function_data;
+static int finalizer_calls_with_correct_data;
+static int finalizer_calls_with_incorrect_data;
+
+static void
+finalizer (void *data)
+{
+ if (data == &function_data)
+ ++finalizer_calls_with_correct_data;
+ else
+ ++finalizer_calls_with_incorrect_data;
+}
+
+static emacs_value
+Fmod_test_make_function_with_finalizer (emacs_env *env, ptrdiff_t nargs,
+ emacs_value *args, void *data)
+{
+ emacs_value fun
+ = env->make_function (env, 2, 2, Fmod_test_sum, NULL, &function_data);
+ env->set_function_finalizer (env, fun, finalizer);
+ if (env->get_function_finalizer (env, fun) != finalizer)
+ signal_error (env, "Invalid finalizer");
+ return fun;
+}
+
+static emacs_value
+Fmod_test_function_finalizer_calls (emacs_env *env, ptrdiff_t nargs,
+ emacs_value *args, void *data)
+{
+ emacs_value Flist = env->intern (env, "list");
+ emacs_value list_args[]
+ = {env->make_integer (env, finalizer_calls_with_correct_data),
+ env->make_integer (env, finalizer_calls_with_incorrect_data)};
+ return env->funcall (env, Flist, 2, list_args);
+}
+
+static void
+sleep_for_half_second (void)
+{
+ /* mingw.org's MinGW has nanosleep, but MinGW64 doesn't. */
+#ifdef WINDOWSNT
+ Sleep (500);
+#else
+ const struct timespec sleep = {0, 500000000};
+ if (nanosleep (&sleep, NULL) != 0)
+ perror ("nanosleep");
+#endif
+}
+
+#ifdef WINDOWSNT
+static void ALIGN_STACK
+#else
+static void *
+#endif
+write_to_pipe (void *arg)
+{
+ /* We sleep a bit to test that writing to a pipe is indeed possible
+ if no environment is active. */
+ sleep_for_half_second ();
+ FILE *stream = arg;
+ /* The string below should be identical to the one we compare with
+ in emacs-module-tests.el:module/async-pipe. */
+ if (fputs ("data from thread", stream) < 0)
+ perror ("fputs");
+ if (fclose (stream) != 0)
+ perror ("close");
+#ifndef WINDOWSNT
+ return NULL;
+#endif
+}
+
+static emacs_value
+Fmod_test_async_pipe (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+ void *data)
+{
+ assert (nargs == 1);
+ int fd = env->open_channel (env, args[0]);
+ if (env->non_local_exit_check (env) != emacs_funcall_exit_return)
+ return NULL;
+ FILE *stream = fdopen (fd, "w");
+ if (stream == NULL)
+ {
+ signal_errno (env, "fdopen");
+ return NULL;
+ }
+#ifdef WINDOWSNT
+ uintptr_t thd = _beginthread (write_to_pipe, 0, stream);
+ int error = (thd == (uintptr_t)-1L) ? errno : 0;
+#else /* !WINDOWSNT */
+ pthread_t thread;
+ int error
+ = pthread_create (&thread, NULL, write_to_pipe, stream);
+#endif
+ if (error != 0)
+ {
+ signal_system_error (env, error, "thread create");
+ if (fclose (stream) != 0)
+ perror ("fclose");
+ return NULL;
+ }
+ return env->intern (env, "nil");
+}
+
+static emacs_value
+Fmod_test_identity (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+ void *data)
+{
+ assert (nargs == 1);
+ return args[0];
+}
+
/* Lisp utilities for easier readability (simple wrappers). */
/* Provide FEATURE to Emacs. */
@@ -603,7 +737,8 @@ emacs_module_init (struct emacs_runtime *ert)
env->make_function (env, amin, amax, csym, doc, data))
DEFUN ("mod-test-return-t", Fmod_test_return_t, 1, 1, NULL, NULL);
- DEFUN ("mod-test-sum", Fmod_test_sum, 2, 2, "Return A + B\n\n(fn a b)", NULL);
+ DEFUN ("mod-test-sum", Fmod_test_sum, 2, 2, "Return A + B\n\n(fn a b)",
+ (void *) (uintptr_t) 0x1234);
DEFUN ("mod-test-signal", Fmod_test_signal, 0, 0, NULL, NULL);
DEFUN ("mod-test-throw", Fmod_test_throw, 0, 0, NULL, NULL);
DEFUN ("mod-test-non-local-exit-funcall", Fmod_test_non_local_exit_funcall,
@@ -629,9 +764,27 @@ emacs_module_init (struct emacs_runtime *ert)
DEFUN ("mod-test-add-nanosecond", Fmod_test_add_nanosecond, 1, 1, NULL, NULL);
DEFUN ("mod-test-nanoseconds", Fmod_test_nanoseconds, 1, 1, NULL, NULL);
DEFUN ("mod-test-double", Fmod_test_double, 1, 1, NULL, NULL);
+ DEFUN ("mod-test-make-function-with-finalizer",
+ Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL);
+ DEFUN ("mod-test-function-finalizer-calls",
+ Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL);
+ DEFUN ("mod-test-async-pipe", Fmod_test_async_pipe, 1, 1, NULL, NULL);
#undef DEFUN
+ emacs_value constant_fn
+ = env->make_function (env, 0, 0, Fmod_test_return_t, NULL, NULL);
+ env->make_interactive (env, constant_fn, env->intern (env, "nil"));
+ bind_function (env, "mod-test-return-t-int", constant_fn);
+
+ emacs_value identity_fn
+ = env->make_function (env, 1, 1, Fmod_test_identity, NULL, NULL);
+ const char *interactive_spec = "i";
+ env->make_interactive (env, identity_fn,
+ env->make_string (env, interactive_spec,
+ strlen (interactive_spec)));
+ bind_function (env, "mod-test-identity", identity_fn);
+
provide (env, "mod-test");
return 0;
}
diff --git a/test/data/mml-sec/.gpg-v21-migrated b/test/data/mml-sec/.gpg-v21-migrated
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/test/data/mml-sec/.gpg-v21-migrated
diff --git a/test/data/mml-sec/gpg-agent.conf b/test/data/mml-sec/gpg-agent.conf
new file mode 100644
index 00000000000..20192990caf
--- /dev/null
+++ b/test/data/mml-sec/gpg-agent.conf
@@ -0,0 +1,5 @@
+# pinentry-program /usr/bin/pinentry-gtk-2
+
+# verbose
+# log-file /tmp/gpg-agent.log
+# debug-all
diff --git a/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key b/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key
new file mode 100644
index 00000000000..58fd0b5edbc
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key b/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key
new file mode 100644
index 00000000000..62f4ab25a69
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key b/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key
new file mode 100644
index 00000000000..2a8ce135fb2
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key b/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key
new file mode 100644
index 00000000000..9f8de71c5e2
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key b/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key
new file mode 100644
index 00000000000..6e4a4e548fd
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key b/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key
new file mode 100644
index 00000000000..cff58edaa89
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key b/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key
new file mode 100644
index 00000000000..14af8662f79
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key b/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key
new file mode 100644
index 00000000000..207a7237d3a
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key b/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key
new file mode 100644
index 00000000000..85ca78da04d
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key b/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key
new file mode 100644
index 00000000000..79f3cd2b841
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key b/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key
new file mode 100644
index 00000000000..776ddf7e9e2
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key b/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key
new file mode 100644
index 00000000000..2b464f0ccbe
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key b/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key
new file mode 100644
index 00000000000..28a07668b21
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key b/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key
new file mode 100644
index 00000000000..137659693bd
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key b/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key
new file mode 100644
index 00000000000..c99824ccd43
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key b/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key
new file mode 100644
index 00000000000..49c2dc58bd8
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key b/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key
new file mode 100644
index 00000000000..ca128408952
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key b/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key
new file mode 100644
index 00000000000..3f14b40927a
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key b/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key
new file mode 100644
index 00000000000..06adc06c427
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key b/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key
new file mode 100644
index 00000000000..cf9a60d233b
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key b/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key
new file mode 100644
index 00000000000..0ed35172fe0
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key b/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key
new file mode 100644
index 00000000000..090059d9e81
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key b/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key
new file mode 100644
index 00000000000..9061f675121
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key b/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key
new file mode 100644
index 00000000000..89f6013100d
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key b/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key
new file mode 100644
index 00000000000..41dac37574e
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key b/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key
new file mode 100644
index 00000000000..5df7b4a5953
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key
Binary files differ
diff --git a/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key b/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key
new file mode 100644
index 00000000000..03daf80975b
--- /dev/null
+++ b/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key
Binary files differ
diff --git a/test/data/mml-sec/pubring.gpg b/test/data/mml-sec/pubring.gpg
new file mode 100644
index 00000000000..6bd169963df
--- /dev/null
+++ b/test/data/mml-sec/pubring.gpg
Binary files differ
diff --git a/test/data/mml-sec/pubring.kbx b/test/data/mml-sec/pubring.kbx
new file mode 100644
index 00000000000..399a0414fd2
--- /dev/null
+++ b/test/data/mml-sec/pubring.kbx
Binary files differ
diff --git a/test/data/mml-sec/secring.gpg b/test/data/mml-sec/secring.gpg
new file mode 100644
index 00000000000..b323c072c04
--- /dev/null
+++ b/test/data/mml-sec/secring.gpg
Binary files differ
diff --git a/test/data/mml-sec/trustdb.gpg b/test/data/mml-sec/trustdb.gpg
new file mode 100644
index 00000000000..09ebd8db114
--- /dev/null
+++ b/test/data/mml-sec/trustdb.gpg
Binary files differ
diff --git a/test/data/mml-sec/trustlist.txt b/test/data/mml-sec/trustlist.txt
new file mode 100644
index 00000000000..f886572d283
--- /dev/null
+++ b/test/data/mml-sec/trustlist.txt
@@ -0,0 +1,26 @@
+# This is the list of trusted keys. Comment lines, like this one, as
+# well as empty lines are ignored. Lines have a length limit but this
+# is not a serious limitation as the format of the entries is fixed and
+# checked by gpg-agent. A non-comment line starts with optional white
+# space, followed by the SHA-1 fingerpint in hex, followed by a flag
+# which may be one of 'P', 'S' or '*' and optionally followed by a list of
+# other flags. The fingerprint may be prefixed with a '!' to mark the
+# key as not trusted. You should give the gpg-agent a HUP or run the
+# command "gpgconf --reload gpg-agent" after changing this file.
+
+
+# Include the default trust list
+include-default
+
+
+# CN=No Expiry
+D0:6A:A1:18:65:3C:C3:8E:9D:0C:AF:56:ED:7A:21:35:E1:58:21:77 S relax
+
+# CN=Second Key Pair
+0E:58:22:9B:80:EE:33:95:9F:F7:18:FE:EF:25:40:2B:47:9D:C6:E2 S relax
+
+# CN=No Expiry two UIDs
+D4:CA:78:E1:47:0B:9F:C2:AE:45:D7:84:64:9B:8C:E6:4E:BB:32:0C S relax
+
+# CN=Different subkeys
+4F:96:2A:B7:F4:76:61:6A:78:3D:72:AA:40:35:D5:9B:5F:88:E9:FC S relax
diff --git a/test/data/syntax-comments.txt b/test/data/syntax-comments.txt
new file mode 100644
index 00000000000..74e08b1b65b
--- /dev/null
+++ b/test/data/syntax-comments.txt
@@ -0,0 +1,66 @@
+/* This file is a test file for tests of the comment handling in src/syntax.c.
+ This includes the testing of comments which figure in parse-partial-sexp
+ and scan-lists. */
+
+/* Straight C comments */
+1/* comment */1
+2/**/2
+3// comment
+3
+4//
+4
+5/*/5
+6*/6
+7/* \*/7
+8*/8
+9/* \\*/9
+10*/10
+11// \
+12
+11
+13// \\
+14
+13
+15/* /*/15
+
+
+/* Straight Pascal comments (not nested) */
+20}20
+21{ Comment }21
+22{}22
+23{
+}23
+24{
+25{25
+}24
+26{ \}26
+
+
+/* Straight Lisp comments (not nested) */
+30
+30
+31; Comment
+31
+32;;;;;;;;;
+32
+33; \
+33
+
+/* Comments within lists */
+50{ /* comment */ }50
+51{ /**/ }51
+52{ // comment
+}52
+53{ //
+}53
+54{ //
+}54
+55{/* */}55
+56{ /* \*/ }56
+57*/57
+58}58
+
+Local Variables:
+mode: fundamental
+eval: (set-syntax-table (make-syntax-table))
+End:
diff --git a/test/data/themes/faces-test-dark-theme.el b/test/data/themes/faces-test-dark-theme.el
index 2eb72d6b358..a5e2ca43627 100644
--- a/test/data/themes/faces-test-dark-theme.el
+++ b/test/data/themes/faces-test-dark-theme.el
@@ -2,18 +2,20 @@
;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
-;; 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/test/data/themes/faces-test-light-theme.el b/test/data/themes/faces-test-light-theme.el
index 4a7c7f6877d..b2f7ec69742 100644
--- a/test/data/themes/faces-test-light-theme.el
+++ b/test/data/themes/faces-test-light-theme.el
@@ -2,18 +2,20 @@
;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
-;; 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/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el
index 901922c03e1..a502bb782f2 100644
--- a/test/lib-src/emacsclient-tests.el
+++ b/test/lib-src/emacsclient-tests.el
@@ -1,4 +1,4 @@
-;;; emacsclient-tests.el --- Test emacsclient
+;;; emacsclient-tests.el --- Test emacsclient -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/allout-tests.el b/test/lisp/allout-tests.el
new file mode 100644
index 00000000000..f7cd6db9cd4
--- /dev/null
+++ b/test/lisp/allout-tests.el
@@ -0,0 +1,148 @@
+;;; allout-tests.el --- Tests for allout.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'allout)
+
+(require 'cl-lib)
+
+(defun allout-tests-obliterate-variable (name)
+ "Completely unbind variable with NAME."
+ (if (local-variable-p name (current-buffer)) (kill-local-variable name))
+ (while (boundp name) (makunbound name)))
+
+(defvar allout-tests-globally-unbound nil
+ "Fodder for allout resumptions tests -- defvar just for byte compiler.")
+(defvar allout-tests-globally-true nil
+ "Fodder for allout resumptions tests -- defvar just for byte compiler.")
+(defvar allout-tests-locally-true nil
+ "Fodder for allout resumptions tests -- defvar just for byte compiler.")
+
+;; For each resumption case, we also test that the right local/global
+;; scopes are affected during resumption effects.
+
+(ert-deftest allout-test-resumption-unbound-return-to-unbound ()
+ "Previously unbound variables return to the unbound state."
+ (with-temp-buffer
+ (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
+ (allout-add-resumptions '(allout-tests-globally-unbound t))
+ (should (not (default-boundp 'allout-tests-globally-unbound)))
+ (should (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
+ (should (boundp 'allout-tests-globally-unbound))
+ (should (equal allout-tests-globally-unbound t))
+ (allout-do-resumptions)
+ (should (not (local-variable-p 'allout-tests-globally-unbound
+ (current-buffer))))
+ (should (not (boundp 'allout-tests-globally-unbound)))))
+
+(ert-deftest allout-test-resumption-variable-resumed ()
+ "Ensure that variable with prior global value is resumed."
+ (with-temp-buffer
+ (allout-tests-obliterate-variable 'allout-tests-globally-true)
+ (setq allout-tests-globally-true t)
+ (allout-add-resumptions '(allout-tests-globally-true nil))
+ (should (equal (default-value 'allout-tests-globally-true) t))
+ (should (local-variable-p 'allout-tests-globally-true (current-buffer)))
+ (should (equal allout-tests-globally-true nil))
+ (allout-do-resumptions)
+ (should (not (local-variable-p 'allout-tests-globally-true
+ (current-buffer))))
+ (should (boundp 'allout-tests-globally-true))
+ (should (equal allout-tests-globally-true t))))
+
+(ert-deftest allout-test-resumption-prior-value-resumed ()
+ "Ensure that prior local value is resumed."
+ (with-temp-buffer
+ (allout-tests-obliterate-variable 'allout-tests-locally-true)
+ (set (make-local-variable 'allout-tests-locally-true) t)
+ (cl-assert (not (default-boundp 'allout-tests-locally-true))
+ nil (concat "Test setup mistake -- variable supposed to"
+ " not have global binding, but it does."))
+ (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer))
+ nil (concat "Test setup mistake -- variable supposed to have"
+ " local binding, but it lacks one."))
+ (allout-add-resumptions '(allout-tests-locally-true nil))
+ (should (not (default-boundp 'allout-tests-locally-true)))
+ (should (local-variable-p 'allout-tests-locally-true (current-buffer)))
+ (should (equal allout-tests-locally-true nil))
+ (allout-do-resumptions)
+ (should (boundp 'allout-tests-locally-true))
+ (should (local-variable-p 'allout-tests-locally-true (current-buffer)))
+ (should (equal allout-tests-locally-true t))
+ (should (not (default-boundp 'allout-tests-locally-true)))))
+
+(ert-deftest allout-test-resumption-multiple-holds ()
+ "Ensure that last of multiple resumptions holds, for various scopes."
+ (with-temp-buffer
+ (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
+ (allout-tests-obliterate-variable 'allout-tests-globally-true)
+ (setq allout-tests-globally-true t)
+ (allout-tests-obliterate-variable 'allout-tests-locally-true)
+ (set (make-local-variable 'allout-tests-locally-true) t)
+ (allout-add-resumptions '(allout-tests-globally-unbound t)
+ '(allout-tests-globally-true nil)
+ '(allout-tests-locally-true nil))
+ (allout-add-resumptions '(allout-tests-globally-unbound 2)
+ '(allout-tests-globally-true 3)
+ '(allout-tests-locally-true 4))
+ ;; reestablish many of the basic conditions are maintained after re-add:
+ (should (not (default-boundp 'allout-tests-globally-unbound)))
+ (should (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
+ (should (equal allout-tests-globally-unbound 2))
+ (should (default-boundp 'allout-tests-globally-true))
+ (should (local-variable-p 'allout-tests-globally-true (current-buffer)))
+ (should (equal allout-tests-globally-true 3))
+ (should (not (default-boundp 'allout-tests-locally-true)))
+ (should (local-variable-p 'allout-tests-locally-true (current-buffer)))
+ (should (equal allout-tests-locally-true 4))
+ (allout-do-resumptions)
+ (should (not (local-variable-p 'allout-tests-globally-unbound
+ (current-buffer))))
+ (should (not (boundp 'allout-tests-globally-unbound)))
+ (should (not (local-variable-p 'allout-tests-globally-true
+ (current-buffer))))
+ (should (boundp 'allout-tests-globally-true))
+ (should (equal allout-tests-globally-true t))
+ (should (boundp 'allout-tests-locally-true))
+ (should (local-variable-p 'allout-tests-locally-true (current-buffer)))
+ (should (equal allout-tests-locally-true t))
+ (should (not (default-boundp 'allout-tests-locally-true)))))
+
+(ert-deftest allout-test-resumption-unbinding ()
+ "Ensure that deliberately unbinding registered variables doesn't foul things."
+ (with-temp-buffer
+ (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
+ (allout-tests-obliterate-variable 'allout-tests-globally-true)
+ (setq allout-tests-globally-true t)
+ (allout-tests-obliterate-variable 'allout-tests-locally-true)
+ (set (make-local-variable 'allout-tests-locally-true) t)
+ (allout-add-resumptions '(allout-tests-globally-unbound t)
+ '(allout-tests-globally-true nil)
+ '(allout-tests-locally-true nil))
+ (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
+ (allout-tests-obliterate-variable 'allout-tests-globally-true)
+ (allout-tests-obliterate-variable 'allout-tests-locally-true)
+ (allout-do-resumptions)))
+
+(provide 'allout-tests)
+;;; allout-tests.el ends here
diff --git a/test/lisp/allout-widgets-tests.el b/test/lisp/allout-widgets-tests.el
new file mode 100644
index 00000000000..2b1bcaa6de3
--- /dev/null
+++ b/test/lisp/allout-widgets-tests.el
@@ -0,0 +1,87 @@
+;;; allout-widgets-tests.el --- Tests for allout-widgets.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'allout-widgets)
+
+(require 'cl-lib)
+
+(ert-deftest allout-test-range-overlaps ()
+ "`allout-range-overlaps' unit tests."
+ (let* (ranges
+ got
+ (try (lambda (from to)
+ (setq got (allout-range-overlaps from to ranges))
+ (setq ranges (cadr got))
+ got)))
+;; ;; biggie:
+;; (setq ranges nil)
+;; ;; ~ .02 to .1 seconds for just repeated listing args instead of funcall
+;; ;; ~ 13 seconds for doing repeated funcall
+;; (message "time-trial: %s, resulting size %s"
+;; (time-trial
+;; '(let ((size 10000)
+;; doing)
+;; (dotimes (count size)
+;; (setq doing (random size))
+;; (funcall try doing (+ doing (random 5)))
+;; ;;(list doing (+ doing (random 5)))
+;; )))
+;; (length ranges))
+;; (sit-for 2)
+
+ ;; fresh:
+ (setq ranges nil)
+ (should (equal (funcall try 3 5) '(nil ((3 5)))))
+ ;; add range at end:
+ (should (equal (funcall try 10 12) '(nil ((3 5) (10 12)))))
+ ;; add range at beginning:
+ (should (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12)))))
+ ;; insert range somewhere in the middle:
+ (should (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12)))))
+ ;; consolidate some:
+ (should (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12)))))
+ ;; add more:
+ (should (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17)))))
+ ;; add more:
+ (should (equal (funcall try 20 22)
+ '(nil ((1 2) (3 9) (10 12) (15 17) (20 22)))))
+ ;; encompass more:
+ (should (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22)))))
+ ;; encompass all:
+ (should (equal (funcall try 2 25) '(t ((1 25)))))
+
+ ;; fresh slate:
+ (setq ranges nil)
+ (should (equal (funcall try 20 25) '(nil ((20 25)))))
+ (should (equal (funcall try 30 35) '(nil ((20 25) (30 35)))))
+ (should (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35)))))
+ (should (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35)))))
+ (should (equal (funcall try 10 30) '(t ((10 35)))))
+ (should (equal (funcall try 5 6) '(nil ((5 6) (10 35)))))
+ (should (equal (funcall try 2 100) '(t ((2 100)))))
+
+ (setq ranges nil)))
+
+(provide 'allout-widgets-tests)
+;;; allout-widgets-tests.el ends here
diff --git a/test/lisp/apropos-tests.el b/test/lisp/apropos-tests.el
new file mode 100644
index 00000000000..4c5522d14c2
--- /dev/null
+++ b/test/lisp/apropos-tests.el
@@ -0,0 +1,133 @@
+;;; apropos-tests.el --- Tests for apropos.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'apropos)
+(require 'ert)
+
+(ert-deftest apropos-tests-words-to-regexp-1 ()
+ (let ((re (apropos-words-to-regexp '("foo" "bar") "baz")))
+ (should (string-match-p re "foobazbar"))
+ (should (string-match-p re "barbazfoo"))
+ (should-not (string-match-p re "foo-bar"))
+ (should-not (string-match-p re "foobazbazbar"))))
+
+(ert-deftest apropos-tests-words-to-regexp-2 ()
+ (let ((re (apropos-words-to-regexp '("foo" "bar" "baz") "-")))
+ (should-not (string-match-p re "foo"))
+ (should-not (string-match-p re "foobar"))
+ (should (string-match-p re "foo-bar"))
+ (should (string-match-p re "foo-baz"))))
+
+(ert-deftest apropos-tests-parse-pattern-1 ()
+ (apropos-parse-pattern '("foo"))
+ (should (string-match-p apropos-regexp "foo"))
+ (should (string-match-p apropos-regexp "foo-bar"))
+ (should (string-match-p apropos-regexp "bar-foo"))
+ (should (string-match-p apropos-regexp "foo-foo"))
+ (should-not (string-match-p apropos-regexp "bar")))
+
+(ert-deftest apropos-tests-parse-pattern-2 ()
+ (apropos-parse-pattern '("foo" "bar"))
+ (should (string-match-p apropos-regexp "foo-bar"))
+ (should (string-match-p apropos-regexp "bar-foo"))
+ (should-not (string-match-p apropos-regexp "foo"))
+ (should-not (string-match-p apropos-regexp "bar"))
+ (should-not (string-match-p apropos-regexp "baz"))
+ (should-not (string-match-p apropos-regexp "foo-foo"))
+ (should-not (string-match-p apropos-regexp "bar-bar")))
+
+(ert-deftest apropos-tests-parse-pattern-3 ()
+ (apropos-parse-pattern '("foo" "bar" "baz"))
+ (should (string-match-p apropos-regexp "foo-bar"))
+ (should (string-match-p apropos-regexp "foo-baz"))
+ (should (string-match-p apropos-regexp "bar-foo"))
+ (should (string-match-p apropos-regexp "bar-baz"))
+ (should (string-match-p apropos-regexp "baz-foo"))
+ (should (string-match-p apropos-regexp "baz-bar"))
+ (should-not (string-match-p apropos-regexp "foo"))
+ (should-not (string-match-p apropos-regexp "bar"))
+ (should-not (string-match-p apropos-regexp "baz"))
+ (should-not (string-match-p apropos-regexp "foo-foo"))
+ (should-not (string-match-p apropos-regexp "bar-bar"))
+ (should-not (string-match-p apropos-regexp "baz-baz")))
+
+(ert-deftest apropos-tests-parse-pattern-single-regexp ()
+ (apropos-parse-pattern "foo+bar")
+ (should-not (string-match-p apropos-regexp "fobar"))
+ (should (string-match-p apropos-regexp "foobar"))
+ (should (string-match-p apropos-regexp "fooobar")))
+
+(ert-deftest apropos-tests-parse-pattern-synonyms ()
+ (let ((apropos-synonyms '(("find" "open" "edit"))))
+ (apropos-parse-pattern '("open"))
+ (should (string-match-p apropos-regexp "find-file"))
+ (should (string-match-p apropos-regexp "open-file"))
+ (should (string-match-p apropos-regexp "edit-file"))))
+
+(ert-deftest apropos-tests-calc-scores ()
+ (let ((str "Return apropos score for string STR."))
+ (should (equal (apropos-calc-scores str '("apr")) '(7)))
+ (should (equal (apropos-calc-scores str '("apr" "str")) '(25 7)))
+ (should (equal (apropos-calc-scores str '("appr" "str")) '(25)))
+ (should-not (apropos-calc-scores str '("appr" "strr")))))
+
+(ert-deftest apropos-tests-score-str ()
+ (apropos-parse-pattern '("foo" "bar"))
+ (should (< (apropos-score-str "baz")
+ (apropos-score-str "foo baz")
+ (apropos-score-str "foo bar baz"))))
+
+(ert-deftest apropos-tests-score-doc ()
+ (apropos-parse-pattern '("foo" "bar"))
+ (should (< (apropos-score-doc "baz")
+ (apropos-score-doc "foo baz")
+ (apropos-score-doc "foo bar baz"))))
+
+(ert-deftest apropos-tests-score-symbol ()
+ (apropos-parse-pattern '("foo" "bar"))
+ (should (< (apropos-score-symbol 'baz)
+ (apropos-score-symbol 'foo-baz)
+ (apropos-score-symbol 'foo-bar-baz))))
+
+(ert-deftest apropos-tests-true-hit ()
+ (should-not (apropos-true-hit "foo" '("foo" "bar")))
+ (should (apropos-true-hit "foo bar" '("foo" "bar")))
+ (should (apropos-true-hit "foo bar baz" '("foo" "bar"))))
+
+(ert-deftest apropos-tests-format-plist ()
+ (setplist 'foo '(a 1 b (2 3) c nil))
+ (apropos-parse-pattern '("b"))
+ (should (equal (apropos-format-plist 'foo ", ")
+ "a 1, b (2 3), c nil"))
+ (should (equal (apropos-format-plist 'foo ", " t)
+ "b (2 3)"))
+ (apropos-parse-pattern '("d"))
+ (should-not (apropos-format-plist 'foo ", " t)))
+
+(provide 'apropos-tests)
+;;; apropos-tests.el ends here
diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el
index df658b98139..e92a4d28c6f 100644
--- a/test/lisp/arc-mode-tests.el
+++ b/test/lisp/arc-mode-tests.el
@@ -28,11 +28,11 @@
(let ((alist (list (cons 448 "-rwx------")
(cons 420 "-rw-r--r--")
(cons 292 "-r--r--r--")
- (cons 512 "----------")
+ (cons 512 "---------T")
(cons 1024 "------S---") ; Bug#28092
(cons 2048 "---S------"))))
(dolist (x alist)
- (should (equal (cdr x) (archive-int-to-mode (car x)))))))
+ (should (equal (cdr x) (file-modes-number-to-symbolic (car x)))))))
(ert-deftest arc-mode-test-zip-extract-gz ()
(skip-unless (and archive-zip-extract (executable-find (car archive-zip-extract))))
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el
index 10ed9c39fbb..677abb33cc9 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -353,6 +353,10 @@ HOSTNAME, USER and PORT are passed unchanged to
(auth-source-pass--with-store '(("bar.com:8080"))
(should (auth-source-pass-match-entry-p "bar.com:8080" "bar.com" nil "8080"))))
+(ert-deftest auth-source-pass--matching-entries-find-entries-with-a-port-when-passed-multiple-ports ()
+ (auth-source-pass--with-store '(("bar.com:8080"))
+ (should (auth-source-pass-match-entry-p "bar.com:8080" "bar.com" nil '("http" "https" "80" "8080")))))
+
(ert-deftest auth-source-pass--matching-entries-find-entries-with-slash ()
;; match if entry filename matches user
(auth-source-pass--with-store '(("foo.com/user"))
diff --git a/test/lisp/autoinsert-tests.el b/test/lisp/autoinsert-tests.el
index 574763c4b3d..eafa9c6c02c 100644
--- a/test/lisp/autoinsert-tests.el
+++ b/test/lisp/autoinsert-tests.el
@@ -79,10 +79,10 @@
(ert-deftest autoinsert-tests-define-auto-insert-before ()
(let ((auto-insert-alist
- (list (cons 'text-mode '(lambda () (insert "foo")))))
+ (list (cons 'text-mode (lambda () (insert "foo")))))
(auto-insert-query nil))
(define-auto-insert 'text-mode
- '(lambda () (insert "bar")))
+ (lambda () (insert "bar")))
(with-temp-buffer
(text-mode)
(auto-insert)
@@ -90,10 +90,10 @@
(ert-deftest autoinsert-tests-define-auto-insert-after ()
(let ((auto-insert-alist
- (list (cons 'text-mode '(lambda () (insert "foo")))))
+ (list (cons 'text-mode (lambda () (insert "foo")))))
(auto-insert-query nil))
(define-auto-insert 'text-mode
- '(lambda () (insert "bar"))
+ (lambda () (insert "bar"))
t)
(with-temp-buffer
(text-mode)
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index f7c5580b111..3243a80e52c 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -59,8 +59,7 @@
auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded"
auto-revert-stop-on-user-input nil
file-notify-debug nil
- tramp-verbose 0
- tramp-message-show-message nil)
+ tramp-verbose 0)
(defconst auto-revert--timeout (1+ auto-revert-interval)
"Time to wait for a message.")
@@ -157,6 +156,7 @@ This expects `auto-revert--messages' to be bound by
"Check autorevert for a file."
;; `auto-revert-buffers' runs every 5". And we must wait, until the
;; file has been reverted.
+ :tags '(:expensive-test)
(let ((tmpfile (make-temp-file "auto-revert-test"))
buf)
(unwind-protect
@@ -357,6 +357,7 @@ This expects `auto-revert--messages' to be bound by
"Check autorevert tail mode."
;; `auto-revert-buffers' runs every 5". And we must wait, until the
;; file has been reverted.
+ :tags '(:expensive-test)
(let ((tmpfile (make-temp-file "auto-revert-test"))
buf)
(unwind-protect
@@ -395,6 +396,7 @@ This expects `auto-revert--messages' to be bound by
"Check autorevert for dired."
;; `auto-revert-buffers' runs every 5". And we must wait, until the
;; file has been reverted.
+ :tags '(:expensive-test)
(let* ((tmpfile (make-temp-file "auto-revert-test"))
(name (file-name-nondirectory tmpfile))
buf)
diff --git a/test/lisp/battery-tests.el b/test/lisp/battery-tests.el
index 052ae49a800..8d7cc7fccf3 100644
--- a/test/lisp/battery-tests.el
+++ b/test/lisp/battery-tests.el
@@ -22,9 +22,9 @@
(require 'battery)
(ert-deftest battery-linux-proc-apm-regexp ()
- "Test `battery-linux-proc-apm-regexp'."
+ "Test `rx' definition `battery--linux-proc-apm'."
(let ((str "1.16 1.2 0x07 0x01 0xff 0x80 -1% -1 ?"))
- (should (string-match battery-linux-proc-apm-regexp str))
+ (should (string-match (rx battery--linux-proc-apm) str))
(should (equal (match-string 0 str) str))
(should (equal (match-string 1 str) "1.16"))
(should (equal (match-string 2 str) "1.2"))
@@ -36,7 +36,7 @@
(should (equal (match-string 8 str) "-1"))
(should (equal (match-string 9 str) "?")))
(let ((str "1.16 1.2 0x03 0x00 0x00 0x01 99% 1792 min"))
- (should (string-match battery-linux-proc-apm-regexp str))
+ (should (string-match (rx battery--linux-proc-apm) str))
(should (equal (match-string 0 str) str))
(should (equal (match-string 1 str) "1.16"))
(should (equal (match-string 2 str) "1.2"))
@@ -48,11 +48,107 @@
(should (equal (match-string 8 str) "1792"))
(should (equal (match-string 9 str) "min"))))
+(ert-deftest battery-acpi-rate-regexp ()
+ "Test `rx' definition `battery--acpi-rate'."
+ (let ((str "01 mA"))
+ (should (string-match (rx (battery--acpi-rate)) str))
+ (should (equal (match-string 0 str) str))
+ (should (equal (match-string 1 str) "01"))
+ (should (equal (match-string 2 str) "mA")))
+ (let ((str "23 mW"))
+ (should (string-match (rx (battery--acpi-rate)) str))
+ (should (equal (match-string 0 str) str))
+ (should (equal (match-string 1 str) "23"))
+ (should (equal (match-string 2 str) "mW")))
+ (let ((str "23 mWh"))
+ (should (string-match (rx (battery--acpi-rate)) str))
+ (should (equal (match-string 0 str) "23 mW"))
+ (should (equal (match-string 1 str) "23"))
+ (should (equal (match-string 2 str) "mW")))
+ (should-not (string-match (rx (battery--acpi-rate) eos) "45 mWh")))
+
+(ert-deftest battery-acpi-capacity-regexp ()
+ "Test `rx' definition `battery--acpi-capacity'."
+ (let ((str "01 mAh"))
+ (should (string-match (rx battery--acpi-capacity) str))
+ (should (equal (match-string 0 str) str))
+ (should (equal (match-string 1 str) "01"))
+ (should (equal (match-string 2 str) "mAh")))
+ (let ((str "23 mWh"))
+ (should (string-match (rx battery--acpi-capacity) str))
+ (should (equal (match-string 0 str) str))
+ (should (equal (match-string 1 str) "23"))
+ (should (equal (match-string 2 str) "mWh")))
+ (should-not (string-match (rx battery--acpi-capacity eos) "45 mW")))
+
+(ert-deftest battery-upower-state ()
+ "Test `battery--upower-state'."
+ ;; Charging.
+ (dolist (total '(nil charging discharging empty fully-charged
+ pending-charge pending-discharge))
+ (should (eq (battery--upower-state '(("State" . 1)) total) 'charging)))
+ (dolist (state '(nil 0 1 2 3 4 5 6))
+ (should (eq (battery--upower-state `(("State" . ,state)) 'charging)
+ 'charging)))
+ ;; Discharging.
+ (dolist (total '(nil discharging empty fully-charged
+ pending-charge pending-discharge))
+ (should (eq (battery--upower-state '(("State" . 2)) total) 'discharging)))
+ (dolist (state '(nil 0 2 3 4 5 6))
+ (should (eq (battery--upower-state `(("State" . ,state)) 'discharging)
+ 'discharging)))
+ ;; Pending charge.
+ (dolist (total '(nil empty fully-charged pending-charge pending-discharge))
+ (should (eq (battery--upower-state '(("State" . 5)) total)
+ 'pending-charge)))
+ (dolist (state '(nil 0 3 4 5 6))
+ (should (eq (battery--upower-state `(("State" . ,state)) 'pending-charge)
+ 'pending-charge)))
+ ;; Pending discharge.
+ (dolist (total '(nil empty fully-charged pending-discharge))
+ (should (eq (battery--upower-state '(("State" . 6)) total)
+ 'pending-discharge)))
+ (dolist (state '(nil 0 3 4 6))
+ (should (eq (battery--upower-state `(("State" . ,state)) 'pending-discharge)
+ 'pending-discharge)))
+ ;; Empty.
+ (dolist (total '(nil empty))
+ (should (eq (battery--upower-state '(("State" . 3)) total) 'empty)))
+ (dolist (state '(nil 0 3))
+ (should (eq (battery--upower-state `(("State" . ,state)) 'empty) 'empty)))
+ ;; Fully charged.
+ (dolist (total '(nil fully-charged))
+ (should (eq (battery--upower-state '(("State" . 4)) total) 'fully-charged)))
+ (dolist (state '(nil 0 4))
+ (should (eq (battery--upower-state `(("State" . ,state)) 'fully-charged)
+ 'fully-charged))))
+
+(ert-deftest battery-upower-state-unknown ()
+ "Test `battery--upower-state' with unknown states."
+ ;; Unknown running total retains new state.
+ (should-not (battery--upower-state () nil))
+ (should-not (battery--upower-state '(("State" . state)) nil))
+ (should-not (battery--upower-state '(("State" . 0)) nil))
+ (should (eq (battery--upower-state '(("State" . 1)) nil) 'charging))
+ (should (eq (battery--upower-state '(("State" . 2)) nil) 'discharging))
+ (should (eq (battery--upower-state '(("State" . 3)) nil) 'empty))
+ (should (eq (battery--upower-state '(("State" . 4)) nil) 'fully-charged))
+ (should (eq (battery--upower-state '(("State" . 5)) nil) 'pending-charge))
+ (should (eq (battery--upower-state '(("State" . 6)) nil) 'pending-discharge))
+ ;; Unknown new state retains running total.
+ (dolist (props '(() (("State" . state)) (("State" . 0))))
+ (dolist (total '(nil charging discharging empty fully-charged
+ pending-charge pending-discharge))
+ (should (eq (battery--upower-state props total) total))))
+ ;; Conflicting empty and fully-charged.
+ (should-not (battery--upower-state '(("State" . 3)) 'fully-charged))
+ (should-not (battery--upower-state '(("State" . 4)) 'empty)))
+
(ert-deftest battery-format ()
"Test `battery-format'."
(should (equal (battery-format "" ()) ""))
(should (equal (battery-format "" '((?b . "-"))) ""))
- (should (equal (battery-format "%a%b%p%%" '((?b . "-") (?p . "99")))
- "-99%")))
+ (should (equal (battery-format "%2a%-3b%.1p%%" '((?b . "-") (?p . "99")))
+ "- 9%")))
;;; battery-tests.el ends here
diff --git a/test/lisp/bookmark-resources/test-list.bmk b/test/lisp/bookmark-resources/test-list.bmk
new file mode 100644
index 00000000000..696d64979b8
--- /dev/null
+++ b/test/lisp/bookmark-resources/test-list.bmk
@@ -0,0 +1,20 @@
+;;;; Emacs Bookmark Format Version 1 ;;;; -*- coding: utf-8-emacs -*-
+;;; This format is meant to be slightly human-readable;
+;;; nevertheless, you probably don't want to edit it.
+;;; -*- End Of Bookmark File Format Version Stamp -*-
+(("name-0"
+ (filename . "/some/file-0")
+ (front-context-string . "abc")
+ (rear-context-string . "def")
+ (position . 3))
+("name-1"
+ (filename . "/some/file-1")
+ (front-context-string . "abc")
+ (rear-context-string . "def")
+ (position . 3))
+("name-2"
+ (filename . "/some/file-2")
+ (front-context-string . "abc")
+ (rear-context-string . "def")
+ (position . 3))
+)
diff --git a/test/lisp/bookmark-tests.el b/test/lisp/bookmark-tests.el
index 7e0384b7241..c5959e46d80 100644
--- a/test/lisp/bookmark-tests.el
+++ b/test/lisp/bookmark-tests.el
@@ -25,6 +25,7 @@
(require 'ert)
(require 'bookmark)
+(require 'cl-lib)
(defvar bookmark-tests-data-dir
(file-truename
@@ -82,6 +83,70 @@ the lexically-bound variable `buffer'."
,@body)
(kill-buffer buffer))))
+(defvar bookmark-tests-bookmark-file-list
+ (expand-file-name "test-list.bmk" bookmark-tests-data-dir)
+ "Bookmark file used for testing a list of bookmarks.")
+
+;; The values below should match `bookmark-tests-bookmark-file-list'
+;; content. We cache these values to speed up tests.
+(eval-and-compile ; needed by `with-bookmark-test-list' macro
+ (defvar bookmark-tests-bookmark-list-0 '("name-0"
+ (filename . "/some/file-0")
+ (front-context-string . "ghi")
+ (rear-context-string . "jkl")
+ (position . 4))
+ "Cached value used in bookmark-tests.el."))
+
+;; The values below should match `bookmark-tests-bookmark-file-list'
+;; content. We cache these values to speed up tests.
+(eval-and-compile ; needed by `with-bookmark-test-list' macro
+ (defvar bookmark-tests-bookmark-list-1 '("name-1"
+ (filename . "/some/file-1")
+ (front-context-string . "mno")
+ (rear-context-string . "pqr")
+ (position . 5))
+ "Cached value used in bookmark-tests.el."))
+
+;; The values below should match `bookmark-tests-bookmark-file-list'
+;; content. We cache these values to speed up tests.
+(eval-and-compile ; needed by `with-bookmark-test-list' macro
+ (defvar bookmark-tests-bookmark-list-2 '("name-2"
+ (filename . "/some/file-2")
+ (front-context-string . "stu")
+ (rear-context-string . "vwx")
+ (position . 6))
+ "Cached value used in bookmark-tests.el."))
+
+(defvar bookmark-tests-cache-timestamp-list
+ (cons bookmark-tests-bookmark-file-list
+ (nth 5 (file-attributes
+ bookmark-tests-bookmark-file-list)))
+ "Cached value used in bookmark-tests.el.")
+
+(defmacro with-bookmark-test-list (&rest body)
+ "Create environment for testing bookmark.el and evaluate BODY.
+Ensure a clean environment for testing, and do not change user
+data when running tests interactively."
+ `(with-temp-buffer
+ (let ((bookmark-alist (quote (,(copy-sequence bookmark-tests-bookmark-list-0)
+ ,(copy-sequence bookmark-tests-bookmark-list-1)
+ ,(copy-sequence bookmark-tests-bookmark-list-2))))
+ (bookmark-default-file bookmark-tests-bookmark-file-list)
+ (bookmark-bookmarks-timestamp bookmark-tests-cache-timestamp-list)
+ bookmark-save-flag)
+ ,@body)))
+
+(defmacro with-bookmark-test-file-list (&rest body)
+ "Create environment for testing bookmark.el and evaluate BODY.
+Same as `with-bookmark-test-list' but also opens the resource file
+example.txt in a buffer, which can be accessed by callers through
+the lexically-bound variable `buffer'."
+ `(let ((buffer (find-file-noselect bookmark-tests-example-file)))
+ (unwind-protect
+ (with-bookmark-test-list
+ ,@body)
+ (kill-buffer buffer))))
+
(ert-deftest bookmark-tests-all-names ()
(with-bookmark-test
(should (equal (bookmark-all-names) '("name")))))
@@ -94,6 +159,30 @@ the lexically-bound variable `buffer'."
(with-bookmark-test
(should (equal (bookmark-get-bookmark-record "name") (cdr bookmark-tests-bookmark)))))
+(ert-deftest bookmark-tests-all-names-list ()
+ (with-bookmark-test-list
+ (should (equal (bookmark-all-names) '("name-0"
+ "name-1"
+ "name-2")))))
+
+(ert-deftest bookmark-tests-get-bookmark-list ()
+ (with-bookmark-test-list
+ (should (equal (bookmark-get-bookmark "name-0")
+ bookmark-tests-bookmark-list-0))
+ (should (equal (bookmark-get-bookmark "name-1")
+ bookmark-tests-bookmark-list-1))
+ (should (equal (bookmark-get-bookmark "name-2")
+ bookmark-tests-bookmark-list-2))))
+
+(ert-deftest bookmark-tests-get-bookmark-record-list ()
+ (with-bookmark-test-list
+ (should (equal (bookmark-get-bookmark-record "name-0")
+ (cdr bookmark-tests-bookmark-list-0)))
+ (should (equal (bookmark-get-bookmark-record "name-1")
+ (cdr bookmark-tests-bookmark-list-1)))
+ (should (equal (bookmark-get-bookmark-record "name-2")
+ (cdr bookmark-tests-bookmark-list-2)))))
+
(ert-deftest bookmark-tests-record-getters-and-setters-new ()
(with-temp-buffer
(let* ((buffer-file-name "test")
@@ -129,6 +218,19 @@ the lexically-bound variable `buffer'."
;; calling twice gives same record
(should (equal (bookmark-make-record) record))))))
+(ert-deftest bookmark-tests-make-record-list ()
+ (with-bookmark-test-file-list
+ (let* ((record `("example.txt" (filename . ,bookmark-tests-example-file)
+ (front-context-string . "is text file is ")
+ (rear-context-string)
+ (position . 3)
+ (defaults "example.txt"))))
+ (with-current-buffer buffer
+ (goto-char 3)
+ (should (equal (bookmark-make-record) record))
+ ;; calling twice gives same record
+ (should (equal (bookmark-make-record) record))))))
+
(ert-deftest bookmark-tests-make-record-function ()
(with-bookmark-test
(let ((buffer-file-name "test"))
@@ -266,6 +368,11 @@ the lexically-bound variable `buffer'."
(bookmark-delete "name")
(should (equal bookmark-alist nil))))
+(ert-deftest bookmark-tests-delete-all ()
+ (with-bookmark-test-list
+ (bookmark-delete-all t)
+ (should (equal bookmark-alist nil))))
+
(defmacro with-bookmark-test-save-load (&rest body)
"Create environment for testing bookmark.el and evaluate BODY.
Same as `with-bookmark-test' but also sets a temporary
@@ -339,21 +446,33 @@ testing `bookmark-bmenu-list'."
,@body)
(kill-buffer bookmark-bmenu-buffer)))))
-(ert-deftest bookmark-bmenu.enu-edit-annotation/show-annotation ()
+(defmacro with-bookmark-bmenu-test-list (&rest body)
+ "Create environment for testing `bookmark-bmenu-list' and evaluate BODY.
+Same as `with-bookmark-test-list' but with additions suitable for
+testing `bookmark-bmenu-list'."
+ `(with-bookmark-test-list
+ (let ((bookmark-bmenu-buffer "*Bookmark List - Testing*"))
+ (unwind-protect
+ (save-window-excursion
+ (bookmark-bmenu-list)
+ ,@body)
+ (kill-buffer bookmark-bmenu-buffer)))))
+
+(ert-deftest bookmark-test-bmenu-edit-annotation/show-annotation ()
(with-bookmark-bmenu-test
(bookmark-set-annotation "name" "foo")
(bookmark-bmenu-edit-annotation)
(should (string-match "foo" (buffer-string)))
(kill-buffer (current-buffer))))
-(ert-deftest bookmark-bmenu-send-edited-annotation ()
+(ert-deftest bookmark-test-bmenu-send-edited-annotation ()
(with-bookmark-bmenu-test
(bookmark-bmenu-edit-annotation)
(insert "foo")
(bookmark-send-edited-annotation)
(should (equal (bookmark-get-annotation "name") "foo"))))
-(ert-deftest bookmark-bmenu-send-edited-annotation/restore-focus ()
+(ert-deftest bookmark-test-bmenu-send-edited-annotation/restore-focus ()
"Test for https://debbugs.gnu.org/20150 ."
(with-bookmark-bmenu-test
(bookmark-bmenu-edit-annotation)
@@ -362,5 +481,170 @@ testing `bookmark-bmenu-list'."
(should (equal (buffer-name (current-buffer)) bookmark-bmenu-buffer))
(should (looking-at "name"))))
+(ert-deftest bookmark-test-bmenu-toggle-filenames ()
+ (with-bookmark-bmenu-test
+ (should (re-search-forward "/some/file" nil t))
+ (bookmark-bmenu-toggle-filenames)
+ (goto-char (point-min))
+ (should-not (re-search-forward "/some/file" nil t))))
+
+(ert-deftest bookmark-test-bmenu-toggle-filenames/show ()
+ (with-bookmark-bmenu-test
+ (bookmark-bmenu-toggle-filenames t)
+ (should (re-search-forward "/some/file"))))
+
+(ert-deftest bookmark-test-bmenu-show-filenames ()
+ (with-bookmark-bmenu-test
+ (bookmark-bmenu-show-filenames)
+ (should (re-search-forward "/some/file"))))
+
+(ert-deftest bookmark-test-bmenu-hide-filenames ()
+ (with-bookmark-bmenu-test
+ (bookmark-bmenu-hide-filenames)
+ (goto-char (point-min))
+ (should-not (re-search-forward "/some/file" nil t))))
+
+(ert-deftest bookmark-test-bmenu-bookmark ()
+ (with-bookmark-bmenu-test
+ (should (equal (bookmark-bmenu-bookmark) "name"))))
+
+(ert-deftest bookmark-test-bmenu-mark ()
+ (with-bookmark-bmenu-test
+ (bookmark-bmenu-mark)
+ (beginning-of-line)
+ (should (looking-at "^>"))))
+
+(ert-deftest bookmark-test-bmenu-any-marks ()
+ (with-bookmark-bmenu-test
+ (bookmark-bmenu-mark)
+ (beginning-of-line)
+ (should (bookmark-bmenu-any-marks))))
+
+(ert-deftest bookmark-test-bmenu-mark-all ()
+ (with-bookmark-bmenu-test-list
+ (let ((here (point-max)))
+ ;; Expect to not move the point
+ (goto-char here)
+ (bookmark-bmenu-mark-all)
+ (should (equal here (point)))
+ ;; Verify that all bookmarks are marked
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (should (looking-at "^> "))
+ (should (equal bookmark-tests-bookmark-list-0
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^> "))
+ (should (equal bookmark-tests-bookmark-list-1
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^> "))
+ (should (equal bookmark-tests-bookmark-list-2
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark)))))))
+
+(ert-deftest bookmark-test-bmenu-any-marks-list ()
+ (with-bookmark-bmenu-test-list
+ ;; Mark just the second item
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (forward-line 1)
+ (bookmark-bmenu-mark)
+ ;; Verify that only the second item is marked
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (should (looking-at "^ "))
+ (should (equal bookmark-tests-bookmark-list-0
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^> "))
+ (should (equal bookmark-tests-bookmark-list-1
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^ "))
+ (should (equal bookmark-tests-bookmark-list-2
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ ;; There should be at least one mark
+ (should (bookmark-bmenu-any-marks))))
+
+(ert-deftest bookmark-test-bmenu-unmark ()
+ (with-bookmark-bmenu-test
+ (bookmark-bmenu-mark)
+ (goto-char (point-min))
+ (bookmark-bmenu-unmark)
+ (beginning-of-line)
+ (should (looking-at "^ "))))
+
+(ert-deftest bookmark-test-bmenu-unmark-all ()
+ (with-bookmark-bmenu-test-list
+ (bookmark-bmenu-mark-all)
+ (let ((here (point-max)))
+ ;; Expect to not move the point
+ (goto-char here)
+ (bookmark-bmenu-unmark-all)
+ (should (equal here (point)))
+ ;; Verify that all bookmarks are unmarked
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (should (looking-at "^ "))
+ (should (equal bookmark-tests-bookmark-list-0
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^ "))
+ (should (equal bookmark-tests-bookmark-list-1
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^ "))
+ (should (equal bookmark-tests-bookmark-list-2
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark)))))))
+
+(ert-deftest bookmark-test-bmenu-delete ()
+ (with-bookmark-bmenu-test
+ (bookmark-bmenu-delete)
+ (bookmark-bmenu-execute-deletions)
+ (should (equal (length bookmark-alist) 0))))
+
+(ert-deftest bookmark-test-bmenu-delete-all ()
+ (with-bookmark-bmenu-test-list
+ ;; Verify that unmarked bookmarks aren't deleted
+ (bookmark-bmenu-execute-deletions)
+ (should-not (eq bookmark-alist nil))
+ (let ((here (point-max)))
+ ;; Expect to not move the point
+ (goto-char here)
+ (bookmark-bmenu-delete-all)
+ (should (equal here (point)))
+ ;; Verify that all bookmarks are marked for deletion
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (should (looking-at "^D "))
+ (should (equal bookmark-tests-bookmark-list-0
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^D "))
+ (should (equal bookmark-tests-bookmark-list-1
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^D "))
+ (should (equal bookmark-tests-bookmark-list-2
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ ;; Verify that all bookmarks are deleted
+ (bookmark-bmenu-execute-deletions)
+ (should (eq bookmark-alist nil)))))
+
+(ert-deftest bookmark-test-bmenu-locate ()
+ (let (msg)
+ (cl-letf (((symbol-function 'message)
+ (lambda (&rest args)
+ (setq msg (apply #'format args)))))
+ (with-bookmark-bmenu-test
+ (bookmark-bmenu-locate)
+ (should (equal msg "/some/file"))))))
+
+(ert-deftest bookmark-test-bmenu-filter-alist-by-regexp ()
+ (with-bookmark-bmenu-test
+ (bookmark-bmenu-filter-alist-by-regexp regexp-unmatchable)
+ (goto-char (point-min))
+ (should (looking-at "^$"))))
+
(provide 'bookmark-tests)
;;; bookmark-tests.el ends here
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index 6db5426ff6d..4dded007f79 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -63,22 +63,16 @@ An existing calc stack is reused, otherwise a new one is created."
(calc-top-n 1))
(calc-pop 0)))
-;; (ert-deftest test-math-bignum ()
-;; ;; bug#17556
-;; (let ((n (math-bignum most-negative-fixnum)))
-;; (should (math-negp n))
-;; (should (cl-notany #'cl-minusp (cdr n)))))
-
-(ert-deftest test-calc-remove-units ()
+(ert-deftest calc-remove-units ()
(should (calc-tests-equal (calc-tests-simple #'calc-remove-units "-1 m") -1)))
-(ert-deftest test-calc-extract-units ()
+(ert-deftest calc-extract-units ()
(should (calc-tests-equal (calc-tests-simple #'calc-extract-units "-1 m")
'(var m var-m)))
(should (calc-tests-equal (calc-tests-simple #'calc-extract-units "-1 m*cm")
'(* (float 1 -2) (^ (var m var-m) 2)))))
-(ert-deftest test-calc-convert-units ()
+(ert-deftest calc-convert-units ()
;; Used to ask for `(The expression is unitless when simplified) Old Units: '.
(should (calc-tests-equal (calc-tests-simple #'calc-convert-units "-1 m" nil "cm")
'(* -100 (var cm var-cm))))
@@ -94,7 +88,7 @@ An existing calc stack is reused, otherwise a new one is created."
(let ((var-i (calcFunc-sqrt -1)))
(should (math-imaginary-i))))
-(ert-deftest test-calc-23889 ()
+(ert-deftest calc-bug-23889 ()
"Test for https://debbugs.gnu.org/23889 and 25652."
(skip-unless t) ;; (>= math-bignum-digit-length 9))
(dolist (mode '(deg rad))
@@ -139,7 +133,7 @@ An existing calc stack is reused, otherwise a new one is created."
(nth 1 (calcFunc-cos 1)))
0 4))))))
-(ert-deftest calc-test-trig ()
+(ert-deftest calc-trig ()
"Trigonometric simplification; bug#33052."
(let ((calc-angle-mode 'rad))
(let ((calc-symbolic-mode t))
@@ -169,7 +163,7 @@ An existing calc stack is reused, otherwise a new one is created."
(should (equal (math-simplify '(calcFunc-cot (/ (var pi var-pi) 3)))
'(calcFunc-cot (/ (var pi var-pi) 3)))))))
-(ert-deftest calc-test-format-radix ()
+(ert-deftest calc-format-radix ()
"Test integer formatting (bug#36689)."
(let ((calc-group-digits nil))
(let ((calc-number-radix 10))
@@ -194,7 +188,7 @@ 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-test-calendar ()
+(ert-deftest calc-calendar ()
"Test calendar conversions (bug#36822)."
(should (equal (calcFunc-julian (math-parse-date "2019-07-27")) 2458692))
(should (equal (math-parse-date "2019-07-27") '(date 737267)))
@@ -216,7 +210,7 @@ An existing calc stack is reused, otherwise a new one is created."
(should (equal (math-absolute-from-julian-dt -101 3 1) -36832))
(should (equal (math-absolute-from-julian-dt -4713 1 1) -1721425)))
-(ert-deftest calc-test-solve-linear-system ()
+(ert-deftest calc-solve-linear-system ()
"Test linear system solving (bug#35374)."
;; x + y = 3
;; 2x - 3y = -4
@@ -345,6 +339,201 @@ An existing calc stack is reused, otherwise a new one is created."
(should (Math-num-integerp '(float 1 0)))
(should-not (Math-num-integerp nil)))
+(ert-deftest calc-matrix-determinant ()
+ (should (equal (calcFunc-det '(vec (vec 3)))
+ 3))
+ (should (equal (calcFunc-det '(vec (vec 2 3) (vec 6 7)))
+ -4))
+ (should (equal (calcFunc-det '(vec (vec 1 2 3) (vec 4 5 7) (vec 9 6 2)))
+ 15))
+ (should (equal (calcFunc-det '(vec (vec 0 5 7 3)
+ (vec 0 0 2 0)
+ (vec 1 2 3 4)
+ (vec 0 0 0 3)))
+ 30))
+ (should (equal (calcFunc-det '(vec (vec (var a var-a))))
+ '(var a var-a)))
+ (should (equal (calcFunc-det '(vec (vec 2 (var a var-a))
+ (vec 7 (var a var-a))))
+ '(* -5 (var a var-a))))
+ (should (equal (calcFunc-det '(vec (vec 1 0 0 0)
+ (vec 0 1 0 0)
+ (vec 0 0 0 1)
+ (vec 0 0 (var a var-a) 0)))
+ '(neg (var a var-a)))))
+
+(ert-deftest calc-gcd ()
+ (should (equal (calcFunc-gcd 3 4) 1))
+ (should (equal (calcFunc-gcd 12 15) 3))
+ (should (equal (calcFunc-gcd -12 15) 3))
+ (should (equal (calcFunc-gcd 12 -15) 3))
+ (should (equal (calcFunc-gcd -12 -15) 3))
+ (should (equal (calcFunc-gcd 0 5) 5))
+ (should (equal (calcFunc-gcd 5 0) 5))
+ (should (equal (calcFunc-gcd 0 -5) 5))
+ (should (equal (calcFunc-gcd -5 0) 5))
+ (should (equal (calcFunc-gcd 0 0) 0))
+ (should (equal (calcFunc-gcd 0 '(var x var-x))
+ '(calcFunc-abs (var x var-x))))
+ (should (equal (calcFunc-gcd '(var x var-x) 0)
+ '(calcFunc-abs (var x var-x)))))
+
+(ert-deftest calc-sum-gcd ()
+ ;; sum(gcd(0,n),n,-1,-1)
+ (should (equal (math-simplify '(calcFunc-sum (calcFunc-gcd 0 (var n var-n))
+ (var n var-n) -1 -1))
+ 1))
+ ;; sum(sum(gcd(n,k),k,-1,1),n,-1,1)
+ (should (equal (math-simplify
+ '(calcFunc-sum
+ (calcFunc-sum (calcFunc-gcd (var n var-n) (var k var-k))
+ (var k var-k) -1 1)
+ (var n var-n) -1 1))
+ 8)))
+
+(defun calc-tests--fac (n)
+ (apply #'* (number-sequence 1 n)))
+
+(defun calc-tests--choose (n k)
+ "N choose K, reference implementation."
+ (cond
+ ((and (integerp n) (integerp k))
+ (if (<= 0 n)
+ (if (<= 0 k n)
+ (/ (calc-tests--fac n)
+ (* (calc-tests--fac k) (calc-tests--fac (- n k))))
+ 0) ; 0≤n<k
+ ;; n<0, n and k integers: use extension from M. J. Kronenburg
+ (cond
+ ((<= 0 k)
+ (* (expt -1 k)
+ (calc-tests--choose (+ (- n) k -1) k)))
+ ((<= k n)
+ (* (expt -1 (- n k))
+ (calc-tests--choose (+ (- k) -1) (- n k))))
+ (t ; n<k<0
+ 0))))
+ ((natnump k)
+ ;; Generalisation for any n, integral k≥0: use falling product
+ (/ (apply '* (number-sequence n (- n (1- k)) -1))
+ (calc-tests--fac k)))
+ (t (error "case not covered"))))
+
+(defun calc-tests--check-choose (n k)
+ (equal (calcFunc-choose n k)
+ (calc-tests--choose n k)))
+
+(defun calc-tests--explain-choose (n k)
+ (let ((got (calcFunc-choose n k))
+ (expected (calc-tests--choose n k)))
+ (format "(calcFunc-choose %d %d) => %S, expected %S" n k got expected)))
+
+(put 'calc-tests--check-choose 'ert-explainer 'calc-tests--explain-choose)
+
+(defun calc-tests--calc-to-number (x)
+ "Convert a Calc object to a Lisp number."
+ (pcase x
+ ((pred numberp) x)
+ (`(frac ,p ,q) (/ (float p) q))
+ (`(float ,m ,e) (* m (expt 10 e)))
+ (_ (error "calc object not converted: %S" x))))
+
+(ert-deftest calc-choose ()
+ "Test computation of binomial coefficients (bug#16999)."
+ ;; Integral arguments
+ (dolist (n (number-sequence -6 6))
+ (dolist (k (number-sequence -6 6))
+ (should (calc-tests--check-choose n k))))
+
+ ;; Fractional n, natural k
+ (should (equal (calc-tests--calc-to-number
+ (calcFunc-choose '(frac 15 2) 3))
+ (calc-tests--choose 7.5 3)))
+
+ (should (equal (calc-tests--calc-to-number
+ (calcFunc-choose '(frac 1 2) 2))
+ (calc-tests--choose 0.5 2)))
+
+ (should (equal (calc-tests--calc-to-number
+ (calcFunc-choose '(frac -15 2) 3))
+ (calc-tests--choose -7.5 3))))
+
+(ert-deftest calc-business-days ()
+ (cl-flet ((m (s) (math-parse-date s))
+ (b+ (a b) (calcFunc-badd a b))
+ (b- (a b) (calcFunc-bsub a b)))
+ ;; Sanity check.
+ (should (equal (m "2020-09-07") '(date 737675)))
+
+ ;; Test with standard business days (Mon-Fri):
+ (should (equal (b+ (m "2020-09-07") 1) (m "2020-09-08"))) ; Mon->Tue
+ (should (equal (b+ (m "2020-09-08") 1) (m "2020-09-09"))) ; Tue->Wed
+ (should (equal (b+ (m "2020-09-09") 1) (m "2020-09-10"))) ; Wed->Thu
+ (should (equal (b+ (m "2020-09-10") 1) (m "2020-09-11"))) ; Thu->Fri
+ (should (equal (b+ (m "2020-09-11") 1) (m "2020-09-14"))) ; Fri->Mon
+
+ (should (equal (b+ (m "2020-09-07") 4) (m "2020-09-11"))) ; Mon->Fri
+ (should (equal (b+ (m "2020-09-07") 6) (m "2020-09-15"))) ; Mon->Tue
+
+ (should (equal (b+ (m "2020-09-12") 1) (m "2020-09-14"))) ; Sat->Mon
+ (should (equal (b+ (m "2020-09-13") 1) (m "2020-09-14"))) ; Sun->Mon
+
+ (should (equal (b- (m "2020-09-11") 1) (m "2020-09-10"))) ; Fri->Thu
+ (should (equal (b- (m "2020-09-10") 1) (m "2020-09-09"))) ; Thu->Wed
+ (should (equal (b- (m "2020-09-09") 1) (m "2020-09-08"))) ; Wed->Tue
+ (should (equal (b- (m "2020-09-08") 1) (m "2020-09-07"))) ; Tue->Mon
+ (should (equal (b- (m "2020-09-07") 1) (m "2020-09-04"))) ; Mon->Fri
+
+ (should (equal (b- (m "2020-09-11") 4) (m "2020-09-07"))) ; Fri->Mon
+ (should (equal (b- (m "2020-09-15") 6) (m "2020-09-07"))) ; Tue->Mon
+
+ (should (equal (b- (m "2020-09-12") 1) (m "2020-09-11"))) ; Sat->Fri
+ (should (equal (b- (m "2020-09-13") 1) (m "2020-09-11"))) ; Sun->Fri
+
+ ;; Stepping fractional days
+ (should (equal (b+ (m "2020-09-08 21:00") '(frac 1 2))
+ (m "2020-09-09 09:00")))
+ (should (equal (b+ (m "2020-09-11 21:00") '(frac 1 2))
+ (m "2020-09-14 09:00")))
+ (should (equal (b- (m "2020-09-08 21:00") '(frac 1 2))
+ (m "2020-09-08 09:00")))
+ (should (equal (b- (m "2020-09-14 06:00") '(frac 1 2))
+ (m "2020-09-11 18:00")))
+
+ ;; Test with a couple of extra days off:
+ (let ((var-Holidays (list 'vec
+ '(var sat var-sat) '(var sun var-sun)
+ (m "2020-09-09") (m "2020-09-11"))))
+
+ (should (equal (b+ (m "2020-09-07") 1) (m "2020-09-08"))) ; Mon->Tue
+ (should (equal (b+ (m "2020-09-08") 1) (m "2020-09-10"))) ; Tue->Thu
+ (should (equal (b+ (m "2020-09-10") 1) (m "2020-09-14"))) ; Thu->Mon
+ (should (equal (b+ (m "2020-09-14") 1) (m "2020-09-15"))) ; Mon->Tue
+ (should (equal (b+ (m "2020-09-15") 1) (m "2020-09-16"))) ; Tue->Wed
+
+ (should (equal (b- (m "2020-09-16") 1) (m "2020-09-15"))) ; Wed->Tue
+ (should (equal (b- (m "2020-09-15") 1) (m "2020-09-14"))) ; Tue->Mon
+ (should (equal (b- (m "2020-09-14") 1) (m "2020-09-10"))) ; Mon->Thu
+ (should (equal (b- (m "2020-09-10") 1) (m "2020-09-08"))) ; Thu->Tue
+ (should (equal (b- (m "2020-09-08") 1) (m "2020-09-07"))) ; Tue->Mon
+ )
+
+ ;; Test with odd non-business weekdays (Tue, Wed, Sat):
+ (let ((var-Holidays '(vec (var tue var-tue)
+ (var wed var-wed)
+ (var sat var-sat))))
+ (should (equal (b+ (m "2020-09-07") 1) (m "2020-09-10"))) ; Mon->Thu
+ (should (equal (b+ (m "2020-09-10") 1) (m "2020-09-11"))) ; Thu->Fri
+ (should (equal (b+ (m "2020-09-11") 1) (m "2020-09-13"))) ; Fri->Sun
+ (should (equal (b+ (m "2020-09-13") 1) (m "2020-09-14"))) ; Sun->Mon
+
+ (should (equal (b- (m "2020-09-14") 1) (m "2020-09-13"))) ; Mon->Sun
+ (should (equal (b- (m "2020-09-13") 1) (m "2020-09-11"))) ; Sun->Fri
+ (should (equal (b- (m "2020-09-11") 1) (m "2020-09-10"))) ; Fri->Thu
+ (should (equal (b- (m "2020-09-10") 1) (m "2020-09-07"))) ; Thu->Mon
+ )
+ ))
+
(provide 'calc-tests)
;;; calc-tests.el ends here
diff --git a/test/lisp/calendar/cal-julian-tests.el b/test/lisp/calendar/cal-julian-tests.el
new file mode 100644
index 00000000000..76118b3d7f5
--- /dev/null
+++ b/test/lisp/calendar/cal-julian-tests.el
@@ -0,0 +1,72 @@
+;;; cal-julian-tests.el --- tests for calendar/cal-julian.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 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/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'cal-julian)
+
+(ert-deftest cal-julian-test-to-absolute ()
+ (should (equal (calendar-gregorian-from-absolute
+ (calendar-julian-to-absolute
+ '(10 25 1917)))
+ '(11 7 1917))))
+
+(ert-deftest cal-julian-test-from-absolute ()
+ (should (equal (calendar-julian-from-absolute
+ (calendar-absolute-from-gregorian
+ '(11 7 1917)))
+ '(10 25 1917))))
+
+(ert-deftest cal-julian-test-date-string ()
+ (should (equal (let ((calendar-date-display-form calendar-iso-date-display-form))
+ (calendar-julian-date-string '(11 7 1917)))
+ "1917-10-25")))
+
+(defmacro with-cal-julian-test (&rest body)
+ `(save-window-excursion
+ (unwind-protect
+ (progn
+ (calendar)
+ ,@body)
+ (kill-buffer "*Calendar*"))))
+
+(ert-deftest cal-julian-test-goto-date ()
+ (with-cal-julian-test
+ (calendar-julian-goto-date '(10 25 1917))
+ (should (looking-at "7"))))
+
+(ert-deftest cal-julian-test-astro-to-and-from-absolute ()
+ (should (= (+ (calendar-astro-to-absolute 0.0)
+ (calendar-astro-from-absolute 0.0))
+ 0.0)))
+
+(ert-deftest cal-julian-calendar-astro-date-string ()
+ (should (equal (calendar-astro-date-string '(10 25 1917)) "2421527")))
+
+(ert-deftest calendar-astro-goto-day-number ()
+ (with-cal-julian-test
+ (calendar-astro-goto-day-number 2421527)
+ (backward-char)
+ (should (looking-at "25"))))
+
+(provide 'cal-julian-tests)
+;;; cal-julian-tests.el ends here
diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el
index 986255250dc..bce7de769e0 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
+;; icalendar-tests.el --- Test suite for icalendar.el -*- lexical-binding:t -*-
;; Copyright (C) 2005, 2008-2020 Free Software Foundation, Inc.
@@ -183,6 +183,7 @@
(ert-deftest icalendar--parse-vtimezone ()
"Test method for `icalendar--parse-vtimezone'."
(let (vtimezone result)
+ ;; testcase: valid timezone with rrule
(setq vtimezone (icalendar-tests--get-ical-event "BEGIN:VTIMEZONE
TZID:thename
BEGIN:STANDARD
@@ -204,6 +205,8 @@ END:VTIMEZONE
(message (cdr result))
(should (string= "STD-02:00DST-03:00,M3.5.0/03:00:00,M10.5.0/04:00:00"
(cdr result)))
+
+ ;; testcase: name of tz contains comma
(setq vtimezone (icalendar-tests--get-ical-event "BEGIN:VTIMEZONE
TZID:anothername, with a comma
BEGIN:STANDARD
@@ -225,7 +228,8 @@ END:VTIMEZONE
(message (cdr result))
(should (string= "STD-02:00DST-03:00,M3.2.1/03:00:00,M10.2.1/04:00:00"
(cdr result)))
- ;; offsetfrom = offsetto
+
+ ;; testcase: offsetfrom = offsetto
(setq vtimezone (icalendar-tests--get-ical-event "BEGIN:VTIMEZONE
TZID:Kolkata, Chennai, Mumbai, New Delhi
X-MICROSOFT-CDO-TZID:23
@@ -245,7 +249,10 @@ END:VTIMEZONE
(should (string= "Kolkata, Chennai, Mumbai, New Delhi" (car result)))
(message (cdr result))
(should (string= "STD-05:30DST-05:30,M1.1.1/00:00:00,M1.1.1/00:00:00"
- (cdr result)))))
+ (cdr result)))
+
+ ;; FIXME: add testcase that covers changes for fix of bug#34315
+ ))
(ert-deftest icalendar--convert-ordinary-to-ical ()
"Test method for `icalendar--convert-ordinary-to-ical'."
@@ -419,11 +426,11 @@ END:VEVENT
")))
(should (string= "SUM sum DES des LOC loc ORG org"
(icalendar--format-ical-event event)))
- (setq icalendar-import-format (lambda (&rest ignore)
+ (setq icalendar-import-format (lambda (&rest _ignore)
"helloworld"))
(should (string= "helloworld" (icalendar--format-ical-event event)))
(setq icalendar-import-format
- (lambda (e)
+ (lambda (event)
(format "-%s-%s-%s-%s-%s-%s-%s-"
(icalendar--get-event-property event 'SUMMARY)
(icalendar--get-event-property event 'DESCRIPTION)
@@ -465,8 +472,7 @@ END:VEVENT
(ert-deftest icalendar--decode-isodatetime ()
"Test `icalendar--decode-isodatetime'."
- (let ((tz (getenv "TZ"))
- result)
+ (let ((tz (getenv "TZ")))
(unwind-protect
(progn
;; Use Eastern European Time (UTC+2, UTC+3 daylight saving)
@@ -483,17 +489,132 @@ END:VEVENT
(should (equal '(0 0 10 1 8 2013 4 t 10800)
(icalendar--decode-isodatetime "20130801T100000")))
+ ;; testcase: no time zone in input, shift by -1 days
+ ;; 1 Jan 2013 10:00 -> 31 Dec 2012
+ (should (equal '(0 0 10 31 12 2012 1 nil 7200)
+ (icalendar--decode-isodatetime "20130101T100000" -1)))
+ ;; 1 Aug 2013 10:00 (DST) -> 31 Jul 2012 (DST)
+ (should (equal '(0 0 10 31 7 2013 3 t 10800)
+ (icalendar--decode-isodatetime "20130801T100000" -1)))
+
+
;; testcase: UTC time zone specifier in input -> convert to local time
- ;; 31 Dec 2013 23:00 UTC -> 1 Jan 2013 01:00 EET
+ ;; 31 Dec 2013 23:00 UTC -> 1 Jan 2014 01:00 EET
(should (equal '(0 0 1 1 1 2014 3 nil 7200)
(icalendar--decode-isodatetime "20131231T230000Z")))
;; 1 Aug 2013 10:00 UTC -> 1 Aug 2013 13:00 EEST
(should (equal '(0 0 13 1 8 2013 4 t 10800)
(icalendar--decode-isodatetime "20130801T100000Z")))
+ ;; testcase: override timezone with Central European Time, 1 Jan 2013 10:00 -> 1 Jan 2013 11:00
+ (should (equal '(0 0 11 1 1 2013 2 nil 7200)
+ (icalendar--decode-isodatetime "20130101T100000" nil
+ '(3600 "CET"))))
+ ;; testcase: override timezone (UTC-02:00), 1 Jan 2013 10:00 -> 1 Jan 2013 14:00
+ (should (equal '(0 0 14 1 1 2013 2 nil 7200)
+ (icalendar--decode-isodatetime "20130101T100000" nil -7200)))
+
+ ;; FIXME: add testcase that covers changes for fix of bug#34315
+
+ )
+ ;; restore time-zone even if something went terribly wrong
+ (setenv "TZ" tz))))
+
+(ert-deftest icalendar--convert-tz-offset ()
+ "Test `icalendar--convert-tz-offset'."
+ (let ((tz (getenv "TZ")))
+ (unwind-protect
+ (progn
+ ;; Use Eastern European Time (UTC+2, UTC+3 daylight saving)
+ (setenv "TZ" "EET-2EEST,M3.5.0/3,M10.5.0/4")
+
+ ;; testcase: artificial input
+ (should (equal '("DST-03:00" . "M5.1.1/01:23:45")
+ (icalendar--convert-tz-offset
+ '((DTSTART nil "________T012345") ;
+ (TZOFFSETFROM nil "+0200")
+ (TZOFFSETTO nil "+0300")
+ (RRULE nil "FREQ=YEARLY;INTERVAL=1;BYDAY=1MO;BYMONTH=5"))
+ t)))
+
+ ;; testcase: Europe/Berlin Standard
+ (should (equal '("STD-01:00" . "M10.5.0/03:00:00")
+ (icalendar--convert-tz-offset
+ '((TZOFFSETFROM nil "+0200")
+ (TZOFFSETTO nil "+0100")
+ (TZNAME nil CET)
+ (DTSTART nil "19701025T030000")
+ (RRULE nil "FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU"))
+ nil)))
+
+ ;; testcase: Europe/Berlin DST
+ (should (equal '("DST-02:00" . "M3.5.0/02:00:00")
+ (icalendar--convert-tz-offset
+ '((TZOFFSETFROM nil "+0100")
+ (TZOFFSETTO nil "+0200")
+ (TZNAME nil CEST)
+ (DTSTART nil "19700329T020000")
+ (RRULE nil "FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU"))
+ t)))
+
+ ;; 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)))
+
+ ;; FIXME: rrule and rdate are NOT mandatory! Must fix code
+ ;; before activating these testcases
+ ;; ;; testcase: no rrule and no rdate => no result
+ ;; (should (null (icalendar--convert-tz-offset
+ ;; '((TZOFFSETFROM nil "+0100")
+ ;; (TZOFFSETTO nil "+0200")
+ ;; (DTSTART nil "19700329T020000"))
+ ;; t)))
+ ;; ;; testcase: no rrule with rdate => no result
+ ;; (should (null (icalendar--convert-tz-offset
+ ;; '((TZOFFSETFROM nil "+0100")
+ ;; (TZOFFSETTO nil "+0200")
+ ;; (DTSTART nil "18840101T000000")
+ ;; (RDATE nil "18840101T000000"))
+ ;; t)))
)
;; restore time-zone even if something went terribly wrong
- (setenv "TZ" tz))) )
+ (setenv "TZ" tz))))
+
+(ert-deftest icalendar--decode-isoduration ()
+ "Test `icalendar--decode-isoduration'."
+
+ ;; testcase: 7 days
+ (should (equal '(0 0 0 7 0 0)
+ (icalendar--decode-isoduration "P7D")))
+
+ ;; testcase: 7 days, one second -- see bug#34315
+ (should (equal '(1 0 0 7 0 0)
+ (icalendar--decode-isoduration "P7DT1S")))
+
+ ;; testcase: 3 hours, 2 minutes, one second
+ (should (equal '(1 2 3 0 0 0)
+ (icalendar--decode-isoduration "PT3H2M1S")))
+
+ ;; testcase: 99 days, 3 hours, 2 minutes, one second -- see bug#34315
+ (should (equal '(1 2 3 99 0 0)
+ (icalendar--decode-isoduration "P99DT3H2M1S")))
+
+ ;; testcase: 2 weeks
+ (should (equal '(0 0 0 14 0 0)
+ (icalendar--decode-isoduration "P2W")))
+
+ ;; testcase: rfc2445, section 4.3.6: 15 days, 5 hours and 20 seconds -- see bug#34315
+ (should (equal '(20 0 5 15 0 0)
+ (icalendar--decode-isoduration "P15DT5H0M20S")))
+
+ ;; testcase: rfc2445, section 4.3.6: 7 weeks
+ (should (equal '(0 0 0 49 0 0)
+ (icalendar--decode-isoduration "P7W")))
+ )
+
;; ======================================================================
;; Export tests
@@ -886,7 +1007,7 @@ During import test the timezone is set to Central European Time."
(icalendar-tests--do-test-import input expected-american)))))
(setenv "TZ" timezone))))
-(defun icalendar-tests--do-test-import (input expected-output)
+(defun icalendar-tests--do-test-import (_input expected-output)
"Actually perform import test.
Argument INPUT input icalendar string.
Argument EXPECTED-OUTPUT expected diary string."
@@ -2347,7 +2468,7 @@ END:VCALENDAR
(let ((time (icalendar--decode-isodatetime string day zone)))
(format-time-string "%FT%T%z" (encode-time time) 0)))
-(defun icalendar-tests--decode-isodatetime (ical-string)
+(defun icalendar-tests--decode-isodatetime (_ical-string)
(should (equal (icalendar-test--format "20040917T050910-0200")
"2004-09-17T03:09:10+0000"))
(should (equal (icalendar-test--format "20040917T050910")
diff --git a/test/lisp/calendar/iso8601-tests.el b/test/lisp/calendar/iso8601-tests.el
index 430680c5077..c835f5792b9 100644
--- a/test/lisp/calendar/iso8601-tests.el
+++ b/test/lisp/calendar/iso8601-tests.el
@@ -24,49 +24,61 @@
(ert-deftest test-iso8601-date-years ()
(should (equal (iso8601-parse-date "1985")
- '(nil nil nil nil nil 1985 nil nil nil)))
+ '(nil nil nil nil nil 1985 nil -1 nil)))
(should (equal (iso8601-parse-date "-0003")
- '(nil nil nil nil nil -3 nil nil nil)))
+ '(nil nil nil nil nil -3 nil -1 nil)))
(should (equal (iso8601-parse-date "+1985")
- '(nil nil nil nil nil 1985 nil nil nil))))
+ '(nil nil nil nil nil 1985 nil -1 nil))))
(ert-deftest test-iso8601-date-dates ()
(should (equal (iso8601-parse-date "1985-03-14")
- '(nil nil nil 14 3 1985 nil nil nil)))
+ '(nil nil nil 14 3 1985 nil -1 nil)))
(should (equal (iso8601-parse-date "19850314")
- '(nil nil nil 14 3 1985 nil nil nil)))
+ '(nil nil nil 14 3 1985 nil -1 nil)))
(should (equal (iso8601-parse-date "1985-02")
- '(nil nil nil nil 2 1985 nil nil nil))))
+ '(nil nil nil nil 2 1985 nil -1 nil))))
(ert-deftest test-iso8601-date-obsolete ()
(should (equal (iso8601-parse-date "--02-01")
- '(nil nil nil 1 2 nil nil nil nil)))
+ '(nil nil nil 1 2 nil nil -1 nil)))
(should (equal (iso8601-parse-date "--0201")
- '(nil nil nil 1 2 nil nil nil nil))))
+ '(nil nil nil 1 2 nil nil -1 nil))))
+
+(ert-deftest test-iso8601-date-obsolete-2000 ()
+ ;; These are forms in 5.2.1.3 of the 2000 version of the standard,
+ ;; e) and f).
+ (should (equal (iso8601-parse-date "--12")
+ '(nil nil nil nil 12 nil nil -1 nil)))
+ (should (equal (iso8601-parse "--12T14")
+ '(0 0 14 nil 12 nil nil -1 nil)))
+ (should (equal (iso8601-parse-date "---12")
+ '(nil nil nil 12 nil nil nil -1 nil)))
+ (should (equal (iso8601-parse "---12T14:10:12")
+ '(12 10 14 12 nil nil nil -1 nil))))
(ert-deftest test-iso8601-date-weeks ()
(should (equal (iso8601-parse-date "2008W39-6")
- '(nil nil nil 27 9 2008 nil nil nil)))
+ '(nil nil nil 27 9 2008 nil -1 nil)))
(should (equal (iso8601-parse-date "2009W01-1")
- '(nil nil nil 29 12 2008 nil nil nil)))
+ '(nil nil nil 29 12 2008 nil -1 nil)))
(should (equal (iso8601-parse-date "2009W53-7")
- '(nil nil nil 3 1 2010 nil nil nil))))
+ '(nil nil nil 3 1 2010 nil -1 nil))))
(ert-deftest test-iso8601-date-ordinals ()
(should (equal (iso8601-parse-date "1981-095")
- '(nil nil nil 5 4 1981 nil nil nil))))
+ '(nil nil nil 5 4 1981 nil -1 nil))))
(ert-deftest test-iso8601-time ()
(should (equal (iso8601-parse-time "13:47:30")
- '(30 47 13 nil nil nil nil nil nil)))
+ '(30 47 13 nil nil nil nil -1 nil)))
(should (equal (iso8601-parse-time "134730")
- '(30 47 13 nil nil nil nil nil nil)))
+ '(30 47 13 nil nil nil nil -1 nil)))
(should (equal (iso8601-parse-time "1347")
- '(0 47 13 nil nil nil nil nil nil))))
+ '(0 47 13 nil nil nil nil -1 nil))))
(ert-deftest test-iso8601-combined ()
(should (equal (iso8601-parse "2008-03-02T13:47:30")
- '(30 47 13 2 3 2008 nil nil nil)))
+ '(30 47 13 2 3 2008 nil -1 nil)))
(should (equal (iso8601-parse "2008-03-02T13:47:30Z")
'(30 47 13 2 3 2008 nil nil 0)))
(should (equal (iso8601-parse "2008-03-02T13:47:30+01:00")
@@ -76,13 +88,13 @@
(ert-deftest test-iso8601-duration ()
(should (equal (iso8601-parse-duration "P3Y6M4DT12H30M5S")
- '(5 30 12 4 6 3 nil nil nil)))
+ '(5 30 12 4 6 3 nil -1 nil)))
(should (equal (iso8601-parse-duration "P1M")
- '(0 0 0 0 1 0 nil nil nil)))
+ '(0 0 0 0 1 0 nil -1 nil)))
(should (equal (iso8601-parse-duration "PT1M")
- '(0 1 0 0 0 0 nil nil nil)))
+ '(0 1 0 0 0 0 nil -1 nil)))
(should (equal (iso8601-parse-duration "P0003-06-04T12:30:05")
- '(5 30 12 4 6 3 nil nil nil))))
+ '(5 30 12 4 6 3 nil -1 nil))))
(ert-deftest test-iso8601-invalid ()
(should-not (iso8601-valid-p " 2008-03-02T13:47:30-01"))
@@ -101,88 +113,88 @@
(should (equal (iso8601-parse-interval "2007-03-01T13:00:00Z/P1Y2M10DT2H30M")
'((0 0 13 1 3 2007 nil nil 0)
(0 30 15 11 5 2008 nil nil 0)
- (0 30 2 10 2 1 nil nil nil))))
+ (0 30 2 10 2 1 nil -1 nil))))
(should (equal (iso8601-parse-interval "P1Y2M10DT2H30M/2008-05-11T15:30:00Z")
'((0 0 13 1 3 2007 nil nil 0)
(0 30 15 11 5 2008 nil nil 0)
- (0 30 2 10 2 1 nil nil nil)))))
+ (0 30 2 10 2 1 nil -1 nil)))))
(ert-deftest standard-test-dates ()
(should (equal (iso8601-parse-date "19850412")
- '(nil nil nil 12 4 1985 nil nil nil)))
+ '(nil nil nil 12 4 1985 nil -1 nil)))
(should (equal (iso8601-parse-date "1985-04-12")
- '(nil nil nil 12 4 1985 nil nil nil)))
+ '(nil nil nil 12 4 1985 nil -1 nil)))
(should (equal (iso8601-parse-date "1985102")
- '(nil nil nil 12 4 1985 nil nil nil)))
+ '(nil nil nil 12 4 1985 nil -1 nil)))
(should (equal (iso8601-parse-date "1985-102")
- '(nil nil nil 12 4 1985 nil nil nil)))
+ '(nil nil nil 12 4 1985 nil -1 nil)))
(should (equal (iso8601-parse-date "1985W155")
- '(nil nil nil 12 4 1985 nil nil nil)))
+ '(nil nil nil 12 4 1985 nil -1 nil)))
(should (equal (iso8601-parse-date "1985-W15-5")
- '(nil nil nil 12 4 1985 nil nil nil)))
+ '(nil nil nil 12 4 1985 nil -1 nil)))
(should (equal (iso8601-parse-date "1985W15")
- '(nil nil nil 7 4 1985 nil nil nil)))
+ '(nil nil nil 7 4 1985 nil -1 nil)))
(should (equal (iso8601-parse-date "1985-W15")
- '(nil nil nil 7 4 1985 nil nil nil)))
+ '(nil nil nil 7 4 1985 nil -1 nil)))
(should (equal (iso8601-parse-date "1985-04")
- '(nil nil nil nil 4 1985 nil nil nil)))
+ '(nil nil nil nil 4 1985 nil -1 nil)))
(should (equal (iso8601-parse-date "1985")
- '(nil nil nil nil nil 1985 nil nil nil)))
+ '(nil nil nil nil nil 1985 nil -1 nil)))
(should (equal (iso8601-parse-date "+1985-04-12")
- '(nil nil nil 12 4 1985 nil nil nil)))
+ '(nil nil nil 12 4 1985 nil -1 nil)))
(should (equal (iso8601-parse-date "+19850412")
- '(nil nil nil 12 4 1985 nil nil nil))))
+ '(nil nil nil 12 4 1985 nil -1 nil))))
(ert-deftest standard-test-time-of-day-local-time ()
(should (equal (iso8601-parse-time "152746")
- '(46 27 15 nil nil nil nil nil nil)))
+ '(46 27 15 nil nil nil nil -1 nil)))
(should (equal (iso8601-parse-time "15:27:46")
- '(46 27 15 nil nil nil nil nil nil)))
+ '(46 27 15 nil nil nil nil -1 nil)))
(should (equal (iso8601-parse-time "1528")
- '(0 28 15 nil nil nil nil nil nil)))
+ '(0 28 15 nil nil nil nil -1 nil)))
(should (equal (iso8601-parse-time "15:28")
- '(0 28 15 nil nil nil nil nil nil)))
+ '(0 28 15 nil nil nil nil -1 nil)))
(should (equal (iso8601-parse-time "15")
- '(0 0 15 nil nil nil nil nil nil))))
+ '(0 0 15 nil nil nil nil -1 nil))))
(ert-deftest standard-test-time-of-day-fractions ()
(should (equal (iso8601-parse-time "152735,5" t)
- '((355 . 10) 27 15 nil nil nil nil nil nil)))
+ '((355 . 10) 27 15 nil nil nil nil -1 nil)))
(should (equal (iso8601-parse-time "15:27:35,5" t)
- '((355 . 10) 27 15 nil nil nil nil nil nil)))
+ '((355 . 10) 27 15 nil nil nil nil -1 nil)))
(should (equal (iso8601-parse-time "2320,5" t)
- '(30 20 23 nil nil nil nil nil nil)))
+ '(30 20 23 nil nil nil nil -1 nil)))
(should (equal (iso8601-parse-time "23:20,8" t)
- '(48 20 23 nil nil nil nil nil nil)))
+ '(48 20 23 nil nil nil nil -1 nil)))
(should (equal (iso8601-parse-time "23,3" t)
- '(0 18 23 nil nil nil nil nil nil))))
+ '(0 18 23 nil nil nil nil -1 nil))))
(ert-deftest nonstandard-test-time-of-day-decimals ()
(should (equal (iso8601-parse-time "15:27:35.123" t)
- '((35123 . 1000) 27 15 nil nil nil nil nil nil)))
+ '((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 nil nil))))
+ '((35123456789 . 1000000000) 27 15 nil nil nil nil -1 nil))))
(ert-deftest standard-test-time-of-day-beginning-of-day ()
(should (equal (iso8601-parse-time "000000")
- '(0 0 0 nil nil nil nil nil nil)))
+ '(0 0 0 nil nil nil nil -1 nil)))
(should (equal (iso8601-parse-time "00:00:00")
- '(0 0 0 nil nil nil nil nil nil)))
+ '(0 0 0 nil nil nil nil -1 nil)))
(should (equal (iso8601-parse-time "0000")
- '(0 0 0 nil nil nil nil nil nil)))
+ '(0 0 0 nil nil nil nil -1 nil)))
(should (equal (iso8601-parse-time "00:00")
- '(0 0 0 nil nil nil nil nil nil))))
+ '(0 0 0 nil nil nil nil -1 nil))))
(ert-deftest standard-test-time-of-day-utc ()
(should (equal (iso8601-parse-time "232030Z")
@@ -220,11 +232,42 @@
(should (equal (iso8601-parse-time "15:27:46-05")
'(46 27 15 nil nil nil nil nil -18000))))
+
+(defun test-iso8601-format-time-string-zone-round-trip (offset-minutes z-format)
+ "Pass OFFSET-MINUTES to format-time-string with Z-FORMAT, a %z variation,
+and then to iso8601-parse-zone. The result should be the original offset."
+ (let* ((offset-seconds (* 60 offset-minutes))
+ (zone-string (format-time-string z-format 0 offset-seconds))
+ (offset-rt
+ (condition-case nil
+ (iso8601-parse-zone zone-string)
+ (wrong-type-argument (format "(failed to parse %S)" zone-string))))
+ ;; compare strings that contain enough info to debug failures
+ (success (format "%s(%s) -> %S -> %s"
+ z-format offset-minutes zone-string offset-minutes))
+ (actual (format "%s(%s) -> %S -> %s"
+ z-format offset-minutes zone-string offset-rt)))
+ (should (equal success actual))))
+
+(ert-deftest iso8601-format-time-string-zone-round-trip ()
+ "Round trip zone offsets through format-time-string and iso8601-parse-zone.
+Passing a time zone created by format-time-string %z to
+iso8601-parse-zone should yield the original offset."
+ (dolist (offset-minutes
+ (list
+ ;; compare hours (1- and 2-digit), minutes, both, neither
+ (* 5 60) (* 11 60) 5 11 (+ (* 5 60) 30) (+ (* 11 60) 30) 0
+ ;; do negative values, too
+ (* -5 60) (* -11 60) -5 -11 (- (* -5 60) 30) (- (* -11 60) 30)))
+ (dolist (z-format '("%z" "%:z" "%:::z"))
+ (test-iso8601-format-time-string-zone-round-trip
+ offset-minutes z-format))))
+
(ert-deftest standard-test-date-and-time-of-day ()
(should (equal (iso8601-parse "19850412T101530")
- '(30 15 10 12 4 1985 nil nil nil)))
+ '(30 15 10 12 4 1985 nil -1 nil)))
(should (equal (iso8601-parse "1985-04-12T10:15:30")
- '(30 15 10 12 4 1985 nil nil nil)))
+ '(30 15 10 12 4 1985 nil -1 nil)))
(should (equal (iso8601-parse "1985102T235030Z")
'(30 50 23 12 4 1985 nil nil 0)))
@@ -232,9 +275,9 @@
'(30 50 23 12 4 1985 nil nil 0)))
(should (equal (iso8601-parse "1985W155T235030")
- '(30 50 23 12 4 1985 nil nil nil)))
+ '(30 50 23 12 4 1985 nil -1 nil)))
(should (equal (iso8601-parse "1985-W155T23:50:30")
- '(30 50 23 12 4 1985 nil nil nil))))
+ '(30 50 23 12 4 1985 nil -1 nil))))
(ert-deftest standard-test-interval ()
;; A time interval starting at 20 minutes and 50 seconds past 23
@@ -256,48 +299,48 @@
;; This example doesn't seem valid according to the standard.
;; "0625" is unambiguous, and means "the year 625". Weird.
;; (should (equal (iso8601-parse-interval "19850412/0625")
- ;; '((nil nil nil 12 4 1985 nil nil nil)
- ;; (nil nil nil nil nil 625 nil nil nil)
+ ;; '((nil nil nil 12 4 1985 nil -1 nil)
+ ;; (nil nil nil nil nil 625 nil -1 nil)
;; (0 17 0 22 9 609 5 nil 0))))
;; A time interval of 2 years, 10 months, 15 days, 10 hours, 20
;; minutes and 30 seconds.
(should (equal (iso8601-parse-duration "P2Y10M15DT10H20M30S")
- '(30 20 10 15 10 2 nil nil nil)))
+ '(30 20 10 15 10 2 nil -1 nil)))
(should (equal (iso8601-parse-duration "P00021015T102030")
- '(30 20 10 15 10 2 nil nil nil)))
+ '(30 20 10 15 10 2 nil -1 nil)))
(should (equal (iso8601-parse-duration "P0002-10-15T10:20:30")
- '(30 20 10 15 10 2 nil nil nil)))
+ '(30 20 10 15 10 2 nil -1 nil)))
;; A time interval of 1 year and 6 months.
(should (equal (iso8601-parse-duration "P1Y6M")
- '(0 0 0 0 6 1 nil nil nil)))
+ '(0 0 0 0 6 1 nil -1 nil)))
(should (equal (iso8601-parse-duration "P0001-06")
- '(nil nil nil nil 6 1 nil nil nil)))
+ '(nil nil nil nil 6 1 nil -1 nil)))
;; A time interval of seventy-two hours.
(should (equal (iso8601-parse-duration "PT72H")
- '(0 0 72 0 0 0 nil nil nil)))
+ '(0 0 72 0 0 0 nil -1 nil)))
;; Defined by start and duration
;; A time interval of 1 year, 2 months, 15 days and 12 hours,
;; beginning on 12 April 1985 at 20 minutes past 23 hours.
(should (equal (iso8601-parse-interval "19850412T232000/P1Y2M15DT12H")
- '((0 20 23 12 4 1985 nil nil nil)
- (0 20 11 28 6 1986 nil nil nil)
- (0 0 12 15 2 1 nil nil nil))))
+ '((0 20 23 12 4 1985 nil -1 nil)
+ (0 20 11 28 6 1986 nil -1 nil)
+ (0 0 12 15 2 1 nil -1 nil))))
(should (equal (iso8601-parse-interval "1985-04-12T23:20:00/P1Y2M15DT12H")
- '((0 20 23 12 4 1985 nil nil nil)
- (0 20 11 28 6 1986 nil nil nil)
- (0 0 12 15 2 1 nil nil nil))))
+ '((0 20 23 12 4 1985 nil -1 nil)
+ (0 20 11 28 6 1986 nil -1 nil)
+ (0 0 12 15 2 1 nil -1 nil))))
;; Defined by duration and end
;; A time interval of 1 year, 2 months, 15 days and 12 hours, ending
;; on 12 April 1985 at 20 minutes past 23 hour.
(should (equal (iso8601-parse-interval "P1Y2M15DT12H/19850412T232000")
- '((0 20 11 28 1 1984 nil nil nil)
- (0 20 23 12 4 1985 nil nil nil)
- (0 0 12 15 2 1 nil nil nil)))))
+ '((0 20 11 28 1 1984 nil -1 nil)
+ (0 20 23 12 4 1985 nil -1 nil)
+ (0 0 12 15 2 1 nil -1 nil)))))
;;; iso8601-tests.el ends here
diff --git a/test/lisp/calendar/lunar-tests.el b/test/lisp/calendar/lunar-tests.el
new file mode 100644
index 00000000000..d2647aac03a
--- /dev/null
+++ b/test/lisp/calendar/lunar-tests.el
@@ -0,0 +1,75 @@
+;;; lunar-tests.el --- tests for calendar/lunar.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 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/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'lunar)
+
+(defmacro with-lunar-test (&rest body)
+ `(let ((calendar-latitude 40.1)
+ (calendar-longitude -88.2)
+ (calendar-location-name "Urbana, IL")
+ (calendar-time-zone -360)
+ (calendar-standard-time-zone-name "CST")
+ (calendar-time-display-form '(12-hours ":" minutes am-pm)))
+ ,@body))
+
+(ert-deftest lunar-test-phase ()
+ (with-lunar-test
+ (should (equal (lunar-phase 1)
+ '((1 7 1900) "11:40pm" 1 "")))))
+
+(ert-deftest lunar-test-eclipse-check ()
+ (with-lunar-test
+ (should (equal (eclipse-check 1 1) "** Eclipse **"))))
+
+;; This fails in certain time zones.
+;; Eg TZ=America/Phoenix make lisp/calendar/lunar-tests
+;; Similarly with TZ=UTC.
+;; Daylight saving related?
+(ert-deftest lunar-test-phase-list ()
+ :tags '(:unstable)
+ (with-lunar-test
+ (should (equal (lunar-phase-list 3 1871)
+ '(((3 20 1871) "11:03pm" 0 "")
+ ((3 29 1871) "1:46am" 1 "** Eclipse **")
+ ((4 5 1871) "9:20am" 2 "")
+ ((4 12 1871) "12:57am" 3 "** Eclipse possible **")
+ ((4 19 1871) "2:06pm" 0 "")
+ ((4 27 1871) "6:49pm" 1 "")
+ ((5 4 1871) "5:57pm" 2 "")
+ ((5 11 1871) "9:29am" 3 "")
+ ((5 19 1871) "5:46am" 0 "")
+ ((5 27 1871) "8:02am" 1 ""))))))
+
+(ert-deftest lunar-test-new-moon-time ()
+ (with-lunar-test
+ (should (= (round (lunar-new-moon-time 1))
+ 2451580))))
+
+(ert-deftest lunar-test-new-moon-on-or-after ()
+ (with-lunar-test
+ (should (= (round (lunar-new-moon-on-or-after (calendar-absolute-from-gregorian '(5 5 1818))))
+ 664525))))
+
+(provide 'lunar-tests)
+;;; lunar-tests.el ends here
diff --git a/test/lisp/calendar/parse-time-tests.el b/test/lisp/calendar/parse-time-tests.el
index 4924e8b072a..e1801a57307 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
+;; parse-time-tests.el --- Test suite for parse-time.el -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el
index 4c8f18a7a95..233d43cd01a 100644
--- a/test/lisp/calendar/time-date-tests.el
+++ b/test/lisp/calendar/time-date-tests.el
@@ -31,7 +31,9 @@
(ert-deftest test-days-in-month ()
(should (= (date-days-in-month 2004 2) 29))
(should (= (date-days-in-month 2004 3) 31))
- (should-not (= (date-days-in-month 1900 3) 28)))
+ (should-not (= (date-days-in-month 1900 3) 28))
+ (should-error (date-days-in-month 2020 15))
+ (should-error (date-days-in-month 2020 'foo)))
(ert-deftest test-ordinal ()
(should (equal (date-ordinal-to-time 2008 271)
@@ -107,4 +109,38 @@
(ert-deftest test-time-since ()
(should (time-equal-p 0 (time-since nil))))
+(ert-deftest test-time-decoded-period ()
+ (should (equal (decoded-time-period '(nil nil 1 nil nil nil nil nil nil))
+ 3600))
+
+ (should (equal (decoded-time-period '(1 0 0 0 0 0 nil nil nil)) 1))
+ (should (equal (decoded-time-period '(0 1 0 0 0 0 nil nil nil)) 60))
+ (should (equal (decoded-time-period '(0 0 1 0 0 0 nil nil nil)) 3600))
+ (should (equal (decoded-time-period '(0 0 0 1 0 0 nil nil nil)) 86400))
+ (should (equal (decoded-time-period '(0 0 0 0 1 0 nil nil nil)) 2592000))
+ (should (equal (decoded-time-period '(0 0 0 0 0 1 nil nil nil)) 31536000))
+
+ (should (equal (decoded-time-period '((135 . 10) 0 0 0 0 0 nil nil nil))
+ 13.5)))
+
+(ert-deftest test-time-wrap-addition ()
+ (should (equal (decoded-time-add '(0 0 0 1 11 2008 nil nil nil)
+ (make-decoded-time :month 1))
+ '(0 0 0 1 12 2008 nil nil nil)))
+ (should (equal (decoded-time-add '(0 0 0 1 12 2008 nil nil nil)
+ (make-decoded-time :month 1))
+ '(0 0 0 1 1 2009 nil nil nil)))
+ (should (equal (decoded-time-add '(0 0 0 1 11 2008 nil nil nil)
+ (make-decoded-time :month 12))
+ '(0 0 0 1 11 2009 nil nil nil)))
+ (should (equal (decoded-time-add '(0 0 0 1 11 2008 nil nil nil)
+ (make-decoded-time :month 13))
+ '(0 0 0 1 12 2009 nil nil nil)))
+ (should (equal (decoded-time-add '(0 0 0 30 12 2008 nil nil nil)
+ (make-decoded-time :day 1))
+ '(0 0 0 31 12 2008 nil nil nil)))
+ (should (equal (decoded-time-add '(0 0 0 30 12 2008 nil nil nil)
+ (make-decoded-time :day 2))
+ '(0 0 0 1 1 2009 nil nil nil))))
+
;;; time-date-tests.el ends here
diff --git a/test/lisp/calendar/todo-mode-resources/todo-test-1.todo b/test/lisp/calendar/todo-mode-resources/todo-test-1.todo
index 598d487cad9..2375772fbe7 100644
--- a/test/lisp/calendar/todo-mode-resources/todo-test-1.todo
+++ b/test/lisp/calendar/todo-mode-resources/todo-test-1.todo
@@ -1,8 +1,8 @@
-(("testcat1" . [2 0 2 1]) ("testcat2" . [3 0 1 1]) ("testcat3" . [0 0 0 0]))
+(("testcat1" . [2 0 2 1]) ("testcat2" . [3 0 1 1]) ("testcat3" . [0 0 0 0]) ("testcat4" . [1 0 0 0]))
--==-- testcat1
[May 29, 2017] testcat1 item3
- has more than one line
- to test item highlighting
+ has more than one line
+ to test item highlighting
[Jul 3, 2017] testcat1 item4
==--== DONE
@@ -18,3 +18,7 @@
--==-- testcat3
==--== DONE
+--==-- testcat4
+[Jan 1, 2020] testcat4 item1
+
+==--== DONE
diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el
index d65f94d4f31..1fbd39478c5 100644
--- a/test/lisp/calendar/todo-mode-tests.el
+++ b/test/lisp/calendar/todo-mode-tests.el
@@ -414,8 +414,15 @@ the top done item should be the first done item."
(should (todo-done-item-p))
(forward-line -1)
(should (looking-at todo-category-done))
- ;; Make sure marked items are no longer in first category.
- (todo-backward-category)
+ ;; Make sure marked items are no longer in first category. Since
+ ;; cat1 now contains no todo or done items but does have archived
+ ;; items, todo-backward-category would skip it by default, so
+ ;; prevent this. (FIXME: Without this let-binding,
+ ;; todo-backward-category selects the nonempty cat4 and this test
+ ;; fails as expected when run interactively but not in a batch
+ ;; run -- why?)
+ (let (todo-skip-archived-categories)
+ (todo-backward-category))
(should (eq (point-min) (point-max))) ; All todo items were moved.
;; This passes when run interactively but fails in a batch run:
;; the message is displayed but (current-message) evaluates to
@@ -848,6 +855,94 @@ should display the previously current (or default) todo file."
(should (equal todo-current-todo-file todo-test-file-1))
(delete-file (concat file "~")))))
+(ert-deftest todo-test-edit-item-date-month () ; bug#42976 #3 and #4
+ "Test incrementing and decrementing the month of an item's date.
+If the change in month crosses a year boundary, the year of the
+item's date should be adjusted accordingly."
+ (with-todo-test
+ (todo-test--show 4)
+ (let ((current-prefix-arg t) ; For todo-edit-item--header.
+ (get-date (lambda ()
+ (save-excursion
+ (todo-date-string-matcher (line-end-position))
+ (buffer-substring-no-properties (match-beginning 1)
+ (match-end 0))))))
+ (should (equal (funcall get-date) "Jan 1, 2020"))
+ (todo-edit-item--header 'month 0)
+ (should (equal (funcall get-date) "Jan 1, 2020"))
+ (todo-edit-item--header 'month 1)
+ (should (equal (funcall get-date) "Feb 1, 2020"))
+ (todo-edit-item--header 'month -1)
+ (should (equal (funcall get-date) "Jan 1, 2020"))
+ (todo-edit-item--header 'month -1)
+ (should (equal (funcall get-date) "Dec 1, 2019"))
+ (todo-edit-item--header 'month 1)
+ (should (equal (funcall get-date) "Jan 1, 2020"))
+ (todo-edit-item--header 'month 12)
+ (should (equal (funcall get-date) "Jan 1, 2021"))
+ (todo-edit-item--header 'month -12)
+ (should (equal (funcall get-date) "Jan 1, 2020"))
+ (todo-edit-item--header 'month -13)
+ (should (equal (funcall get-date) "Dec 1, 2018"))
+ (todo-edit-item--header 'month 7)
+ (should (equal (funcall get-date) "Jul 1, 2019"))
+ (todo-edit-item--header 'month 6)
+ (should (equal (funcall get-date) "Jan 1, 2020"))
+ (todo-edit-item--header 'month 23)
+ (should (equal (funcall get-date) "Dec 1, 2021"))
+ (todo-edit-item--header 'month -23)
+ (should (equal (funcall get-date) "Jan 1, 2020"))
+ (todo-edit-item--header 'month 24)
+ (should (equal (funcall get-date) "Jan 1, 2022"))
+ (todo-edit-item--header 'month -24)
+ (should (equal (funcall get-date) "Jan 1, 2020"))
+ (todo-edit-item--header 'month 25)
+ (should (equal (funcall get-date) "Feb 1, 2022"))
+ (todo-edit-item--header 'month -25)
+ (should (equal (funcall get-date) "Jan 1, 2020")))))
+
+(ert-deftest todo-test-multiline-item-indentation-1 ()
+ "Test inserting a multine item containing a hard line break.
+After insertion the second line of the item should begin with a
+tab character."
+ (with-todo-test
+ (let* ((item0 "Test inserting a multine item")
+ (item1 "containing a hard line break.")
+ (item (concat item0 "\n" item1)))
+ (todo-test--show 1)
+ (todo-test--insert-item item 1)
+ (re-search-forward (concat todo-date-string-start todo-date-pattern
+ (regexp-quote todo-nondiary-end) " ")
+ (line-end-position) t)
+ (should (looking-at (regexp-quote (concat item0 "\n\t" item1)))))))
+
+(ert-deftest todo-test-multiline-item-indentation-2 () ; bug#43068
+ "Test editing an item by adding text on a new line.
+After quitting todo-edit-mode the second line of the item should
+begin with a tab character."
+ (with-todo-test
+ (todo-test--show 2)
+ (let* ((item0 (todo-item-string))
+ (item1 "Second line."))
+ (todo-edit-item--text 'multiline)
+ (insert (concat "\n" item1))
+ (todo-edit-quit)
+ (goto-char (line-beginning-position))
+ (should (looking-at (regexp-quote (concat item0 "\n\t" item1)))))))
+
+(ert-deftest todo-test-multiline-item-indentation-3 ()
+ "Test adding an unindented new line to an item using todo-edit-file.
+Attempting to quit todo-edit-mode should signal a user-error,
+since all non-initial item lines must begin with whitespace."
+ (with-todo-test
+ (todo-test--show 2)
+ (let* ((item0 (todo-item-string))
+ (item1 "Second line."))
+ (todo-edit-file)
+ (should (looking-at (regexp-quote item0)))
+ (goto-char (line-end-position))
+ (insert (concat "\n" item1))
+ (should-error (todo-edit-quit) :type 'user-error))))
(provide 'todo-mode-tests)
;;; todo-mode-tests.el ends here
diff --git a/test/lisp/cedet/semantic-utest-c.el b/test/lisp/cedet/semantic-utest-c.el
index bdd6c050df6..c776a0fbaac 100644
--- a/test/lisp/cedet/semantic-utest-c.el
+++ b/test/lisp/cedet/semantic-utest-c.el
@@ -1,4 +1,4 @@
-;;; semantic-utest-c.el --- C based parsing tests.
+;;; semantic-utest-c.el --- C based parsing tests. -*- lexical-binding:t -*-
;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
@@ -40,11 +40,13 @@
(defvar semantic-utest-c-test-directory (expand-file-name "tests" cedet-utest-directory)
"Location of test files.")
+(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."
- (interactive)
+ :tags '(:expensive-test)
(semantic-mode 1)
(dolist (fp semantic-utest-c-comparisons)
(let* ((semantic-lex-c-nested-namespace-ignore-second nil)
@@ -146,33 +148,32 @@ gcc version 2.95.2 19991024 (release)"
(ert-deftest semantic-test-gcc-output-parser ()
"Test the output parser against some collected strings."
- (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)
- ))
- (should (and v h))
- ))
- (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)))
- )
- ;; negative test
- (should-not (and v h p))
- ))
- ))
+ (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)
+ ))
+ (should (and v h))
+ ))
+ (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)))
+ )
+ ;; negative test
+ (should-not (and v h p))
+ ))
+ )
(provide 'semantic-utest-c)
diff --git a/test/lisp/cedet/semantic-utest-fmt.el b/test/lisp/cedet/semantic-utest-fmt.el
index 2fc2b681868..c2f2bb7226c 100644
--- a/test/lisp/cedet/semantic-utest-fmt.el
+++ b/test/lisp/cedet/semantic-utest-fmt.el
@@ -1,4 +1,4 @@
-;;; cedet/semantic-utest-fmt.el --- Parsing / Formatting tests
+;;; cedet/semantic-utest-fmt.el --- Parsing / Formatting tests -*- lexical-binding:t -*-
;;; Copyright (C) 2003-2004, 2007-2020 Free Software Foundation, Inc.
@@ -69,7 +69,6 @@ Files to visit are in `semantic-fmt-utest-file-list'."
;; Run the tests.
(let ((fb (find-buffer-visiting fname))
(b (semantic-find-file-noselect fname))
- (num 0)
(tags nil))
(save-current-buffer
@@ -82,7 +81,6 @@ Files to visit are in `semantic-fmt-utest-file-list'."
(semantic-clear-toplevel-cache)
;; Force the reparse
(setq tags (semantic-fetch-tags))
- (setq num (length tags))
(save-excursion
(while tags
diff --git a/test/lisp/cedet/semantic-utest-ia.el b/test/lisp/cedet/semantic-utest-ia.el
index 5761224d756..c99ef97b509 100644
--- a/test/lisp/cedet/semantic-utest-ia.el
+++ b/test/lisp/cedet/semantic-utest-ia.el
@@ -1,4 +1,4 @@
-;;; semantic-utest-ia.el --- Analyzer unit tests
+;;; semantic-utest-ia.el --- Analyzer unit tests -*- lexical-binding:t -*-
;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
@@ -211,7 +211,7 @@
;; completions, then remove the below debug-on-error setting.
(debug-on-error nil)
(acomp
- (condition-case err
+ (condition-case _err
(semantic-analyze-possible-completions ctxt)
((error user-error) nil))
))
@@ -438,11 +438,10 @@ tag that contains point, and return that."
(let* ((ctxt (semantic-analyze-current-context))
(target (car (reverse (oref ctxt prefix))))
(tag (semantic-current-tag))
- (start (current-time))
(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))
Lcount)))
diff --git a/test/lisp/cedet/semantic-utest.el b/test/lisp/cedet/semantic-utest.el
index 7e336557948..e537871528c 100644
--- a/test/lisp/cedet/semantic-utest.el
+++ b/test/lisp/cedet/semantic-utest.el
@@ -1,4 +1,4 @@
-;;; semantic-utest.el --- Tests for semantic's parsing system.
+;;; semantic-utest.el --- Tests for semantic's parsing system. -*- lexical-binding:t -*-
;;; Copyright (C) 2003-2004, 2007-2020 Free Software Foundation, Inc.
@@ -537,10 +537,9 @@ Pre-fill the buffer with CONTENTS."
-(defun semantic-utest-generic (testname filename contents name-contents names-removed killme insertme)
+(defun semantic-utest-generic (filename contents name-contents names-removed killme insertme)
"Generic unit test according to template.
Should work for languages without .h files, python javascript java.
-TESTNAME is the name of the test.
FILENAME is the name of the file to create.
CONTENTS is the contents of the file to test.
NAME-CONTENTS is the list of names that should be in the contents.
@@ -564,10 +563,8 @@ INSERTME is the text to be inserted after the deletion."
(sit-for 0)
;; Run the tests.
- ;;(message "First parsing test %s." testname)
(should (semantic-utest-verify-names name-contents))
- ;;(message "Invalid tag test %s." testname)
(semantic-utest-last-invalid name-contents names-removed killme insertme)
(should (semantic-utest-verify-names name-contents))
@@ -576,16 +573,17 @@ INSERTME is the text to be inserted after the deletion."
(kill-buffer buff)
)))
+(defvar python-indent-guess-indent-offset) ; Silence byte-compiler.
(ert-deftest semantic-utest-Python()
- (skip-unless (featurep 'python-mode))
+ (skip-unless (fboundp 'python-mode))
(let ((python-indent-guess-indent-offset nil))
- (semantic-utest-generic "Python" (semantic-utest-fname "pytest.py") semantic-utest-Python-buffer-contents semantic-utest-Python-name-contents '("fun2") "#1" "#deleted line")
+ (semantic-utest-generic (semantic-utest-fname "pytest.py") semantic-utest-Python-buffer-contents semantic-utest-Python-name-contents '("fun2") "#1" "#deleted line")
))
(ert-deftest semantic-utest-Javascript()
(if (fboundp 'javascript-mode)
- (semantic-utest-generic "Javascript" (semantic-utest-fname "javascripttest.js") semantic-utest-Javascript-buffer-contents semantic-utest-Javascript-name-contents '("fun2") "//1" "//deleted line")
+ (semantic-utest-generic (semantic-utest-fname "javascripttest.js") semantic-utest-Javascript-buffer-contents semantic-utest-Javascript-name-contents '("fun2") "//1" "//deleted line")
(message "Skipping JavaScript test: NO major mode."))
)
@@ -593,34 +591,34 @@ INSERTME is the text to be inserted after the deletion."
;; If JDE is installed, it might mess things up depending on the version
;; that was installed.
(let ((auto-mode-alist '(("\\.java\\'" . java-mode))))
- (semantic-utest-generic "Java" (semantic-utest-fname "JavaTest.java") semantic-utest-Java-buffer-contents semantic-utest-Java-name-contents '("fun2") "//1" "//deleted line")
+ (semantic-utest-generic (semantic-utest-fname "JavaTest.java") semantic-utest-Java-buffer-contents semantic-utest-Java-name-contents '("fun2") "//1" "//deleted line")
))
(ert-deftest semantic-utest-Makefile()
- (semantic-utest-generic "Makefile" (semantic-utest-fname "Makefile") semantic-utest-Makefile-buffer-contents semantic-utest-Makefile-name-contents '("fun2") "#1" "#deleted line")
+ (semantic-utest-generic (semantic-utest-fname "Makefile") semantic-utest-Makefile-buffer-contents semantic-utest-Makefile-name-contents '("fun2") "#1" "#deleted line")
)
(ert-deftest semantic-utest-Scheme()
(skip-unless nil) ;; There is a bug w/ scheme parser. Skip this for now.
- (semantic-utest-generic "Scheme" (semantic-utest-fname "tst.scm") semantic-utest-Scheme-buffer-contents semantic-utest-Scheme-name-contents '("fun2") ";1" ";deleted line")
+ (semantic-utest-generic (semantic-utest-fname "tst.scm") semantic-utest-Scheme-buffer-contents semantic-utest-Scheme-name-contents '("fun2") ";1" ";deleted line")
)
-
+(defvar html-helper-build-new-buffer) ; Silence byte-compiler.
(ert-deftest semantic-utest-Html()
;; Disable html-helper auto-fill-in mode.
- (let ((html-helper-build-new-buffer nil))
- (semantic-utest-generic "HTML" (semantic-utest-fname "tst.html") semantic-utest-Html-buffer-contents semantic-utest-Html-name-contents '("fun2") "<!--1-->" "<!--deleted line-->")
+ (let ((html-helper-build-new-buffer nil)) ; FIXME: Why is this bound?
+ (semantic-utest-generic (semantic-utest-fname "tst.html") semantic-utest-Html-buffer-contents semantic-utest-Html-name-contents '("fun2") "<!--1-->" "<!--deleted line-->")
))
(ert-deftest semantic-utest-PHP()
(skip-unless (featurep 'php-mode))
- (semantic-utest-generic "PHP" (semantic-utest-fname "phptest.php") semantic-utest-PHP-buffer-contents semantic-utest-PHP-name-contents '("fun1") "fun2" "%^@")
+ (semantic-utest-generic (semantic-utest-fname "phptest.php") semantic-utest-PHP-buffer-contents semantic-utest-PHP-name-contents '("fun1") "fun2" "%^@")
)
;look at http://mfgames.com/linux/csharp-mode
(ert-deftest semantic-utest-Csharp() ;; hmm i don't even know how to edit a scharp file. need a csharp mode implementation i suppose
(skip-unless (featurep 'csharp-mode))
- (semantic-utest-generic "C#" (semantic-utest-fname "csharptest.cs") semantic-utest-Csharp-buffer-contents semantic-utest-Csharp-name-contents '("fun2") "//1" "//deleted line")
+ (semantic-utest-generic (semantic-utest-fname "csharptest.cs") semantic-utest-Csharp-buffer-contents semantic-utest-Csharp-name-contents '("fun2") "//1" "//deleted line")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -758,7 +756,7 @@ JAVE this thing would need to be recursive to handle java and csharp"
(sit-for 0)
)
-(defun semantic-utest-last-invalid (name-contents names-removed killme insertme)
+(defun semantic-utest-last-invalid (_name-contents _names-removed killme insertme)
"Make the last fcn invalid."
(semantic-utest-kill-indicator killme insertme)
; (semantic-utest-verify-names name-contents names-removed); verify its gone ;new validator doesn't handle skipnames yet
diff --git a/test/lisp/cedet/srecode-utest-getset.el b/test/lisp/cedet/srecode-utest-getset.el
index e49a19594c3..fc66ac4edf2 100644
--- a/test/lisp/cedet/srecode-utest-getset.el
+++ b/test/lisp/cedet/srecode-utest-getset.el
@@ -1,4 +1,4 @@
-;;; srecode/test-getset.el --- Test the getset inserter.
+;;; srecode/test-getset.el --- Test the getset inserter. -*- lexical-binding:t -*-
;; Copyright (C) 2008, 2009, 2011, 2019-2020 Free Software Foundation, Inc
@@ -52,8 +52,10 @@ private:
temporary-file-directory)
"File used to do testing.")
+(defvar srecode-insert-getset-fully-automatic-flag) ; Silence byte-compiler.
(ert-deftest srecode-utest-getset-output ()
"Test various template insertion options."
+ :tags '(:expensive-test)
(save-excursion
(let ((testbuff (find-file-noselect srecode-utest-getset-testfile))
(srecode-insert-getset-fully-automatic-flag t))
diff --git a/test/lisp/cedet/srecode-utest-template.el b/test/lisp/cedet/srecode-utest-template.el
index 4dd64e2ea8c..7c5bbc599a3 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.
+;;; srecode/test.el --- SRecode Core Template tests. -*- lexical-binding:t -*-
;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
@@ -323,7 +323,6 @@ INSIDE SECTION: ARG HANDLER ONE")
(ert-deftest srecode-utest-project ()
"Test that project filtering works."
- :expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed) ; fixme
(save-excursion
(let ((testbuff (find-file-noselect srecode-utest-testfile))
(temp nil))
@@ -347,6 +346,10 @@ INSIDE SECTION: ARG HANDLER ONE")
;; Load the application templates, and make sure we can find them.
(srecode-load-tables-for-mode major-mode 'tests)
+ (dolist (table (oref (srecode-table) tables))
+ (when (gethash "test" (oref table contexthash))
+ (oset table project default-directory)))
+
(setq temp (srecode-template-get-table (srecode-table)
"test-project"
"test"
diff --git a/test/lisp/char-fold-tests.el b/test/lisp/char-fold-tests.el
index 0e55dfbb8ed..599d9d614f9 100644
--- a/test/lisp/char-fold-tests.el
+++ b/test/lisp/char-fold-tests.el
@@ -4,18 +4,20 @@
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
-;; 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/>.
;;; Code:
diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el
index 9c27a92d2bf..5b593409027 100644
--- a/test/lisp/comint-tests.el
+++ b/test/lisp/comint-tests.el
@@ -1,4 +1,4 @@
-;;; comint-testsuite.el
+;;; comint-tests.el -*- lexical-binding:t -*-
;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
@@ -52,73 +52,41 @@
(dolist (str comint-testsuite-password-strings)
(should (string-match comint-password-prompt-regexp str))))
-(ert-deftest comint-test-no-password-function ()
- "Test that `comint-password-function' not being set does not
-alter normal password flow."
- (cl-letf
- (((symbol-function 'read-passwd)
- (lambda (_prompt &optional _confirm _default)
- "PaSsWoRd123")))
- (let ((cat (executable-find "cat")))
- (when cat
+(defun comint-tests/test-password-function (password-function)
+ "PASSWORD-FUNCTION can return nil or a string."
+ (when-let ((cat (executable-find "cat")))
+ (let ((comint-password-function password-function))
+ (cl-letf (((symbol-function 'read-passwd)
+ (lambda (&rest _args) "non-nil")))
(with-temp-buffer
(make-comint-in-buffer "test-comint-password" (current-buffer) cat)
(let ((proc (get-buffer-process (current-buffer))))
(set-process-query-on-exit-flag proc nil)
- (comint-send-string proc "Password: ")
- (comint-send-eof)
- (while (accept-process-output proc 0.1 nil t))
- (should (string-equal (buffer-substring-no-properties (point-min) (point-max))
- "Password: PaSsWoRd123\n"))
- (when (process-live-p proc)
- (kill-process proc))
- (accept-process-output proc 0 1 t)))))))
+ (set-process-query-on-exit-flag proc nil)
+ (comint-send-invisible "Password: ")
+ (accept-process-output proc 0.1)
+ (should (string-equal
+ (buffer-substring-no-properties (point-min) (point-max))
+ (concat (or (and password-function
+ (funcall password-function))
+ "non-nil")
+ "\n")))))))))
+
+(ert-deftest comint-test-no-password-function ()
+ "Test that `comint-password-function' not being set does not
+alter normal password flow."
+ (comint-tests/test-password-function nil))
(ert-deftest comint-test-password-function-with-value ()
"Test that `comint-password-function' alters normal password
flow. Hook function returns alternative password."
- (cl-letf
- (((symbol-function 'read-passwd)
- (lambda (_prompt &optional _confirm _default)
- "PaSsWoRd123")))
- (let ((cat (executable-find "cat"))
- (comint-password-function (lambda (_prompt) "MaGiC-PaSsWoRd789")))
- (when cat
- (with-temp-buffer
- (make-comint-in-buffer "test-comint-password" (current-buffer) cat)
- (let ((proc (get-buffer-process (current-buffer))))
- (set-process-query-on-exit-flag proc nil)
- (comint-send-string proc "Password: ")
- (comint-send-eof)
- (while (accept-process-output proc 0.1 nil t))
- (should (string-equal (buffer-substring-no-properties (point-min) (point-max))
- "Password: MaGiC-PaSsWoRd789\n"))
- (when (process-live-p proc)
- (kill-process proc))
- (accept-process-output proc 0 1 t)))))))
+ (comint-tests/test-password-function
+ (lambda (&rest _args) "MaGiC-PaSsWoRd789")))
(ert-deftest comint-test-password-function-with-nil ()
"Test that `comint-password-function' does not alter the normal
password flow if it returns a nil value."
- (cl-letf
- (((symbol-function 'read-passwd)
- (lambda (_prompt &optional _confirm _default)
- "PaSsWoRd456")))
- (let ((cat (executable-find "cat"))
- (comint-password-function (lambda (_prompt) nil)))
- (when cat
- (with-temp-buffer
- (make-comint-in-buffer "test-comint-password" (current-buffer) cat)
- (let ((proc (get-buffer-process (current-buffer))))
- (set-process-query-on-exit-flag proc nil)
- (comint-send-string proc "Password: ")
- (comint-send-eof)
- (while (accept-process-output proc 0.1 nil t))
- (should (string-equal (buffer-substring-no-properties (point-min) (point-max))
- "Password: PaSsWoRd456\n"))
- (when (process-live-p proc)
- (kill-process proc))
- (accept-process-output proc 0 1 t)))))))
+ (comint-tests/test-password-function #'ignore))
;; Local Variables:
;; no-byte-compile: t
diff --git a/test/lisp/completion-tests.el b/test/lisp/completion-tests.el
new file mode 100644
index 00000000000..7473bbbb0c5
--- /dev/null
+++ b/test/lisp/completion-tests.el
@@ -0,0 +1,170 @@
+;;; completion-tests.el --- Tests for completion.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'completion)
+
+(ert-deftest completion-test-cmpl-string-case-type ()
+ (should (eq (cmpl-string-case-type "123ABCDEF456") :up))
+ (should (eq (cmpl-string-case-type "123abcdef456") :down))
+ (should (eq (cmpl-string-case-type "123aBcDeF456") :mixed))
+ (should (eq (cmpl-string-case-type "123456") :neither))
+ (should (eq (cmpl-string-case-type "Abcde123") :capitalized)))
+
+(ert-deftest completion-test-cmpl-merge-string-cases ()
+ (should (equal (cmpl-merge-string-cases "AbCdEf456" "abc") "AbCdEf456"))
+ (should (equal (cmpl-merge-string-cases "abcdef456" "ABC") "ABCDEF456"))
+ (should (equal (cmpl-merge-string-cases "ABCDEF456" "Abc") "Abcdef456"))
+ (should (equal (cmpl-merge-string-cases "ABCDEF456" "abc") "abcdef456")))
+
+(ert-deftest completion-test-add-find-delete-tail ()
+ (unwind-protect
+ (progn
+ ;; - Add and Find -
+ (should (equal (add-completion-to-head "banana") '("banana" 0 nil 0)))
+ (should (equal (find-exact-completion "banana") '("banana" 0 nil 0)))
+ (should (equal (find-exact-completion "bana") nil))
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0))))
+ (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0))))
+
+ (should (equal (add-completion-to-head "banish") '("banish" 0 nil 0)))
+ (should (equal (find-exact-completion "banish") '("banish" 0 nil 0)))
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil 0) ("banana" 0 nil 0))))
+ (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0))))
+
+ (should (equal (add-completion-to-head "banana") '("banana" 0 nil 0)))
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0) ("banish" 0 nil 0))))
+ (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil 0))))
+
+ ;; - Deleting -
+ (should (equal (add-completion-to-head "banner") '("banner" 0 nil 0)))
+ (delete-completion "banner")
+ (should-not (find-exact-completion "banner"))
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0) ("banish" 0 nil 0))))
+ (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil 0))))
+ (should (equal (add-completion-to-head "banner") '("banner" 0 nil 0)))
+ (delete-completion "banana")
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banner" 0 nil 0) ("banish" 0 nil 0))))
+ (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil 0))))
+ (delete-completion "banner")
+ (delete-completion "banish")
+ (should-not (find-cmpl-prefix-entry "ban"))
+ (should-error (delete-completion "banner"))
+
+ ;; - Tail -
+ (should (equal (add-completion-to-tail-if-new "banana") '("banana" 0 nil 0)))
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0))))
+ (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0))))
+ (add-completion-to-tail-if-new "banish") '("banish" 0 nil 0)
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0) ("banish" 0 nil 0))))
+ (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil 0)))))
+ (ignore-errors (kill-completion "banana"))
+ (ignore-errors (kill-completion "banner"))
+ (ignore-errors (kill-completion "banish"))))
+
+(ert-deftest completion-test-add-find-accept-delete ()
+ (unwind-protect
+ (progn
+ ;; - Add and Find -
+ (add-completion "banana" 5 10)
+ (should (equal (find-exact-completion "banana") '("banana" 5 10 0)))
+ (add-completion "banana" 6)
+ (should (equal (find-exact-completion "banana") '("banana" 6 10 0)))
+ (add-completion "banish")
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil 0) ("banana" 6 10 0))))
+
+ ;; - Accepting -
+ (setq completion-to-accept "banana")
+ (accept-completion)
+ (should (equal (find-exact-completion "banana") '("banana" 7 10 0)))
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 7 10 0) ("banish" 0 nil 0))))
+ (setq completion-to-accept "banish")
+ (add-completion "banner")
+ (should (equal (car (find-cmpl-prefix-entry "ban"))
+ '(("banner" 0 nil 0) ("banish" 1 nil 0) ("banana" 7 10 0))))
+
+ ;; - Deleting -
+ (kill-completion "banish")
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banner" 0 nil 0) ("banana" 7 10 0)))))
+ (ignore-errors (kill-completion "banish"))
+ (ignore-errors (kill-completion "banana"))
+ (ignore-errors (kill-completion "banner"))))
+
+(ert-deftest completion-test-search ()
+ (unwind-protect
+ (progn
+ ;; - Add and Find -
+ (add-completion "banana")
+ (completion-search-reset "ban")
+ (should (equal (car (completion-search-next 0)) "banana"))
+
+ ;; - Discrimination -
+ (add-completion "cumberland")
+ (add-completion "cumberbund")
+ ;; cumbering
+ (completion-search-reset "cumb")
+ (should (equal (car (completion-search-peek t)) "cumberbund"))
+ (should (equal (car (completion-search-next 0)) "cumberbund"))
+ (should (equal (car (completion-search-peek t)) "cumberland"))
+ (should (equal (car (completion-search-next 1)) "cumberland"))
+ (should-not (completion-search-peek nil))
+
+ ;; FIXME
+ ;; (should (equal (completion-search-next 2) "cumbering")) ; {cdabbrev}
+ ;;(completion-search-next 3) --> nil or "cumming" {depends on context}
+
+ (should (equal (car (completion-search-next 1)) "cumberland"))
+
+ ;; FIXME
+ ;; (should (equal (completion-search-peek t) "cumbering")) ; {cdabbrev}
+
+ ;; - Accepting -
+ (should (equal (car (completion-search-next 1)) "cumberland"))
+ (setq completion-to-accept "cumberland")
+ (completion-search-reset "foo")
+ (completion-search-reset "cum")
+ (should (equal (car (completion-search-next 0)) "cumberland"))
+
+ ;; - Deleting -
+ (kill-completion "cumberland")
+ (add-completion "cummings")
+ (completion-search-reset "cum")
+ (should (equal (car (completion-search-next 0)) "cummings"))
+ (should (equal (car (completion-search-next 1)) "cumberbund"))
+
+ ;; - Ignoring Capitalization -
+ (completion-search-reset "CuMb")
+ (should (equal (car (completion-search-next 0)) "cumberbund")))
+ (ignore-errors (kill-completion "banana"))
+ (ignore-errors (kill-completion "cumberland"))
+ (ignore-errors (kill-completion "cumberbund"))
+ (ignore-errors (kill-completion "cummings"))))
+
+(ert-deftest completion-test-lisp-def-regexp ()
+ (should (= (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) 8))
+ (should (= (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) 9))
+ (should (= (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) 10))
+ (should (= (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) 9)))
+
+(provide 'completion-tests)
+;;; completion-tests.el ends here
diff --git a/test/lisp/custom-resources/custom--test-theme.el b/test/lisp/custom-resources/custom--test-theme.el
index da9121e0a0a..4ced98a50bc 100644
--- a/test/lisp/custom-resources/custom--test-theme.el
+++ b/test/lisp/custom-resources/custom--test-theme.el
@@ -1,3 +1,5 @@
+;;; custom--test-theme.el -- A test theme. -*- lexical-binding:t -*-
+
(deftheme custom--test
"A test theme.")
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el
index 766e4844988..76661dc13b8 100644
--- a/test/lisp/custom-tests.el
+++ b/test/lisp/custom-tests.el
@@ -99,10 +99,11 @@
;; This is demonstrating bug#34027.
(ert-deftest custom--test-theme-variables ()
"Test variables setting with enabling / disabling a custom theme."
- :expected-result :failed
;; We load custom-resources/custom--test-theme.el.
(let ((custom-theme-load-path
- `(,(expand-file-name "custom-resources" (file-name-directory #$)))))
+ `(,(expand-file-name
+ "custom-resources"
+ (expand-file-name "lisp" (getenv "EMACS_TEST_DIRECTORY"))))))
(load-theme 'custom--test 'no-confirm 'no-enable)
;; The variables have still their initial values.
(should (equal custom--test-user-option 'foo))
@@ -115,15 +116,10 @@
(should (equal custom--test-user-option 'baz))
(should (equal custom--test-variable 'baz))
+ ;; Enable and then disable.
(enable-theme 'custom--test)
- ;; The variables have the theme values.
- (should (equal custom--test-user-option 'bar))
- (should (equal custom--test-variable 'bar))
-
(disable-theme 'custom--test)
;; The variables should have the changed values, by reverting.
- ;; This doesn't work as expected. Instead, they have their
- ;; initial values `foo'.
(should (equal custom--test-user-option 'baz))
(should (equal custom--test-variable 'baz))))
@@ -151,4 +147,15 @@
(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))))
+
;;; custom-tests.el ends here
diff --git a/test/lisp/dabbrev-tests.el b/test/lisp/dabbrev-tests.el
index 0a2f67e91c7..06c5c0655a7 100644
--- a/test/lisp/dabbrev-tests.el
+++ b/test/lisp/dabbrev-tests.el
@@ -1,4 +1,4 @@
-;;; dabbrev-tests.el --- Test suite for dabbrev.
+;;; dabbrev-tests.el --- Test suite for dabbrev. -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/descr-text-tests.el b/test/lisp/descr-text-tests.el
index 74fcdf5af37..b060dffb0ff 100644
--- a/test/lisp/descr-text-tests.el
+++ b/test/lisp/descr-text-tests.el
@@ -75,18 +75,18 @@
(goto-char (point-min))
(should (eq ?a (following-char))) ; make sure we are where we think we are
;; Function should return nil for an ASCII character.
- (should (not (describe-char-eldoc)))
+ (should (not (describe-char-eldoc 'ignore)))
(goto-char (1+ (point)))
(should (eq ?… (following-char)))
(let ((eldoc-echo-area-use-multiline-p t))
;; Function should return description of an Unicode character.
(should (equal "U+2026: Horizontal ellipsis (Po: Punctuation, Other)"
- (describe-char-eldoc))))
+ (describe-char-eldoc 'ignore))))
(goto-char (point-max))
;; At the end of the buffer, function should return nil and not blow up.
- (should (not (describe-char-eldoc)))))
+ (should (not (describe-char-eldoc 'ignore)))))
(provide 'descr-text-test)
diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el
index 1fe155718d5..6bb8ced1f30 100644
--- a/test/lisp/dired-aux-tests.el
+++ b/test/lisp/dired-aux-tests.el
@@ -28,7 +28,7 @@
(let* ((foo (make-temp-file "foo"))
(files (list foo)))
(unwind-protect
- (cl-letf (((symbol-function 'y-or-n-p) 'error))
+ (cl-letf (((symbol-function 'read-char-from-minibuffer) 'error))
(dired temporary-file-directory)
(dired-goto-file foo)
;; `dired-do-shell-command' returns nil on success.
@@ -40,7 +40,7 @@
(should-not (dired-do-shell-command "ls ? ./`?`" nil files)))
(delete-file foo))))
-;; Auxiliar macro for `dired-test-bug28834': it binds
+;; Auxiliary macro for `dired-test-bug28834': it binds
;; `dired-create-destination-dirs' to CREATE-DIRS and execute BODY.
;; If YES-OR-NO is non-nil, it binds `yes-or-no-p' to
;; to avoid the prompt.
@@ -114,6 +114,49 @@
(mapc #'delete-file `(,file1 ,file2))
(kill-buffer buf)))))
+(defun dired-test--check-highlighting (command positions)
+ (let ((start 1))
+ (dolist (pos positions)
+ (should-not (text-property-not-all start (1- pos) 'face nil command))
+ (should (equal 'warning (get-text-property pos 'face command)))
+ (setq start (1+ pos)))
+ (should-not (text-property-not-all
+ start (length command) 'face nil command))))
+
+(ert-deftest dired-test-highlight-metachar ()
+ "Check that non-isolated meta-characters are highlighted."
+ (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`")
+ (markers " ^ ^")
+ (result (dired--highlight-no-subst-chars
+ (dired--need-confirm-positions command "?")
+ command
+ t))
+ (lines (split-string result "\n")))
+ (should (= (length lines) 2))
+ (should (string-match (regexp-quote command) (nth 0 lines)))
+ (should (string-match (regexp-quote markers) (nth 1 lines)))
+ (dired-test--check-highlighting (nth 0 lines) '(15 29)))
+ ;; Note that `?` is considered isolated, but `*` is not.
+ (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'")
+ (markers " ^ ^")
+ (result (dired--highlight-no-subst-chars
+ (dired--need-confirm-positions command "*")
+ command
+ t))
+ (lines (split-string result "\n")))
+ (should (= (length lines) 2))
+ (should (string-match (regexp-quote command) (nth 0 lines)))
+ (should (string-match (regexp-quote markers) (nth 1 lines)))
+ (dired-test--check-highlighting (nth 0 lines) '(11 25)))
+ (let* ((command "sed 's/\\?/!/'")
+ (result (dired--highlight-no-subst-chars
+ (dired--need-confirm-positions command "?")
+ command
+ nil))
+ (lines (split-string result "\n")))
+ (should (= (length lines) 1))
+ (should (string-match (regexp-quote command) (nth 0 lines)))
+ (dired-test--check-highlighting (nth 0 lines) '(8))))
(provide 'dired-aux-tests)
;; dired-aux-tests.el ends here
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index 5c6649cba46..cec533ddfaa 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -24,11 +24,11 @@
(ert-deftest dired-autoload ()
"Tests to see whether dired-x has been autoloaded"
(should
- (fboundp 'dired-jump))
+ (fboundp 'dired-do-relsymlink))
(should
(autoloadp
(symbol-function
- 'dired-jump))))
+ 'dired-do-relsymlink))))
(ert-deftest dired-test-bug22694 ()
"Test for https://debbugs.gnu.org/22694 ."
diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el
index d44851eb13b..f743df78fd5 100644
--- a/test/lisp/dom-tests.el
+++ b/test/lisp/dom-tests.el
@@ -84,6 +84,13 @@
(dom-set-attribute dom attr value)
(should (equal (dom-attr dom attr) value))))
+(ert-deftest dom-tests-remove-attribute ()
+ (let ((dom (copy-tree '(body ((foo . "bar") (zot . "foobar"))))))
+ (should (equal (dom-attr dom 'foo) "bar"))
+ (dom-remove-attribute dom 'foo)
+ (should (equal (dom-attr dom 'foo) nil))
+ (should (equal dom '(body ((zot . "foobar")))))))
+
(ert-deftest dom-tests-attr ()
(let ((dom (dom-tests--tree)))
(should-not (dom-attr dom 'id))
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el
index 69e5de32bfb..5f63f6831b3 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -5,18 +5,20 @@
;; Author: João Távora <joaotavora@gmail.com>
;; 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 <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -547,6 +549,24 @@ baz\"\""
(should (equal "" (buffer-string))))))
+;;; Undoing
+(ert-deftest electric-pair-undo-unrelated-state ()
+ "Make sure `electric-pair-mode' does not confuse `undo' (bug#39680)."
+ (with-temp-buffer
+ (buffer-enable-undo)
+ (electric-pair-local-mode)
+ (let ((last-command-event ?\())
+ (ert-simulate-command '(self-insert-command 1)))
+ (undo-boundary)
+ (let ((last-command-event ?a))
+ (ert-simulate-command '(self-insert-command 1)))
+ (undo-boundary)
+ (ert-simulate-command '(undo))
+ (let ((last-command-event ?\())
+ (ert-simulate-command '(self-insert-command 1)))
+ (should (string= (buffer-string) "(())"))))
+
+
;;; Electric newlines between pairs
;;; TODO: better tests
(ert-deftest electric-pair-open-extra-newline ()
diff --git a/test/lisp/elide-head-tests.el b/test/lisp/elide-head-tests.el
new file mode 100644
index 00000000000..c9ef26a8181
--- /dev/null
+++ b/test/lisp/elide-head-tests.el
@@ -0,0 +1,62 @@
+;;; elide-head-tests.el --- Tests for elide-head.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'elide-head)
+(require 'ert)
+
+(ert-deftest elide-head-tests-elide-head ()
+ (let ((elide-head-headers-to-hide '(("START" . "END"))))
+ (with-temp-buffer
+ (insert "foo\nSTART\nHIDDEN\nEND\nbar")
+ (elide-head)
+ (let ((o (car (overlays-at 14))))
+ (should (= (overlay-start o) 10))
+ (should (= (overlay-end o) 21))
+ (should (overlay-get o 'invisible))
+ (should (overlay-get o 'evaporate))))))
+
+(ert-deftest elide-head-tests-elide-head-with-prefix-arg ()
+ (let ((elide-head-headers-to-hide '(("START" . "END"))))
+ (with-temp-buffer
+ (insert "foo\nSTART\nHIDDEN\nEND\nbar")
+ (elide-head)
+ (should (overlays-at 14))
+ (elide-head t)
+ (should-not (overlays-at 14)))))
+
+(ert-deftest elide-head-tests-show ()
+ (let ((elide-head-headers-to-hide '(("START" . "END"))))
+ (with-temp-buffer
+ (insert "foo\nSTART\nHIDDEN\nEND\nbar")
+ (elide-head)
+ (should (overlays-at 14))
+ (elide-head-show)
+ (should-not (overlays-at 14)))))
+
+(provide 'elide-head-tests)
+;;; elide-head-tests.el ends here
diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el
index f8efa7902a4..14f95a8bf80 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -96,4 +96,20 @@
(dest-ip .
[192 168 1 100]))))))
+(ert-deftest bindat-test-format-vector ()
+ (should (equal (bindat-format-vector [1 2 3] "%d" "x" 2) "1x2"))
+ (should (equal (bindat-format-vector [1 2 3] "%d" "x") "1x2x3")))
+
+(ert-deftest bindat-test-vector-to-dec ()
+ (should (equal (bindat-vector-to-dec [1 2 3]) "1.2.3"))
+ (should (equal (bindat-vector-to-dec [2048 1024 512] ".") "2048.1024.512")))
+
+(ert-deftest bindat-test-vector-to-hex ()
+ (should (equal (bindat-vector-to-hex [1 2 3]) "01:02:03"))
+ (should (equal (bindat-vector-to-hex [2048 1024 512] ".") "800.400.200")))
+
+(ert-deftest bindat-test-ip-to-string ()
+ (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")))
+
;;; bindat-tests.el ends here
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 3aba9af3e79..a9dcf152617 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -1,4 +1,4 @@
-;;; bytecomp-tests.el
+;;; bytecomp-tests.el -*- lexical-binding:t -*-
;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
@@ -47,6 +47,11 @@
(let ((a 1.0)) (/ 3 a 2))
(let ((a most-positive-fixnum) (b 2.0)) (* a 2 b))
(let ((a 3) (b 2)) (/ a b 1.0))
+ (let ((a -0.0)) (+ a))
+ (let ((a -0.0)) (- a))
+ (let ((a -0.0)) (* a))
+ (let ((a -0.0)) (min a))
+ (let ((a -0.0)) (max a))
(/ 3 -1)
(+ 4 3 2 1)
(+ 4 3 2.0 1)
@@ -368,24 +373,24 @@ bytecompiled code, and their results compared.")
(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 nil
+ (byte-compile-warnings nil)
+ (v0 (condition-case err
(eval pat)
- (error nil)))
- (v1 (condition-case nil
+ (error (list 'bytecomp-check-error (car err)))))
+ (v1 (condition-case err
(funcall (byte-compile (list 'lambda nil pat)))
- (error nil))))
+ (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 nil
+ (let ((v0 (condition-case err
(eval pat)
- (error nil)))
- (v1 (condition-case nil
+ (error (list 'bytecomp-check-error (car err)))))
+ (v1 (condition-case err
(funcall (byte-compile (list 'lambda nil pat)))
- (error nil))))
+ (error (list 'bytecomp-check-error (car err))))))
(format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled."
pat v0 v1)))
@@ -408,12 +413,12 @@ Subtests signal errors if something goes wrong."
(print-quoted t)
v0 v1)
(dolist (pat byte-opt-testsuite-arith-data)
- (condition-case nil
+ (condition-case err
(setq v0 (eval pat))
- (error (setq v0 nil)))
- (condition-case nil
+ (error (setq v0 (list 'bytecomp-check-error (car err)))))
+ (condition-case err
(setq v1 (funcall (byte-compile (list 'lambda nil pat))))
- (error (setq v1 nil)))
+ (error (setq v1 (list 'bytecomp-check-error (car err)))))
(insert (format "%s" pat))
(indent-to-column 65)
(if (equal v0 v1)
@@ -482,6 +487,7 @@ Subtests signal errors if something goes wrong."
(ert-deftest bytecomp-tests--warnings ()
(with-current-buffer (get-buffer-create "*Compile-Log*")
(let ((inhibit-read-only t)) (erase-buffer)))
+ (mapc #'fmakunbound '(my-test0 my--test11 my--test12 my--test2))
(test-byte-comp-compile-and-load t
'(progn
(defun my-test0 ()
@@ -567,25 +573,25 @@ bytecompiled code, and their results compared.")
"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 nil
+ (v0 (condition-case err
(eval pat t)
- (error nil)))
- (v1 (condition-case nil
+ (error (list 'bytecomp-check-error (car err)))))
+ (v1 (condition-case err
(funcall (let ((lexical-binding t))
(byte-compile `(lambda nil ,pat))))
- (error nil))))
+ (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 nil
+ (let ((v0 (condition-case err
(eval pat t)
- (error nil)))
- (v1 (condition-case nil
+ (error (list 'bytecomp-check-error (car err)))))
+ (v1 (condition-case err
(funcall (let ((lexical-binding t))
(byte-compile (list 'lambda nil pat))))
- (error nil))))
+ (error (list 'bytecomp-check-error (car err))))))
(format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled."
pat v0 v1)))
@@ -628,17 +634,6 @@ literals (Bug#20852)."
(let ((byte-compile-dest-file-function (lambda (_) destination)))
(should (byte-compile-file source)))))))
-(ert-deftest bytecomp-tests--old-style-backquotes ()
- "Check that byte compiling warns about old-style backquotes."
- (bytecomp-tests--with-temp-file source
- (write-region "(` (a b))" nil source)
- (bytecomp-tests--with-temp-file destination
- (let* ((byte-compile-dest-file-function (lambda (_) destination))
- (byte-compile-debug t)
- (err (should-error (byte-compile-file source))))
- (should (equal (cdr err) '("Old-style backquotes detected!")))))))
-
-
(ert-deftest bytecomp-tests-function-put ()
"Check `function-put' operates during compilation."
(bytecomp-tests--with-temp-file source
diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el
index c8d46541ad4..0ea9742be49 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -20,6 +20,166 @@
;;; Commentary:
(require 'ert)
+(require 'cl-lib)
+
+(ert-deftest cconv-tests-lambda-:documentation ()
+ "Docstring for lambda can be specified with :documentation."
+ (let ((fun (lambda ()
+ (:documentation (concat "lambda" " documentation"))
+ 'lambda-result)))
+ (should (string= (documentation fun) "lambda documentation"))
+ (should (eq (funcall fun) 'lambda-result))))
+
+(ert-deftest cconv-tests-pcase-lambda-:documentation ()
+ "Docstring for pcase-lambda can be specified with :documentation."
+ (let ((fun (pcase-lambda (`(,a ,b))
+ (:documentation (concat "pcase-lambda" " documentation"))
+ (list b a))))
+ (should (string= (documentation fun) "pcase-lambda documentation"))
+ (should (equal '(2 1) (funcall fun '(1 2))))))
+
+(defun cconv-tests-defun ()
+ (:documentation (concat "defun" " documentation"))
+ 'defun-result)
+(ert-deftest cconv-tests-defun-:documentation ()
+ "Docstring for defun can be specified with :documentation."
+ (should (string= (documentation 'cconv-tests-defun)
+ "defun documentation"))
+ (should (eq (cconv-tests-defun) 'defun-result)))
+
+(cl-defun cconv-tests-cl-defun ()
+ (:documentation (concat "cl-defun" " documentation"))
+ 'cl-defun-result)
+(ert-deftest cconv-tests-cl-defun-:documentation ()
+ "Docstring for cl-defun can be specified with :documentation."
+ (should (string= (documentation 'cconv-tests-cl-defun)
+ "cl-defun documentation"))
+ (should (eq (cconv-tests-cl-defun) 'cl-defun-result)))
+
+;; FIXME: The byte-complier croaks on this. See Bug#28557.
+;; (defmacro cconv-tests-defmacro ()
+;; (:documentation (concat "defmacro" " documentation"))
+;; '(quote defmacro-result))
+;; (ert-deftest cconv-tests-defmacro-:documentation ()
+;; "Docstring for defmacro can be specified with :documentation."
+;; (should (string= (documentation 'cconv-tests-defmacro)
+;; "defmacro documentation"))
+;; (should (eq (cconv-tests-defmacro) 'defmacro-result)))
+
+;; FIXME: The byte-complier croaks on this. See Bug#28557.
+;; (cl-defmacro cconv-tests-cl-defmacro ()
+;; (:documentation (concat "cl-defmacro" " documentation"))
+;; '(quote cl-defmacro-result))
+;; (ert-deftest cconv-tests-cl-defmacro-:documentation ()
+;; "Docstring for cl-defmacro can be specified with :documentation."
+;; (should (string= (documentation 'cconv-tests-cl-defmacro)
+;; "cl-defmacro documentation"))
+;; (should (eq (cconv-tests-cl-defmacro) 'cl-defmacro-result)))
+
+(cl-iter-defun cconv-tests-cl-iter-defun ()
+ (:documentation (concat "cl-iter-defun" " documentation"))
+ (iter-yield 'cl-iter-defun-result))
+(ert-deftest cconv-tests-cl-iter-defun-:documentation ()
+ "Docstring for cl-iter-defun can be specified with :documentation."
+ ;; FIXME: See Bug#28557.
+ :tags '(:unstable)
+ :expected-result :failed
+ (should (string= (documentation 'cconv-tests-cl-iter-defun)
+ "cl-iter-defun documentation"))
+ (should (eq (iter-next (cconv-tests-cl-iter-defun))
+ 'cl-iter-defun-result)))
+
+(iter-defun cconv-tests-iter-defun ()
+ (:documentation (concat "iter-defun" " documentation"))
+ (iter-yield 'iter-defun-result))
+(ert-deftest cconv-tests-iter-defun-:documentation ()
+ "Docstring for iter-defun can be specified with :documentation."
+ ;; FIXME: See Bug#28557.
+ :tags '(:unstable)
+ :expected-result :failed
+ (should (string= (documentation 'cconv-tests-iter-defun)
+ "iter-defun documentation"))
+ (should (eq (iter-next (cconv-tests-iter-defun)) 'iter-defun-result)))
+
+(ert-deftest cconv-tests-iter-lambda-:documentation ()
+ "Docstring for iter-lambda can be specified with :documentation."
+ ;; FIXME: See Bug#28557.
+ :expected-result :failed
+ (let ((iter-fun
+ (iter-lambda ()
+ (:documentation (concat "iter-lambda" " documentation"))
+ (iter-yield 'iter-lambda-result))))
+ (should (string= (documentation iter-fun) "iter-lambda documentation"))
+ (should (eq (iter-next (funcall iter-fun)) 'iter-lambda-result))))
+
+(ert-deftest cconv-tests-cl-function-:documentation ()
+ "Docstring for cl-function can be specified with :documentation."
+ ;; FIXME: See Bug#28557.
+ :expected-result :failed
+ (let ((fun (cl-function (lambda (&key arg)
+ (:documentation (concat "cl-function"
+ " documentation"))
+ (list arg 'cl-function-result)))))
+ (should (string= (documentation fun) "cl-function documentation"))
+ (should (equal (funcall fun :arg t) '(t cl-function-result)))))
+
+(ert-deftest cconv-tests-function-:documentation ()
+ "Docstring for lambda inside function can be specified with :documentation."
+ (let ((fun #'(lambda (arg)
+ (:documentation (concat "function" " documentation"))
+ (list arg 'function-result))))
+ (should (string= (documentation fun) "function documentation"))
+ (should (equal (funcall fun t) '(t function-result)))))
+
+(fmakunbound 'cconv-tests-cl-defgeneric)
+(setplist 'cconv-tests-cl-defgeneric nil)
+(cl-defgeneric cconv-tests-cl-defgeneric (n)
+ (:documentation (concat "cl-defgeneric" " documentation")))
+(cl-defmethod cconv-tests-cl-defgeneric ((n integer))
+ (:documentation (concat "cl-defmethod" " documentation"))
+ (+ 1 n))
+(ert-deftest cconv-tests-cl-defgeneric-:documentation ()
+ "Docstring for cl-defgeneric can be specified with :documentation."
+ ;; FIXME: See Bug#28557.
+ :expected-result :failed
+ (let ((descr (describe-function 'cconv-tests-cl-defgeneric)))
+ (set-text-properties 0 (length descr) nil descr)
+ (should (string-match-p "cl-defgeneric documentation" descr))
+ (should (string-match-p "cl-defmethod documentation" descr)))
+ (should (= 11 (cconv-tests-cl-defgeneric 10))))
+
+(fmakunbound 'cconv-tests-cl-defgeneric-literal)
+(setplist 'cconv-tests-cl-defgeneric-literal nil)
+(cl-defgeneric cconv-tests-cl-defgeneric-literal (n)
+ (:documentation "cl-defgeneric-literal documentation"))
+(cl-defmethod cconv-tests-cl-defgeneric-literal ((n integer))
+ (:documentation "cl-defmethod-literal documentation")
+ (+ 1 n))
+(ert-deftest cconv-tests-cl-defgeneric-literal-:documentation ()
+ "Docstring for cl-defgeneric can be specified with :documentation."
+ (let ((descr (describe-function 'cconv-tests-cl-defgeneric-literal)))
+ (set-text-properties 0 (length descr) nil descr)
+ (should (string-match-p "cl-defgeneric-literal documentation" descr))
+ (should (string-match-p "cl-defmethod-literal documentation" descr)))
+ (should (= 11 (cconv-tests-cl-defgeneric-literal 10))))
+
+(defsubst cconv-tests-defsubst ()
+ (:documentation (concat "defsubst" " documentation"))
+ 'defsubst-result)
+(ert-deftest cconv-tests-defsubst-:documentation ()
+ "Docstring for defsubst can be specified with :documentation."
+ (should (string= (documentation 'cconv-tests-defsubst)
+ "defsubst documentation"))
+ (should (eq (cconv-tests-defsubst) 'defsubst-result)))
+
+(cl-defsubst cconv-tests-cl-defsubst ()
+ (:documentation (concat "cl-defsubst" " documentation"))
+ 'cl-defsubst-result)
+(ert-deftest cconv-tests-cl-defsubst-:documentation ()
+ "Docstring for cl-defsubst can be specified with :documentation."
+ (should (string= (documentation 'cconv-tests-cl-defsubst)
+ "cl-defsubst documentation"))
+ (should (eq (cconv-tests-cl-defsubst) 'cl-defsubst-result)))
(ert-deftest cconv-convert-lambda-lifted ()
"Bug#30872."
diff --git a/test/lisp/emacs-lisp/check-declare-tests.el b/test/lisp/emacs-lisp/check-declare-tests.el
new file mode 100644
index 00000000000..bb9542114c4
--- /dev/null
+++ b/test/lisp/emacs-lisp/check-declare-tests.el
@@ -0,0 +1,116 @@
+;;; check-declare-tests.el --- Tests for check-declare.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'check-declare)
+(require 'ert)
+(eval-when-compile (require 'subr-x))
+
+(ert-deftest check-declare-tests-locate ()
+ (should (file-exists-p (check-declare-locate "check-declare" "")))
+ (should
+ (string-prefix-p "ext:" (check-declare-locate "ext:foo" ""))))
+
+(ert-deftest check-declare-tests-scan ()
+ (let ((file (make-temp-file "check-declare-tests-")))
+ (unwind-protect
+ (progn
+ (with-temp-file file
+ (insert
+ (string-join
+ '(";; foo comment"
+ "(declare-function ring-insert \"ring\" (ring item))"
+ "(let ((foo 'code)) foo)")
+ "\n")))
+ (let ((res (check-declare-scan file)))
+ (should (= (length res) 1))
+ (pcase-let ((`((,fnfile ,fn ,arglist ,fileonly)) res))
+ (should (string-match-p "ring" fnfile))
+ (should (equal "ring-insert" fn))
+ (should (equal '(ring item) arglist))
+ (should-not fileonly))))
+ (delete-file file))))
+
+(ert-deftest check-declare-tests-verify ()
+ (let ((file (make-temp-file "check-declare-tests-")))
+ (unwind-protect
+ (progn
+ (with-temp-file file
+ (insert
+ (string-join
+ '(";; foo comment"
+ "(defun foo-fun ())"
+ "(defun ring-insert (ring item)"
+ "\"Insert onto ring RING the item ITEM.\""
+ "nil)")
+ "\n")))
+ (should-not
+ (check-declare-verify
+ file '(("foo.el" "ring-insert" (ring item))))))
+ (delete-file file))))
+
+(ert-deftest check-declare-tests-verify-mismatch ()
+ (let ((file (make-temp-file "check-declare-tests-")))
+ (unwind-protect
+ (progn
+ (with-temp-file file
+ (insert
+ (string-join
+ '(";; foo comment"
+ "(defun foo-fun ())"
+ "(defun ring-insert (ring)"
+ "\"Insert onto ring RING the item ITEM.\""
+ "nil)")
+ "\n")))
+ (should
+ (equal
+ (check-declare-verify
+ file '(("foo.el" "ring-insert" (ring item))))
+ '(("foo.el" "ring-insert" "arglist mismatch")))))
+ (delete-file file))))
+
+(ert-deftest check-declare-tests-sort ()
+ (should-not (check-declare-sort '()))
+ (should (equal (check-declare-sort '((a (1 a)) (b (2)) (d (1 d))))
+ '((2 (b)) (1 (a a) (d d))))))
+
+(ert-deftest check-declare-tests-warn ()
+ (with-temp-buffer
+ (let ((check-declare-warning-buffer (buffer-name)))
+ (check-declare-warn
+ "foo-file" "foo-fun" "bar-file" "it wasn't" 999)
+ (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))))))
+
+(provide 'check-declare-tests)
+;;; check-declare-tests.el ends here
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el
index 51c9884ddc8..5aa58782f36 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -24,6 +24,7 @@
;;; Code:
(require 'cl-generic)
+(require 'edebug)
;; Don't indirectly require `cl-lib' at run-time.
(eval-when-compile (require 'ert))
@@ -249,5 +250,42 @@
(should-not (cl--generic-method-files 'cl-generic-tests--undefined-generic))
(should-not (cl--generic-method-files 'cl-generic-tests--generic-without-methods)))
+(ert-deftest cl-defgeneric/edebug/method ()
+ "Check that `:method' forms in `cl-defgeneric' create unique
+Edebug symbols (Bug#42672)."
+ (with-temp-buffer
+ (dolist (form '((cl-defgeneric cl-defgeneric/edebug/method/1 (_)
+ (:method ((_ number)) 1)
+ (:method ((_ string)) 2)
+ (:method :around ((_ number)) 3))
+ (cl-defgeneric cl-defgeneric/edebug/method/2 (_)
+ (:method ((_ number)) 3))))
+ (print form (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)))
+ ;; Make generated symbols reproducible.
+ (gensym-counter 10000))
+ (eval-buffer)
+ (should (equal
+ (reverse instrumented-names)
+ ;; The generic function definitions come after the
+ ;; method definitions because their body ends later.
+ ;; 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))")
+ 'cl-defgeneric/edebug/method/1
+ (intern "cl-generic-:method@10003 ((_ number))")
+ 'cl-defgeneric/edebug/method/2))))))
+
(provide 'cl-generic-tests)
;;; cl-generic-tests.el ends here
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el
index 57b9d23efb0..40dd7e4eeb0 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -242,6 +242,22 @@
(should (= (cl-the integer (cl-incf side-effect)) 1))
(should (= side-effect 1))))
+(ert-deftest cl-lib-test-incf ()
+ (let ((var 0))
+ (should (= (cl-incf var) 1))
+ (should (= var 1)))
+ (let ((alist))
+ (should (= (cl-incf (alist-get 'a alist 0)) 1))
+ (should (= (alist-get 'a alist 0) 1))))
+
+(ert-deftest cl-lib-test-decf ()
+ (let ((var 1))
+ (should (= (cl-decf var) 0))
+ (should (= var 0)))
+ (let ((alist))
+ (should (= (cl-decf (alist-get 'a alist 0)) -1))
+ (should (= (alist-get 'a alist 0) -1))))
+
(ert-deftest cl-lib-test-plusp ()
(should-not (cl-plusp -1.0e+INF))
(should-not (cl-plusp -1.5e2))
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index c357ecde951..29ae95e2771 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -39,6 +39,15 @@
collect (list c b a))
'((4.0 2 1) (8.3 6 5) (10.4 9 8)))))
+(ert-deftest cl-macs-loop-and-arrays ()
+ "Bug#40727"
+ (should (equal (cl-loop for y = (- (or x 0)) and x across [1 2]
+ collect (cons x y))
+ '((1 . 0) (2 . -1))))
+ (should (equal (cl-loop for x across [1 2] and y = (- (or x 0))
+ collect (cons x y))
+ '((1 . 0) (2 . -1)))))
+
(ert-deftest cl-macs-loop-destructure ()
(should (equal (cl-loop for (a b c) in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
collect (list c b a))
@@ -416,7 +425,9 @@ collection clause."
'(2 3 4 5 6))))
(ert-deftest cl-macs-loop-across-ref ()
- (should (equal (cl-loop with my-vec = ["one" "two" "three"]
+ (should (equal (cl-loop with my-vec = (vector (cl-copy-seq "one")
+ (cl-copy-seq "two")
+ (cl-copy-seq "three"))
for x across-ref my-vec
do (setf (aref x 0) (upcase (aref x 0)))
finally return my-vec)
@@ -498,7 +509,6 @@ collection clause."
(ert-deftest cl-macs-loop-for-as-equals-and ()
"Test for https://debbugs.gnu.org/29799 ."
- :expected-result :failed
(let ((arr (make-vector 3 0)))
(should (equal '((0 0) (1 1) (2 2))
(cl-loop for k below 3 for x = k and z = (elt arr k)
@@ -532,7 +542,6 @@ collection clause."
(ert-deftest cl-macs-loop-conditional-step-clauses ()
"These tests failed under the initial fixes in #bug#29799."
- :expected-result :failed
(should (cl-loop for i from 1 upto 100 and j = 1 then (1+ j)
if (not (= i j))
return nil
@@ -592,4 +601,13 @@ collection clause."
collect y into result1
finally return (equal (nreverse result) result1))))
+(ert-deftest cl-macs-aux-edebug ()
+ "Check that Bug#40431 is fixed."
+ (with-temp-buffer
+ (prin1 '(cl-defun cl-macs-aux-edebug-test-fun (&aux ((a . b) '(1 . 2)))
+ (list a b))
+ (current-buffer))
+ ;; Just make sure the function can be instrumented.
+ (edebug-defun)))
+
;;; cl-macs-tests.el ends here
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el
index cddefbbdee8..7e0f5384542 100644
--- a/test/lisp/emacs-lisp/cl-seq-tests.el
+++ b/test/lisp/emacs-lisp/cl-seq-tests.el
@@ -294,6 +294,7 @@ Body are forms defining the test."
(ert-deftest cl-seq-test-bug24264 ()
"Test for https://debbugs.gnu.org/24264 ."
+ :tags '(:expensive-test)
(let ((list (append (make-list 8000005 1) '(8)))
(list2 (make-list 8000005 2)))
(should (cl-position 8 list))
diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
index 60e49ab93a4..7be057db8b2 100644
--- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
+++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
@@ -1,4 +1,4 @@
-;;; edebug-test-code.el --- Sample code for the Edebug test suite
+;;; edebug-test-code.el --- Sample code for the Edebug test suite -*- lexical-binding:t -*-
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index 88c4a0fe175..6db07b1b707 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -938,5 +938,99 @@ test and possibly others should be updated."
"g"
(should (equal edebug-tests-@-result '(0 1))))))
+(ert-deftest edebug-cl-defmethod-qualifier ()
+ "Check that secondary `cl-defmethod' forms don't stomp over
+primary ones (Bug#42671)."
+ (with-temp-buffer
+ (let* ((edebug-all-defs t)
+ (edebug-initial-mode 'Go-nonstop)
+ (defined-symbols ())
+ (edebug-new-definition-function
+ (lambda (def-name)
+ (push def-name defined-symbols)
+ (edebug-new-definition def-name))))
+ (dolist (form '((cl-defmethod edebug-cl-defmethod-qualifier ((_ number)))
+ (cl-defmethod edebug-cl-defmethod-qualifier
+ :around ((_ number)))))
+ (print form (current-buffer)))
+ (eval-buffer)
+ (should
+ (equal
+ defined-symbols
+ (list (intern "edebug-cl-defmethod-qualifier :around ((_ number))")
+ (intern "edebug-cl-defmethod-qualifier ((_ number))")))))))
+
+(ert-deftest edebug-tests-cl-flet ()
+ "Check that Edebug can instrument `cl-flet' forms without name
+clashes (Bug#41853)."
+ (with-temp-buffer
+ (dolist (form '((defun edebug-tests-cl-flet-1 ()
+ (cl-flet ((inner () 0)) (message "Hi"))
+ (cl-flet ((inner () 1)) (inner)))
+ (defun edebug-tests-cl-flet-2 ()
+ (cl-flet ((inner () 2)) (inner)))))
+ (print form (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)))
+ ;; Make generated symbols reproducible.
+ (gensym-counter 10000))
+ (eval-buffer)
+ (should (equal (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))))))
+
+(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)))
+ (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)))
+ ;; Make generated symbols reproducible.
+ (gensym-counter 10000))
+ (eval-buffer)
+ ;; The anonymous symbols are uninterned. Use their names so we
+ ;; can perform the assertion. The names should still be unique.
+ (should (equal (mapcar #'symbol-name (reverse instrumented-names))
+ ;; The outer definition comes after the inner
+ ;; ones because its body ends later.
+ ;; FIXME: There are twice as many inner
+ ;; definitions as expected due to Bug#42701.
+ ;; Once that bug is fixed, remove the duplicates.
+ '("edebug-anon10000"
+ "edebug-anon10001"
+ "edebug-tests-duplicate-symbol-backtrack"))))))
+
(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 b3e296db16b..73c3ea82e2d 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
+;;; eieio-testsinvoke.el -- eieio tests for method invocation -*- lexical-binding:t -*-
;; Copyright (C) 2005, 2008, 2010, 2013-2020 Free Software Foundation,
;; Inc.
@@ -83,36 +83,36 @@
(defclass eitest-B-base2 () ())
(defclass eitest-B (eitest-B-base1 eitest-B-base2) ())
-(defmethod eitest-F :BEFORE ((p eitest-B-base1))
+(defmethod eitest-F :BEFORE ((_p eitest-B-base1))
(eieio-test-method-store :BEFORE 'eitest-B-base1))
-(defmethod eitest-F :BEFORE ((p eitest-B-base2))
+(defmethod eitest-F :BEFORE ((_p eitest-B-base2))
(eieio-test-method-store :BEFORE 'eitest-B-base2))
-(defmethod eitest-F :BEFORE ((p eitest-B))
+(defmethod eitest-F :BEFORE ((_p eitest-B))
(eieio-test-method-store :BEFORE 'eitest-B))
-(defmethod eitest-F ((p eitest-B))
+(defmethod eitest-F ((_p eitest-B))
(eieio-test-method-store :PRIMARY 'eitest-B)
(call-next-method))
-(defmethod eitest-F ((p eitest-B-base1))
+(defmethod eitest-F ((_p eitest-B-base1))
(eieio-test-method-store :PRIMARY 'eitest-B-base1)
(call-next-method))
-(defmethod eitest-F ((p eitest-B-base2))
+(defmethod eitest-F ((_p eitest-B-base2))
(eieio-test-method-store :PRIMARY 'eitest-B-base2)
(when (next-method-p)
(call-next-method))
)
-(defmethod eitest-F :AFTER ((p eitest-B-base1))
+(defmethod eitest-F :AFTER ((_p eitest-B-base1))
(eieio-test-method-store :AFTER 'eitest-B-base1))
-(defmethod eitest-F :AFTER ((p eitest-B-base2))
+(defmethod eitest-F :AFTER ((_p eitest-B-base2))
(eieio-test-method-store :AFTER 'eitest-B-base2))
-(defmethod eitest-F :AFTER ((p eitest-B))
+(defmethod eitest-F :AFTER ((_p eitest-B))
(eieio-test-method-store :AFTER 'eitest-B))
(ert-deftest eieio-test-method-order-list-3 ()
@@ -136,7 +136,7 @@
;;; Test static invocation
;;
-(defmethod eitest-H :STATIC ((class eitest-A))
+(defmethod eitest-H :STATIC ((_class eitest-A))
"No need to do work in here."
'moose)
@@ -147,15 +147,15 @@
;;; Return value from :PRIMARY
;;
-(defmethod eitest-I :BEFORE ((a eitest-A))
+(defmethod eitest-I :BEFORE ((_a eitest-A))
(eieio-test-method-store :BEFORE 'eitest-A)
":before")
-(defmethod eitest-I :PRIMARY ((a eitest-A))
+(defmethod eitest-I :PRIMARY ((_a eitest-A))
(eieio-test-method-store :PRIMARY 'eitest-A)
":primary")
-(defmethod eitest-I :AFTER ((a eitest-A))
+(defmethod eitest-I :AFTER ((_a eitest-A))
(eieio-test-method-store :AFTER 'eitest-A)
":after")
@@ -174,17 +174,17 @@
(defclass C (C-base1 C-base2) ())
;; Just use the obsolete name once, to make sure it also works.
-(defmethod constructor :STATIC ((p C-base1) &rest args)
+(defmethod constructor :STATIC ((_p C-base1) &rest _args)
(eieio-test-method-store :STATIC 'C-base1)
(if (next-method-p) (call-next-method))
)
-(defmethod make-instance :STATIC ((p C-base2) &rest args)
+(defmethod make-instance :STATIC ((_p C-base2) &rest _args)
(eieio-test-method-store :STATIC 'C-base2)
(if (next-method-p) (call-next-method))
)
-(cl-defmethod make-instance ((p (subclass C)) &rest args)
+(cl-defmethod make-instance ((_p (subclass C)) &rest _args)
(eieio-test-method-store :STATIC 'C)
(cl-call-next-method)
)
@@ -213,24 +213,24 @@
(defclass D-base2 (D-base0) () :method-invocation-order :depth-first)
(defclass D (D-base1 D-base2) () :method-invocation-order :depth-first)
-(defmethod eitest-F ((p D))
+(defmethod eitest-F ((_p D))
"D"
(eieio-test-method-store :PRIMARY 'D)
(call-next-method))
-(defmethod eitest-F ((p D-base0))
+(defmethod eitest-F ((_p D-base0))
"D-base0"
(eieio-test-method-store :PRIMARY 'D-base0)
;; This should have no next
;; (when (next-method-p) (call-next-method))
)
-(defmethod eitest-F ((p D-base1))
+(defmethod eitest-F ((_p D-base1))
"D-base1"
(eieio-test-method-store :PRIMARY 'D-base1)
(call-next-method))
-(defmethod eitest-F ((p D-base2))
+(defmethod eitest-F ((_p D-base2))
"D-base2"
(eieio-test-method-store :PRIMARY 'D-base2)
(when (next-method-p)
@@ -256,21 +256,21 @@
(defclass E-base2 (E-base0) () :method-invocation-order :breadth-first)
(defclass E (E-base1 E-base2) () :method-invocation-order :breadth-first)
-(defmethod eitest-F ((p E))
+(defmethod eitest-F ((_p E))
(eieio-test-method-store :PRIMARY 'E)
(call-next-method))
-(defmethod eitest-F ((p E-base0))
+(defmethod eitest-F ((_p E-base0))
(eieio-test-method-store :PRIMARY 'E-base0)
;; This should have no next
;; (when (next-method-p) (call-next-method))
)
-(defmethod eitest-F ((p E-base1))
+(defmethod eitest-F ((_p E-base1))
(eieio-test-method-store :PRIMARY 'E-base1)
(call-next-method))
-(defmethod eitest-F ((p E-base2))
+(defmethod eitest-F ((_p E-base2))
(eieio-test-method-store :PRIMARY 'E-base2)
(when (next-method-p)
(call-next-method))
@@ -293,7 +293,7 @@
(defclass eitest-Ja ()
())
-(defmethod initialize-instance :after ((this eitest-Ja) &rest slots)
+(defmethod initialize-instance :after ((_this eitest-Ja) &rest _slots)
;(message "+Ja")
;; FIXME: Using next-method-p in an after-method is invalid!
(when (next-method-p)
@@ -304,7 +304,7 @@
(defclass eitest-Jb ()
())
-(defmethod initialize-instance :after ((this eitest-Jb) &rest slots)
+(defmethod initialize-instance :after ((_this eitest-Jb) &rest _slots)
;(message "+Jb")
;; FIXME: Using next-method-p in an after-method is invalid!
(when (next-method-p)
@@ -318,7 +318,7 @@
(defclass eitest-Jd (eitest-Jc eitest-Ja)
())
-(defmethod initialize-instance ((this eitest-Jd) &rest slots)
+(defmethod initialize-instance ((_this eitest-Jd) &rest _slots)
;(message "+Jd")
(when (next-method-p)
(call-next-method))
@@ -357,7 +357,7 @@
(call-next-method
this (cons 'CNM-1-1 args))))
-(defmethod CNM-M ((this CNM-1-2) args)
+(defmethod CNM-M ((_this CNM-1-2) args)
(push (cons 'CNM-1-2 (copy-sequence args))
eieio-test-call-next-method-arguments)
(when (next-method-p)
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
index 3c5aeaf708f..6979da8482b 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
@@ -1,4 +1,4 @@
-;;; eieio-test-persist.el --- Tests for eieio-persistent class
+;;; eieio-test-persist.el --- Tests for eieio-persistent class -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 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 34c20b2003f..21adc91e555 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 tests routines
+;;; eieio-tests.el -- eieio test routines -*- lexical-binding: t -*-
;; Copyright (C) 1999-2003, 2005-2010, 2012-2020 Free Software
;; Foundation, Inc.
@@ -356,7 +356,7 @@ METHOD is the method that was attempting to be called."
(oset a test-tag 1))
(let ((ca (class-a)))
- (should-not (/= (oref ca test-tag) 2))))
+ (should (= (oref ca test-tag) 2))))
;;; Perform slot testing
@@ -852,6 +852,7 @@ Subclasses to override slot attributes.")
"Instance Tracker test object.")
(ert-deftest eieio-test-33-instance-tracker ()
+ (defvar IT-list)
(let (IT-list IT1)
(should (setq IT1 (IT)))
;; The instance tracker must find this
diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el
index e910329c201..f342bff0472 100644
--- a/test/lisp/emacs-lisp/ert-x-tests.el
+++ b/test/lisp/emacs-lisp/ert-x-tests.el
@@ -1,4 +1,4 @@
-;;; ert-x-tests.el --- Tests for ert-x.el
+;;; ert-x-tests.el --- Tests for ert-x.el -*- lexical-binding:t -*-
;; Copyright (C) 2008, 2010-2020 Free Software Foundation, Inc.
@@ -187,18 +187,15 @@
"Tests `ert-describe-test'."
(save-window-excursion
(ert-with-buffer-renamed ("*Help*")
- (if (< emacs-major-version 24)
- (should (equal (should-error (ert-describe-test 'ert-describe-test))
- '(error "Requires Emacs 24")))
- (ert-describe-test 'ert-test-describe-test)
- (with-current-buffer "*Help*"
- (let ((case-fold-search nil))
- (should (string-match (concat
- "\\`ert-test-describe-test is a test"
- " defined in"
- " ['`‘]ert-x-tests.elc?['’]\\.\n\n"
- "Tests ['`‘]ert-describe-test['’]\\.\n\\'")
- (buffer-string)))))))))
+ (ert-describe-test 'ert-test-describe-test)
+ (with-current-buffer "*Help*"
+ (let ((case-fold-search nil))
+ (should (string-match (concat
+ "\\`ert-test-describe-test is a test"
+ " defined in"
+ " ['`‘]ert-x-tests.elc?['’]\\.\n\n"
+ "Tests ['`‘]ert-describe-test['’]\\.\n\\'")
+ (buffer-string))))))))
(ert-deftest ert-test-message-log-truncation ()
:tags '(:causes-redisplay)
diff --git a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
index 3017b52ab54..c77f2dc4990 100644
--- a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
+++ b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
@@ -1,4 +1,4 @@
-;;; faceup-test-mode.el --- Dummy major mode for testing `faceup'.
+;;; faceup-test-mode.el --- Dummy major mode for testing `faceup'. -*- lexical-binding:t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
@@ -44,7 +44,7 @@
(0 (progn
(add-text-properties (match-beginning 0)
(match-end 0)
- '(help-echo "Baloon tip: Fly smoothly!"))
+ '(help-echo "Balloon tip: Fly smoothly!"))
font-lock-warning-face))))
"Highlight rules for `faceup-test-mode'.")
diff --git a/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el b/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
index ab638ef932f..d8ab02b650e 100644
--- a/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
+++ b/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
@@ -1,4 +1,4 @@
-;;; faceup-test-this-file-directory.el --- Support file for faceup tests
+;;; faceup-test-this-file-directory.el --- Support file for faceup tests -*- lexical-binding:t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup b/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup
index 7d4938adf17..ec9e82148fd 100644
--- a/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup
+++ b/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup
@@ -1,7 +1,7 @@
This is a test of `faceup', a regression test system for font-lock
keywords. It should use major mode `faceup-test-mode'.
-«(help-echo):"Baloon tip: Fly smoothly!":«w:WARNING»»: The first word on this line should use
+«(help-echo):"Balloon tip: Fly smoothly!":«w:WARNING»»: The first word on this line should use
`font-lock-warning-face', and a tooltip should be displayed if the
mouse pointer is moved over it.
diff --git a/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el b/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el
index 0838981fcb9..3c9ec76cdf7 100644
--- a/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el
+++ b/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el
@@ -1,4 +1,4 @@
-;;; faceup-test-basics.el --- Tests for the `faceup' package.
+;;; faceup-test-basics.el --- Tests for the `faceup' package. -*- lexical-binding:t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el b/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el
index 4f5fe180bb3..a87c16d66c0 100644
--- a/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el
+++ b/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el
@@ -1,4 +1,4 @@
-;;; faceup-test-files.el --- Self test of `faceup' using dummy major mode.
+;;; faceup-test-files.el --- Self test of `faceup' using dummy major mode. -*- lexical-binding:t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/emacs-lisp/find-func-tests.el b/test/lisp/emacs-lisp/find-func-tests.el
new file mode 100644
index 00000000000..f505e78566e
--- /dev/null
+++ b/test/lisp/emacs-lisp/find-func-tests.el
@@ -0,0 +1,45 @@
+;;; find-func-tests.el --- Unit tests for find-func.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 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:
+
+(require 'ert-x) ;For `ert-run-keys'.
+
+(ert-deftest find-func-tests--library-completion () ;bug#43393
+ ;; FIXME: How can we make this work in batch (see also
+ ;; `mule-cmds--test-universal-coding-system-argument')?
+ ;; (skip-unless (not noninteractive))
+ ;; Check that `partial-completion' works when completing library names.
+ (should (equal "org/org"
+ (ert-simulate-keys
+ (kbd "o / o r g TAB RET")
+ (read-library-name))))
+ ;; Check that absolute file names also work.
+ (should (equal (expand-file-name "nxml/" data-directory)
+ (ert-simulate-keys
+ (concat data-directory (kbd "n x / TAB RET"))
+ (read-library-name)))))
+
+(provide 'find-func-tests)
+;;; find-func-tests.el ends here
diff --git a/test/lisp/emacs-lisp/float-sup-tests.el b/test/lisp/emacs-lisp/float-sup-tests.el
new file mode 100644
index 00000000000..9f9a3daa28b
--- /dev/null
+++ b/test/lisp/emacs-lisp/float-sup-tests.el
@@ -0,0 +1,33 @@
+;;; float-sup-tests.el --- Tests for float-sup.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest float-sup-degrees-and-radians ()
+ (should (equal (degrees-to-radians 180.0) float-pi))
+ (should (equal (radians-to-degrees float-pi) 180.0))
+ (should (equal (radians-to-degrees (degrees-to-radians 360.0)) 360.0))
+ (should (equal (degrees-to-radians (radians-to-degrees float-pi)) float-pi)))
+
+(provide 'float-sup-tests)
+;;; float-sup-tests.el ends here
diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el
index e0d9167118e..72eee07be8c 100644
--- a/test/lisp/emacs-lisp/generator-tests.el
+++ b/test/lisp/emacs-lisp/generator-tests.el
@@ -30,6 +30,8 @@
(require 'ert)
(require 'cl-lib)
+;;; Code:
+
(defun generator-list-subrs ()
(cl-loop for x being the symbols
when (and (fboundp x)
@@ -306,4 +308,13 @@ identical output."
(1+ it)))))))
-2)))
+(ert-deftest generator-tests-edebug ()
+ "Check that Bug#40434 is fixed."
+ (with-temp-buffer
+ (prin1 '(iter-defun generator-tests-edebug ()
+ (iter-yield 123))
+ (current-buffer))
+ (edebug-defun))
+ (should (eql (iter-next (generator-tests-edebug)) 123)))
+
;;; generator-tests.el ends here
diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el
index 7fa4cd50b08..29e4273b478 100644
--- a/test/lisp/emacs-lisp/gv-tests.el
+++ b/test/lisp/emacs-lisp/gv-tests.el
@@ -19,6 +19,7 @@
;;; Code:
+(require 'edebug)
(require 'ert)
(eval-when-compile (require 'cl-lib))
@@ -134,8 +135,67 @@
"--eval"
(prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99)
(message "%d" (car gv-test-pair)))))
- (should (equal (buffer-string)
- "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n")))))
+ (should (string-match
+ "\\`Symbol.s function definition is void: \\\\(setf\\\\ gv-test-foo\\\\)\n\\'"
+ (buffer-string))))))
+
+(ert-deftest gv-setter-edebug ()
+ "Check that a setter can be defined and edebugged together with
+its getter (Bug#41853)."
+ (with-temp-buffer
+ (let ((edebug-all-defs t)
+ (edebug-initial-mode 'Go-nonstop))
+ (dolist (form '((defun gv-setter-edebug-help (b) b)
+ (defun gv-setter-edebug-get (a b)
+ (get a (gv-setter-edebug-help b)))
+ (gv-define-setter gv-setter-edebug-get (x a b)
+ `(setf (get ,a (gv-setter-edebug-help ,b)) ,x))
+ (push 123 (gv-setter-edebug-get 'gv-setter-edebug
+ 'gv-setter-edebug-prop))))
+ (print form (current-buffer)))
+ ;; Only check whether evaluation works in general.
+ (eval-buffer)))
+ (should (equal (get 'gv-setter-edebug 'gv-setter-edebug-prop) '(123))))
+
+(ert-deftest gv-plist-get ()
+ (require 'cl-lib)
+
+ ;; Simple setf usage for plist-get.
+ (should (equal (let ((target '(:a "a" :b "b" :c "c")))
+ (setf (plist-get target :b) "modify")
+ target)
+ '(:a "a" :b "modify" :c "c")))
+
+ ;; Other function (cl-rotatef) usage for plist-get.
+ (should (equal (let ((target '(:a "a" :b "b" :c "c")))
+ (cl-rotatef (plist-get target :b) (plist-get target :c))
+ target)
+ '(:a "a" :b "c" :c "b")))
+
+ ;; Add new key value pair at top of list if setf for missing key.
+ (should (equal (let ((target '(:a "a" :b "b" :c "c")))
+ (setf (plist-get target :d) "modify")
+ target)
+ '(:d "modify" :a "a" :b "b" :c "c")))
+
+ ;; Rotate with missing value.
+ ;; The value corresponding to the missing key is assumed to be nil.
+ (should (equal (let ((target '(:a "a" :b "b" :c "c")))
+ (cl-rotatef (plist-get target :b) (plist-get target :d))
+ target)
+ '(:d "b" :a "a" :b nil :c "c")))
+
+ ;; Simple setf usage for plist-get. (symbol plist)
+ (should (equal (let ((target '(a "a" b "b" c "c")))
+ (setf (plist-get target 'b) "modify")
+ target)
+ '(a "a" b "modify" c "c")))
+
+ ;; Other function (cl-rotatef) usage for plist-get. (symbol plist)
+ (should (equal (let ((target '(a "a" b "b" c "c")))
+ (cl-rotatef (plist-get target 'b) (plist-get target 'c))
+ target)
+ '(a "a" b "c" c "b"))))
;; `ert-deftest' messes up macroexpansion when the test file itself is
;; compiled (see Bug #24402).
diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el b/test/lisp/emacs-lisp/hierarchy-tests.el
new file mode 100644
index 00000000000..41d3f2f3ccf
--- /dev/null
+++ b/test/lisp/emacs-lisp/hierarchy-tests.el
@@ -0,0 +1,556 @@
+;;; hierarchy-tests.el --- Tests for hierarchy.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2017-2019 Damien Cassou
+
+;; Author: Damien Cassou <damien@cassou.me>
+;; Maintainer: emacs-devel@gnu.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests for hierarchy.el
+
+;;; Code:
+
+(require 'ert)
+(require 'hierarchy)
+
+(defun hierarchy-animals ()
+ "Create a sorted animal hierarchy."
+ (let ((parentfn (lambda (item) (cl-case item
+ (dove 'bird)
+ (pigeon 'bird)
+ (bird 'animal)
+ (dolphin 'animal)
+ (cow 'animal))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'dove parentfn)
+ (hierarchy-add-tree hierarchy 'pigeon parentfn)
+ (hierarchy-add-tree hierarchy 'dolphin parentfn)
+ (hierarchy-add-tree hierarchy 'cow parentfn)
+ (hierarchy-sort hierarchy)
+ hierarchy))
+
+(ert-deftest hierarchy-add-one-root ()
+ (let ((parentfn (lambda (_) nil))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'animal parentfn)
+ (should (equal (hierarchy-roots hierarchy) '(animal)))))
+
+(ert-deftest hierarchy-add-one-item-with-parent ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (bird 'animal))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'bird parentfn)
+ (should (equal (hierarchy-roots hierarchy) '(animal)))
+ (should (equal (hierarchy-children hierarchy 'animal) '(bird)))))
+
+(ert-deftest hierarchy-add-one-item-with-parent-and-grand-parent ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (dove 'bird)
+ (bird 'animal))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'dove parentfn)
+ (should (equal (hierarchy-roots hierarchy) '(animal)))
+ (should (equal (hierarchy-children hierarchy 'animal) '(bird)))
+ (should (equal (hierarchy-children hierarchy 'bird) '(dove)))))
+
+(ert-deftest hierarchy-add-same-root-twice ()
+ (let ((parentfn (lambda (_) nil))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'animal parentfn)
+ (hierarchy-add-tree hierarchy 'animal parentfn)
+ (should (equal (hierarchy-roots hierarchy) '(animal)))))
+
+(ert-deftest hierarchy-add-same-child-twice ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (bird 'animal))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'bird parentfn)
+ (hierarchy-add-tree hierarchy 'bird parentfn)
+ (should (equal (hierarchy-roots hierarchy) '(animal)))
+ (should (equal (hierarchy-children hierarchy 'animal) '(bird)))))
+
+(ert-deftest hierarchy-add-item-and-its-parent ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (bird 'animal))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'bird parentfn)
+ (hierarchy-add-tree hierarchy 'animal parentfn)
+ (should (equal (hierarchy-roots hierarchy) '(animal)))
+ (should (equal (hierarchy-children hierarchy 'animal) '(bird)))))
+
+(ert-deftest hierarchy-add-item-and-its-child ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (bird 'animal))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'animal parentfn)
+ (hierarchy-add-tree hierarchy 'bird parentfn)
+ (should (equal (hierarchy-roots hierarchy) '(animal)))
+ (should (equal (hierarchy-children hierarchy 'animal) '(bird)))))
+
+(ert-deftest hierarchy-add-two-items-sharing-parent ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (dove 'bird)
+ (pigeon 'bird))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'dove parentfn)
+ (hierarchy-add-tree hierarchy 'pigeon parentfn)
+ (should (equal (hierarchy-roots hierarchy) '(bird)))
+ (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon)))))
+
+(ert-deftest hierarchy-add-two-hierarchies ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (dove 'bird)
+ (circle 'shape))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'dove parentfn)
+ (hierarchy-add-tree hierarchy 'circle parentfn)
+ (should (equal (hierarchy-roots hierarchy) '(bird shape)))
+ (should (equal (hierarchy-children hierarchy 'bird) '(dove)))
+ (should (equal (hierarchy-children hierarchy 'shape) '(circle)))))
+
+(ert-deftest hierarchy-add-with-childrenfn ()
+ (let ((childrenfn (lambda (item)
+ (cl-case item
+ (animal '(bird))
+ (bird '(dove pigeon)))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'animal nil childrenfn)
+ (should (equal (hierarchy-roots hierarchy) '(animal)))
+ (should (equal (hierarchy-children hierarchy 'animal) '(bird)))
+ (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon)))))
+
+(ert-deftest hierarchy-add-with-parentfn-and-childrenfn ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (bird 'animal)
+ (animal 'life-form))))
+ (childrenfn (lambda (item)
+ (cl-case item
+ (bird '(dove pigeon))
+ (pigeon '(ashy-wood-pigeon)))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'bird parentfn childrenfn)
+ (should (equal (hierarchy-roots hierarchy) '(life-form)))
+ (should (equal (hierarchy-children hierarchy 'life-form) '(animal)))
+ (should (equal (hierarchy-children hierarchy 'animal) '(bird)))
+ (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon)))
+ (should (equal (hierarchy-children hierarchy 'pigeon) '(ashy-wood-pigeon)))))
+
+(ert-deftest hierarchy-add-twice-with-parentfn-and-childrenfn ()
+ (let* ((parentfn (lambda (item)
+ (cl-case item
+ (dove 'bird)
+ (bird 'animal))))
+ (childrenfn (lambda (item)
+ (cl-case item
+ (animal '(bird))
+ (bird '(dove)))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'bird parentfn childrenfn)
+ (should (equal (hierarchy-children hierarchy 'animal) '(bird)))
+ (should (equal (hierarchy-children hierarchy 'bird) '(dove)))))
+
+(ert-deftest hierarchy-add-trees ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (dove 'bird)
+ (pigeon 'bird)
+ (bird 'animal))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-trees hierarchy '(dove pigeon) parentfn)
+ (should (equal (hierarchy-roots hierarchy) '(animal)))
+ (should (equal (hierarchy-children hierarchy 'animal) '(bird)))
+ (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon)))))
+
+(ert-deftest hierarchy-from-list ()
+ (let ((hierarchy (hierarchy-from-list
+ '(animal (bird (dove)
+ (pigeon))
+ (cow)
+ (dolphin)))))
+ (hierarchy-sort hierarchy (lambda (item1 item2)
+ (string< (car item1)
+ (car item2))))
+ (should (equal (hierarchy-to-string hierarchy (lambda (item) (symbol-name (car item))))
+ "animal\n bird\n dove\n pigeon\n cow\n dolphin\n"))))
+
+(ert-deftest hierarchy-from-list-with-duplicates ()
+ (let ((hierarchy (hierarchy-from-list
+ '(a (b) (b))
+ t)))
+ (hierarchy-sort hierarchy (lambda (item1 item2)
+ ;; sort by ID
+ (< (car item1) (car item2))))
+ (should (equal (hierarchy-length hierarchy) 3))
+ (should (equal (hierarchy-to-string
+ hierarchy
+ (lambda (item)
+ (format "%s(%s)"
+ (cadr item)
+ (car item))))
+ "a(1)\n b(2)\n b(3)\n"))))
+
+(ert-deftest hierarchy-from-list-with-childrenfn ()
+ (let ((hierarchy (hierarchy-from-list
+ "abc"
+ nil
+ (lambda (item)
+ (when (string= item "abc")
+ (split-string item "" t))))))
+ (hierarchy-sort hierarchy (lambda (item1 item2) (string< item1 item2)))
+ (should (equal (hierarchy-length hierarchy) 4))
+ (should (equal (hierarchy-to-string hierarchy)
+ "abc\n a\n b\n c\n"))))
+
+(ert-deftest hierarchy-add-relation-check-error-when-different-parent ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (bird 'animal))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'bird parentfn)
+ (should-error
+ (hierarchy--add-relation hierarchy 'bird 'cow #'identity))))
+
+(ert-deftest hierarchy-empty-p-return-non-nil-for-empty ()
+ (should (hierarchy-empty-p (hierarchy-new))))
+
+(ert-deftest hierarchy-empty-p-return-nil-for-non-empty ()
+ (should-not (hierarchy-empty-p (hierarchy-animals))))
+
+(ert-deftest hierarchy-length-of-empty-is-0 ()
+ (should (equal (hierarchy-length (hierarchy-new)) 0)))
+
+(ert-deftest hierarchy-length-of-non-empty-counts-items ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (bird 'animal)
+ (dove 'bird)
+ (pigeon 'bird))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'dove parentfn)
+ (hierarchy-add-tree hierarchy 'pigeon parentfn)
+ (should (equal (hierarchy-length hierarchy) 4))))
+
+(ert-deftest hierarchy-has-root ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (bird 'animal)
+ (dove 'bird)
+ (pigeon 'bird))))
+ (hierarchy (hierarchy-new)))
+ (should-not (hierarchy-has-root hierarchy 'animal))
+ (should-not (hierarchy-has-root hierarchy 'bird))
+ (hierarchy-add-tree hierarchy 'dove parentfn)
+ (hierarchy-add-tree hierarchy 'pigeon parentfn)
+ (should (hierarchy-has-root hierarchy 'animal))
+ (should-not (hierarchy-has-root hierarchy 'bird))))
+
+(ert-deftest hierarchy-leafs ()
+ (let ((animals (hierarchy-animals)))
+ (should (equal (hierarchy-leafs animals)
+ '(dove pigeon dolphin cow)))))
+
+(ert-deftest hierarchy-leafs-includes-lonely-roots ()
+ (let ((parentfn (lambda (_) nil))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 'foo parentfn)
+ (should (equal (hierarchy-leafs hierarchy)
+ '(foo)))))
+
+(ert-deftest hierarchy-leafs-of-node ()
+ (let ((animals (hierarchy-animals)))
+ (should (equal (hierarchy-leafs animals 'cow) '()))
+ (should (equal (hierarchy-leafs animals 'animal) '(dove pigeon dolphin cow)))
+ (should (equal (hierarchy-leafs animals 'bird) '(dove pigeon)))
+ (should (equal (hierarchy-leafs animals 'dove) '()))))
+
+(ert-deftest hierarchy-child-p ()
+ (let ((animals (hierarchy-animals)))
+ (should (hierarchy-child-p animals 'dove 'bird))
+ (should (hierarchy-child-p animals 'bird 'animal))
+ (should (hierarchy-child-p animals 'cow 'animal))
+ (should-not (hierarchy-child-p animals 'cow 'bird))
+ (should-not (hierarchy-child-p animals 'bird 'cow))
+ (should-not (hierarchy-child-p animals 'animal 'dove))
+ (should-not (hierarchy-child-p animals 'animal 'bird))))
+
+(ert-deftest hierarchy-descendant ()
+ (let ((animals (hierarchy-animals)))
+ (should (hierarchy-descendant-p animals 'dove 'animal))
+ (should (hierarchy-descendant-p animals 'dove 'bird))
+ (should (hierarchy-descendant-p animals 'bird 'animal))
+ (should (hierarchy-descendant-p animals 'cow 'animal))
+ (should-not (hierarchy-descendant-p animals 'cow 'bird))
+ (should-not (hierarchy-descendant-p animals 'bird 'cow))
+ (should-not (hierarchy-descendant-p animals 'animal 'dove))
+ (should-not (hierarchy-descendant-p animals 'animal 'bird))))
+
+(ert-deftest hierarchy-descendant-if-not-same ()
+ (let ((animals (hierarchy-animals)))
+ (should-not (hierarchy-descendant-p animals 'cow 'cow))
+ (should-not (hierarchy-descendant-p animals 'dove 'dove))
+ (should-not (hierarchy-descendant-p animals 'bird 'bird))
+ (should-not (hierarchy-descendant-p animals 'animal 'animal))))
+
+;; keywords supported: :test :key
+(ert-deftest hierarchy--set-equal ()
+ (should (hierarchy--set-equal '(1 2 3) '(1 2 3)))
+ (should (hierarchy--set-equal '(1 2 3) '(3 2 1)))
+ (should (hierarchy--set-equal '(3 2 1) '(1 2 3)))
+ (should-not (hierarchy--set-equal '(2 3) '(3 2 1)))
+ (should-not (hierarchy--set-equal '(1 2 3) '(2 3)))
+ (should-not (hierarchy--set-equal '("1" "2") '("2" "1") :test #'eq))
+ (should (hierarchy--set-equal '("1" "2") '("2" "1") :test #'equal))
+ (should-not (hierarchy--set-equal '(1 2) '(-1 -2)))
+ (should (hierarchy--set-equal '(1 2) '(-1 -2) :key #'abs))
+ (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2))))
+ (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :key #'car))
+ (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :test #'equal))
+ (should (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :key #'car :test #'equal)))
+
+(ert-deftest hierarchy-equal-returns-true-for-same-hierarchy ()
+ (let ((animals (hierarchy-animals)))
+ (should (hierarchy-equal animals animals))
+ (should (hierarchy-equal (hierarchy-animals) animals))))
+
+(ert-deftest hierarchy-equal-returns-true-for-hierarchy-copies ()
+ (let ((animals (hierarchy-animals)))
+ (should (hierarchy-equal animals (hierarchy-copy animals)))))
+
+(ert-deftest hierarchy-map-item-on-leaf ()
+ (let* ((animals (hierarchy-animals))
+ (result (hierarchy-map-item (lambda (item indent) (cons item indent))
+ 'cow
+ animals)))
+ (should (equal result '((cow . 0))))))
+
+(ert-deftest hierarchy-map-item-on-leaf-with-indent ()
+ (let* ((animals (hierarchy-animals))
+ (result (hierarchy-map-item (lambda (item indent) (cons item indent))
+ 'cow
+ animals
+ 2)))
+ (should (equal result '((cow . 2))))))
+
+(ert-deftest hierarchy-map-item-on-parent ()
+ (let* ((animals (hierarchy-animals))
+ (result (hierarchy-map-item (lambda (item indent) (cons item indent))
+ 'bird
+ animals)))
+ (should (equal result '((bird . 0) (dove . 1) (pigeon . 1))))))
+
+(ert-deftest hierarchy-map-item-on-grand-parent ()
+ (let* ((animals (hierarchy-animals))
+ (result (hierarchy-map-item (lambda (item indent) (cons item indent))
+ 'animal
+ animals)))
+ (should (equal result '((animal . 0) (bird . 1) (dove . 2) (pigeon . 2)
+ (cow . 1) (dolphin . 1))))))
+
+(ert-deftest hierarchy-map-conses ()
+ (let* ((animals (hierarchy-animals))
+ (result (hierarchy-map (lambda (item indent)
+ (cons item indent))
+ animals)))
+ (should (equal result '((animal . 0)
+ (bird . 1)
+ (dove . 2)
+ (pigeon . 2)
+ (cow . 1)
+ (dolphin . 1))))))
+
+(ert-deftest hierarchy-map-tree ()
+ (let ((animals (hierarchy-animals)))
+ (should (equal (hierarchy-map-tree (lambda (item indent children)
+ (list item indent children))
+ animals)
+ '(animal
+ 0
+ ((bird 1 ((dove 2 nil) (pigeon 2 nil)))
+ (cow 1 nil)
+ (dolphin 1 nil)))))))
+
+(ert-deftest hierarchy-map-hierarchy-keeps-hierarchy ()
+ (let* ((animals (hierarchy-animals))
+ (result (hierarchy-map-hierarchy (lambda (item _) (identity item))
+ animals)))
+ (should (hierarchy-equal animals result))))
+
+(ert-deftest hierarchy-map-applies-function ()
+ (let* ((animals (hierarchy-animals))
+ (parentfn (lambda (item)
+ (cond
+ ((equal item "bird") "animal")
+ ((equal item "dove") "bird")
+ ((equal item "pigeon") "bird")
+ ((equal item "cow") "animal")
+ ((equal item "dolphin") "animal"))))
+ (expected (hierarchy-new)))
+ (hierarchy-add-tree expected "dove" parentfn)
+ (hierarchy-add-tree expected "pigeon" parentfn)
+ (hierarchy-add-tree expected "cow" parentfn)
+ (hierarchy-add-tree expected "dolphin" parentfn)
+ (should (hierarchy-equal
+ (hierarchy-map-hierarchy (lambda (item _) (symbol-name item)) animals)
+ expected))))
+
+(ert-deftest hierarchy-extract-tree ()
+ (let* ((animals (hierarchy-animals))
+ (birds (hierarchy-extract-tree animals 'bird)))
+ (hierarchy-sort birds)
+ (should (equal (hierarchy-roots birds) '(animal)))
+ (should (equal (hierarchy-children birds 'animal) '(bird)))
+ (should (equal (hierarchy-children birds 'bird) '(dove pigeon)))))
+
+(ert-deftest hierarchy-extract-tree-nil-if-not-in-hierarchy ()
+ (let* ((animals (hierarchy-animals)))
+ (should-not (hierarchy-extract-tree animals 'foobar))))
+
+(ert-deftest hierarchy-items-of-empty-hierarchy-is-empty ()
+ (should (seq-empty-p (hierarchy-items (hierarchy-new)))))
+
+(ert-deftest hierarchy-items-returns-sequence-of-same-length ()
+ (let* ((animals (hierarchy-animals))
+ (result (hierarchy-items animals)))
+ (should (= (seq-length result) (hierarchy-length animals)))))
+
+(ert-deftest hierarchy-items-return-all-elements-of-hierarchy ()
+ (let* ((animals (hierarchy-animals))
+ (result (hierarchy-items animals)))
+ (should (equal (seq-sort #'string< result) '(animal bird cow dolphin dove pigeon)))))
+
+(ert-deftest hierarchy-labelfn-indent-no-indent-if-0 ()
+ (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
+ (labelfn (hierarchy-labelfn-indent labelfn-base)))
+ (should (equal
+ (with-temp-buffer
+ (funcall labelfn "bar" 0)
+ (buffer-substring (point-min) (point-max)))
+ "foo"))))
+
+(ert-deftest hierarchy-labelfn-indent-three-times-if-3 ()
+ (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
+ (labelfn (hierarchy-labelfn-indent labelfn-base)))
+ (should (equal
+ (with-temp-buffer
+ (funcall labelfn "bar" 3)
+ (buffer-substring (point-min) (point-max)))
+ " foo"))))
+
+(ert-deftest hierarchy-labelfn-indent-default-indent-string ()
+ (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
+ (labelfn (hierarchy-labelfn-indent labelfn-base)))
+ (should (equal
+ (with-temp-buffer
+ (funcall labelfn "bar" 1)
+ (buffer-substring (point-min) (point-max)))
+ " foo"))))
+
+(ert-deftest hierarchy-labelfn-indent-custom-indent-string ()
+ (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
+ (labelfn (hierarchy-labelfn-indent labelfn-base "###"))
+ (content (with-temp-buffer
+ (funcall labelfn "bar" 1)
+ (buffer-substring (point-min) (point-max)))))
+ (should (equal content "###foo"))))
+
+(ert-deftest hierarchy-labelfn-button-propertize ()
+ (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
+ (actionfn #'identity)
+ (labelfn (hierarchy-labelfn-button labelfn-base actionfn))
+ (properties (with-temp-buffer
+ (funcall labelfn "bar" 1)
+ (text-properties-at 1))))
+ (should (equal (car properties) 'action))))
+
+(ert-deftest hierarchy-labelfn-button-execute-labelfn ()
+ (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
+ (actionfn #'identity)
+ (labelfn (hierarchy-labelfn-button labelfn-base actionfn))
+ (content (with-temp-buffer
+ (funcall labelfn "bar" 1)
+ (buffer-substring-no-properties (point-min) (point-max)))))
+ (should (equal content "foo"))))
+
+(ert-deftest hierarchy-labelfn-button-if-does-not-button-unless-condition ()
+ (let ((labelfn-base (lambda (_item _indent) (insert "foo")))
+ (spy-count 0)
+ (condition (lambda (_item _indent) nil)))
+ (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (cl-incf spy-count)))))
+ (funcall (hierarchy-labelfn-button-if labelfn-base condition #'identity) nil nil)
+ (should (equal spy-count 0)))))
+
+(ert-deftest hierarchy-labelfn-button-if-does-button-when-condition ()
+ (let ((labelfn-base (lambda (_item _indent) (insert "foo")))
+ (spy-count 0)
+ (condition (lambda (_item _indent) t)))
+ (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (cl-incf spy-count)))))
+ (funcall (hierarchy-labelfn-button-if labelfn-base condition #'identity) nil nil)
+ (should (equal spy-count 1)))))
+
+(ert-deftest hierarchy-labelfn-to-string ()
+ (let ((labelfn (lambda (item _indent) (insert item))))
+ (should (equal (hierarchy-labelfn-to-string labelfn "foo" 1) "foo"))))
+
+(ert-deftest hierarchy-print ()
+ (let* ((animals (hierarchy-animals))
+ (result (with-temp-buffer
+ (hierarchy-print animals)
+ (buffer-substring-no-properties (point-min) (point-max)))))
+ (should (equal result "animal\n bird\n dove\n pigeon\n cow\n dolphin\n"))))
+
+(ert-deftest hierarchy-to-string ()
+ (let* ((animals (hierarchy-animals))
+ (result (hierarchy-to-string animals)))
+ (should (equal result "animal\n bird\n dove\n pigeon\n cow\n dolphin\n"))))
+
+(ert-deftest hierarchy-tabulated-display ()
+ (let* ((animals (hierarchy-animals))
+ (labelfn (lambda (item _indent) (insert (symbol-name item))))
+ (contents (with-temp-buffer
+ (hierarchy-tabulated-display animals labelfn (current-buffer))
+ (buffer-substring-no-properties (point-min) (point-max)))))
+ (should (equal contents "animal\nbird\ndove\npigeon\ncow\ndolphin\n"))))
+
+(ert-deftest hierarchy-sort-non-root-nodes ()
+ (let* ((animals (hierarchy-animals)))
+ (should (equal (hierarchy-roots animals) '(animal)))
+ (should (equal (hierarchy-children animals 'animal) '(bird cow dolphin)))
+ (should (equal (hierarchy-children animals 'bird) '(dove pigeon)))))
+
+(ert-deftest hierarchy-sort-roots ()
+ (let* ((organisms (hierarchy-new))
+ (parentfn (lambda (item)
+ (cl-case item
+ (oak 'plant)
+ (bird 'animal)))))
+ (hierarchy-add-tree organisms 'oak parentfn)
+ (hierarchy-add-tree organisms 'bird parentfn)
+ (hierarchy-sort organisms)
+ (should (equal (hierarchy-roots organisms) '(animal plant)))))
+
+(provide 'hierarchy-tests)
+;;; hierarchy-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 febac8f4789..d1183d83f6a 100644
--- a/test/lisp/emacs-lisp/lisp-mode-tests.el
+++ b/test/lisp/emacs-lisp/lisp-mode-tests.el
@@ -153,7 +153,7 @@ noindent\" 3
(should (equal (buffer-string) str)))))
(ert-deftest indent-sexp-stop-before-eol-non-lisp ()
- "`indent-sexp' shouldn't be too agressive in non-Lisp modes."
+ "`indent-sexp' shouldn't be too aggressive in non-Lisp modes."
;; See https://debbugs.gnu.org/35286#13.
(with-temp-buffer
(prolog-mode)
@@ -294,6 +294,18 @@ Expected initialization file: `%s'\"
(insert "\"\n")
(lisp-indent-region (point-min) (point-max))))
+(ert-deftest lisp-indent-defun ()
+ (with-temp-buffer
+ (lisp-mode)
+ (let ((orig "(defun x ()
+ (print (quote ( thingy great
+ stuff)))
+ (print (quote (thingy great
+ stuff))))"))
+ (insert orig)
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) orig)))))
+
;;; Fontification
diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el
index 8736ac70201..437b907ba13 100644
--- a/test/lisp/emacs-lisp/lisp-tests.el
+++ b/test/lisp/emacs-lisp/lisp-tests.el
@@ -136,8 +136,7 @@
(text-mode)
(insert "\"foo\"")
(goto-char (point-min))
- (delete-pair)
- (should (string-equal "fo\"" (buffer-string)))))
+ (should-error (delete-pair))))
(ert-deftest lisp-delete-pair-quotes-text-mode-syntax-table ()
"Test \\[delete-pair] with modified Text Mode syntax for #15014."
@@ -296,7 +295,7 @@
(lambda () (up-list 1 t t))
(or "(1 '2 ( 2' 1 '2 ) 2' 1)")
;; abcdefghijklmnopqrstuvwxy
- i k x scan-error)
+ i k x user-error)
(define-lisp-up-list-test backward-up-list-basic
(lambda () (backward-up-list))
@@ -367,6 +366,61 @@ start."
"
"Test buffer for `mark-defun'."))
+;;; end-of-defun
+
+(ert-deftest end-of-defun-twice ()
+ "Test behavior of prefix arg for `end-of-defun' (Bug#24427).
+Calling `end-of-defun' twice should be the same as a prefix arg
+of two."
+ (setq last-command nil)
+ (cl-flet ((eod2 (lambda ()
+ (goto-char (point-min))
+ (end-of-defun)
+ (end-of-defun)
+ (let ((pt-eod2 (point)))
+ (goto-char (point-min))
+ (end-of-defun 2)
+ (should (= (point) pt-eod2))))))
+ (with-temp-buffer
+ (insert "\
+\(defun a ())
+
+\(defun b ())
+
+\(defun c ())")
+ (eod2))
+ (with-temp-buffer
+ (insert "\
+\(defun a ())
+\(defun b ())
+\(defun c ())")
+ (eod2)))
+ (elisp-tests-with-temp-buffer ";; Comment header
+
+\(defun func-1 (arg)
+ \"docstring\"
+ body)
+=!p1=
+;; Comment before a defun
+\(defun func-2 (arg)
+ \"docstring\"
+ body)
+
+\(defun func-3 (arg)
+ \"docstring\"
+ body)
+=!p2=(defun func-4 (arg)
+ \"docstring\"
+ body)
+
+;; end
+"
+ (goto-char p1)
+ (end-of-defun 2)
+ (should (= (point) p2))))
+
+;;; mark-defun
+
(ert-deftest mark-defun-no-arg-region-inactive ()
"Test `mark-defun' with no prefix argument and inactive
region."
diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el
index c52bb83fa33..1888baf6017 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -376,5 +376,11 @@ Evaluate BODY for each created map.
'((1 . 1) (2 . 5) (3 . 0)))
'((3 . 0) (2 . 9) (1 . 6)))))
+(ert-deftest test-map-plist-pcase ()
+ (let ((plist '(:one 1 :two 2)))
+ (should (equal (pcase-let (((map :one (:two two)) plist))
+ (list one two))
+ '(1 2)))))
+
(provide 'map-tests)
;;; map-tests.el ends here
diff --git a/test/lisp/emacs-lisp/nadvice-tests.el b/test/lisp/emacs-lisp/nadvice-tests.el
index eabe3cb1970..a955df0a696 100644
--- a/test/lisp/emacs-lisp/nadvice-tests.el
+++ b/test/lisp/emacs-lisp/nadvice-tests.el
@@ -1,4 +1,4 @@
-;;; advice-tests.el --- Test suite for the new advice thingy.
+;;; nadvice-tests.el --- Test suite for the new advice thingy. -*- lexical-binding:t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/emacs-lisp/package-resources/newer-versions/new-pkg-1.0.el b/test/lisp/emacs-lisp/package-resources/newer-versions/new-pkg-1.0.el
index 7251622fa59..61c1b045990 100644
--- a/test/lisp/emacs-lisp/package-resources/newer-versions/new-pkg-1.0.el
+++ b/test/lisp/emacs-lisp/package-resources/newer-versions/new-pkg-1.0.el
@@ -1,4 +1,4 @@
-;;; new-pkg.el --- A package only seen after "updating" archive-contents
+;;; new-pkg.el --- A package only seen after "updating" archive-contents -*- lexical-binding:t -*-
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.0
diff --git a/test/lisp/emacs-lisp/package-resources/newer-versions/simple-single-1.4.el b/test/lisp/emacs-lisp/package-resources/newer-versions/simple-single-1.4.el
index 7b1c00c06db..301993deb30 100644
--- a/test/lisp/emacs-lisp/package-resources/newer-versions/simple-single-1.4.el
+++ b/test/lisp/emacs-lisp/package-resources/newer-versions/simple-single-1.4.el
@@ -1,4 +1,4 @@
-;;; simple-single.el --- A single-file package with no dependencies
+;;; simple-single.el --- A single-file package with no dependencies -*- lexical-binding:t -*-
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.4
diff --git a/test/lisp/emacs-lisp/package-resources/simple-depend-1.0.el b/test/lisp/emacs-lisp/package-resources/simple-depend-1.0.el
index b58b658d024..cb003905bb5 100644
--- a/test/lisp/emacs-lisp/package-resources/simple-depend-1.0.el
+++ b/test/lisp/emacs-lisp/package-resources/simple-depend-1.0.el
@@ -1,4 +1,4 @@
-;;; simple-depend.el --- A single-file package with a dependency.
+;;; simple-depend.el --- A single-file package with a dependency. -*- lexical-binding:t -*-
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.0
diff --git a/test/lisp/emacs-lisp/package-resources/simple-single-1.3.el b/test/lisp/emacs-lisp/package-resources/simple-single-1.3.el
index 6756a28080b..9c3f427ff48 100644
--- a/test/lisp/emacs-lisp/package-resources/simple-single-1.3.el
+++ b/test/lisp/emacs-lisp/package-resources/simple-single-1.3.el
@@ -1,4 +1,4 @@
-;;; simple-single.el --- A single-file package with no dependencies
+;;; simple-single.el --- A single-file package with no dependencies -*- lexical-binding:t -*-
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.3
diff --git a/test/lisp/emacs-lisp/package-resources/simple-two-depend-1.1.el b/test/lisp/emacs-lisp/package-resources/simple-two-depend-1.1.el
index 9cfe5c0d4e2..a0a9607350a 100644
--- a/test/lisp/emacs-lisp/package-resources/simple-two-depend-1.1.el
+++ b/test/lisp/emacs-lisp/package-resources/simple-two-depend-1.1.el
@@ -1,4 +1,4 @@
-;;; simple-two-depend.el --- A single-file package with two dependencies.
+;;; simple-two-depend.el --- A single-file package with two dependencies. -*- lexical-binding:t -*-
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.1
diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el
index 4fcaf0e84c2..cbb2410f953 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -1,4 +1,4 @@
-;;; package-test.el --- Tests for the Emacs package system
+;;; package-tests.el --- Tests for the Emacs package system -*- lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
@@ -143,8 +143,8 @@
,(if basedir `(cd ,basedir))
(unless (file-directory-p package-user-dir)
(mkdir package-user-dir))
- (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest r) t))
- ((symbol-function 'y-or-n-p) (lambda (&rest r) t)))
+ (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
+ ((symbol-function 'y-or-n-p) (lambda (&rest _) t)))
,@(when install
`((package-initialize)
(package-refresh-contents)
@@ -175,9 +175,8 @@
(defun package-test-suffix-matches (base suffix-list)
"Return file names matching BASE concatenated with each item in SUFFIX-LIST"
- (cl-mapcan
- '(lambda (item) (file-expand-wildcards (concat base item)))
- suffix-list))
+ (mapcan (lambda (item) (file-expand-wildcards (concat base item)))
+ suffix-list))
(defvar tar-parse-info)
(declare-function tar-header-name "tar-mode" (cl-x) t) ; defstruct
@@ -352,48 +351,122 @@ Must called from within a `tar-mode' buffer."
(goto-char (point-min))
(should (re-search-forward re nil t)))))))
+
+;;; Package Menu tests
+
+(defmacro with-package-menu-test (&rest body)
+ "Set up Package Menu (\"*Packages*\") buffer for testing."
+ (declare (indent 0) (debug (([&rest form]) body)))
+ `(with-package-test ()
+ (let ((buf (package-list-packages)))
+ (unwind-protect
+ (progn ,@body)
+ (kill-buffer buf)))))
+
(ert-deftest package-test-update-listing ()
"Ensure installed package status is updated."
- (with-package-test ()
- (let ((buf (package-list-packages)))
- (search-forward-regexp "^ +simple-single")
- (package-menu-mark-install)
- (package-menu-execute)
- (run-hooks 'post-command-hook)
- (should (package-installed-p 'simple-single))
- (switch-to-buffer "*Packages*")
- (goto-char (point-min))
- (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t))
- (goto-char (point-min))
- (should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t))
- (kill-buffer buf))))
+ (with-package-menu-test
+ (search-forward-regexp "^ +simple-single")
+ (package-menu-mark-install)
+ (package-menu-execute)
+ (run-hooks 'post-command-hook)
+ (should (package-installed-p 'simple-single))
+ (switch-to-buffer "*Packages*")
+ (goto-char (point-min))
+ (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t))
+ (goto-char (point-min))
+ (should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t))))
+
+(ert-deftest package-test-list-filter-by-archive ()
+ "Ensure package list is filtered correctly by archive version."
+ (with-package-menu-test
+ ;; TODO: Add another package archive to test filtering, because
+ ;; the testing environment currently only has one.
+ (package-menu-filter-by-archive "gnu")
+ (goto-char (point-min))
+ (should (looking-at "^\\s-+multi-file"))
+ (should (= (count-lines (point-min) (point-max)) 4))
+ (should-error (package-menu-filter-by-archive "non-existent archive"))))
+
+(ert-deftest package-test-list-filter-by-keyword ()
+ "Ensure package list is filtered correctly by package keyword."
+ (with-package-menu-test
+ (package-menu-filter-by-keyword "frobnicate")
+ (goto-char (point-min))
+ (should (re-search-forward "^\\s-+simple-single" nil t))
+ (should (= (count-lines (point-min) (point-max)) 1))
+ (should-error (package-menu-filter-by-keyword "non-existent-keyword"))))
(ert-deftest package-test-list-filter-by-name ()
"Ensure package list is filtered correctly by package name."
+ (with-package-menu-test ()
+ (package-menu-filter-by-name "tetris")
+ (goto-char (point-min))
+ (should (re-search-forward "^\\s-+tetris" nil t))
+ (should (= (count-lines (point-min) (point-max)) 1))))
+
+(ert-deftest package-test-list-filter-by-status ()
+ "Ensure package list is filtered correctly by package status."
+ (with-package-menu-test
+ (package-menu-filter-by-status "available")
+ (goto-char (point-min))
+ (should (re-search-forward "^\\s-+multi-file" nil t))
+ (should (= (count-lines (point-min) (point-max)) 4))
+ ;; No installed packages in default environment.
+ (should-error (package-menu-filter-by-status "installed"))))
+
+(ert-deftest package-test-list-filter-marked ()
+ "Ensure package list is filtered correctly by non-empty mark."
(with-package-test ()
- (let ((buf (package-list-packages)))
- (package-menu-filter-by-name "tetris")
- (goto-char (point-min))
- (should (re-search-forward "^\\s-+tetris" nil t))
- (should (= (count-lines (point-min) (point-max)) 1))
- (kill-buffer buf))))
+ (package-list-packages)
+ (revert-buffer)
+ (search-forward-regexp "^ +simple-single")
+ (package-menu-mark-install)
+ (package-menu-filter-marked)
+ (goto-char (point-min))
+ (should (re-search-forward "^I +simple-single" nil t))
+ (should (= (count-lines (point-min) (point-max)) 1))
+ (package-menu-mark-unmark)
+ ;; No marked packages in default environment.
+ (should-error (package-menu-filter-marked))))
+
+(ert-deftest package-test-list-filter-by-version ()
+ (with-package-menu-test
+ (should-error (package-menu-filter-by-version "1.1" 'unknown-symbol))) )
+
+(defun package-test-filter-by-version (version predicate name)
+ (with-package-menu-test
+ (package-menu-filter-by-version version predicate)
+ (goto-char (point-min))
+ ;; We just check that the given package is included in the
+ ;; listing. One could be more ambitious.
+ (should (re-search-forward name))))
+
+(ert-deftest package-test-list-filter-by-version-= ()
+ "Ensure package list is filtered correctly by package version (=)."
+ (package-test-filter-by-version "1.1" '= "^\\s-+simple-two-depend"))
+
+(ert-deftest package-test-list-filter-by-version-< ()
+ "Ensure package list is filtered correctly by package version (<)."
+ (package-test-filter-by-version "1.2" '< "^\\s-+simple-two-depend"))
+
+(ert-deftest package-test-list-filter-by-version-> ()
+ "Ensure package list is filtered correctly by package version (>)."
+ (package-test-filter-by-version "1.0" '> "^\\s-+simple-two-depend"))
(ert-deftest package-test-list-clear-filter ()
"Ensure package list filter is cleared correctly."
- (with-package-test ()
- (let ((buf (package-list-packages)))
- (let ((num-packages (count-lines (point-min) (point-max))))
- (should (> num-packages 1))
- (package-menu-filter-by-name "tetris")
- (should (= (count-lines (point-min) (point-max)) 1))
- (package-menu-clear-filter)
- (should (= (count-lines (point-min) (point-max)) num-packages)))
- (kill-buffer buf))))
+ (with-package-menu-test
+ (let ((num-packages (count-lines (point-min) (point-max))))
+ (package-menu-filter-by-name "tetris")
+ (should (= (count-lines (point-min) (point-max)) 1))
+ (package-menu-clear-filter)
+ (should (= (count-lines (point-min) (point-max)) num-packages)))))
(ert-deftest package-test-update-archives ()
"Test updating package archives."
(with-package-test ()
- (let ((buf (package-list-packages)))
+ (let ((_buf (package-list-packages)))
(revert-buffer)
(search-forward-regexp "^ +simple-single")
(package-menu-mark-install)
@@ -419,6 +492,7 @@ Must called from within a `tar-mode' buffer."
(ert-deftest package-test-update-archives-async ()
"Test updating package archives asynchronously."
+ :tags '(:expensive-test)
(skip-unless (executable-find "python2"))
(let* ((package-menu-async t)
(default-directory package-test-data-dir)
@@ -537,6 +611,7 @@ Must called from within a `tar-mode' buffer."
(should (search-forward "This is a bare-bones readme file for the multi-file"
nil t)))))
+(defvar epg-config--program-alist) ; Silence byte-compiler.
(ert-deftest package-test-signed ()
"Test verifying package signature."
(skip-unless (let ((homedir (make-temp-file "package-test" t)))
@@ -577,8 +652,8 @@ Must called from within a `tar-mode' buffer."
(should (progn (package-install 'signed-good) 'noerror))
(should (progn (package-install 'signed-bad) 'noerror)))
;; Check if the installed package status is updated.
- (let ((buf (package-list-packages)))
- (revert-buffer)
+ (let ((_buf (package-list-packages)))
+ (revert-buffer)
(should (re-search-forward
"^\\s-+signed-good\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-"
nil t))
@@ -731,4 +806,4 @@ Must called from within a `tar-mode' buffer."
(provide 'package-test)
-;;; package-test.el ends here
+;;; package-tests.el ends here
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index 0b69bd99f32..ac512416b71 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -1,4 +1,4 @@
-;;; pcase-tests.el --- Test suite for pcase macro.
+;;; pcase-tests.el --- Test suite for pcase macro. -*- lexical-binding:t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/emacs-lisp/regexp-opt-tests.el b/test/lisp/emacs-lisp/regexp-opt-tests.el
index 0179ac4f1f4..ff93b8b759e 100644
--- a/test/lisp/emacs-lisp/regexp-opt-tests.el
+++ b/test/lisp/emacs-lisp/regexp-opt-tests.el
@@ -25,27 +25,14 @@
(require 'regexp-opt)
-(defun regexp-opt-test--permutation (n list)
- "The Nth permutation of LIST, 0 ≤ N < (length LIST)!."
- (let ((len (length list))
- (perm-list nil))
- (dotimes (i len)
- (let* ((d (- len i))
- (k (mod n d)))
- (push (nth k list) perm-list)
- (setq list (append (butlast list (- (length list) k))
- (nthcdr (1+ k) list)))
- (setq n (/ n d))))
- (nreverse perm-list)))
-
-(defun regexp-opt-test--factorial (n)
- "N!"
- (apply #'* (number-sequence 1 n)))
-
-(defun regexp-opt-test--permutations (list)
- "All permutations of LIST."
- (mapcar (lambda (i) (regexp-opt-test--permutation i list))
- (number-sequence 0 (1- (regexp-opt-test--factorial (length list))))))
+(defun regexp-opt-test--permutations (l)
+ "All permutations of L, assuming no duplicates."
+ (if (cdr l)
+ (mapcan (lambda (x)
+ (mapcar (lambda (p) (cons x p))
+ (regexp-opt-test--permutations (remove x l))))
+ l)
+ (list l)))
(ert-deftest regexp-opt-longest-match ()
"Check that the regexp always matches as much as possible."
diff --git a/test/lisp/emacs-lisp/rmc-tests.el b/test/lisp/emacs-lisp/rmc-tests.el
index 5dee206e931..5add24c479a 100644
--- a/test/lisp/emacs-lisp/rmc-tests.el
+++ b/test/lisp/emacs-lisp/rmc-tests.el
@@ -5,18 +5,20 @@
;; Author: Tino Calancha <tino.calancha@gmail.com>
;; 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 <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/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index 0fece4004bd..3b01d89dbab 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -56,13 +56,17 @@
(ert-deftest rx-def-in-or ()
(rx-let ((a b)
(b (or "abc" c))
- (c ?a))
+ (c ?a)
+ (d (any "a-z")))
(should (equal (rx (or a (| "ab" "abcde") "abcd"))
- "\\(?:a\\(?:b\\(?:c\\(?:de?\\)?\\)?\\)?\\)"))))
+ "\\(?:a\\(?:b\\(?:c\\(?:de?\\)?\\)?\\)?\\)"))
+ (should (equal (rx (or ?m (not d)))
+ "[^a-ln-z]"))))
(ert-deftest rx-char-any ()
"Test character alternatives with `]' and `-' (Bug#25123)."
(should (equal
+ ;; relint suppression: Range .<-]. overlaps previous .]-{
(rx string-start (1+ (char (?\] . ?\{) (?< . ?\]) (?- . ?:)))
string-end)
"\\`[.-:<-{-]+\\'")))
@@ -127,8 +131,12 @@
"[[:lower:][:upper:]-][^[:lower:][:upper:]-]"))
(should (equal (rx (any "]" lower upper) (not (any "]" lower upper)))
"[][:lower:][:upper:]][^][:lower:][:upper:]]"))
- (should (equal (rx (any "-a" "c-" "f-f" "--/*--"))
- "[*-/acf]"))
+ ;; relint suppression: Duplicated character .-.
+ ;; relint suppression: Single-character range .f-f
+ ;; relint suppression: Range .--/. overlaps previous .-
+ ;; relint suppression: Range .\*--. overlaps previous .--/
+ (should (equal (rx (any "-a" "c-" "f-f" "--/*--") (any "," "-" "A"))
+ "[*-/acf][,A-]"))
(should (equal (rx (any "]-a" ?-) (not (any "]-a" ?-)))
"[]-a-][^]-a-]"))
(should (equal (rx (any "--]") (not (any "--]"))
@@ -140,6 +148,7 @@
"\\`a\\`[^z-a]"))
(should (equal (rx (any "") (not (any "")))
"\\`a\\`[^z-a]"))
+ ;; relint suppression: Duplicated class .space.
(should (equal (rx (any space ?a digit space))
"[a[:space:][:digit:]]"))
(should (equal (rx (not "\n") (not ?\n) (not (any "\n")) (not-char ?\n)
@@ -388,6 +397,8 @@
"ab")))
(ert-deftest rx-literal ()
+ (should (equal (rx (literal "$a"))
+ "\\$a"))
(should (equal (rx (literal (char-to-string 42)) nonl)
"\\*."))
(let ((x "a+b"))
diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el
index 77ee4f5c38d..a6a80952360 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -1,4 +1,4 @@
-;;; seq-tests.el --- Tests for sequences.el
+;;; seq-tests.el --- Tests for seq.el -*- lexical-binding:t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
@@ -126,7 +126,7 @@ Evaluate BODY for each created sequence.
(with-test-sequences (seq '(6 7 8 9 10))
(should (equal (seq-filter #'test-sequences-evenp seq) '(6 8 10)))
(should (equal (seq-filter #'test-sequences-oddp seq) '(7 9)))
- (should (equal (seq-filter (lambda (elt) nil) seq) '())))
+ (should (equal (seq-filter (lambda (_) nil) seq) '())))
(with-test-sequences (seq '())
(should (equal (seq-filter #'test-sequences-evenp seq) '()))))
@@ -134,7 +134,7 @@ Evaluate BODY for each created sequence.
(with-test-sequences (seq '(6 7 8 9 10))
(should (equal (seq-remove #'test-sequences-evenp seq) '(7 9)))
(should (equal (seq-remove #'test-sequences-oddp seq) '(6 8 10)))
- (should (same-contents-p (seq-remove (lambda (elt) nil) seq) seq)))
+ (should (same-contents-p (seq-remove (lambda (_) nil) seq) seq)))
(with-test-sequences (seq '())
(should (equal (seq-remove #'test-sequences-evenp seq) '()))))
@@ -142,7 +142,7 @@ Evaluate BODY for each created sequence.
(with-test-sequences (seq '(6 7 8 9 10))
(should (equal (seq-count #'test-sequences-evenp seq) 3))
(should (equal (seq-count #'test-sequences-oddp seq) 2))
- (should (equal (seq-count (lambda (elt) nil) seq) 0)))
+ (should (equal (seq-count (lambda (_) nil) seq) 0)))
(with-test-sequences (seq '())
(should (equal (seq-count #'test-sequences-evenp seq) 0))))
@@ -199,7 +199,7 @@ Evaluate BODY for each created sequence.
(ert-deftest test-seq-every-p ()
(with-test-sequences (seq '(43 54 22 1))
- (should (seq-every-p (lambda (elt) t) seq))
+ (should (seq-every-p (lambda (_) t) seq))
(should-not (seq-every-p #'test-sequences-oddp seq))
(should-not (seq-every-p #'test-sequences-evenp seq)))
(with-test-sequences (seq '(42 54 22 2))
diff --git a/test/lisp/emacs-lisp/shadow-resources/p1/foo.el b/test/lisp/emacs-lisp/shadow-resources/p1/foo.el
index 465038bee5e..ffe68f9356f 100644
--- a/test/lisp/emacs-lisp/shadow-resources/p1/foo.el
+++ b/test/lisp/emacs-lisp/shadow-resources/p1/foo.el
@@ -1 +1 @@
-;;; This file intentionally left blank.
+;;; This file intentionally left blank. -*- lexical-binding:t -*-
diff --git a/test/lisp/emacs-lisp/shadow-resources/p2/FOO.el b/test/lisp/emacs-lisp/shadow-resources/p2/FOO.el
index 465038bee5e..ffe68f9356f 100644
--- a/test/lisp/emacs-lisp/shadow-resources/p2/FOO.el
+++ b/test/lisp/emacs-lisp/shadow-resources/p2/FOO.el
@@ -1 +1 @@
-;;; This file intentionally left blank.
+;;; This file intentionally left blank. -*- lexical-binding:t -*-
diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el
index 220ce0c08f0..9d14a5ab7ec 100644
--- a/test/lisp/emacs-lisp/subr-x-tests.el
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -1,22 +1,24 @@
-;;; subr-x-tests.el --- Testing the extended lisp routines
+;;; subr-x-tests.el --- Testing the extended lisp routines -*- lexical-binding:t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
;; Author: Fabián E. Gallina <fgallina@gnu.org>
;; 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 <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/syntax-tests.el b/test/lisp/emacs-lisp/syntax-tests.el
new file mode 100644
index 00000000000..9d4c4113fdd
--- /dev/null
+++ b/test/lisp/emacs-lisp/syntax-tests.el
@@ -0,0 +1,67 @@
+;;; syntax-tests.el --- tests for syntax.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'syntax)
+
+(ert-deftest syntax-propertize--shift-groups-and-backrefs ()
+ "Test shifting of numbered groups and back-references in regexps."
+ ;; A numbered group must be shifted.
+ (should
+ (string=
+ (syntax-propertize--shift-groups-and-backrefs
+ "\\(?2:[abc]+\\)foobar" 2)
+ "\\(?4:[abc]+\\)foobar"))
+ ;; A back-reference \1 on a normal sub-regexp context must be
+ ;; shifted.
+ (should
+ (string=
+ (syntax-propertize--shift-groups-and-backrefs "\\(a\\)\\1" 2)
+ "\\(a\\)\\3"))
+ ;; Shifting must not happen if the \1 appears in a character class,
+ ;; or in a \{\} repetition construct (although \1 isn't valid there
+ ;; anyway).
+ (let ((rx-with-class "\\(a\\)[\\1-2]")
+ (rx-with-rep "\\(a\\)\\{1,\\1\\}"))
+ (should
+ (string=
+ (syntax-propertize--shift-groups-and-backrefs rx-with-class 2)
+ rx-with-class))
+ (should
+ (string=
+ (syntax-propertize--shift-groups-and-backrefs rx-with-rep 2)
+ rx-with-rep)))
+ ;; Now numbered groups and back-references in combination.
+ (should
+ (string=
+ (syntax-propertize--shift-groups-and-backrefs
+ "\\(?2:[abc]+\\)foo\\(\\2\\)" 2)
+ "\\(?4:[abc]+\\)foo\\(\\4\\)"))
+ ;; Emacs supports only the back-references \1,...,\9, so when a
+ ;; shift would result in \10 or more, an error must be signalled.
+ (should-error
+ (syntax-propertize--shift-groups-and-backrefs "\\(a\\)\\3" 7)))
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+;;; syntax-tests.el ends here.
diff --git a/test/lisp/emacs-lisp/text-property-search-tests.el b/test/lisp/emacs-lisp/text-property-search-tests.el
index 26b89b72312..83d4b95b76b 100644
--- a/test/lisp/emacs-lisp/text-property-search-tests.el
+++ b/test/lisp/emacs-lisp/text-property-search-tests.el
@@ -1,22 +1,24 @@
-;;; text-property-search-tests.el --- Testing text-property-search
+;;; text-property-search-tests.el --- Testing text-property-search -*- lexical-binding:t -*-
;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
;; Author: Lars Ingebrigtsen <larsi@gnus.org>
;; 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 <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/tcover-unsafep.el b/test/lisp/emacs-lisp/unsafep-tests.el
index 108dee3d95d..2b920a00ca4 100644
--- a/lisp/emacs-lisp/tcover-unsafep.el
+++ b/test/lisp/emacs-lisp/unsafep-tests.el
@@ -1,10 +1,8 @@
-;;;; testcover-unsafep.el -- Use testcover to test unsafep's code coverage
-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;;; unsafep-tests.el --- tests for unsafep.el -*- lexical-binding: t; -*-
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
-;; Keywords: safety lisp utility
-;; Package: testcover
+
+;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -21,18 +19,19 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-(require 'testcover)
+;;; Code:
+
+(require 'ert)
+(require 'unsafep)
(defvar safe-functions)
-;;;These forms are all considered safe
+;;; These forms are all considered safe
(defconst testcover-unsafep-safe
'(((lambda (x) (* x 2)) 14)
(apply 'cdr (mapcar (lambda (x) (car x)) y))
(cond ((= x 4) 5) (t 27))
(condition-case x (car y) (error (car x)))
- (dolist (x y) (message "here: %s" x))
- (dotimes (x 14 (* x 2)) (message "here: %d" x))
(let (x) (dolist (y '(1 2 3) (1+ y)) (push y x)))
(let (x) (apply (lambda (x) (* x 2)) 14))
(let ((x '(2))) (push 1 x) (pop x) (add-to-list 'x 2))
@@ -47,7 +46,7 @@
(propertize "x" 'display '(height (progn (delete-file "x") 1))))
"List of forms that `unsafep' should decide are safe.")
-;;;These forms are considered unsafe
+;;; These forms are considered unsafe
(defconst testcover-unsafep-unsafe
'(( (add-to-list x y)
. (unquoted x))
@@ -109,32 +108,37 @@
)
"A-list of (FORM . REASON)... that`unsafep' should decide are unsafe.")
-(declare-function unsafep-function "unsafep" (fun))
-
-;;;#########################################################################
-(defun testcover-unsafep ()
+(ert-deftest test-unsafep/safe ()
"Executes all unsafep tests and displays the coverage results."
- (interactive)
- (testcover-unmark-all "unsafep.el")
- (testcover-start "unsafep.el")
- (let (save-functions)
+ (let (safe-functions)
(dolist (x testcover-unsafep-safe)
- (if (unsafep x)
- (error "%S should be safe" x)))
+ (should-not (unsafep x)))))
+
+(ert-deftest test-unsafep/message ()
+ ;; FIXME: This failed after converting these tests from testcover to
+ ;; ert.
+ :expected-result :failed
+ (should-not '(dolist (x y) (message "here: %s" x)))
+ (should-not '(dotimes (x 14 (* x 2)) (message "here: %d" x))))
+
+(ert-deftest test-unsafep/unsafe ()
+ "Executes all unsafep tests and displays the coverage results."
+ (let (safe-functions)
(dolist (x testcover-unsafep-unsafe)
- (if (not (equal (unsafep (car x)) (cdr x)))
- (error "%S should be unsafe: %s" (car x) (cdr x))))
- (setq safe-functions t)
- (if (or (unsafep '(delete-file "x"))
- (unsafep-function 'delete-file))
- (error "safe-functions=t should allow delete-file"))
- (setq safe-functions '(setcar))
- (if (unsafep '(setcar x 1))
- (error "safe-functions=(setcar) should allow setcar"))
- (if (not (unsafep '(setcdr x 1)))
- (error "safe-functions=(setcar) should not allow setcdr")))
- (testcover-mark-all "unsafep.el")
- (testcover-end "unsafep.el")
- (message "Done"))
-
-;; testcover-unsafep.el ends here.
+ (should (equal (unsafep (car x)) (cdr x))))))
+
+(ert-deftest test-unsafep/safe-functions-t ()
+ "safe-functions=t should allow delete-file"
+ (let ((safe-functions t))
+ (should-not (unsafep '(delete-file "x")))
+ (should-not (unsafep-function 'delete-file))))
+
+(ert-deftest test-unsafep/safe-functions-setcar ()
+ "safe-functions=(setcar) should allow setcar but not setcdr"
+ (let ((safe-functions '(setcar)))
+ (should-not (unsafep '(setcar x 1)))
+ (should (unsafep '(setcdr x 1)))))
+
+(provide 'unsafep-tests)
+
+;;; unsafep-tests.el ends here
diff --git a/test/lisp/emacs-lisp/warnings-tests.el b/test/lisp/emacs-lisp/warnings-tests.el
new file mode 100644
index 00000000000..02c09b41ca5
--- /dev/null
+++ b/test/lisp/emacs-lisp/warnings-tests.el
@@ -0,0 +1,60 @@
+;;; warnings-tests.el --- tests for warnings.el -*- lexical-binding: t; -*-
+
+;; Author: Stefan Kangas <stefankangas@gmail.com>
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'warnings)
+
+(ert-deftest test-warning-suppress-p ()
+ (should (warning-suppress-p 'foo '((foo))))
+ (should (warning-suppress-p '(foo bar) '((foo bar))))
+ (should (warning-suppress-p '(foo bar baz) '((foo bar))))
+ (should-not (warning-suppress-p '(foo bar baz) '((foo bax))))
+ (should-not (warning-suppress-p 'foobar nil)))
+
+(ert-deftest test-display-warning ()
+ (dolist (level '(:emergency :error :warning))
+ (with-temp-buffer
+ (display-warning '(foo) "Hello123" level (current-buffer))
+ (should (string-match "foo" (buffer-string)))
+ (should (string-match "Hello123" (buffer-string))))
+ (with-current-buffer "*Messages*"
+ (should (string-match "Hello123" (buffer-string))))))
+
+(ert-deftest test-display-warning/warning-minimum-level ()
+ ;; This test only works interactively:
+ :expected-result :failed
+ (let ((warning-minimum-level :emergency))
+ (with-temp-buffer
+ (display-warning '(foo) "baz" :warning (current-buffer)))
+ (with-current-buffer "*Messages*"
+ (should-not (string-match "baz" (buffer-string))))))
+
+(ert-deftest test-display-warning/warning-minimum-log-level ()
+ (let ((warning-minimum-log-level :error))
+ (with-temp-buffer
+ (display-warning '(foo) "hello" :warning (current-buffer))
+ (should-not (string-match "hello" (buffer-string))))))
+
+(provide 'warnings-tests)
+
+;;; warnings-tests.el ends here
diff --git a/test/lisp/emulation/viper-tests.el b/test/lisp/emulation/viper-tests.el
index 33f85e51254..b981938fe19 100644
--- a/test/lisp/emulation/viper-tests.el
+++ b/test/lisp/emulation/viper-tests.el
@@ -1,4 +1,4 @@
-;;; viper-tests.el --- tests for viper.
+;;; viper-tests.el --- tests for viper. -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
new file mode 100644
index 00000000000..27f48fa8131
--- /dev/null
+++ b/test/lisp/erc/erc-tests.el
@@ -0,0 +1,47 @@
+;;; erc-tests.el --- Tests for erc. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Lars Ingebrigtsen <larsi@gnus.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'erc)
+
+(ert-deftest erc--read-time-period ()
+ (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "")))
+ (should (equal (erc--read-time-period "foo: ") nil)))
+
+ (cl-letf (((symbol-function 'read-string) (lambda (&rest _) " ")))
+ (should (equal (erc--read-time-period "foo: ") nil)))
+
+ (cl-letf (((symbol-function 'read-string) (lambda (&rest _) " 432 ")))
+ (should (equal (erc--read-time-period "foo: ") 432)))
+
+ (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "432")))
+ (should (equal (erc--read-time-period "foo: ") 432)))
+
+ (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1h")))
+ (should (equal (erc--read-time-period "foo: ") 3600)))
+
+ (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1h10s")))
+ (should (equal (erc--read-time-period "foo: ") 3610)))
+
+ (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d")))
+ (should (equal (erc--read-time-period "foo: ") 86400))))
diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el
index b0ed4bbcb67..457f08cb73c 100644
--- a/test/lisp/erc/erc-track-tests.el
+++ b/test/lisp/erc/erc-track-tests.el
@@ -1,4 +1,4 @@
-;;; erc-track-tests.el --- Tests for erc-track.
+;;; erc-track-tests.el --- Tests for erc-track. -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
@@ -107,8 +107,8 @@
(ert-deftest erc-track--erc-faces-in ()
"`erc-faces-in' should pick up both 'face and 'font-lock-face properties."
- (let ((str0 "is bold")
- (str1 "is bold"))
+ (let ((str0 (copy-sequence "is bold"))
+ (str1 (copy-sequence "is bold")))
;; Turn on Font Lock mode: this initialize `char-property-alias-alist'
;; to '((face font-lock-face)). Note that `font-lock-mode' don't
;; turn on the mode if the test is run on batch mode or if the
diff --git a/test/lisp/eshell/em-hist-tests.el b/test/lisp/eshell/em-hist-tests.el
index a08a7a2afcb..5bb16f64a46 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
+;;; tests/em-hist-tests.el --- em-hist test suite -*- lexical-binding:t -*-
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/eshell/em-ls-tests.el b/test/lisp/eshell/em-ls-tests.el
index da3e224a94d..975701e3838 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
+;;; tests/em-ls-tests.el --- em-ls test suite -*- lexical-binding:t -*-
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/eshell/esh-opt-tests.el b/test/lisp/eshell/esh-opt-tests.el
index af6c089c16b..caba153cf73 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
+;;; tests/esh-opt-tests.el --- esh-opt test suite -*- lexical-binding:t -*-
;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el
index 70694309443..1b93fb0fbbc 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
+;;; tests/eshell-tests.el --- Eshell test suite -*- lexical-binding:t -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -61,6 +61,8 @@
(eshell-insert-command text func)
(eshell-match-result regexp))
+(defvar eshell-history-file-name)
+
(defun eshell-test-command-result (command)
"Like `eshell-command-result', but not using HOME."
(let ((eshell-directory-name (make-temp-file "eshell" t))
@@ -170,6 +172,13 @@ e.g. \"{(+ 1 2)} 3\" => 3"
(eshell-command-result-p "+ 1 2; + $_ 4"
"3\n6\n")))
+(ert-deftest eshell-test/inside-emacs-var ()
+ "Test presence of \"INSIDE_EMACS\" in subprocesses"
+ (with-temp-eshell
+ (eshell-command-result-p "env"
+ (format "INSIDE_EMACS=%s,eshell"
+ emacs-version))))
+
(ert-deftest eshell-test/escape-nonspecial ()
"Test that \"\\c\" and \"c\" are equivalent when \"c\" is not a
special character."
diff --git a/test/lisp/faces-tests.el b/test/lisp/faces-tests.el
index d5dc19349a4..32dc1eea856 100644
--- a/test/lisp/faces-tests.el
+++ b/test/lisp/faces-tests.el
@@ -5,18 +5,20 @@
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; 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 <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el
index eaf39680e48..e8c12669c1a 100644
--- a/test/lisp/ffap-tests.el
+++ b/test/lisp/ffap-tests.el
@@ -74,9 +74,49 @@ left alone when opening a URL in an external browser."
(urls nil)
(ffap-url-fetcher (lambda (url) (push url urls) nil)))
(should-not (ffap-other-window "https://www.gnu.org"))
- (should (equal (current-window-configuration) old))
+ (should (compare-window-configurations (current-window-configuration) old))
(should (equal urls '("https://www.gnu.org")))))
+(defun ffap-test-string (space string)
+ (let ((ffap-file-name-with-spaces space))
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (forward-char 10)
+ (ffap-string-at-point))))
+
+(ert-deftest ffap-test-with-spaces ()
+ (should
+ (equal
+ (ffap-test-string
+ t "c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program here.txt")
+ "/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program here.txt"))
+ (should
+ (equal
+ (ffap-test-string
+ nil "c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program here.txt")
+ "c:/Program"))
+ (should
+ (equal
+ (ffap-test-string
+ t "c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program Files/Hummingbird/")
+ "/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program Files/Hummingbird/"))
+ (should
+ (equal
+ (ffap-test-string
+ t "c:\\Program Files\\Open Text Evaluation Media\\Open Text Exceed 14 x86\\Program Files\\Hummingbird\\")
+ "\\Program Files\\Open Text Evaluation Media\\Open Text Exceed 14 x86\\Program Files\\Hummingbird\\"))
+ (should
+ (equal
+ (ffap-test-string
+ t "c:\\Program Files\\Freescale\\CW for MPC55xx and MPC56xx 2.10\\PowerPC_EABI_Tools\\Command_Line_Tools\\CLT_Usage_Notes.txt")
+ "\\Program Files\\Freescale\\CW for MPC55xx and MPC56xx 2.10\\PowerPC_EABI_Tools\\Command_Line_Tools\\CLT_Usage_Notes.txt"))
+ (should
+ (equal
+ (ffap-test-string
+ t "C:\\temp\\program.log on Windows or /var/log/program.log on Unix.")
+ "\\temp\\program.log")))
+
(provide 'ffap-tests)
;;; ffap-tests.el ends here
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index e9dc7532d59..47ed661ebf8 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -200,8 +200,7 @@ Return nil when any other file notification watch is still active."
(setq file-notify-debug nil
password-cache-expiry nil
- tramp-verbose 0
- tramp-message-show-message nil)
+ tramp-verbose 0)
;; This should happen on hydra only.
(when (getenv "EMACS_HYDRA_CI")
@@ -220,7 +219,8 @@ remote case we return always t."
(or file-notify--library
(file-remote-p temporary-file-directory)))
-(defvar file-notify--test-remote-enabled-checked nil
+(defvar file-notify--test-remote-enabled-checked
+ (if (getenv "EMACS_HYDRA_CI") '(t . nil))
"Cached result of `file-notify--test-remote-enabled'.
If the function did run, the value is a cons cell, the `cdr'
being the result.")
@@ -611,6 +611,7 @@ delivered."
(ert-deftest file-notify-test03-events ()
"Check file creation/change/removal notifications."
+ :tags '(:expensive-test)
(skip-unless (file-notify--test-local-enabled))
(unwind-protect
@@ -772,9 +773,9 @@ delivered."
(copy-file file-notify--test-tmpfile file-notify--test-tmpfile1)
;; The next two events shall not be visible.
(file-notify--test-read-event)
- (set-file-modes file-notify--test-tmpfile 000)
+ (set-file-modes file-notify--test-tmpfile 000 'nofollow)
(file-notify--test-read-event)
- (set-file-times file-notify--test-tmpfile '(0 0))
+ (set-file-times file-notify--test-tmpfile '(0 0) 'nofollow)
(file-notify--test-read-event)
(delete-directory file-notify--test-tmpdir 'recursive))
(file-notify-rm-watch file-notify--test-desc)
@@ -865,9 +866,9 @@ delivered."
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
(file-notify--test-read-event)
- (set-file-modes file-notify--test-tmpfile 000)
+ (set-file-modes file-notify--test-tmpfile 000 'nofollow)
(file-notify--test-read-event)
- (set-file-times file-notify--test-tmpfile '(0 0))
+ (set-file-times file-notify--test-tmpfile '(0 0) 'nofollow)
(file-notify--test-read-event)
(delete-file file-notify--test-tmpfile))
(file-notify-rm-watch file-notify--test-desc)
@@ -888,6 +889,7 @@ delivered."
(ert-deftest file-notify-test04-autorevert ()
"Check autorevert via file notification."
+ :tags '(:expensive-test)
(skip-unless (file-notify--test-local-enabled))
;; `auto-revert-buffers' runs every 5". And we must wait, until the
@@ -929,17 +931,18 @@ delivered."
;; Modify file. We wait for a second, in order to have
;; another timestamp.
(ert-with-message-capture captured-messages
- (sleep-for 1)
- (write-region
- "another text" nil file-notify--test-tmpfile nil 'no-message)
-
- ;; Check, that the buffer has been reverted.
- (file-notify--test-wait-for-events
- timeout
- (string-match
- (format-message "Reverting buffer `%s'." (buffer-name buf))
- captured-messages))
- (should (string-match "another text" (buffer-string))))
+ (let ((inhibit-message t))
+ (sleep-for 1)
+ (write-region
+ "another text" nil file-notify--test-tmpfile nil 'no-message)
+
+ ;; Check, that the buffer has been reverted.
+ (file-notify--test-wait-for-events
+ timeout
+ (string-match
+ (format-message "Reverting buffer `%s'." (buffer-name buf))
+ captured-messages))
+ (should (string-match "another text" (buffer-string)))))
;; Stop file notification. Autorevert shall still work via polling.
(file-notify-rm-watch auto-revert-notify-watch-descriptor)
@@ -953,17 +956,18 @@ delivered."
;; have another timestamp. One second seems to be too
;; short. And Cygwin sporadically requires more than two.
(ert-with-message-capture captured-messages
- (sleep-for (if (eq system-type 'cygwin) 3 2))
- (write-region
- "foo bla" nil file-notify--test-tmpfile nil 'no-message)
-
- ;; Check, that the buffer has been reverted.
- (file-notify--test-wait-for-events
- timeout
- (string-match
- (format-message "Reverting buffer `%s'." (buffer-name buf))
- captured-messages))
- (should (string-match "foo bla" (buffer-string))))
+ (let ((inhibit-message t))
+ (sleep-for (if (eq system-type 'cygwin) 3 2))
+ (write-region
+ "foo bla" nil file-notify--test-tmpfile nil 'no-message)
+
+ ;; Check, that the buffer has been reverted.
+ (file-notify--test-wait-for-events
+ timeout
+ (string-match
+ (format-message "Reverting buffer `%s'." (buffer-name buf))
+ captured-messages))
+ (should (string-match "foo bla" (buffer-string)))))
;; Stop autorevert, in order to cleanup descriptor.
(auto-revert-mode -1))
@@ -981,6 +985,7 @@ delivered."
(ert-deftest file-notify-test05-file-validity ()
"Check `file-notify-valid-p' for files."
+ :tags '(:expensive-test)
(skip-unless (file-notify--test-local-enabled))
(unwind-protect
@@ -1233,6 +1238,7 @@ delivered."
(ert-deftest file-notify-test08-backup ()
"Check that backup keeps file notification."
+ :tags '(:expensive-test)
(skip-unless (file-notify--test-local-enabled))
(unwind-protect
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 11e1f4db794..1b964af6887 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -190,7 +190,6 @@ form.")
(ert-deftest files-tests-bug-21454 ()
"Test for https://debbugs.gnu.org/21454 ."
- :expected-result :failed
(let ((input-result
'(("/foo/bar//baz/:/bar/foo/baz//" nil ("/foo/bar/baz/" "/bar/foo/baz/"))
("/foo/bar/:/bar/qux/:/qux/foo" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
@@ -1003,9 +1002,9 @@ unquoted file names."
(ert-deftest files-tests-file-name-non-special-set-file-times ()
(files-tests--with-temp-non-special (tmpfile nospecial)
- (set-file-times nospecial))
+ (set-file-times nospecial nil 'nofollow))
(files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial)
- (should-error (set-file-times nospecial))))
+ (should-error (set-file-times nospecial nil 'nofollow))))
(ert-deftest files-tests-file-name-non-special-set-visited-file-modtime ()
(files-tests--with-temp-non-special (tmpfile nospecial)
@@ -1164,6 +1163,42 @@ works as expected if the default directory is quoted."
(should-not (make-directory a/b t))
(delete-directory dir 'recursive)))
+(ert-deftest files-tests-file-modes-symbolic-to-number ()
+ (let ((alist (list (cons "a=rwx" #o777)
+ (cons "o=t" #o1000)
+ (cons "o=xt" #o1001)
+ (cons "o=tx" #o1001) ; Order doesn't matter.
+ (cons "u=rwx,g=rx,o=rx" #o755)
+ (cons "u=rwx,g=,o=" #o700)
+ (cons "u=rwx" #o700) ; Empty permissions can be ignored.
+ (cons "u=rw,g=r,o=r" #o644)
+ (cons "u=rw,g=r,o=t" #o1640)
+ (cons "u=rw,g=r,o=xt" #o1641)
+ (cons "u=rwxs,g=rs,o=xt" #o7741)
+ (cons "u=rws,g=rs,o=t" #o7640)
+ (cons "u=rws,g=rs,o=r" #o6644)
+ (cons "a=r" #o444)
+ (cons "u=S" nil)
+ (cons "u=T" nil)
+ (cons "u=Z" nil))))
+ (dolist (x alist)
+ (if (cdr-safe x)
+ (should (equal (cdr x) (file-modes-symbolic-to-number (car x))))
+ (should-error (file-modes-symbolic-to-number (car x)))))))
+
+(ert-deftest files-tests-file-modes-number-to-symbolic ()
+ (let ((alist (list (cons #o755 "-rwxr-xr-x")
+ (cons #o700 "-rwx------")
+ (cons #o644 "-rw-r--r--")
+ (cons #o1640 "-rw-r----T")
+ (cons #o1641 "-rw-r----t")
+ (cons #o7741 "-rwsr-S--t")
+ (cons #o7640 "-rwSr-S--T")
+ (cons #o6644 "-rwSr-Sr--")
+ (cons #o444 "-r--r--r--"))))
+ (dolist (x alist)
+ (should (equal (cdr x) (file-modes-number-to-symbolic (car x)))))))
+
(ert-deftest files-tests-no-file-write-contents ()
"Test that `write-contents-functions' permits saving a file.
Usually `basic-save-buffer' will prompt for a file name if the
@@ -1326,5 +1361,75 @@ See <https://debbugs.gnu.org/36401>."
(normal-mode)
(should (not (eq major-mode 'text-mode))))))
+(ert-deftest files-colon-path ()
+ (should (equal (parse-colon-path "/foo//bar/baz")
+ '("/foo/bar/baz/"))))
+
+(ert-deftest files-test-magic-mode-alist-doctype ()
+ "Test that DOCTYPE and variants put files in mhtml-mode."
+ (with-temp-buffer
+ (goto-char (point-min))
+ (insert "<!DOCTYPE html>")
+ (normal-mode)
+ (should (eq major-mode 'mhtml-mode))
+ (erase-buffer)
+ (insert "<!doctype html>")
+ (normal-mode)
+ (should (eq major-mode 'mhtml-mode))))
+
+(defvar files-tests-lao "The Way that can be told of is not the eternal Way;
+The name that can be named is not the eternal name.
+The Nameless is the origin of Heaven and Earth;
+The Named is the mother of all things.
+Therefore let there always be non-being,
+ so we may see their subtlety,
+And let there always be being,
+ so we may see their outcome.
+The two are the same,
+But after they are produced,
+ they have different names.
+")
+
+(defvar files-tests-tzu "The Nameless is the origin of Heaven and Earth;
+The named is the mother of all things.
+
+Therefore let there always be non-being,
+ so we may see their subtlety,
+And let there always be being,
+ so we may see their outcome.
+The two are the same,
+But after they are produced,
+ they have different names.
+They both may be called deep and profound.
+Deeper and more profound,
+The door of all subtleties!
+")
+
+(ert-deftest files-tests-revert-buffer ()
+ "Test that revert-buffer is successful."
+ (files-tests--with-temp-file temp-file-name
+ (with-temp-buffer
+ (insert files-tests-lao)
+ (write-file temp-file-name)
+ (erase-buffer)
+ (insert files-tests-tzu)
+ (revert-buffer t t t)
+ (should (compare-strings files-tests-lao nil nil
+ (buffer-substring (point-min) (point-max))
+ nil nil)))))
+
+(ert-deftest files-tests-revert-buffer-with-fine-grain ()
+ "Test that revert-buffer-with-fine-grain is successful."
+ (files-tests--with-temp-file temp-file-name
+ (with-temp-buffer
+ (insert files-tests-lao)
+ (write-file temp-file-name)
+ (erase-buffer)
+ (insert files-tests-tzu)
+ (should (revert-buffer-with-fine-grain t t))
+ (should (compare-strings files-tests-lao nil nil
+ (buffer-substring (point-min) (point-max))
+ nil nil)))))
+
(provide 'files-tests)
;;; files-tests.el ends here
diff --git a/test/lisp/format-spec-tests.el b/test/lisp/format-spec-tests.el
index 23ee88c5269..11882217afb 100644
--- a/test/lisp/format-spec-tests.el
+++ b/test/lisp/format-spec-tests.el
@@ -22,22 +22,145 @@
(require 'ert)
(require 'format-spec)
-(ert-deftest test-format-spec ()
+(ert-deftest format-spec-make ()
+ "Test `format-spec-make'."
+ (should-not (format-spec-make))
+ (should-error (format-spec-make ?b))
+ (should (equal (format-spec-make ?b "b") '((?b . "b"))))
+ (should-error (format-spec-make ?b "b" ?a))
+ (should (equal (format-spec-make ?b "b" ?a 'a)
+ '((?b . "b")
+ (?a . a)))))
+
+(ert-deftest format-spec-parse-flags ()
+ "Test `format-spec--parse-flags'."
+ (should-not (format-spec--parse-flags nil))
+ (should-not (format-spec--parse-flags ""))
+ (should (equal (format-spec--parse-flags "-") '(:pad-right)))
+ (should (equal (format-spec--parse-flags " 0") '(:pad-zero)))
+ (should (equal (format-spec--parse-flags " -x0y< >^_z ")
+ '(:pad-right :pad-zero :chop-left :chop-right
+ :upcase :downcase))))
+
+(ert-deftest format-spec-do-flags ()
+ "Test `format-spec--do-flags'."
+ (should (equal (format-spec--do-flags "" () nil nil) ""))
+ (dolist (flag '(:pad-zero :pad-right :upcase :downcase
+ :chop-left :chop-right))
+ (should (equal (format-spec--do-flags "" (list flag) nil nil) "")))
+ (should (equal (format-spec--do-flags "FOOBAR" '(:downcase :chop-right) 5 2)
+ " fo"))
+ (should (equal (format-spec--do-flags
+ "foobar" '(:pad-zero :pad-right :upcase :chop-left) 5 2)
+ "AR000")))
+
+(ert-deftest format-spec-do-flags-truncate ()
+ "Test `format-spec--do-flags' truncation."
+ (let (flags)
+ (should (equal (format-spec--do-flags "" flags nil 0) ""))
+ (should (equal (format-spec--do-flags "" flags nil 1) ""))
+ (should (equal (format-spec--do-flags "a" flags nil 0) ""))
+ (should (equal (format-spec--do-flags "a" flags nil 1) "a"))
+ (should (equal (format-spec--do-flags "a" flags nil 2) "a"))
+ (should (equal (format-spec--do-flags "asd" flags nil 0) ""))
+ (should (equal (format-spec--do-flags "asd" flags nil 1) "a")))
+ (let ((flags '(:chop-left)))
+ (should (equal (format-spec--do-flags "" flags nil 0) ""))
+ (should (equal (format-spec--do-flags "" flags nil 1) ""))
+ (should (equal (format-spec--do-flags "a" flags nil 0) ""))
+ (should (equal (format-spec--do-flags "a" flags nil 1) "a"))
+ (should (equal (format-spec--do-flags "a" flags nil 2) "a"))
+ (should (equal (format-spec--do-flags "asd" flags nil 0) ""))
+ (should (equal (format-spec--do-flags "asd" flags nil 1) "d"))))
+
+(ert-deftest format-spec-do-flags-pad ()
+ "Test `format-spec--do-flags' padding."
+ (let (flags)
+ (should (equal (format-spec--do-flags "" flags 0 nil) ""))
+ (should (equal (format-spec--do-flags "" flags 1 nil) " "))
+ (should (equal (format-spec--do-flags "a" flags 0 nil) "a"))
+ (should (equal (format-spec--do-flags "a" flags 1 nil) "a"))
+ (should (equal (format-spec--do-flags "a" flags 2 nil) " a")))
+ (let ((flags '(:pad-zero)))
+ (should (equal (format-spec--do-flags "" flags 0 nil) ""))
+ (should (equal (format-spec--do-flags "" flags 1 nil) "0"))
+ (should (equal (format-spec--do-flags "a" flags 0 nil) "a"))
+ (should (equal (format-spec--do-flags "a" flags 1 nil) "a"))
+ (should (equal (format-spec--do-flags "a" flags 2 nil) "0a")))
+ (let ((flags '(:pad-right)))
+ (should (equal (format-spec--do-flags "" flags 0 nil) ""))
+ (should (equal (format-spec--do-flags "" flags 1 nil) " "))
+ (should (equal (format-spec--do-flags "a" flags 0 nil) "a"))
+ (should (equal (format-spec--do-flags "a" flags 1 nil) "a"))
+ (should (equal (format-spec--do-flags "a" flags 2 nil) "a ")))
+ (let ((flags '(:pad-right :pad-zero)))
+ (should (equal (format-spec--do-flags "" flags 0 nil) ""))
+ (should (equal (format-spec--do-flags "" flags 1 nil) "0"))
+ (should (equal (format-spec--do-flags "a" flags 0 nil) "a"))
+ (should (equal (format-spec--do-flags "a" flags 1 nil) "a"))
+ (should (equal (format-spec--do-flags "a" flags 2 nil) "a0"))))
+
+(ert-deftest format-spec-do-flags-chop ()
+ "Test `format-spec--do-flags' chopping."
+ (let ((flags '(:chop-left)))
+ (should (equal (format-spec--do-flags "a" flags 0 nil) ""))
+ (should (equal (format-spec--do-flags "a" flags 1 nil) "a"))
+ (should (equal (format-spec--do-flags "asd" flags 0 nil) ""))
+ (should (equal (format-spec--do-flags "asd" flags 1 nil) "d")))
+ (let ((flags '(:chop-right)))
+ (should (equal (format-spec--do-flags "a" flags 0 nil) ""))
+ (should (equal (format-spec--do-flags "a" flags 1 nil) "a"))
+ (should (equal (format-spec--do-flags "asd" flags 0 nil) ""))
+ (should (equal (format-spec--do-flags "asd" flags 1 nil) "a"))))
+
+(ert-deftest format-spec-do-flags-case ()
+ "Test `format-spec--do-flags' case fiddling."
+ (dolist (flag '(:pad-zero :pad-right :chop-left :chop-right))
+ (let ((flags (list flag)))
+ (should (equal (format-spec--do-flags "a" flags nil nil) "a"))
+ (should (equal (format-spec--do-flags "A" flags nil nil) "A")))
+ (let ((flags (list flag :downcase)))
+ (should (equal (format-spec--do-flags "a" flags nil nil) "a"))
+ (should (equal (format-spec--do-flags "A" flags nil nil) "a")))
+ (let ((flags (list flag :upcase)))
+ (should (equal (format-spec--do-flags "a" flags nil nil) "A"))
+ (should (equal (format-spec--do-flags "A" flags nil nil) "A")))))
+
+(ert-deftest format-spec ()
+ (should (equal (format-spec "" ()) ""))
+ (should (equal (format-spec "a" ()) "a"))
+ (should (equal (format-spec "b" '((?b . "bar"))) "b"))
+ (should (equal (format-spec "%%%b%%b%b%%" '((?b . "bar"))) "%bar%bbar%"))
(should (equal (format-spec "foo %b zot" `((?b . "bar")))
"foo bar zot"))
(should (equal (format-spec "foo %-10b zot" '((?b . "bar")))
"foo bar zot"))
(should (equal (format-spec "foo %10b zot" '((?b . "bar")))
- "foo bar zot")))
+ "foo bar zot"))
+ (should (equal-including-properties
+ (format-spec (propertize "a" 'a 'b) '((?a . "foo")))
+ #("a" 0 1 (a b))))
+ (let ((fmt (concat (propertize "%a" 'a 'b)
+ (propertize "%%" 'c 'd)
+ "%b"
+ (propertize "%b" 'e 'f))))
+ (should (equal-including-properties
+ (format-spec fmt '((?b . "asd") (?a . "fgh")))
+ #("fgh%asdasd" 0 3 (a b) 3 4 (c d) 7 10 (e f))))))
-(ert-deftest test-format-unknown ()
+(ert-deftest format-spec-unknown ()
(should-error (format-spec "foo %b %z zot" '((?b . "bar"))))
+ (should-error (format-spec "foo %b %%%z zot" '((?b . "bar"))))
(should (equal (format-spec "foo %b %z zot" '((?b . "bar")) t)
"foo bar %z zot"))
- (should (equal (format-spec "foo %b %z %% zot" '((?b . "bar")) t)
- "foo bar %z %% zot")))
+ (should (equal (format-spec "foo %4b %%%4z %%4 zot" '((?b . "bar")) t)
+ "foo bar %%%4z %%4 zot"))
+ (should (equal (format-spec "foo %4b %%%4z %%4 zot" '((?b . "bar")) 'ignore)
+ "foo bar %%4z %4 zot"))
+ (should (equal (format-spec "foo %4b %%%4z %%4 zot" '((?b . "bar")) 'delete)
+ "foo bar % %4 zot")))
-(ert-deftest test-format-modifiers ()
+(ert-deftest format-spec-flags ()
(should (equal (format-spec "foo %10b zot" '((?b . "bar")))
"foo bar zot"))
(should (equal (format-spec "foo % 10b zot" '((?b . "bar")))
diff --git a/test/lisp/gnus/gnus-icalendar-tests.el b/test/lisp/gnus/gnus-icalendar-tests.el
new file mode 100644
index 00000000000..dd265b4fa97
--- /dev/null
+++ b/test/lisp/gnus/gnus-icalendar-tests.el
@@ -0,0 +1,259 @@
+;;; gnus-icalendar-tests.el --- tests -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Jan Tatarik <jan.tatarik@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'gnus-icalendar)
+
+
+(defun gnus-icalendar-tests--get-ical-event (ical-string &optional participant)
+ "Return gnus-icalendar event for ICAL-STRING."
+ (let (event)
+ (with-temp-buffer
+ (insert ical-string)
+ (setq event (gnus-icalendar-event-from-buffer (buffer-name) participant)))
+ event))
+
+(ert-deftest gnus-icalendar-parse ()
+ "test"
+ (let ((tz (getenv "TZ"))
+ (event (gnus-icalendar-tests--get-ical-event "\
+BEGIN:VCALENDAR
+PRODID:-//Google Inc//Google Calendar 70.9054//EN
+VERSION:2.0
+CALSCALE:GREGORIAN
+METHOD:REQUEST
+BEGIN:VTIMEZONE
+TZID:America/New_York
+X-LIC-LOCATION:America/New_York
+BEGIN:DAYLIGHT
+TZOFFSETFROM:-0500
+TZOFFSETTO:-0400
+TZNAME:EDT
+DTSTART:19700308T020000
+RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=2SU
+END:DAYLIGHT
+BEGIN:STANDARD
+TZOFFSETFROM:-0400
+TZOFFSETTO:-0500
+TZNAME:EST
+DTSTART:19701101T020000
+RRULE:FREQ=YEARLY;BYMONTH=11;BYDAY=1SU
+END:STANDARD
+END:VTIMEZONE
+BEGIN:VEVENT
+DTSTART;TZID=America/New_York:20201208T090000
+DTEND;TZID=America/New_York:20201208T100000
+DTSTAMP:20200728T182853Z
+ORGANIZER;CN=Company Events:mailto:anoncompany.com_3bm6fh805bme9uoeliqcle1sa
+ g@group.calendar.google.com
+UID:iipdt88slddpeu7hheuu09sfmd@google.com
+X-MICROSOFT-CDO-OWNERAPPTID:-362490173
+RECURRENCE-ID;TZID=America/New_York:20201208T091500
+CREATED:20200309T134939Z
+DESCRIPTION:In this meeting\\, we will cover topics from product and enginee
+ ring presentations and demos to new hire announcements to watching the late
+LAST-MODIFIED:20200728T182852Z
+LOCATION:New York-22-Town Hall Space (250) [Chrome Box]
+SEQUENCE:4
+STATUS:CONFIRMED
+SUMMARY:Townhall | All Company Meeting
+TRANSP:OPAQUE
+END:VEVENT
+END:VCALENDAR
+")))
+
+ (unwind-protect
+ (progn
+ ;; Use this form so as not to rely on system tz database.
+ ;; Eg hydra.nixos.org.
+ (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3")
+ (should (eq (eieio-object-class event) 'gnus-icalendar-event-request))
+ (should (not (gnus-icalendar-event:recurring-p event)))
+ (should (string= (gnus-icalendar-event:start event) "2020-12-08 15:00"))
+ (with-slots (organizer summary description location end-time uid rsvp participation-type) event
+ (should (string= organizer "anoncompany.com_3bm6fh805bme9uoeliqcle1sag@group.calendar.google.com"))
+ (should (string= summary "Townhall | All Company Meeting"))
+ (should (string= description "In this meeting, we will cover topics from product and engineering presentations and demos to new hire announcements to watching the late"))
+ (should (string= location "New York-22-Town Hall Space (250) [Chrome Box]"))
+ (should (string= (format-time-string "%Y-%m-%d %H:%M" end-time) "2020-12-08 16:00"))
+ (should (string= uid "iipdt88slddpeu7hheuu09sfmd@google.com"))
+ (should (not rsvp))
+ (should (eq participation-type 'non-participant))))
+ (setenv "TZ" tz))))
+
+(ert-deftest gnus-icalendary-byday ()
+ ""
+ (let ((tz (getenv "TZ"))
+ (event (gnus-icalendar-tests--get-ical-event "\
+BEGIN:VCALENDAR
+PRODID:Zimbra-Calendar-Provider
+VERSION:2.0
+METHOD:REQUEST
+BEGIN:VTIMEZONE
+TZID:America/New_York
+BEGIN:STANDARD
+DTSTART:16010101T020000
+TZOFFSETTO:-0500
+TZOFFSETFROM:-0400
+RRULE:FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=11;BYDAY=1SU
+TZNAME:EST
+END:STANDARD
+BEGIN:DAYLIGHT
+DTSTART:16010101T020000
+TZOFFSETTO:-0400
+TZOFFSETFROM:-0500
+RRULE:FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=3;BYDAY=2SU
+TZNAME:EDT
+END:DAYLIGHT
+END:VTIMEZONE
+BEGIN:VEVENT
+UID:903a5415-9067-4f63-b499-1b6205f49c88
+RRULE:FREQ=DAILY;UNTIL=20200825T035959Z;INTERVAL=1;BYDAY=MO,TU,WE,TH,FR
+SUMMARY:appointment every weekday\\, start jul 24\\, 2020\\, end aug 24\\, 2020
+ATTENDEE;CN=Mark Hershberger;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP
+ =TRUE:mailto:hexmode <at> gmail.com
+ORGANIZER;CN=Mark A. Hershberger:mailto:mah <at> nichework.com
+DTSTART;TZID=\"America/New_York\":20200724T090000
+DTEND;TZID=\"America/New_York\":20200724T093000
+STATUS:CONFIRMED
+CLASS:PUBLIC
+X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY
+TRANSP:OPAQUE
+LAST-MODIFIED:20200719T150815Z
+DTSTAMP:20200719T150815Z
+SEQUENCE:0
+DESCRIPTION:The following is a new meeting request:
+BEGIN:VALARM
+ACTION:DISPLAY
+TRIGGER;RELATED=START:-PT5M
+DESCRIPTION:Reminder
+END:VALARM
+END:VEVENT
+END:VCALENDAR" (list "Mark Hershberger"))))
+
+ (unwind-protect
+ (progn
+ ;; Use this form so as not to rely on system tz database.
+ ;; Eg hydra.nixos.org.
+ (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3")
+ (should (eq (eieio-object-class event) 'gnus-icalendar-event-request))
+ (should (gnus-icalendar-event:recurring-p event))
+ (should (string= (gnus-icalendar-event:recurring-interval event) "1"))
+ (should (string= (gnus-icalendar-event:start event) "2020-07-24 15:00"))
+ (with-slots (organizer summary description location end-time uid rsvp participation-type) event
+ (should (string= organizer "mah <at> nichework.com"))
+ (should (string= summary "appointment every weekday, start jul 24, 2020, end aug 24, 2020"))
+ (should (string= description "The following is a new meeting request:"))
+ (should (null location))
+ (should (string= (format-time-string "%Y-%m-%d %H:%M" end-time) "2020-07-24 15:30"))
+ (should (string= uid "903a5415-9067-4f63-b499-1b6205f49c88"))
+ (should rsvp)
+ (should (eq participation-type 'required)))
+ (should (equal (gnus-icalendar-event:recurring-days event) '(1 2 3 4 5)))
+ (should (string= (gnus-icalendar-event:org-timestamp event) "<2020-07-24 15:00-15:30 +1w>
+<2020-07-27 15:00-15:30 +1w>
+<2020-07-28 15:00-15:30 +1w>
+<2020-07-29 15:00-15:30 +1w>
+<2020-07-30 15:00-15:30 +1w>")))
+ (setenv "TZ" tz))))
+
+(ert-deftest gnus-icalendary-weekly-byday ()
+ ""
+ (let ((tz (getenv "TZ"))
+ (event (gnus-icalendar-tests--get-ical-event "\
+BEGIN:VCALENDAR
+PRODID:-//Google Inc//Google Calendar 70.9054//EN
+VERSION:2.0
+CALSCALE:GREGORIAN
+METHOD:REQUEST
+BEGIN:VTIMEZONE
+TZID:Europe/Berlin
+X-LIC-LOCATION:Europe/Berlin
+BEGIN:DAYLIGHT
+TZOFFSETFROM:+0100
+TZOFFSETTO:+0200
+TZNAME:CEST
+DTSTART:19700329T020000
+RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU
+END:DAYLIGHT
+BEGIN:STANDARD
+TZOFFSETFROM:+0200
+TZOFFSETTO:+0100
+TZNAME:CET
+DTSTART:19701025T030000
+RRULE:FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU
+END:STANDARD
+END:VTIMEZONE
+BEGIN:VEVENT
+DTSTART;TZID=Europe/Berlin:20200915T140000
+DTEND;TZID=Europe/Berlin:20200915T143000
+RRULE:FREQ=WEEKLY;BYDAY=FR,MO,TH,TU,WE
+DTSTAMP:20200915T120627Z
+ORGANIZER;CN=anon@anoncompany.com:mailto:anon@anoncompany.com
+UID:7b6g3m7iftuo90ei4ul00feqn_R20200915T120000@google.com
+ATTENDEE;CUTYPE=INDIVIDUAL;ROLE=REQ-PARTICIPANT;PARTSTAT=ACCEPTED;RSVP=TRUE
+ ;CN=participant@anoncompany.com;X-NUM-GUESTS=0:mailto:participant@anoncompany.com
+CREATED:20200325T095723Z
+DESCRIPTION:Coffee talk
+LAST-MODIFIED:20200915T120623Z
+LOCATION:
+SEQUENCE:0
+STATUS:CONFIRMED
+SUMMARY:Casual coffee talk
+TRANSP:OPAQUE
+END:VEVENT
+END:VCALENDAR" (list "participant@anoncompany.com"))))
+
+ (unwind-protect
+ (progn
+ ;; Use this form so as not to rely on system tz database.
+ ;; Eg hydra.nixos.org.
+ (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3")
+ (should (eq (eieio-object-class event) 'gnus-icalendar-event-request))
+ (should (gnus-icalendar-event:recurring-p event))
+ (should (string= (gnus-icalendar-event:recurring-interval event) "1"))
+ (should (string= (gnus-icalendar-event:start event) "2020-09-15 14:00"))
+ (with-slots (organizer summary description location end-time uid rsvp participation-type) event
+ (should (string= organizer "anon@anoncompany.com"))
+ (should (string= summary "Casual coffee talk"))
+ (should (string= description "Coffee talk"))
+ (should (string= location ""))
+ (should (string= (format-time-string "%Y-%m-%d %H:%M" end-time) "2020-09-15 14:30"))
+ (should (string= uid "7b6g3m7iftuo90ei4ul00feqn_R20200915T120000@google.com"))
+ (should rsvp)
+ (should (eq participation-type 'required)))
+ (should (equal (sort (gnus-icalendar-event:recurring-days event) #'<) '(1 2 3 4 5)))
+ (should (string= (gnus-icalendar-event:org-timestamp event) "<2020-09-15 14:00-14:30 +1w>
+<2020-09-16 14:00-14:30 +1w>
+<2020-09-17 14:00-14:30 +1w>
+<2020-09-18 14:00-14:30 +1w>
+<2020-09-21 14:00-14:30 +1w>")))
+ (setenv "TZ" tz))))
+
+(provide 'gnus-icalendar-tests)
+;;; gnus-icalendar-tests.el ends here
diff --git a/test/lisp/gnus/gnus-tests.el b/test/lisp/gnus/gnus-tests.el
index d18b3fbed0f..fb1b204f042 100644
--- a/test/lisp/gnus/gnus-tests.el
+++ b/test/lisp/gnus/gnus-tests.el
@@ -1,4 +1,4 @@
-;;; gnus-tests.el --- Wrapper for the Gnus tests
+;;; gnus-tests.el --- Wrapper for the Gnus tests -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el
new file mode 100644
index 00000000000..47f0a9cf761
--- /dev/null
+++ b/test/lisp/gnus/gnus-util-tests.el
@@ -0,0 +1,174 @@
+;;; gnus-util-tests.el --- Selectived tests only. -*- lexical-binding:t -*-
+;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+
+;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org>
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'gnus-util)
+
+(ert-deftest gnus-string> ()
+ ;; Failure paths
+ (should-error (gnus-string> "" 1)
+ :type 'wrong-type-argument)
+ (should-error (gnus-string> "")
+ :type 'wrong-number-of-arguments)
+
+ ;; String tests
+ (should (gnus-string> "def" "abc"))
+ (should (gnus-string> 'def 'abc))
+ (should (gnus-string> "abc" "DEF"))
+ (should (gnus-string> "abc" 'DEF))
+ (should (gnus-string> "αβγ" "abc"))
+ (should (gnus-string> "אבג" "αβγ"))
+ (should (gnus-string> nil ""))
+ (should (gnus-string> "abc" ""))
+ (should (gnus-string> "abc" "ab"))
+ (should-not (gnus-string> "abc" "abc"))
+ (should-not (gnus-string> "abc" "def"))
+ (should-not (gnus-string> "DEF" "abc"))
+ (should-not (gnus-string> 'DEF "abc"))
+ (should-not (gnus-string> "123" "abc"))
+ (should-not (gnus-string> "" "")))
+
+(ert-deftest gnus-string< ()
+ ;; Failure paths
+ (should-error (gnus-string< "" 1)
+ :type 'wrong-type-argument)
+ (should-error (gnus-string< "")
+ :type 'wrong-number-of-arguments)
+
+ ;; String tests
+ (setq case-fold-search nil)
+ (should (gnus-string< "abc" "def"))
+ (should (gnus-string< 'abc 'def))
+ (should (gnus-string< "DEF" "abc"))
+ (should (gnus-string< "DEF" 'abc))
+ (should (gnus-string< "abc" "αβγ"))
+ (should (gnus-string< "αβγ" "אבג"))
+ (should (gnus-string< "" nil))
+ (should (gnus-string< "" "abc"))
+ (should (gnus-string< "ab" "abc"))
+ (should-not (gnus-string< "abc" "abc"))
+ (should-not (gnus-string< "def" "abc"))
+ (should-not (gnus-string< "abc" "DEF"))
+ (should-not (gnus-string< "abc" 'DEF))
+ (should-not (gnus-string< "abc" "123"))
+ (should-not (gnus-string< "" ""))
+
+ ;; gnus-string< checks case-fold-search
+ (setq case-fold-search t)
+ (should (gnus-string< "abc" "DEF"))
+ (should (gnus-string< "abc" 'GHI))
+ (should (gnus-string< 'abc "DEF"))
+ (should (gnus-string< 'GHI 'JKL))
+ (should (gnus-string< "abc" "ΑΒΓ"))
+ (should-not (gnus-string< "ABC" "abc"))
+ (should-not (gnus-string< "def" "ABC")))
+
+(ert-deftest gnus-subsetp ()
+ ;; False for non-lists.
+ (should-not (gnus-subsetp "1" "1"))
+ (should-not (gnus-subsetp "1" '("1")))
+ (should-not (gnus-subsetp '("1") "1"))
+
+ ;; Real tests.
+ (should (gnus-subsetp '() '()))
+ (should (gnus-subsetp '() '("1")))
+ (should (gnus-subsetp '("1") '("1")))
+ (should (gnus-subsetp '(42) '("1" 42)))
+ (should (gnus-subsetp '(42) '(42 "1")))
+ (should (gnus-subsetp '(42) '("1" 42 2)))
+ (should-not (gnus-subsetp '("1") '()))
+ (should-not (gnus-subsetp '("1") '(2)))
+ (should-not (gnus-subsetp '("1" 2) '(2)))
+ (should-not (gnus-subsetp '(2 "1") '(2)))
+ (should-not (gnus-subsetp '("1" 2) '(2 3)))
+
+ ;; Duplicates don't matter for sets.
+ (should (gnus-subsetp '("1" "1") '("1")))
+ (should (gnus-subsetp '("1" 2 "1") '(2 "1")))
+ (should (gnus-subsetp '("1" 2 "1") '(2 "1" "1" 2)))
+ (should-not (gnus-subsetp '("1" 2 "1" 3) '(2 "1" "1" 2))))
+
+(ert-deftest gnus-setdiff ()
+ ;; False for non-lists.
+ (should-not (gnus-setdiff "1" "1"))
+ (should-not (gnus-setdiff "1" '()))
+ (should-not (gnus-setdiff '() "1"))
+
+ ;; Real tests.
+ (should-not (gnus-setdiff '() '()))
+ (should-not (gnus-setdiff '() '("1")))
+ (should-not (gnus-setdiff '("1") '("1")))
+ (should (equal '("1") (gnus-setdiff '("1") '())))
+ (should (equal '("1") (gnus-setdiff '("1") '(2))))
+ (should (equal '("1") (gnus-setdiff '("1" 2) '(2))))
+ (should (equal '("1") (gnus-setdiff '("1" 2 3) '(3 2))))
+ (should (equal '("1") (gnus-setdiff '(2 "1" 3) '(3 2))))
+ (should (equal '("1") (gnus-setdiff '(2 3 "1") '(3 2))))
+ (should (equal '(2 "1") (gnus-setdiff '(2 3 "1") '(3))))
+
+ ;; Duplicates aren't touched for sets if they are not removed.
+ (should-not (gnus-setdiff '("1" "1") '("1")))
+ (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 "" nil nil nil)
+ :type 'wrong-number-of-arguments)
+ (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/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el
new file mode 100644
index 00000000000..427018520c8
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-tests.el
@@ -0,0 +1,888 @@
+;;; mml-sec-tests.el --- Tests mml-sec.el, see README-mml-secure.txt. -*- lexical-binding:t -*-
+;; Copyright (C) 2015, 2020 Free Software Foundation, Inc.
+
+;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org>
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+
+(require 'message)
+(require 'epa)
+(require 'epg)
+(require 'mml-sec)
+(require 'gnus-sum)
+
+(defvar with-smime nil
+ "If nil, exclude S/MIME from tests as passphrases need to entered manually.
+Mostly, the empty passphrase is used. However, the keys for
+ \"No Expiry two UIDs\" have the passphrase \"Passphrase\" (for OpenPGP as well
+ as S/MIME).")
+
+(defun test-conf ()
+ (ignore-errors (epg-find-configuration 'OpenPGP)))
+
+(defun enc-standards ()
+ (if with-smime '(enc-pgp enc-pgp-mime enc-smime)
+ '(enc-pgp enc-pgp-mime)))
+(defun enc-sign-standards ()
+ (if with-smime
+ '(enc-sign-pgp enc-sign-pgp-mime enc-sign-smime)
+ '(enc-sign-pgp enc-sign-pgp-mime)))
+(defun sign-standards ()
+ (if with-smime
+ '(sign-pgp sign-pgp-mime sign-smime)
+ '(sign-pgp sign-pgp-mime)))
+
+(defvar mml-smime-use)
+
+(defun mml-secure-test-fixture (body &optional interactive)
+ "Setup GnuPG home containing test keys and prepare environment for BODY.
+If optional INTERACTIVE is non-nil, allow questions to the user in case of
+key problems.
+This fixture temporarily unsets GPG_AGENT_INFO to enable passphrase tests,
+which will neither work with gpgsm nor GnuPG 2.1 any longer, I guess.
+Actually, I'm not sure why people would want to cache passwords in Emacs
+instead of gpg-agent."
+ (unwind-protect
+ (let ((agent-info (getenv "GPG_AGENT_INFO"))
+ (gpghome (getenv "GNUPGHOME")))
+ (condition-case error
+ (let ((epg-gpg-home-directory
+ (expand-file-name "test/data/mml-sec" source-directory))
+ (mml-smime-use 'epg)
+ ;; Create debug output in empty epg-debug-buffer.
+ (epg-debug t)
+ (epg-debug-buffer (get-buffer-create " *epg-test*"))
+ (mml-secure-fail-when-key-problem (not interactive)))
+ (with-current-buffer epg-debug-buffer
+ (erase-buffer))
+ ;; Unset GPG_AGENT_INFO to enable passphrase caching inside Emacs.
+ ;; Just for testing. Jens does not recommend this for daily use.
+ (setenv "GPG_AGENT_INFO")
+ ;; Set GNUPGHOME as gpg-agent started by gpgsm does
+ ;; not look in the proper places otherwise, see:
+ ;; https://bugs.gnupg.org/gnupg/issue2126
+ (setenv "GNUPGHOME" epg-gpg-home-directory)
+ (unwind-protect
+ (funcall body)
+ (mml-sec-test--kill-gpg-agent)))
+ (error
+ (setenv "GPG_AGENT_INFO" agent-info)
+ (setenv "GNUPGHOME" gpghome)
+ (signal (car error) (cdr error))))
+ (setenv "GPG_AGENT_INFO" agent-info)
+ (setenv "GNUPGHOME" gpghome))))
+
+(defun mml-secure-test-message-setup (method to from &optional text bcc)
+ "Setup a buffer with MML METHOD, TO, and FROM headers.
+Optionally, a message TEXT and BCC header can be passed."
+ (with-temp-buffer
+ (when bcc (insert (format "Bcc: %s\n" bcc)))
+ (insert (format "To: %s
+From: %s
+Subject: Test
+%s\n" to from mail-header-separator))
+ (if text
+ (insert (format "%s" text))
+ (spook))
+ (cond ((eq method 'enc-pgp-mime)
+ (mml-secure-message-encrypt-pgpmime 'nosig))
+ ((eq method 'enc-sign-pgp-mime)
+ (mml-secure-message-encrypt-pgpmime))
+ ((eq method 'enc-pgp) (mml-secure-message-encrypt-pgp 'nosig))
+ ((eq method 'enc-sign-pgp) (mml-secure-message-encrypt-pgp))
+ ((eq method 'enc-smime) (mml-secure-message-encrypt-smime 'nosig))
+ ((eq method 'enc-sign-smime) (mml-secure-message-encrypt-smime))
+ ((eq method 'sign-pgp-mime) (mml-secure-message-sign-pgpmime))
+ ((eq method 'sign-pgp) (mml-secure-message-sign-pgp))
+ ((eq method 'sign-smime) (mml-secure-message-sign-smime))
+ (t (error "Unknown method")))
+ (buffer-string)))
+
+(defun mml-secure-test-mail-fixture (method to from body2
+ &optional interactive)
+ "Setup buffer encrypted using METHOD for TO from FROM, call BODY2.
+Pass optional INTERACTIVE to mml-secure-test-fixture."
+ (mml-secure-test-fixture
+ (lambda ()
+ (let ((_context (if (memq method '(enc-smime enc-sign-smime sign-smime))
+ (epg-make-context 'CMS)
+ (epg-make-context 'OpenPGP)))
+ ;; Verify and decrypt by default.
+ (mm-verify-option 'known)
+ (mm-decrypt-option 'known)
+ (plaintext "The Magic Words are Squeamish Ossifrage"))
+ (with-temp-buffer
+ (insert (mml-secure-test-message-setup method to from plaintext))
+ (message-options-set-recipient)
+ (message-encode-message-body)
+ ;; Replace separator line with newline.
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n")
+ ;; The following treatment of handles, plainbuf, and multipart
+ ;; resulted from trial-and-error.
+ ;; Someone with more knowledge on how to decrypt messages and verify
+ ;; signatures might know more appropriate functions to invoke
+ ;; instead.
+ (let* ((handles (or (mm-dissect-buffer)
+ (mm-uu-dissect)))
+ (isplain (bufferp (car handles)))
+ (ismultipart (equal (car handles) "multipart/mixed"))
+ (plainbuf (if isplain
+ (car handles)
+ (if ismultipart
+ (car (cadadr handles))
+ (caadr handles))))
+ (decrypted
+ (with-current-buffer plainbuf (buffer-string)))
+ (gnus-info
+ (if isplain
+ nil
+ (if ismultipart
+ (or (mm-handle-multipart-ctl-parameter
+ (cadr handles) 'gnus-details)
+ (mm-handle-multipart-ctl-parameter
+ (cadr handles) 'gnus-info))
+ (mm-handle-multipart-ctl-parameter
+ handles 'gnus-info)))))
+ (funcall body2 gnus-info plaintext decrypted)))))
+ interactive))
+
+;; TODO If the variable BODY3 is renamed to BODY, an infinite recursion
+;; occurs. Emacs bug?
+(defun mml-secure-test-key-fixture (body3)
+ "Customize unique keys for sub@example.org and call BODY3.
+For OpenPGP, we have:
+- 1E6B FA97 3D9E 3103 B77F D399 C399 9CF1 268D BEA2
+ uid Different subkeys <sub@example.org>
+- 1463 2ECA B9E2 2736 9C8D D97B F7E7 9AB7 AE31 D471
+ uid Second Key Pair <sub@example.org>
+
+For S/MIME:
+ ID: 0x479DC6E2
+ Subject: /CN=Second Key Pair
+ aka: sub@example.org
+ fingerprint: 0E:58:22:9B:80:EE:33:95:9F:F7:18:FE:EF:25:40:2B:47:9D:C6:E2
+
+ ID: 0x5F88E9FC
+ Subject: /CN=Different subkeys
+ aka: sub@example.org
+ fingerprint: 4F:96:2A:B7:F4:76:61:6A:78:3D:72:AA:40:35:D5:9B:5F:88:E9:FC
+
+In both cases, the first key is customized for signing and encryption."
+ (mml-secure-test-fixture
+ (lambda ()
+ (let* ((mml-secure-key-preferences
+ '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt))))
+ (pcontext (epg-make-context 'OpenPGP))
+ (pkey (epg-list-keys pcontext "C3999CF1268DBEA2"))
+ (scontext (epg-make-context 'CMS))
+ (skey (epg-list-keys scontext "0x479DC6E2")))
+ (mml-secure-cust-record-keys pcontext 'encrypt "sub@example.org" pkey)
+ (mml-secure-cust-record-keys pcontext 'sign "sub@example.org" pkey)
+ (mml-secure-cust-record-keys scontext 'encrypt "sub@example.org" skey)
+ (mml-secure-cust-record-keys scontext 'sign "sub@example.org" skey)
+ (funcall body3)))))
+
+(ert-deftest mml-secure-key-checks ()
+ "Test mml-secure-check-user-id and mml-secure-check-sub-key on sample keys."
+ (skip-unless (test-conf))
+ (mml-secure-test-fixture
+ (lambda ()
+ (let* ((context (epg-make-context 'OpenPGP))
+ (keys1 (epg-list-keys context "expired@example.org"))
+ (keys2 (epg-list-keys context "no-exp@example.org"))
+ (keys3 (epg-list-keys context "sub@example.org"))
+ (keys4 (epg-list-keys context "revoked-uid@example.org"))
+ (keys5 (epg-list-keys context "disabled@example.org"))
+ (keys6 (epg-list-keys context "sign@example.org"))
+ (keys7 (epg-list-keys context "jens.lechtenboerger@fsfe"))
+ )
+ (should (and (= 1 (length keys1)) (= 1 (length keys2))
+ (= 2 (length keys3))
+ (= 1 (length keys4)) (= 1 (length keys5))
+ ))
+ ;; key1 is expired
+ (should-not (mml-secure-check-user-id (car keys1) "expired@example.org"))
+ (should-not (mml-secure-check-sub-key context (car keys1) 'encrypt))
+ (should-not (mml-secure-check-sub-key context (car keys1) 'sign))
+
+ ;; key2 does not expire, but does not have the UID expired@example.org
+ (should-not (mml-secure-check-user-id (car keys2) "expired@example.org"))
+ (should (mml-secure-check-user-id (car keys2) "no-exp@example.org"))
+ (should (mml-secure-check-sub-key context (car keys2) 'encrypt))
+ (should (mml-secure-check-sub-key context (car keys2) 'sign))
+
+ ;; Two keys exist for sub@example.org.
+ (should (mml-secure-check-user-id (car keys3) "sub@example.org"))
+ (should (mml-secure-check-sub-key context (car keys3) 'encrypt))
+ (should (mml-secure-check-sub-key context (car keys3) 'sign))
+ (should (mml-secure-check-user-id (cadr keys3) "sub@example.org"))
+ (should (mml-secure-check-sub-key context (cadr keys3) 'encrypt))
+ (should (mml-secure-check-sub-key context (cadr keys3) 'sign))
+
+ ;; The UID revoked-uid@example.org is revoked. The key itself is
+ ;; usable, though (with the UID sub@example.org).
+ (should-not
+ (mml-secure-check-user-id (car keys4) "revoked-uid@example.org"))
+ (should (mml-secure-check-sub-key context (car keys4) 'encrypt))
+ (should (mml-secure-check-sub-key context (car keys4) 'sign))
+ (should (mml-secure-check-user-id (car keys4) "sub@example.org"))
+
+ ;; The next key is disabled and, thus, unusable.
+ (should (mml-secure-check-user-id (car keys5) "disabled@example.org"))
+ (should-not (mml-secure-check-sub-key context (car keys5) 'encrypt))
+ (should-not (mml-secure-check-sub-key context (car keys5) 'sign))
+
+ ;; The next key has multiple subkeys.
+ ;; 42466F0F is valid sign subkey, 501FFD98 is expired
+ (should (mml-secure-check-sub-key context (car keys6) 'sign "42466F0F"))
+ (should-not
+ (mml-secure-check-sub-key context (car keys6) 'sign "501FFD98"))
+ ;; DC7F66E7 is encrypt subkey
+ (should
+ (mml-secure-check-sub-key context (car keys6) 'encrypt "DC7F66E7"))
+ (should-not
+ (mml-secure-check-sub-key context (car keys6) 'sign "DC7F66E7"))
+ (should-not
+ (mml-secure-check-sub-key context (car keys6) 'encrypt "42466F0F"))
+
+ ;; The final key is just a public key.
+ (should (mml-secure-check-sub-key context (car keys7) 'encrypt))
+ (should-not (mml-secure-check-sub-key context (car keys7) 'sign))
+ ))))
+
+(ert-deftest mml-secure-find-usable-keys-1 ()
+ "Make sure that expired and disabled keys and revoked UIDs are not used."
+ (skip-unless (test-conf))
+ (mml-secure-test-fixture
+ (lambda ()
+ (let ((context (epg-make-context 'OpenPGP)))
+ (should-not
+ (mml-secure-find-usable-keys context "expired@example.org" 'encrypt))
+ (should-not
+ (mml-secure-find-usable-keys context "expired@example.org" 'sign))
+
+ (should-not
+ (mml-secure-find-usable-keys context "disabled@example.org" 'encrypt))
+ (should-not
+ (mml-secure-find-usable-keys context "disabled@example.org" 'sign))
+
+ (should-not
+ (mml-secure-find-usable-keys
+ context "<revoked-uid@example.org>" 'encrypt))
+ (should-not
+ (mml-secure-find-usable-keys
+ context "<revoked-uid@example.org>" 'sign))
+ ;; Same test without ankles. Will fail for Ma Gnus v0.14 and earlier.
+ (should-not
+ (mml-secure-find-usable-keys
+ context "revoked-uid@example.org" 'encrypt))
+
+ ;; Expired key should not be usable.
+ ;; Will fail for Ma Gnus v0.14 and earlier.
+ ;; sign@example.org has the expired subkey 0x501FFD98.
+ (should-not
+ (mml-secure-find-usable-keys context "0x501FFD98" 'sign))
+
+ (should
+ (mml-secure-find-usable-keys context "no-exp@example.org" 'encrypt))
+ (should
+ (mml-secure-find-usable-keys context "no-exp@example.org" 'sign))
+ ))))
+
+(ert-deftest mml-secure-find-usable-keys-2 ()
+ "Test different ways to search for keys."
+ (skip-unless (test-conf))
+ (mml-secure-test-fixture
+ (lambda ()
+ (let ((context (epg-make-context 'OpenPGP)))
+ ;; Plain substring search is not supported.
+ (should
+ (= 0 (length
+ (mml-secure-find-usable-keys context "No Expiry" 'encrypt))))
+ (should
+ (= 0 (length
+ (mml-secure-find-usable-keys context "No Expiry" 'sign))))
+
+ ;; Search for e-mail addresses works with and without ankle brackets.
+ (should
+ (= 1 (length (mml-secure-find-usable-keys
+ context "<no-exp@example.org>" 'encrypt))))
+ (should
+ (= 1 (length (mml-secure-find-usable-keys
+ context "<no-exp@example.org>" 'sign))))
+ (should
+ (= 1 (length (mml-secure-find-usable-keys
+ context "no-exp@example.org" 'encrypt))))
+ (should
+ (= 1 (length (mml-secure-find-usable-keys
+ context "no-exp@example.org" 'sign))))
+
+ ;; Use full UID string.
+ (should
+ (= 1 (length (mml-secure-find-usable-keys
+ context "No Expiry <no-exp@example.org>" 'encrypt))))
+ (should
+ (= 1 (length (mml-secure-find-usable-keys
+ context "No Expiry <no-exp@example.org>" 'sign))))
+
+ ;; If just the public key is present, only encryption is possible.
+ ;; Search works with key IDs, with and without prefix "0x".
+ (should
+ (= 1 (length (mml-secure-find-usable-keys
+ context "A142FD84" 'encrypt))))
+ (should
+ (= 1 (length (mml-secure-find-usable-keys
+ context "0xA142FD84" 'encrypt))))
+ (should
+ (= 0 (length (mml-secure-find-usable-keys
+ context "A142FD84" 'sign))))
+ (should
+ (= 0 (length (mml-secure-find-usable-keys
+ context "0xA142FD84" 'sign))))
+ ))))
+
+(ert-deftest mml-secure-select-preferred-keys-1 ()
+ "If only one key exists for an e-mail address, it is the preferred one."
+ (skip-unless (test-conf))
+ (mml-secure-test-fixture
+ (lambda ()
+ (let ((context (epg-make-context 'OpenPGP)))
+ (should (equal "832F3CC6518D37BC658261B802372A42CA6D40FB"
+ (mml-secure-fingerprint
+ (car (mml-secure-select-preferred-keys
+ context '("no-exp@example.org") 'encrypt)))))))))
+
+(ert-deftest mml-secure-select-preferred-keys-2 ()
+ "If multiple keys exists for an e-mail address, customization is necessary."
+ (skip-unless (test-conf))
+ (mml-secure-test-fixture
+ (lambda ()
+ (let* ((context (epg-make-context 'OpenPGP))
+ (mml-secure-key-preferences
+ '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt))))
+ (pref (car (mml-secure-find-usable-keys
+ context "sub@example.org" 'encrypt))))
+ (should-error (mml-secure-select-preferred-keys
+ context '("sub@example.org") 'encrypt))
+ (mml-secure-cust-record-keys
+ context 'encrypt "sub@example.org" (list pref))
+ (should (mml-secure-select-preferred-keys
+ context '("sub@example.org") 'encrypt))
+ (should-error (mml-secure-select-preferred-keys
+ context '("sub@example.org") 'sign))
+ (should (mml-secure-select-preferred-keys
+ context '("sub@example.org") 'encrypt))
+ (should
+ (equal (list (mml-secure-fingerprint pref))
+ (mml-secure-cust-fpr-lookup context 'encrypt "sub@example.org")))
+ (should (mml-secure-cust-remove-keys context 'encrypt "sub@example.org"))
+ (should-error (mml-secure-select-preferred-keys
+ context '("sub@example.org") 'encrypt))))))
+
+(ert-deftest mml-secure-select-preferred-keys-3 ()
+ "Expired customized keys are removed if multiple keys are available."
+ (skip-unless (test-conf))
+ (mml-secure-test-fixture
+ (lambda ()
+ (let ((context (epg-make-context 'OpenPGP))
+ (mml-secure-key-preferences
+ '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt)))))
+ ;; sub@example.org has two keys (268DBEA2, AE31D471).
+ ;; Normal preference works.
+ (mml-secure-cust-record-keys
+ context 'encrypt "sub@example.org" (epg-list-keys context "268DBEA2"))
+ (should (mml-secure-select-preferred-keys
+ context '("sub@example.org") 'encrypt))
+ (mml-secure-cust-remove-keys context 'encrypt "sub@example.org")
+
+ ;; Fake preference for expired (unrelated) key CE15FAE7,
+ ;; results in error (and automatic removal of outdated preference).
+ (mml-secure-cust-record-keys
+ context 'encrypt "sub@example.org" (epg-list-keys context "CE15FAE7"))
+ (should-error (mml-secure-select-preferred-keys
+ context '("sub@example.org") 'encrypt))
+ (should-not
+ (mml-secure-cust-remove-keys context 'encrypt "sub@example.org"))))))
+
+(ert-deftest mml-secure-select-preferred-keys-4 ()
+ "Multiple keys can be recorded per recipient or signature."
+ (skip-unless (test-conf))
+ (mml-secure-test-fixture
+ (lambda ()
+ (let ((pcontext (epg-make-context 'OpenPGP))
+ (scontext (epg-make-context 'CMS))
+ (pkeys '("1E6BFA973D9E3103B77FD399C3999CF1268DBEA2"
+ "14632ECAB9E227369C8DD97BF7E79AB7AE31D471"))
+ (skeys '("0x5F88E9FC" "0x479DC6E2"))
+ (mml-secure-key-preferences
+ '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt)))))
+
+ ;; OpenPGP preferences via pcontext
+ (dolist (key pkeys nil)
+ (mml-secure-cust-record-keys
+ pcontext 'encrypt "sub@example.org" (epg-list-keys pcontext key))
+ (mml-secure-cust-record-keys
+ pcontext 'sign "sub@example.org" (epg-list-keys pcontext key 'secret)))
+ (let ((p-e-fprs (mml-secure-cust-fpr-lookup
+ pcontext 'encrypt "sub@example.org"))
+ (p-s-fprs (mml-secure-cust-fpr-lookup
+ pcontext 'sign "sub@example.org")))
+ (should (= 2 (length p-e-fprs)))
+ (should (= 2 (length p-s-fprs)))
+ (should (member "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2" p-e-fprs))
+ (should (member "14632ECAB9E227369C8DD97BF7E79AB7AE31D471" p-e-fprs))
+ (should (member "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2" p-s-fprs))
+ (should (member "14632ECAB9E227369C8DD97BF7E79AB7AE31D471" p-s-fprs)))
+ ;; Duplicate record does not change anything.
+ (mml-secure-cust-record-keys
+ pcontext 'encrypt "sub@example.org"
+ (epg-list-keys pcontext "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2"))
+ (mml-secure-cust-record-keys
+ pcontext 'sign "sub@example.org"
+ (epg-list-keys pcontext "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2"))
+ (let ((p-e-fprs (mml-secure-cust-fpr-lookup
+ pcontext 'encrypt "sub@example.org"))
+ (p-s-fprs (mml-secure-cust-fpr-lookup
+ pcontext 'sign "sub@example.org")))
+ (should (= 2 (length p-e-fprs)))
+ (should (= 2 (length p-s-fprs))))
+
+ ;; S/MIME preferences via scontext
+ (dolist (key skeys nil)
+ (mml-secure-cust-record-keys
+ scontext 'encrypt "sub@example.org"
+ (epg-list-keys scontext key))
+ (mml-secure-cust-record-keys
+ scontext 'sign "sub@example.org"
+ (epg-list-keys scontext key 'secret)))
+ (let ((s-e-fprs (mml-secure-cust-fpr-lookup
+ scontext 'encrypt "sub@example.org"))
+ (s-s-fprs (mml-secure-cust-fpr-lookup
+ scontext 'sign "sub@example.org")))
+ (should (= 2 (length s-e-fprs)))
+ (should (= 2 (length s-s-fprs))))
+ ))))
+
+(defun mml-secure-test-en-decrypt
+ (method to from
+ &optional checksig checkplain enc-keys expectfail interactive)
+ "Encrypt message using METHOD, addressed to TO, from FROM.
+If optional CHECKSIG is non-nil, it must be a number, and a signature check is
+performed; the number indicates how many signatures are expected.
+If optional CHECKPLAIN is non-nil, the expected plaintext should be obtained
+via decryption.
+If optional ENC-KEYS is non-nil, it is a list of pairs of encryption keys (for
+OpenPGP and S/SMIME) expected in `epg-debug-buffer'.
+If optional EXPECTFAIL is non-nil, a decryption failure is expected.
+Pass optional INTERACTIVE to mml-secure-test-mail-fixture."
+ (mml-secure-test-mail-fixture method to from
+ (lambda (gnus-info plaintext decrypted)
+ (if expectfail
+ (should-not (equal plaintext decrypted))
+ (when checkplain
+ (should (equal plaintext decrypted)))
+ (let ((protocol (if (memq method
+ '(enc-smime enc-sign-smime sign-smime))
+ 'CMS
+ 'OpenPGP)))
+ (when checksig
+ (let* ((context (epg-make-context protocol))
+ (signer-names (mml-secure-signer-names protocol from))
+ (signer-keys (mml-secure-signers context signer-names))
+ (signer-fprs (mapcar 'mml-secure-fingerprint signer-keys)))
+ (should (eq checksig (length signer-fprs)))
+ (if (eq checksig 0)
+ ;; First key in keyring
+ (should (string-match-p
+ (concat "Good signature from "
+ (if (eq protocol 'CMS)
+ "0E58229B80EE33959FF718FEEF25402B479DC6E2"
+ "02372A42CA6D40FB"))
+ gnus-info)))
+ (dolist (fpr signer-fprs nil)
+ ;; OpenPGP: "Good signature from 02372A42CA6D40FB No Expiry <no-exp@example.org> (trust undefined) created ..."
+ ;; S/MIME: "Good signature from D06AA118653CC38E9D0CAF56ED7A2135E1582177 /CN=No Expiry (trust full) ..."
+ (should (string-match-p
+ (concat "Good signature from "
+ (if (eq protocol 'CMS)
+ fpr
+ (substring fpr -16 nil)))
+ gnus-info)))))
+ (when enc-keys
+ (with-current-buffer epg-debug-buffer
+ (goto-char (point-min))
+ ;; The following regexp does not necessarily match at the
+ ;; start of the line as a path may or may not be present.
+ ;; Also note that gpg.* matches gpg2 and gpgsm as well.
+ (let* ((line (concat "gpg.*--encrypt.*$"))
+ (end (re-search-forward line))
+ (match (match-string 0)))
+ (should (and end match))
+ (dolist (pair enc-keys nil)
+ (let ((fpr (if (eq protocol 'OpenPGP)
+ (car pair)
+ (cdr pair))))
+ (should (string-match-p (concat "-r " fpr) match))))
+ (goto-char (point-max))
+ ))))))
+ interactive))
+
+(defvar mml-smime-cache-passphrase)
+(defvar mml2015-cache-passphrase)
+(defvar mml1991-cache-passphrase)
+
+(defun mml-secure-test-en-decrypt-with-passphrase
+ (method to from checksig jl-passphrase do-cache
+ &optional enc-keys expectfail)
+ "Call mml-secure-test-en-decrypt with changed passphrase caching.
+Args METHOD, TO, FROM, CHECKSIG are passed to mml-secure-test-en-decrypt.
+JL-PASSPHRASE is fixed as return value for `read-passwd',
+boolean DO-CACHE determines whether to cache the passphrase.
+If optional ENC-KEYS is non-nil, it is a list of encryption keys expected
+in `epg-debug-buffer'.
+If optional EXPECTFAIL is non-nil, a decryption failure is expected."
+ (let ((mml-secure-cache-passphrase do-cache)
+ (mml1991-cache-passphrase do-cache)
+ (mml2015-cache-passphrase do-cache)
+ (mml-smime-cache-passphrase do-cache)
+ )
+ (cl-letf (((symbol-function 'read-passwd)
+ (lambda (_prompt &optional _confirm _default) jl-passphrase)))
+ (mml-secure-test-en-decrypt method to from checksig t enc-keys expectfail)
+ )))
+
+(ert-deftest mml-secure-en-decrypt-1 ()
+ "Encrypt message; then decrypt and test for expected result.
+In this test, the single matching key is chosen automatically."
+ (skip-unless (test-conf))
+ (dolist (method (enc-standards) nil)
+ ;; no-exp@example.org with single encryption key
+ (mml-secure-test-en-decrypt
+ method "no-exp@example.org" "sub@example.org" nil t
+ (list (cons "02372A42CA6D40FB" "ED7A2135E1582177")))))
+
+(ert-deftest mml-secure-en-decrypt-2 ()
+ "Encrypt message; then decrypt and test for expected result.
+In this test, the encryption key needs to fixed among multiple ones."
+ (skip-unless (test-conf))
+ ;; sub@example.org with multiple candidate keys,
+ ;; fixture customizes preferred ones.
+ (mml-secure-test-key-fixture
+ (lambda ()
+ (dolist (method (enc-standards) nil)
+ (mml-secure-test-en-decrypt
+ method "sub@example.org" "no-exp@example.org" nil t
+ (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2")))))))
+
+(ert-deftest mml-secure-en-decrypt-3 ()
+ "Encrypt message; then decrypt and test for expected result.
+In this test, encrypt-to-self variables are set to t."
+ (skip-unless (test-conf))
+ ;; sub@example.org with multiple candidate keys,
+ ;; fixture customizes preferred ones.
+ (mml-secure-test-key-fixture
+ (lambda ()
+ (let ((mml-secure-openpgp-encrypt-to-self t)
+ (mml-secure-smime-encrypt-to-self t))
+ (dolist (method (enc-standards) nil)
+ (mml-secure-test-en-decrypt
+ method "sub@example.org" "no-exp@example.org" nil t
+ (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2")
+ (cons "02372A42CA6D40FB" "ED7A2135E1582177"))))))))
+
+(ert-deftest mml-secure-en-decrypt-4 ()
+ "Encrypt message; then decrypt and test for expected result.
+In this test, encrypt-to-self variables are set to lists."
+ (skip-unless (test-conf))
+ ;; Send from sub@example.org, which has two keys; encrypt to both.
+ (let ((mml-secure-openpgp-encrypt-to-self
+ '("C3999CF1268DBEA2" "F7E79AB7AE31D471"))
+ (mml-secure-smime-encrypt-to-self
+ '("EF25402B479DC6E2" "4035D59B5F88E9FC")))
+ (dolist (method (enc-standards) nil)
+ (mml-secure-test-en-decrypt
+ method "no-exp@example.org" "sub@example.org" nil t
+ (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2")
+ (cons "F7E79AB7AE31D471" "4035D59B5F88E9FC"))))))
+
+(ert-deftest mml-secure-en-decrypt-sign-1-1-single ()
+ "Sign and encrypt message; then decrypt and test for expected result.
+In this test, just multiple encryption and signing keys may be available."
+ :tags '(:unstable)
+ (skip-unless (test-conf))
+ (mml-secure-test-key-fixture
+ (lambda ()
+ (let ((mml-secure-openpgp-sign-with-sender t)
+ (mml-secure-smime-sign-with-sender t))
+ (dolist (method (enc-sign-standards) nil)
+ ;; no-exp with just one key
+ (mml-secure-test-en-decrypt
+ method "no-exp@example.org" "no-exp@example.org" 1 t)
+ ;; customized choice for encryption key
+ (mml-secure-test-en-decrypt
+ method "sub@example.org" "no-exp@example.org" 1 t)
+ ;; customized choice for signing key
+ (mml-secure-test-en-decrypt
+ method "no-exp@example.org" "sub@example.org" 1 t)
+ ;; customized choice for both keys
+ (mml-secure-test-en-decrypt
+ method "sub@example.org" "sub@example.org" 1 t)
+ )))))
+
+(ert-deftest mml-secure-en-decrypt-sign-1-2-double ()
+ "Sign and encrypt message; then decrypt and test for expected result.
+In this test, just multiple encryption and signing keys may be available."
+ :tags '(:unstable)
+ (skip-unless (test-conf))
+ (mml-secure-test-key-fixture
+ (lambda ()
+ (let ((mml-secure-openpgp-sign-with-sender t)
+ (mml-secure-smime-sign-with-sender t))
+ ;; Now use both keys to sign. The customized one via sign-with-sender,
+ ;; the other one via the following setting.
+ (let ((mml-secure-openpgp-signers '("F7E79AB7AE31D471"))
+ (mml-secure-smime-signers '("0x5F88E9FC")))
+ (dolist (method (enc-sign-standards) nil)
+ (mml-secure-test-en-decrypt
+ method "no-exp@example.org" "sub@example.org" 2 t)))))))
+
+(ert-deftest mml-secure-en-decrypt-sign-1-3-double ()
+ "Sign and encrypt message; then decrypt and test for expected result.
+In this test, just multiple encryption and signing keys may be available."
+ :tags '(:unstable)
+ (skip-unless (test-conf))
+ (mml-secure-test-key-fixture
+ (lambda ()
+ ;; Now use both keys for sub@example.org to sign an e-mail from
+ ;; a different address (without associated keys).
+ (let ((mml-secure-openpgp-sign-with-sender nil)
+ (mml-secure-smime-sign-with-sender nil)
+ (mml-secure-openpgp-signers
+ '("F7E79AB7AE31D471" "C3999CF1268DBEA2"))
+ (mml-secure-smime-signers '("0x5F88E9FC" "0x479DC6E2")))
+ (dolist (method (enc-sign-standards) nil)
+ (mml-secure-test-en-decrypt
+ method "no-exp@example.org" "no-keys@example.org" 2 t))))))
+
+(ert-deftest mml-secure-en-decrypt-sign-2 ()
+ "Sign and encrypt message; then decrypt and test for expected result.
+In this test, lists of encryption and signing keys are customized."
+ :tags '(:unstable)
+ (skip-unless (test-conf))
+ (mml-secure-test-key-fixture
+ (lambda ()
+ (let ((mml-secure-key-preferences
+ '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt))))
+ (pcontext (epg-make-context 'OpenPGP))
+ (scontext (epg-make-context 'CMS))
+ (mml-secure-openpgp-sign-with-sender t)
+ (mml-secure-smime-sign-with-sender t))
+ (dolist (key '("F7E79AB7AE31D471" "C3999CF1268DBEA2") nil)
+ (mml-secure-cust-record-keys
+ pcontext 'encrypt "sub@example.org" (epg-list-keys pcontext key))
+ (mml-secure-cust-record-keys
+ pcontext 'sign "sub@example.org" (epg-list-keys pcontext key t)))
+ (dolist (key '("0x5F88E9FC" "0x479DC6E2") nil)
+ (mml-secure-cust-record-keys
+ scontext 'encrypt "sub@example.org" (epg-list-keys scontext key))
+ (mml-secure-cust-record-keys
+ scontext 'sign "sub@example.org" (epg-list-keys scontext key t)))
+ (dolist (method (enc-sign-standards) nil)
+ ;; customized choice for encryption key
+ (mml-secure-test-en-decrypt
+ method "sub@example.org" "no-exp@example.org" 1 t)
+ ;; customized choice for signing key
+ (mml-secure-test-en-decrypt
+ method "no-exp@example.org" "sub@example.org" 2 t)
+ ;; customized choice for both keys
+ (mml-secure-test-en-decrypt
+ method "sub@example.org" "sub@example.org" 2 t)
+ )))))
+
+(ert-deftest mml-secure-en-decrypt-sign-3 ()
+ "Sign and encrypt message; then decrypt and test for expected result.
+Use sign-with-sender and encrypt-to-self."
+ :tags '(:unstable)
+ (skip-unless (test-conf))
+ (mml-secure-test-key-fixture
+ (lambda ()
+ (let ((mml-secure-openpgp-sign-with-sender t)
+ (mml-secure-openpgp-encrypt-to-self t)
+ (mml-secure-smime-sign-with-sender t)
+ (mml-secure-smime-encrypt-to-self t))
+ (dolist (method (enc-sign-standards) nil)
+ (mml-secure-test-en-decrypt
+ method "sub@example.org" "no-exp@example.org" 1 t
+ (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2")
+ (cons "02372A42CA6D40FB" "ED7A2135E1582177"))))
+ ))))
+
+(ert-deftest mml-secure-sign-verify-1 ()
+ "Sign message with sender; then verify and test for expected result."
+ (skip-unless (test-conf))
+ (mml-secure-test-key-fixture
+ (lambda ()
+ (dolist (method (sign-standards) nil)
+ (let ((mml-secure-openpgp-sign-with-sender t)
+ (mml-secure-smime-sign-with-sender t))
+ ;; A single signing key for sender sub@example.org is customized
+ ;; in the fixture.
+ (mml-secure-test-en-decrypt
+ method "uid1@example.org" "sub@example.org" 1 nil)
+
+ ;; From sub@example.org, sign with two keys;
+ ;; sign-with-sender and one from signers-variable:
+ (let ((mml-secure-openpgp-signers '("02372A42CA6D40FB"))
+ (mml-secure-smime-signers
+ '("D06AA118653CC38E9D0CAF56ED7A2135E1582177")))
+ (mml-secure-test-en-decrypt
+ method "no-exp@example.org" "sub@example.org" 2 nil))
+ )))))
+
+(ert-deftest mml-secure-sign-verify-3 ()
+ "Try to sign message with expired OpenPGP subkey, which raises an error.
+With Ma Gnus v0.14 and earlier a signature would be created with a wrong key."
+ (skip-unless (test-conf))
+ (should-error
+ (mml-secure-test-key-fixture
+ (lambda ()
+ (let ((with-smime nil)
+ (mml-secure-openpgp-sign-with-sender nil)
+ (mml-secure-openpgp-signers '("501FFD98")))
+ (dolist (method (sign-standards) nil)
+ (mml-secure-test-en-decrypt
+ method "no-exp@example.org" "sign@example.org" 1 nil)
+ ))))))
+
+;; TODO Passphrase passing and caching in Emacs does not seem to work
+;; with gpgsm at all.
+;; Independently of caching settings, a pinentry dialogue is displayed.
+;; Thus, the following tests require the user to enter the correct gpgsm
+;; passphrases at the correct points in time. (Either empty string or
+;; "Passphrase".)
+(ert-deftest mml-secure-en-decrypt-passphrase-cache ()
+ "Encrypt message; then decrypt and test for expected result.
+In this test, a key is used that requires the passphrase \"Passphrase\".
+In the first decryption this passphrase is hardcoded, in the second one it
+ is taken from a cache."
+ (skip-unless (test-conf))
+ (ert-skip "Requires passphrase")
+ (mml-secure-test-key-fixture
+ (lambda ()
+ (dolist (method (enc-standards) nil)
+ (mml-secure-test-en-decrypt-with-passphrase
+ method "uid1@example.org" "sub@example.org" nil
+ ;; Beware! For passphrases copy-sequence is necessary, as they may
+ ;; be erased, which actually changes the function's code and causes
+ ;; multiple invocations to fail. I was surprised...
+ (copy-sequence "Passphrase") t)
+ (mml-secure-test-en-decrypt-with-passphrase
+ method "uid1@example.org" "sub@example.org" nil
+ (copy-sequence "Incorrect") t)))))
+
+(defun mml-secure-en-decrypt-passphrase-no-cache (method)
+ "Encrypt message with METHOD; then decrypt and test for expected result.
+In this test, a key is used that requires the passphrase \"Passphrase\".
+In the first decryption this passphrase is hardcoded, but caching disabled.
+So the second decryption fails."
+ (mml-secure-test-key-fixture
+ (lambda ()
+ (mml-secure-test-en-decrypt-with-passphrase
+ method "uid1@example.org" "sub@example.org" nil
+ (copy-sequence "Passphrase") nil)
+ (mml-secure-test-en-decrypt-with-passphrase
+ method "uid1@example.org" "sub@example.org" nil
+ (copy-sequence "Incorrect") nil nil t))))
+
+(ert-deftest mml-secure-en-decrypt-passphrase-no-cache-openpgp-todo ()
+ "Passphrase caching with OpenPGP only for GnuPG 1.x."
+ (skip-unless (test-conf))
+ (skip-unless (string< (cdr (assq 'version (epg-find-configuration 'OpenPGP)))
+ "2"))
+ (mml-secure-en-decrypt-passphrase-no-cache 'enc-pgp)
+ (mml-secure-en-decrypt-passphrase-no-cache 'enc-pgp-mime))
+
+(ert-deftest mml-secure-en-decrypt-passphrase-no-cache-smime-todo ()
+ "Passphrase caching does not work with S/MIME (and gpgsm)."
+ :expected-result :failed
+ (skip-unless (test-conf))
+ (if with-smime
+ (mml-secure-en-decrypt-passphrase-no-cache 'enc-smime)
+ (should nil)))
+
+
+;; Test truncation of question in y-or-n-p.
+(defun mml-secure-select-preferred-keys-todo ()
+ "Manual customization with truncated question."
+ (mml-secure-test-key-fixture
+ (lambda ()
+ (mml-secure-test-en-decrypt
+ 'enc-pgp-mime
+ "jens.lechtenboerger@informationelle-selbstbestimmung-im-internet.de"
+ "no-exp@example.org" nil t nil nil t))))
+
+(defun mml-secure-select-preferred-keys-ok ()
+ "Manual customization with entire question."
+ (mml-secure-test-fixture
+ (lambda ()
+ (mml-secure-select-preferred-keys
+ (epg-make-context 'OpenPGP)
+ '("jens.lechtenboerger@informationelle-selbstbestimmung-im-internet.de")
+ 'encrypt))
+ t))
+
+
+;; ERT entry points
+(defun mml-secure-run-tests ()
+ "Run all tests with defaults."
+ (ert-run-tests-batch))
+
+(defun mml-secure-run-tests-with-gpg2 ()
+ "Run all tests with gpg2 instead of gpg."
+ (let* ((epg-gpg-program "gpg2"); ~/local/gnupg-2.1.9/PLAY/inst/bin/gpg2
+ (gpg-version (cdr (assq 'version (epg-find-configuration 'OpenPGP))))
+ ;; Empty passphrases do not seem to work with gpgsm in 2.1.x:
+ ;; https://lists.gnupg.org/pipermail/gnupg-users/2015-October/054575.html
+ (with-smime (string< gpg-version "2.1")))
+ (ert-run-tests-batch)))
+
+(defun mml-secure-run-tests-without-smime ()
+ "Skip S/MIME tests (as they require manual passphrase entry)."
+ (let ((with-smime nil))
+ (ert-run-tests-batch)))
+
+(defun mml-sec-test--kill-gpg-agent ()
+ (dolist (pid (list-system-processes))
+ (let ((atts (process-attributes pid)))
+ (when (and (equal (cdr (assq 'user atts)) (user-login-name))
+ (equal (cdr (assq 'comm atts)) "gpg-agent")
+ (string-match
+ (concat "homedir.*"
+ (regexp-quote (expand-file-name "test/data/mml-sec"
+ source-directory)))
+ (cdr (assq 'args atts))))
+ (call-process "kill" nil nil nil (format "%d" pid))))))
+
+;;; mml-sec-tests.el ends here
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el
index 4c808d8372e..811b3677910 100644
--- a/test/lisp/help-fns-tests.el
+++ b/test/lisp/help-fns-tests.el
@@ -56,28 +56,28 @@ Return first line of the output of (describe-function-1 FUNC)."
(should (string-match regexp result))))
(ert-deftest help-fns-test-lisp-macro ()
- (let ((regexp "a Lisp macro in .subr\.el")
+ (let ((regexp "a Lisp macro in .subr\\.el")
(result (help-fns-tests--describe-function 'when)))
(should (string-match regexp result))))
(ert-deftest help-fns-test-lisp-defun ()
- (let ((regexp "a compiled Lisp function in .subr\.el")
+ (let ((regexp "a compiled Lisp function in .subr\\.el")
(result (help-fns-tests--describe-function 'last)))
(should (string-match regexp result))))
(ert-deftest help-fns-test-lisp-defsubst ()
- (let ((regexp "a compiled Lisp function in .subr\.el")
+ (let ((regexp "a compiled Lisp function in .subr\\.el")
(result (help-fns-tests--describe-function 'posn-window)))
(should (string-match regexp result))))
(ert-deftest help-fns-test-alias-to-defun ()
- (let ((regexp "an alias for .set-file-modes. in .subr\.el")
+ (let ((regexp "an alias for .set-file-modes. in .subr\\.el")
(result (help-fns-tests--describe-function 'chmod)))
(should (string-match regexp result))))
(ert-deftest help-fns-test-bug23887 ()
"Test for https://debbugs.gnu.org/23887 ."
- (let ((regexp "an alias for .re-search-forward. in .subr\.el")
+ (let ((regexp "an alias for .re-search-forward. in .subr\\.el")
(result (help-fns-tests--describe-function 'search-forward-regexp)))
(should (string-match regexp result))))
@@ -123,4 +123,55 @@ Return first line of the output of (describe-function-1 FUNC)."
(goto-char (point-min))
(should (looking-at "^font-lock-comment-face is "))))
+(defvar foo-test-map)
+(defvar help-fns-test--describe-keymap-foo)
+
+
+;;; Tests for describe-keymap
+(ert-deftest help-fns-test-find-keymap-name ()
+ (should (equal (help-fns-find-keymap-name lisp-mode-map) 'lisp-mode-map))
+ ;; Follow aliasing.
+ (unwind-protect
+ (progn
+ (defvaralias 'foo-test-map 'lisp-mode-map)
+ (should (equal (help-fns-find-keymap-name foo-test-map) 'lisp-mode-map)))
+ (makunbound 'foo-test-map)))
+
+(ert-deftest help-fns-test-describe-keymap/symbol ()
+ (describe-keymap 'minibuffer-local-must-match-map)
+ (with-current-buffer "*Help*"
+ (should (looking-at "^minibuffer-local-must-match-map is"))))
+
+(ert-deftest help-fns-test-describe-keymap/value ()
+ (describe-keymap minibuffer-local-must-match-map)
+ (with-current-buffer "*Help*"
+ (should (looking-at "^key"))))
+
+(ert-deftest help-fns-test-describe-keymap/not-keymap ()
+ (should-error (describe-keymap nil))
+ (should-error (describe-keymap emacs-version)))
+
+(ert-deftest help-fns-test-describe-keymap/let-bound ()
+ (let ((foobar minibuffer-local-must-match-map))
+ (describe-keymap foobar)
+ (with-current-buffer "*Help*"
+ (should (looking-at "^key")))))
+
+(ert-deftest help-fns-test-describe-keymap/dynamically-bound-no-file ()
+ (setq help-fns-test--describe-keymap-foo minibuffer-local-must-match-map)
+ (describe-keymap 'help-fns-test--describe-keymap-foo)
+ (with-current-buffer "*Help*"
+ (should (looking-at "^help-fns-test--describe-keymap-foo is"))))
+
+;;; Tests for find-lisp-object-file-name
+(ert-deftest help-fns-test-bug24697-function-search ()
+ (should-not (find-lisp-object-file-name 'tab-width 1)))
+
+(ert-deftest help-fns-test-bug24697-non-internal-variable ()
+ (let ((help-fns--test-var (make-symbol "help-fns--test-var")))
+ ;; simulate an internal variable
+ (put help-fns--test-var 'variable-documentation 1)
+ (should-not (find-lisp-object-file-name help-fns--test-var 'defface))
+ (should-not (find-lisp-object-file-name help-fns--test-var 1))))
+
;;; help-fns-tests.el ends here
diff --git a/test/lisp/help-mode-tests.el b/test/lisp/help-mode-tests.el
new file mode 100644
index 00000000000..2b9552a8d81
--- /dev/null
+++ b/test/lisp/help-mode-tests.el
@@ -0,0 +1,169 @@
+;;; help-mode-tests.el --- Tests for help-mode.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'help-mode)
+(require 'pp)
+
+(ert-deftest help-mode-tests-help-buffer ()
+ (let ((help-xref-following nil))
+ (should (equal "*Help*" (help-buffer)))))
+
+(ert-deftest help-mode-tests-help-buffer-current-buffer ()
+ (with-temp-buffer
+ (help-mode)
+ (let ((help-xref-following t))
+ (should (equal (buffer-name (current-buffer))
+ (help-buffer))))))
+
+(ert-deftest help-mode-tests-help-buffer-current-buffer-error ()
+ (with-temp-buffer
+ (let ((help-xref-following t))
+ (should-error (help-buffer)))))
+
+(ert-deftest help-mode-tests-make-xrefs ()
+ (with-temp-buffer
+ (insert "car is a built-in function in ‘C source code’.
+
+(car LIST)
+
+ Probably introduced at or before Emacs version 1.2.
+ This function does not change global state, including the match data.
+
+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’.
+
+See Info node ‘(elisp)Cons Cells’ for a discussion of related basic
+Lisp concepts such as car, cdr, cons cell and list.")
+ (help-mode)
+ (help-make-xrefs)
+ (let ((car-safe-button (button-at 298)))
+ (should (eq (button-type car-safe-button) 'help-symbol))
+ (should (eq (button-get car-safe-button 'help-function)
+ #'describe-symbol)))
+ (let ((cons-cells-info-button (button-at 333)))
+ (should (eq (button-type cons-cells-info-button) 'help-info))
+ (should (eq (button-get cons-cells-info-button 'help-function)
+ #'info)))))
+
+(ert-deftest help-mode-tests-xref-button ()
+ (with-temp-buffer
+ (insert "See also the function ‘interactive’.")
+ (string-match help-xref-symbol-regexp (buffer-string))
+ (help-xref-button 8 'help-function)
+ (should-not (button-at 22))
+ (should-not (button-at 35))
+ (let ((button (button-at 30)))
+ (should (eq (button-type button) 'help-function)))))
+
+(ert-deftest help-mode-tests-insert-xref-button ()
+ (with-temp-buffer
+ (help-insert-xref-button "[back]" 'help-back)
+ (goto-char (point-min))
+ (should (eq (button-type (button-at (point))) 'help-back))
+ (help-insert-xref-button "[forward]" 'help-forward)
+ ;; The back button should stay unchanged.
+ (should (eq (button-type (button-at (point))) 'help-back))))
+
+(ert-deftest help-mode-tests-xref-on-pp ()
+ (with-temp-buffer
+ (insert (pp '(cons fill-column)))
+ (help-xref-on-pp (point-min) (point-max))
+ (goto-char (point-min))
+ (search-forward "co")
+ (should (eq (button-type (button-at (point))) 'help-function))
+ (search-forward "-")
+ (should (eq (button-type (button-at (point))) 'help-variable))))
+
+(ert-deftest help-mode-tests-xref-go-back ()
+ (let ((help-xref-stack
+ `((2 ,(lambda () (erase-buffer) (insert "bar"))))))
+ (with-temp-buffer
+ (insert "foo")
+ (help-xref-go-back (current-buffer))
+ (should (= (point) 2))
+ (should (equal (buffer-string) "bar")))))
+
+(ert-deftest help-mode-tests-xref-go-forward ()
+ (let ((help-xref-forward-stack
+ `((2 ,(lambda () (erase-buffer) (insert "bar"))))))
+ (with-temp-buffer
+ (insert "foo")
+ (help-xref-go-forward (current-buffer))
+ (should (= (point) 2))
+ (should (equal (buffer-string) "bar")))))
+
+(ert-deftest help-mode-tests-go-back ()
+ (let ((help-xref-stack
+ `((2 ,(lambda () (erase-buffer) (insert "bar"))))))
+ (with-temp-buffer
+ (insert "foo")
+ (help-go-back)
+ (should (= (point) 2))
+ (should (equal (buffer-string) "bar")))))
+
+(ert-deftest help-mode-tests-go-back-no-stack ()
+ (let ((help-xref-stack '()))
+ (should-error (help-go-back))))
+
+(ert-deftest help-mode-tests-go-forward ()
+ (let ((help-xref-forward-stack
+ `((2 ,(lambda () (erase-buffer) (insert "bar"))))))
+ (with-temp-buffer
+ (insert "foo")
+ (help-go-forward)
+ (should (= (point) 2))
+ (should (equal (buffer-string) "bar")))))
+
+(ert-deftest help-mode-tests-go-forward-no-stack ()
+ (let ((help-xref-forward-stack '()))
+ (should-error (help-go-forward))))
+
+(ert-deftest help-mode-tests-do-xref ()
+ (with-temp-buffer
+ (help-mode)
+ (help-do-xref 0 #'describe-symbol '(car))
+ (should (looking-at-p "car is a"))
+ (should (string-match-p "[back]" (buffer-string)))))
+
+(ert-deftest help-mode-tests-follow-symbol ()
+ (with-temp-buffer
+ (insert "car")
+ (help-mode)
+ (help-follow-symbol 0)
+ (should (looking-at-p "car is a"))
+ (should (string-match-p "[back]" (buffer-string)))))
+
+(ert-deftest help-mode-tests-follow-symbol-no-symbol ()
+ (with-temp-buffer
+ (insert "fXYEWnRHI0B9w6VJqQIw")
+ (help-mode)
+ (should-error (help-follow-symbol 0))))
+
+(provide 'help-mode-tests)
+;;; help-mode-tests.el ends here
diff --git a/test/lisp/hi-lock-tests.el b/test/lisp/hi-lock-tests.el
index dd2c28053a0..d30a6d08001 100644
--- a/test/lisp/hi-lock-tests.el
+++ b/test/lisp/hi-lock-tests.el
@@ -5,18 +5,20 @@
;; Author: Tino Calancha <tino.calancha@gmail.com>
;; 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 <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -48,5 +50,161 @@
;; Only one match, then we have used just 1 face
(should (equal hi-lock--unused-faces (cdr faces))))))
+(ert-deftest hi-lock-case-fold ()
+ "Test for case-sensitivity."
+ (let ((hi-lock-auto-select-face t))
+ (with-temp-buffer
+ (insert "a A b B\n")
+
+ (dotimes (_ 2) (highlight-regexp "[a]"))
+ (should (= (length (overlays-in (point-min) (point-max))) 2))
+ (unhighlight-regexp "[a]")
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (dotimes (_ 2) (highlight-regexp "[a]" nil nil "a"))
+ (should (= (length (overlays-in (point-min) (point-max))) 2))
+ (unhighlight-regexp "a")
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (dotimes (_ 2) (highlight-regexp "[A]" ))
+ (should (= (length (overlays-in (point-min) (point-max))) 1))
+ (unhighlight-regexp "[A]")
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (dotimes (_ 2) (highlight-regexp "[A]" nil nil "A"))
+ (should (= (length (overlays-in (point-min) (point-max))) 1))
+ (unhighlight-regexp "A")
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (let ((case-fold-search nil)) (dotimes (_ 2) (highlight-regexp "[a]")))
+ (should (= (length (overlays-in (point-min) (point-max))) 1))
+ (unhighlight-regexp "[a]")
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (dotimes (_ 2) (highlight-phrase "a a"))
+ (should (= (length (overlays-in (point-min) (point-max))) 1))
+ (unhighlight-regexp "a a")
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (let ((search-spaces-regexp search-whitespace-regexp)) (highlight-regexp "a a"))
+ (should (= (length (overlays-in (point-min) (point-max))) 1))
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (_prompt _coll _x _y _z _hist defaults)
+ (car defaults))))
+ (call-interactively 'unhighlight-regexp))
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (emacs-lisp-mode)
+ (setq font-lock-mode t)
+
+ (dotimes (_ 2) (highlight-regexp "[a]"))
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ (let ((font-lock-fontified t)) (unhighlight-regexp "[a]"))
+ (should (null (get-text-property 3 'face)))
+
+ (dotimes (_ 2) (highlight-regexp "[a]" nil nil "a"))
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ (let ((font-lock-fontified t)) (unhighlight-regexp "a"))
+ (should (null (get-text-property 3 'face)))
+
+ (dotimes (_ 2) (highlight-regexp "[A]" ))
+ (font-lock-ensure)
+ (should (null (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ (let ((font-lock-fontified t)) (unhighlight-regexp "[A]"))
+ (should (null (get-text-property 3 'face)))
+
+ (dotimes (_ 2) (highlight-regexp "[A]" nil nil "A"))
+ (font-lock-ensure)
+ (should (null (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ (let ((font-lock-fontified t)) (unhighlight-regexp "A"))
+ (should (null (get-text-property 3 'face)))
+
+ (let ((case-fold-search nil)) (dotimes (_ 2) (highlight-regexp "[a]")))
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (should (null (get-text-property 3 'face)))
+ (let ((font-lock-fontified t)) (unhighlight-regexp "[a]"))
+ (should (null (get-text-property 1 'face)))
+
+ (dotimes (_ 2) (highlight-phrase "a a"))
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (let ((font-lock-fontified t)) (unhighlight-regexp "a a"))
+ (should (null (get-text-property 1 'face)))
+
+ (let ((search-spaces-regexp search-whitespace-regexp)) (highlight-regexp "a a"))
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (_prompt _coll _x _y _z _hist defaults)
+ (car defaults)))
+ (font-lock-fontified t))
+ (call-interactively 'unhighlight-regexp))
+ (should (null (get-text-property 1 'face))))))
+
+(ert-deftest hi-lock-unhighlight ()
+ "Test for unhighlighting and `hi-lock--regexps-at-point'."
+ (let ((hi-lock-auto-select-face t))
+ (with-temp-buffer
+ (insert "aAbB\n")
+
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (_prompt _coll _x _y _z _hist defaults)
+ (car defaults))))
+
+ (highlight-regexp "a")
+ (highlight-regexp "b")
+ (should (= (length (overlays-in (point-min) (point-max))) 4))
+ ;; `hi-lock--regexps-at-point' should take regexp "a" at point 1,
+ ;; not the last regexp "b"
+ (goto-char 1)
+ (call-interactively 'unhighlight-regexp)
+ (should (= (length (overlays-in 1 3)) 0))
+ (should (= (length (overlays-in 3 5)) 2))
+ ;; Next call should unhighlight remaining regepxs
+ (call-interactively 'unhighlight-regexp)
+ (should (= (length (overlays-in 3 5)) 0))
+
+ ;; Test unhighlight all
+ (highlight-regexp "a")
+ (highlight-regexp "b")
+ (should (= (length (overlays-in (point-min) (point-max))) 4))
+ (unhighlight-regexp t)
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (emacs-lisp-mode)
+ (setq font-lock-mode t)
+
+ (highlight-regexp "a")
+ (highlight-regexp "b")
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ ;; `hi-lock--regexps-at-point' should take regexp "a" at point 1,
+ ;; not the last regexp "b"
+ (goto-char 1)
+ (let ((font-lock-fontified t)) (call-interactively 'unhighlight-regexp))
+ (should (null (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ ;; Next call should unhighlight remaining regepxs
+ (let ((font-lock-fontified t)) (call-interactively 'unhighlight-regexp))
+ (should (null (get-text-property 3 'face)))
+
+ ;; Test unhighlight all
+ (highlight-regexp "a")
+ (highlight-regexp "b")
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ (let ((font-lock-fontified t)) (unhighlight-regexp t))
+ (should (null (get-text-property 1 'face)))
+ (should (null (get-text-property 3 'face)))))))
+
(provide 'hi-lock-tests)
;;; hi-lock-tests.el ends here
diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el
index 8dadb920547..2211cae305b 100644
--- a/test/lisp/ibuffer-tests.el
+++ b/test/lisp/ibuffer-tests.el
@@ -82,7 +82,7 @@
(test1 '((mode . org-mode)
(or (size-gt . 10000)
(and (not (starred-name))
- (directory . "\<org\>")))))
+ (directory . "<org>")))))
(test2 '((or (mode . emacs-lisp-mode) (file-extension . "elc?")
(and (starred-name) (name . "elisp"))
(mode . lisp-interaction-mode))))
diff --git a/test/lisp/image/gravatar-tests.el b/test/lisp/image/gravatar-tests.el
index e66b5c6803d..43c3024721e 100644
--- a/test/lisp/image/gravatar-tests.el
+++ b/test/lisp/image/gravatar-tests.el
@@ -65,8 +65,13 @@
"Test `gravatar-build-url'."
(let ((gravatar-default-image nil)
(gravatar-force-default nil)
- (gravatar-size nil))
- (should (equal (gravatar-build-url "foo") "\
+ (gravatar-size nil)
+ (gravatar-service 'gravatar)
+ url)
+ (gravatar-build-url "foo" (lambda (u) (setq url u)))
+ (while (not url)
+ (sleep-for 0.01))
+ (should (equal url "\
https://www.gravatar.com/avatar/acbd18db4cc2f85cedef654fccc4a4d8?r=g"))))
;;; gravatar-tests.el ends here
diff --git a/test/lisp/imenu-tests.el b/test/lisp/imenu-tests.el
index 684a856fe04..e5cdb9e65d1 100644
--- a/test/lisp/imenu-tests.el
+++ b/test/lisp/imenu-tests.el
@@ -1,4 +1,4 @@
-;;; imenu-tests.el --- Test suite for imenu.
+;;; imenu-tests.el --- Test suite for imenu. -*- lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
@@ -50,24 +50,23 @@
(setq input (cdr input)))))
result))
-(defmacro imenu-simple-scan-deftest (name doc major-mode content expected-items)
+(defmacro imenu-simple-scan-deftest (name doc mode content expected-items)
"Generate an ert test for mode-own imenu expression.
Run `imenu-create-index-function' at the buffer which content is
-CONTENT with MAJOR-MODE. A generated test runs `imenu-create-index-function'
-at the buffer which content is CONTENT with MAJOR-MODE. Then it compares a list
-of strings which are picked up from the result with EXPECTED-ITEMS."
+CONTENT with major MODE. A generated test runs `imenu-create-index-function'
+at the buffer which content is CONTENT with major MODE. Then it compares a
+list of strings which are picked up from the result with EXPECTED-ITEMS."
(let ((xname (intern (concat "imenu-simple-scan-deftest-" (symbol-name name)))))
`(ert-deftest ,xname ()
- ,doc
+ ,doc
(with-temp-buffer
(insert ,content)
- (funcall ',major-mode)
+ (funcall #',mode)
(let ((result-items (sort (imenu-simple-scan-deftest-gather-strings-from-list
(funcall imenu-create-index-function))
#'string-lessp))
(expected-items (sort (copy-sequence ,expected-items) #'string-lessp)))
- (should (equal result-items expected-items))
- )))))
+ (should (equal result-items expected-items)))))))
(imenu-simple-scan-deftest sh "Test imenu expression for sh-mode." sh-mode "a()
{
diff --git a/test/lisp/info-xref-tests.el b/test/lisp/info-xref-tests.el
index 128b3f25ca5..940aa7d8ad1 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
+;;; info-xref.el --- tests for info-xref.el -*- lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/international/ccl-tests.el b/test/lisp/international/ccl-tests.el
index c8a5512d6f0..16e591f1dd5 100644
--- a/test/lisp/international/ccl-tests.el
+++ b/test/lisp/international/ccl-tests.el
@@ -1,3 +1,5 @@
+;;; ccl-tests.el --- unit tests for ccl.el -*- lexical-binding:t -*-
+
;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -230,3 +232,17 @@ At EOF:
(with-temp-buffer
(ccl-dump prog-midi-code)
(should (equal (buffer-string) prog-midi-dump))))
+
+(ert-deftest ccl-hash-table ()
+ (let ((sym (gensym))
+ (table (make-hash-table :test 'eq)))
+ (puthash 16 17 table)
+ (puthash 17 16 table)
+ (define-translation-hash-table sym table)
+ (let* ((prog `(2
+ ((loop
+ (lookup-integer ,sym r0 r1)))))
+ (compiled (ccl-compile prog))
+ (registers [17 0 0 0 0 0 0 0]))
+ (ccl-execute compiled registers)
+ (should (equal registers [2 16 0 0 0 0 0 1])))))
diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el
index 91e3c2279f0..9520d9d8633 100644
--- a/test/lisp/international/mule-tests.el
+++ b/test/lisp/international/mule-tests.el
@@ -23,6 +23,8 @@
;;; Code:
+(require 'ert-x) ;For `ert-run-keys'.
+
(ert-deftest find-auto-coding--bug27391 ()
"Check that Bug#27391 is fixed."
(with-temp-buffer
@@ -41,12 +43,32 @@
(should (not (multibyte-string-p (encode-coding-char ?a 'utf-8)))))
(ert-deftest mule-cmds--test-universal-coding-system-argument ()
- (skip-unless (not noninteractive))
(should (equal "ccccccccccccccccab"
- (let ((enable-recursive-minibuffers t)
- (unread-command-events
- (append (kbd "C-x RET c u t f - 8 RET C-u C-u c a b RET") nil)))
- (read-string "prompt:")))))
+ (let ((enable-recursive-minibuffers t))
+ (ert-simulate-keys
+ (kbd "C-x RET c u t f - 8 RET C-u C-u c a b RET")
+ (read-string "prompt:"))))))
+
+(ert-deftest mule-utf-7 ()
+ ;; utf-7 and utf-7-imap are not ASCII-compatible.
+ (should-not (coding-system-get 'utf-7 :ascii-compatible-p))
+ (should-not (coding-system-get 'utf-7-imap :ascii-compatible-p))
+ ;; Invariant ASCII subset.
+ (let ((s (apply #'string (append (number-sequence #x20 #x25)
+ (number-sequence #x27 #x7e)))))
+ (should (equal (encode-coding-string s 'utf-7-imap) s))
+ (should (equal (decode-coding-string s 'utf-7-imap) s)))
+ ;; Escaped ampersand.
+ (should (equal (encode-coding-string "a&bcd" 'utf-7-imap) "a&-bcd"))
+ (should (equal (decode-coding-string "a&-bcd" 'utf-7-imap) "a&bcd"))
+ ;; Ability to encode Unicode.
+ (should (equal (check-coding-systems-region "あ" nil '(utf-7-imap)) nil))
+ (should (equal (encode-coding-string "あ" 'utf-7-imap) "&MEI-"))
+ (should (equal (decode-coding-string "&MEI-" 'utf-7-imap) "あ")))
+
+(ert-deftest mule-hz ()
+ ;; The chinese-hz encoding is not ASCII compatible.
+ (should-not (coding-system-get 'chinese-hz :ascii-compatible-p)))
;; Stop "Local Variables" above causing confusion when visiting this file.
diff --git a/test/lisp/international/mule-util-tests.el b/test/lisp/international/mule-util-tests.el
index c571782d635..cc199bd4972 100644
--- a/test/lisp/international/mule-util-tests.el
+++ b/test/lisp/international/mule-util-tests.el
@@ -1,4 +1,4 @@
-;;; mule-util --- tests for international/mule-util.el
+;;; mule-util-tests.el --- tests for international/mule-util.el -*- lexical-binding:t -*-
;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
@@ -81,4 +81,4 @@
(dotimes (i (length mule-util-test-truncate-data))
(mule-util-test-truncate-create i))
-;;; mule-util.el ends here
+;;; 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 03366065ce6..2c60bd318a2 100644
--- a/test/lisp/international/ucs-normalize-tests.el
+++ b/test/lisp/international/ucs-normalize-tests.el
@@ -307,7 +307,7 @@ implementations:
(list " var var))
(dolist (linos (seq-partition newval 8))
(insert (mapconcat #'number-to-string linos " ") "\n"))
- (insert ")\)"))
+ (insert "))"))
(defun ucs-normalize-check-failing-lines ()
(interactive)
@@ -341,4 +341,15 @@ implementations:
(display-buffer (current-buffer)))
(message "No changes to failing lines needed"))))
+(ert-deftest ucs-normalize-save-match-data ()
+ "Verify that match data isn't clobbered (bug#41445)"
+ (string-match (rx (+ digit)) "a47b")
+ (should (equal (match-data t) '(1 3)))
+ (should (equal
+ (decode-coding-string
+ (encode-coding-string "Käsesoßenrührlöffel" 'utf-8-hfs)
+ 'utf-8-hfs)
+ "Käsesoßenrührlöffel"))
+ (should (equal (match-data t) '(1 3))))
+
;;; ucs-normalize-tests.el ends here
diff --git a/test/lisp/isearch-tests.el b/test/lisp/isearch-tests.el
index 3f430ab25f7..516077ac1f8 100644
--- a/test/lisp/isearch-tests.el
+++ b/test/lisp/isearch-tests.el
@@ -4,18 +4,20 @@
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
-;; 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/>.
;;; Code:
diff --git a/test/lisp/jit-lock-tests.el b/test/lisp/jit-lock-tests.el
index 445716c14b9..dfa74cf35e7 100644
--- a/test/lisp/jit-lock-tests.el
+++ b/test/lisp/jit-lock-tests.el
@@ -1,4 +1,4 @@
-;;; jit-lock-tests.el --- tests for jit-lock
+;;; jit-lock-tests.el --- tests for jit-lock -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el
index 05837e83f90..8ac454467d3 100644
--- a/test/lisp/json-tests.el
+++ b/test/lisp/json-tests.el
@@ -1,31 +1,38 @@
-;;; json-tests.el --- Test suite for json.el
+;;; json-tests.el --- Test suite for json.el -*- lexical-binding:t -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
;; Author: Dmitry Gutov <dgutov@yandex.ru>
-;; 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/>.
;;; Code:
(require 'ert)
(require 'json)
+(require 'map)
+(require 'seq)
+
+(eval-when-compile
+ (require 'cl-lib))
(defmacro json-tests--with-temp-buffer (content &rest body)
"Create a temporary buffer with CONTENT and evaluate BODY there.
Point is moved to beginning of the buffer."
- (declare (indent 1))
+ (declare (debug t) (indent 1))
`(with-temp-buffer
(insert ,content)
(goto-char (point-min))
@@ -33,66 +40,107 @@ Point is moved to beginning of the buffer."
;;; Utilities
-(ert-deftest test-json-join ()
- (should (equal (json-join '() ", ") ""))
- (should (equal (json-join '("a" "b" "c") ", ") "a, b, c")))
-
(ert-deftest test-json-alist-p ()
(should (json-alist-p '()))
- (should (json-alist-p '((a 1) (b 2) (c 3))))
- (should (json-alist-p '((:a 1) (:b 2) (:c 3))))
- (should (json-alist-p '(("a" 1) ("b" 2) ("c" 3))))
+ (should (json-alist-p '((()))))
+ (should (json-alist-p '((a))))
+ (should (json-alist-p '((a . 1))))
+ (should (json-alist-p '((a . 1) (b 2) (c))))
+ (should (json-alist-p '((:a) (:b 2) (:c . 3))))
+ (should (json-alist-p '(("a" . 1) ("b" 2) ("c"))))
+ (should-not (json-alist-p '(())))
+ (should-not (json-alist-p '(a)))
+ (should-not (json-alist-p '(a . 1)))
+ (should-not (json-alist-p '((a . 1) . [])))
+ (should-not (json-alist-p '((a . 1) [])))
(should-not (json-alist-p '(:a :b :c)))
(should-not (json-alist-p '(:a 1 :b 2 :c 3)))
- (should-not (json-alist-p '((:a 1) (:b 2) 3))))
+ (should-not (json-alist-p '((:a 1) (:b 2) 3)))
+ (should-not (json-alist-p '((:a 1) (:b 2) ())))
+ (should-not (json-alist-p '(((a) 1) (b 2) (c 3))))
+ (should-not (json-alist-p []))
+ (should-not (json-alist-p [(a . 1)]))
+ (should-not (json-alist-p #s(hash-table))))
(ert-deftest test-json-plist-p ()
(should (json-plist-p '()))
+ (should (json-plist-p '(:a 1)))
(should (json-plist-p '(:a 1 :b 2 :c 3)))
+ (should (json-plist-p '(:a :b)))
+ (should (json-plist-p '(:a :b :c :d)))
+ (should-not (json-plist-p '(a)))
+ (should-not (json-plist-p '(a 1)))
(should-not (json-plist-p '(a 1 b 2 c 3)))
(should-not (json-plist-p '("a" 1 "b" 2 "c" 3)))
+ (should-not (json-plist-p '(:a)))
(should-not (json-plist-p '(:a :b :c)))
- (should-not (json-plist-p '((:a 1) (:b 2) (:c 3)))))
-
-(ert-deftest test-json-plist-reverse ()
- (should (equal (json--plist-reverse '()) '()))
- (should (equal (json--plist-reverse '(:a 1)) '(:a 1)))
- (should (equal (json--plist-reverse '(:a 1 :b 2 :c 3))
+ (should-not (json-plist-p '(:a 1 :b 2 :c)))
+ (should-not (json-plist-p '((:a 1))))
+ (should-not (json-plist-p '((:a 1) (:b 2) (:c 3))))
+ (should-not (json-plist-p []))
+ (should-not (json-plist-p [:a 1]))
+ (should-not (json-plist-p #s(hash-table))))
+
+(ert-deftest test-json-plist-nreverse ()
+ (should (equal (json--plist-nreverse '()) '()))
+ (should (equal (json--plist-nreverse (list :a 1)) '(:a 1)))
+ (should (equal (json--plist-nreverse (list :a 1 :b 2)) '(:b 2 :a 1)))
+ (should (equal (json--plist-nreverse (list :a 1 :b 2 :c 3))
'(:c 3 :b 2 :a 1))))
-(ert-deftest test-json-plist-to-alist ()
- (should (equal (json--plist-to-alist '()) '()))
- (should (equal (json--plist-to-alist '(:a 1)) '((:a . 1))))
- (should (equal (json--plist-to-alist '(:a 1 :b 2 :c 3))
- '((:a . 1) (:b . 2) (:c . 3)))))
-
(ert-deftest test-json-advance ()
(json-tests--with-temp-buffer "{ \"a\": 1 }"
(json-advance 0)
- (should (= (point) (point-min)))
+ (should (bobp))
+ (json-advance)
+ (should (= (point) (1+ (point-min))))
+ (json-advance 0)
+ (should (= (point) (1+ (point-min))))
+ (json-advance 1)
+ (should (= (point) (+ (point-min) 2)))
(json-advance 3)
- (should (= (point) (+ (point-min) 3)))))
+ (should (= (point) (+ (point-min) 5)))))
(ert-deftest test-json-peek ()
(json-tests--with-temp-buffer ""
(should (zerop (json-peek))))
(json-tests--with-temp-buffer "{ \"a\": 1 }"
- (should (equal (json-peek) ?{))))
+ (should (= (json-peek) ?\{))
+ (goto-char (1- (point-max)))
+ (should (= (json-peek) ?\}))
+ (json-advance)
+ (should (zerop (json-peek)))))
(ert-deftest test-json-pop ()
(json-tests--with-temp-buffer ""
(should-error (json-pop) :type 'json-end-of-file))
(json-tests--with-temp-buffer "{ \"a\": 1 }"
- (should (equal (json-pop) ?{))
- (should (= (point) (+ (point-min) 1)))))
+ (should (= (json-pop) ?\{))
+ (should (= (point) (1+ (point-min))))
+ (goto-char (1- (point-max)))
+ (should (= (json-pop) ?\}))
+ (should-error (json-pop) :type 'json-end-of-file)))
(ert-deftest test-json-skip-whitespace ()
+ (json-tests--with-temp-buffer ""
+ (json-skip-whitespace)
+ (should (bobp))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "{}"
+ (json-skip-whitespace)
+ (should (bobp))
+ (json-advance)
+ (json-skip-whitespace)
+ (should (= (point) (1+ (point-min))))
+ (json-advance)
+ (json-skip-whitespace)
+ (should (eobp)))
(json-tests--with-temp-buffer "\t\r\n\f\b { \"a\": 1 }"
(json-skip-whitespace)
- (should (equal (char-after) ?\f)))
+ (should (= (json-peek) ?\f)))
(json-tests--with-temp-buffer "\t\r\n\t { \"a\": 1 }"
(json-skip-whitespace)
- (should (equal (char-after) ?{))))
+ (should (= (json-peek) ?\{))))
;;; Paths
@@ -113,59 +161,243 @@ Point is moved to beginning of the buffer."
(ert-deftest test-json-path-to-position-no-match ()
(let* ((json-string "{\"foo\": {\"bar\": \"baz\"}}")
(matched-path (json-path-to-position 5 json-string)))
- (should (null matched-path))))
+ (should-not matched-path)))
;;; Keywords
(ert-deftest test-json-read-keyword ()
(json-tests--with-temp-buffer "true"
- (should (json-read-keyword "true")))
+ (should (eq (json-read-keyword "true") t))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "true "
+ (should (eq (json-read-keyword "true") t))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "true}"
+ (should (eq (json-read-keyword "true") t))
+ (should (= (point) (+ (point-min) 4))))
+ (json-tests--with-temp-buffer "true false"
+ (should (eq (json-read-keyword "true") t))
+ (should (= (point) (+ (point-min) 5))))
+ (json-tests--with-temp-buffer "true }"
+ (should (eq (json-read-keyword "true") t))
+ (should (= (point) (+ (point-min) 5))))
+ (json-tests--with-temp-buffer "true |"
+ (should (eq (json-read-keyword "true") t))
+ (should (= (point) (+ (point-min) 5))))
+ (json-tests--with-temp-buffer "false"
+ (let ((json-false 'false))
+ (should (eq (json-read-keyword "false") 'false)))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "null"
+ (let ((json-null 'null))
+ (should (eq (json-read-keyword "null") 'null)))
+ (should (eobp))))
+
+(ert-deftest test-json-read-keyword-invalid ()
+ (json-tests--with-temp-buffer ""
+ (should (equal (should-error (json-read-keyword ""))
+ '(json-unknown-keyword "")))
+ (should (equal (should-error (json-read-keyword "true"))
+ '(json-unknown-keyword ()))))
(json-tests--with-temp-buffer "true"
- (should-error
- (json-read-keyword "false") :type 'json-unknown-keyword))
+ (should (equal (should-error (json-read-keyword "false"))
+ '(json-unknown-keyword "true"))))
(json-tests--with-temp-buffer "foo"
- (should-error
- (json-read-keyword "foo") :type 'json-unknown-keyword)))
+ (should (equal (should-error (json-read-keyword "foo"))
+ '(json-unknown-keyword "foo")))
+ (should (equal (should-error (json-read-keyword "bar"))
+ '(json-unknown-keyword "bar"))))
+ (json-tests--with-temp-buffer " true"
+ (should (equal (should-error (json-read-keyword "true"))
+ '(json-unknown-keyword ()))))
+ (json-tests--with-temp-buffer "truefalse"
+ (should (equal (should-error (json-read-keyword "true"))
+ '(json-unknown-keyword "truefalse"))))
+ (json-tests--with-temp-buffer "true|"
+ (should (equal (should-error (json-read-keyword "true"))
+ '(json-unknown-keyword "true")))))
(ert-deftest test-json-encode-keyword ()
(should (equal (json-encode-keyword t) "true"))
- (should (equal (json-encode-keyword json-false) "false"))
- (should (equal (json-encode-keyword json-null) "null")))
+ (let ((json-false 'false))
+ (should (equal (json-encode-keyword 'false) "false"))
+ (should (equal (json-encode-keyword json-false) "false")))
+ (let ((json-null 'null))
+ (should (equal (json-encode-keyword 'null) "null"))
+ (should (equal (json-encode-keyword json-null) "null"))))
;;; Numbers
-(ert-deftest test-json-read-number ()
- (json-tests--with-temp-buffer "3"
- (should (= (json-read-number) 3)))
- (json-tests--with-temp-buffer "-5"
- (should (= (json-read-number) -5)))
- (json-tests--with-temp-buffer "123.456"
- (should (= (json-read-number) 123.456)))
- (json-tests--with-temp-buffer "1e3"
- (should (= (json-read-number) 1e3)))
- (json-tests--with-temp-buffer "2e+3"
- (should (= (json-read-number) 2e3)))
- (json-tests--with-temp-buffer "3E3"
- (should (= (json-read-number) 3e3)))
- (json-tests--with-temp-buffer "1e-7"
- (should (= (json-read-number) 1e-7)))
- (json-tests--with-temp-buffer "abc"
- (should-error (json-read-number) :type 'json-number-format)))
+(ert-deftest test-json-read-integer ()
+ (json-tests--with-temp-buffer "0 "
+ (should (= (json-read-number) 0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-0 "
+ (should (= (json-read-number) 0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "3 "
+ (should (= (json-read-number) 3))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-10 "
+ (should (= (json-read-number) -10))
+ (should (eobp)))
+ (json-tests--with-temp-buffer (format "%d " (1+ most-positive-fixnum))
+ (should (= (json-read-number) (1+ most-positive-fixnum)))
+ (should (eobp)))
+ (json-tests--with-temp-buffer (format "%d " (1- most-negative-fixnum))
+ (should (= (json-read-number) (1- most-negative-fixnum)))
+ (should (eobp))))
+
+(ert-deftest test-json-read-fraction ()
+ (json-tests--with-temp-buffer "0.0 "
+ (should (= (json-read-number) 0.0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-0.0 "
+ (should (= (json-read-number) 0.0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "0.01 "
+ (should (= (json-read-number) 0.01))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-0.01 "
+ (should (= (json-read-number) -0.01))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "123.456 "
+ (should (= (json-read-number) 123.456))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-123.456 "
+ (should (= (json-read-number) -123.456))
+ (should (eobp))))
+
+(ert-deftest test-json-read-exponent ()
+ (json-tests--with-temp-buffer "0e0 "
+ (should (= (json-read-number) 0e0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-0E0 "
+ (should (= (json-read-number) 0e0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-0E+0 "
+ (should (= (json-read-number) 0e0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "0e-0 "
+ (should (= (json-read-number) 0e0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "12e34 "
+ (should (= (json-read-number) 12e34))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-12E34 "
+ (should (= (json-read-number) -12e34))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-12E+34 "
+ (should (= (json-read-number) -12e34))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "12e-34 "
+ (should (= (json-read-number) 12e-34))
+ (should (eobp))))
+
+(ert-deftest test-json-read-fraction-exponent ()
+ (json-tests--with-temp-buffer "0.0e0 "
+ (should (= (json-read-number) 0.0e0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-0.0E0 "
+ (should (= (json-read-number) 0.0e0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "0.12E-0 "
+ (should (= (json-read-number) 0.12e0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-12.34e+56 "
+ (should (= (json-read-number) -12.34e+56))
+ (should (eobp))))
+
+(ert-deftest test-json-read-number-invalid ()
+ (cl-flet ((read (str)
+ ;; Return error and point resulting from reading STR.
+ (json-tests--with-temp-buffer str
+ (cons (should-error (json-read-number)) (point)))))
+ ;; POS is where each of its STRINGS becomes invalid.
+ (pcase-dolist (`(,pos . ,strings)
+ '((1 "" "+" "-" "." "e" "e1" "abc" "++0" "++1"
+ "+0" "+0.0" "+12" "+12.34" "+12.34e56"
+ ".0" "+.0" "-.0" ".12" "+.12" "-.12"
+ ".e0" "+.e0" "-.e0" ".0e0" "+.0e0" "-.0e0")
+ (2 "01" "1ee1" "1e++1")
+ (3 "-01")
+ (4 "0.0.0" "1.1.1" "1e1e1")
+ (5 "-0.0.0" "-1.1.1")))
+ ;; Expected error and point.
+ (let ((res `((json-number-format ,pos) . ,pos)))
+ (dolist (str strings)
+ (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-number 123.456) "123.456"))
+ (let ((bignum (1+ most-positive-fixnum)))
+ (should (equal (json-encode-number bignum)
+ (number-to-string bignum)))))
-;; Strings
+;;; Strings
(ert-deftest test-json-read-escaped-char ()
(json-tests--with-temp-buffer "\\\""
- (should (equal (json-read-escaped-char) ?\"))))
+ (should (= (json-read-escaped-char) ?\"))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "\\\\ "
+ (should (= (json-read-escaped-char) ?\\))
+ (should (= (point) (+ (point-min) 2))))
+ (json-tests--with-temp-buffer "\\b "
+ (should (= (json-read-escaped-char) ?\b))
+ (should (= (point) (+ (point-min) 2))))
+ (json-tests--with-temp-buffer "\\f "
+ (should (= (json-read-escaped-char) ?\f))
+ (should (= (point) (+ (point-min) 2))))
+ (json-tests--with-temp-buffer "\\n "
+ (should (= (json-read-escaped-char) ?\n))
+ (should (= (point) (+ (point-min) 2))))
+ (json-tests--with-temp-buffer "\\r "
+ (should (= (json-read-escaped-char) ?\r))
+ (should (= (point) (+ (point-min) 2))))
+ (json-tests--with-temp-buffer "\\t "
+ (should (= (json-read-escaped-char) ?\t))
+ (should (= (point) (+ (point-min) 2))))
+ (json-tests--with-temp-buffer "\\x "
+ (should (= (json-read-escaped-char) ?x))
+ (should (= (point) (+ (point-min) 2))))
+ (json-tests--with-temp-buffer "\\ud800\\uDC00 "
+ (should (= (json-read-escaped-char) #x10000))
+ (should (= (point) (+ (point-min) 12))))
+ (json-tests--with-temp-buffer "\\ud7ff\\udc00 "
+ (should (= (json-read-escaped-char) #xd7ff))
+ (should (= (point) (+ (point-min) 6))))
+ (json-tests--with-temp-buffer "\\uffff "
+ (should (= (json-read-escaped-char) #xffff))
+ (should (= (point) (+ (point-min) 6))))
+ (json-tests--with-temp-buffer "\\ufffff "
+ (should (= (json-read-escaped-char) #xffff))
+ (should (= (point) (+ (point-min) 6)))))
+
+(ert-deftest test-json-read-escaped-char-invalid ()
+ (json-tests--with-temp-buffer ""
+ (should-error (json-read-escaped-char)))
+ (json-tests--with-temp-buffer "\\"
+ (should-error (json-read-escaped-char) :type 'json-end-of-file))
+ (json-tests--with-temp-buffer "\\ufff "
+ (should (equal (should-error (json-read-escaped-char))
+ (list 'json-string-escape (+ (point-min) 2)))))
+ (json-tests--with-temp-buffer "\\ufffg "
+ (should (equal (should-error (json-read-escaped-char))
+ (list 'json-string-escape (+ (point-min) 2))))))
(ert-deftest test-json-read-string ()
+ (json-tests--with-temp-buffer ""
+ (should-error (json-read-string)))
(json-tests--with-temp-buffer "\"formfeed\f\""
- (should-error (json-read-string) :type 'json-string-format))
+ (should (equal (should-error (json-read-string))
+ '(json-string-format ?\f))))
+ (json-tests--with-temp-buffer "\"\""
+ (should (equal (json-read-string) "")))
(json-tests--with-temp-buffer "\"foo \\\"bar\\\"\""
(should (equal (json-read-string) "foo \"bar\"")))
(json-tests--with-temp-buffer "\"abcαβγ\""
@@ -175,57 +407,117 @@ Point is moved to beginning of the buffer."
;; Bug#24784
(json-tests--with-temp-buffer "\"\\uD834\\uDD1E\""
(should (equal (json-read-string) "\U0001D11E")))
+ (json-tests--with-temp-buffer "f"
+ (should-error (json-read-string) :type 'json-end-of-file))
(json-tests--with-temp-buffer "foo"
- (should-error (json-read-string) :type 'json-string-format)))
+ (should-error (json-read-string) :type 'json-end-of-file)))
(ert-deftest test-json-encode-string ()
+ (should (equal (json-encode-string "") "\"\""))
+ (should (equal (json-encode-string "a") "\"a\""))
(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\"")))
(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-error (json-encode-key 5) :type 'json-key-format)
- (should-error (json-encode-key ["foo"]) :type 'json-key-format)
- (should-error (json-encode-key '("foo")) :type 'json-key-format))
+ (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
(ert-deftest test-json-new-object ()
(let ((json-object-type 'alist))
- (should (equal (json-new-object) '())))
+ (should-not (json-new-object)))
(let ((json-object-type 'plist))
- (should (equal (json-new-object) '())))
+ (should-not (json-new-object)))
(let* ((json-object-type 'hash-table)
(json-object (json-new-object)))
(should (hash-table-p json-object))
- (should (= (hash-table-count json-object) 0))))
+ (should (map-empty-p json-object))
+ (should (eq (hash-table-test json-object) #'equal))))
-(ert-deftest test-json-add-to-object ()
+(ert-deftest test-json-add-to-alist ()
(let* ((json-object-type 'alist)
- (json-key-type nil)
(obj (json-new-object)))
- (setq obj (json-add-to-object obj "a" 1))
- (setq obj (json-add-to-object obj "b" 2))
- (should (equal (assq 'a obj) '(a . 1)))
- (should (equal (assq 'b obj) '(b . 2))))
+ (let ((json-key-type nil))
+ (setq obj (json-add-to-object obj "a" 1))
+ (setq obj (json-add-to-object obj "b" 2))
+ (should (equal (assq 'a obj) '(a . 1)))
+ (should (equal (assq 'b obj) '(b . 2))))
+ (let ((json-key-type 'symbol))
+ (setq obj (json-add-to-object obj "c" 3))
+ (setq obj (json-add-to-object obj "d" 4))
+ (should (equal (assq 'c obj) '(c . 3)))
+ (should (equal (assq 'd obj) '(d . 4))))
+ (let ((json-key-type 'keyword))
+ (setq obj (json-add-to-object obj "e" 5))
+ (setq obj (json-add-to-object obj "f" 6))
+ (should (equal (assq :e obj) '(:e . 5)))
+ (should (equal (assq :f obj) '(:f . 6))))
+ (let ((json-key-type 'string))
+ (setq obj (json-add-to-object obj "g" 7))
+ (setq obj (json-add-to-object obj "h" 8))
+ (should (equal (assoc "g" obj) '("g" . 7)))
+ (should (equal (assoc "h" obj) '("h" . 8))))))
+
+(ert-deftest test-json-add-to-plist ()
(let* ((json-object-type 'plist)
- (json-key-type nil)
(obj (json-new-object)))
- (setq obj (json-add-to-object obj "a" 1))
- (setq obj (json-add-to-object obj "b" 2))
- (should (= (plist-get obj :a) 1))
- (should (= (plist-get obj :b) 2)))
+ (let ((json-key-type nil))
+ (setq obj (json-add-to-object obj "a" 1))
+ (setq obj (json-add-to-object obj "b" 2))
+ (should (= (plist-get obj :a) 1))
+ (should (= (plist-get obj :b) 2)))
+ (let ((json-key-type 'keyword))
+ (setq obj (json-add-to-object obj "c" 3))
+ (setq obj (json-add-to-object obj "d" 4))
+ (should (= (plist-get obj :c) 3))
+ (should (= (plist-get obj :d) 4)))
+ (let ((json-key-type 'symbol))
+ (setq obj (json-add-to-object obj "e" 5))
+ (setq obj (json-add-to-object obj "f" 6))
+ (should (= (plist-get obj 'e) 5))
+ (should (= (plist-get obj 'f) 6)))
+ (let ((json-key-type 'string))
+ (setq obj (json-add-to-object obj "g" 7))
+ (setq obj (json-add-to-object obj "h" 8))
+ (should (= (lax-plist-get obj "g") 7))
+ (should (= (lax-plist-get obj "h") 8)))))
+
+(ert-deftest test-json-add-to-hash-table ()
(let* ((json-object-type 'hash-table)
- (json-key-type nil)
(obj (json-new-object)))
- (setq obj (json-add-to-object obj "a" 1))
- (setq obj (json-add-to-object obj "b" 2))
- (should (= (gethash "a" obj) 1))
- (should (= (gethash "b" obj) 2))))
+ (let ((json-key-type nil))
+ (setq obj (json-add-to-object obj "a" 1))
+ (setq obj (json-add-to-object obj "b" 2))
+ (should (= (gethash "a" obj) 1))
+ (should (= (gethash "b" obj) 2)))
+ (let ((json-key-type 'string))
+ (setq obj (json-add-to-object obj "c" 3))
+ (setq obj (json-add-to-object obj "d" 4))
+ (should (= (gethash "c" obj) 3))
+ (should (= (gethash "d" obj) 4)))
+ (let ((json-key-type 'symbol))
+ (setq obj (json-add-to-object obj "e" 5))
+ (setq obj (json-add-to-object obj "f" 6))
+ (should (= (gethash 'e obj) 5))
+ (should (= (gethash 'f obj) 6)))
+ (let ((json-key-type 'keyword))
+ (setq obj (json-add-to-object obj "g" 7))
+ (setq obj (json-add-to-object obj "h" 8))
+ (should (= (gethash :g obj) 7))
+ (should (= (gethash :h obj) 8)))))
(ert-deftest test-json-read-object ()
(json-tests--with-temp-buffer "{ \"a\": 1, \"b\": 2 }"
@@ -238,94 +530,384 @@ Point is moved to beginning of the buffer."
(let* ((json-object-type 'hash-table)
(hash-table (json-read-object)))
(should (= (gethash "a" hash-table) 1))
- (should (= (gethash "b" hash-table) 2))))
+ (should (= (gethash "b" hash-table) 2)))))
+
+(ert-deftest test-json-read-object-empty ()
+ (json-tests--with-temp-buffer "{}"
+ (let ((json-object-type 'alist))
+ (should-not (save-excursion (json-read-object))))
+ (let ((json-object-type 'plist))
+ (should-not (save-excursion (json-read-object))))
+ (let* ((json-object-type 'hash-table)
+ (hash-table (json-read-object)))
+ (should (hash-table-p hash-table))
+ (should (map-empty-p hash-table)))))
+
+(ert-deftest test-json-read-object-invalid ()
+ (json-tests--with-temp-buffer "{ \"a\" 1, \"b\": 2 }"
+ (should (equal (should-error (json-read-object))
+ '(json-object-format ":" ?1))))
(json-tests--with-temp-buffer "{ \"a\": 1 \"b\": 2 }"
- (should-error (json-read-object) :type 'json-object-format)))
+ (should (equal (should-error (json-read-object))
+ '(json-object-format "," ?\")))))
+
+(ert-deftest test-json-read-object-function ()
+ (let* ((pre nil)
+ (post nil)
+ (keys '("b" "a"))
+ (json-pre-element-read-function
+ (lambda (key)
+ (setq pre 'pre)
+ (should (equal key (pop keys)))))
+ (json-post-element-read-function
+ (lambda () (setq post 'post))))
+ (json-tests--with-temp-buffer "{ \"b\": 2, \"a\": 1 }"
+ (json-read-object)
+ (should (eq pre 'pre))
+ (should (eq post 'post)))))
(ert-deftest test-json-encode-hash-table ()
- (let ((hash-table (make-hash-table))
- (json-encoding-object-sort-predicate 'string<)
+ (let ((json-encoding-object-sort-predicate nil)
(json-encoding-pretty-print nil))
- (puthash :a 1 hash-table)
- (puthash :b 2 hash-table)
- (puthash :c 3 hash-table)
- (should (equal (json-encode hash-table)
- "{\"a\":1,\"b\":2,\"c\":3}"))))
-
-(ert-deftest json-encode-simple-alist ()
- (let ((json-encoding-pretty-print nil))
- (should (equal (json-encode '((a . 1) (b . 2)))
- "{\"a\":1,\"b\":2}"))))
-
-(ert-deftest test-json-encode-plist ()
- (let ((plist '(:a 1 :b 2))
+ (should (equal (json-encode-hash-table #s(hash-table)) "{}"))
+ (should (equal (json-encode-hash-table #s(hash-table data (a 1)))
+ "{\"a\":1}"))
+ (should (member (json-encode-hash-table #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)))
+ '("{\"a\":1,\"b\":2,\"c\":3}"
+ "{\"a\":1,\"c\":3,\"b\":2}"
+ "{\"b\":2,\"a\":1,\"c\":3}"
+ "{\"b\":2,\"c\":3,\"a\":1}"
+ "{\"c\":3,\"a\":1,\"b\":2}"
+ "{\"c\":3,\"b\":2,\"a\":1}")))))
+
+(ert-deftest test-json-encode-hash-table-pretty ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (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)))
+ '("{\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)))
+ '("{\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}"
+ "{\n \"b\": 2,\n \"c\": 3,\n \"a\": 1\n}"
+ "{\n \"c\": 3,\n \"a\": 1,\n \"b\": 2\n}"
+ "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1\n}")))))
+
+(ert-deftest test-json-encode-hash-table-lisp-style ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (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)))
+ '("{\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)))
+ '("{\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}"
+ "{\n \"b\": 2,\n \"c\": 3,\n \"a\": 1}"
+ "{\n \"c\": 3,\n \"a\": 1,\n \"b\": 2}"
+ "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1}")))))
+
+(ert-deftest test-json-encode-hash-table-sort ()
+ (let ((json-encoding-object-sort-predicate #'string<)
(json-encoding-pretty-print nil))
- (should (equal (json-encode plist) "{\"a\":1,\"b\":2}"))))
-
-(ert-deftest test-json-encode-plist-with-sort-predicate ()
- (let ((plist '(:c 3 :a 1 :b 2))
- (json-encoding-object-sort-predicate 'string<)
+ (pcase-dolist (`(,in . ,out)
+ '((#s(hash-table) . "{}")
+ (#s(hash-table data (a 1)) . "{\"a\":1}")
+ (#s(hash-table data (b 2 a 1)) . "{\"a\":1,\"b\":2}")
+ (#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))
+ ;; Ensure sorting isn't destructive.
+ (should (seq-set-equal-p (map-pairs in) copy))))))
+
+(ert-deftest test-json-encode-alist ()
+ (let ((json-encoding-object-sort-predicate nil)
(json-encoding-pretty-print nil))
- (should (equal (json-encode plist) "{\"a\":1,\"b\":2,\"c\":3}"))))
+ (should (equal (json-encode-alist ()) "{}"))
+ (should (equal (json-encode-alist '((a . 1))) "{\"a\":1}"))
+ (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}"))))
+
+(ert-deftest test-json-encode-alist-pretty ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print t)
+ (json-encoding-default-indentation " ")
+ (json-encoding-lisp-style-closings nil))
+ (should (equal (json-encode-alist ()) "{}"))
+ (should (equal (json-encode-alist '((a . 1))) "{\n \"a\": 1\n}"))
+ (should (equal (json-encode-alist '((b . 2) (a . 1)))
+ "{\n \"b\": 2,\n \"a\": 1\n}"))
+ (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1)))
+ "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1\n}"))))
+
+(ert-deftest test-json-encode-alist-lisp-style ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print t)
+ (json-encoding-default-indentation " ")
+ (json-encoding-lisp-style-closings t))
+ (should (equal (json-encode-alist ()) "{}"))
+ (should (equal (json-encode-alist '((a . 1))) "{\n \"a\": 1}"))
+ (should (equal (json-encode-alist '((b . 2) (a . 1)))
+ "{\n \"b\": 2,\n \"a\": 1}"))
+ (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1)))
+ "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1}"))))
+
+(ert-deftest test-json-encode-alist-sort ()
+ (let ((json-encoding-object-sort-predicate #'string<)
+ (json-encoding-pretty-print nil))
+ (pcase-dolist (`(,in . ,out)
+ '((() . "{}")
+ (((a . 1)) . "{\"a\":1}")
+ (((b . 2) (a . 1)) . "{\"a\":1,\"b\":2}")
+ (((c . 3) (b . 2) (a . 1))
+ . "{\"a\":1,\"b\":2,\"c\":3}")))
+ (let ((copy (copy-alist in)))
+ (should (equal (json-encode-alist in) out))
+ ;; Ensure sorting isn't destructive (bug#40693).
+ (should (equal in copy))))))
-(ert-deftest test-json-encode-alist-with-sort-predicate ()
- (let ((alist '((:c . 3) (:a . 1) (:b . 2)))
- (json-encoding-object-sort-predicate 'string<)
+(ert-deftest test-json-encode-plist ()
+ (let ((json-encoding-object-sort-predicate nil)
(json-encoding-pretty-print nil))
- (should (equal (json-encode alist) "{\"a\":1,\"b\":2,\"c\":3}"))))
+ (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}"))))
+
+(ert-deftest test-json-encode-plist-pretty ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print t)
+ (json-encoding-default-indentation " ")
+ (json-encoding-lisp-style-closings nil))
+ (should (equal (json-encode-plist ()) "{}"))
+ (should (equal (json-encode-plist '(:a 1)) "{\n \"a\": 1\n}"))
+ (should (equal (json-encode-plist '(:b 2 :a 1))
+ "{\n \"b\": 2,\n \"a\": 1\n}"))
+ (should (equal (json-encode-plist '(:c 3 :b 2 :a 1))
+ "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1\n}"))))
+
+(ert-deftest test-json-encode-plist-lisp-style ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print t)
+ (json-encoding-default-indentation " ")
+ (json-encoding-lisp-style-closings t))
+ (should (equal (json-encode-plist ()) "{}"))
+ (should (equal (json-encode-plist '(:a 1)) "{\n \"a\": 1}"))
+ (should (equal (json-encode-plist '(:b 2 :a 1))
+ "{\n \"b\": 2,\n \"a\": 1}"))
+ (should (equal (json-encode-plist '(:c 3 :b 2 :a 1))
+ "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1}"))))
+
+(ert-deftest test-json-encode-plist-sort ()
+ (let ((json-encoding-object-sort-predicate #'string<)
+ (json-encoding-pretty-print nil))
+ (pcase-dolist (`(,in . ,out)
+ '((() . "{}")
+ ((:a 1) . "{\"a\":1}")
+ ((:b 2 :a 1) . "{\"a\":1,\"b\":2}")
+ ((:c 3 :b 2 :a 1) . "{\"a\":1,\"b\":2,\"c\":3}")))
+ (let ((copy (copy-sequence in)))
+ (should (equal (json-encode-plist in) out))
+ ;; Ensure sorting isn't destructive.
+ (should (equal in copy))))))
(ert-deftest test-json-encode-list ()
- (let ((json-encoding-pretty-print nil))
- (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 (equal (json-encode-list '(1 2 3 4)) "[1,2,3,4]"))))
+ (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)))
+ "{\"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])))))
;;; Arrays
(ert-deftest test-json-read-array ()
(let ((json-array-type 'vector))
+ (json-tests--with-temp-buffer "[]"
+ (should (equal (json-read-array) [])))
+ (json-tests--with-temp-buffer "[ ]"
+ (should (equal (json-read-array) [])))
+ (json-tests--with-temp-buffer "[1]"
+ (should (equal (json-read-array) [1])))
(json-tests--with-temp-buffer "[1, 2, \"a\", \"b\"]"
(should (equal (json-read-array) [1 2 "a" "b"]))))
(let ((json-array-type 'list))
+ (json-tests--with-temp-buffer "[]"
+ (should-not (json-read-array)))
+ (json-tests--with-temp-buffer "[ ]"
+ (should-not (json-read-array)))
+ (json-tests--with-temp-buffer "[1]"
+ (should (equal (json-read-array) '(1))))
(json-tests--with-temp-buffer "[1, 2, \"a\", \"b\"]"
(should (equal (json-read-array) '(1 2 "a" "b")))))
(json-tests--with-temp-buffer "[1 2]"
- (should-error (json-read-array) :type 'json-error)))
+ (should (equal (should-error (json-read-array))
+ '(json-array-format "," ?2)))))
+
+(ert-deftest test-json-read-array-function ()
+ (let* ((pre nil)
+ (post nil)
+ (keys '(0 1))
+ (json-pre-element-read-function
+ (lambda (key)
+ (setq pre 'pre)
+ (should (equal key (pop keys)))))
+ (json-post-element-read-function
+ (lambda () (setq post 'post))))
+ (json-tests--with-temp-buffer "[1, 0]"
+ (json-read-array)
+ (should (eq pre 'pre))
+ (should (eq post 'post)))))
(ert-deftest test-json-encode-array ()
- (let ((json-encoding-pretty-print nil))
- (should (equal (json-encode-array [1 2 "a" "b"])
- "[1,2,\"a\",\"b\"]"))))
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print nil))
+ (should (equal (json-encode-array ()) "[]"))
+ (should (equal (json-encode-array []) "[]"))
+ (should (equal (json-encode-array '(1)) "[1]"))
+ (should (equal (json-encode-array '[1]) "[1]"))
+ (should (equal (json-encode-array '(2 1)) "[2,1]"))
+ (should (equal (json-encode-array '[2 1]) "[2,1]"))
+ (should (equal (json-encode-array '[:b a 2 1]) "[\"b\",\"a\",2,1]"))))
+
+(ert-deftest test-json-encode-array-pretty ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print t)
+ (json-encoding-default-indentation " ")
+ (json-encoding-lisp-style-closings nil))
+ (should (equal (json-encode-array ()) "[]"))
+ (should (equal (json-encode-array []) "[]"))
+ (should (equal (json-encode-array '(1)) "[\n 1\n]"))
+ (should (equal (json-encode-array '[1]) "[\n 1\n]"))
+ (should (equal (json-encode-array '(2 1)) "[\n 2,\n 1\n]"))
+ (should (equal (json-encode-array '[2 1]) "[\n 2,\n 1\n]"))
+ (should (equal (json-encode-array '[:b a 2 1])
+ "[\n \"b\",\n \"a\",\n 2,\n 1\n]"))))
+
+(ert-deftest test-json-encode-array-lisp-style ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print t)
+ (json-encoding-default-indentation " ")
+ (json-encoding-lisp-style-closings t))
+ (should (equal (json-encode-array ()) "[]"))
+ (should (equal (json-encode-array []) "[]"))
+ (should (equal (json-encode-array '(1)) "[\n 1]"))
+ (should (equal (json-encode-array '[1]) "[\n 1]"))
+ (should (equal (json-encode-array '(2 1)) "[\n 2,\n 1]"))
+ (should (equal (json-encode-array '[2 1]) "[\n 2,\n 1]"))
+ (should (equal (json-encode-array '[:b a 2 1])
+ "[\n \"b\",\n \"a\",\n 2,\n 1]"))))
;;; Reader
(ert-deftest test-json-read ()
- (json-tests--with-temp-buffer "{ \"a\": 1 }"
- ;; We don't care exactly what the return value is (that is tested
- ;; in `test-json-read-object'), but it should parse without error.
- (should (json-read)))
+ (pcase-dolist (`(,fn . ,contents)
+ '((json-read-string "\"\"" "\"a\"")
+ (json-read-array "[]" "[1]")
+ (json-read-object "{}" "{\"a\":1}")
+ (json-read-keyword "null" "false" "true")
+ (json-read-number
+ "-0" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")))
+ (dolist (content contents)
+ ;; Check that leading whitespace is skipped.
+ (dolist (str (list content (concat " " content)))
+ (cl-letf* ((called nil)
+ ((symbol-function fn)
+ (lambda (&rest _) (setq called t))))
+ (json-tests--with-temp-buffer str
+ ;; We don't care exactly what the return value is (that is
+ ;; tested elsewhere), but it should parse without error.
+ (should (json-read))
+ (should called)))))))
+
+(ert-deftest test-json-read-invalid ()
(json-tests--with-temp-buffer ""
(should-error (json-read) :type 'json-end-of-file))
- (json-tests--with-temp-buffer "xxx"
- (let ((err (should-error (json-read) :type 'json-readtable-error)))
- (should (equal (cdr err) '(?x))))))
+ (json-tests--with-temp-buffer " "
+ (should-error (json-read) :type 'json-end-of-file))
+ (json-tests--with-temp-buffer "x"
+ (should (equal (should-error (json-read))
+ '(json-readtable-error ?x))))
+ (json-tests--with-temp-buffer " x"
+ (should (equal (should-error (json-read))
+ '(json-readtable-error ?x)))))
(ert-deftest test-json-read-from-string ()
- (let ((json-string "{ \"a\": 1 }"))
- (json-tests--with-temp-buffer json-string
- (should (equal (json-read-from-string json-string)
+ (dolist (str '("\"\"" "\"a\"" "[]" "[1]" "{}" "{\"a\":1}"
+ "null" "false" "true" "0" "123"))
+ (json-tests--with-temp-buffer str
+ (should (equal (json-read-from-string str)
(json-read))))))
-;;; JSON encoder
+;;; Encoder
(ert-deftest test-json-encode ()
+ (should (equal (json-encode t) "true"))
+ (let ((json-null 'null))
+ (should (equal (json-encode json-null) "null")))
+ (let ((json-false 'false))
+ (should (equal (json-encode json-false) "false")))
+ (should (equal (json-encode "") "\"\""))
(should (equal (json-encode "foo") "\"foo\""))
+ (should (equal (json-encode :) "\"\""))
+ (should (equal (json-encode :foo) "\"foo\""))
+ (should (equal (json-encode '(1)) "[1]"))
+ (should (equal (json-encode 'foo) "\"foo\""))
+ (should (equal (json-encode 0) "0"))
+ (should (equal (json-encode 123) "123"))
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print nil))
+ (should (equal (json-encode []) "[]"))
+ (should (equal (json-encode [1]) "[1]"))
+ (should (equal (json-encode #s(hash-table)) "{}"))
+ (should (equal (json-encode #s(hash-table data (a 1))) "{\"a\":1}")))
(with-temp-buffer
- (should-error (json-encode (current-buffer)) :type 'json-error)))
+ (should (equal (should-error (json-encode (current-buffer)))
+ (list 'json-error (current-buffer))))))
-;;; Pretty-print
+;;; Pretty printing & minimizing
(defun json-tests-equal-pretty-print (original &optional expected)
"Abort current test if pretty-printing ORIGINAL does not yield EXPECTED.
@@ -351,46 +933,45 @@ nil, ORIGINAL should stay unchanged by pretty-printing."
(json-tests-equal-pretty-print "0.123"))
(ert-deftest test-json-pretty-print-object ()
- ;; empty (regression test for bug#24252)
- (json-tests-equal-pretty-print
- "{}"
- "{\n}")
- ;; one pair
+ ;; Empty (regression test for bug#24252).
+ (json-tests-equal-pretty-print "{}")
+ ;; One pair.
(json-tests-equal-pretty-print
"{\"key\":1}"
"{\n \"key\": 1\n}")
- ;; two pairs
+ ;; Two pairs.
(json-tests-equal-pretty-print
"{\"key1\":1,\"key2\":2}"
"{\n \"key1\": 1,\n \"key2\": 2\n}")
- ;; embedded object
+ ;; Nested object.
(json-tests-equal-pretty-print
"{\"foo\":{\"key\":1}}"
"{\n \"foo\": {\n \"key\": 1\n }\n}")
- ;; embedded array
+ ;; Nested array.
(json-tests-equal-pretty-print
"{\"key\":[1,2]}"
"{\n \"key\": [\n 1,\n 2\n ]\n}"))
(ert-deftest test-json-pretty-print-array ()
- ;; empty
+ ;; Empty.
(json-tests-equal-pretty-print "[]")
- ;; one item
+ ;; One item.
(json-tests-equal-pretty-print
"[1]"
"[\n 1\n]")
- ;; two items
+ ;; Two items.
(json-tests-equal-pretty-print
"[1,2]"
"[\n 1,\n 2\n]")
- ;; embedded object
+ ;; Nested object.
(json-tests-equal-pretty-print
"[{\"key\":1}]"
"[\n {\n \"key\": 1\n }\n]")
- ;; embedded array
+ ;; Nested array.
(json-tests-equal-pretty-print
"[[1,2]]"
"[\n [\n 1,\n 2\n ]\n]"))
(provide 'json-tests)
+
;;; json-tests.el ends here
diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el
index 6c08023d4f3..1ef83daed24 100644
--- a/test/lisp/jsonrpc-tests.el
+++ b/test/lisp/jsonrpc-tests.el
@@ -5,18 +5,20 @@
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: tests
-;; 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:
@@ -165,7 +167,7 @@
(ert-deftest deferred-action-toolate ()
:tags '(:expensive-test)
- "Deferred request fails because noone clears the flag."
+ "Deferred request fails because no one clears the flag."
(jsonrpc--with-emacsrpc-fixture (conn)
(should-error
(jsonrpc-request conn '+ [1 2]
diff --git a/test/lisp/mail/flow-fill-tests.el b/test/lisp/mail/flow-fill-tests.el
index 4d435aeda71..c2e4178b7d4 100644
--- a/test/lisp/mail/flow-fill-tests.el
+++ b/test/lisp/mail/flow-fill-tests.el
@@ -35,7 +35,8 @@
">>> unmuzzled ratsbane!\n"
">>>> Henceforth, the coding style is to be strictly \n"
">>>> enforced, including the use of only upper case.\n"
- ">>>>> I've noticed a lack of adherence to the coding \n"
+ ">>>>> I've noticed a lack of adherence to \n"
+ ">>>>> the coding \n"
">>>>> styles, of late.\n"
">>>>>> Any complaints?\n"))
(output
diff --git a/test/lisp/mail/footnote-tests.el b/test/lisp/mail/footnote-tests.el
index 79f48072391..6594aa2b3e5 100644
--- a/test/lisp/mail/footnote-tests.el
+++ b/test/lisp/mail/footnote-tests.el
@@ -5,18 +5,20 @@
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; 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 <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/mail/qp-tests.el b/test/lisp/mail/qp-tests.el
new file mode 100644
index 00000000000..8d704499334
--- /dev/null
+++ b/test/lisp/mail/qp-tests.el
@@ -0,0 +1,74 @@
+;;; qp-tests.el --- Tests for qp.el -*- lexical-binding:t; coding:utf-8 -*-
+
+;; Copyright (C) 2020 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 'qp)
+
+;; Quote by Antoine de Saint-Exupéry, Citadelle (1948)
+;; from https://en.wikipedia.org/wiki/Quoted-printable
+(defvar qp-tests-quote-qp
+ (concat "J'interdis aux marchands de vanter trop leurs marchandises. Car ils se font =\n"
+ "vite p=C3=A9dagogues et t'enseignent comme but ce qui n'est par essence qu'=\n"
+ "un moyen, et te trompant ainsi sur la route =C3=A0 suivre les voil=C3=A0 bi=\n"
+ "ent=C3=B4t qui te d=C3=A9gradent, car si leur musique est vulgaire ils te f=\n"
+ "abriquent pour te la vendre une =C3=A2me vulgaire."))
+(defvar qp-tests-quote-utf8
+ (concat "J'interdis aux marchands de vanter trop leurs marchandises. Car ils se font "
+ "vite pédagogues et t'enseignent comme but ce qui n'est par essence qu'"
+ "un moyen, et te trompant ainsi sur la route à suivre les voilà bi"
+ "entôt qui te dégradent, car si leur musique est vulgaire ils te f"
+ "abriquent pour te la vendre une âme vulgaire."))
+
+(ert-deftest qp-test--quoted-printable-decode-region ()
+ (with-temp-buffer
+ (insert qp-tests-quote-qp)
+ (encode-coding-region (point-min) (point-max) 'utf-8)
+ (quoted-printable-decode-region (point-min) (point-max) 'utf-8)
+ (should (equal (buffer-string) qp-tests-quote-utf8))))
+
+(ert-deftest qp-test--quoted-printable-decode-string ()
+ (should (equal (quoted-printable-decode-string "foo!") "foo!"))
+ (should (equal (quoted-printable-decode-string "=0C") "\^L"))
+ (should (equal (quoted-printable-decode-string "=3D") "="))
+ (should (equal (quoted-printable-decode-string "=A1Hola, se=F1or!?")
+ "\241Hola, se\361or!?")))
+
+(ert-deftest qp-test--quoted-printable-encode-region ()
+ (with-temp-buffer
+ (insert (make-string 26 ?=))
+ ;; (encode-coding-region (point-min) (point-max) 'utf-8)
+ (quoted-printable-encode-region (point-min) (point-max) t)
+ (should (equal (buffer-string)
+ (concat "=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D"
+ "=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=\n=3D")))))
+
+(ert-deftest qp-test--quoted-printable-encode-string ()
+ (should (equal (quoted-printable-encode-string "\241Hola, se\361or!?")
+ "=A1Hola, se=F1or!?"))
+ ;; Multibyte character.
+ (should-error (quoted-printable-encode-string "å")))
+
+(provide 'qp-tests)
+;;; qp-tests.el ends here
diff --git a/test/lisp/mail/rfc2045-tests.el b/test/lisp/mail/rfc2045-tests.el
new file mode 100644
index 00000000000..edd7a88c69e
--- /dev/null
+++ b/test/lisp/mail/rfc2045-tests.el
@@ -0,0 +1,37 @@
+;;; rfc2045-tests.el --- Tests for rfc2045.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 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 'rfc2045)
+
+(ert-deftest rfc2045-test-encode-string ()
+ (should (equal (rfc2045-encode-string "foo" "bar") "foo=bar"))
+ (should (equal (rfc2045-encode-string "foo" "bar-baz") "foo=bar-baz"))
+ (should (equal (rfc2045-encode-string "foo" "bar baz") "foo=\"bar baz\""))
+ (should (equal (rfc2045-encode-string "foo" "bar\tbaz") "foo=\"bar\tbaz\""))
+ (should (equal (rfc2045-encode-string "foo" "bar\nbaz") "foo=\"bar\nbaz\"")))
+
+(provide 'rfc2045-tests)
+;;; rfc2045-tests.el ends here
diff --git a/test/lisp/mail/rfc2368-tests.el b/test/lisp/mail/rfc2368-tests.el
new file mode 100644
index 00000000000..c35b8e33ad5
--- /dev/null
+++ b/test/lisp/mail/rfc2368-tests.el
@@ -0,0 +1,39 @@
+;;; rfc2368-tests.el --- Tests for rfc2368.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'rfc2368)
+
+(ert-deftest rfc2368-unhexify-string ()
+ (should (equal (rfc2368-unhexify-string "hello%20there") "hello there")))
+
+(ert-deftest rfc2368-parse-mailto-url ()
+ (should (equal (rfc2368-parse-mailto-url "mailto:foo@example.org?subject=Foo&bar=baz")
+ '(("To" . "foo@example.org") ("Subject" . "Foo") ("Bar" . "baz"))))
+ (should (equal (rfc2368-parse-mailto-url "mailto:foo@bar.com?to=bar@example.org")
+ '(("To" . "foo@bar.com, bar@example.org"))))
+ (should (equal (rfc2368-parse-mailto-url "mailto:foo@bar.com?subject=bar%20baz")
+ '(("To" . "foo@bar.com") ("Subject" . "bar baz")))))
+
+(provide 'rfc2368-tests)
+;;; rfc2368-tests.el ends here
diff --git a/test/manual/rmailmm.el b/test/lisp/mail/rmailmm-tests.el
index d6e29a8b07b..645bb96d113 100644
--- a/test/manual/rmailmm.el
+++ b/test/lisp/mail/rmailmm-tests.el
@@ -1,4 +1,4 @@
-;;; rmailmm.el --- tests for mail/rmailmm.el
+;;; rmailmm-tests.el --- Tests for rmailmm.el -*- lexical-binding:t -*-
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
@@ -19,27 +19,42 @@
;;; Commentary:
+;; Converted to ert from previous manual tests.
+
+;; FIXME: Some of these still lack a condition for success.
+
;;; Code:
+(require 'ert)
(require 'rmailmm)
-(defun rmailmm-test-handler ()
+(ert-deftest rmailmm-test-handler ()
"Test of a mail using no MIME parts at all."
(let ((mail "To: alex@gnu.org
Content-Type: text/plain; charset=koi8-r
Content-Transfer-Encoding: 8bit
MIME-Version: 1.0
-\372\304\322\301\327\323\324\327\325\312\324\305\41"))
- (switch-to-buffer (get-buffer-create "*test*"))
- (erase-buffer)
- (set-buffer-multibyte nil)
- (insert mail)
- (rmail-mime-show t)
- (set-buffer-multibyte t)))
+\372\304\322\301\327\323\324\327\325\312\324\305\41")
+ (correct "To: alex@gnu.org
+Content-Type: text/plain; charset=koi8-r
+Content-Transfer-Encoding: 8bit
+MIME-Version: 1.0
-(defun rmailmm-test-bulk-handler ()
+Здравствуйте!
+"))
+ (with-temp-buffer
+ (erase-buffer)
+ (set-buffer-multibyte nil)
+ (insert mail)
+ (rmail-mime-show t)
+ (set-buffer-multibyte t)
+ (should (equal (buffer-string) correct)))))
+
+;;;; FIXME: This doesn't seem to be working.
+(ert-deftest rmailmm-test-bulk-handler ()
"Test of a mail used as an example in RFC 2183."
+ :tags '(:unstable)
(let ((mail "Content-Type: image/jpeg
Content-Disposition: attachment; filename=genome.jpeg;
modification-date=\"Wed, 12 Feb 1997 16:29:51 -0500\";
@@ -54,13 +69,17 @@ WATQdRUvAK0Bnmshmtn79PpaLBbbOZkjKvRnjRZoRswOkG1wFchKew2g9wXVJVZL/m4+B+vv
UDwbgUEAUmk2Zyg101d6PhCDySgAvTvDgKiuOrc4dLxUb7UMnhGIexyI+d6U+ABuNAP4Simx
lgAAAABJRU5ErkJggg==
"))
- (switch-to-buffer (get-buffer-create "*test*"))
- (erase-buffer)
- (insert mail)
- (rmail-mime-show)))
-
-(defun rmailmm-test-multipart-handler ()
+ (with-temp-buffer
+ (erase-buffer)
+ (insert mail)
+ (rmail-mime-show)
+ ;; FIXME: What is the condition for success?
+ )))
+
+;; FIXME: Has no condition for success -- see below.
+(ert-deftest rmailmm-test-multipart-handler ()
"Test of a mail used as an example in RFC 2046."
+ :tags '(:unstable)
(let ((mail "From: Nathaniel Borenstein <nsb@bellcore.com>
To: Ned Freed <ned@innosoft.com>
Date: Sun, 21 Mar 1993 23:56:48 -0800 (PST)
@@ -88,6 +107,11 @@ This is the epilogue. It is also to be ignored."))
(switch-to-buffer (get-buffer-create "*test*"))
(erase-buffer)
(insert mail)
- (rmail-mime-show t)))
+ (rmail-mime-show t)
+ ;; FIXME: What is the condition for success?
+ (should nil) ; expected fail for now
+ ))
+
+(provide 'rmailmm-tests)
-;;; rmailmm.el ends here
+;; rmailmm-tests.el ends here
diff --git a/test/lisp/man-tests.el b/test/lisp/man-tests.el
index fba4d748ce1..8267d8e4f6a 100644
--- a/test/lisp/man-tests.el
+++ b/test/lisp/man-tests.el
@@ -1,4 +1,4 @@
-;;; man-tests.el --- Test suite for man.
+;;; man-tests.el --- Test suite for man. -*- lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
@@ -114,7 +114,7 @@ in the cdr of the element.")
(dolist (test man-tests-parse-man-k-tests)
(should (man-tests-parse-man-k-test-case test))))
-(defun man-tests-filter-strings (buffer strings)
+(defun man-tests-filter-strings (_buffer strings)
"Run `Man-bgproc-filter' on each of STRINGS.
The formatted result will be inserted into BUFFER."
(let ((proc (start-process "dummy man-tests proc" (current-buffer) "cat")))
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index f4c840c1171..5da86f36148 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -5,18 +5,20 @@
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; 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 <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/misc-tests.el b/test/lisp/misc-tests.el
new file mode 100644
index 00000000000..fbcbfb7d0cc
--- /dev/null
+++ b/test/lisp/misc-tests.el
@@ -0,0 +1,77 @@
+;;; misc-tests.el --- Tests for misc.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 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)
+
+(defmacro with-misc-test (original result &rest body)
+ (declare (indent 2))
+ `(with-temp-buffer
+ (insert ,original)
+ ,@body
+ (should (equal (buffer-string) ,result))))
+
+(ert-deftest misc-test-copy-from-above-command ()
+ (with-misc-test "abc\n" "abc\nabc"
+ (copy-from-above-command))
+ (with-misc-test "abc\n" "abc\nab"
+ (copy-from-above-command 2)))
+
+(ert-deftest misc-test-zap-up-to-char ()
+ (with-misc-test "abcde" "cde"
+ (goto-char (point-min))
+ (zap-up-to-char 1 ?c))
+ (with-misc-test "abcde abc123" "c123"
+ (goto-char (point-min))
+ (zap-up-to-char 2 ?c)))
+
+(ert-deftest misc-test-upcase-char ()
+ (with-misc-test "abcde" "aBCDe"
+ (goto-char (1+ (point-min)))
+ (upcase-char 3)))
+
+(ert-deftest misc-test-forward-to-word ()
+ (with-temp-buffer
+ (insert " - abc")
+ (goto-char (point-min))
+ (forward-to-word 1)
+ (should (equal (point) 9)))
+ (with-temp-buffer
+ (insert "a b c")
+ (goto-char (point-min))
+ (forward-to-word 3)
+ (should (equal (point) 6))))
+
+(ert-deftest misc-test-backward-to-word ()
+ (with-temp-buffer
+ (insert "abc - ")
+ (backward-to-word 1)
+ (should (equal (point) 4)))
+ (with-temp-buffer
+ (insert "a b c")
+ (backward-to-word 3)
+ (should (equal (point) 1))))
+
+(provide 'misc-tests)
+;;; misc-tests.el ends here
diff --git a/test/lisp/mwheel-tests.el b/test/lisp/mwheel-tests.el
new file mode 100644
index 00000000000..315f25edae8
--- /dev/null
+++ b/test/lisp/mwheel-tests.el
@@ -0,0 +1,46 @@
+;;; mwheel-tests.el --- tests for mwheel.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'mwheel)
+
+(ert-deftest mwheel-test-enable/disable ()
+ (mouse-wheel-mode 1)
+ (should (eq (lookup-key (current-global-map) `[,mouse-wheel-up-event]) 'mwheel-scroll))
+ (mouse-wheel-mode -1)
+ (should (eq (lookup-key (current-global-map) `[,mouse-wheel-up-event]) nil)))
+
+(ert-deftest mwheel-test--create-scroll-keys ()
+ (should (equal (mouse-wheel--create-scroll-keys 10 'mouse-4)
+ '([mouse-4]
+ [left-margin mouse-4] [right-margin mouse-4]
+ [left-fringe mouse-4] [right-fringe mouse-4]
+ [vertical-scroll-bar mouse-4] [horizontal-scroll-bar mouse-4]
+ [mode-line mouse-4] [header-line mouse-4])))
+ ;; Don't bind modifiers outside of buffer area (e.g. for fringes).
+ (should (equal (mouse-wheel--create-scroll-keys '((shift) . 1) 'mouse-4)
+ '([(shift mouse-4)])))
+ (should (equal (mouse-wheel--create-scroll-keys '((control) . 9) 'mouse-7)
+ '([(control mouse-7)])))
+ (should (equal (mouse-wheel--create-scroll-keys '((meta) . 5) 'mouse-5)
+ '([(meta mouse-5)]))))
+
+;;; mwheel-tests.el ends here
diff --git a/test/lisp/net/browse-url-tests.el b/test/lisp/net/browse-url-tests.el
new file mode 100644
index 00000000000..b2b27d2ae7b
--- /dev/null
+++ b/test/lisp/net/browse-url-tests.el
@@ -0,0 +1,119 @@
+;;; browse-url-tests.el --- Tests for browse-url.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'browse-url)
+(require 'ert)
+
+(ert-deftest browse-url-tests-browser-kind ()
+ (should (eq (browse-url--browser-kind #'browse-url-w3 "gnu.org")
+ 'internal))
+ (should
+ (eq (browse-url--browser-kind #'browse-url-firefox "gnu.org")
+ 'external)))
+
+(ert-deftest browse-url-tests-non-html-file-url-p ()
+ (should (browse-url--non-html-file-url-p "file://foo.txt"))
+ (should-not (browse-url--non-html-file-url-p "file://foo.html")))
+
+(ert-deftest browse-url-tests-select-handler-mailto ()
+ (should (eq (browse-url-select-handler "mailto:foo@bar.org")
+ 'browse-url--mailto))
+ (should (eq (browse-url-select-handler "mailto:foo@bar.org"
+ 'internal)
+ 'browse-url--mailto))
+ (should-not (browse-url-select-handler "mailto:foo@bar.org"
+ 'external)))
+
+(ert-deftest browse-url-tests-select-handler-man ()
+ (should (eq (browse-url-select-handler "man:ls") 'browse-url--man))
+ (should (eq (browse-url-select-handler "man:ls" 'internal)
+ 'browse-url--man))
+ (should-not (browse-url-select-handler "man:ls" 'external)))
+
+(ert-deftest browse-url-tests-select-handler-file ()
+ (should (eq (browse-url-select-handler "file://foo.txt")
+ 'browse-url-emacs))
+ (should (eq (browse-url-select-handler "file://foo.txt" 'internal)
+ 'browse-url-emacs))
+ (should-not (browse-url-select-handler "file://foo.txt" 'external)))
+
+(ert-deftest browse-url-tests-url-encode-chars ()
+ (should (equal (browse-url-url-encode-chars "foobar" "[ob]")
+ "f%6F%6F%62ar")))
+
+(ert-deftest browse-url-tests-encode-url ()
+ (should (equal (browse-url-encode-url "") ""))
+ (should (equal (browse-url-encode-url "a b c") "a b c"))
+ (should (equal (browse-url-encode-url "\"a\" \"b\"")
+ "\"a%22\"b\""))
+ (should (equal (browse-url-encode-url "(a) (b)") "(a%29(b)"))
+ (should (equal (browse-url-encode-url "a$ b$") "a%24b$")))
+
+(ert-deftest browse-url-tests-url-at-point ()
+ (with-temp-buffer
+ (insert "gnu.org")
+ (should (equal (browse-url-url-at-point) "http://gnu.org"))))
+
+(ert-deftest browse-url-tests-file-url ()
+ (should (equal (browse-url-file-url "/foo") "file:///foo"))
+ (should (equal (browse-url-file-url "/foo:") "ftp://foo/"))
+ (should (equal (browse-url-file-url "/ftp@foo:") "ftp://foo/"))
+ (should (equal (browse-url-file-url "/anonymous@foo:")
+ "ftp://foo/")))
+
+(ert-deftest browse-url-tests-delete-temp-file ()
+ (let ((browse-url-temp-file-name
+ (make-temp-file "browse-url-tests-")))
+ (browse-url-delete-temp-file)
+ (should-not (file-exists-p browse-url-temp-file-name)))
+ (let ((file (make-temp-file "browse-url-tests-")))
+ (browse-url-delete-temp-file file)
+ (should-not (file-exists-p file))))
+
+(ert-deftest browse-url-tests-add-buttons ()
+ (with-temp-buffer
+ (insert "Visit https://gnu.org")
+ (goto-char (point-min))
+ (browse-url-add-buttons)
+ (goto-char (- (point-max) 1))
+ (should (eq (get-text-property (point) 'face)
+ 'browse-url-button))
+ (should (get-text-property (point) 'browse-url-data))))
+
+(ert-deftest browse-url-tests-button-copy ()
+ (with-temp-buffer
+ (insert "Visit https://gnu.org")
+ (goto-char (point-min))
+ (browse-url-add-buttons)
+ (should-error (browse-url-button-copy))
+ (goto-char (- (point-max) 1))
+ (browse-url-button-copy)
+ (should (equal (car kill-ring) "https://gnu.org"))))
+
+(provide 'browse-url-tests)
+;;; browse-url-tests.el ends here
diff --git a/test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml b/test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml
new file mode 100644
index 00000000000..620f10510f2
--- /dev/null
+++ b/test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml
@@ -0,0 +1,49 @@
+<?xml version="1.0"?>
+<!DOCTYPE node PUBLIC "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN" "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd">
+<node>
+ <interface name="org.freedesktop.DBus.Introspectable">
+ <method name="Introspect">
+ <arg name="xml" type="s" direction="out"/>
+ </method>
+ </interface>
+ <interface name="org.freedesktop.DBus.Properties">
+ <method name="Get">
+ <arg name="interface" type="s" direction="in"/>
+ <arg name="name" type="s" direction="in"/>
+ <arg name="value" type="v" direction="out"/>
+ </method>
+ <method name="Set">
+ <arg name="interface" type="s" direction="in"/>
+ <arg name="name" type="s" direction="in"/>
+ <arg name="value" type="v" direction="in"/>
+ </method>
+ <method name="GetAll">
+ <arg name="interface" type="s" direction="in"/>
+ <arg name="properties" type="a{sv}" direction="out"/>
+ </method>
+ <signal name="PropertiesChanged">
+ <arg name="interface" type="s"/>
+ <arg name="changed_properties" type="a{sv}"/>
+ <arg name="invalidated_properties" type="as"/>
+ </signal>
+ </interface>
+ <interface name="org.gnu.Emacs.TestDBus.Interface">
+ <method name="Connect">
+ <arg name="uuid" type="s" direction="in"/>
+ <arg name="mode" type="y" direction="in"/>
+ <arg name="options" type="a{sv}" direction="in"/>
+ <arg name="interface" type="s" direction="out"/>
+ </method>
+ <method name="DeprecatedMethod0">
+ <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
+ </method>
+ <method name="DeprecatedMethod1">
+ <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
+ </method>
+ <property name="Connected" type="b" access="read"/>
+ <property name="Player" type="o" access="read"/>
+ <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
+ </interface>
+ <node name="node0"/>
+ <node name="node1"/>
+</node>
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 68f69f62b56..759cd102892 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -1,21 +1,23 @@
-;;; dbus-tests.el --- Tests of D-Bus integration into Emacs
+;;; dbus-tests.el --- Tests of D-Bus integration into Emacs -*- lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
-;; 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.
-;;
+;; 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/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -25,16 +27,32 @@
(defvar dbus-debug nil)
(declare-function dbus-get-unique-name "dbusbind.c" (bus))
-(defvar dbus--test-enabled-session-bus
+(defconst dbus--test-enabled-session-bus
(and (featurep 'dbusbind)
(dbus-ignore-errors (dbus-get-unique-name :session)))
"Check, whether we are registered at the session bus.")
-(defvar dbus--test-enabled-system-bus
+(defconst dbus--test-enabled-system-bus
(and (featurep 'dbusbind)
(dbus-ignore-errors (dbus-get-unique-name :system)))
"Check, whether we are registered at the system bus.")
+(defconst dbus--test-service "org.gnu.Emacs.TestDBus"
+ "Test service.")
+
+(defconst dbus--test-path "/org/gnu/Emacs/TestDBus"
+ "Test object path.")
+
+(defconst dbus--test-interface "org.gnu.Emacs.TestDBus.Interface"
+ "Test interface.")
+
+(defconst dbus--tests-dir
+ (file-truename
+ (expand-file-name "dbus-resources"
+ (file-name-directory (or load-file-name
+ buffer-file-name))))
+ "Directory containing introspection test data file.")
+
(defun dbus--test-availability (bus)
"Test availability of D-Bus BUS."
(should (dbus-list-names bus))
@@ -54,6 +72,8 @@
(ert-deftest dbus-test01-type-conversion ()
"Check type conversion functions."
+ (skip-unless dbus--test-enabled-session-bus)
+
(let ((ustr "0123abc_xyz\x01\xff")
(mstr "Grüß Göttin"))
(should
@@ -82,31 +102,373 @@
(string-equal
(dbus-unescape-from-identifier (dbus-escape-as-identifier mstr)) mstr))))
+(ert-deftest dbus-test01-basic-types ()
+ "Check basic D-Bus type arguments."
+ (skip-unless dbus--test-enabled-session-bus)
+
+ ;; No argument or unknown keyword.
+ (should-error
+ (dbus-check-arguments :session dbus--test-service)
+ :type 'wrong-number-of-arguments)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :keyword)
+ :type 'wrong-type-argument)
+
+ ;; `:string'.
+ (should (dbus-check-arguments :session dbus--test-service "string"))
+ (should (dbus-check-arguments :session dbus--test-service :string "string"))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :string)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :string 0.5)
+ :type 'wrong-type-argument)
+
+ ;; `:object-path'.
+ (should
+ (dbus-check-arguments
+ :session dbus--test-service :object-path "/object/path"))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :object-path)
+ :type 'wrong-type-argument)
+ ;; Raises an error on stdin.
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :object-path "string")
+ :type 'dbus-error)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :object-path 0.5)
+ :type 'wrong-type-argument)
+
+ ;; `:signature'.
+ (should (dbus-check-arguments :session dbus--test-service :signature "as"))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :signature)
+ :type 'wrong-type-argument)
+ ;; Raises an error on stdin.
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :signature "string")
+ :type 'dbus-error)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :signature 0.5)
+ :type 'wrong-type-argument)
+
+ ;; `:boolean'.
+ (should (dbus-check-arguments :session dbus--test-service nil))
+ (should (dbus-check-arguments :session dbus--test-service t))
+ (should (dbus-check-arguments :session dbus--test-service :boolean nil))
+ (should (dbus-check-arguments :session dbus--test-service :boolean t))
+ (should (dbus-check-arguments :session dbus--test-service :boolean 'whatever))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :boolean)
+ :type 'wrong-type-argument)
+
+ ;; `:byte'.
+ (should (dbus-check-arguments :session dbus--test-service :byte 0))
+ ;; Only the least significant byte is taken into account.
+ (should
+ (dbus-check-arguments :session dbus--test-service :byte most-positive-fixnum))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :byte)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :byte -1)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :byte 0.5)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :byte "string")
+ :type 'wrong-type-argument)
+
+ ;; `:int16'.
+ (should (dbus-check-arguments :session dbus--test-service :int16 0))
+ (should (dbus-check-arguments :session dbus--test-service :int16 #x7fff))
+ (should (dbus-check-arguments :session dbus--test-service :int16 #x-8000))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int16)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int16 #x8000)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int16 #x-8001)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int16 0.5)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int16 "string")
+ :type 'wrong-type-argument)
+
+ ;; `:uint16'.
+ (should (dbus-check-arguments :session dbus--test-service :uint16 0))
+ (should (dbus-check-arguments :session dbus--test-service :uint16 #xffff))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint16)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint16 #x10000)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint16 -1)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint16 0.5)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint16 "string")
+ :type 'wrong-type-argument)
+
+ ;; `:int32'.
+ (should (dbus-check-arguments :session dbus--test-service :int32 0))
+ (should (dbus-check-arguments :session dbus--test-service :int32 #x7fffffff))
+ (should (dbus-check-arguments :session dbus--test-service :int32 #x-80000000))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int32)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int32 #x80000000)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int32 #x-80000001)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int32 0.5)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int32 "string")
+ :type 'wrong-type-argument)
+
+ ;; `:uint32'.
+ (should (dbus-check-arguments :session dbus--test-service 0))
+ (should (dbus-check-arguments :session dbus--test-service :uint32 0))
+ (should (dbus-check-arguments :session dbus--test-service :uint32 #xffffffff))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint32)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint32 #x100000000)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint32 -1)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint32 0.5)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint32 "string")
+ :type 'wrong-type-argument)
+
+ ;; `:int64'.
+ (should (dbus-check-arguments :session dbus--test-service :int64 0))
+ (should
+ (dbus-check-arguments :session dbus--test-service :int64 #x7fffffffffffffff))
+ (should
+ (dbus-check-arguments :session dbus--test-service :int64 #x-8000000000000000))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int64)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int64 #x8000000000000000)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int64 #x-8000000000000001)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int64 0.5)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int64 "string")
+ :type 'wrong-type-argument)
+
+ ;; `:uint64'.
+ (should (dbus-check-arguments :session dbus--test-service :uint64 0))
+ (should
+ (dbus-check-arguments :session dbus--test-service :uint64 #xffffffffffffffff))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint64)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint64 #x10000000000000000)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint64 -1)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint64 0.5)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint64 "string")
+ :type 'wrong-type-argument)
+
+ ;; `:double'.
+ (should (dbus-check-arguments :session dbus--test-service :double 0))
+ (should (dbus-check-arguments :session dbus--test-service :double 0.5))
+ (should (dbus-check-arguments :session dbus--test-service :double -0.5))
+ (should (dbus-check-arguments :session dbus--test-service :double -1))
+ ;; Shall both be supported?
+ (should (dbus-check-arguments :session dbus--test-service :double 1.0e+INF))
+ (should (dbus-check-arguments :session dbus--test-service :double 0.0e+NaN))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :double)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :double "string")
+ :type 'wrong-type-argument)
+
+ ;; `:unix-fd'. UNIX file descriptors are transfered out-of-band.
+ ;; We do not support this, and so we cannot do much testing here for
+ ;; `:unix-fd' being an argument (which is an index to the file
+ ;; descriptor in the array of file descriptors that accompany the
+ ;; D-Bus message). Mainly testing, that values out of `:uint32'
+ ;; type range fail.
+ (should (dbus-check-arguments :session dbus--test-service :unix-fd 0))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :unix-fd)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :unix-fd -1)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :unix-fd 0.5)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :unix-fd "string")
+ :type 'wrong-type-argument))
+
+(ert-deftest dbus-test01-compound-types ()
+ "Check basic D-Bus type arguments."
+ (skip-unless dbus--test-enabled-session-bus)
+
+ ;; `:array'. It contains several elements of the same type.
+ (should (dbus-check-arguments :session dbus--test-service '("string")))
+ (should (dbus-check-arguments :session dbus--test-service '(:array "string")))
+ (should
+ (dbus-check-arguments :session dbus--test-service '(:array :string "string")))
+ (should
+ (dbus-check-arguments
+ :session dbus--test-service '(:array :string "string1" "string2")))
+ ;; Empty array (of strings).
+ (should (dbus-check-arguments :session dbus--test-service '(:array)))
+ (should
+ (dbus-check-arguments :session dbus--test-service '(:array :signature "o")))
+ ;; Different element types.
+ (should-error
+ (dbus-check-arguments
+ :session dbus--test-service
+ '(:array :string "string" :object-path "/object/path"))
+ :type 'wrong-type-argument)
+
+ ;; `:variant'. It contains exactly one element.
+ (should
+ (dbus-check-arguments
+ :session dbus--test-service '(:variant :string "string")))
+ (should
+ (dbus-check-arguments
+ :session dbus--test-service '(:variant (:array "string"))))
+ ;; Empty variant.
+ (should-error
+ (dbus-check-arguments :session dbus--test-service '(:variant))
+ :type 'wrong-type-argument)
+ ;; More than one element.
+ (should-error
+ (dbus-check-arguments
+ :session dbus--test-service
+ '(:variant :string "string" :object-path "/object/path"))
+ :type 'wrong-type-argument)
+
+ ;; `:dict-entry'. It must contain two elements; the first one must
+ ;; be of a basic type. It must be an element of an array.
+ (should
+ (dbus-check-arguments
+ :session dbus--test-service
+ '(:array (:dict-entry :string "string" :boolean nil))))
+ ;; This is an alternative syntax. FIXME: Shall this be supported?
+ (should
+ (dbus-check-arguments
+ :session dbus--test-service
+ '(:array :dict-entry (:string "string" :boolean t))))
+ ;; Empty dict-entry.
+ (should-error
+ (dbus-check-arguments
+ :session dbus--test-service '(:array (:dict-entry)))
+ :type 'wrong-type-argument)
+ ;; One element.
+ (should-error
+ (dbus-check-arguments
+ :session dbus--test-service '(:array (:dict-entry :string "string")))
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments
+ :session dbus--test-service
+ '(:array (:dict-entry :string "string" :boolean t :boolean t)))
+ :type 'wrong-type-argument)
+ ;; The first element ist not of a basic type.
+ (should-error
+ (dbus-check-arguments
+ :session dbus--test-service
+ '(:array (:dict-entry (:array :string "string") :boolean t)))
+ :type 'wrong-type-argument)
+ ;; It is not an element of an array.
+ (should-error
+ (dbus-check-arguments
+ :session dbus--test-service '(:dict-entry :string "string" :boolean t))
+ :type 'wrong-type-argument)
+ ;; Different dict entry types are not ched. FIXME: Add check.
+ ;; (should-error
+ ;; (dbus-check-arguments
+ ;; :session dbus--test-service
+ ;; '(:array
+ ;; (:dict-entry :string "string1" :boolean t)
+ ;; (:dict-entry :string "string2" :object-path "/object/path")))
+ ;; :type 'wrong-type-argument)
+
+ ;; `:struct'. There is no restriction what could be an element of a struct.
+ (should
+ (dbus-check-arguments
+ :session dbus--test-service
+ '(:struct
+ :string "string"
+ :object-path "/object/path"
+ (:variant (:array :unix-fd 1 :unix-fd 2 :unix-fd 3 :unix-fd 4)))))
+ ;; Empty struct.
+ (should-error
+ (dbus-check-arguments :session dbus--test-service '(:struct))
+ :type 'wrong-type-argument))
+
(defun dbus--test-register-service (bus)
"Check service registration at BUS."
;; Cleanup.
- (dbus-ignore-errors (dbus-unregister-service bus dbus-service-emacs))
+ (dbus-ignore-errors (dbus-unregister-service bus dbus--test-service))
;; Register an own service.
- (should (eq (dbus-register-service bus dbus-service-emacs) :primary-owner))
- (should (member dbus-service-emacs (dbus-list-known-names bus)))
- (should (eq (dbus-register-service bus dbus-service-emacs) :already-owner))
- (should (member dbus-service-emacs (dbus-list-known-names bus)))
+ (should (eq (dbus-register-service bus dbus--test-service) :primary-owner))
+ (should (member dbus--test-service (dbus-list-known-names bus)))
+ (should (eq (dbus-register-service bus dbus--test-service) :already-owner))
+ (should (member dbus--test-service (dbus-list-known-names bus)))
;; Unregister the service.
- (should (eq (dbus-unregister-service bus dbus-service-emacs) :released))
- (should-not (member dbus-service-emacs (dbus-list-known-names bus)))
- (should (eq (dbus-unregister-service bus dbus-service-emacs) :non-existent))
- (should-not (member dbus-service-emacs (dbus-list-known-names bus)))
+ (should (eq (dbus-unregister-service bus dbus--test-service) :released))
+ (should-not (member dbus--test-service (dbus-list-known-names bus)))
+ (should (eq (dbus-unregister-service bus dbus--test-service) :non-existent))
+ (should-not (member dbus--test-service (dbus-list-known-names bus)))
;; `dbus-service-dbus' is reserved for the BUS itself.
- (should-error (dbus-register-service bus dbus-service-dbus))
- (should-error (dbus-unregister-service bus dbus-service-dbus)))
+ (should
+ (equal
+ (butlast
+ (should-error (dbus-register-service bus dbus-service-dbus)))
+ `(dbus-error ,dbus-error-invalid-args)))
+ (should
+ (equal
+ (butlast
+ (should-error (dbus-unregister-service bus dbus-service-dbus)))
+ `(dbus-error ,dbus-error-invalid-args))))
(ert-deftest dbus-test02-register-service-session ()
"Check service registration at `:session' bus."
(skip-unless (and dbus--test-enabled-session-bus
- (dbus-register-service :session dbus-service-emacs)))
+ (dbus-register-service :session dbus--test-service)))
(dbus--test-register-service :session)
(let ((service "org.freedesktop.Notifications"))
@@ -124,7 +486,7 @@
(ert-deftest dbus-test02-register-service-system ()
"Check service registration at `:system' bus."
(skip-unless (and dbus--test-enabled-system-bus
- (dbus-register-service :system dbus-service-emacs)))
+ (dbus-register-service :system dbus--test-service)))
(dbus--test-register-service :system))
(ert-deftest dbus-test02-register-service-own-bus ()
@@ -148,7 +510,7 @@ This includes initialization and closing the bus."
(featurep 'dbusbind)
(dbus-init-bus bus)
(dbus-get-unique-name bus)
- (dbus-register-service bus dbus-service-emacs))))
+ (dbus-register-service bus dbus--test-service))))
;; Run the test.
(dbus--test-register-service bus))
@@ -159,25 +521,1323 @@ This includes initialization and closing the bus."
"Check `dbus-interface-peer' methods."
(skip-unless
(and dbus--test-enabled-session-bus
- (dbus-register-service :session dbus-service-emacs)
+ (dbus-register-service :session dbus--test-service)
;; "GetMachineId" is not implemented (yet). When it returns a
;; value, another D-Bus client like dbus-monitor is reacting
;; on `dbus-interface-peer'. We cannot test then.
(not
(dbus-ignore-errors
(dbus-call-method
- :session dbus-service-emacs dbus-path-dbus
+ :session dbus--test-service dbus-path-dbus
dbus-interface-peer "GetMachineId" :timeout 100)))))
- (should (dbus-ping :session dbus-service-emacs 100))
- (dbus-unregister-service :session dbus-service-emacs)
- (should-not (dbus-ping :session dbus-service-emacs 100)))
+ (should (dbus-ping :session dbus--test-service 100))
+ (dbus-unregister-service :session dbus--test-service)
+ (should-not (dbus-ping :session dbus--test-service 100)))
+
+(defun dbus--test-method-handler (&rest args)
+ "Method handler for `dbus-test04-register-method'."
+ (cond
+ ;; No argument.
+ ((null args)
+ :ignore)
+ ;; One argument.
+ ((= 1 (length args))
+ (car args))
+ ;; Two arguments.
+ ((= 2 (length args))
+ `(:error ,dbus-error-invalid-args
+ ,(format-message "Wrong arguments %s" args)))
+ ;; More than two arguments.
+ (t (signal 'dbus-error (cons "D-Bus signal" args)))))
+
+(ert-deftest dbus-test04-register-method ()
+ "Check method registration for an own service."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+ (unwind-protect
+ (let ((method1 "Method1")
+ (method2 "Method2")
+ (handler #'dbus--test-method-handler)
+ registered)
+
+ ;; The service is not registered yet.
+ (should
+ (equal
+ (butlast
+ (should-error
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method1 :timeout 10 "foo")))
+ `(dbus-error ,dbus-error-service-unknown)))
+
+ ;; Register.
+ (should
+ (equal
+ (setq
+ registered
+ (dbus-register-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method1 handler))
+ `((:method :session ,dbus--test-interface ,method1)
+ (,dbus--test-service ,dbus--test-path ,handler))))
+ (should
+ (equal
+ (dbus-register-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method2 handler)
+ `((:method :session ,dbus--test-interface ,method2)
+ (,dbus--test-service ,dbus--test-path ,handler))))
+
+ ;; No argument, returns nil.
+ (should-not
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method1))
+ ;; One argument, returns the argument.
+ (should
+ (string-equal
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method1 "foo")
+ "foo"))
+ ;; Two arguments, D-Bus error activated as `(:error ...)' list.
+ (should
+ (equal
+ (should-error
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method1 "foo" "bar"))
+ `(dbus-error ,dbus-error-invalid-args "Wrong arguments (foo bar)")))
+ ;; Three arguments, D-Bus error activated by `dbus-error' signal.
+ (should
+ (equal
+ (should-error
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method1 "foo" "bar" "baz"))
+ `(dbus-error
+ ,dbus-error-failed
+ "D-Bus error: \"D-Bus signal\", \"foo\", \"bar\", \"baz\"")))
+
+ ;; Unregister method.
+ (should (dbus-unregister-object registered))
+ (should-not (dbus-unregister-object registered))
+ (should
+ (equal
+ (butlast
+ (should-error
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method1 :timeout 10 "foo")))
+ `(dbus-error ,dbus-error-no-reply))))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+(defun dbus--test-method-reentry-handler (&rest _args)
+ "Method handler for `dbus-test04-method-reentry'."
+ (dbus-get-all-managed-objects :session dbus--test-service dbus--test-path)
+ 42)
+
+(ert-deftest dbus-test04-method-reentry ()
+ "Check receiving method call while awaiting response.
+Ensure that incoming method calls are handled when call to `dbus-call-method'
+is in progress."
+ :tags '(:expensive-test)
+ ;; Simulate application registration. (Bug#43251)
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+ (unwind-protect
+ (let ((method "Reentry"))
+ (should
+ (equal
+ (dbus-register-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method #'dbus--test-method-reentry-handler)
+ `((:method :session ,dbus--test-interface ,method)
+ (,dbus--test-service ,dbus--test-path
+ dbus--test-method-reentry-handler))))
+
+ (should
+ (=
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method)
+ 42)))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+(ert-deftest dbus-test04-call-method-timeout ()
+ "Verify `dbus-call-method' request timeout."
+ :tags '(:expensive-test)
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+ (dbus-register-service :session dbus--test-service)
+
+ (unwind-protect
+ (let ((start (current-time)))
+ ;; Test timeout override for method call.
+ (should-error
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus-interface-introspectable "Introspect" :timeout 2500)
+ :type 'dbus-error)
+
+ (should
+ (< 2.4 (float-time (time-since start)) 2.7)))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+(defvar dbus--test-signal-received nil
+ "Received signal value in `dbus--test-signal-handler'.")
+
+(defun dbus--test-signal-handler (&rest args)
+ "Signal handler for `dbus-test*-signal'."
+ (setq dbus--test-signal-received args))
+
+(defun dbus--test-timeout-handler (&rest _ignore)
+ "Timeout handler, reporting a failed test."
+ (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
+
+(ert-deftest dbus-test05-register-signal ()
+ "Check signal registration for an own service."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+ (unwind-protect
+ (let ((member "Member")
+ (handler #'dbus--test-signal-handler)
+ registered)
+
+ ;; Register signal handler.
+ (should
+ (equal
+ (setq
+ registered
+ (dbus-register-signal
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface member handler))
+ `((:signal :session ,dbus--test-interface ,member)
+ (,dbus--test-service ,dbus--test-path ,handler))))
+
+ ;; Send one argument, basic type.
+ (setq dbus--test-signal-received nil)
+ (dbus-send-signal
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface member "foo")
+ (with-timeout (1 (dbus--test-timeout-handler))
+ (while (null dbus--test-signal-received)
+ (read-event nil nil 0.1)))
+ (should (equal dbus--test-signal-received '("foo")))
+
+ ;; Send two arguments, compound types.
+ (setq dbus--test-signal-received nil)
+ (dbus-send-signal
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface member
+ '(:array :byte 1 :byte 2 :byte 3) '(:variant :string "bar"))
+ (with-timeout (1 (dbus--test-timeout-handler))
+ (while (null dbus--test-signal-received)
+ (read-event nil nil 0.1)))
+ (should (equal dbus--test-signal-received '((1 2 3) ("bar"))))
+
+ ;; Unregister signal.
+ (should (dbus-unregister-object registered))
+ (should-not (dbus-unregister-object registered)))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+(ert-deftest dbus-test06-register-property ()
+ "Check property registration for an own service."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+ (unwind-protect
+ (let ((property1 "Property1")
+ (property2 "Property2")
+ (property3 "Property3")
+ (property4 "Property4")
+ registered)
+
+ ;; `:read' property.
+ (should
+ (equal
+ (setq
+ registered
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1 :read "foo"))
+ `((:property :session ,dbus--test-interface ,property1)
+ (,dbus--test-service ,dbus--test-path))))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1)
+ "foo"))
+ ;; Due to `:read' access type, we don't get a proper reply
+ ;; from `dbus-set-property'.
+ (should
+ (equal
+ (butlast
+ (should-error
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1 "foofoo")))
+ `(dbus-error ,dbus-error-property-read-only)))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1)
+ "foo"))
+
+ ;; `:write' property.
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2 :write "bar")
+ `((:property :session ,dbus--test-interface ,property2)
+ (,dbus--test-service ,dbus--test-path))))
+ ;; Due to `:write' access type, we don't get a proper reply
+ ;; from `dbus-get-property'.
+ (should
+ (equal
+ (butlast
+ (should-error
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2)))
+ `(dbus-error ,dbus-error-access-denied)))
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2 "barbar")
+ "barbar"))
+ ;; Still `:write' access type.
+ (should
+ (equal
+ (butlast
+ (should-error
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2)))
+ `(dbus-error ,dbus-error-access-denied)))
+
+ ;; `:readwrite' property, typed value (Bug#43252).
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property3 :readwrite :object-path "/baz")
+ `((:property :session ,dbus--test-interface ,property3)
+ (,dbus--test-service ,dbus--test-path))))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property3)
+ "/baz"))
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property3 :object-path "/baz/baz")
+ "/baz/baz"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property3)
+ "/baz/baz"))
+
+ ;; Not registered property.
+ (should
+ (equal
+ (butlast
+ (should-error
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property4)))
+ `(dbus-error ,dbus-error-unknown-property)))
+ (should
+ (equal
+ (butlast
+ (should-error
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property4 "foobarbaz")))
+ `(dbus-error ,dbus-error-unknown-property)))
+
+ ;; `dbus-get-all-properties'. We cannot retrieve a value for
+ ;; the property with `:write' access type.
+ (let ((result
+ (dbus-get-all-properties
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface)))
+ (should (string-equal (cdr (assoc property1 result)) "foo"))
+ (should (string-equal (cdr (assoc property3 result)) "/baz/baz"))
+ (should-not (assoc property2 result)))
+
+ ;; `dbus-get-all-managed-objects'. We cannot retrieve a value for
+ ;; the property with `:write' access type.
+ (let ((result
+ (dbus-get-all-managed-objects
+ :session dbus--test-service dbus--test-path)))
+ (should (setq result (cadr (assoc dbus--test-path result))))
+ (should (setq result (cadr (assoc dbus--test-interface result))))
+ (should (string-equal (cdr (assoc property1 result)) "foo"))
+ (should (string-equal (cdr (assoc property3 result)) "/baz/baz"))
+ (should-not (assoc property2 result)))
+
+ ;; Unregister property.
+ (should (dbus-unregister-object registered))
+ (should-not (dbus-unregister-object registered))
+ (should
+ (equal
+ (butlast
+ (should-error
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1)))
+ `(dbus-error ,dbus-error-unknown-property))))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+;; The following test is inspired by Bug#43146.
+(ert-deftest dbus-test06-register-property-several-paths ()
+ "Check property registration for an own service at several paths."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+ (unwind-protect
+ (let ((property1 "Property1")
+ (property2 "Property2")
+ (property3 "Property3"))
+
+ ;; First path.
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1 :readwrite "foo")
+ `((:property :session ,dbus--test-interface ,property1)
+ (,dbus--test-service ,dbus--test-path))))
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2 :readwrite "bar")
+ `((:property :session ,dbus--test-interface ,property2)
+ (,dbus--test-service ,dbus--test-path))))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1)
+ "foo"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2)
+ "bar"))
+
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1 "foofoo")
+ "foofoo"))
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2 "barbar")
+ "barbar"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1)
+ "foofoo"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2)
+ "barbar"))
+
+ ;; Second path.
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property2 :readwrite "foo")
+ `((:property :session ,dbus--test-interface ,property2)
+ (,dbus--test-service ,(concat dbus--test-path dbus--test-path)))))
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property3 :readwrite "bar")
+ `((:property :session ,dbus--test-interface ,property3)
+ (,dbus--test-service ,(concat dbus--test-path dbus--test-path)))))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property2)
+ "foo"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property3)
+ "bar"))
+
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property2 "foofoo")
+ "foofoo"))
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property3 "barbar")
+ "barbar"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property2)
+ "foofoo"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property3)
+ "barbar"))
+
+ ;; Everything is still fine, tested with `dbus-get-all-properties'.
+ (let ((result
+ (dbus-get-all-properties
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface)))
+ (should (string-equal (cdr (assoc property1 result)) "foofoo"))
+ (should (string-equal (cdr (assoc property2 result)) "barbar"))
+ (should-not (assoc property3 result)))
+
+ (let ((result
+ (dbus-get-all-properties
+ :session dbus--test-service
+ (concat dbus--test-path dbus--test-path) dbus--test-interface)))
+ (should (string-equal (cdr (assoc property2 result)) "foofoo"))
+ (should (string-equal (cdr (assoc property3 result)) "barbar"))
+ (should-not (assoc property1 result)))
+
+ ;; Final check with `dbus-get-all-managed-objects'.
+ (let ((result
+ (dbus-get-all-managed-objects :session dbus--test-service "/"))
+ result1)
+ (should (setq result1 (cadr (assoc dbus--test-path result))))
+ (should (setq result1 (cadr (assoc dbus--test-interface result1))))
+ (should (string-equal (cdr (assoc property1 result1)) "foofoo"))
+ (should (string-equal (cdr (assoc property2 result1)) "barbar"))
+ (should-not (assoc property3 result1))
+
+ (should
+ (setq
+ result1
+ (cadr (assoc (concat dbus--test-path dbus--test-path) result))))
+ (should (setq result1 (cadr (assoc dbus--test-interface result1))))
+ (should (string-equal (cdr (assoc property2 result1)) "foofoo"))
+ (should (string-equal (cdr (assoc property3 result1)) "barbar"))
+ (should-not (assoc property1 result1))))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+(ert-deftest dbus-test06-register-property-emits-signal ()
+ "Check property registration for an own service, including signalling."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+ (unwind-protect
+ (let ((property "Property")
+ (handler #'dbus--test-signal-handler))
+
+ ;; Register signal handler.
+ (should
+ (equal
+ (dbus-register-signal
+ :session dbus--test-service dbus--test-path
+ dbus-interface-properties "PropertiesChanged" handler)
+ `((:signal :session ,dbus-interface-properties "PropertiesChanged")
+ (,dbus--test-service ,dbus--test-path ,handler))))
+
+ ;; Register property.
+ (setq dbus--test-signal-received nil)
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property :readwrite "foo" 'emits-signal)
+ `((:property :session ,dbus--test-interface ,property)
+ (,dbus--test-service ,dbus--test-path))))
+ (with-timeout (1 (dbus--test-timeout-handler))
+ (while (null dbus--test-signal-received)
+ (read-event nil nil 0.1)))
+ ;; It returns two arguments, "changed_properties" (an array of
+ ;; dict entries) and "invalidated_properties" (an array of
+ ;; strings).
+ (should (equal dbus--test-signal-received `(((,property ("foo"))) ())))
+
+ (should
+ (equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property)
+ "foo"))
+
+ ;; Set property. The new value shall be signalled.
+ (setq dbus--test-signal-received nil)
+ (should
+ (equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property
+ '(:array :byte 1 :byte 2 :byte 3))
+ '(1 2 3)))
+ (with-timeout (1 (dbus--test-timeout-handler))
+ (while (null dbus--test-signal-received)
+ (read-event nil nil 0.1)))
+ (should
+ (equal
+ dbus--test-signal-received `(((,property ((1 2 3)))) ())))
+
+ (should
+ (equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property)
+ '(1 2 3))))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+(defsubst dbus--test-run-property-test (selector name value expected)
+ "Generate a property test: register, set, get, getall sequence.
+This is a helper function for the macro `dbus--test-property'.
+The argument SELECTOR indicates whether the test should expand to
+`dbus-register-property' (if SELECTOR is `register') or
+`dbus-set-property' (if SELECTOR is `set').
+The argument NAME is the property name.
+The argument VALUE is the value to register or set.
+The argument EXPECTED is a transformed VALUE representing the
+form `dbus-get-property' should return."
+ (cond
+ ((eq selector 'register)
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface name
+ :readwrite value)
+ `((:property :session ,dbus--test-interface ,name)
+ (,dbus--test-service ,dbus--test-path)))))
+
+ ((eq selector 'set)
+ (should
+ (equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path dbus--test-interface name
+ value)
+ expected)))
+
+ (t (signal 'wrong-type-argument "Selector should be 'register or 'set.")))
+
+ (should
+ (equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface name)
+ expected))
+
+ (let ((result
+ (dbus-get-all-properties
+ :session dbus--test-service dbus--test-path dbus--test-interface)))
+ (should (equal (cdr (assoc name result)) expected)))
+
+ (let ((result
+ (dbus-get-all-managed-objects :session dbus--test-service "/"))
+ result1)
+ (should (setq result1 (cadr (assoc dbus--test-path result))))
+ (should (setq result1 (cadr (assoc dbus--test-interface result1))))
+ (should (equal (cdr (assoc name result1)) expected))))
+
+(defsubst dbus--test-property (name &rest value-list)
+ "Test a D-Bus property named by string argument NAME.
+The argument VALUE-LIST is a sequence of pairs, where each pair
+represents a value form and an expected returned value form. The
+first pair in VALUES is used for `dbus-register-property'.
+Subsequent pairs of the list are tested with `dbus-set-property'."
+ (let ((values (car value-list)))
+ (dbus--test-run-property-test
+ 'register name (car values) (cdr values)))
+ (dolist (values (cdr value-list))
+ (dbus--test-run-property-test
+ 'set name (car values) (cdr values))))
+
+(ert-deftest dbus-test06-property-types ()
+ "Check property access and mutation for an own service."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+ (dbus-register-service :session dbus--test-service)
+
+ (unwind-protect
+ (progn
+ (dbus--test-property
+ "ByteArray"
+ '((:array :byte 1 :byte 2 :byte 3) . (1 2 3))
+ '((:array :byte 4 :byte 5 :byte 6) . (4 5 6)))
+
+ (dbus--test-property
+ "StringArray"
+ '((:array "one" "two" :string "three") . ("one" "two" "three"))
+ '((:array :string "four" :string "five" "six") . ("four" "five" "six")))
+
+ (dbus--test-property
+ "ObjectArray"
+ '((:array
+ :object-path "/node00"
+ :object-path "/node01"
+ :object-path "/node0/node02")
+ . ("/node00" "/node01" "/node0/node02"))
+ '((:array
+ :object-path "/node10"
+ :object-path "/node11"
+ :object-path "/node0/node12")
+ . ("/node10" "/node11" "/node0/node12")))
+
+ (dbus--test-property
+ "Dictionary"
+ '((:array
+ :dict-entry (:string "four" (:variant :string "value of four"))
+ :dict-entry ("five" (:variant :object-path "/node0"))
+ :dict-entry ("six" (:variant (:array :byte 4 :byte 5 :byte 6))))
+ . (("four"
+ ("value of four"))
+ ("five"
+ ("/node0"))
+ ("six"
+ ((4 5 6)))))
+ '((:array
+ :dict-entry
+ (:string "key0" (:variant (:array :byte 7 :byte 8 :byte 9)))
+ :dict-entry ("key1" (:variant :string "value"))
+ :dict-entry ("key2" (:variant :object-path "/node0/node1")))
+ . (("key0"
+ ((7 8 9)))
+ ("key1"
+ ("value"))
+ ("key2"
+ ("/node0/node1")))))
+
+ (dbus--test-property ; Syntax emphasizing :dict compound type.
+ "Dictionary"
+ '((:array
+ (:dict-entry :string "seven" (:variant :string "value of seven"))
+ (:dict-entry "eight" (:variant :object-path "/node8"))
+ (:dict-entry "nine" (:variant (:array :byte 9 :byte 27 :byte 81))))
+ . (("seven"
+ ("value of seven"))
+ ("eight"
+ ("/node8"))
+ ("nine"
+ ((9 27 81)))))
+ '((:array
+ (:dict-entry
+ :string "key4" (:variant (:array :byte 7 :byte 49 :byte 125)))
+ (:dict-entry "key5" (:variant :string "obsolete"))
+ (:dict-entry "key6" (:variant :object-path "/node6/node7")))
+ . (("key4"
+ ((7 49 125)))
+ ("key5"
+ ("obsolete"))
+ ("key6"
+ ("/node6/node7")))))
+
+ (dbus--test-property
+ "ByteDictionary"
+ '((:array
+ (:dict-entry :byte 8 (:variant :string "byte-eight"))
+ (:dict-entry :byte 16 (:variant :object-path "/byte/sixteen"))
+ (:dict-entry :byte 48 (:variant (:array :byte 8 :byte 9 :byte 10))))
+ . (( 8 ("byte-eight"))
+ (16 ("/byte/sixteen"))
+ (48 ((8 9 10))))))
+
+ (dbus--test-property
+ "Variant"
+ '((:variant "Variant string") . ("Variant string"))
+ '((:variant :byte 42) . (42))
+ '((:variant :uint32 1000000) . (1000000))
+ '((:variant :object-path "/variant/path") . ("/variant/path"))
+ '((:variant :signature "a{sa{sv}}") . ("a{sa{sv}}"))
+ '((:variant
+ (:struct
+ 42 "string" (:object-path "/structure/path") (:variant "last")))
+ . ((42 "string" ("/structure/path") ("last")))))
+
+ ;; Test that :read prevents writes.
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "StringArray" :read '(:array "one" "two" :string "three"))
+ `((:property :session ,dbus--test-interface "StringArray")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should-error ; Cannot set property with :read access.
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "StringArray" '(:array "seven" "eight" :string "nine"))
+ :type 'dbus-error)
+
+ (should ; Property value preserved on error.
+ (equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "StringArray")
+ '("one" "two" "three")))
+
+ ;; Test mismatched types in array.
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "MixedArray" :readwrite
+ '(:array
+ :object-path "/node00"
+ :string "/node01"
+ :object-path "/node0/node02"))
+ :type 'wrong-type-argument)
+
+ ;; Test in-range integer values.
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue" :readwrite :byte 255)
+ `((:property :session ,dbus--test-interface "ByteValue")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue")
+ 255))
+
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ShortValue" :readwrite :int16 32767)
+ `((:property :session ,dbus--test-interface "ShortValue")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ShortValue")
+ 32767))
+
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "UShortValue" :readwrite :uint16 65535)
+ `((:property :session ,dbus--test-interface "UShortValue")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "UShortValue")
+ 65535))
+
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "IntValue" :readwrite :int32 2147483647)
+ `((:property :session ,dbus--test-interface "IntValue")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface "IntValue")
+ 2147483647))
+
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "UIntValue" :readwrite :uint32 4294967295)
+ `((:property :session ,dbus--test-interface "UIntValue")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "UIntValue")
+ 4294967295))
+
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "LongValue" :readwrite :int64 9223372036854775807)
+ `((:property :session ,dbus--test-interface "LongValue")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "LongValue")
+ 9223372036854775807))
+
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ULongValue" :readwrite :uint64 18446744073709551615)
+ `((:property :session ,dbus--test-interface "ULongValue")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ULongValue")
+ 18446744073709551615))
+
+ ;; Test integer overflow.
+ (should
+ (=
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue" :byte 520)
+ 8))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue")
+ 8))
+
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ShortValue" :readwrite :int16 32800)
+ :type 'args-out-of-range)
+
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "UShortValue" :readwrite :uint16 65600)
+ :type 'args-out-of-range)
+
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "IntValue" :readwrite :int32 2147483700)
+ :type 'args-out-of-range)
+
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "UIntValue" :readwrite :uint32 4294967300)
+ :type 'args-out-of-range)
+
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "LongValue" :readwrite :int64 9223372036854775900)
+ :type 'args-out-of-range)
+
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ULongValue" :readwrite :uint64 18446744073709551700)
+ :type 'args-out-of-range)
+
+ ;; dbus-set-property may change property type.
+ (should
+ (=
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue" 1024)
+ 1024))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue")
+ 1024))
+
+ (should ; Another change property type test.
+ (equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue" :boolean t)
+ t))
+
+ (should
+ (eq
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue")
+ t))
+
+ ;; Test invalid type specification.
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "InvalidType" :readwrite :keyword 128)
+ :type 'wrong-type-argument))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+(defun dbus--test-introspect ()
+ "Return test introspection string."
+ (when (string-equal dbus--test-path (dbus-event-path-name last-input-event))
+ (with-temp-buffer
+ (insert-file-contents-literally
+ (expand-file-name "org.gnu.Emacs.TestDBus.xml" dbus--tests-dir))
+ (buffer-string))))
+
+(defsubst dbus--test-validate-interface
+ (iface-name expected-properties expected-methods expected-signals
+ expected-annotations)
+ "Validate an interface definition for `dbus-test07-introspection'.
+The argument IFACE-NAME is a string naming the interface to validate.
+The arguments EXPECTED-PROPERTIES, EXPECTED-METHODS, EXPECTED-SIGNALS, and
+EXPECTED-ANNOTATIONS represent the names of the interface's properties,
+methods, signals, and annotations, respectively."
+
+ (let ((interface
+ (dbus-introspect-get-interface
+ :session dbus--test-service dbus--test-path iface-name)))
+ (pcase-let ((`(interface ((name . ,name)) . ,rest) interface))
+ (should
+ (string-equal name iface-name))
+ (should
+ (string-equal name (dbus-introspect-get-attribute interface "name")))
+
+ (let (properties methods signals annotations)
+ (mapc (lambda (x)
+ (let ((name (dbus-introspect-get-attribute x "name")))
+ (cond
+ ((eq 'property (car x)) (push name properties))
+ ((eq 'method (car x)) (push name methods))
+ ((eq 'signal (car x)) (push name signals))
+ ((eq 'annotation (car x)) (push name annotations)))))
+ rest)
+
+ (should
+ (equal
+ (nreverse properties)
+ expected-properties))
+ (should
+ (equal
+ (nreverse methods)
+ expected-methods))
+ (should
+ (equal
+ (nreverse signals)
+ expected-signals))
+ (should
+ (equal
+ (nreverse annotations)
+ expected-annotations))))))
+
+(defsubst dbus--test-validate-annotations (annotations expected-annotations)
+ "Validate a list of D-Bus ANNOTATIONS.
+Ensure each string in EXPECTED-ANNOTATIONS names an element of ANNOTATIONS.
+And ensure each ANNOTATIONS has a value attribute marked \"true\"."
+ (mapc
+ (lambda (annotation)
+ (let ((name (dbus-introspect-get-attribute annotation "name"))
+ (value (dbus-introspect-get-attribute annotation "value")))
+ (should
+ (member name expected-annotations))
+ (should
+ (equal value "true"))))
+ annotations))
+
+(defsubst dbus--test-validate-property
+ (interface property-name _expected-annotations &rest expected-args)
+ "Validate a property definition for `dbus-test07-introspection'.
+
+The argument INTERFACE is a string naming the interface owning PROPERTY-NAME.
+The argument PROPERTY-NAME is a string naming the property to validate.
+The arguments EXPECTED-ANNOTATIONS is a list of strings matching
+the annotation names defined for the method or signal.
+The argument EXPECTED-ARGS is a list of expected arguments for the property."
+ (let* ((property
+ (dbus-introspect-get-property
+ :session dbus--test-service dbus--test-path interface property-name))
+ (name (dbus-introspect-get-attribute property "name"))
+ (type (dbus-introspect-get-attribute property "type"))
+ (access (dbus-introspect-get-attribute property "access"))
+ (expected (assoc-string name expected-args)))
+ (should expected)
+
+ (should
+ (string-equal name property-name))
+
+ (should
+ (string-equal
+ (nth 0 expected)
+ name))
+
+ (should
+ (string-equal
+ (nth 1 expected)
+ type))
+
+ (should
+ (string-equal
+ (nth 2 expected)
+ access))))
+
+(defsubst dbus--test-validate-m-or-s (tree expected-annotations expected-args)
+ "Validate a method or signal definition for `dbus-test07-introspection'.
+The argument TREE is an sexp returned from either `dbus-introspect-get-method'
+or `dbus-introspect-get-signal'
+The arguments EXPECTED-ANNOTATIONS is a list of strings matching
+the annotation names defined for the method or signal.
+The argument EXPECTED-ARGS is a list of expected arguments for
+the method or signal."
+ (let (args annotations)
+ (mapc (lambda (elem)
+ (cond
+ ((eq 'arg (car elem)) (push elem args))
+ ((eq 'annotation (car elem)) (push elem annotations))))
+ tree)
+ (should
+ (equal
+ (nreverse args)
+ expected-args))
+ (dbus--test-validate-annotations annotations expected-annotations)))
+
+(defsubst dbus--test-validate-signal
+ (interface signal-name expected-annotations &rest expected-args)
+ "Validate a signal definition for `dbus-test07-introspection'.
+
+The argument INTERFACE is a string naming the interface owning SIGNAL-NAME.
+The argument SIGNAL-NAME is a string naming the signal to validate.
+The arguments EXPECTED-ANNOTATIONS is a list of strings matching
+the annotation names defined for the signal.
+The argument EXPECTED-ARGS is a list of expected arguments for the signal."
+ (let ((signal
+ (dbus-introspect-get-signal
+ :session dbus--test-service dbus--test-path interface signal-name)))
+ (pcase-let ((`(signal ((name . ,name)) . ,rest) signal))
+ (should
+ (string-equal name signal-name))
+ (should
+ (string-equal name (dbus-introspect-get-attribute signal "name")))
+ (dbus--test-validate-m-or-s rest expected-annotations expected-args))))
+
+(defsubst dbus--test-validate-method
+ (interface method-name expected-annotations &rest expected-args)
+ "Validate a method definition for `dbus-test07-introspection'.
+
+The argument INTERFACE is a string naming the interface owning METHOD-NAME.
+The argument METHOD-NAME is a string naming the method to validate.
+The arguments EXPECTED-ANNOTATIONS is a list of strings matching
+the annotation names defined for the method.
+The argument EXPECTED-ARGS is a list of expected arguments for the method."
+ (let ((method
+ (dbus-introspect-get-method
+ :session dbus--test-service dbus--test-path interface method-name)))
+ (pcase-let ((`(method ((name . ,name)) . ,rest) method))
+ (should
+ (string-equal name method-name))
+ (should
+ (string-equal name (dbus-introspect-get-attribute method "name")))
+ (dbus--test-validate-m-or-s rest expected-annotations expected-args))))
+
+(ert-deftest dbus-test07-introspection ()
+ "Register an Introspection interface then query it."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+ (dbus-register-service :session dbus--test-service)
+
+ ;; Prepare introspection response.
+ (dbus-register-method
+ :session dbus--test-service dbus--test-path dbus-interface-introspectable
+ "Introspect" 'dbus--test-introspect)
+ (dbus-register-method
+ :session dbus--test-service (concat dbus--test-path "/node0")
+ dbus-interface-introspectable
+ "Introspect" 'dbus--test-introspect)
+ (dbus-register-method
+ :session dbus--test-service (concat dbus--test-path "/node1")
+ dbus-interface-introspectable
+ "Introspect" 'dbus--test-introspect)
+ (unwind-protect
+ (let ((start (current-time)))
+ ;; dbus-introspect-get-node-names
+ (should
+ (equal
+ (dbus-introspect-get-node-names
+ :session dbus--test-service dbus--test-path)
+ '("node0" "node1")))
+
+ ;; dbus-introspect-get-all-nodes
+ (should
+ (equal
+ (dbus-introspect-get-all-nodes
+ :session dbus--test-service dbus--test-path)
+ (list dbus--test-path
+ (concat dbus--test-path "/node0")
+ (concat dbus--test-path "/node1"))))
+
+ ;; dbus-introspect-get-interface-names
+ (let ((interfaces
+ (dbus-introspect-get-interface-names
+ :session dbus--test-service dbus--test-path)))
+
+ (should
+ (equal
+ interfaces
+ `(,dbus-interface-introspectable
+ ,dbus-interface-properties
+ ,dbus--test-interface)))
+
+ (dbus--test-validate-interface
+ dbus-interface-introspectable nil '("Introspect") nil nil)
+
+ ;; dbus-introspect-get-interface via `dbus--test-validate-interface'.
+ (dbus--test-validate-interface
+ dbus-interface-properties nil
+ '("Get" "Set" "GetAll") '("PropertiesChanged") nil)
+
+ (dbus--test-validate-interface
+ dbus--test-interface '("Connected" "Player")
+ '("Connect" "DeprecatedMethod0" "DeprecatedMethod1") nil
+ `(,dbus-annotation-deprecated)))
+
+ ;; dbus-introspect-get-method-names
+ (let ((methods
+ (dbus-introspect-get-method-names
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface)))
+ (should
+ (equal
+ methods
+ '("Connect" "DeprecatedMethod0" "DeprecatedMethod1")))
+
+ ;; dbus-introspect-get-method via `dbus--test-validate-method'.
+ (dbus--test-validate-method
+ dbus--test-interface "Connect" nil
+ '(arg ((name . "uuid") (type . "s") (direction . "in")))
+ '(arg ((name . "mode") (type . "y") (direction . "in")))
+ '(arg ((name . "options") (type . "a{sv}") (direction . "in")))
+ '(arg ((name . "interface") (type . "s") (direction . "out"))))
+
+ (dbus--test-validate-method
+ dbus--test-interface "DeprecatedMethod0"
+ `(,dbus-annotation-deprecated))
+
+ (dbus--test-validate-method
+ dbus--test-interface "DeprecatedMethod1"
+ `(,dbus-annotation-deprecated)))
+
+ ;; dbus-introspect-get-signal-names
+ (let ((signals
+ (dbus-introspect-get-signal-names
+ :session dbus--test-service dbus--test-path
+ dbus-interface-properties)))
+ (should
+ (equal
+ signals
+ '("PropertiesChanged")))
+
+ ;; dbus-introspect-get-signal via `dbus--test-validate-signal'.
+ (dbus--test-validate-signal
+ dbus-interface-properties "PropertiesChanged" nil
+ '(arg ((name . "interface") (type . "s")))
+ '(arg ((name . "changed_properties") (type . "a{sv}")))
+ '(arg ((name . "invalidated_properties") (type . "as")))))
+
+ ;; dbus-intropct-get-property-names
+ (let ((properties
+ (dbus-introspect-get-property-names
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface)))
+ (should
+ (equal
+ properties
+ '("Connected" "Player")))
+
+ ;; dbus-introspect-get-property via `dbus--test-validate-property'.
+ (dbus--test-validate-property
+ dbus--test-interface "Connected" nil
+ '("Connected" "b" "read")
+ '("Player" "o" "read")))
+
+ ;; Elapsed time over a second suggests timeouts.
+ (should
+ (< 0.0 (float-time (time-since start)) 1.0)))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+(ert-deftest dbus-test07-introspection-timeout ()
+ "Verify introspection request timeouts."
+ :tags '(:expensive-test)
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+ (dbus-register-service :session dbus--test-service)
+
+ (unwind-protect
+ (let ((start (current-time)))
+ (dbus-introspect-xml :session dbus--test-service dbus--test-path)
+ ;; Introspection internal timeout is one second.
+ (should
+ (< 1.0 (float-time (time-since start)))))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
(defun dbus-test-all (&optional interactive)
"Run all tests for \\[dbus]."
(interactive "p")
- (funcall
- (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^dbus"))
+ (funcall (if interactive #'ert-run-tests-interactively #'ert-run-tests-batch)
+ "^dbus"))
(provide 'dbus-tests)
;;; dbus-tests.el ends here
diff --git a/test/lisp/net/dig-tests.el b/test/lisp/net/dig-tests.el
new file mode 100644
index 00000000000..1b14384634e
--- /dev/null
+++ b/test/lisp/net/dig-tests.el
@@ -0,0 +1,56 @@
+;;; dig-tests.el --- Tests for dig.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'dig)
+
+(defvar dig-test-result-data "
+; <<>> DiG 9.11.16-2-Debian <<>> gnu.org
+;; global options: +cmd
+;; Got answer:
+;; ->>HEADER<<- opcode: QUERY, status: NOERROR, id: 7777
+;; flags: qr rd ra; QUERY: 1, ANSWER: 1, AUTHORITY: 0, ADDITIONAL: 1
+
+;; OPT PSEUDOSECTION:
+; EDNS: version: 0, flags:; udp: 4096
+;; QUESTION SECTION:
+;gnu.org. IN A
+
+;; ANSWER SECTION:
+gnu.org. 300 IN A 111.11.111.111
+
+;; Query time: 127 msec
+;; SERVER: 192.168.0.1#53(192.168.0.1)
+;; WHEN: Sun Apr 26 00:47:55 CEST 2020
+;; MSG SIZE rcvd: 52
+
+" "Data used to test dig.el.")
+
+(ert-deftest dig-test-dig-extract-rr ()
+ (with-temp-buffer
+ (insert dig-test-result-data)
+ (should (equal (dig-extract-rr "gnu.org")
+ "gnu.org. 300 IN A 111.11.111.111"))))
+
+(provide 'dig-tests)
+;;; dig-tests.el ends here
diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el
index c2472d844c1..5205f0b851f 100644
--- a/test/lisp/net/gnutls-tests.el
+++ b/test/lisp/net/gnutls-tests.el
@@ -1,4 +1,4 @@
-;;; gnutls-tests.el --- Test suite for gnutls.el
+;;; gnutls-tests.el --- Test suite for gnutls.el -*- lexical-binding:t -*-
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
@@ -241,6 +241,7 @@
(ert-deftest test-gnutls-005-aead-ciphers ()
"Test the GnuTLS AEAD ciphers"
+ :tags '(:expensive-test)
(skip-unless (memq 'AEAD-ciphers (gnutls-available-p)))
(setq gnutls-tests-message-prefix "AEAD verification: ")
(let ((keys '("mykey" "mykey2"))
diff --git a/test/lisp/net/hmac-md5-tests.el b/test/lisp/net/hmac-md5-tests.el
new file mode 100644
index 00000000000..30d221ec87b
--- /dev/null
+++ b/test/lisp/net/hmac-md5-tests.el
@@ -0,0 +1,80 @@
+;;; hmac-md5-tests.el --- Tests for hmac-md5.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'hmac-md5)
+
+;; Test cases from RFC 2202, "Test Cases for HMAC-MD5 and HMAC-SHA-1",
+;; moved here from hmac-md5.el
+
+(ert-deftest hmac-md5-test-encode-string ()
+ ;; RFC 2202 -- test_case 1
+ (should (equal (encode-hex-string
+ (hmac-md5 "Hi There" (make-string 16 ?\x0b)))
+ "9294727a3638bb1c13f48ef8158bfc9d"))
+
+ ;; RFC 2202 -- test_case 2
+ (should (equal (encode-hex-string
+ (hmac-md5 "what do ya want for nothing?" "Jefe"))
+ "750c783e6ab0b503eaa86e310a5db738"))
+
+ ;; RFC 2202 -- test_case 3
+ (should (equal (encode-hex-string
+ (hmac-md5 (decode-hex-string (make-string 100 ?d))
+ (decode-hex-string (make-string 32 ?a))))
+ "56be34521d144c88dbb8c733f0e8b3f6"))
+
+ ;; RFC 2202 -- test_case 4
+ (should (equal (encode-hex-string
+ (hmac-md5 (decode-hex-string
+ (mapconcat (lambda (c) (concat (list c) "d"))
+ (make-string 50 ?c) ""))
+ (decode-hex-string "0102030405060708090a0b0c0d0e0f10111213141516171819")))
+ "697eaf0aca3a3aea3a75164746ffaa79"))
+
+ ;; RFC 2202 -- test_case 5 (a)
+ (should (equal (encode-hex-string
+ (hmac-md5 "Test With Truncation" (make-string 16 ?\x0c)))
+ "56461ef2342edc00f9bab995690efd4c"))
+
+ ;; RFC 2202 -- test_case 5 (b)
+ (should (equal (encode-hex-string
+ (hmac-md5-96 "Test With Truncation" (make-string 16 ?\x0c)))
+ "56461ef2342edc00f9bab995"))
+
+ ;; RFC 2202 -- test_case 6
+ (should (equal (encode-hex-string
+ (hmac-md5
+ "Test Using Larger Than Block-Size Key - Hash Key First"
+ (decode-hex-string (make-string 160 ?a))))
+ "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd"))
+
+ ;; RFC 2202 -- test_case 7
+ (should (equal (encode-hex-string
+ (hmac-md5
+ "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"
+ (decode-hex-string (make-string 160 ?a))))
+ "6f630fad67cda0ee1fb1f562db3aa53e")))
+
+(provide 'hmac-md5-tests)
+;;; hmac-md5-tests.el ends here
diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el
index 28686547a44..cf416155e50 100644
--- a/test/lisp/net/network-stream-tests.el
+++ b/test/lisp/net/network-stream-tests.el
@@ -136,7 +136,20 @@
(t
))))
+(defun network-test--resolve-system-name ()
+ (cl-loop for address in (network-lookup-address-info (system-name))
+ when (or (and (= (length address) 5)
+ ;; IPv4 localhost addresses start with 127.
+ (= (elt address 0) 127))
+ (and (= (length address) 9)
+ ;; IPv6 localhost address.
+ (equal address [0 0 0 0 0 0 0 1 0])))
+ return t))
+
(ert-deftest echo-server-with-dns ()
+ (unless (network-test--resolve-system-name)
+ (ert-skip "Can't test resolver for (system-name)"))
+
(let* ((server (make-server (system-name)))
(port (aref (process-contact server :local) 4))
(proc (make-network-process :name "foo"
@@ -724,4 +737,56 @@
44777
(vector :nowait t))))
+(ert-deftest check-network-process-coding-system-bind ()
+ "Check that binding coding-system-for-{read,write} works."
+ (let* ((coding-system-for-read 'binary)
+ (coding-system-for-write 'utf-8-unix)
+ (server
+ (make-network-process
+ :name "server"
+ :server t
+ :noquery t
+ :family 'ipv4
+ :service t
+ :host 'local))
+ (coding (process-coding-system server)))
+ (should (eq (car coding) 'binary))
+ (should (eq (cdr coding) 'utf-8-unix))
+ (delete-process server)))
+
+(ert-deftest check-network-process-coding-system-no-override ()
+ "Check that coding-system-for-{read,write} is not overridden by :coding nil."
+ (let* ((coding-system-for-read 'binary)
+ (coding-system-for-write 'utf-8-unix)
+ (server
+ (make-network-process
+ :name "server"
+ :server t
+ :noquery t
+ :family 'ipv4
+ :service t
+ :coding nil
+ :host 'local))
+ (coding (process-coding-system server)))
+ (should (eq (car coding) 'binary))
+ (should (eq (cdr coding) 'utf-8-unix))
+ (delete-process server)))
+
+(ert-deftest check-network-process-coding-system-override ()
+ "Check that :coding non-nil overrides coding-system-for-{read,write}."
+ (let* ((coding-system-for-read 'binary)
+ (coding-system-for-write 'utf-8-unix)
+ (server
+ (make-network-process
+ :name "server"
+ :server t
+ :noquery t
+ :family 'ipv4
+ :service t
+ :coding 'georgian-academy
+ :host 'local))
+ (coding (process-coding-system server)))
+ (should (eq (car coding) 'georgian-academy))
+ (should (eq (cdr coding) 'georgian-academy))
+ (delete-process server)))
;;; network-stream-tests.el ends here
diff --git a/test/lisp/net/newsticker-tests.el b/test/lisp/net/newsticker-tests.el
index 1a6e11dc512..5552fa8c1a6 100644
--- a/test/lisp/net/newsticker-tests.el
+++ b/test/lisp/net/newsticker-tests.el
@@ -1,4 +1,4 @@
-;;; newsticker-testsuite.el --- Test suite for newsticker.
+;;; newsticker-tests.el --- Test suite for newsticker. -*- lexical-binding:t -*-
;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/net/puny-tests.el b/test/lisp/net/puny-tests.el
index 9fb2ebb5469..7dac39795b6 100644
--- a/test/lisp/net/puny-tests.el
+++ b/test/lisp/net/puny-tests.el
@@ -1,4 +1,4 @@
-;;; puny-tests.el --- tests for net/puny.el -*- coding: utf-8; -*-
+;;; puny-tests.el --- tests for net/puny.el -*- coding: utf-8; lexical-binding:t -*-
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
@@ -38,4 +38,25 @@
"Test puny decoding."
(should (string= (puny-decode-string "xn--9dbdkw") "חנוך")))
+(ert-deftest puny-test-encode-domain ()
+ (should (string= (puny-encode-domain "åäö.se") "xn--4cab6c.se")))
+
+(ert-deftest puny-test-decode-domain ()
+ (should (string= (puny-decode-domain "xn--4cab6c.se") "åäö.se")))
+
+(ert-deftest puny-highly-restrictive-domain-p ()
+ (should (puny-highly-restrictive-domain-p "foo.bar.org"))
+ (should (puny-highly-restrictive-domain-p "foo.abcåäö.org"))
+ (should (puny-highly-restrictive-domain-p "foo.ர.org"))
+ ;; Disallow unicode character 2044, visually similar to "/".
+ (should-not (puny-highly-restrictive-domain-p "www.yourbank.com⁄login⁄checkUser.jsp?inxs.ch"))
+ ;; Disallow mixing scripts.
+ (should-not (puny-highly-restrictive-domain-p "åர.org"))
+ ;; Only allowed in moderately restrictive.
+ (should-not (puny-highly-restrictive-domain-p "Teχ.org"))
+ (should-not (puny-highly-restrictive-domain-p "HλLF-LIFE.org"))
+ (should-not (puny-highly-restrictive-domain-p "Ωmega.org"))
+ ;; Only allowed in unrestricted.
+ (should-not (puny-highly-restrictive-domain-p "I♥NY.org")))
+
;;; puny-tests.el ends here
diff --git a/test/lisp/net/rfc2104-tests.el b/test/lisp/net/rfc2104-tests.el
index 5c1f4410934..90535898382 100644
--- a/test/lisp/net/rfc2104-tests.el
+++ b/test/lisp/net/rfc2104-tests.el
@@ -1,4 +1,4 @@
-;;; rfc2104-tests.el --- Tests of RFC2104 hashes
+;;; rfc2104-tests.el --- Tests of RFC2104 hashes -*- lexical-binding:t -*-
;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/net/sasl-scram-rfc-tests.el b/test/lisp/net/sasl-scram-rfc-tests.el
index ec283c86f55..09e05b62a25 100644
--- a/test/lisp/net/sasl-scram-rfc-tests.el
+++ b/test/lisp/net/sasl-scram-rfc-tests.el
@@ -1,4 +1,4 @@
-;;; sasl-scram-rfc-tests.el --- tests for SCRAM-SHA-1 -*- lexical-binding: t; -*-
+;;; sasl-scram-rfc-tests.el --- tests for SCRAM -*- lexical-binding: t; -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;;; Commentary:
-;; Test cases from RFC 5802.
+;; Test cases from RFC 5802 and RFC 7677.
;;; Code:
@@ -47,4 +47,26 @@
(sasl-scram-sha-1-authenticate-server client (vector nil "v=rmF9pqV8S7suAoZWja4dJRkFsKQ=
"))))
+(require 'sasl-scram-sha256)
+
+(ert-deftest sasl-scram-sha-256-test ()
+ ;; The following strings are taken from section 3 of RFC 7677.
+ (let ((client
+ (sasl-make-client (sasl-find-mechanism '("SCRAM-SHA-256"))
+ "user"
+ "imap"
+ "localhost"))
+ (data "r=rOprNGfwEbeRWgbNEkqO%hvYDpWUa2RaTCAfuxFIlj)hNlF$k0,s=W22ZaJ0SNY7soEsUEjb6gQ==,i=4096")
+ (c-nonce "rOprNGfwEbeRWgbNEkqO")
+ (sasl-read-passphrase
+ (lambda (_prompt) (copy-sequence "pencil"))))
+ (sasl-client-set-property client 'c-nonce c-nonce)
+ (should
+ (equal
+ (sasl-scram-sha-256-client-final-message client (vector nil data))
+ "c=biws,r=rOprNGfwEbeRWgbNEkqO%hvYDpWUa2RaTCAfuxFIlj)hNlF$k0,p=dHzbZapWIk4jUhN+Ute9ytag9zjfMHgsqmmiz7AndVQ="))
+
+ ;; This should not throw an error:
+ (sasl-scram-sha-256-authenticate-server client (vector nil "v=6rriTRBi23WpRR/wtup+mMhUZUn/dB5nLTJRsjl95G4="))))
+
;;; sasl-scram-rfc-tests.el ends here
diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el
index 95e41a3f03b..9a2319126a9 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -48,6 +48,12 @@
(expand-file-name "foo.tar.gz" tramp-archive-test-resource-directory))
"The test file archive.")
+(defun tramp-archive-test-file-archive-hexlified ()
+ "Return hexlified `tramp-archive-test-file-archive'.
+Do not hexlify \"/\". This hexlified string is used in `file:///' URLs."
+ (let* ((url-unreserved-chars (cons ?/ url-unreserved-chars)))
+ (url-hexify-string tramp-archive-test-file-archive)))
+
(defconst tramp-archive-test-archive
(file-name-as-directory tramp-archive-test-file-archive)
"The test archive.")
@@ -60,7 +66,6 @@
(setq password-cache-expiry nil
tramp-cache-read-persistent-data t ;; For auth-sources.
tramp-copy-size-limit nil
- tramp-message-show-message nil
tramp-persistency-file-name nil
tramp-verbose 0)
@@ -175,7 +180,8 @@ variables, so we check the Emacs version directly."
(should
(string-equal
host
- (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
+ (url-hexify-string
+ (concat "file://" (tramp-archive-test-file-archive-hexlified)))))
(should-not port)
(should (string-equal localname "/"))
(should (string-equal archive tramp-archive-test-file-archive)))
@@ -194,7 +200,8 @@ variables, so we check the Emacs version directly."
(should
(string-equal
host
- (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
+ (url-hexify-string
+ (concat "file://" (tramp-archive-test-file-archive-hexlified)))))
(should-not port)
(should (string-equal localname "/foo"))
(should (string-equal archive tramp-archive-test-file-archive)))
@@ -238,7 +245,8 @@ variables, so we check the Emacs version directly."
;; archive boundaries. So we must cut the
;; trailing slash ourselves.
(substring
- (file-name-directory tramp-archive-test-file-archive)
+ (file-name-directory
+ (tramp-archive-test-file-archive-hexlified))
0 -1)))
nil "/"))
(file-name-nondirectory tramp-archive-test-file-archive)))))
@@ -971,4 +979,5 @@ If INTERACTIVE is non-nil, the tests are run interactively."
"^tramp-archive"))
(provide 'tramp-archive-tests)
+
;;; tramp-archive-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 89d4171ddea..3914f9ae44e 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -43,6 +43,7 @@
(require 'dired)
(require 'ert)
(require 'ert-x)
+(require 'trace)
(require 'tramp)
(require 'vc)
(require 'vc-bzr)
@@ -50,14 +51,13 @@
(require 'vc-hg)
(declare-function tramp-find-executable "tramp-sh")
+(declare-function tramp-get-remote-chmod-h "tramp-sh")
(declare-function tramp-get-remote-gid "tramp-sh")
(declare-function tramp-get-remote-path "tramp-sh")
(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")
-(declare-function tramp-time-diff "tramp")
(defvar ange-ftp-make-backup-files)
(defvar auto-save-file-name-transforms)
(defvar tramp-connection-properties)
@@ -68,8 +68,6 @@
(defvar tramp-remote-path)
(defvar tramp-remote-process-environment)
-;; Needed for Emacs 24.
-(defvar inhibit-message)
;; Needed for Emacs 25.
(defvar connection-local-criteria-alist)
(defvar connection-local-profile-alist)
@@ -98,25 +96,29 @@
'("mock"
(tramp-login-program "sh")
(tramp-login-args (("-i")))
+ (tramp-direct-async-args (("-c")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)))
(add-to-list
'tramp-default-host-alist
`("\\`mock\\'" nil ,(system-name)))
- ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in
- ;; batch mode only, therefore.
+ ;; Emacs's Makefile sets $HOME to a nonexistent value. Needed
+ ;; in batch mode only, therefore.
(unless (and (null noninteractive) (file-directory-p "~/"))
(setenv "HOME" temporary-file-directory))
(format "/mock::%s" temporary-file-directory)))
"Temporary directory for Tramp tests.")
+(defconst tramp-test-vec
+ (tramp-dissect-file-name tramp-test-temporary-file-directory)
+ "The used `tramp-file-name' structure.")
+
(setq auth-source-save-behavior nil
password-cache-expiry nil
remote-file-name-inhibit-cache nil
tramp-cache-read-persistent-data t ;; For auth-sources.
tramp-copy-size-limit nil
- tramp-message-show-message nil
tramp-persistency-file-name nil
tramp-verbose 0)
@@ -144,9 +146,7 @@ being the result.")
(when (cdr tramp--test-enabled-checked)
;; Cleanup connection.
(ignore-errors
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- nil 'keep-password)))
+ (tramp-cleanup-connection tramp-test-vec nil 'keep-password)))
;; Return result.
(cdr tramp--test-enabled-checked))
@@ -177,38 +177,46 @@ This shall used dynamically bound only.")
(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
-`tramp-verbose' is greater than 3. `should-error' is not handled
-properly. BODY shall not contain a timeout."
+`tramp-verbose' is greater than 3. Print traces if `tramp-verbose'
+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)))
- (tramp-message-show-message t)
- (debug-ignored-errors
- (append
- '("^make-symbolic-link not supported$"
- "^error with add-name-to-file")
- debug-ignored-errors))
- inhibit-message)
+ `(let* ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
+ (trace-buffer
+ (when (> tramp-verbose 10) (generate-new-buffer " *temp*")))
+ (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 (tramp-list-tramp-buffers))
+ (dolist
+ (buf (if trace-buffer
+ (cons (get-buffer trace-buffer) (tramp-list-tramp-buffers))
+ (tramp-list-tramp-buffers)))
(with-current-buffer buf
- (message ";; %s\n%s" buf (buffer-string))))))))
+ (message ";; %s\n%s" buf (buffer-string)))))
+ (when trace-buffer
+ (kill-buffer trace-buffer)))))
(defsubst tramp--test-message (fmt-string &rest arguments)
"Emit a message into ERT *Messages*."
(tramp--test-instrument-test-case 0
- (apply
- #'tramp-message
- (tramp-dissect-file-name tramp-test-temporary-file-directory) 0
- fmt-string arguments)))
+ (apply #'tramp-message tramp-test-vec 0 fmt-string arguments)))
(defsubst tramp--test-backtrace ()
"Dump a backtrace into ERT *Messages*."
(tramp--test-instrument-test-case 10
- (tramp-backtrace
- (tramp-dissect-file-name tramp-test-temporary-file-directory))))
+ (tramp-backtrace tramp-test-vec)))
(defmacro tramp--test-print-duration (message &rest body)
"Run BODY and print a message with duration, prompted by MESSAGE."
@@ -1970,9 +1978,9 @@ properly. BODY shall not contain a timeout."
;; Host names must match rules in case the command template of a
;; method doesn't use them.
(dolist (m '("su" "sg" "sudo" "doas" "ksu"))
- (let ((vec (tramp-dissect-file-name tramp-test-temporary-file-directory))
- tramp-connection-properties tramp-default-proxies-alist)
- (ignore-errors (tramp-cleanup-connection vec nil 'keep-password))
+ (let (tramp-connection-properties tramp-default-proxies-alist)
+ (ignore-errors
+ (tramp-cleanup-connection tramp-test-vec nil 'keep-password))
;; Single hop. The host name must match `tramp-local-host-regexp'.
(should-error
(find-file (format "/%s:foo:" m))
@@ -1992,16 +2000,17 @@ properly. BODY shall not contain a timeout."
(skip-unless (tramp--test-enabled))
;; Multi hops are allowed for inline methods only.
- (should-error
- (file-remote-p "/ssh:user1@host1|method:user2@host2:/path/to/file")
- :type 'user-error)
- (should-error
- (file-remote-p "/method:user1@host1|ssh:user2@host2:/path/to/file")
- :type 'user-error)
+ (let (non-essential)
+ (should-error
+ (expand-file-name "/ssh:user1@host1|method:user2@host2:/path/to/file")
+ :type 'user-error)
+ (should-error
+ (expand-file-name "/method:user1@host1|ssh:user2@host2:/path/to/file")
+ :type 'user-error))
;; Samba does not support file names with periods followed by
;; spaces, and trailing periods or spaces.
- (when (tramp-smb-file-name-p tramp-test-temporary-file-directory)
+ (when (tramp--test-smb-p)
(dolist (file '("foo." "foo. bar" "foo "))
(should-error
(tramp-smb-get-localname
@@ -2013,8 +2022,12 @@ properly. BODY shall not contain a timeout."
"Check `substitute-in-file-name'."
(skip-unless (eq tramp-syntax 'default))
- ;; Suppress method name check.
- (let ((tramp-methods (cons '("method") tramp-methods)))
+ ;; Suppress method name check. We cannot use the string "foo" as
+ ;; user name, because (substitute-in-string "/~foo") returns
+ ;; different values depending on the existence of user "foo" (see
+ ;; Bug#43052).
+ (let ((tramp-methods (cons '("method") tramp-methods))
+ (foo (downcase (md5 (current-time-string)))))
(should
(string-equal (substitute-in-file-name "/method:host:///foo") "/foo"))
(should
@@ -2043,39 +2056,43 @@ properly. BODY shall not contain a timeout."
"/method:host:/:/path//foo"))
;; Forwhatever reasons, the following tests let Emacs crash for
- ;; Emacs 24 and Emacs 25, occasionally. No idea what's up.
+ ;; Emacs 25, occasionally. No idea what's up.
(when (tramp--test-emacs26-p)
(should
- (string-equal (substitute-in-file-name "/method:host://~foo") "/~foo"))
+ (string-equal
+ (substitute-in-file-name (concat "/method:host://~" foo))
+ (concat "/~" foo)))
(should
(string-equal
- (substitute-in-file-name "/method:host:/~foo") "/method:host:/~foo"))
+ (substitute-in-file-name (concat "/method:host:/~" foo))
+ (concat "/method:host:/~" foo)))
(should
(string-equal
- (substitute-in-file-name "/method:host:/path//~foo") "/~foo"))
+ (substitute-in-file-name (concat "/method:host:/path//~" foo))
+ (concat "/~" foo)))
;; (substitute-in-file-name "/path/~foo") expands only for a local
;; user "foo" to "/~foo"". Otherwise, it doesn't expand.
(should
(string-equal
- (substitute-in-file-name "/method:host:/path/~foo")
- "/method:host:/path/~foo"))
+ (substitute-in-file-name (concat "/method:host:/path/~" foo))
+ (concat "/method:host:/path/~" foo)))
;; Quoting local part.
(should
(string-equal
- (substitute-in-file-name "/method:host:/://~foo")
- "/method:host:/://~foo"))
+ (substitute-in-file-name (concat "/method:host:/://~" foo))
+ (concat "/method:host:/://~" foo)))
(should
(string-equal
- (substitute-in-file-name
- "/method:host:/:/~foo") "/method:host:/:/~foo"))
+ (substitute-in-file-name (concat "/method:host:/:/~" foo))
+ (concat "/method:host:/:/~" foo)))
(should
(string-equal
- (substitute-in-file-name "/method:host:/:/path//~foo")
- "/method:host:/:/path//~foo"))
+ (substitute-in-file-name (concat "/method:host:/:/path//~" foo))
+ (concat "/method:host:/:/path//~" foo)))
(should
(string-equal
- (substitute-in-file-name "/method:host:/:/path/~foo")
- "/method:host:/:/path/~foo")))
+ (substitute-in-file-name (concat "/method:host:/:/path/~" foo))
+ (concat "/method:host:/:/path/~" foo))))
(let (process-environment)
(should
@@ -2144,20 +2161,12 @@ properly. BODY shall not contain a timeout."
"/method:host:/:/~/path/file"))))
;; The following test is inspired by Bug#26911 and Bug#34834. They
-;; are rather bugs in `expand-file-name', and it fails for all Emacs
-;; versions prior 28.1. Test added for later, when they are fixed.
+;; were bugs in `expand-file-name'.
(ert-deftest tramp-test05-expand-file-name-relative ()
"Check `expand-file-name'."
- :expected-result (if (>= emacs-major-version 28) :passed :failed)
(skip-unless (tramp--test-enabled))
-
- ;; These are the methods the test doesn't fail.
- (when (or (tramp--test-adb-p) (tramp--test-ange-ftp-p) (tramp--test-gvfs-p)
- (tramp--test-rclone-p)
- (tramp-smb-file-name-p tramp-test-temporary-file-directory))
- (setf (ert-test-expected-result-type
- (ert-get-test 'tramp-test05-expand-file-name-relative))
- :passed))
+ ;; The bugs are fixed in Emacs 28.1.
+ (skip-unless (tramp--test-emacs28-p))
(should
(string-equal
@@ -2221,11 +2230,10 @@ This checks also `file-name-as-directory', `file-name-directory',
;; Bug#10085.
(when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
- (dolist (n-e '(nil t))
+ (dolist (non-essential '(nil t))
;; We must clear `tramp-default-method'. On hydra, it is "ftp",
;; which ruins the tests.
- (let ((non-essential n-e)
- (tramp-default-method
+ (let ((tramp-default-method
(file-remote-p tramp-test-temporary-file-directory 'method))
(host (file-remote-p tramp-test-temporary-file-directory 'host)))
(dolist
@@ -2241,7 +2249,7 @@ This checks also `file-name-as-directory', `file-name-directory',
(should
(string-equal
(file-name-as-directory file)
- (if (tramp-completion-mode-p)
+ (if non-essential
file (concat file (if (tramp--test-ange-ftp-p) "/" "./")))))
(should (string-equal (file-name-directory file) file))
(should (string-equal (file-name-nondirectory file) "")))))))
@@ -2299,16 +2307,25 @@ This checks also `file-name-as-directory', `file-name-directory',
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
- (insert-file-contents tmp-name)
- (should (string-equal (buffer-string) "foo"))
- (insert-file-contents tmp-name)
- (should (string-equal (buffer-string) "foofoo"))
+ (let ((point (point)))
+ (insert-file-contents tmp-name)
+ (should (string-equal (buffer-string) "foo"))
+ (should (= point (point))))
+ (goto-char (1+ (point)))
+ (let ((point (point)))
+ (insert-file-contents tmp-name)
+ (should (string-equal (buffer-string) "ffoooo"))
+ (should (= point (point))))
;; Insert partly.
- (insert-file-contents tmp-name nil 1 3)
- (should (string-equal (buffer-string) "oofoofoo"))
+ (let ((point (point)))
+ (insert-file-contents tmp-name nil 1 3)
+ (should (string-equal (buffer-string) "foofoooo"))
+ (should (= point (point))))
;; Replace.
- (insert-file-contents tmp-name nil nil nil 'replace)
- (should (string-equal (buffer-string) "foo"))
+ (let ((point (point)))
+ (insert-file-contents tmp-name nil nil nil 'replace)
+ (should (string-equal (buffer-string) "foo"))
+ (should (= point (point))))
;; Error case.
(delete-file tmp-name)
(should-error
@@ -2386,7 +2403,7 @@ This checks also `file-name-as-directory', `file-name-directory',
;; Check message.
;; Macro `ert-with-message-capture' was introduced in Emacs 26.1.
(with-no-warnings (when (symbol-plist 'ert-with-message-capture)
- (let ((tramp-message-show-message t))
+ (let (inhibit-message)
(dolist
(noninteractive (unless (tramp--test-ange-ftp-p) '(nil t)))
(dolist (visit '(nil t "string" no-message))
@@ -2921,6 +2938,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
;; (this is performed by `dired'). If FULL is nil, it shows just
;; one file. So we refrain from testing.
(skip-unless (not (tramp--test-ange-ftp-p)))
+ ;; `insert-directory' of crypted remote directories works only since
+ ;; Emacs 27.1.
+ (skip-unless (or (not (tramp--test-crypt-p)) (tramp--test-emacs27-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let* ((tmp-name1
@@ -2991,6 +3011,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
+ ;; Wildcards are not supported in tramp-crypt.el.
+ (skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 26.1.
(skip-unless (fboundp 'insert-directory-wildcard-in-dir-p))
@@ -3140,8 +3162,7 @@ This tests also `access-file', `file-readable-p',
(setq test-file-ownership-preserved-p
(= (tramp-compat-file-attribute-group-id
(file-attributes tmp-name1))
- (tramp-get-remote-gid
- (tramp-dissect-file-name tmp-name1) 'integer)))
+ (tramp-get-remote-gid tramp-test-vec 'integer)))
(delete-file tmp-name1))
(should-error
@@ -3376,25 +3397,80 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
"ftp" (file-remote-p tramp-test-temporary-file-directory 'method)))))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
- (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
+ (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
+ (tmp-name2 (tramp--test-make-temp-name nil quoted)))
+
(unwind-protect
(progn
- (write-region "foo" nil tmp-name)
- (should (file-exists-p tmp-name))
- (set-file-modes tmp-name #o777)
- (should (= (file-modes tmp-name) #o777))
- (should (file-executable-p tmp-name))
- (should (file-writable-p tmp-name))
- (set-file-modes tmp-name #o444)
- (should (= (file-modes tmp-name) #o444))
- (should-not (file-executable-p tmp-name))
+ (write-region "foo" nil tmp-name1)
+ (should (file-exists-p tmp-name1))
+ (set-file-modes tmp-name1 #o777)
+ (should (= (file-modes tmp-name1) #o777))
+ (should (file-executable-p tmp-name1))
+ (should (file-writable-p tmp-name1))
+ (set-file-modes tmp-name1 #o444)
+ (should (= (file-modes tmp-name1) #o444))
+ (should-not (file-executable-p tmp-name1))
;; A file is always writable for user "root".
(unless (zerop (tramp-compat-file-attribute-user-id
- (file-attributes tmp-name)))
- (should-not (file-writable-p tmp-name))))
+ (file-attributes tmp-name1)))
+ (should-not (file-writable-p tmp-name1)))
+ ;; Check the NOFOLLOW arg. It exists since Emacs 28. For
+ ;; regular files, there shouldn't be a difference.
+ (when (tramp--test-emacs28-p)
+ (with-no-warnings
+ (set-file-modes tmp-name1 #o222 'nofollow)
+ (should (= (file-modes tmp-name1 'nofollow) #o222)))))
;; Cleanup.
- (ignore-errors (delete-file tmp-name))))))
+ (ignore-errors (delete-file tmp-name1)))
+
+ ;; Check the NOFOLLOW arg. It exists since Emacs 28. It is
+ ;; implemented for tramp-gvfs.el and tramp-sh.el. However,
+ ;; tramp-gvfs,el does not support creating symbolic links. And
+ ;; in tramp-sh.el, we must ensure that the remote chmod command
+ ;; supports the "-h" argument.
+ (when (and (tramp--test-emacs28-p) (tramp--test-sh-p)
+ (tramp-get-remote-chmod-h tramp-test-vec))
+ (unwind-protect
+ (with-no-warnings
+ (write-region "foo" nil tmp-name1)
+ (should (file-exists-p tmp-name1))
+ (make-symbolic-link tmp-name1 tmp-name2)
+ (should
+ (string-equal
+ (funcall
+ (if quoted #'tramp-compat-file-name-unquote #'identity)
+ (file-remote-p tmp-name1 'localname))
+ (file-symlink-p tmp-name2)))
+ ;; Both report the modes of `tmp-name1'.
+ (should
+ (= (file-modes tmp-name1) (file-modes tmp-name2)))
+ ;; `tmp-name1' is a regular file. NOFOLLOW doesn't matter.
+ (should
+ (= (file-modes tmp-name1) (file-modes tmp-name1 'nofollow)))
+ ;; `tmp-name2' is a symbolic link. It has different permissions.
+ (should-not
+ (= (file-modes tmp-name2) (file-modes tmp-name2 'nofollow)))
+ (should-not
+ (= (file-modes tmp-name1 'nofollow)
+ (file-modes tmp-name2 'nofollow)))
+ ;; Change permissions.
+ (set-file-modes tmp-name1 #o200)
+ (set-file-modes tmp-name2 #o200)
+ (should
+ (= (file-modes tmp-name1) (file-modes tmp-name2) #o200))
+ ;; Change permissions with NOFOLLOW.
+ (set-file-modes tmp-name1 #o300 'nofollow)
+ (set-file-modes tmp-name2 #o300 'nofollow)
+ (should
+ (= (file-modes tmp-name1 'nofollow)
+ (file-modes tmp-name2 'nofollow)))
+ (should-not (= (file-modes tmp-name1) (file-modes tmp-name2))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file tmp-name1))
+ (ignore-errors (delete-file tmp-name2)))))))
;; Method "smb" could run into "NT_STATUS_REVISION_MISMATCH" error.
(defmacro tramp--test-ignore-add-name-to-file-error (&rest body)
@@ -3478,7 +3554,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; `tmp-name3' is a local file name. Therefore, the link
;; target remains unchanged, even if quoted.
;; `make-symbolic-link' might not be permitted on w32 systems.
- (unless (tramp--test-windows-nt)
+ (unless (tramp--test-windows-nt-p)
(make-symbolic-link tmp-name1 tmp-name3)
(should
(string-equal tmp-name1 (file-symlink-p tmp-name3))))
@@ -3592,7 +3668,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(concat (file-remote-p tmp-name2) penguin)))))
;; `tmp-name3' is a local file name.
;; `make-symbolic-link' might not be permitted on w32 systems.
- (unless (tramp--test-windows-nt)
+ (unless (tramp--test-windows-nt-p)
(make-symbolic-link tmp-name1 tmp-name3)
(should (file-symlink-p tmp-name3))
(should-not (string-equal tmp-name3 (file-truename tmp-name3)))
@@ -3653,7 +3729,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(tramp--test-ignore-make-symbolic-link-error
(make-symbolic-link tmp-name2 tmp-name1)
(should (file-symlink-p tmp-name1))
- (if (tramp-smb-file-name-p tramp-test-temporary-file-directory)
+ (if (tramp--test-smb-p)
;; The symlink command of `smbclient' detects the
;; cycle already.
(should-error
@@ -3716,7 +3792,17 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (file-newer-than-file-p tmp-name2 tmp-name1))
;; `tmp-name3' does not exist.
(should (file-newer-than-file-p tmp-name2 tmp-name3))
- (should-not (file-newer-than-file-p tmp-name3 tmp-name1))))
+ (should-not (file-newer-than-file-p tmp-name3 tmp-name1))
+ ;; Check the NOFOLLOW arg. It exists since Emacs 28. For
+ ;; regular files, there shouldn't be a difference.
+ (when (tramp--test-emacs28-p)
+ (with-no-warnings
+ (set-file-times tmp-name1 (seconds-to-time 1) 'nofollow)
+ (should
+ (tramp-compat-time-equal-p
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes tmp-name1))
+ (seconds-to-time 1)))))))
;; Cleanup.
(ignore-errors
@@ -3756,6 +3842,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check that `file-acl' and `set-file-acl' work proper."
(skip-unless (tramp--test-enabled))
(skip-unless (file-acl tramp-test-temporary-file-directory))
+ (skip-unless (not (tramp--test-crypt-p)))
;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
(dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p))
@@ -3834,6 +3921,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(skip-unless
(not (equal (file-selinux-context tramp-test-temporary-file-directory)
'(nil nil nil nil))))
+ (skip-unless (not (tramp--test-crypt-p)))
;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
(dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p))
@@ -3977,7 +4065,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(when (not (memq system-type '(cygwin windows-nt)))
(let ((method (file-remote-p tramp-test-temporary-file-directory 'method))
(host (file-remote-p tramp-test-temporary-file-directory 'host))
- (vec (tramp-dissect-file-name tramp-test-temporary-file-directory))
(orig-syntax tramp-syntax))
(when (and (stringp host) (string-match tramp-host-with-port-regexp host))
(setq host (match-string 1 host)))
@@ -3990,7 +4077,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(tramp-change-syntax syntax)
;; This has cleaned up all connection data, which are used
;; for completion. We must refill the cache.
- (tramp-set-connection-property vec "property" nil)
+ (tramp-set-connection-property tramp-test-vec "property" nil)
(let ;; This is needed for the `simplified' syntax.
((method-marker
@@ -4046,10 +4133,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Cleanup.
(tramp-change-syntax orig-syntax))))
- (dolist (n-e '(nil t))
+ (dolist (non-essential '(nil t))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
- (let ((non-essential n-e)
- (tmp-name (tramp--test-make-temp-name nil quoted)))
+ (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(progn
@@ -4139,6 +4225,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let* ((tmp-name (tramp--test-make-temp-name nil quoted))
@@ -4217,6 +4304,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
@@ -4235,9 +4323,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- ;; We cannot use `string-equal', because tramp-adb.el
- ;; echoes also the sent string.
- (should (string-match "\\`foo" (buffer-string))))
+ (should (string-match "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4256,7 +4342,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-equal (buffer-string) "foo")))
+ (should (string-match "foo" (buffer-string))))
;; Cleanup.
(ignore-errors
@@ -4278,20 +4364,42 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- ;; We cannot use `string-equal', because tramp-adb.el
- ;; echoes also the sent string.
- (should (string-match "\\`foo" (buffer-string))))
+ (should (string-match "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc))))))
+(defmacro tramp--test--deftest-direct-async-process
+ (test docstring &optional unstable)
+ "Define ert test `TEST-direct-async' for direct async processes.
+If UNSTABLE is non-nil, the test is tagged as `:unstable'."
+ (declare (indent 1))
+ `(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) ()
+ ,docstring
+ :tags (if ,unstable '(:expensive-test :unstable) '(:expensive-test))
+ (skip-unless (tramp--test-enabled))
+ (let ((default-directory tramp-test-temporary-file-directory)
+ (ert-test (ert-get-test ',test))
+ (tramp-connection-properties
+ (cons '(nil "direct-async-process" t) tramp-connection-properties)))
+ (skip-unless (tramp-direct-async-process-p))
+ ;; We do expect an established connection already,
+ ;; `file-truename' does it by side-effect. Suppress
+ ;; `tramp--test-enabled', in order to keep the connection.
+ (cl-letf (((symbol-function #'tramp--test-enabled) (lambda nil t)))
+ (file-truename tramp-test-temporary-file-directory)
+ (funcall (ert-test-body ert-test))))))
+
+(tramp--test--deftest-direct-async-process tramp-test29-start-file-process
+ "Check direct async `start-file-process'.")
+
(ert-deftest tramp-test30-make-process ()
"Check `make-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
- ;; `make-process' has been inserted in Emacs 25.1. It supports file
- ;; name handlers since Emacs 27.
+ (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)))
@@ -4317,9 +4425,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- ;; We cannot use `string-equal', because tramp-adb.el
- ;; echoes also the sent string.
- (should (string-match "\\`foo" (buffer-string))))
+ (should (string-match "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4340,7 +4446,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-equal (buffer-string) "foo")))
+ (should (string-match "foo" (buffer-string))))
;; Cleanup.
(ignore-errors
@@ -4366,9 +4472,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (not (string-match "foo" (buffer-string)))
(while (accept-process-output proc 0 nil t))))
- ;; We cannot use `string-equal', because tramp-adb.el
- ;; echoes also the sent string.
- (should (string-match "\\`foo" (buffer-string))))
+ (should (string-match "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4392,75 +4496,74 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
- ;; We cannot use `string-equal', because tramp-adb.el
- ;; echoes also the sent string. And a remote macOS sends
- ;; a slightly modified string. On MS Windows,
- ;; `delete-process' sends an unknown signal.
- (should
- (string-match
- (if (eq system-type 'windows-nt)
- "unknown signal\n\\'" "killed.*\n\\'")
- (buffer-string))))
+ ;; On some MS Windows systems, it returns "unknown signal".
+ (should (string-match "unknown signal\\|killed" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
;; Process with stderr buffer.
- (let ((stderr (generate-new-buffer "*stderr*")))
- (unwind-protect
- (with-temp-buffer
- (setq proc
- (with-no-warnings
- (make-process
- :name "test5" :buffer (current-buffer)
- :command '("cat" "/does-not-exist")
- :stderr stderr
- :file-handler t)))
- (should (processp proc))
- ;; Read stderr.
- (with-timeout (10 (tramp--test-timeout-handler))
- (while (accept-process-output proc 0 nil t)))
- (delete-process proc)
- (with-current-buffer stderr
- (should
- (string-match
- "cat:.* No such file or directory" (buffer-string)))))
+ (unless (tramp-direct-async-process-p)
+ (let ((stderr (generate-new-buffer "*stderr*")))
+ (unwind-protect
+ (with-temp-buffer
+ (setq proc
+ (with-no-warnings
+ (make-process
+ :name "test5" :buffer (current-buffer)
+ :command '("cat" "/does-not-exist")
+ :stderr stderr
+ :file-handler t)))
+ (should (processp proc))
+ ;; Read stderr.
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (accept-process-output proc 0 nil t)))
+ (delete-process proc)
+ (with-current-buffer stderr
+ (should
+ (string-match
+ "cat:.* No such file or directory" (buffer-string)))))
- ;; Cleanup.
- (ignore-errors (delete-process proc))
- (ignore-errors (kill-buffer stderr))))
+ ;; Cleanup.
+ (ignore-errors (delete-process proc))
+ (ignore-errors (kill-buffer stderr)))))
;; Process with stderr file.
- (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 tmpfile
- :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)
+ (unless (tramp-direct-async-process-p)
+ (dolist (tmpfile `(,tmp-name1 ,tmp-name2))
+ (unwind-protect
(with-temp-buffer
- (insert-file-contents tmpfile)
- (should
- (string-match
- "cat:.* No such file or directory" (buffer-string)))))
+ (setq proc
+ (with-no-warnings
+ (make-process
+ :name "test6" :buffer (current-buffer)
+ :command '("cat" "/does-not-exist")
+ :stderr tmpfile
+ :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 tmpfile)
+ (should
+ (string-match
+ "cat:.* No such file or directory" (buffer-string)))))
- ;; Cleanup.
- (ignore-errors (delete-process proc))
- (ignore-errors (delete-file tmpfile)))))))
+ ;; Cleanup.
+ (ignore-errors (delete-process proc))
+ (ignore-errors (delete-file tmpfile))))))))
+
+(tramp--test--deftest-direct-async-process tramp-test30-make-process
+ "Check direct async `make-process'.")
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
+ (skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 26.1.
(skip-unless (boundp 'interrupt-process-functions))
@@ -4521,6 +4624,7 @@ INPUT, if non-nil, is a string sent to the process."
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
(tramp--test-sh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted))
@@ -4612,6 +4716,7 @@ INPUT, if non-nil, is a string sent to the process."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly.
(skip-unless (tramp--test-emacs27-p))
@@ -4824,6 +4929,7 @@ INPUT, if non-nil, is a string sent to the process."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
+ (skip-unless (not (tramp--test-crypt-p)))
(dolist (this-shell-command-to-string
'(;; Synchronously.
@@ -4836,67 +4942,71 @@ INPUT, if non-nil, is a string sent to the process."
(envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
kill-buffer-query-functions)
- (unwind-protect
- ;; Set a value.
- (let ((process-environment
- (cons (concat envvar "=foo") process-environment)))
- ;; Default value.
- (should
- (string-match
- "foo"
- (funcall
- this-shell-command-to-string
- (format "echo -n ${%s:-bla}" envvar))))))
-
- (unwind-protect
- ;; Set the empty value.
- (let ((process-environment
- (cons (concat envvar "=") process-environment)))
- ;; Value is null.
- (should
- (string-match
- "bla"
- (funcall
- this-shell-command-to-string
- (format "echo -n ${%s:-bla}" envvar))))
- ;; Variable is set.
- (should
- (string-match
- (regexp-quote envvar)
- (funcall this-shell-command-to-string "set")))))
+ ;; Check INSIDE_EMACS.
+ (setenv "INSIDE_EMACS")
+ (should
+ (string-equal
+ (format "%s,tramp:%s\n" emacs-version tramp-version)
+ (funcall this-shell-command-to-string "echo ${INSIDE_EMACS:-bla}")))
+ (let ((process-environment
+ (cons (format "INSIDE_EMACS=%s,foo" emacs-version)
+ process-environment)))
+ (should
+ (string-equal
+ (format "%s,foo,tramp:%s\n" emacs-version tramp-version)
+ (funcall
+ this-shell-command-to-string "echo ${INSIDE_EMACS:-bla}"))))
+
+ ;; Set a value.
+ (let ((process-environment
+ (cons (concat envvar "=foo") process-environment)))
+ ;; Default value.
+ (should
+ (string-match
+ "foo"
+ (funcall
+ this-shell-command-to-string (format "echo ${%s:-bla}" envvar)))))
+
+ ;; Set the empty value.
+ (let ((process-environment
+ (cons (concat envvar "=") process-environment)))
+ ;; Value is null.
+ (should
+ (string-match
+ "bla"
+ (funcall
+ this-shell-command-to-string (format "echo ${%s:-bla}" envvar))))
+ ;; Variable is set.
+ (should
+ (string-match
+ (regexp-quote envvar)
+ (funcall this-shell-command-to-string "set"))))
;; We force a reconnect, in order to have a clean environment.
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
- (unwind-protect
- ;; Unset the variable.
- (let ((tramp-remote-process-environment
- (cons (concat envvar "=foo")
- tramp-remote-process-environment)))
- ;; Set the initial value, we want to unset below.
- (should
- (string-match
- "foo"
- (funcall
- this-shell-command-to-string
- (format "echo -n ${%s:-bla}" envvar))))
- (let ((process-environment
- (cons envvar process-environment)))
- ;; Variable is unset.
- (should
- (string-match
- "bla"
- (funcall
- this-shell-command-to-string
- (format "echo -n ${%s:-bla}" envvar))))
- ;; Variable is unset.
- (should-not
- (string-match
- (regexp-quote envvar)
- ;; We must remove PS1, the output is truncated otherwise.
- (funcall
- this-shell-command-to-string "printenv | grep -v PS1")))))))))
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ ;; Unset the variable.
+ (let ((tramp-remote-process-environment
+ (cons (concat envvar "=foo") tramp-remote-process-environment)))
+ ;; Set the initial value, we want to unset below.
+ (should
+ (string-match
+ "foo"
+ (funcall
+ this-shell-command-to-string (format "echo ${%s:-bla}" envvar))))
+ (let ((process-environment (cons envvar process-environment)))
+ ;; Variable is unset.
+ (should
+ (string-match
+ "bla"
+ (funcall
+ this-shell-command-to-string (format "echo ${%s:-bla}" envvar))))
+ ;; Variable is unset.
+ (should-not
+ (string-match
+ (regexp-quote envvar)
+ ;; We must remove PS1, the output is truncated otherwise.
+ (funcall
+ this-shell-command-to-string "printenv | grep -v PS1"))))))))
;; This test is inspired by Bug#27009.
(ert-deftest tramp-test33-environment-variables-and-port-numbers ()
@@ -4905,6 +5015,7 @@ INPUT, if non-nil, is a string sent to the process."
;; We test it only for the mock-up connection; otherwise there might
;; be problems with the used ports.
(skip-unless (and (eq tramp-syntax 'default) (tramp--test-mock-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
;; We force a reconnect, in order to have a clean environment.
(dolist (dir `(,tramp-test-temporary-file-directory
@@ -4927,7 +5038,7 @@ INPUT, if non-nil, is a string sent to the process."
(should
(string-match
(number-to-string port)
- (shell-command-to-string (format "echo -n $%s" envvar))))))
+ (shell-command-to-string (format "echo $%s" envvar))))))
;; Cleanup.
(dolist (dir '("/mock:localhost#11111:" "/mock:localhost#22222:"))
@@ -5009,6 +5120,7 @@ INPUT, if non-nil, is a string sent to the process."
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
(tramp--test-sh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 26.1.
(skip-unless (and (fboundp 'connection-local-set-profile-variables)
(fboundp 'connection-local-set-profiles)))
@@ -5065,6 +5177,7 @@ INPUT, if non-nil, is a string sent to the process."
"Check `exec-path' and `executable-find'."
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 27.1.
(skip-unless (fboundp 'exec-path))
@@ -5108,6 +5221,7 @@ INPUT, if non-nil, is a string sent to the process."
"Check loooong `tramp-remote-path'."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
+ (skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 27.1.
(skip-unless (fboundp 'exec-path))
@@ -5115,23 +5229,20 @@ INPUT, if non-nil, is a string sent to the process."
(default-directory tramp-test-temporary-file-directory)
(orig-exec-path (with-no-warnings (exec-path)))
(tramp-remote-path tramp-remote-path)
- (orig-tramp-remote-path tramp-remote-path))
+ (orig-tramp-remote-path tramp-remote-path)
+ path)
(unwind-protect
(progn
;; Non existing directories are removed.
(setq tramp-remote-path
(cons (file-remote-p tmp-name 'localname) tramp-remote-path))
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should (equal (with-no-warnings (exec-path)) orig-exec-path))
(setq tramp-remote-path orig-tramp-remote-path)
;; Double entries are removed.
(setq tramp-remote-path (append '("/" "/") tramp-remote-path))
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should
(equal (with-no-warnings (exec-path)) (cons "/" orig-exec-path)))
(setq tramp-remote-path orig-tramp-remote-path)
@@ -5143,26 +5254,30 @@ INPUT, if non-nil, is a string sent to the process."
(let ((dir (make-temp-file (file-name-as-directory tmp-name) 'dir)))
(should (file-directory-p dir))
(setq tramp-remote-path
- (cons (file-remote-p dir 'localname) tramp-remote-path)
+ (append
+ tramp-remote-path `(,(file-remote-p dir 'localname)))
orig-exec-path
- (cons (file-remote-p dir 'localname) orig-exec-path))))
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ (append
+ (butlast orig-exec-path)
+ `(,(file-remote-p dir 'localname))
+ (last orig-exec-path)))))
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should (equal (with-no-warnings (exec-path)) orig-exec-path))
- (should
- (string-equal
- ;; Ignore trailing newline.
- (substring (shell-command-to-string "echo $PATH") nil -1)
+ ;; Ignore trailing newline.
+ (setq path (substring (shell-command-to-string "echo $PATH") nil -1))
+ ;; The shell doesn't handle such long strings.
+ (unless (<= (length path)
+ (tramp-get-connection-property
+ tramp-test-vec "pipe-buf" 4096))
;; The last element of `exec-path' is `exec-directory'.
- (mapconcat #'identity (butlast orig-exec-path) ":")))
+ (should
+ (string-equal
+ path (mapconcat #'identity (butlast orig-exec-path) ":"))))
;; The shell "sh" shall always exist.
(should (apply #'executable-find '("sh" remote))))
;; Cleanup.
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(setq tramp-remote-path orig-tramp-remote-path)
(ignore-errors (delete-directory tmp-name 'recursive)))))
@@ -5171,6 +5286,7 @@ INPUT, if non-nil, is a string sent to the process."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
+ (skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
;; We must use `file-truename' for the temporary directory, in
@@ -5199,8 +5315,7 @@ INPUT, if non-nil, is a string sent to the process."
tramp-remote-process-environment))
;; We must force a reconnect, in order to activate $BZR_HOME.
(tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ tramp-test-vec 'keep-debug 'keep-password)
'(Bzr))
(t nil))))
;; Suppress nasty messages.
@@ -5226,13 +5341,9 @@ INPUT, if non-nil, is a string sent to the process."
(error (ert-skip "`vc-create-repo' not supported")))
;; The structure of VC-FILESET is not documented. Let's
;; hope it won't change.
- (condition-case nil
- (vc-register
- (list (car vc-handled-backends)
- (list (file-name-nondirectory tmp-name2))))
- ;; `vc-register' has changed its arguments in Emacs
- ;; 25.1. Let's skip it for older Emacsen.
- (error (skip-unless (tramp--test-emacs25-p))))
+ (vc-register
+ (list (car vc-handled-backends)
+ (list (file-name-nondirectory tmp-name2))))
;; vc-git uses an own process sentinel, Tramp's sentinel
;; for flushing the cache isn't used.
(dired-uncache (concat (file-remote-p default-directory) "/"))
@@ -5489,12 +5600,6 @@ INPUT, if non-nil, is a string sent to the process."
(delete-directory tmp-file)
(should-not (file-exists-p tmp-file))))
-(defun tramp--test-emacs25-p ()
- "Check for Emacs version >= 25.1.
-Some semantics has been changed for there, w/o new functions or
-variables, so we check the Emacs version directly."
- (>= emacs-major-version 25))
-
(defun tramp--test-emacs26-p ()
"Check for Emacs version >= 26.1.
Some semantics has been changed for there, w/o new functions or
@@ -5530,6 +5635,10 @@ This does not support some special file names."
(string-equal
"docker" (file-remote-p tramp-test-temporary-file-directory 'method)))
+(defun tramp--test-crypt-p ()
+ "Check, whether the remote directory is crypted"
+ (tramp-crypt-file-name-p tramp-test-temporary-file-directory))
+
(defun tramp--test-ftp-p ()
"Check, whether an FTP-like method is used.
This does not support globbing characters in file names (yet)."
@@ -5585,19 +5694,18 @@ This does not support special file names."
(defun tramp--test-sh-p ()
"Check, whether the remote host runs a based method from tramp-sh.el."
- (eq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- 'tramp-sh-file-name-handler))
+ (tramp-sh-file-name-handler-p
+ (tramp-dissect-file-name 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))
-(defun tramp--test-windows-nt ()
+(defun tramp--test-windows-nt-p ()
"Check, whether the locale host runs MS Windows."
(eq system-type 'windows-nt))
-(defun tramp--test-windows-nt-and-batch ()
+(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))
@@ -5614,7 +5722,12 @@ This does not support utf8 based file transfer."
"Check, whether the locale or remote host runs MS Windows.
This requires restrictions of file name syntax."
(or (eq system-type 'windows-nt)
- (tramp-smb-file-name-p tramp-test-temporary-file-directory)))
+ (tramp--test-smb-p)))
+
+(defun tramp--test-smb-p ()
+ "Check, whether the locale or remote host runs MS Windows.
+This requires restrictions of file name syntax."
+ (tramp-smb-file-name-p tramp-test-temporary-file-directory))
(defun tramp--test-check-files (&rest files)
"Run a simple but comprehensive test over every file in FILES."
@@ -5738,8 +5851,7 @@ This requires restrictions of file name syntax."
;; It does not work in the "smb" case, only relative
;; symlinks to existing files are shown there.
(tramp--test-ignore-make-symbolic-link-error
- (unless
- (tramp-smb-file-name-p tramp-test-temporary-file-directory)
+ (unless (tramp--test-smb-p)
(make-symbolic-link file2 file3)
(should (file-symlink-p file3))
(should
@@ -5766,6 +5878,7 @@ This requires restrictions of file name syntax."
;; We do not run on macOS due to encoding problems. See
;; Bug#36940.
(when (and (tramp--test-expensive-test) (tramp--test-sh-p)
+ (not (tramp--test-crypt-p))
(not (eq system-type 'darwin)))
(dolist (elt files)
(let ((envvar (concat "VAR_" (upcase (md5 elt))))
@@ -5899,7 +6012,7 @@ Use the `ls' command."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-batch)))
+ (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(let ((tramp-connection-properties
@@ -5933,18 +6046,28 @@ Use the `ls' command."
"银河系漫游指南系列"
"Автостопом по гала́ктике"
;; Use codepoints without a name. See Bug#31272.
- "™›šbung")
+ "™›šbung"
+ ;; Use codepoints from Supplementary Multilingual Plane (U+10000
+ ;; to U+1FFFF).
+ "🌈🍒👋")
(when (tramp--test-expensive-test)
(delete-dups
(mapcar
- ;; Use all available language specific snippets. Filter out
- ;; strings which use unencodable characters.
+ ;; Use all available language specific snippets.
(lambda (x)
(and
(stringp (setq x (eval (get-language-info (car x) 'sample-text))))
- (not (unencodable-char-position
- 0 (length x) file-name-coding-system nil x))
+ ;; Filter out strings which use unencodable characters.
+ (not (and (or (tramp--test-gvfs-p) (tramp--test-smb-p))
+ (unencodable-char-position
+ 0 (length x) file-name-coding-system nil x)))
+ ;; Filter out not displayable characters.
+ (setq x (mapconcat
+ (lambda (y)
+ (and (char-displayable-p y) (char-to-string y)))
+ 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)))
@@ -5955,9 +6078,10 @@ Use the `ls' command."
(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)))
+ (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
(tramp--test-utf8))
@@ -5969,9 +6093,10 @@ 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)))
+ (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@@ -5990,9 +6115,10 @@ 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)))
+ (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@@ -6014,9 +6140,10 @@ 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)))
+ (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
(let ((tramp-connection-properties
(append
@@ -6098,6 +6225,7 @@ process sentinels. They shall not disturb each other."
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
(tramp--test-sh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
(with-timeout
(tramp--test-asynchronous-requests-timeout (tramp--test-timeout-handler))
@@ -6107,7 +6235,7 @@ process sentinels. They shall not disturb each other."
(shell-file-name (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
;; It doesn't work on w32 systems.
(watchdog
- (unless (tramp--test-windows-nt)
+ (unless (tramp--test-windows-nt-p)
(start-process-shell-command
"*watchdog*" nil
(format
@@ -6158,10 +6286,7 @@ process sentinels. They shall not disturb each other."
0 timer-repeat
(lambda ()
(tramp--test-with-proper-process-name-and-buffer
- (get-buffer-process
- (tramp-get-buffer
- (tramp-dissect-file-name
- tramp-test-temporary-file-directory)))
+ (get-buffer-process (tramp-get-buffer tramp-test-vec))
(when (> (- (time-to-seconds) (time-to-seconds timer-start))
tramp--test-asynchronous-requests-timeout)
(tramp--test-timeout-handler))
@@ -6429,12 +6554,14 @@ Since it unloads Tramp, it shall be the last test to run."
(and (or (and (boundp x) (null (local-variable-if-set-p x)))
(and (functionp x) (null (autoloadp (symbol-function x)))))
(string-match "^tramp" (symbol-name x))
+ ;; `tramp-completion-mode' is autoloaded in Emacs < 28.1.
+ (not (eq 'tramp-completion-mode x))
(not (string-match "^tramp\\(-archive\\)?--?test" (symbol-name x)))
(not (string-match "unload-hook$" (symbol-name x)))
(ert-fail (format "`%s' still bound" x)))))
;; The defstruct `tramp-file-name' and all its internal functions
- ;; shall be purged. `cl--find-class' must be protected in Emacs 24.
- (with-no-warnings (should-not (cl--find-class 'tramp-file-name)))
+ ;; shall be purged.
+ (should-not (cl--find-class 'tramp-file-name))
(mapatoms
(lambda (x)
(and (functionp x)
@@ -6466,6 +6593,8 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; * file-equal-p (partly done in `tramp-test21-file-links')
;; * file-in-directory-p
;; * file-name-case-insensitive-p
+;; * tramp-get-remote-gid
+;; * tramp-get-remote-uid
;; * tramp-set-file-uid-gid
;; * Work on skipped tests. Make a comment, when it is impossible.
@@ -6474,9 +6603,11 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file'
;; do not work properly for `nextcloud'.
-;; * Implement `tramp-test31-interrupt-process' for `adb'.
+;; * Implement `tramp-test31-interrupt-process' for `adb' and for
+;; direct async processes.
;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. A remote
;; file name operation cannot run in the timer. Remove `:unstable' tag?
(provide 'tramp-tests)
+
;;; tramp-tests.el ends here
diff --git a/test/lisp/net/webjump-tests.el b/test/lisp/net/webjump-tests.el
new file mode 100644
index 00000000000..47569c948f5
--- /dev/null
+++ b/test/lisp/net/webjump-tests.el
@@ -0,0 +1,73 @@
+;;; webjump-tests.el --- Tests for webjump.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'webjump)
+
+(ert-deftest webjump-tests-builtin ()
+ (should (equal (webjump-builtin '[name] "gnu.org") "gnu.org")))
+
+(ert-deftest webjump-tests-builtin-check-args ()
+ (should (webjump-builtin-check-args [1 2 3] "Foo" 2))
+ (should-error (webjump-builtin-check-args [1 2 3] "Foo" 3)))
+
+(ert-deftest webjump-tests-mirror-default ()
+ (should (equal (webjump-mirror-default
+ '("https://ftp.gnu.org/pub/gnu/"
+ "https://ftpmirror.gnu.org"))
+ "https://ftp.gnu.org/pub/gnu/")))
+
+(ert-deftest webjump-tests-null-or-blank-string-p ()
+ (should (webjump-null-or-blank-string-p nil))
+ (should (webjump-null-or-blank-string-p ""))
+ (should (webjump-null-or-blank-string-p " "))
+ (should-not (webjump-null-or-blank-string-p " . ")))
+
+(ert-deftest webjump-tests-url-encode ()
+ (should (equal (webjump-url-encode "") ""))
+ (should (equal (webjump-url-encode "a b c") "a+b+c"))
+ (should (equal (webjump-url-encode "foo?") "foo%3F"))
+ (should (equal (webjump-url-encode "/foo\\") "/foo%5C"))
+ (should (equal (webjump-url-encode "f&o") "f%26o")))
+
+(ert-deftest webjump-tests-url-fix ()
+ (should (equal (webjump-url-fix nil) ""))
+ (should (equal (webjump-url-fix "/tmp/") "file:///tmp/"))
+ (should (equal (webjump-url-fix "gnu.org") "http://gnu.org/"))
+ (should (equal (webjump-url-fix "ftp.x.org") "ftp://ftp.x.org/"))
+ (should (equal (webjump-url-fix "https://gnu.org")
+ "https://gnu.org/")))
+
+(ert-deftest webjump-tests-url-fix-trailing-slash ()
+ (should (equal (webjump-url-fix-trailing-slash "https://gnu.org")
+ "https://gnu.org/"))
+ (should (equal (webjump-url-fix-trailing-slash "https://gnu.org/")
+ "https://gnu.org/")))
+
+(provide 'webjump-tests)
+;;; webjump-tests.el ends here
diff --git a/test/lisp/nxml/nxml-mode-tests.el b/test/lisp/nxml/nxml-mode-tests.el
index 624e5c8866d..54d3bd8d132 100644
--- a/test/lisp/nxml/nxml-mode-tests.el
+++ b/test/lisp/nxml/nxml-mode-tests.el
@@ -132,5 +132,26 @@
<sub/>
</t>"))))
+(ert-deftest nxml-mode-test-comment-bug-17264 ()
+ "Test for Bug#17264."
+ (with-temp-buffer
+ (nxml-mode)
+ (let ((data "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+<spocosy version=\"1.0\" responsetime=\"2011-03-15 13:53:12\" exec=\"0.171\">
+ <!--
+ <query-response requestid=\"\" service=\"objectquery\">
+ <sport name=\"Soccer\" enetSportCode=\"s\" del=\"no\" n=\"1\" ut=\"2009-12-29
+ 15:36:24\" id=\"1\">
+ </sport>
+ </query-response>
+ -->
+</spocosy>
+"))
+ (insert data)
+ (goto-char (point-min))
+ (search-forward "<query-response")
+ ;; Inside comment
+ (should (eq (nth 4 (syntax-ppss)) t)))))
+
(provide 'nxml-mode-tests)
;;; nxml-mode-tests.el ends here
diff --git a/test/lisp/obsolete/cl-tests.el b/test/lisp/obsolete/cl-tests.el
index 37061df0a7a..3f3fda3638e 100644
--- a/test/lisp/obsolete/cl-tests.el
+++ b/test/lisp/obsolete/cl-tests.el
@@ -21,7 +21,8 @@
;;; Code:
-(require 'cl)
+(with-no-warnings
+ (require 'cl))
(require 'ert)
diff --git a/test/lisp/org/org-tests.el b/test/lisp/org/org-tests.el
index 918d79b8dcd..6e91dd28649 100644
--- a/test/lisp/org/org-tests.el
+++ b/test/lisp/org/org-tests.el
@@ -1,4 +1,4 @@
-;;; org-tests.el --- tests for org/org.el
+;;; org-tests.el --- tests for org/org.el -*- lexical-binding:t -*-
;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/password-cache-tests.el b/test/lisp/password-cache-tests.el
index 01f4358fc59..55ebbfce7fe 100644
--- a/test/lisp/password-cache-tests.el
+++ b/test/lisp/password-cache-tests.el
@@ -28,31 +28,31 @@
(ert-deftest password-cache-tests-add-and-remove ()
(let ((password-data (copy-hash-table password-data)))
- (password-cache-add "foo" "bar")
+ (password-cache-add "foo" (copy-sequence "bar"))
(should (eq (password-in-cache-p "foo") t))
(password-cache-remove "foo")
(should (not (password-in-cache-p "foo")))))
(ert-deftest password-cache-tests-read-from-cache ()
(let ((password-data (copy-hash-table password-data)))
- (password-cache-add "foo" "bar")
+ (password-cache-add "foo" (copy-sequence "bar"))
(should (equal (password-read-from-cache "foo") "bar"))
(should (not (password-read-from-cache nil)))))
(ert-deftest password-cache-tests-in-cache-p ()
(let ((password-data (copy-hash-table password-data)))
- (password-cache-add "foo" "bar")
+ (password-cache-add "foo" (copy-sequence "bar"))
(should (password-in-cache-p "foo"))
(should (not (password-read-from-cache nil)))))
(ert-deftest password-cache-tests-read ()
(let ((password-data (copy-hash-table password-data)))
- (password-cache-add "foo" "bar")
+ (password-cache-add "foo" (copy-sequence "bar"))
(should (equal (password-read nil "foo") "bar"))))
(ert-deftest password-cache-tests-reset ()
(let ((password-data (copy-hash-table password-data)))
- (password-cache-add "foo" "bar")
+ (password-cache-add "foo" (copy-sequence "bar"))
(password-reset)
(should (not (password-in-cache-p "foo")))))
@@ -60,14 +60,14 @@
:tags '(:expensive-test)
(let ((password-data (copy-hash-table password-data))
(password-cache-expiry 0.01))
- (password-cache-add "foo" "bar")
+ (password-cache-add "foo" (copy-sequence "bar"))
(sit-for 0.1)
(should (not (password-in-cache-p "foo")))))
(ert-deftest password-cache-tests-no-password-cache ()
(let ((password-data (copy-hash-table password-data))
(password-cache nil))
- (password-cache-add "foo" "bar")
+ (password-cache-add "foo" (copy-sequence "bar"))
(should (not (password-in-cache-p "foo")))
(should (not (password-read-from-cache "foo")))))
diff --git a/test/lisp/pcmpl-linux-resources/fs/ext4/.keep b/test/lisp/pcmpl-linux-resources/fs/ext4/.keep
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/test/lisp/pcmpl-linux-resources/fs/ext4/.keep
diff --git a/test/lisp/pcmpl-linux-resources/mtab b/test/lisp/pcmpl-linux-resources/mtab
new file mode 100644
index 00000000000..ea33abd7b0a
--- /dev/null
+++ b/test/lisp/pcmpl-linux-resources/mtab
@@ -0,0 +1,11 @@
+/dev/sdb1 / ext3 rw,relatime,errors=remount-ro 0 0
+proc /proc proc rw,noexec,nosuid,nodev 0 0
+/sys /sys sysfs rw,noexec,nosuid,nodev 0 0
+varrun /var/run tmpfs rw,noexec,nosuid,nodev,mode=0755 0 0
+varlock /var/lock tmpfs rw,noexec,nosuid,nodev,mode=1777 0 0
+udev /dev tmpfs rw,mode=0755 0 0
+devshm /dev/shm tmpfs rw 0 0
+devpts /dev/pts devpts rw,gid=5,mode=620 0 0
+lrm /lib/modules/2.6.24-16-generic/volatile tmpfs rw 0 0
+securityfs /sys/kernel/security securityfs rw 0 0
+gvfs-fuse-daemon /home/alice/.gvfs fuse.gvfs-fuse-daemon rw,nosuid,nodev,user=alice 0 0
diff --git a/test/lisp/pcmpl-linux-tests.el b/test/lisp/pcmpl-linux-tests.el
new file mode 100644
index 00000000000..cf7e6288fdb
--- /dev/null
+++ b/test/lisp/pcmpl-linux-tests.el
@@ -0,0 +1,51 @@
+;;; pcmpl-linux-tests.el --- Tests for pcmpl-linux.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'pcmpl-linux)
+
+(defvar pcmpl-linux-tests-data-dir
+ (file-truename
+ (expand-file-name "pcmpl-linux-resources/"
+ (file-name-directory (or load-file-name
+ buffer-file-name))))
+ "Base directory of pcmpl-linux-tests.el data files.")
+
+(ert-deftest pcmpl-linux-test-fs-types ()
+ (let ((pcmpl-linux-fs-modules-path-format (expand-file-name "fs"
+ pcmpl-linux-tests-data-dir)))
+ ;; FIXME: Shouldn't return "." and ".."
+ (should (equal (pcmpl-linux-fs-types)
+ '("." ".." "ext4")))))
+
+(ert-deftest pcmpl-linux-test-mounted-directories ()
+ (let ((pcmpl-linux-mtab-file (expand-file-name "mtab"
+ pcmpl-linux-tests-data-dir)))
+ (should (equal (pcmpl-linux-mounted-directories)
+ '("/" "/dev" "/dev/pts" "/dev/shm" "/home/alice/.gvfs"
+ "/lib/modules/2.6.24-16-generic/volatile" "/proc" "/sys"
+ "/sys/kernel/security" "/var/lock" "/var/run")))))
+
+(provide 'pcmpl-linux-tests)
+
+;;; pcmpl-linux-tests.el ends here
diff --git a/test/lisp/play/animate-tests.el b/test/lisp/play/animate-tests.el
new file mode 100644
index 00000000000..8af1517ffa4
--- /dev/null
+++ b/test/lisp/play/animate-tests.el
@@ -0,0 +1,56 @@
+;;; animate-tests.el --- Tests for animate.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'animate)
+
+(ert-deftest animate-test-birthday-present ()
+ (unwind-protect
+ (save-window-excursion
+ (cl-letf (((symbol-function 'sit-for) (lambda (_) nil)))
+ (animate-birthday-present "foo")
+ (should (equal (buffer-string)
+ "
+
+
+
+
+
+Happy Birthday,
+ Foo
+
+
+ You are my sunshine,
+ My only sunshine.
+ I'm awful sad that
+ You've moved away.
+
+ Let's talk together
+ And love more deeply.
+ Please bring back
+ my sunshine
+ to stay!"))))
+ (kill-buffer "*A-Present-for-Foo*")))
+
+(provide 'animate-tests)
+;;; animate-tests.el ends here
diff --git a/test/lisp/play/dissociate-tests.el b/test/lisp/play/dissociate-tests.el
new file mode 100644
index 00000000000..e8d903109fc
--- /dev/null
+++ b/test/lisp/play/dissociate-tests.el
@@ -0,0 +1,38 @@
+;;; dissociate-tests.el --- Tests for dissociate.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'dissociate)
+
+(ert-deftest dissociate-tests-dissociated-press ()
+ (cl-letf (((symbol-function 'y-or-n-p) (lambda (_) nil))
+ ((symbol-function 'random) (lambda (_) 10)))
+ (save-window-excursion
+ (with-temp-buffer
+ (insert "Lorem ipsum dolor sit amet")
+ (dissociated-press)
+ (should (string-match-p "dolor sit ametdolor sit amdolor sit amdolor sit am"
+ (buffer-string)))))))
+
+(provide 'dissociate-tests)
+;;; dissociate-tests.el ends here
diff --git a/test/lisp/play/life-tests.el b/test/lisp/play/life-tests.el
new file mode 100644
index 00000000000..38726bbc416
--- /dev/null
+++ b/test/lisp/play/life-tests.el
@@ -0,0 +1,80 @@
+;;; life-tests.el --- Tests for life.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 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/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'life)
+
+(ert-deftest test-life ()
+ (let ((life--max-width 5)
+ (life--max-height 3)
+ (life-patterns [(" @ "
+ " @"
+ "@@@")])
+ (generations '("
+
+ @
+ @
+ @@@
+" "
+
+
+ @ @
+ @@
+ @
+" "
+
+
+ @
+ @ @
+ @@
+" "
+
+
+ @
+ @@
+ @@
+" "
+
+
+ @
+ @
+ @@@
+"
+)))
+ (life-setup)
+ ;; Test initial state.
+ (goto-char (point-min))
+ (dolist (generation generations)
+ ;; Hack to test buffer contents without trailing whitespace,
+ ;; while also not modifying the "*Life*" buffer.
+ (let ((str (buffer-string))
+ (delete-trailing-lines t))
+ (with-temp-buffer
+ (insert str)
+ (delete-trailing-whitespace)
+ (should (equal (buffer-string) generation))))
+ (life--tick))))
+
+(provide 'life-tests)
+
+;;; life-tests.el ends here
diff --git a/test/lisp/progmodes/autoconf-tests.el b/test/lisp/progmodes/autoconf-tests.el
new file mode 100644
index 00000000000..63cf2889ee2
--- /dev/null
+++ b/test/lisp/progmodes/autoconf-tests.el
@@ -0,0 +1,55 @@
+;;; autoconf-tests.el --- Tests for autoconf.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'autoconf)
+(require 'ert)
+
+(ert-deftest autoconf-tests-current-defun-function-define ()
+ (with-temp-buffer
+ (insert "AC_DEFINE(HAVE_RSVG, 1, [Define to 1 if using librsvg.])")
+ (goto-char (point-min))
+ (should-not (autoconf-current-defun-function))
+ (forward-char 10)
+ (should (equal (autoconf-current-defun-function) "HAVE_RSVG"))))
+
+(ert-deftest autoconf-tests-current-defun-function-subst ()
+ (with-temp-buffer
+ (insert "AC_SUBST(srcdir)")
+ (goto-char (point-min))
+ (should-not (autoconf-current-defun-function))
+ (forward-char 9)
+ (should (equal (autoconf-current-defun-function) "srcdir"))))
+
+(ert-deftest autoconf-tests-autoconf-mode-comment-syntax ()
+ (with-temp-buffer
+ (autoconf-mode)
+ (insert "dnl Autoconf script for GNU Emacs")
+ (should (nth 4 (syntax-ppss)))))
+
+(provide 'autoconf-tests)
+;;; autoconf-tests.el ends here
diff --git a/test/lisp/progmodes/cc-mode-tests.el b/test/lisp/progmodes/cc-mode-tests.el
index 0729841ce6f..64d52a952b6 100644
--- a/test/lisp/progmodes/cc-mode-tests.el
+++ b/test/lisp/progmodes/cc-mode-tests.el
@@ -40,7 +40,7 @@
(insert content)
(setq mode nil)
(c-or-c++-mode)
- (unless(eq expected mode)
+ (unless (eq expected mode)
(ert-fail
(format "expected %s but got %s when testing '%s'"
expected mode content)))))
@@ -53,11 +53,18 @@
(funcall do-test (concat " * " content) 'c-mode))
'("using \t namespace \t std;"
"using \t std::string;"
+ "using Foo = Bar;"
"namespace \t {"
"namespace \t foo \t {"
- "class \t Blah_42 \t {"
+ "namespace \t foo::bar \t {"
+ "inline namespace \t foo \t {"
+ "inline namespace \t foo::bar \t {"
"class \t Blah_42 \t \n"
+ "class \t Blah_42;"
+ "class \t Blah_42 \t final {"
+ "struct \t Blah_42 \t final {"
"class \t _42_Blah:public Foo {"
+ "struct \t _42_Blah:public Foo {"
"template \t < class T >"
"template< class T >"
"#include <string>"
@@ -67,6 +74,7 @@
(mapc (lambda (content) (funcall do-test content 'c-mode))
'("struct \t Blah_42 \t {"
"struct template {"
+ "struct Blah;"
"#include <string.h>")))))
(ert-deftest c-mode-macro-comment ()
@@ -78,4 +86,25 @@
(insert macro-string)
(c-mode))))
+(ert-deftest c-lineup-ternary-bodies ()
+ "Test for c-lineup-ternary-bodies function"
+ (with-temp-buffer
+ (c-mode)
+ (let* ((common-prefix "int value = condition ")
+ (expected-column (length common-prefix)))
+ (dolist (test '(("? a : \n b" . nil)
+ ("? a \n ::b" . nil)
+ ("a \n : b" . nil)
+ ("? a \n : b" . t)
+ ("? ::a \n : b" . t)
+ ("? (p ? q : r) \n : b" . t)
+ ("? p ?: q \n : b" . t)
+ ("? p ? : q \n : b" . t)
+ ("? p ? q : r \n : b" . t)))
+ (delete-region (point-min) (point-max))
+ (insert common-prefix (car test))
+ (should (equal
+ (and (cdr test) (vector expected-column))
+ (c-lineup-ternary-bodies '(statement-cont . 1))))))))
+
;;; cc-mode-tests.el ends here
diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el
index 75962566f14..45eebac0367 100644
--- a/test/lisp/progmodes/compile-tests.el
+++ b/test/lisp/progmodes/compile-tests.el
@@ -176,6 +176,9 @@
13 nil 217 "../src/Lib/System.cpp")
("==1332== by 0x8008621: main (vtest.c:180)"
13 nil 180 "vtest.c")
+ ;; javac
+ ("/src/Test.java:5: ';' expected\n foo foo\n ^\n" 1 15 5 "/src/Test.java" 2)
+ ("e:\\src\\Test.java:7: warning: ';' expected\n foo foo\n ^\n" 1 10 7 "e:\\src\\Test.java" 1)
;; jikes-file jikes-line
("Found 2 semantic errors compiling \"../javax/swing/BorderFactory.java\":"
1 nil nil "../javax/swing/BorderFactory.java")
@@ -264,6 +267,8 @@
3 nil 29 "test_main.cpp")
("1>test_main.cpp(29): error C4430: missing type specifier - int assumed. Note: C++ does not support default-int"
3 nil 29 "test_main.cpp")
+ ("C:\\tmp\\test.cpp(101,11): error C4101: 'bias0123': unreferenced local variable [C:\\tmp\\project.vcxproj]"
+ 1 11 101 "C:\\tmp\\test.cpp")
;; watcom
("..\\src\\ctrl\\lister.c(109): Error! E1009: Expecting ';' but found '{'"
1 nil 109 "..\\src\\ctrl\\lister.c")
@@ -319,6 +324,9 @@
1 8 71 "/home/reto/test/group.xml")
("Warning: Start tag for undeclared element geroup\nin unnamed entity at line 4 char 8 of file:///home/reto/test/group.xml"
1 8 4 "/home/reto/test/group.xml")
+ ;; shellcheck
+ ("In autogen.sh line 48:"
+ 1 nil 48 "autogen.sh")
;; sparc-pascal-file sparc-pascal-line sparc-pascal-example
("Thu May 14 10:46:12 1992 mom3.p:"
1 nil nil "mom3.p")
@@ -431,9 +439,9 @@ The test data is in `compile-tests--test-regexps-data'."
(compilation-num-warnings-found 0)
(compilation-num-infos-found 0))
(mapc #'compile--test-error-line compile-tests--test-regexps-data)
- (should (eq compilation-num-errors-found 93))
- (should (eq compilation-num-warnings-found 36))
- (should (eq compilation-num-infos-found 26)))))
+ (should (eq compilation-num-errors-found 96))
+ (should (eq compilation-num-warnings-found 35))
+ (should (eq compilation-num-infos-found 28)))))
(ert-deftest compile-test-grep-regexps ()
"Test the `grep-regexp-alist' regexps.
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl
new file mode 100644
index 00000000000..4a9842ffa56
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl
@@ -0,0 +1,52 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use 5.020;
+
+# This file contains test input and expected output for the tests in
+# cperl-mode-tests.el, cperl-mode-test-indent-exp. The code is
+# syntactically valid, but doesn't make much sense.
+
+# -------- for loop: input --------
+for my $foo (@ARGV)
+{
+...;
+}
+# -------- for loop: expected output --------
+for my $foo (@ARGV) {
+ ...;
+}
+# -------- for loop: end --------
+
+# -------- while loop: input --------
+{
+while (1)
+{
+say "boring loop";
+}
+continue
+{
+last; # no endless loop, though
+}
+}
+# -------- while loop: expected output --------
+{
+ while (1) {
+ say "boring loop";
+ } continue {
+ last; # no endless loop, though
+ }
+}
+# -------- while loop: end --------
+
+# -------- if-then-else: input --------
+if (my $foo) { bar() } elsif (quux()) { baz() } else { quuux }
+# -------- if-then-else: expected output --------
+if (my $foo) {
+ bar();
+} elsif (quux()) {
+ baz();
+} else {
+ quuux;
+}
+# -------- if-then-else: end --------
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl
new file mode 100644
index 00000000000..0832f868288
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use 5.020;
+
+# This file contains test input and expected output for the tests in
+# cperl-mode-tests.el, cperl-mode-test-indent-exp. The code is
+# syntactically valid, but doesn't make much sense.
+
+# -------- PBP indent: input --------
+for my $foo (@ARGV)
+{
+...;
+}
+# -------- PBP indent: expected output --------
+for my $foo (@ARGV) {
+ ...;
+}
+# -------- PBP indent: end --------
+
+# -------- PBP uncuddle else: input --------
+{
+if (1 < 2)
+{
+say "Seems ok";
+} elsif (1 == 2) {
+say "Strange things are happening";
+} else {
+die "This world is backwards";
+}
+}
+# -------- PBP uncuddle else: expected output --------
+{
+ if (1 < 2) {
+ say "Seems ok";
+ }
+ elsif (1 == 2) {
+ say "Strange things are happening";
+ }
+ else {
+ die "This world is backwards";
+ }
+}
+# -------- PBP uncuddle else: end --------
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
new file mode 100644
index 00000000000..f0ff8e90052
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -0,0 +1,206 @@
+;;; cperl-mode-tests --- Test for cperl-mode -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Harald Jörg <haj@posteo.de>
+;; Maintainer: Harald Jörg
+;; Keywords: internal
+;; Homepage: https://github.com/HaraldJoerg/cperl-mode
+
+;; 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 is a collection of tests for CPerl-mode.
+
+;;; Code:
+
+(defvar cperl-test-mode #'cperl-mode)
+
+(require 'cperl-mode)
+(require 'ert)
+
+(defvar cperl-mode-tests-data-directory
+ (expand-file-name "lisp/progmodes/cperl-mode-resources"
+ (or (getenv "EMACS_TEST_DIRECTORY")
+ (expand-file-name "../../../"
+ (or load-file-name
+ buffer-file-name))))
+ "Directory containing cperl-mode test data.")
+
+(defun cperl-test-ppss (text regexp)
+ "Return the `syntax-ppss' of the first character matched by REGEXP in TEXT."
+ (interactive)
+ (with-temp-buffer
+ (insert text)
+ (funcall cperl-test-mode)
+ (goto-char (point-min))
+ (re-search-forward regexp)
+ (syntax-ppss)))
+
+(ert-deftest cperl-mode-test-bug-42168 ()
+ "Verify that '/' is a division after ++ or --, not a regexp.
+Reported in https://github.com/jrockway/cperl-mode/issues/45.
+If seen as regular expression, then the slash is displayed using
+font-lock-constant-face. If seen as a division, then it doesn't
+have a face property."
+ :tags '(:fontification)
+ ;; The next two Perl expressions have divisions. Perl "punctuation"
+ ;; operators don't get a face.
+ (let ((code "{ $a++ / $b }"))
+ (should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
+ (let ((code "{ $a-- / $b }"))
+ (should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
+ ;; The next two Perl expressions have regular expressions. The
+ ;; delimiter of a RE is fontified with font-lock-constant-face.
+ (let ((code "{ $a+ / $b } # /"))
+ (should (equal (nth 8 (cperl-test-ppss code "/")) 7)))
+ (let ((code "{ $a- / $b } # /"))
+ (should (equal (nth 8 (cperl-test-ppss code "/")) 7))))
+
+(ert-deftest cperl-mode-test-bug-16368 ()
+ "Verify that `cperl-forward-group-in-re' doesn't hide errors."
+ (skip-unless (eq cperl-test-mode #'cperl-mode))
+ (let ((code "/(\\d{4})(?{2}/;") ; the regex from the bug report
+ (result))
+ (with-temp-buffer
+ (insert code)
+ (goto-char 9)
+ (setq result (cperl-forward-group-in-re))
+ (should (equal (car result) 'scan-error))
+ (should (equal (nth 1 result) "Unbalanced parentheses"))
+ (should (= (point) 9)))) ; point remains unchanged on error
+ (let ((code "/(\\d{4})(?{2})/;") ; here all parens are balanced
+ (result))
+ (with-temp-buffer
+ (insert code)
+ (goto-char 9)
+ (setq result (cperl-forward-group-in-re))
+ (should (equal result nil))
+ (should (= (point) 15))))) ; point has skipped the group
+
+(defun cperl-mode-test--run-bug-10483 ()
+ "Runs a short program, intended to be under timer scrutiny.
+This function is intended to be used by an Emacs subprocess in
+batch mode. The message buffer is used to report the result of
+running `cperl-indent-exp' for a very simple input. The result
+is expected to be different from the input, to verify that
+indentation actually takes place.."
+ (let ((code "poop ('foo', \n'bar')")) ; see the bug report
+ (message "Test Bug#10483 started")
+ (with-temp-buffer
+ (insert code)
+ (funcall cperl-test-mode)
+ (goto-char (point-min))
+ (search-forward "poop")
+ (cperl-indent-exp)
+ (message "%s" (buffer-string)))))
+
+(ert-deftest cperl-mode-test-bug-10483 ()
+ "Check that indenting certain perl code does not loop forever.
+This verifies that indenting a piece of code that ends in a paren
+without a statement terminator on the same line does not loop
+forever. The test starts an asynchronous Emacs batch process
+under timeout control."
+ (interactive)
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out
+ (let* ((emacs (concat invocation-directory invocation-name))
+ (test-function 'cperl-mode-test--run-bug-10483)
+ (test-function-name (symbol-name test-function))
+ (test-file (symbol-file test-function 'defun))
+ (ran-out-of-time nil)
+ (process-connection-type nil)
+ runner)
+ (with-temp-buffer
+ (with-timeout (1
+ (delete-process runner)
+ (setq ran-out-of-time t))
+ (setq runner (start-process "speedy"
+ (current-buffer)
+ emacs
+ "-batch"
+ "--quick"
+ "--load" test-file
+ "--funcall" test-function-name))
+ (while (accept-process-output runner)))
+ (should (equal ran-out-of-time nil))
+ (goto-char (point-min))
+ ;; just a very simple test for indentation: This should
+ ;; be rather robust with regard to indentation defaults
+ (should (string-match
+ "poop ('foo', \n 'bar')" (buffer-string))))))
+
+(ert-deftest cperl-mode-test-indent-exp ()
+ "Run various tests for `cperl-indent-exp' edge cases.
+These exercise some standard blocks and also the special
+treatment for Perl expressions where a closing paren isn't the
+end of the statement."
+ (let ((file (expand-file-name "cperl-indent-exp.pl"
+ cperl-mode-tests-data-directory)))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n"
+ "\\(?2:\\(?:.*\n\\)+?\\)"
+ "# ?-+ \\1: expected output ?-+\n"
+ "\\(?3:\\(?:.*\n\\)+?\\)"
+ "# ?-+ \\1: end ?-+")
+ nil t)
+ (let ((name (match-string 1))
+ (code (match-string 2))
+ (expected (match-string 3))
+ got)
+ (with-temp-buffer
+ (insert code)
+ (goto-char (point-min))
+ (cperl-indent-exp) ; here we go!
+ (setq expected (concat "test case " name ":\n" expected))
+ (setq got (concat "test case " name ":\n" (buffer-string)))
+ (should (equal got expected))))))))
+
+(ert-deftest cperl-mode-test-indent-styles ()
+ "Verify correct indentation by style \"PBP\".
+Perl Best Practices sets some indentation values different from
+ the defaults, and also wants an \"else\" or \"elsif\" keyword
+ to align with the \"if\"."
+ (let ((file (expand-file-name "cperl-indent-styles.pl"
+ cperl-mode-tests-data-directory)))
+ (with-temp-buffer
+ (cperl-set-style "PBP")
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n"
+ "\\(?2:\\(?:.*\n\\)+?\\)"
+ "# ?-+ \\1: expected output ?-+\n"
+ "\\(?3:\\(?:.*\n\\)+?\\)"
+ "# ?-+ \\1: end ?-+")
+ nil t)
+ (let ((name (match-string 1))
+ (code (match-string 2))
+ (expected (match-string 3))
+ got)
+ (with-temp-buffer
+ (insert code)
+ (cperl-mode)
+ (indent-region (point-min) (point-max)) ; here we go!
+ (setq expected (concat "test case " name ":\n" expected))
+ (setq got (concat "test case " name ":\n" (buffer-string)))
+ (should (equal got expected)))))
+ (cperl-set-style "CPerl"))))
+
+;;; 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 2ba00656862..6c30e4f664b 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -194,7 +194,7 @@
(dotimes (i 3)
(should
(equal (elisp-mode-tests--face-propertized-string
- (elisp--highlight-function-argument 'foo "(A B C)" (1+ i) "foo: "))
+ (elisp--highlight-function-argument 'foo "(A B C)" (1+ i)))
(propertize (nth i '("A" "B" "C"))
'face 'eldoc-highlight-function-argument)))))
@@ -206,7 +206,7 @@
(cl-flet ((bold-arg (i)
(elisp-mode-tests--face-propertized-string
(elisp--highlight-function-argument
- 'foo "(PROMPT LST &key A B C)" i "foo: "))))
+ 'foo "(PROMPT LST &key A B C)" i))))
(should-not (bold-arg 0))
(progn (forward-sexp) (forward-char))
(should (equal (bold-arg 1) "PROMPT"))
@@ -226,7 +226,7 @@
(cl-flet ((bold-arg (i)
(elisp-mode-tests--face-propertized-string
(elisp--highlight-function-argument
- 'foo "(X &key A B C)" i "foo: "))))
+ 'foo "(X &key A B C)" i))))
(should-not (bold-arg 0))
;; The `:b' specifies positional arg `X'.
(progn (forward-sexp) (forward-char))
@@ -810,5 +810,17 @@ to (xref-elisp-test-descr-to-target xref)."
(insert "?\\N{HEAVY CHECK MARK}")
(should (equal (elisp--preceding-sexp) ?\N{HEAVY CHECK MARK}))))
+(ert-deftest elisp-indent-basic ()
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (let ((orig "(defun x ()
+ (print (quote ( thingy great
+ stuff)))
+ (print (quote (thingy great
+ stuff))))"))
+ (insert orig)
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) orig)))))
+
(provide 'elisp-mode-tests)
;;; elisp-mode-tests.el ends here
diff --git a/test/lisp/progmodes/etags-tests.el b/test/lisp/progmodes/etags-tests.el
index f7a5ac4870c..79368cd193f 100644
--- a/test/lisp/progmodes/etags-tests.el
+++ b/test/lisp/progmodes/etags-tests.el
@@ -1,4 +1,4 @@
-;;; etags-tests.el --- Test suite for etags.el.
+;;; etags-tests.el --- Test suite for etags.el. -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/progmodes/f90-tests.el b/test/lisp/progmodes/f90-tests.el
index b6fbac351dc..b8a3f7e8401 100644
--- a/test/lisp/progmodes/f90-tests.el
+++ b/test/lisp/progmodes/f90-tests.el
@@ -1,8 +1,9 @@
-;;; f90-tests.el --- tests for progmodes/f90.el
+;;; f90-tests.el --- tests for progmodes/f90.el -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
;; Author: Glenn Morris <rgm@gnu.org>
+;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
diff --git a/test/lisp/progmodes/glasses-tests.el b/test/lisp/progmodes/glasses-tests.el
new file mode 100644
index 00000000000..277a9cc1927
--- /dev/null
+++ b/test/lisp/progmodes/glasses-tests.el
@@ -0,0 +1,101 @@
+;;; glasses-tests.el --- Tests for glasses.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'glasses)
+(require 'seq)
+
+(ert-deftest glasses-tests-parenthesis-exception-p ()
+ (with-temp-buffer
+ (insert "public OnClickListener menuListener() {}")
+ (let ((glasses-separate-parentheses-exceptions '("^Listen")))
+ (should-not (glasses-parenthesis-exception-p 1 (point-max)))
+ (should (glasses-parenthesis-exception-p 15 (point-max)))
+ (should-not (glasses-parenthesis-exception-p 24 (point-max)))
+ (should (glasses-parenthesis-exception-p 28 (point-max))))))
+
+(ert-deftest glasses-tests-overlay-p ()
+ (should
+ (glasses-overlay-p (glasses-make-overlay (point-min) (point-max))))
+ (should-not
+ (glasses-overlay-p (make-overlay (point-min) (point-max)))))
+
+(ert-deftest glasses-tests-make-overlay-p ()
+ (let ((o (glasses-make-overlay (point-min) (point-max))))
+ (should (eq (overlay-get o 'category) 'glasses)))
+ (let ((o (glasses-make-overlay (point-min) (point-max) 'foo)))
+ (should (eq (overlay-get o 'category) 'foo))))
+
+(ert-deftest glasses-tests-make-readable ()
+ (with-temp-buffer
+ (insert "pp.setBackgroundResource(R.drawable.button_right);")
+ (glasses-make-readable (point-min) (point-max))
+ (pcase-let ((`(,o1 ,o2 ,o3)
+ (sort (overlays-in (point-min) (point-max))
+ (lambda (o1 o2)
+ (< (overlay-start o1) (overlay-start o2))))))
+ (should (= (overlay-start o1) 7))
+ (should (equal (overlay-get o1 'before-string)
+ glasses-separator))
+ (should (= (overlay-start o2) 17))
+ (should (equal (overlay-get o2 'before-string)
+ glasses-separator))
+ (should (= (overlay-start o3) 25))
+ (should (equal (overlay-get o3 'before-string) " ")))))
+
+(ert-deftest glasses-tests-make-readable-dont-separate-parentheses ()
+ (with-temp-buffer
+ (insert "pp.setBackgroundResource(R.drawable.button_right);")
+ (let ((glasses-separate-parentheses-p nil))
+ (glasses-make-readable (point-min) (point-max))
+ (should-not (overlays-at 25)))))
+
+(ert-deftest glasses-tests-make-unreadable ()
+ (with-temp-buffer
+ (insert "pp.setBackgroundResource(R.drawable.button_right);")
+ (glasses-make-readable (point-min) (point-max))
+ (should (seq-some #'glasses-overlay-p
+ (overlays-in (point-min) (point-max))))
+ (glasses-make-unreadable (point-min) (point-max))
+ (should-not (seq-some #'glasses-overlay-p
+ (overlays-in (point-min) (point-max))))))
+
+(ert-deftest glasses-tests-convert-to-unreadable ()
+ (with-temp-buffer
+ (insert "set_Background_Resource(R.button_right);")
+ (let ((glasses-convert-on-write-p nil))
+ (should-not (glasses-convert-to-unreadable))
+ (should (equal (buffer-string)
+ "set_Background_Resource(R.button_right);")))
+ (let ((glasses-convert-on-write-p t))
+ (should-not (glasses-convert-to-unreadable))
+ (should (equal (buffer-string)
+ "setBackgroundResource(R.button_right);")))))
+
+(provide 'glasses-tests)
+;;; glasses-tests.el ends here
diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el
index 0d53c0681bf..681e51de0ed 100644
--- a/test/lisp/progmodes/js-tests.el
+++ b/test/lisp/progmodes/js-tests.el
@@ -1,4 +1,4 @@
-;;; js-tests.el --- Test suite for js-mode
+;;; js-tests.el --- Test suite for js-mode -*- lexical-binding:t -*-
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/progmodes/opascal-tests.el b/test/lisp/progmodes/opascal-tests.el
new file mode 100644
index 00000000000..70a4ebfa70d
--- /dev/null
+++ b/test/lisp/progmodes/opascal-tests.el
@@ -0,0 +1,45 @@
+;;; opascal-tests.el --- tests for opascal.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+(require 'ert)
+(require 'opascal)
+
+(ert-deftest opascal-indent-bug-36348 ()
+ (with-temp-buffer
+ (opascal-mode)
+ (let ((orig "{ -*- opascal -*- }
+
+procedure Toto ();
+begin
+ for i := 0 to 1 do
+ Write (str.Chars[i]);
+
+ // bug#36348
+ for var i := 0 to 1 do
+ Write (str.Chars[i]);
+
+end;
+"))
+ (insert orig)
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) orig)))))
+
+(provide 'opascal-tests)
+
+;;; opascal-tests.el ends here
diff --git a/test/lisp/progmodes/pascal-tests.el b/test/lisp/progmodes/pascal-tests.el
new file mode 100644
index 00000000000..ed4c6fb03e0
--- /dev/null
+++ b/test/lisp/progmodes/pascal-tests.el
@@ -0,0 +1,63 @@
+;;; pascal-tests.el --- tests for pascal.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+(require 'ert)
+(require 'pascal)
+
+(ert-deftest pascal-completion ()
+ ;; Bug#41740: completion functions must preserve point.
+ (let ((pascal-completion-cache nil))
+ (with-temp-buffer
+ (pascal-mode)
+ (insert "program test; var")
+ (let* ((point-before (point))
+ (completions (pascal-completion "var" nil 'metadata))
+ (point-after (point)))
+ (should (equal completions nil))
+ (should (equal point-before point-after)))))
+
+ (let ((pascal-completion-cache nil))
+ (with-temp-buffer
+ (pascal-mode)
+ (insert "program test; function f(x : i")
+ (let* ((point-before (point))
+ (completions (pascal-completion "i" nil 'metadata))
+ (point-after (point)))
+ (should (equal completions nil))
+ (should (equal point-before point-after)))))
+
+ (let ((pascal-completion-cache nil))
+ (with-temp-buffer
+ (pascal-mode)
+ (insert "program test; function f(x : integer) : real")
+ (let* ((point-before (point))
+ (completions (pascal-completion "real" nil 'metadata))
+ (point-after (point)))
+ (should (equal completions nil))
+ (should (equal point-before point-after))))))
+
+(ert-deftest pascal-beg-of-defun ()
+ (with-temp-buffer
+ (pascal-mode)
+ (insert "program test; procedure p(")
+ (forward-char -1)
+ (pascal-beg-of-defun)
+ (should (equal (point) 15))))
+
+(provide 'pascal-tests)
diff --git a/test/lisp/progmodes/ps-mode-tests.el b/test/lisp/progmodes/ps-mode-tests.el
index a47abebe6e4..61cf4c62511 100644
--- a/test/lisp/progmodes/ps-mode-tests.el
+++ b/test/lisp/progmodes/ps-mode-tests.el
@@ -1,4 +1,4 @@
-;;; ps-mode-tests.el --- Test suite for ps-mode
+;;; ps-mode-tests.el --- Test suite for ps-mode -*- lexical-binding:t -*-
;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
@@ -43,6 +43,30 @@
(should (equal (buffer-string)
"foo\\220\\221\\222bar"))))
+(ert-deftest ps-mode-test-indent ()
+ ;; Converted from manual test.
+ (with-temp-buffer
+ (ps-mode)
+ ;; TODO: Should some of these be fontification tests as well?
+ (let ((orig "%!PS-2.0
+
+<< 23 45 >> %dictionary
+< 23 > %hex string
+<~a>a%a~> %base85 string
+(%)s
+(sf\\(g>a)sdg)
+
+/foo {
+ <<
+ hello 2
+ 3
+ >>
+} def
+"))
+ (insert orig)
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) orig)))))
+
(provide 'ps-mode-tests)
;;; ps-mode-tests.el ends here
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el
index f57150c397e..6b3e63653be 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -1,4 +1,4 @@
-;;; python-tests.el --- Test suite for python.el
+;;; python-tests.el --- Test suite for python.el -*- lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
@@ -118,7 +118,6 @@ Argument MIN and MAX delimit the region to be returned and
default to `point-min' and `point-max' respectively."
(let* ((min (or min (point-min)))
(max (or max (point-max)))
- (buffer (current-buffer))
(buffer-contents (buffer-substring-no-properties min max))
(overlays
(sort (overlays-in min max)
@@ -154,7 +153,7 @@ The name of this directory depends on `system-type'."
sed do eiusmod tempor incididunt ut labore et dolore magna
aliqua."
(let ((expected (save-excursion
- (dotimes (i 3)
+ (dotimes (_ 3)
(re-search-forward "et" nil t))
(forward-char -2)
(point))))
@@ -163,7 +162,7 @@ aliqua."
;; one should be returned.
(should (= (python-tests-look-at "et" 6 t) expected))
;; If already looking at STRING, it should skip it.
- (dotimes (i 2) (re-search-forward "et"))
+ (dotimes (_ 2) (re-search-forward "et"))
(forward-char -2)
(should (= (python-tests-look-at "et") expected)))))
@@ -178,7 +177,7 @@ aliqua."
(re-search-forward "et" nil t)
(forward-char -2)
(point))))
- (dotimes (i 3)
+ (dotimes (_ 3)
(re-search-forward "et" nil t))
(should (= (python-tests-look-at "et" -3 t) expected))
(should (= (python-tests-look-at "et" -6 t) expected)))))
@@ -2642,7 +2641,7 @@ if x:
(ert-deftest python-shell-calculate-process-environment-2 ()
"Test `python-shell-extra-pythonpaths' modification."
(let* ((process-environment process-environment)
- (original-pythonpath (setenv "PYTHONPATH" "/path0"))
+ (_original-pythonpath (setenv "PYTHONPATH" "/path0"))
(python-shell-extra-pythonpaths '("/path1" "/path2"))
(process-environment (python-shell-calculate-process-environment)))
(should (equal (getenv "PYTHONPATH")
diff --git a/test/manual/indent/ruby.rb b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
index b038512b114..6b7d10dea38 100644
--- a/test/manual/indent/ruby.rb
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
@@ -34,7 +34,7 @@ x = # "tot %q/to"; =
# Regexp after whitelisted method.
"abc".sub /b/, 'd'
-# Don't mis-match "sub" at the end of words.
+# Don't mismatch "sub" at the end of words.
a = asub / aslb + bsub / bslb;
# Highlight the regexp after "if".
diff --git a/test/lisp/progmodes/ruby-mode-tests.el b/test/lisp/progmodes/ruby-mode-tests.el
index 6bdc7651ff1..5988a495238 100644
--- a/test/lisp/progmodes/ruby-mode-tests.el
+++ b/test/lisp/progmodes/ruby-mode-tests.el
@@ -1,4 +1,4 @@
-;;; ruby-mode-tests.el --- Test suite for ruby-mode
+;;; ruby-mode-tests.el --- Test suite for ruby-mode -*- lexical-binding:t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
@@ -24,6 +24,12 @@
(require 'ert)
(require 'ruby-mode)
+(defvar ruby-mode-tests-data-dir
+ (file-truename
+ (expand-file-name "ruby-mode-resources/"
+ (file-name-directory (or load-file-name
+ buffer-file-name)))))
+
(defmacro ruby-with-temp-buffer (contents &rest body)
(declare (indent 1) (debug t))
`(with-temp-buffer
@@ -842,6 +848,17 @@ 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--indent/converted-from-manual-test ()
+ :tags '(:expensive-test)
+ ;; Converted from manual test.
+ (let ((buf (find-file-noselect (expand-file-name "ruby.rb"
+ ruby-mode-tests-data-dir))))
+ (unwind-protect
+ (with-current-buffer buf
+ (let ((orig (buffer-string)))
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) orig))))
+ (kill-buffer buf))))
(provide 'ruby-mode-tests)
diff --git a/test/lisp/progmodes/scheme-tests.el b/test/lisp/progmodes/scheme-tests.el
new file mode 100644
index 00000000000..e3736bd411e
--- /dev/null
+++ b/test/lisp/progmodes/scheme-tests.el
@@ -0,0 +1,50 @@
+;;; scheme-tests.el --- Test suite for scheme.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'scheme)
+
+(ert-deftest scheme-test-indent ()
+ ;; FIXME: Look into what is the expected indent here and fix it.
+ :expected-result :failed
+ ;; Converted from manual test.
+ (with-temp-buffer
+ (scheme-mode)
+ ;; TODO: Should some of these be fontification tests as well?
+ (let ((orig "#!/usr/bin/scheme is this a comment?
+
+;; This one is a comment
+(a)
+#| and this one as #|well|# as this! |#
+(b)
+(cons #;(this is a
+ comment)
+ head tail)
+"))
+ (insert orig)
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) orig)))))
+
+(provide 'scheme-tests)
+
+;;; scheme-tests.el ends here
diff --git a/test/lisp/progmodes/subword-tests.el b/test/lisp/progmodes/subword-tests.el
index 00168c01e13..6aeee76110b 100644
--- a/test/lisp/progmodes/subword-tests.el
+++ b/test/lisp/progmodes/subword-tests.el
@@ -1,22 +1,24 @@
-;;; subword-tests.el --- Testing the subword rules
+;;; subword-tests.el --- Testing the subword rules -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; 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 <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/progmodes/tcl-tests.el b/test/lisp/progmodes/tcl-tests.el
index 75409a62723..fb5a19d3d0c 100644
--- a/test/lisp/progmodes/tcl-tests.el
+++ b/test/lisp/progmodes/tcl-tests.el
@@ -1,4 +1,4 @@
-;;; tcl-tests.el --- Test suite for tcl-mode
+;;; tcl-tests.el --- Test suite for tcl-mode -*- lexical-binding:t -*-
;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el
index 9c7a9e69658..a4980b2acb1 100644
--- a/test/lisp/progmodes/xref-tests.el
+++ b/test/lisp/progmodes/xref-tests.el
@@ -1,4 +1,4 @@
-;;; xref-tests.el --- tests for xref
+;;; xref-tests.el --- tests for xref -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index af765fbe3fa..aed14c33572 100644
--- a/test/lisp/replace-tests.el
+++ b/test/lisp/replace-tests.el
@@ -1,4 +1,4 @@
-;;; replace-tests.el --- tests for replace.el.
+;;; replace-tests.el --- tests for replace.el. -*- lexical-binding:t -*-
;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
@@ -546,4 +546,46 @@ Return the last evalled form in BODY."
?q
(string= expected (buffer-string))))))
+(defmacro replace-tests-with-highlighted-occurrence (highlight-locus &rest body)
+ "Helper macro to test the highlight of matches when navigating occur buffer.
+
+Eval BODY with `next-error-highlight' and `next-error-highlight-no-select'
+bound to HIGHLIGHT-LOCUS."
+ (declare (indent 1) (debug (form body)))
+ `(let ((regexp "foo")
+ (next-error-highlight ,highlight-locus)
+ (next-error-highlight-no-select ,highlight-locus)
+ (buffer (generate-new-buffer "test"))
+ (inhibit-message t))
+ (unwind-protect
+ ;; Local bind to disable the deletion of `occur-highlight-overlay'
+ (cl-letf (((symbol-function 'occur-goto-locus-delete-o) (lambda ())))
+ (with-current-buffer buffer (dotimes (_ 3) (insert regexp ?\n)))
+ (pop-to-buffer buffer)
+ (occur regexp)
+ (pop-to-buffer "*Occur*")
+ (occur-next)
+ ,@body)
+ (kill-buffer buffer)
+ (kill-buffer "*Occur*"))))
+
+(ert-deftest occur-highlight-occurrence ()
+ "Test for https://debbugs.gnu.org/39121 ."
+ (let ((alist '((nil . nil) (0.5 . t) (t . t) (fringe-arrow . nil)))
+ (check-overlays
+ (lambda (has-ov)
+ (eq has-ov (not (null (overlays-in (point-min) (point-max))))))))
+ (pcase-dolist (`(,highlight-locus . ,has-overlay) alist)
+ ;; Visiting occurrences
+ (replace-tests-with-highlighted-occurrence highlight-locus
+ (occur-mode-goto-occurrence)
+ (should (funcall check-overlays has-overlay)))
+ ;; Displaying occurrences
+ (replace-tests-with-highlighted-occurrence highlight-locus
+ (occur-mode-display-occurrence)
+ (with-current-buffer (marker-buffer
+ (get-text-property (point) 'occur-target))
+ (should (funcall check-overlays has-overlay)))))))
+
+
;;; replace-tests.el ends here
diff --git a/test/lisp/saveplace-resources/saveplace b/test/lisp/saveplace-resources/saveplace
new file mode 100644
index 00000000000..3f3f6d501d6
--- /dev/null
+++ b/test/lisp/saveplace-resources/saveplace
@@ -0,0 +1,4 @@
+;;; -*- coding: utf-8 -*-
+(("/home/skangas/.emacs.d/cache/recentf" . 1306)
+ ("/home/skangas/wip/emacs/"
+ (dired-filename . "/home/skangas/wip/emacs/COPYING")))
diff --git a/test/lisp/saveplace-tests.el b/test/lisp/saveplace-tests.el
new file mode 100644
index 00000000000..ae7749fe930
--- /dev/null
+++ b/test/lisp/saveplace-tests.el
@@ -0,0 +1,103 @@
+;;; saveplace-tests.el --- Tests for saveplace.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2019-2020 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:
+
+(require 'ert)
+(require 'saveplace)
+
+(defvar saveplace-tests-dir
+ (file-truename
+ (expand-file-name "saveplace-resources"
+ (file-name-directory (or load-file-name
+ buffer-file-name)))))
+
+(ert-deftest saveplace-test-save-place-to-alist/dir ()
+ (save-place-mode)
+ (let* ((save-place-alist nil)
+ (save-place-loaded t)
+ (loc saveplace-tests-dir))
+ (save-window-excursion
+ (dired loc)
+ (save-place-to-alist)
+ (should (equal save-place-alist
+ `((,(concat loc "/")
+ (dired-filename . ,(concat loc "/saveplace")))))))))
+
+(ert-deftest saveplace-test-save-place-to-alist/file ()
+ (save-place-mode)
+ (let* ((tmpfile (make-temp-file "emacs-test-saveplace-"))
+ (save-place-alist nil)
+ (save-place-loaded t)
+ (loc tmpfile)
+ (pos 4))
+ (unwind-protect
+ (save-window-excursion
+ (find-file loc)
+ (insert "abc") ; must insert something
+ (save-place-to-alist)
+ (should (equal save-place-alist (list (cons tmpfile pos)))))
+ (delete-file tmpfile))))
+
+(ert-deftest saveplace-test-forget-unreadable-files ()
+ (save-place-mode)
+ (let* ((save-place-loaded t)
+ (tmpfile (make-temp-file "emacs-test-saveplace-"))
+ (alist-orig (list (cons "/this/file/does/not/exist" 10)
+ (cons tmpfile 1917)))
+ (save-place-alist alist-orig))
+ (unwind-protect
+ (progn
+ (save-place-forget-unreadable-files)
+ (should (equal save-place-alist (cdr alist-orig))))
+ (delete-file tmpfile))))
+
+(ert-deftest saveplace-test-place-alist-to-file ()
+ (save-place-mode)
+ (let* ((tmpfile (make-temp-file "emacs-test-saveplace-"))
+ (tmpfile2 (make-temp-file "emacs-test-saveplace-"))
+ (save-place-file tmpfile)
+ (save-place-alist (list (cons tmpfile2 99))))
+ (unwind-protect
+ (progn (save-place-alist-to-file)
+ (setq save-place-alist nil)
+ (save-window-excursion
+ (find-file save-place-file)
+ (unwind-protect
+ (should (string-match tmpfile2 (buffer-string)))
+ (kill-buffer))))
+ (delete-file tmpfile)
+ (delete-file tmpfile2))))
+
+(ert-deftest saveplace-test-load-alist-from-file ()
+ (save-place-mode)
+ (let ((save-place-loaded nil)
+ (save-place-file
+ (expand-file-name "saveplace" saveplace-tests-dir))
+ (save-place-alist nil))
+ (load-save-place-alist-from-file)
+ (should (equal save-place-alist
+ '(("/home/skangas/.emacs.d/cache/recentf" . 1306)
+ ("/home/skangas/wip/emacs/"
+ (dired-filename . "/home/skangas/wip/emacs/COPYING")))))))
+
+(provide 'saveplace-tests)
+;;; saveplace-tests.el ends here
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index 650782bc53c..f40f6a1cdb0 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -1,4 +1,4 @@
-;;; shadowfile-tests.el --- Tests of shadowfile
+;;; shadowfile-tests.el --- Tests of shadowfile -*- lexical-binding:t -*-
;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
@@ -70,7 +70,6 @@
(setq password-cache-expiry nil
shadow-debug (getenv "EMACS_HYDRA_CI")
tramp-verbose 0
- tramp-message-show-message nil
;; On macOS, `temporary-file-directory' is a symlinked directory.
temporary-file-directory (file-truename temporary-file-directory)
shadow-test-remote-temporary-file-directory
@@ -126,6 +125,7 @@
Per definition, all files are identical on the different hosts of
a cluster (or site). This is not tested here; it must be
guaranteed by the originator of a cluster definition."
+ :tags '(:expensive-test)
(skip-unless (not (memq system-type '(windows-nt ms-dos))))
(skip-unless (file-remote-p shadow-test-remote-temporary-file-directory))
@@ -139,9 +139,9 @@ guaranteed by the originator of a cluster definition."
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
(cl-letf* (((symbol-function #'read-from-minibuffer)
- (lambda (&rest args) (pop mocked-input)))
+ (lambda (&rest _args) (pop mocked-input)))
((symbol-function #'read-string)
- (lambda (&rest args) (pop mocked-input))))
+ (lambda (&rest _args) (pop mocked-input))))
;; Cleanup & initialize.
(shadow--tests-cleanup)
@@ -256,9 +256,9 @@ guaranteed by the originator of a cluster definition."
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
(cl-letf* (((symbol-function #'read-from-minibuffer)
- (lambda (&rest args) (pop mocked-input)))
+ (lambda (&rest _args) (pop mocked-input)))
((symbol-function #'read-string)
- (lambda (&rest args) (pop mocked-input))))
+ (lambda (&rest _args) (pop mocked-input))))
;; Cleanup & initialize.
(shadow--tests-cleanup)
@@ -609,9 +609,9 @@ guaranteed by the originator of a cluster definition."
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
(cl-letf* (((symbol-function #'read-from-minibuffer)
- (lambda (&rest args) (pop mocked-input)))
+ (lambda (&rest _args) (pop mocked-input)))
((symbol-function #'read-string)
- (lambda (&rest args) (pop mocked-input))))
+ (lambda (&rest _args) (pop mocked-input))))
;; Cleanup & initialize.
(shadow--tests-cleanup)
@@ -670,9 +670,9 @@ guaranteed by the originator of a cluster definition."
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
(cl-letf* (((symbol-function #'read-from-minibuffer)
- (lambda (&rest args) (pop mocked-input)))
+ (lambda (&rest _args) (pop mocked-input)))
((symbol-function #'read-string)
- (lambda (&rest args) (pop mocked-input))))
+ (lambda (&rest _args) (pop mocked-input))))
;; Cleanup & initialize.
(shadow--tests-cleanup)
@@ -866,6 +866,7 @@ guaranteed by the originator of a cluster definition."
(ert-deftest shadow-test09-shadow-copy-files ()
"Check that needed shadow files are copied."
+ :tags '(:expensive-test)
(skip-unless (not (memq system-type '(windows-nt ms-dos))))
(skip-unless (file-remote-p shadow-test-remote-temporary-file-directory))
(skip-unless (file-writable-p shadow-test-remote-temporary-file-directory))
@@ -924,7 +925,7 @@ guaranteed by the originator of a cluster definition."
;; action.
(add-function
:before (symbol-function #'write-region)
- (lambda (&rest args)
+ (lambda (&rest _args)
(when (and (buffer-file-name) mocked-input)
(should (equal (buffer-file-name) (pop mocked-input)))))
'((name . "write-region-mock")))
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index c8b913b3f1c..d4b316811e6 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -4,18 +4,20 @@
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
-;; 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/>.
;;; Code:
@@ -39,6 +41,13 @@
(with-no-warnings (simple-test--buffer-substrings))))
+;;; `count-words'
+(ert-deftest simple-test-count-words-bug-41761 ()
+ (with-temp-buffer
+ (dotimes (_i 10) (insert (propertize "test " 'field (cons nil nil))))
+ (should (= (count-words (point-min) (point-max)) 10))))
+
+
;;; `transpose-sexps'
(defmacro simple-test--transpositions (&rest body)
(declare (indent 0)
@@ -392,6 +401,48 @@ See bug#35036."
(should (equal ?\s (char-syntax ?\n))))))
+;;; undo tests
+
+(defun simple-tests--exec (cmds)
+ (dolist (cmd cmds)
+ (setq last-command this-command)
+ (setq this-command cmd)
+ (run-hooks 'pre-command-hook)
+ (command-execute cmd)
+ (run-hooks 'post-command-hook)
+ (undo-boundary)))
+
+(ert-deftest simple-tests--undo ()
+ (with-temp-buffer
+ (buffer-enable-undo)
+ (dolist (x '("a" "b" "c" "d" "e"))
+ (insert x)
+ (undo-boundary))
+ (should (equal (buffer-string) "abcde"))
+ (simple-tests--exec '(undo undo))
+ (should (equal (buffer-string) "abc"))
+ (simple-tests--exec '(backward-char undo))
+ (should (equal (buffer-string) "abcd"))
+ (simple-tests--exec '(undo))
+ (should (equal (buffer-string) "abcde"))
+ (simple-tests--exec '(backward-char undo undo))
+ (should (equal (buffer-string) "abc"))
+ (simple-tests--exec '(backward-char undo-redo))
+ (should (equal (buffer-string) "abcd"))
+ (simple-tests--exec '(undo))
+ (should (equal (buffer-string) "abc"))
+ (simple-tests--exec '(backward-char undo-redo undo-redo))
+ (should (equal (buffer-string) "abcde"))
+ (simple-tests--exec '(undo undo))
+ (should (equal (buffer-string) "abc"))
+ (simple-tests--exec '(backward-char undo-only undo-only))
+ (should (equal (buffer-string) "a"))
+ (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"))
+ ))
+
;;; undo auto-boundary tests
(ert-deftest undo-auto-boundary-timer ()
(should
@@ -427,7 +478,7 @@ See bug#35036."
(with-temp-buffer
(switch-to-buffer (current-buffer))
(setq buffer-undo-list nil)
- (insert "a\nb\n\c\n")
+ (insert "a\nb\nc\n")
(goto-char (point-max))
;; We use a keyboard macro because it adds undo events in the same
;; way as if a user were involved.
diff --git a/test/lisp/sort-tests.el b/test/lisp/sort-tests.el
index 21f483a23af..9033745e0d4 100644
--- a/test/lisp/sort-tests.el
+++ b/test/lisp/sort-tests.el
@@ -4,18 +4,20 @@
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
-;; 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/>.
;;; Code:
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 059d52b1b6f..035c064d75c 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1,4 +1,4 @@
-;;; subr-tests.el --- Tests for subr.el
+;;; subr-tests.el --- Tests for subr.el -*- lexical-binding:t -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
@@ -172,27 +172,28 @@
(should (equal (version-to-list "6.9.30Beta") '(6 9 30 -2)))
(should (equal (version-to-list "6.9.30_Beta") '(6 9 30 -2)))
- (should (equal
- (error-message-string (should-error (version-to-list "OTP-18.1.5")))
- "Invalid version syntax: `OTP-18.1.5' (must start with a number)"))
- (should (equal
- (error-message-string (should-error (version-to-list "")))
- "Invalid version syntax: `' (must start with a number)"))
- (should (equal
- (error-message-string (should-error (version-to-list "1.0..7.5")))
- "Invalid version syntax: `1.0..7.5'"))
- (should (equal
- (error-message-string (should-error (version-to-list "1.0prepre2")))
- "Invalid version syntax: `1.0prepre2'"))
- (should (equal
- (error-message-string (should-error (version-to-list "22.8X3")))
- "Invalid version syntax: `22.8X3'"))
- (should (equal
- (error-message-string (should-error (version-to-list "beta22.8alpha3")))
- "Invalid version syntax: `beta22.8alpha3' (must start with a number)"))
- (should (equal
- (error-message-string (should-error (version-to-list "honk")))
- "Invalid version syntax: `honk' (must start with a number)"))
+ (let ((text-quoting-style 'grave))
+ (should (equal
+ (error-message-string (should-error (version-to-list "OTP-18.1.5")))
+ "Invalid version syntax: `OTP-18.1.5' (must start with a number)"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "")))
+ "Invalid version syntax: `' (must start with a number)"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "1.0..7.5")))
+ "Invalid version syntax: `1.0..7.5'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "1.0prepre2")))
+ "Invalid version syntax: `1.0prepre2'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "22.8X3")))
+ "Invalid version syntax: `22.8X3'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "beta22.8alpha3")))
+ "Invalid version syntax: `beta22.8alpha3' (must start with a number)"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "honk")))
+ "Invalid version syntax: `honk' (must start with a number)")))
(should (equal
(error-message-string (should-error (version-to-list 9)))
"Version must be a string"))
@@ -231,18 +232,40 @@
(should (equal (version-to-list "6_9_30.Beta") '(6 9 30 -2)))
(should (equal (version-to-list "6_9_30Beta") '(6 9 30 -2)))
- (should (equal
- (error-message-string (should-error (version-to-list "1_0__7_5")))
- "Invalid version syntax: `1_0__7_5'"))
- (should (equal
- (error-message-string (should-error (version-to-list "1_0prepre2")))
- "Invalid version syntax: `1_0prepre2'"))
- (should (equal
- (error-message-string (should-error (version-to-list "22.8X3")))
- "Invalid version syntax: `22.8X3'"))
- (should (equal
- (error-message-string (should-error (version-to-list "beta22_8alpha3")))
- "Invalid version syntax: `beta22_8alpha3' (must start with a number)"))))
+ (let ((text-quoting-style 'grave))
+ (should (equal
+ (error-message-string (should-error (version-to-list "1_0__7_5")))
+ "Invalid version syntax: `1_0__7_5'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "1_0prepre2")))
+ "Invalid version syntax: `1_0prepre2'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "22.8X3")))
+ "Invalid version syntax: `22.8X3'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "beta22_8alpha3")))
+ "Invalid version syntax: `beta22_8alpha3' (must start with a number)")))))
+
+(ert-deftest subr-test-version-list-< ()
+ (should (version-list-< '(0) '(1)))
+ (should (version-list-< '(0 9) '(1 0)))
+ (should (version-list-< '(1 -1) '(1 0)))
+ (should (version-list-< '(1 -2) '(1 -1)))
+ (should (not (version-list-< '(1) '(0))))
+ (should (not (version-list-< '(1 1) '(1 0))))
+ (should (not (version-list-< '(1) '(1 0))))
+ (should (not (version-list-< '(1 0) '(1 0 0)))))
+
+(ert-deftest subr-test-version-list-= ()
+ (should (version-list-= '(1) '(1)))
+ (should (version-list-= '(1 0) '(1)))
+ (should (not (version-list-= '(0) '(1)))))
+
+(ert-deftest subr-test-version-list-<= ()
+ (should (version-list-<= '(0) '(1)))
+ (should (version-list-<= '(1) '(1)))
+ (should (version-list-<= '(1 0) '(1)))
+ (should (not (version-list-<= '(1) '(0)))))
(defun subr-test--backtrace-frames-with-backtrace-frame (base)
"Reference implementation of `backtrace-frames'."
@@ -417,5 +440,49 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350."
(should-error (ignore-error foo
(read ""))))
+(ert-deftest string-replace ()
+ (should (equal (string-replace "foo" "bar" "zot")
+ "zot"))
+ (should (equal (string-replace "foo" "bar" "foozot")
+ "barzot"))
+ (should (equal (string-replace "foo" "bar" "barfoozot")
+ "barbarzot"))
+ (should (equal (string-replace "zot" "bar" "barfoozot")
+ "barfoobar"))
+ (should (equal (string-replace "z" "bar" "barfoozot")
+ "barfoobarot"))
+ (should (equal (string-replace "zot" "bar" "zat")
+ "zat"))
+ (should (equal (string-replace "azot" "bar" "zat")
+ "zat"))
+ (should (equal (string-replace "azot" "bar" "azot")
+ "bar"))
+
+ (should (equal (string-replace "azot" "bar" "foozotbar")
+ "foozotbar"))
+
+ (should (equal (string-replace "fo" "bar" "lafofofozot")
+ "labarbarbarzot"))
+
+ (should (equal (string-replace "\377" "x" "a\377b")
+ "axb"))
+ (should (equal (string-replace "\377" "x" "a\377ø")
+ "axø"))
+ (should (equal (string-replace (string-to-multibyte "\377") "x" "a\377b")
+ "axb"))
+ (should (equal (string-replace (string-to-multibyte "\377") "x" "a\377ø")
+ "axø"))
+
+ (should (equal (string-replace "ana" "ANA" "ananas") "ANAnas"))
+
+ (should (equal (string-replace "a" "" "") ""))
+ (should (equal (string-replace "a" "" "aaaaa") ""))
+ (should (equal (string-replace "ab" "" "ababab") ""))
+ (should (equal (string-replace "ab" "" "abcabcabc") "ccc"))
+ (should (equal (string-replace "a" "aa" "aaa") "aaaaaa"))
+ (should (equal (string-replace "abc" "defg" "abc") "defg"))
+
+ (should-error (string-replace "" "x" "abc")))
+
(provide 'subr-tests)
;;; subr-tests.el ends here
diff --git a/test/lisp/tar-mode-tests.el b/test/lisp/tar-mode-tests.el
index bc41b863da7..f05389df60f 100644
--- a/test/lisp/tar-mode-tests.el
+++ b/test/lisp/tar-mode-tests.el
@@ -29,7 +29,8 @@
(cons 420 "rw-r--r--")
(cons 292 "r--r--r--")
(cons 512 "--------T")
- (cons 1024 "-----S---"))))
+ (cons 1024 "-----S---")
+ (cons 2048 "--S------"))))
(dolist (x alist)
(should (equal (cdr x) (tar-grind-file-mode (car x)))))))
diff --git a/test/lisp/tempo-tests.el b/test/lisp/tempo-tests.el
index 0dd310b8531..bfe475910da 100644
--- a/test/lisp/tempo-tests.el
+++ b/test/lisp/tempo-tests.el
@@ -216,6 +216,45 @@
(tempo-complete-tag)
(should (equal (buffer-string) "Hello, World!"))))
+(ert-deftest tempo-define-tag-globally-test ()
+ "Testing usage of a template tag defined from another buffer."
+ (tempo-define-template "test" '("Hello, World!") "hello")
+
+ (with-temp-buffer
+ ;; Use a tag in buffer 1
+ (insert "hello")
+ (tempo-complete-tag)
+ (should (equal (buffer-string) "Hello, World!"))
+ (erase-buffer)
+
+ ;; Collection should not be dirty
+ (should-not tempo-dirty-collection)
+
+ ;; Define a tag on buffer 2
+ (with-temp-buffer
+ (tempo-define-template "test2" '("Now expanded.") "mytag"))
+
+ ;; I should be able to use this template back in buffer 1
+ (insert "mytag")
+ (tempo-complete-tag)
+ (should (equal (buffer-string) "Now expanded."))))
+
+(ert-deftest tempo-overwrite-tag-test ()
+ "Testing ability to reassign templates to tags."
+ (with-temp-buffer
+ ;; Define a tag and use it
+ (tempo-define-template "test-tag-1" '("abc") "footag")
+ (insert "footag")
+ (tempo-complete-tag)
+ (should (equal (buffer-string) "abc"))
+ (erase-buffer)
+
+ ;; Define a new template with the same tag
+ (tempo-define-template "test-tag-2" '("xyz") "footag")
+ (insert "footag")
+ (tempo-complete-tag)
+ (should (equal (buffer-string) "xyz"))))
+
(ert-deftest tempo-expand-partial-tag-test ()
"Testing expansion of a template with a tag, with a partial match."
(with-temp-buffer
diff --git a/test/lisp/textmodes/bibtex-tests.el b/test/lisp/textmodes/bibtex-tests.el
new file mode 100644
index 00000000000..c12722fca13
--- /dev/null
+++ b/test/lisp/textmodes/bibtex-tests.el
@@ -0,0 +1,57 @@
+;;; bibtex-tests.el --- Test suite for bibtex. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+
+;; Keywords: bibtex
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'bibtex)
+
+(ert-deftest bibtex-test-set-dialect ()
+ "Tests if `bibtex-set-dialect' is executed."
+ (with-temp-buffer
+ (insert "@article{someID,
+ author = {some author},
+ title = {some title},
+}")
+ (bibtex-mode)
+ (should-not (null bibtex-dialect))
+ (should-not (null bibtex-entry-type))
+ (should-not (null bibtex-entry-head))
+ (should-not (null bibtex-reference-key))
+ (should-not (null bibtex-entry-head))
+ (should-not (null bibtex-entry-maybe-empty-head))
+ (should-not (null bibtex-any-valid-entry-type))))
+
+(ert-deftest bibtex-test-parse-buffers-stealthily ()
+ "Tests if `bibtex-parse-buffers-stealthily' can be executed."
+ (with-temp-buffer
+ (insert "@article{someID,
+ author = {some author},
+ title = {some title},
+}")
+ (bibtex-mode)
+ (should (progn (bibtex-parse-buffers-stealthily) t))))
+
+(provide 'bibtex-tests)
+
+;;; bibtex-tests.el ends here
diff --git a/test/lisp/textmodes/conf-mode-tests.el b/test/lisp/textmodes/conf-mode-tests.el
index 814cb06b960..7e094e8a7c2 100644
--- a/test/lisp/textmodes/conf-mode-tests.el
+++ b/test/lisp/textmodes/conf-mode-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
+;; 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:
@@ -162,7 +162,7 @@ image/tiff tiff tif
(ert-deftest conf-test-toml-mode ()
;; From `conf-toml-mode' docstring.
(with-temp-buffer
- (insert "\[entry]
+ (insert "[entry]
value = \"some string\"")
(goto-char (point-min))
(conf-toml-mode)
diff --git a/test/manual/indent/css-mode.css b/test/lisp/textmodes/css-mode-resources/test-indent.css
index ecf6c3c0ca5..041aeec1b15 100644
--- a/test/manual/indent/css-mode.css
+++ b/test/lisp/textmodes/css-mode-resources/test-indent.css
@@ -92,5 +92,9 @@ div::before {
.foo-bar--baz {
--foo-variable: 5px;
+ --_variable_with_underscores: #fff;
+ --_variable-starting-with-underscore: none;
margin: var(--foo-variable);
+ color: var(--_variable_with_underscores);
+ display: var(--_variable-starting-with-underscore);
}
diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el
index b57bbd8a9ef..f627d1c02c9 100644
--- a/test/lisp/textmodes/css-mode-tests.el
+++ b/test/lisp/textmodes/css-mode-tests.el
@@ -7,18 +7,20 @@
;; This file is part of GNU Emacs.
-;; 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:
@@ -28,6 +30,12 @@
(require 'ert)
(require 'seq)
+(defvar css-mode-tests-data-dir
+ (file-truename
+ (expand-file-name "css-mode-resources/"
+ (file-name-directory (or load-file-name
+ buffer-file-name)))))
+
(ert-deftest css-test-property-values ()
;; The `float' property has a flat value list.
(should
@@ -409,5 +417,13 @@
(point))
"black")))))
+(ert-deftest css-mode-test-indent ()
+ (with-current-buffer
+ (find-file-noselect (expand-file-name "test-indent.css"
+ css-mode-tests-data-dir))
+ (let ((orig (buffer-string)))
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) orig)))))
+
(provide 'css-mode-tests)
;;; css-mode-tests.el ends here
diff --git a/test/lisp/textmodes/mhtml-mode-tests.el b/test/lisp/textmodes/mhtml-mode-tests.el
index aa5f19efdaa..1840e8b4016 100644
--- a/test/lisp/textmodes/mhtml-mode-tests.el
+++ b/test/lisp/textmodes/mhtml-mode-tests.el
@@ -1,4 +1,4 @@
-;;; mhtml-mode-tests.el --- Tests for mhtml-mode
+;;; mhtml-mode-tests.el --- Tests for mhtml-mode -*- lexical-binding:t -*-
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/textmodes/paragraphs-tests.el b/test/lisp/textmodes/paragraphs-tests.el
index fc839fe7d95..0b264e7e184 100644
--- a/test/lisp/textmodes/paragraphs-tests.el
+++ b/test/lisp/textmodes/paragraphs-tests.el
@@ -50,8 +50,8 @@
(goto-char (point-min))
(mark-paragraph)
(should mark-active)
- (should (equal (mark) 7)))
- (should-error (mark-paragraph 0)))
+ (should (equal (mark) 7))))
+;;; (should-error (mark-paragraph 0)))
(ert-deftest paragraphs-tests-kill-paragraph ()
(with-temp-buffer
diff --git a/test/lisp/textmodes/po-tests.el b/test/lisp/textmodes/po-tests.el
new file mode 100644
index 00000000000..a098290ce15
--- /dev/null
+++ b/test/lisp/textmodes/po-tests.el
@@ -0,0 +1,68 @@
+;;; po-tests.el --- Tests for po.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'po)
+(require 'ert)
+
+(defconst po-tests--buffer-string
+ "# Norwegian bokmål translation of the GIMP.
+# Copyright (C) 1999-2001 Free Software Foundation, Inc.
+#
+msgid \"\"
+msgstr \"\"
+\"Project-Id-Version: gimp 2.8.5\\n\"
+\"Report-Msgid-Bugs-To: https://gitlab.gnome.org/GNOME/gimp/issues\\n\"
+\"POT-Creation-Date: 2013-05-27 14:57+0200\\n\"
+\"PO-Revision-Date: 2013-05-27 15:21+0200\\n\"
+\"Language: nb\\n\"
+\"MIME-Version: 1.0\\n\"
+\"Content-Type: text/plain; charset=UTF-8\\n\"
+\"Content-Transfer-Encoding: 8bit\\n\"
+\"Plural-Forms: nplurals=2; plural=(n != 1);\\n\"
+
+#: ../desktop/gimp.desktop.in.in.h:1 ../app/about.h:26
+msgid \"GNU Image Manipulation Program\"
+msgstr \"GNU bildebehandlingsprogram\"
+")
+
+(ert-deftest po-tests-find-charset ()
+ (with-temp-buffer
+ (insert po-tests--buffer-string)
+ (should (equal (po-find-charset (cons nil (current-buffer)))
+ "UTF-8"))))
+
+(ert-deftest po-tests-find-file-coding-system-guts ()
+ (with-temp-buffer
+ (insert po-tests--buffer-string)
+ (should (equal (po-find-file-coding-system-guts
+ 'insert-file-contents
+ (cons "*tmp*" (current-buffer)))
+ '(utf-8 . nil)))))
+
+(provide 'po-tests)
+;;; po-tests.el ends here
diff --git a/test/lisp/textmodes/sgml-mode-tests.el b/test/lisp/textmodes/sgml-mode-tests.el
index f0b93e24d2c..a4457307b35 100644
--- a/test/lisp/textmodes/sgml-mode-tests.el
+++ b/test/lisp/textmodes/sgml-mode-tests.el
@@ -1,4 +1,4 @@
-;;; sgml-mode-tests.el --- Tests for sgml-mode
+;;; sgml-mode-tests.el --- Tests for sgml-mode -*- lexical-binding:t -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index 4edf75edba6..f02aeaeef6a 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -1,4 +1,4 @@
-;;; thingatpt.el --- tests for thing-at-point.
+;;; thingatpt.el --- tests for thing-at-point. -*- lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el
index d229fddc48d..e75e84b0221 100644
--- a/test/lisp/time-stamp-tests.el
+++ b/test/lisp/time-stamp-tests.el
@@ -38,9 +38,7 @@
(cl-letf (((symbol-function 'time-stamp-conv-warn)
(lambda (old-format _new)
(ert-fail
- (format "Unexpected format warning for '%s'" old-format))))
- ((symbol-function 'system-name)
- (lambda () "test-system-name.example.org")))
+ (format "Unexpected format warning for '%s'" old-format)))))
;; Not all reference times are used in all tests;
;; suppress the byte compiler's "unused" warning.
(list ref-time1 ref-time2 ref-time3)
@@ -56,6 +54,13 @@
(apply orig-time-stamp-string-fn ts-format ,reference-time nil))))
,@body))
+(defmacro with-time-stamp-system-name (name &rest body)
+ "Force (system-name) to return NAME while evaluating BODY."
+ (declare (indent defun))
+ `(cl-letf (((symbol-function 'system-name)
+ (lambda () ,name)))
+ ,@body))
+
(defmacro time-stamp-should-warn (form)
"Similar to `should' but verifies that a format warning is generated."
`(let ((warning-count 0))
@@ -170,6 +175,20 @@
;; triggering the tests above.
(time-stamp)))))))
+(ert-deftest time-stamp-custom-format-tabs-expand ()
+ "Test that Tab characters expand in the format but not elsewhere."
+ (with-time-stamp-test-env
+ (let ((time-stamp-start "Updated in: <\t")
+ ;; Tabs in the format should expand
+ (time-stamp-format "\t%Y\t")
+ (time-stamp-end "\t>"))
+ (with-time-stamp-test-time ref-time1
+ (with-temp-buffer
+ (insert "Updated in: <\t\t>")
+ (time-stamp)
+ (should (equal (buffer-string)
+ "Updated in: <\t 2006 \t>")))))))
+
(ert-deftest time-stamp-custom-inserts-lines ()
"Test that time-stamp inserts lines or not, as directed."
(with-time-stamp-test-env
@@ -194,19 +213,46 @@
(time-stamp)
(should (equal (buffer-string) buffer-expected-2line)))))))
+(ert-deftest time-stamp-custom-end ()
+ "Test that time-stamp finds the end pattern on the correct line."
+ (with-time-stamp-test-env
+ (let ((time-stamp-start "Updated on: <")
+ (time-stamp-format "%Y-%m-%d")
+ (time-stamp-end ">") ;changed later in the test
+ (buffer-original-contents "Updated on: <\n>\n")
+ (buffer-expected-time-stamped "Updated on: <2006-01-02\n>\n"))
+ (with-time-stamp-test-time ref-time1
+ (with-temp-buffer
+ (insert buffer-original-contents)
+ ;; time-stamp-end is not on same line, should not be seen
+ (time-stamp)
+ (should (equal (buffer-string) buffer-original-contents))
+
+ ;; add a newline to time-stamp-end, so it starts on same line
+ (setq time-stamp-end "\n>")
+ (time-stamp)
+ (should (equal (buffer-string) buffer-expected-time-stamped)))))))
+
(ert-deftest time-stamp-custom-count ()
"Test that time-stamp updates no more than time-stamp-count templates."
(with-time-stamp-test-env
(let ((time-stamp-start "TS: <")
(time-stamp-format "%Y-%m-%d")
- (time-stamp-count 1) ;changed later in the test
+ (time-stamp-count 0) ;changed later in the test
(buffer-expected-once "TS: <2006-01-02>\nTS: <>")
(buffer-expected-twice "TS: <2006-01-02>\nTS: <2006-01-02>"))
(with-time-stamp-test-time ref-time1
(with-temp-buffer
(insert "TS: <>\nTS: <>")
(time-stamp)
+ ;; even with count = 0, expect one time stamp
+ (should (equal (buffer-string) buffer-expected-once)))
+ (with-temp-buffer
+ (setq time-stamp-count 1)
+ (insert "TS: <>\nTS: <>")
+ (time-stamp)
(should (equal (buffer-string) buffer-expected-once))
+
(setq time-stamp-count 2)
(time-stamp)
(should (equal (buffer-string) buffer-expected-twice)))))))
@@ -488,26 +534,35 @@
(ert-deftest time-stamp-format-non-date-conversions ()
"Test time-stamp formats for non-date items."
(with-time-stamp-test-env
- ;; implemented and documented since 1995
- (should (equal (time-stamp-string "%%" ref-time1) "%")) ;% last char
- (should (equal (time-stamp-string "%%P" ref-time1) "%P")) ;% not last char
- (should (equal (time-stamp-string "%f" ref-time1) "time-stamped-file"))
- (should
- (equal (time-stamp-string "%F" ref-time1) "/emacs/test/time-stamped-file"))
- (should (equal (time-stamp-string "%h" ref-time1) "test-mail-host-name"))
- ;; documented 1995-2019
- (should (equal
- (time-stamp-string "%s" ref-time1) "test-system-name.example.org"))
- (should (equal (time-stamp-string "%U" ref-time1) "100%d Tester"))
- (should (equal (time-stamp-string "%u" ref-time1) "test-logname"))
- ;; implemented since 2001, documented since 2019
- (should (equal (time-stamp-string "%L" ref-time1) "100%d Tester"))
- (should (equal (time-stamp-string "%l" ref-time1) "test-logname"))
- ;; implemented since 2007, documented since 2019
- (should (equal
- (time-stamp-string "%Q" ref-time1) "test-system-name.example.org"))
- (should (equal
- (time-stamp-string "%q" ref-time1) "test-system-name"))))
+ (with-time-stamp-system-name "test-system-name.example.org"
+ ;; implemented and documented since 1995
+ (should (equal (time-stamp-string "%%" ref-time1) "%")) ;% last char
+ (should (equal (time-stamp-string "%%P" ref-time1) "%P")) ;% not last char
+ (should (equal (time-stamp-string "%f" ref-time1) "time-stamped-file"))
+ (should (equal (time-stamp-string "%F" ref-time1)
+ "/emacs/test/time-stamped-file"))
+ (with-temp-buffer
+ (should (equal (time-stamp-string "%f" ref-time1) "(no file)"))
+ (should (equal (time-stamp-string "%F" ref-time1) "(no file)")))
+ (should (equal (time-stamp-string "%h" ref-time1) "test-mail-host-name"))
+ (let ((mail-host-address nil))
+ (should (equal (time-stamp-string "%h" ref-time1)
+ "test-system-name.example.org")))
+ ;; documented 1995-2019
+ (should (equal (time-stamp-string "%s" ref-time1)
+ "test-system-name.example.org"))
+ (should (equal (time-stamp-string "%U" ref-time1) "100%d Tester"))
+ (should (equal (time-stamp-string "%u" ref-time1) "test-logname"))
+ ;; implemented since 2001, documented since 2019
+ (should (equal (time-stamp-string "%L" ref-time1) "100%d Tester"))
+ (should (equal (time-stamp-string "%l" ref-time1) "test-logname"))
+ ;; implemented since 2007, documented since 2019
+ (should (equal (time-stamp-string "%Q" ref-time1)
+ "test-system-name.example.org"))
+ (should (equal (time-stamp-string "%q" ref-time1) "test-system-name")))
+ (with-time-stamp-system-name "sysname-no-dots"
+ (should (equal (time-stamp-string "%Q" ref-time1) "sysname-no-dots"))
+ (should (equal (time-stamp-string "%q" ref-time1) "sysname-no-dots")))))
(ert-deftest time-stamp-format-ignored-modifiers ()
"Test additional args allowed (but ignored) to allow for future expansion."
@@ -538,6 +593,13 @@
;;; Tests of helper functions
+(ert-deftest time-stamp-helper-string-defaults ()
+ "Test that time-stamp-string defaults its format to time-stamp-format."
+ (with-time-stamp-test-env
+ (should (equal (time-stamp-string nil ref-time1)
+ (time-stamp-string time-stamp-format ref-time1)))
+ (should (equal (time-stamp-string 'not-a-string ref-time1) nil))))
+
(ert-deftest time-stamp-helper-zone-type-p ()
"Test time-stamp-zone-type-p."
(should (time-stamp-zone-type-p t))
diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el
index c574f3d373b..d3acdef8535 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -1,4 +1,4 @@
-;;; url-auth-tests.el --- Test suite for url-auth.
+;;; url-auth-tests.el --- Test suite for url-auth. -*- lexical-binding:t -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/url/url-expand-tests.el b/test/lisp/url/url-expand-tests.el
index 553bcf67bd2..3b0b6fbd41a 100644
--- a/test/lisp/url/url-expand-tests.el
+++ b/test/lisp/url/url-expand-tests.el
@@ -1,4 +1,4 @@
-;;; url-expand-tests.el --- Test suite for relative URI/URL resolution.
+;;; url-expand-tests.el --- Test suite for relative URI/URL resolution. -*- lexical-binding:t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
@@ -100,6 +100,13 @@
(should (equal (url-expand-file-name "foo#bar" "http://host/foobar") "http://host/foo#bar"))
(should (equal (url-expand-file-name "foo#bar" "http://host/foobar/") "http://host/foobar/foo#bar")))
+(ert-deftest url-expand-file-name/relative-resolution-file-url ()
+ "RFC 3986, Section 5.4 Reference Resolution Examples / Section 5.4.1. Normal Examples"
+ (should (equal (url-expand-file-name "bar.html" "file:///a/b/c/foo.html") "file:///a/b/c/bar.html"))
+ (should (equal (url-expand-file-name "bar.html" "file:///a/b/c/") "file:///a/b/c/bar.html"))
+ (should (equal (url-expand-file-name "../d/bar.html" "file:///a/b/c/") "file:///a/b/d/bar.html"))
+ (should (equal (url-expand-file-name "../d/bar.html" "file:///a/b/c/foo.html") "file:///a/b/d/bar.html")))
+
(provide 'url-expand-tests)
;;; url-expand-tests.el ends here
diff --git a/test/lisp/url/url-future-tests.el b/test/lisp/url/url-future-tests.el
index 2c5d45d62b2..a07730a2be6 100644
--- a/test/lisp/url/url-future-tests.el
+++ b/test/lisp/url/url-future-tests.el
@@ -1,4 +1,4 @@
-;;; url-future-tests.el --- Test suite for url-future.
+;;; url-future-tests.el --- Test suite for url-future. -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
@@ -25,31 +25,33 @@
(require 'ert)
(require 'url-future)
+(defvar url-future-tests--saver)
+
(ert-deftest url-future-tests ()
- (let* (saver
+ (let* (url-future-tests--saver
(text "running future")
(good (make-url-future :value (lambda () (format text))
- :callback (lambda (f) (set 'saver f))))
+ :callback (lambda (f) (set 'url-future-tests--saver f))))
(bad (make-url-future :value (lambda () (/ 1 0))
- :errorback (lambda (&rest d) (set 'saver d))))
+ :errorback (lambda (&rest d) (set 'url-future-tests--saver d))))
(tocancel (make-url-future :value (lambda () (/ 1 0))
- :callback (lambda (f) (set 'saver f))
+ :callback (lambda (f) (set 'url-future-tests--saver f))
:errorback (lambda (&rest d)
- (set 'saver d)))))
+ (set 'url-future-tests--saver d)))))
(should (equal good (url-future-call good)))
- (should (equal good saver))
+ (should (equal good url-future-tests--saver))
(should (equal text (url-future-value good)))
(should (url-future-completed-p good))
(should-error (url-future-call good))
- (setq saver nil)
+ (setq url-future-tests--saver nil)
(should (equal bad (url-future-call bad)))
(should-error (url-future-call bad))
- (should (equal saver (list bad '(arith-error))))
+ (should (equal url-future-tests--saver (list bad '(arith-error))))
(should (url-future-errored-p bad))
- (setq saver nil)
+ (setq url-future-tests--saver nil)
(should (equal (url-future-cancel tocancel) tocancel))
(should-error (url-future-call tocancel))
- (should (null saver))
+ (should (null url-future-tests--saver))
(should (url-future-cancelled-p tocancel))))
(provide 'url-future-tests)
diff --git a/test/lisp/url/url-handlers-test.el b/test/lisp/url/url-handlers-test.el
index bf574fcc1a5..57692e53a70 100644
--- a/test/lisp/url/url-handlers-test.el
+++ b/test/lisp/url/url-handlers-test.el
@@ -4,18 +4,20 @@
;; Author: Nicolas Petton <nicolas@petton.fr>
-;; 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/test/lisp/url/url-parse-tests.el b/test/lisp/url/url-parse-tests.el
index 98e6dcb9aed..6ec46479a6f 100644
--- a/test/lisp/url/url-parse-tests.el
+++ b/test/lisp/url/url-parse-tests.el
@@ -1,4 +1,4 @@
-;;; url-parse-tests.el --- Test suite for URI/URL parsing.
+;;; url-parse-tests.el --- Test suite for URI/URL parsing. -*- lexical-binding:t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/url/url-tramp-tests.el b/test/lisp/url/url-tramp-tests.el
index d6f830afcf2..965b9ea0888 100644
--- a/test/lisp/url/url-tramp-tests.el
+++ b/test/lisp/url/url-tramp-tests.el
@@ -1,4 +1,4 @@
-;;; url-tramp-tests.el --- Test suite for Tramp / URL conversion.
+;;; url-tramp-tests.el --- Test suite for Tramp / URL conversion. -*- lexical-binding:t -*-
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/url/url-util-tests.el b/test/lisp/url/url-util-tests.el
index fd3a8d6e108..0416331b032 100644
--- a/test/lisp/url/url-util-tests.el
+++ b/test/lisp/url/url-util-tests.el
@@ -1,4 +1,4 @@
-;;; url-util-tests.el --- Test suite for url-util.
+;;; url-util-tests.el --- Test suite for url-util. -*- lexical-binding:t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/vc/add-log-tests.el b/test/lisp/vc/add-log-tests.el
index fc928b02c3b..f256945ee42 100644
--- a/test/lisp/vc/add-log-tests.el
+++ b/test/lisp/vc/add-log-tests.el
@@ -1,4 +1,4 @@
-;;; add-log-tests.el --- Test suite for add-log.
+;;; add-log-tests.el --- Test suite for add-log. -*- lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
@@ -25,12 +25,12 @@
(require 'ert)
(require 'add-log)
-(defmacro add-log-current-defun-deftest (name doc major-mode
+(defmacro add-log-current-defun-deftest (name doc mode
content marker expected-defun)
"Generate an ert test for mode-own `add-log-current-defun-function'.
-Run `add-log-current-defun' at the point where MARKER specifies in a
-buffer which content is CONTENT under MAJOR-MODE. Then it compares the
-result with EXPECTED-DEFUN."
+Run `add-log-current-defun' at the point where MARKER specifies
+in a buffer which content is CONTENT under major mode MODE. Then
+it compares the result with EXPECTED-DEFUN."
(let ((xname (intern (concat "add-log-current-defun-test-"
(symbol-name name)
))))
@@ -39,7 +39,7 @@ result with EXPECTED-DEFUN."
(with-temp-buffer
(insert ,content)
(goto-char (point-min))
- (funcall ',major-mode)
+ (funcall ',mode)
(should (equal (when (search-forward ,marker nil t)
(replace-match "" nil t)
(add-log-current-defun))
diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el
index 26e9f26fe24..f17ec3648f1 100644
--- a/test/lisp/vc/diff-mode-tests.el
+++ b/test/lisp/vc/diff-mode-tests.el
@@ -1,3 +1,5 @@
+;;; diff-mode-tests.el --- Tests for diff-mode.el -*- lexical-binding:t -*-
+
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
;; Author: Dima Kogan <dima@secretsauce.net>
@@ -204,6 +206,11 @@ youthfulness
(ert-deftest diff-mode-test-font-lock ()
"Check font-locking of diff hunks."
+ ;; See comments in diff-hunk-file-names about nonascii.
+ ;; In such cases, the diff-font-lock-syntax portion of this fails.
+ :expected-result (if (string-match-p "[[:nonascii:]]"
+ diff-mode-tests--datadir)
+ :failed :passed)
(skip-unless (executable-find shell-file-name))
(skip-unless (executable-find diff-command))
(let ((default-directory diff-mode-tests--datadir)
@@ -242,6 +249,7 @@ youthfulness
111 124 (face diff-context)
124 127 (face diff-context))))
+ ;; Test diff-font-lock-syntax.
(should (equal (mapcar (lambda (o)
(list (- (overlay-start o) diff-beg)
(- (overlay-end o) diff-beg)
@@ -265,6 +273,9 @@ youthfulness
(ert-deftest diff-mode-test-font-lock-syntax-one-line ()
"Check diff syntax highlighting for one line with no newline at end."
+ :expected-result (if (string-match-p "[[:nonascii:]]"
+ diff-mode-tests--datadir)
+ :failed :passed)
(skip-unless (executable-find shell-file-name))
(skip-unless (executable-find diff-command))
(let ((default-directory diff-mode-tests--datadir)
diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el
index ab44e23033c..a3a592bb623 100644
--- a/test/lisp/vc/ediff-ptch-tests.el
+++ b/test/lisp/vc/ediff-ptch-tests.el
@@ -1,4 +1,4 @@
-;;; ediff-ptch-tests.el --- Tests for ediff-ptch.el
+;;; ediff-ptch-tests.el --- Tests for ediff-ptch.el -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/vc/smerge-mode-tests.el b/test/lisp/vc/smerge-mode-tests.el
index c76fc172402..5b15a0931d1 100644
--- a/test/lisp/vc/smerge-mode-tests.el
+++ b/test/lisp/vc/smerge-mode-tests.el
@@ -1,3 +1,5 @@
+;;; smerge-mode-tests.el --- Tests for smerge-mode.el -*- lexical-binding:t -*-
+
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/lisp/vc/vc-bzr-tests.el b/test/lisp/vc/vc-bzr-tests.el
index b68a6945129..408d6e8e23d 100644
--- a/test/lisp/vc/vc-bzr-tests.el
+++ b/test/lisp/vc/vc-bzr-tests.el
@@ -131,7 +131,6 @@
(make-directory bzrdir)
(expand-file-name "foo.el" bzrdir)))
(default-directory (file-name-as-directory bzrdir))
- (generated-autoload-file (expand-file-name "loaddefs.el" bzrdir))
(process-environment (cons (format "HOME=%s" homedir)
process-environment)))
(unwind-protect
@@ -148,7 +147,9 @@
;; causes bzr status to fail. This simulates a broken bzr
;; installation.
(delete-file ".bzr/checkout/dirstate")
- (should (progn (update-directory-autoloads default-directory)
+ (should (progn (make-directory-autoloads
+ default-directory
+ (expand-file-name "loaddefs.el" bzrdir))
t)))
(delete-directory homedir t))))
diff --git a/test/lisp/vc/vc-hg-tests.el b/test/lisp/vc/vc-hg-tests.el
index 01d197574fc..e4a20bbf2da 100644
--- a/test/lisp/vc/vc-hg-tests.el
+++ b/test/lisp/vc/vc-hg-tests.el
@@ -1,4 +1,4 @@
-;;; vc-hg-tests.el --- tests for vc/vc-hg.el
+;;; vc-hg-tests.el --- tests for vc/vc-hg.el -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el
index 43d24486ed1..01d196565dd 100644
--- a/test/lisp/vc/vc-tests.el
+++ b/test/lisp/vc/vc-tests.el
@@ -1,4 +1,4 @@
-;;; vc-tests.el --- Tests of different backends of vc.el
+;;; vc-tests.el --- Tests of different backends of vc.el -*- lexical-binding:t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
@@ -224,11 +224,10 @@ For backends which don't support it, `vc-not-supported' is signaled."
(defmacro vc-test--run-maybe-unsupported-function (func &rest args)
"Run FUNC with ARGS as arguments.
Catch the `vc-not-supported' error."
- `(let (err)
- (condition-case err
- (funcall ,func ,@args)
- (vc-not-supported 'vc-not-supported)
- (t (signal (car err) (cdr err))))))
+ `(condition-case err
+ (funcall ,func ,@args)
+ (vc-not-supported 'vc-not-supported)
+ (t (signal (car err) (cdr err)))))
(defun vc-test--register (backend)
"Register and unregister a file.
@@ -555,7 +554,8 @@ This checks also `vc-backend' and `vc-responsible-backend'."
(defvar vc-svn-program)
(defun vc-test--svn-enabled ()
- (executable-find vc-svn-program))
+ (and (executable-find "svnadmin")
+ (executable-find vc-svn-program)))
(defun vc-test--sccs-enabled ()
(executable-find "sccs"))
diff --git a/test/lisp/version-tests.el b/test/lisp/version-tests.el
new file mode 100644
index 00000000000..8fbd4a19fc5
--- /dev/null
+++ b/test/lisp/version-tests.el
@@ -0,0 +1,31 @@
+;;; version-tests.el --- Tests for version.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest test-emacs-version ()
+ (should (string-match emacs-version (emacs-version)))
+ (should (string-match system-configuration (emacs-version))))
+
+(provide 'version-tests)
+;;; version-tests.el ends here
diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el
index 5b01c54cf24..f876967bf98 100644
--- a/test/lisp/wdired-tests.el
+++ b/test/lisp/wdired-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
+;; 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/>.
;;; Code:
@@ -106,7 +106,6 @@ only the name before the link arrow."
"Test editing a file name without saving the change.
Finding the new name should be possible while still in
wdired-mode."
- :expected-result (if (< emacs-major-version 27) :failed :passed)
(let* ((test-dir (make-temp-file "test-dir-" t))
(test-file (concat (file-name-as-directory test-dir) "foo.c"))
(replace "bar")
@@ -143,6 +142,7 @@ wdired-get-filename before and after editing."
(let* ((test-dir (make-temp-file "test-dir-" t))
(server-socket-dir test-dir)
(dired-listing-switches "-Fl")
+ (dired-ls-F-marks-symlinks (eq system-type 'darwin))
(buf (find-file-noselect test-dir)))
(unwind-protect
(progn
@@ -178,6 +178,22 @@ wdired-get-filename before and after editing."
(server-force-delete)
(delete-directory test-dir t))))
+(ert-deftest wdired-test-bug39280 ()
+ "Test for https://debbugs.gnu.org/39280."
+ (let* ((test-dir (make-temp-file "test-dir" 'dir))
+ (fname "foo")
+ (full-fname (expand-file-name fname test-dir)))
+ (make-empty-file full-fname)
+ (let ((buf (find-file-noselect test-dir)))
+ (unwind-protect
+ (with-current-buffer buf
+ (dired-toggle-read-only)
+ (dolist (old '(t nil))
+ (should (equal fname (wdired-get-filename 'nodir old)))
+ (should (equal full-fname (wdired-get-filename nil old))))
+ (wdired-finish-edit))
+ (if buf (kill-buffer buf))
+ (delete-directory test-dir t)))))
(provide 'wdired-tests)
;;; wdired-tests.el ends here
diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el
index 2ddb656fa9e..df49ffc8224 100644
--- a/test/lisp/wid-edit-tests.el
+++ b/test/lisp/wid-edit-tests.el
@@ -113,4 +113,20 @@
(should (eq (current-column)
(widget-get grandchild :indent)))))))
+(ert-deftest widget-test-character-widget-value ()
+ "Check that we get the character widget's value correctly."
+ (with-temp-buffer
+ (let ((wid (widget-create '(character :value ?\n))))
+ (goto-char (widget-get wid :from))
+ (should (string= (widget-apply wid :value-get) "\n"))
+ (should (char-equal (widget-value wid) ?\n))
+ (should-not (widget-apply wid :validate)))))
+
+(ert-deftest widget-test-editable-field-widget-value ()
+ "Test that we get the editable field widget's value correctly."
+ (with-temp-buffer
+ (let ((wid (widget-create '(editable-field :value ""))))
+ (widget-insert "And some non-widget text.")
+ (should (string= (widget-apply wid :value-get) "")))))
+
;;; wid-edit-tests.el ends here
diff --git a/test/lisp/xml-tests.el b/test/lisp/xml-tests.el
index 895b68f79af..d09336c0080 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.
+;;; xml-parse-tests.el --- Test suite for XML parsing. -*- lexical-binding:t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
@@ -164,6 +164,37 @@ Parser is called with and without 'symbol-qnames argument.")
(should (equal (cdr xml-parse-test--namespace-attribute-qnames)
(xml-parse-region nil nil nil nil 'symbol-qnames)))))
+(ert-deftest xml-print-invalid-cdata ()
+ "Check that Bug#41094 is fixed."
+ (with-temp-buffer
+ (should (equal (should-error (xml-print '((foo () "\0")))
+ :type 'xml-invalid-character)
+ '(xml-invalid-character 0 1)))
+ (should (equal (should-error (xml-print '((foo () "\u00FF \xFF")))
+ :type 'xml-invalid-character)
+ '(xml-invalid-character #x3FFFFF 3)))))
+
+(defvar xml-tests--data-with-comments
+ `(;; simple case
+ ("<?xml version=\"1.0\"?><foo baz=\"true\">bar</foo>"
+ . ((foo ((baz . "true")) "bar")))
+ ;; toplevel comments -- first document child must not get lost
+ (,(concat "<?xml version=\"1.0\"?><foo>bar</foo><!--comment-1-->"
+ "<!--comment-2-->")
+ . ((foo nil "bar")))
+ (,(concat "<?xml version=\"1.0\"?><!--comment-a--><foo a=\"b\">"
+ "<bar>blub</bar></foo><!--comment-b--><!--comment-c-->")
+ . ((foo ((a . "b")) (bar nil "blub")))))
+ "Alist of XML strings and their expected parse trees for discarded comments.")
+
+(ert-deftest xml-remove-comments ()
+ (dolist (test xml-tests--data-with-comments)
+ (erase-buffer)
+ (insert (car test))
+ (xml-remove-comments (point-min) (point-max))
+ (should (equal (cdr test)
+ (xml-parse-region (point-min) (point-max))))))
+
;; Local Variables:
;; no-byte-compile: t
;; End:
diff --git a/test/manual/cedet/cedet-utests.el b/test/manual/cedet/cedet-utests.el
index 124b49907d8..ee6be438dd3 100644
--- a/test/manual/cedet/cedet-utests.el
+++ b/test/manual/cedet/cedet-utests.el
@@ -150,7 +150,7 @@ of just logging the error."
;; Cleanup stray input and events that are in the way.
;; Not doing this causes sit-for to not refresh the screen.
;; Doing this causes the user to need to press keys more frequently.
- (when (and (interactive-p) (input-pending-p))
+ (when (and (called-interactively-p 'interactive) (input-pending-p))
(if (fboundp 'read-event)
(read-event)
(read-char)))
@@ -497,11 +497,11 @@ When optional NO-ERROR don't throw an error if we can't run tests."
(error (concat "Pulse test only works on versions of Emacs"
" that support pulsing")))
;; Run the tests
- (when (interactive-p)
+ (when (called-interactively-p 'interactive)
(message "<Press a key> Pulse one line.")
(read-char))
(pulse-momentary-highlight-one-line (point))
- (when (interactive-p)
+ (when (called-interactively-p 'interactive)
(message "<Press a key> Pulse a region.")
(read-char))
(pulse-momentary-highlight-region (point)
@@ -510,11 +510,11 @@ When optional NO-ERROR don't throw an error if we can't run tests."
(forward-char 30)
(error nil))
(point)))
- (when (interactive-p)
+ (when (called-interactively-p 'interactive)
(message "<Press a key> Pulse line a specific color.")
(read-char))
(pulse-momentary-highlight-one-line (point) 'mode-line)
- (when (interactive-p)
+ (when (called-interactively-p 'interactive)
(message "<Press a key> Pulse a pre-existing overlay.")
(read-char))
(let* ((start (point-at-bol))
@@ -530,7 +530,7 @@ When optional NO-ERROR don't throw an error if we can't run tests."
(delete-overlay o)
(error "Non-temporary overlay was deleted!"))
)
- (when (interactive-p)
+ (when (called-interactively-p 'interactive)
(message "Done!"))))
(provide 'cedet-utests)
diff --git a/test/manual/cedet/semantic-tests.el b/test/manual/cedet/semantic-tests.el
index 53552be06b2..a0899cb9326 100644
--- a/test/manual/cedet/semantic-tests.el
+++ b/test/manual/cedet/semantic-tests.el
@@ -235,7 +235,7 @@ Analyze the area between BEG and END."
(set-buffer buff)
(semantic-lex-spp-write-test)
(kill-buffer buff)
- (when (not (interactive-p))
+ (when (not (called-interactively-p 'interactive))
(kill-buffer "*SPP Write Test*"))
)))
@@ -276,7 +276,7 @@ tag that contains point, and return that."
target (lambda (start end prefix) (setq Lcount (1+ Lcount)))
(semantic-tag-start tag)
(semantic-tag-end tag))
- (when (interactive-p)
+ (when (called-interactively-p 'interactive)
(message "Found %d occurrences of %s in %.2f seconds"
Lcount (semantic-tag-name target)
(semantic-elapsed-time start nil)))
diff --git a/test/manual/etags/c-src/abbrev.c b/test/manual/etags/c-src/abbrev.c
index 03b9f0e65b8..44563d6046a 100644
--- a/test/manual/etags/c-src/abbrev.c
+++ b/test/manual/etags/c-src/abbrev.c
@@ -78,9 +78,6 @@ Lisp_Object Vlast_abbrev_text;
int last_abbrev_point;
-/* Hook to run before expanding any abbrev. */
-
-Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
DEFUN ("make-abbrev-table", Fmake_abbrev_table, Smake_abbrev_table, 0, 0, 0,
"Create a new, empty abbrev table object.")
@@ -232,9 +229,6 @@ Returns the abbrev symbol, if expansion took place.")
value = Qnil;
- if (!NILP (Vrun_hooks))
- call1 (Vrun_hooks, Qpre_abbrev_expand_hook);
-
wordstart = 0;
if (!(BUFFERP (Vabbrev_start_location_buffer)
&& XBUFFER (Vabbrev_start_location_buffer) == current_buffer))
@@ -595,14 +589,6 @@ This causes `save-some-buffers' to offer to save the abbrevs.");
"*Set non-nil means expand multi-word abbrevs all caps if abbrev was so.");
abbrev_all_caps = 0;
- DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook,
- "Function or functions to be called before abbrev expansion is done.\n\
-This is the first thing that `expand-abbrev' does, and so this may change\n\
-the current abbrev table before abbrev lookup happens.");
- Vpre_abbrev_expand_hook = Qnil;
- Qpre_abbrev_expand_hook = intern ("pre-abbrev-expand-hook");
- staticpro (&Qpre_abbrev_expand_hook);
-
defsubr (&Smake_abbrev_table);
defsubr (&Sclear_abbrev_table);
defsubr (&Sdefine_abbrev);
diff --git a/test/manual/etags/c-src/emacs/src/keyboard.c b/test/manual/etags/c-src/emacs/src/keyboard.c
index d4e3848afcc..e869363152b 100644
--- a/test/manual/etags/c-src/emacs/src/keyboard.c
+++ b/test/manual/etags/c-src/emacs/src/keyboard.c
@@ -5754,7 +5754,7 @@ make_lispy_event (struct input_event *event)
ignore_mouse_drag_p = 0;
}
- /* Now we're releasing a button - check the co-ordinates to
+ /* Now we're releasing a button - check the coordinates to
see if this was a click or a drag. */
else if (event->modifiers & up_modifier)
{
diff --git a/test/manual/etags/y-src/parse.c b/test/manual/etags/y-src/parse.c
index e35d862ca5f..0415c4a1180 100644
--- a/test/manual/etags/y-src/parse.c
+++ b/test/manual/etags/y-src/parse.c
@@ -1917,7 +1917,7 @@ yylex FUN0()
}
#ifdef TEST
if(nn==n_usr_funs) {
- io_error_msg("Couln't turn fp into a ##");
+ io_error_msg("Couldn't turn fp into a ##");
parse_error=BAD_FUNC;
return ERROR;
}
diff --git a/test/manual/etags/y-src/parse.y b/test/manual/etags/y-src/parse.y
index 075add2c822..eeef44cc6eb 100644
--- a/test/manual/etags/y-src/parse.y
+++ b/test/manual/etags/y-src/parse.y
@@ -556,7 +556,7 @@ yylex FUN0()
}
#ifdef TEST
if(nn==n_usr_funs) {
- io_error_msg("Couln't turn fp into a ##");
+ io_error_msg("Couldn't turn fp into a ##");
parse_error=BAD_FUNC;
return ERROR;
}
diff --git a/test/manual/image-circular-tests.el b/test/manual/image-circular-tests.el
new file mode 100644
index 00000000000..33ea3ea9547
--- /dev/null
+++ b/test/manual/image-circular-tests.el
@@ -0,0 +1,144 @@
+;;; image-tests.el --- Test suite for image-related functions.
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; Author: Pip Cet <pipcet@gmail.com>
+;; Keywords: internal
+;; Human-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
+;; (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)
+
+(ert-deftest image-test-duplicate-keywords ()
+ "Test that duplicate keywords in an image spec lead to rejection."
+ (should-error (image-size `(image :type xbm :type xbm :width 1 :height 1
+ :data ,(bool-vector t))
+ t)))
+
+(ert-deftest image-test-circular-plist ()
+ "Test that a circular image spec is rejected."
+ (should-error
+ (let ((l `(image :type xbm :width 1 :height 1 :data ,(bool-vector t))))
+ (setcdr (last l) '#1=(:invalid . #1#))
+ (image-size l t))))
+
+(ert-deftest image-test-:type-property-value ()
+ "Test that :type is allowed as a property value in an image spec."
+ (should (equal (image-size `(image :dummy :type :type xbm :width 1 :height 1
+ :data ,(bool-vector t))
+ t)
+ (cons 1 1))))
+
+(ert-deftest image-test-circular-specs ()
+ "Test that circular image spec property values do not cause infinite recursion."
+ (should
+ (let* ((circ1 (cons :dummy nil))
+ (circ2 (cons :dummy nil))
+ (spec1 `(image :type xbm :width 1 :height 1
+ :data ,(bool-vector 1) :ignored ,circ1))
+ (spec2 `(image :type xbm :width 1 :height 1
+ :data ,(bool-vector 1) :ignored ,circ2)))
+ (setcdr circ1 circ1)
+ (setcdr circ2 circ2)
+ (and (equal (image-size spec1 t) (cons 1 1))
+ (equal (image-size spec2 t) (cons 1 1))))))
+
+(provide 'image-tests)
+;;; image-tests.el ends here.
+;;; image-tests.el --- tests for image.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'image)
+(eval-when-compile
+ (require 'cl-lib))
+
+(defconst image-tests--emacs-images-directory
+ (expand-file-name "../etc/images" (getenv "EMACS_TEST_DIRECTORY"))
+ "Directory containing Emacs images.")
+
+(ert-deftest image--set-property ()
+ "Test `image--set-property' behavior."
+ (let ((image (list 'image)))
+ ;; Add properties.
+ (setf (image-property image :scale) 1)
+ (should (equal image '(image :scale 1)))
+ (setf (image-property image :width) 8)
+ (should (equal image '(image :scale 1 :width 8)))
+ (setf (image-property image :height) 16)
+ (should (equal image '(image :scale 1 :width 8 :height 16)))
+ ;; Delete properties.
+ (setf (image-property image :type) nil)
+ (should (equal image '(image :scale 1 :width 8 :height 16)))
+ (setf (image-property image :scale) nil)
+ (should (equal image '(image :width 8 :height 16)))
+ (setf (image-property image :height) nil)
+ (should (equal image '(image :width 8)))
+ (setf (image-property image :width) nil)
+ (should (equal image '(image)))))
+
+(ert-deftest image-type-from-file-header-test ()
+ "Test image-type-from-file-header."
+ (should (eq (if (image-type-available-p 'svg) 'svg)
+ (image-type-from-file-header
+ (expand-file-name "splash.svg"
+ image-tests--emacs-images-directory)))))
+
+(ert-deftest image-rotate ()
+ "Test `image-rotate'."
+ (cl-letf* ((image (list 'image))
+ ((symbol-function 'image--get-imagemagick-and-warn)
+ (lambda () image)))
+ (let ((current-prefix-arg '(4)))
+ (call-interactively #'image-rotate))
+ (should (equal image '(image :rotation 270.0)))
+ (call-interactively #'image-rotate)
+ (should (equal image '(image :rotation 0.0)))
+ (image-rotate)
+ (should (equal image '(image :rotation 90.0)))
+ (image-rotate 0)
+ (should (equal image '(image :rotation 90.0)))
+ (image-rotate 1)
+ (should (equal image '(image :rotation 91.0)))
+ (image-rotate 1234.5)
+ (should (equal image '(image :rotation 245.5)))
+ (image-rotate -154.5)
+ (should (equal image '(image :rotation 91.0)))))
+
+;;; image-tests.el ends here
diff --git a/test/manual/image-size-tests.el b/test/manual/image-size-tests.el
index 67d8f788c8a..159e9025ae3 100644
--- a/test/manual/image-size-tests.el
+++ b/test/manual/image-size-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
+;; 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/>.
;; To test: Load the file and eval (image-size-tests).
;; A non-erroring result is a success.
diff --git a/test/manual/image-transforms-tests.el b/test/manual/image-transforms-tests.el
index 0ebd5c7a195..02607e63676 100644
--- a/test/manual/image-transforms-tests.el
+++ b/test/manual/image-transforms-tests.el
@@ -48,24 +48,24 @@
(let ((image "<svg height='30' width='30'>
<rect x='0' y='0' width='10' height='10'/>
<rect x='10' y='10' width='10' height='10'
- style='fill:none;stroke-width:1;stroke:#000'/>
- <line x1='10' y1='10' x2='20' y2='20' style='stroke:#000'/>
- <line x1='20' y1='10' x2='10' y2='20' style='stroke:#000'/>
+ style='fill:none;stroke-width:1;stroke:currentColor'/>
+ <line x1='10' y1='10' x2='20' y2='20' style='stroke:currentColor'/>
+ <line x1='20' y1='10' x2='10' y2='20' style='stroke:currentColor'/>
<rect x='20' y='20' width='10' height='10'
- style='fill:none;stroke-width:1;stroke:#000'/>
+ style='fill:none;stroke-width:1;stroke:currentColor'/>
</svg>")
(top-left "<svg height='10' width='10'>
<rect x='0' y='0' width='10' height='10'/>
</svg>")
(middle "<svg height='10' width='10'>
<rect x='0' y='0' width='10' height='10'
- style='fill:none;stroke-width:1;stroke:#000'/>
- <line x1='0' y1='0' x2='10' y2='10' style='stroke:#000'/>
- <line x1='10' y1='0' x2='0' y2='10' style='stroke:#000'/>
+ style='fill:none;stroke-width:1;stroke:currentColor'/>
+ <line x1='0' y1='0' x2='10' y2='10' style='stroke:currentColor'/>
+ <line x1='10' y1='0' x2='0' y2='10' style='stroke:currentColor'/>
</svg>")
(bottom-right "<svg height='10' width='10'>
<rect x='0' y='0' width='10' height='10'
- style='fill:none;stroke-width:1;stroke:#000'/>
+ style='fill:none;stroke-width:1;stroke:currentColor'/>
</svg>"))
(insert-header "Test Crop: cropping an image (only works with ImageMagick)")
(insert-test "all params" top-left image '(:crop (10 10 0 0)))
@@ -77,23 +77,23 @@
(defun test-scaling ()
(let ((image "<svg height='10' width='10'>
<rect x='0' y='0' width='10' height='10'
- style='fill:none;stroke-width:1;stroke:#000'/>
- <line x1='0' y1='0' x2='10' y2='10' style='stroke:#000'/>
- <line x1='10' y1='0' x2='0' y2='10' style='stroke:#000'/>
+ style='fill:none;stroke-width:1;stroke:currentColor'/>
+ <line x1='0' y1='0' x2='10' y2='10' style='stroke:currentColor'/>
+ <line x1='10' y1='0' x2='0' y2='10' style='stroke:currentColor'/>
</svg>")
(large "<svg height='20' width='20'>
<rect x='0' y='0' width='20' height='20'
- style='fill:none;stroke-width:2;stroke:#000'/>
+ style='fill:none;stroke-width:2;stroke:currentColor'/>
<line x1='0' y1='0' x2='20' y2='20'
- style='stroke-width:2;stroke:#000'/>
+ style='stroke-width:2;stroke:currentColor'/>
<line x1='20' y1='0' x2='0' y2='20'
- style='stroke-width:2;stroke:#000'/>
+ style='stroke-width:2;stroke:currentColor'/>
</svg>")
(small "<svg height='5' width='5'>
<rect x='0' y='0' width='4' height='4'
- style='fill:none;stroke-width:1;stroke:#000'/>
- <line x1='0' y1='0' x2='4' y2='4' style='stroke:#000'/>
- <line x1='4' y1='0' x2='0' y2='4' style='stroke:#000'/>
+ style='fill:none;stroke-width:1;stroke:currentColor'/>
+ <line x1='0' y1='0' x2='4' y2='4' style='stroke:currentColor'/>
+ <line x1='4' y1='0' x2='0' y2='4' style='stroke:currentColor'/>
</svg>"))
(insert-header "Test Scaling: resize an image (pixelization may occur)")
(insert-test "1x" image image '(:scale 1))
@@ -107,27 +107,27 @@
(defun test-scaling-rotation ()
(let ((image "<svg height='20' width='20'>
<rect x='0' y='0' width='20' height='20'
- style='fill:none;stroke-width:1;stroke:#000'/>
+ style='fill:none;stroke-width:1;stroke:currentColor'/>
<rect x='0' y='0' width='10' height='10'
- style='fill:#000'/>
+ style='fill:currentColor'/>
</svg>")
(x2-90 "<svg height='40' width='40'>
<rect x='0' y='0' width='40' height='40'
- style='fill:none;stroke-width:1;stroke:#000'/>
+ style='fill:none;stroke-width:1;stroke:currentColor'/>
<rect x='20' y='0' width='20' height='20'
- style='fill:#000'/>
+ style='fill:currentColor'/>
</svg>")
(x2--90 "<svg height='40' width='40'>
<rect x='0' y='0' width='40' height='40'
- style='fill:none;stroke-width:1;stroke:#000'/>
+ style='fill:none;stroke-width:1;stroke:currentColor'/>
<rect x='0' y='20' width='20' height='20'
- style='fill:#000'/>
+ style='fill:currentColor'/>
</svg>")
(x0.5-180 "<svg height='10' width='10'>
<rect x='0' y='0' width='10' height='10'
- style='fill:none;stroke-width:1;stroke:#000'/>
+ style='fill:none;stroke-width:1;stroke:currentColor'/>
<rect x='5' y='5' width='5' height='5'
- style='fill:#000'/>
+ style='fill:currentColor'/>
</svg>"))
(insert-header "Test Scaling and Rotation: resize and rotate an image (pixelization may occur)")
(insert-test "1x, 0 degrees" image image '(:scale 1 :rotation 0))
diff --git a/test/manual/indent/less-css-mode.less b/test/manual/indent/less-css-mode.less
index 36c037450cc..b40a2362e28 100644
--- a/test/manual/indent/less-css-mode.less
+++ b/test/manual/indent/less-css-mode.less
@@ -1,3 +1,13 @@
+@var-with-dashes: #428bca;
+@var_with_underscores: 10px;
+@_var-starting-with-underscore: none;
+
+body {
+ background: @var-with-dashes;
+ padding: @var_with_underscores;
+ display: @_var-starting-with-underscore;
+}
+
.desktop-and-old-ie(@rules) {
@media screen and (min-width: 1200) { @rules(); }
html.lt-ie9 & { @rules(); }
diff --git a/test/manual/indent/nxml.xml b/test/manual/indent/nxml.xml
deleted file mode 100644
index 61b84f270b0..00000000000
--- a/test/manual/indent/nxml.xml
+++ /dev/null
@@ -1,10 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<spocosy version="1.0" responsetime="2011-03-15 13:53:12" exec="0.171">
- <!--
- <query-response requestid="" service="objectquery">
- <sport name="Soccer" enetSportCode="s" del="no" n="1" ut="2009-12-29
- 15:36:24" id="1">
- </sport>
- </query-response>
- -->
-</spocosy>
diff --git a/test/manual/indent/opascal.pas b/test/manual/indent/opascal.pas
deleted file mode 100644
index ac4beb3f840..00000000000
--- a/test/manual/indent/opascal.pas
+++ /dev/null
@@ -1,12 +0,0 @@
-{ -*- opascal -*- }
-
-procedure Toto ();
-begin
- for i := 0 to 1 do
- Write (str.Chars[i]);
-
- // bug#36348
- for var i := 0 to 1 do
- Write (str.Chars[i]);
-
-end;
diff --git a/test/manual/indent/ps-mode.ps b/test/manual/indent/ps-mode.ps
deleted file mode 100644
index 4b4ee0f10cb..00000000000
--- a/test/manual/indent/ps-mode.ps
+++ /dev/null
@@ -1,14 +0,0 @@
-%!PS-2.0
-
-<< 23 45 >> %dictionary
-< 23 > %hex string
-<~a>a%a~> %base85 string
-(%)s
-(sf\(g>a)sdg)
-
-/foo {
- <<
- hello 2
- 3
- >>
-} def
diff --git a/test/manual/indent/scheme.scm b/test/manual/indent/scheme.scm
deleted file mode 100644
index 84d0f6d8786..00000000000
--- a/test/manual/indent/scheme.scm
+++ /dev/null
@@ -1,9 +0,0 @@
-#!/usr/bin/scheme is this a comment?
-
-;; This one is a comment
-(a)
-#| and this one as #|well|# as this! |#
-(b)
-(cons #;(this is a
- comment)
- head tail)
diff --git a/test/manual/indent/scss-mode.scss b/test/manual/indent/scss-mode.scss
index a3dd41eeb47..189ec4e22ac 100644
--- a/test/manual/indent/scss-mode.scss
+++ b/test/manual/indent/scss-mode.scss
@@ -41,9 +41,13 @@ p.#{$name} var
article[role="main"] {
$toto: 500 !global;
$var-with-default: 300 !default;
+ $var_with_underscores: #fff;
+ $_var-starting-with-underscore: none;
float: left !important;
width: 600px / 888px * 100%;
height: 100px / 888px * 100%;
+ color: $var_with_underscores;
+ display: $_var-starting-with-underscore;
}
%placeholder {
diff --git a/test/manual/scroll-tests.el b/test/manual/scroll-tests.el
index 96a419a29d9..937e0b12799 100644
--- a/test/manual/scroll-tests.el
+++ b/test/manual/scroll-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
+;; 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/test/src/alloc-tests.el b/test/src/alloc-tests.el
index 4eb776a0555..aa1ab1648f8 100644
--- a/test/src/alloc-tests.el
+++ b/test/src/alloc-tests.el
@@ -51,3 +51,10 @@
(should-not (eq x y))
(dotimes (i 4)
(should (eql (aref x i) (aref y i))))))
+
+;; Bug#39207
+(ert-deftest aset-nbytes-change ()
+ (let ((s (make-string 1 ?a)))
+ (dolist (c (list 10003 ?b 128 ?c ?d (max-char) ?e))
+ (aset s 0 c)
+ (should (equal s (make-string 1 c))))))
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 60d29dd3a12..0db66f97517 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -1314,4 +1314,24 @@ with parameters from the *Messages* buffer modification."
(ovshould nonempty-eob-end 4 5)
(ovshould empty-eob 5 5)))))
+(ert-deftest buffer-multibyte-overlong-sequences ()
+ (dolist (uni '("\xE0\x80\x80"
+ "\xF0\x80\x80\x80"
+ "\xF8\x8F\xBF\xBF\x80"))
+ (let ((multi (string-to-multibyte uni)))
+ (should
+ (string-equal
+ multi
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert uni)
+ (set-buffer-multibyte t)
+ (buffer-string)))))))
+
+;; https://debbugs.gnu.org/33492
+(ert-deftest buffer-tests-buffer-local-variables-undo ()
+ "Test that `buffer-undo-list' appears in `buffer-local-variables'."
+ (with-temp-buffer
+ (should (assq 'buffer-undo-list (buffer-local-variables)))))
+
;;; buffer-tests.el ends here
diff --git a/test/src/callint-tests.el b/test/src/callint-tests.el
index c2010ae31d3..42dae424476 100644
--- a/test/src/callint-tests.el
+++ b/test/src/callint-tests.el
@@ -29,7 +29,8 @@
(ert-deftest call-interactively/incomplete-multibyte-sequence ()
"Check that Bug#30004 is fixed."
- (let ((data (should-error (call-interactively (lambda () (interactive "\xFF"))))))
+ (let* ((text-quoting-style 'grave)
+ (data (should-error (call-interactively (lambda () (interactive "\xFF"))))))
(should
(equal
(cdr data)
diff --git a/test/src/callproc-tests.el b/test/src/callproc-tests.el
index 39d2014488a..1617d5e33d3 100644
--- a/test/src/callproc-tests.el
+++ b/test/src/callproc-tests.el
@@ -17,6 +17,11 @@
;; 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/callproc.c.
+
;;; Code:
(require 'ert)
@@ -60,3 +65,15 @@
(call-process "c:/nul.exe")
(error :got-error))))
(should have-called-debugger)))
+
+(ert-deftest call-process-region-entire-buffer-with-delete ()
+ "Check that Bug#40576 is fixed."
+ (let ((emacs (expand-file-name invocation-name invocation-directory)))
+ (skip-unless (file-executable-p emacs))
+ (with-temp-buffer
+ (insert "Buffer contents\n")
+ (should
+ (eq (call-process-region nil nil emacs :delete nil nil "--version") 0))
+ (should (eq (buffer-size) 0)))))
+
+;;; callproc-tests.el ends here
diff --git a/test/src/charset-tests.el b/test/src/charset-tests.el
index 01a68c21a52..86a0d6ffc1a 100644
--- a/test/src/charset-tests.el
+++ b/test/src/charset-tests.el
@@ -1,19 +1,21 @@
-;;; charset-tests.el --- Tests for charset.c
+;;; charset-tests.el --- Tests for charset.c -*- lexical-binding: t -*-
;; Copyright 2017-2020 Free Software Foundation, Inc.
-;; 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/>.
;;; Code:
diff --git a/test/src/chartab-tests.el b/test/src/chartab-tests.el
index da320e33b51..4d52dc367c8 100644
--- a/test/src/chartab-tests.el
+++ b/test/src/chartab-tests.el
@@ -1,21 +1,23 @@
-;;; chartab-tests.el --- Tests for char-tab.c
+;;; chartab-tests.el --- Tests for char-tab.c -*- lexical-binding: t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
;; Author: Eli Zaretskii <eliz@gnu.org>
-;; 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/>.
;;; Code:
diff --git a/test/src/cmds-tests.el b/test/src/cmds-tests.el
index 8604d346109..302b00c6760 100644
--- a/test/src/cmds-tests.el
+++ b/test/src/cmds-tests.el
@@ -1,22 +1,24 @@
-;;; cmds-tests.el --- Testing some Emacs commands
+;;; cmds-tests.el --- Testing some Emacs commands -*- lexical-binding: t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
;; Author: Nicolas Richard <youngfrog@members.fsf.org>
;; 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 <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el
index 899025b4c91..82883a045c8 100644
--- a/test/src/coding-tests.el
+++ b/test/src/coding-tests.el
@@ -1,4 +1,4 @@
-;;; coding-tests.el --- tests for text encoding and decoding
+;;; coding-tests.el --- tests for text encoding and decoding -*- lexical-binding: t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
@@ -296,7 +296,7 @@
;;; decoder, not for regression testing.
(defun generate-ascii-file ()
- (dotimes (i 100000)
+ (dotimes (_i 100000)
(insert-char ?a 80)
(insert "\n")))
@@ -309,13 +309,13 @@
(insert "\n")))
(defun generate-mostly-nonascii-file ()
- (dotimes (i 30000)
+ (dotimes (_i 30000)
(insert-char ?a 80)
(insert "\n"))
- (dotimes (i 20000)
+ (dotimes (_i 20000)
(insert-char ?À 80)
(insert "\n"))
- (dotimes (i 10000)
+ (dotimes (_i 10000)
(insert-char ?あ 80)
(insert "\n")))
@@ -375,6 +375,60 @@
(with-temp-buffer (insert-file-contents (car file))))))
(insert (format "%s: %s\n" (car file) result)))))))
+(ert-deftest coding-nocopy-trivial ()
+ "Check that the NOCOPY parameter works for the trivial coding system."
+ (let ((s "abc"))
+ (should-not (eq (decode-coding-string s nil nil) s))
+ (should (eq (decode-coding-string s nil t) s))
+ (should-not (eq (encode-coding-string s nil nil) s))
+ (should (eq (encode-coding-string s nil t) s))))
+
+(ert-deftest coding-nocopy-ascii ()
+ "Check that the NOCOPY parameter works for ASCII-only strings."
+ (let* ((uni (apply #'string (number-sequence 0 127)))
+ (multi (string-to-multibyte uni)))
+ (dolist (s (list uni multi))
+ ;; Encodings without EOL conversion.
+ (dolist (coding '(us-ascii-unix iso-latin-1-unix utf-8-unix))
+ (should-not (eq (decode-coding-string s coding nil) s))
+ (should-not (eq (encode-coding-string s coding nil) s))
+ (should (eq (decode-coding-string s coding t) s))
+ (should (eq (encode-coding-string s coding t) s))
+ (should (eq last-coding-system-used coding)))
+
+ ;; With EOL conversion inhibited.
+ (let ((inhibit-eol-conversion t))
+ (dolist (coding '(us-ascii iso-latin-1 utf-8))
+ (should-not (eq (decode-coding-string s coding nil) s))
+ (should-not (eq (encode-coding-string s coding nil) s))
+ (should (eq (decode-coding-string s coding t) s))
+ (should (eq (encode-coding-string s coding t) s))))))
+
+ ;; Check identity decoding with EOL conversion for ASCII except CR.
+ (let* ((uni (apply #'string (delq ?\r (number-sequence 0 127))))
+ (multi (string-to-multibyte uni)))
+ (dolist (s (list uni multi))
+ (dolist (coding '(us-ascii-dos iso-latin-1-dos utf-8-dos mac-roman-mac))
+ (should-not (eq (decode-coding-string s coding nil) s))
+ (should (eq (decode-coding-string s coding t) s)))))
+
+ ;; Check identity encoding with EOL conversion for ASCII except LF.
+ (let* ((uni (apply #'string (delq ?\n (number-sequence 0 127))))
+ (multi (string-to-multibyte uni)))
+ (dolist (s (list uni multi))
+ (dolist (coding '(us-ascii-dos iso-latin-1-dos utf-8-dos mac-roman-mac))
+ (should-not (eq (encode-coding-string s coding nil) s))
+ (should (eq (encode-coding-string s coding t) s))))))
+
+
+(ert-deftest coding-check-coding-systems-region ()
+ (should (equal (check-coding-systems-region "aå" nil '(utf-8))
+ nil))
+ (should (equal (check-coding-systems-region "aåbγc" nil
+ '(utf-8 iso-latin-1 us-ascii))
+ '((iso-latin-1 3) (us-ascii 1 3))))
+ (should-error (check-coding-systems-region "å" nil '(bad-coding-system))))
+
;; Local Variables:
;; byte-compile-warnings: (not obsolete)
;; End:
diff --git a/test/src/decompress-tests.el b/test/src/decompress-tests.el
index 46fd26635c9..0a328396818 100644
--- a/test/src/decompress-tests.el
+++ b/test/src/decompress-tests.el
@@ -1,4 +1,4 @@
-;;; decompress-tests.el --- Test suite for decompress.
+;;; decompress-tests.el --- Test suite for decompress. -*- lexical-binding: t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
diff --git a/test/src/doc-tests.el b/test/src/doc-tests.el
index b6026e79c65..797b9ba5480 100644
--- a/test/src/doc-tests.el
+++ b/test/src/doc-tests.el
@@ -1,21 +1,23 @@
-;;; doc-tests.el --- Tests for doc.c
+;;; doc-tests.el --- Tests for doc.c -*- lexical-binding: t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
;; Author: Eli Zaretskii <eliz@gnu.org>
-;; 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/>.
;;; Code:
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index 18f76afca91..de0aeabfe78 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -1,21 +1,21 @@
-;;; editfns-tests.el -- tests for editfns.c
+;;; editfns-tests.el -- tests for editfns.c -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
;; 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/>.
;;; Code:
@@ -124,8 +124,8 @@
"Validate character position to byte position translation."
(let ((bytes '()))
(dotimes (pos len)
- (setq bytes (add-to-list 'bytes (position-bytes (1+ pos)) t)))
- bytes))
+ (push (position-bytes (1+ pos)) bytes))
+ (nreverse bytes)))
(ert-deftest transpose-ascii-regions-test ()
(with-temp-buffer
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 9df0b25a0c5..1eebb418cf3 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -24,6 +24,7 @@
;; module in test/data/emacs-module.
;;; Code:
+;;; Prelude
(require 'cl-lib)
(require 'ert)
@@ -48,9 +49,7 @@
(cl-defmethod emacs-module-tests--generic ((_ user-ptr))
'user-ptr)
-;;
-;; Basic tests.
-;;
+;;; Basic tests
(ert-deftest mod-test-sum-test ()
(should (= (mod-test-sum 1 2) 3))
@@ -60,8 +59,9 @@
(should (eq 0
(string-match
(concat "#<module function "
- "\\(at \\(0x\\)?[[:xdigit:]]+\\( from .*\\)?"
- "\\|Fmod_test_sum from .*\\)>")
+ "\\(at \\(0x\\)?[[:xdigit:]]+ "
+ "with data 0x1234\\( from .*\\)?"
+ "\\|Fmod_test_sum with data 0x1234 from .*\\)>")
(prin1-to-string (nth 1 descr)))))
(should (= (nth 2 descr) 3)))
(should-error (mod-test-sum "1" 2) :type 'wrong-type-argument)
@@ -97,13 +97,12 @@ changes."
(rx bos "#<module function "
(or "Fmod_test_sum"
(and "at 0x" (+ hex-digit)))
+ " with data 0x1234"
(? " from " (* nonl) "mod-test" (* nonl) )
">" eos)
(prin1-to-string func)))))
-;;
-;; Non-local exists (throw, signal).
-;;
+;;; Non-local exists (throw, signal)
(ert-deftest mod-test-non-local-exit-signal-test ()
(should-error (mod-test-signal))
@@ -140,9 +139,7 @@ changes."
(should (equal (mod-test-non-local-exit-funcall (lambda () (throw 'tag 32)))
'(throw tag 32))))
-;;
-;; String tests.
-;;
+;;; String tests
(defun multiply-string (s n)
"Return N copies of S concatenated together."
@@ -166,9 +163,7 @@ changes."
(ert-deftest mod-test-string-a-to-b-test ()
(should (string= (mod-test-string-a-to-b "aaa") "bbb")))
-;;
-;; User-pointer tests.
-;;
+;;; User-pointer tests
(ert-deftest mod-test-userptr-fun-test ()
(let* ((n 42)
@@ -182,9 +177,7 @@ changes."
;; TODO: try to test finalizer
-;;
-;; Vector tests.
-;;
+;;; Vector tests
(ert-deftest mod-test-vector-test ()
(dolist (s '(2 10 100 1000))
@@ -316,7 +309,8 @@ local reference."
(ert-deftest module/describe-function-1 ()
"Check that Bug#30163 is fixed."
(with-temp-buffer
- (let ((standard-output (current-buffer)))
+ (let ((standard-output (current-buffer))
+ (text-quoting-style 'grave))
(describe-function-1 #'mod-test-sum)
(goto-char (point-min))
(while (re-search-forward "`[^']*/data/emacs-module/" nil t)
@@ -419,4 +413,91 @@ Interactively, you can try hitting \\[keyboard-quit] to quit."
(ert-info ((format "input: %d" input))
(should (= (mod-test-double input) (* 2 input))))))
+(ert-deftest module-darwin-secondary-suffix ()
+ "Check that on Darwin, both .so and .dylib suffixes work.
+See Bug#36226."
+ (skip-unless (eq system-type 'darwin))
+ (should (member ".dylib" load-suffixes))
+ (should (member ".so" load-suffixes))
+ ;; Preserve the old `load-history'. This is needed for some of the
+ ;; other unit tests that indirectly rely on `load-history'.
+ (let ((load-history load-history)
+ (dylib (concat mod-test-file ".dylib"))
+ (so (concat mod-test-file ".so")))
+ (should (file-regular-p dylib))
+ (should-not (file-exists-p so))
+ (add-name-to-file dylib so)
+ (unwind-protect
+ (load so nil nil :nosuffix :must-suffix)
+ (delete-file so))))
+
+(ert-deftest module/function-finalizer ()
+ "Test that module function finalizers are properly called."
+ ;; We create and leak a couple of module functions with attached
+ ;; finalizer. Creating only one function risks spilling it to the
+ ;; stack, where it wouldn't be garbage-collected. However, with one
+ ;; hundred functions, there should be at least one that's
+ ;; unreachable.
+ (dotimes (_ 100)
+ (mod-test-make-function-with-finalizer))
+ (cl-destructuring-bind (valid-before invalid-before)
+ (mod-test-function-finalizer-calls)
+ (should (zerop invalid-before))
+ (garbage-collect)
+ (cl-destructuring-bind (valid-after invalid-after)
+ (mod-test-function-finalizer-calls)
+ (should (zerop invalid-after))
+ ;; We don't require exactly 100 invocations of the finalizer,
+ ;; but at least one.
+ (should (> valid-after valid-before)))))
+
+(ert-deftest module/async-pipe ()
+ "Check that writing data from another thread works."
+ (skip-unless (not (eq system-type 'windows-nt))) ; FIXME!
+ (with-temp-buffer
+ (let ((process (make-pipe-process :name "module/async-pipe"
+ :buffer (current-buffer)
+ :coding 'utf-8-unix
+ :noquery t)))
+ (unwind-protect
+ (progn
+ (mod-test-async-pipe process)
+ (should (accept-process-output process 1))
+ ;; The string below must be identical to what
+ ;; mod-test.c:write_to_pipe produces.
+ (should (equal (buffer-string) "data from thread")))
+ (delete-process process)))))
+
+(ert-deftest module/interactive/return-t ()
+ (should (functionp (symbol-function #'mod-test-return-t)))
+ (should (module-function-p (symbol-function #'mod-test-return-t)))
+ (should-not (commandp #'mod-test-return-t))
+ (should-not (commandp (symbol-function #'mod-test-return-t)))
+ (should-not (interactive-form #'mod-test-return-t))
+ (should-not (interactive-form (symbol-function #'mod-test-return-t)))
+ (should-error (call-interactively #'mod-test-return-t)
+ :type 'wrong-type-argument))
+
+(ert-deftest module/interactive/return-t-int ()
+ (should (functionp (symbol-function #'mod-test-return-t-int)))
+ (should (module-function-p (symbol-function #'mod-test-return-t-int)))
+ (should (commandp #'mod-test-return-t-int))
+ (should (commandp (symbol-function #'mod-test-return-t-int)))
+ (should (equal (interactive-form #'mod-test-return-t-int) '(interactive)))
+ (should (equal (interactive-form (symbol-function #'mod-test-return-t-int))
+ '(interactive)))
+ (should (eq (mod-test-return-t-int) t))
+ (should (eq (call-interactively #'mod-test-return-t-int) t)))
+
+(ert-deftest module/interactive/identity ()
+ (should (functionp (symbol-function #'mod-test-identity)))
+ (should (module-function-p (symbol-function #'mod-test-identity)))
+ (should (commandp #'mod-test-identity))
+ (should (commandp (symbol-function #'mod-test-identity)))
+ (should (equal (interactive-form #'mod-test-identity) '(interactive "i")))
+ (should (equal (interactive-form (symbol-function #'mod-test-identity))
+ '(interactive "i")))
+ (should (eq (mod-test-identity 123) 123))
+ (should-not (call-interactively #'mod-test-identity)))
+
;;; emacs-module-tests.el ends here
diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el
index 96b03a01372..ed381d151ee 100644
--- a/test/src/fileio-tests.el
+++ b/test/src/fileio-tests.el
@@ -98,15 +98,14 @@ Also check that an encoding error can appear in a symlink."
(ert-deftest fileio-tests--relative-HOME ()
"Test that expand-file-name works even when HOME is relative."
- (let ((old-home (getenv "HOME")))
+ (let ((process-environment (copy-sequence process-environment)))
(setenv "HOME" "a/b/c")
(should (equal (expand-file-name "~/foo")
(expand-file-name "a/b/c/foo")))
(when (memq system-type '(ms-dos windows-nt))
;; Test expansion of drive-relative file names.
(setenv "HOME" "x:foo")
- (should (equal (expand-file-name "~/bar") "x:/foo/bar")))
- (setenv "HOME" old-home)))
+ (should (equal (expand-file-name "~/bar") "x:/foo/bar")))))
(ert-deftest fileio-tests--insert-file-interrupt ()
(let ((text "-*- coding: binary -*-\n\xc3\xc3help")
diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el
index c1c2c8996a7..8c56674d4fd 100644
--- a/test/src/floatfns-tests.el
+++ b/test/src/floatfns-tests.el
@@ -1,4 +1,4 @@
-;;; floatfns-tests.el --- tests for floating point operations
+;;; floatfns-tests.el --- tests for floating point operations -*- lexical-binding: t -*-
;; Copyright 2017-2020 Free Software Foundation, Inc.
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 60be2c6c2d7..d3c22f966e6 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -1,4 +1,4 @@
-;;; fns-tests.el --- tests for src/fns.c
+;;; fns-tests.el --- tests for src/fns.c -*- lexical-binding:t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
@@ -49,21 +49,21 @@
(should-error (nreverse))
(should-error (nreverse 1))
(should-error (nreverse (make-char-table 'foo)))
- (should (equal (nreverse "xyzzy") "yzzyx"))
- (let ((A []))
+ (should (equal (nreverse (copy-sequence "xyzzy")) "yzzyx"))
+ (let ((A (vector)))
(nreverse A)
(should (equal A [])))
- (let ((A [0]))
+ (let ((A (vector 0)))
(nreverse A)
(should (equal A [0])))
- (let ((A [1 2 3 4]))
+ (let ((A (vector 1 2 3 4)))
(nreverse A)
(should (equal A [4 3 2 1])))
- (let ((A [1 2 3 4]))
+ (let ((A (vector 1 2 3 4)))
(nreverse A)
(nreverse A)
(should (equal A [1 2 3 4])))
- (let* ((A [1 2 3 4])
+ (let* ((A (vector 1 2 3 4))
(B (nreverse (nreverse A))))
(should (equal A B))))
@@ -146,13 +146,13 @@
;; Invalid UTF-8 sequences shall be indicated. How to create such strings?
(ert-deftest fns-tests-sort ()
- (should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
+ (should (equal (sort (list 9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
'(-1 2 3 4 5 5 7 8 9)))
- (should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
+ (should (equal (sort (list 9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
'(9 8 7 5 5 4 3 2 -1)))
- (should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (< x y)))
+ (should (equal (sort (vector 9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
[-1 2 3 4 5 5 7 8 9]))
- (should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (> x y)))
+ (should (equal (sort (vector 9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
[9 8 7 5 5 4 3 2 -1]))
(should (equal
(sort
@@ -166,13 +166,15 @@
(should (equal (should-error (sort "cba" #'<) :type 'wrong-type-argument)
'(wrong-type-argument list-or-vector-p "cba"))))
+(defvar w32-collate-ignore-punctuation)
+
(ert-deftest fns-tests-collate-sort ()
(skip-unless (fns-tests--collate-enabled-p))
;; Punctuation and whitespace characters are relevant for POSIX.
(should
(equal
- (sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
+ (sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
(lambda (a b) (string-collate-lessp a b "POSIX")))
'("1 1" "1 2" "1.1" "1.2" "11" "12")))
;; Punctuation and whitespace characters are not taken into account
@@ -180,7 +182,7 @@
(when (eq system-type 'windows-nt)
(should
(equal
- (sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
+ (sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
(lambda (a b)
(let ((w32-collate-ignore-punctuation t))
(string-collate-lessp
@@ -190,7 +192,7 @@
;; Diacritics are different letters for POSIX, they sort lexicographical.
(should
(equal
- (sort '("Ævar" "Agustín" "Adrian" "Eli")
+ (sort (list "Ævar" "Agustín" "Adrian" "Eli")
(lambda (a b) (string-collate-lessp a b "POSIX")))
'("Adrian" "Agustín" "Eli" "Ævar")))
;; Diacritics are sorted between similar letters for other locales,
@@ -198,7 +200,7 @@
(when (eq system-type 'windows-nt)
(should
(equal
- (sort '("Ævar" "Agustín" "Adrian" "Eli")
+ (sort (list "Ævar" "Agustín" "Adrian" "Eli")
(lambda (a b)
(let ((w32-collate-ignore-punctuation t))
(string-collate-lessp
@@ -212,7 +214,7 @@
(should (not (string-version-lessp "foo20000.png" "foo12.png")))
(should (string-version-lessp "foo.png" "foo2.png"))
(should (not (string-version-lessp "foo2.png" "foo.png")))
- (should (equal (sort '("foo12.png" "foo2.png" "foo1.png")
+ (should (equal (sort (list "foo12.png" "foo2.png" "foo1.png")
'string-version-lessp)
'("foo1.png" "foo2.png" "foo12.png")))
(should (string-version-lessp "foo2" "foo1234"))
@@ -228,9 +230,9 @@
(should (equal (func-arity 'format) '(1 . many)))
(require 'info)
(should (equal (func-arity 'Info-goto-node) '(1 . 3)))
- (should (equal (func-arity (lambda (&rest x))) '(0 . many)))
- (should (equal (func-arity (eval (lambda (x &optional y)) nil)) '(1 . 2)))
- (should (equal (func-arity (eval (lambda (x &optional y)) t)) '(1 . 2)))
+ (should (equal (func-arity (lambda (&rest _x))) '(0 . many)))
+ (should (equal (func-arity (eval '(lambda (_x &optional y)) nil)) '(1 . 2)))
+ (should (equal (func-arity (eval '(lambda (_x &optional y)) t)) '(1 . 2)))
(should (equal (func-arity 'let) '(1 . unevalled))))
(defun fns-tests--string-repeat (s o)
@@ -432,9 +434,9 @@
(should-error (mapcan))
(should-error (mapcan #'identity))
(should-error (mapcan #'identity (make-char-table 'foo)))
- (should (equal (mapcan #'list '(1 2 3)) '(1 2 3)))
+ (should (equal (mapcan #'list (list 1 2 3)) '(1 2 3)))
;; `mapcan' is destructive
- (let ((data '((foo) (bar))))
+ (let ((data (list (list 'foo) (list 'bar))))
(should (equal (mapcan #'identity data) '(foo bar)))
(should (equal data '((foo bar) (bar))))))
@@ -858,6 +860,22 @@
(puthash k k h)))
(should (= 100 (hash-table-count h)))))
+(ert-deftest test-sxhash-equal ()
+ (should (= (sxhash-equal (* most-positive-fixnum most-negative-fixnum))
+ (sxhash-equal (* most-positive-fixnum most-negative-fixnum))))
+ (should (= (sxhash-equal (make-string 1000 ?a))
+ (sxhash-equal (make-string 1000 ?a))))
+ (should (= (sxhash-equal (point-marker))
+ (sxhash-equal (point-marker))))
+ (should (= (sxhash-equal (make-vector 1000 (make-string 10 ?a)))
+ (sxhash-equal (make-vector 1000 (make-string 10 ?a)))))
+ (should (= (sxhash-equal (make-bool-vector 1000 t))
+ (sxhash-equal (make-bool-vector 1000 t))))
+ (should (= (sxhash-equal (make-char-table nil (make-string 10 ?a)))
+ (sxhash-equal (make-char-table nil (make-string 10 ?a)))))
+ (should (= (sxhash-equal (record 'a (make-string 10 ?a)))
+ (sxhash-equal (record 'a (make-string 10 ?a))))))
+
(ert-deftest test-secure-hash ()
(should (equal (secure-hash 'md5 "foobar")
"3858f62230ac3c915f300c664312c63f"))
@@ -874,6 +892,87 @@
(should (equal (secure-hash 'sha512 "foobar")
(concat "0a50261ebd1a390fed2bf326f2673c145582a6342d5"
"23204973d0219337f81616a8069b012587cf5635f69"
- "25f1b56c360230c19b273500ee013e030601bf2425"))))
+ "25f1b56c360230c19b273500ee013e030601bf2425")))
+ ;; Test that a call to getrandom returns the right format.
+ ;; This does not test randomness; it's merely a format check.
+ (should (string-match "\\`[0-9a-f]\\{128\\}\\'"
+ (secure-hash 'sha512 'iv-auto 100))))
+
+(ert-deftest test-vector-delete ()
+ (let ((v1 (make-vector 1000 1)))
+ (should (equal (delete t [nil t]) [nil]))
+ (should (equal (delete 1 v1) (vector)))
+ (should (equal (delete 2 v1) v1))))
+
+(ert-deftest string-search ()
+ (should (equal (string-search "zot" "foobarzot") 6))
+ (should (equal (string-search "foo" "foobarzot") 0))
+ (should (not (string-search "fooz" "foobarzot")))
+ (should (not (string-search "zot" "foobarzo")))
+ (should (equal (string-search "ab" "ab") 0))
+ (should (equal (string-search "ab\0" "ab") nil))
+ (should (equal (string-search "ab" "abababab" 3) 4))
+ (should (equal (string-search "ab" "ababac" 3) nil))
+ (should (equal (string-search "aaa" "aa") nil))
+ (let ((case-fold-search t))
+ (should (equal (string-search "ab" "AB") nil)))
-(provide 'fns-tests)
+ (should (equal
+ (string-search (make-string 2 130)
+ (concat "helló" (make-string 5 130 t) "bár"))
+ 5))
+ (should (equal
+ (string-search (make-string 2 127)
+ (concat "helló" (make-string 5 127 t) "bár"))
+ 5))
+
+ (should (equal (string-search "\377" "a\377ø") 1))
+ (should (equal (string-search "\377" "a\377a") 1))
+
+ (should (not (string-search (make-string 1 255) "a\377ø")))
+ (should (not (string-search (make-string 1 255) "a\377a")))
+
+ (should (equal (string-search "fóo" "zotfóo") 3))
+
+ (should (equal (string-search (string-to-multibyte "\377") "ab\377c") 2))
+ (should (equal (string-search "\303" "aøb") nil))
+ (should (equal (string-search "\270" "aøb") nil))
+ (should (equal (string-search "ø" "\303\270") nil))
+
+ (should (equal (string-search "a\U00010f98z" "a\U00010f98a\U00010f98z") 2))
+
+ (should-error (string-search "a" "abc" -1))
+ (should-error (string-search "a" "abc" 4))
+ (should-error (string-search "a" "abc" 100000000000))
+
+ (should (equal (string-search "a" "aaa" 3) nil))
+ (should (equal (string-search "aa" "aa" 1) nil))
+ (should (equal (string-search "\0" "") nil))
+
+ (should (equal (string-search "" "") 0))
+ (should-error (string-search "" "" 1))
+ (should (equal (string-search "" "abc") 0))
+ (should (equal (string-search "" "abc" 2) 2))
+ (should (equal (string-search "" "abc" 3) 3))
+ (should-error (string-search "" "abc" 4))
+ (should-error (string-search "" "abc" -1))
+
+ (should-not (string-search "ø" "foo\303\270"))
+ (should-not (string-search "\303\270" "ø"))
+ (should-not (string-search "\370" "ø"))
+ (should-not (string-search (string-to-multibyte "\370") "ø"))
+ (should-not (string-search "ø" "\370"))
+ (should-not (string-search "ø" (string-to-multibyte "\370")))
+ (should-not (string-search "\303\270" "\370"))
+ (should-not (string-search (string-to-multibyte "\303\270") "\370"))
+ (should-not (string-search "\303\270" (string-to-multibyte "\370")))
+ (should-not (string-search (string-to-multibyte "\303\270")
+ (string-to-multibyte "\370")))
+ (should-not (string-search "\370" "\303\270"))
+ (should-not (string-search (string-to-multibyte "\370") "\303\270"))
+ (should-not (string-search "\370" (string-to-multibyte "\303\270")))
+ (should-not (string-search (string-to-multibyte "\370")
+ (string-to-multibyte "\303\270")))
+ (should (equal (string-search (string-to-multibyte "o\303\270") "foo\303\270")
+ 2))
+ (should (equal (string-search "\303\270" "foo\303\270") 3)))
diff --git a/test/src/font-tests.el b/test/src/font-tests.el
index 73c2846b032..cfc6f4c31b7 100644
--- a/test/src/font-tests.el
+++ b/test/src/font-tests.el
@@ -1,4 +1,4 @@
-;;; font-tests.el --- Test suite for font-related functions.
+;;; font-tests.el --- Test suite for font-related functions. -*- lexical-binding: t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
diff --git a/test/src/indent-tests.el b/test/src/indent-tests.el
new file mode 100644
index 00000000000..7d1a6ce6dc3
--- /dev/null
+++ b/test/src/indent-tests.el
@@ -0,0 +1,59 @@
+;;; indent-tests.el --- tests for src/indent.c -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+
+;;; Commentary:
+
+;;; Code:
+
+(ert-deftest indent-tests-move-to-column-invis-1tab ()
+ "Test `move-to-column' when a TAB is followed by invisible text."
+ (should
+ (string=
+ (with-temp-buffer
+ (insert "\tLine starting with INVISIBLE text after TAB\n")
+ (add-text-properties 2 21 '(invisible t))
+ (goto-char (point-min))
+ (move-to-column 7 t)
+ (buffer-substring-no-properties 1 8))
+ " ")))
+
+(ert-deftest indent-tests-move-to-column-invis-2tabs ()
+ "Test `move-to-column' when 2 TABs are followed by invisible text."
+ (should
+ (string=
+ (with-temp-buffer
+ (insert "\t\tLine starting with INVISIBLE text after TAB\n")
+ (add-text-properties 3 22 '(invisible t))
+ (goto-char (point-min))
+ (move-to-column 12 t)
+ (buffer-substring-no-properties 1 11))
+ "\t \tLine")))
+
+(ert-deftest indent-tests-move-to-column-invis-between-tabs ()
+ "Test `move-to-column' when 2 TABs are mixed with invisible text."
+ (should
+ (string=
+ (with-temp-buffer
+ (insert "\txxx\tLine starting with INVISIBLE text after TAB\n")
+ (add-text-properties 6 25 '(invisible t))
+ (add-text-properties 2 5 '(invisible t))
+ (goto-char (point-min))
+ (move-to-column 12 t)
+ (buffer-substring-no-properties 1 14))
+ "\txxx \tLine")))
diff --git a/test/src/keyboard-tests.el b/test/src/keyboard-tests.el
index 1988ba51a76..970a53555f9 100644
--- a/test/src/keyboard-tests.el
+++ b/test/src/keyboard-tests.el
@@ -32,5 +32,20 @@
(read-event nil nil 2))
?\C-b)))
+(ert-deftest keyboard-lossage-size ()
+ "Test `lossage-size'."
+ (let ((min-value 100)
+ (lossage-orig (lossage-size)))
+ (dolist (factor (list 1 3 4 5 10 7 3))
+ (let ((new-lossage (* factor min-value)))
+ (should (= new-lossage (lossage-size new-lossage)))))
+ ;; Wrong type
+ (should-error (lossage-size -5))
+ (should-error (lossage-size "200"))
+ ;; Less that minimum value
+ (should-error (lossage-size (1- min-value)))
+ (should (= lossage-orig (lossage-size lossage-orig)))))
+
+
(provide 'keyboard-tests)
;;; keyboard-tests.el ends here
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index dbf0a7d1229..75f8c0f092e 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -1,4 +1,4 @@
-;;; keymap-tests.el --- Test suite for src/keymap.c
+;;; keymap-tests.el --- Test suite for src/keymap.c -*- lexical-binding: t -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index 1426b0145e0..26fd6aa22a1 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-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
+;; 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:
@@ -157,22 +157,6 @@ literals (Bug#20852)."
(load "somelib" nil t)
(should (string-suffix-p "/somelib.el" (caar load-history)))))
-(ert-deftest lread-tests--old-style-backquotes ()
- "Check that loading doesn't accept old-style backquotes."
- (lread-tests--with-temp-file file-name
- (write-region "(` (a b))" nil file-name)
- (let ((data (should-error (load file-name nil :nomessage :nosuffix))))
- (should (equal (cdr data)
- (list (concat (format-message "Loading `%s': " file-name)
- "old-style backquotes detected!")))))))
-
-(ert-deftest lread-tests--force-new-style-backquotes ()
- (let ((data (should-error (read "(` (a b))"))))
- (should (equal (cdr data) '("Old-style backquotes detected!"))))
- (should (equal (let ((force-new-style-backquotes t))
- (read "(` (a b))"))
- '(`(a b)))))
-
(ert-deftest lread-lread--substitute-object-in-subtree ()
(let ((x (cons 0 1)))
(setcar x x)
diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index 0f729964248..eb9572dbdf4 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-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
+;; 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/>.
;;; Code:
@@ -355,5 +355,33 @@ otherwise, use a different charset."
(setcdr err err)
(should-error (error-message-string err) :type 'circular-list)))
+(print-tests--deftest print-hash-table-test ()
+ (should
+ (string-match
+ "data (2 3)"
+ (let ((h (make-hash-table)))
+ (puthash 1 2 h)
+ (puthash 2 3 h)
+ (remhash 1 h)
+ (format "%S" h))))
+
+ (should
+ (string-match
+ "data ()"
+ (let ((h (make-hash-table)))
+ (let ((print-length 0))
+ (format "%S" h)))))
+
+ (should
+ (string-match
+ "data (99 99)"
+ (let ((h (make-hash-table)))
+ (dotimes (i 100)
+ (puthash i i h))
+ (dotimes (i 99)
+ (remhash i h))
+ (let ((print-length 1))
+ (format "%S" h))))))
+
(provide 'print-tests)
;;; print-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 66a76fd33b8..e15ad47f968 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -1,19 +1,21 @@
-;;; process-tests.el --- Testing the process facilities
+;;; process-tests.el --- Testing the process facilities -*- lexical-binding: t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
-;; 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:
@@ -33,7 +35,7 @@
(let ((proc (start-process "test" nil "bash" "-c" "exit 20"))
(sentinel-called nil)
(start-time (float-time)))
- (set-process-sentinel proc (lambda (proc msg)
+ (set-process-sentinel proc (lambda (_proc _msg)
(setq sentinel-called t)))
(while (not (or sentinel-called
(> (- (float-time) start-time)
@@ -88,7 +90,7 @@
:stderr stderr-buffer))
(sentinel-called nil)
(start-time (float-time)))
- (set-process-sentinel proc (lambda (proc msg)
+ (set-process-sentinel proc (lambda (_proc _msg)
(setq sentinel-called t)))
(while (not (or sentinel-called
(> (- (float-time) start-time)
@@ -120,13 +122,13 @@
"exit 20"))
:stderr stderr-proc))
(start-time (float-time)))
- (set-process-filter proc (lambda (proc input)
+ (set-process-filter proc (lambda (_proc input)
(push input stdout-output)))
- (set-process-sentinel proc (lambda (proc msg)
+ (set-process-sentinel proc (lambda (_proc _msg)
(setq sentinel-called t)))
- (set-process-filter stderr-proc (lambda (proc input)
+ (set-process-filter stderr-proc (lambda (_proc input)
(push input stderr-output)))
- (set-process-sentinel stderr-proc (lambda (proc input)
+ (set-process-sentinel stderr-proc (lambda (_proc _input)
(setq stderr-sentinel-called t)))
(while (not (or sentinel-called
(> (- (float-time) start-time)
diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el
index 6a661afeff9..f9372e37b11 100644
--- a/test/src/regex-emacs-tests.el
+++ b/test/src/regex-emacs-tests.el
@@ -161,7 +161,7 @@ what failed, if anything; valid values are 'search-failed,
'compilation-failed and nil. I compare the beginning/end of each
group with their expected values. This is done with either
BOUNDS-REF or SUBSTRING-REF; one of those should be non-nil.
-BOUNDS-REF is a sequence \[start-ref0 end-ref0 start-ref1
+BOUNDS-REF is a sequence [start-ref0 end-ref0 start-ref1
end-ref1 ....] while SUBSTRING-REF is the expected substring
obtained by indexing the input string by start/end-ref.
@@ -327,7 +327,7 @@ emacs requires an extra symbol character"
(defun regex-tests-BOOST-frob-escapes (s ispattern)
"Mangle \\ the way it is done in frob_escapes() in
regex-tests-BOOST.c in glibc: \\t, \\n, \\r are interpreted;
-\\\\, \\^, \{, \\|, \} are unescaped for the string (not
+\\\\, \\^, \\{, \\|, \\} are unescaped for the string (not
pattern)"
;; this is all similar to (regex-tests-unextend)
@@ -505,7 +505,7 @@ differences in behavior.")
(cond
;; pattern
- ((save-excursion (re-search-forward "^/\\(.*\\)/\\(.*i?\\)$" nil t))
+ ((save-excursion (re-search-forward "^/\\(.*\\)/\\(.*\\)$" nil t))
(setq icase (string= "i" (match-string 2))
pattern (regex-tests-unextend (match-string 1))))
diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el
index 65c56b3b29d..4bd8a8519c0 100644
--- a/test/src/syntax-tests.el
+++ b/test/src/syntax-tests.el
@@ -82,4 +82,194 @@ also has open paren syntax (see Bug#24870)."
(should (equal (parse-partial-sexp pointC pointX nil nil ppsC)
ppsX)))))
+
+;;; Commentary:
+;; The next bit tests the handling of comments in syntax.c, in
+;; particular the function `forward-comment'.
+
+;; It is intended to enhance this bit to test nested comments and also
+;; the interaction of `parse-partial-sexp' and `scan-lists' with
+;; comments (2020-10-01).
+
+;; This bit uses the data file test/data/syntax-comments.txt.
+
+(defun syntax-comments-point (n forw)
+ "Return the buffer offset corresponding to the \"label\" N.
+N is a decimal number which appears in the data file, usually
+twice, as \"labels\". It can also be a negative number or zero.
+FORW is t when we're using the label at BOL, nil for the one at EOL.
+
+If the label N doesn't exist in the current buffer, an exception
+is thrown.
+
+When FORW is t and N positive, we return the position after the
+first occurrence of label N at BOL in the data file. With FORW
+nil, we return the position before the last occurrence of the
+label at EOL in the data file.
+
+When N is negative, we return instead the position of the end of
+line that the -N label is on. When it is zero, we return POINT."
+ (if (zerop n)
+ (point)
+ (let ((str (format "%d" (abs n))))
+ (save-excursion
+ (if forw
+ (progn
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^\\(" str "\\)\\([^0-9\n]\\|$\\)"))
+ (if (< n 0)
+ (progn (end-of-line) (point))
+ (match-end 1)))
+ (goto-char (point-max))
+ (re-search-backward
+ (concat "\\(^\\|[^0-9]\\)\\(" str "\\)$"))
+ (if (< n 0)
+ (progn (end-of-line) (point))
+ (match-beginning 2)))))))
+
+(eval-and-compile
+ (defvar syntax-comments-section))
+
+(defmacro syntax-comments (-type- -dir- res start &optional stop)
+ "Create an ERT test to test (forward-comment 1/-1).
+The test uses a fixed name data file, which it visits. It calls
+entry and exit functions to set up and tear down syntax entries
+for comment characters. The test is given a name based on the
+global variable `syntax-comments-section', the direction of
+movement and the value of START.
+
+-TYPE- (unquoted) is a symbol from whose name the entry and exit
+function names are derived by appending \"-in\" and \"-out\".
+
+-DIR- (unquoted) is `forward' or `backward', the direction
+`forward-comment' is attempted.
+
+RES, t or nil, is the expected result from `forward-comment'.
+
+START and STOP are decimal numbers corresponding to labels in the
+data file marking the start and expected stop positions. See
+`syntax-comments-point' for a precise specification. If STOP is
+missing or nil, the value of START is assumed for it."
+ (declare (debug t))
+ (let ((forw
+ (cond
+ ((eq -dir- 'forward) t)
+ ((eq -dir- 'backward) nil)
+ (t (error "Invalid -dir- argument \"%s\" to `syntax-comments'" -dir-))))
+ (start-str (format "%d" (abs start)))
+ (type -type-)
+ )
+ `(ert-deftest ,(intern (concat "syntax-comments-"
+ syntax-comments-section
+ (if forw "-f" "-b") start-str))
+ ()
+ (with-current-buffer
+ (find-file
+ ,(expand-file-name "data/syntax-comments.txt"
+ (getenv "EMACS_TEST_DIRECTORY")))
+ (,(intern (concat (symbol-name type) "-in")))
+ (goto-char (syntax-comments-point ,start ,forw))
+ (let ((stop (syntax-comments-point ,(or stop start) ,(not forw))))
+ (should (eq (forward-comment ,(if forw 1 -1)) ,res))
+ (should (eq (point) stop)))
+ (,(intern (concat (symbol-name type) "-out")))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; "Pascal" style comments - single character delimiters, the closing
+;; delimiter not being newline.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun {-in ()
+ (setq comment-end-can-be-escaped nil)
+ (modify-syntax-entry ?{ "<")
+ (modify-syntax-entry ?} ">"))
+(defun {-out ()
+ (modify-syntax-entry ?{ "(}")
+ (modify-syntax-entry ?} "){"))
+(eval-and-compile
+ (setq syntax-comments-section "pascal"))
+
+(syntax-comments { forward nil 20 0)
+(syntax-comments { backward nil 20 0)
+(syntax-comments { forward t 21)
+(syntax-comments { backward t 21)
+(syntax-comments { forward t 22)
+(syntax-comments { backward t 22)
+
+(syntax-comments { forward t 23)
+(syntax-comments { backward t 23)
+(syntax-comments { forward t 24)
+(syntax-comments { backward t 24)
+(syntax-comments { forward t 26)
+(syntax-comments { backward t 26)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; "Lisp" style comments - single character opening delimiters on line
+;; comments.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun \;-in ()
+ (setq comment-end-can-be-escaped nil)
+ (modify-syntax-entry ?\n ">")
+ (modify-syntax-entry ?\; "<"))
+(defun \;-out ()
+ (modify-syntax-entry ?\n " ")
+ (modify-syntax-entry ?\; "."))
+(eval-and-compile
+ (setq syntax-comments-section "lisp"))
+
+(syntax-comments \; backward nil 30 30)
+(syntax-comments \; forward t 31)
+(syntax-comments \; backward t 31)
+(syntax-comments \; forward t 32)
+(syntax-comments \; backward t 32)
+(syntax-comments \; forward t 33)
+(syntax-comments \; backward t 33)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Emacs 27 "C" style comments - `comment-end-can-be-escaped' is non-nil.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun /*-in ()
+ (setq comment-end-can-be-escaped t)
+ (modify-syntax-entry ?/ ". 124b")
+ (modify-syntax-entry ?* ". 23")
+ (modify-syntax-entry ?\n "> b"))
+(defun /*-out ()
+ (setq comment-end-can-be-escaped nil)
+ (modify-syntax-entry ?/ ".")
+ (modify-syntax-entry ?* ".")
+ (modify-syntax-entry ?\n " "))
+(eval-and-compile
+ (setq syntax-comments-section "c"))
+
+(syntax-comments /* forward t 1)
+(syntax-comments /* backward t 1)
+(syntax-comments /* forward t 2)
+(syntax-comments /* backward t 2)
+(syntax-comments /* forward t 3)
+(syntax-comments /* backward t 3)
+
+(syntax-comments /* forward t 4)
+(syntax-comments /* backward t 4)
+(syntax-comments /* forward t 5 6)
+(syntax-comments /* backward nil 5 0)
+(syntax-comments /* forward nil 6 0)
+(syntax-comments /* backward t 6 5)
+
+(syntax-comments /* forward t 7 8)
+(syntax-comments /* backward nil 7 0)
+(syntax-comments /* forward nil 8 0)
+(syntax-comments /* backward t 8 7)
+(syntax-comments /* forward t 9)
+(syntax-comments /* backward t 9)
+
+(syntax-comments /* forward nil 10 0)
+(syntax-comments /* backward nil 10 0)
+(syntax-comments /* forward t 11)
+(syntax-comments /* backward t 11)
+
+(syntax-comments /* forward t 13 14)
+(syntax-comments /* backward nil 13 -14)
+(syntax-comments /* forward t 15)
+(syntax-comments /* backward t 15)
+
;;; syntax-tests.el ends here
diff --git a/test/src/textprop-tests.el b/test/src/textprop-tests.el
index 7333444df0b..365d2c7a7b7 100644
--- a/test/src/textprop-tests.el
+++ b/test/src/textprop-tests.el
@@ -1,4 +1,4 @@
-;;; textprop-tests.el --- Test suite for text properties.
+;;; textprop-tests.el --- Test suite for text properties. -*- lexical-binding: t -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index 5d85fc74e50..df34a2b66eb 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -1,4 +1,4 @@
-;;; threads.el --- tests for threads.
+;;; threads.el --- tests for threads. -*- lexical-binding: t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el
index 62d56ac0d9f..b35a5287946 100644
--- a/test/src/timefns-tests.el
+++ b/test/src/timefns-tests.el
@@ -1,21 +1,23 @@
-;;; timefns-tests.el -- tests for timefns.c
+;;; timefns-tests.el -- tests for timefns.c -*- lexical-binding: t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
;; 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/>.
+
+;;; Code:
(require 'ert)
@@ -124,44 +126,44 @@
;;; Tests of format-time-string padding
(ert-deftest format-time-string-padding-minimal-deletes-unneeded-zeros ()
- (let ((ref-time (append (encode-time 0 0 0 15 2 2000) '(123450))))
+ (let ((ref-time (encode-time '((123450 . 1000000) 0 0 15 2 2000 - - t))))
(should (equal (format-time-string "%-:::z" ref-time "FJT-12") "+12"))
- (should (equal (format-time-string "%-N" ref-time) "12345"))
- (should (equal (format-time-string "%-6N" ref-time) "12345"))
- (should (equal (format-time-string "%-m" ref-time) "2")))) ;not "02"
+ (should (equal (format-time-string "%-N" ref-time t) "12345"))
+ (should (equal (format-time-string "%-6N" ref-time t) "12345"))
+ (should (equal (format-time-string "%-m" ref-time t) "2")))) ;not "02"
(ert-deftest format-time-string-padding-minimal-retains-needed-zeros ()
- (let ((ref-time (append (encode-time 0 0 0 20 10 2000) '(3450))))
+ (let ((ref-time (encode-time '((3450 . 1000000) 0 0 20 10 2000 - - t))))
(should (equal (format-time-string "%-z" ref-time "IST-5:30") "+530"))
(should (equal (format-time-string "%-4z" ref-time "IST-5:30") "+530"))
(should (equal (format-time-string "%4z" ref-time "IST-5:30") "+530"))
- (should (equal (format-time-string "%-N" ref-time) "00345"))
- (should (equal (format-time-string "%-3N" ref-time) "003"))
- (should (equal (format-time-string "%3N" ref-time) "003"))
- (should (equal (format-time-string "%-m" ref-time) "10")) ;not "1"
- (should (equal (format-time-string "%-1m" ref-time) "10")) ;not "1"
- (should (equal (format-time-string "%1m" ref-time) "10")))) ;not "1"
+ (should (equal (format-time-string "%-N" ref-time t) "00345"))
+ (should (equal (format-time-string "%-3N" ref-time t) "003"))
+ (should (equal (format-time-string "%3N" ref-time t) "003"))
+ (should (equal (format-time-string "%-m" ref-time t) "10")) ;not "1"
+ (should (equal (format-time-string "%-1m" ref-time t) "10")) ;not "1"
+ (should (equal (format-time-string "%1m" ref-time t) "10")))) ;not "1"
(ert-deftest format-time-string-padding-spaces ()
- (let ((ref-time (append (encode-time 0 0 0 10 12 2000) '(123000))))
+ (let ((ref-time (encode-time '((123000 . 1000000) 0 0 10 12 2000 - - t))))
(should (equal (format-time-string "%_7z" ref-time "CHA-12:45") " +1245"))
- (should (equal (format-time-string "%_6N" ref-time) "123 "))
- (should (equal (format-time-string "%_9N" ref-time) "123 "))
- (should (equal (format-time-string "%_12N" ref-time) "123 "))
- (should (equal (format-time-string "%_m" ref-time) "12"))
- (should (equal (format-time-string "%_2m" ref-time) "12"))
- (should (equal (format-time-string "%_3m" ref-time) " 12"))))
+ (should (equal (format-time-string "%_6N" ref-time t) "123 "))
+ (should (equal (format-time-string "%_9N" ref-time t) "123 "))
+ (should (equal (format-time-string "%_12N" ref-time t) "123 "))
+ (should (equal (format-time-string "%_m" ref-time t) "12"))
+ (should (equal (format-time-string "%_2m" ref-time t) "12"))
+ (should (equal (format-time-string "%_3m" ref-time t) " 12"))))
(ert-deftest format-time-string-padding-zeros-adds-on-insignificant-side ()
"Fractional seconds have a fixed place on the left,
and any padding must happen on the right. All other numbers have
a fixed place on the right and are padded on the left."
- (let ((ref-time (append (encode-time 0 0 0 10 12 2000) '(123000))))
- (should (equal (format-time-string "%3m" ref-time) "012"))
+ (let ((ref-time (encode-time '((123000 . 1000000) 0 0 10 12 2000 - - t))))
+ (should (equal (format-time-string "%3m" ref-time t) "012"))
(should (equal (format-time-string "%7z" ref-time "CHA-12:45") "+001245"))
- (should (equal (format-time-string "%12N" ref-time) "123000000000"))
- (should (equal (format-time-string "%9N" ref-time) "123000000"))
- (should (equal (format-time-string "%6N" ref-time) "123000"))))
+ (should (equal (format-time-string "%12N" ref-time t) "123000000000"))
+ (should (equal (format-time-string "%9N" ref-time t) "123000000"))
+ (should (equal (format-time-string "%6N" ref-time t) "123000"))))
(ert-deftest time-equal-p-nil-nil ()
@@ -220,6 +222,9 @@ a fixed place on the right and are padded on the left."
'(23752 27217))))
(ert-deftest float-time-precision ()
+ (should (= (float-time '(0 1 0 4025)) 1.000000004025))
+ (should (= (float-time '(1000000004025 . 1000000000000)) 1.000000004025))
+
(should (< 0 (float-time '(1 . 10000000000))))
(should (< (float-time '(-1 . 10000000000)) 0))
diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el
index 995e4365e12..b26a276c61b 100644
--- a/test/src/undo-tests.el
+++ b/test/src/undo-tests.el
@@ -1,4 +1,4 @@
-;;; undo-tests.el --- Tests of primitive-undo
+;;; undo-tests.el --- Tests of primitive-undo -*- lexical-binding: t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
@@ -452,7 +452,7 @@ Demonstrates bug 25599."
(insert ";; aaaaaaaaa
;; bbbbbbbb")
(let ((overlay-modified
- (lambda (ov after-p _beg _end &optional length)
+ (lambda (ov after-p _beg _end &optional _length)
(unless after-p
(when (overlay-buffer ov)
(delete-overlay ov))))))
diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el
new file mode 100644
index 00000000000..3d0d0f58302
--- /dev/null
+++ b/test/src/xdisp-tests.el
@@ -0,0 +1,52 @@
+;;; xdisp-tests.el --- tests for xdisp.c functions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest xdisp-tests--minibuffer-resizing () ;; bug#43519
+ ;; FIXME: This test returns success when run in batch but
+ ;; it's only a lucky accident: it also returned success
+ ;; when bug#43519 was not fixed.
+ (should
+ (equal
+ t
+ (catch 'result
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (insert "hello")
+ (let ((ol (make-overlay (point) (point)))
+ (max-mini-window-height 1)
+ (text "askdjfhaklsjdfhlkasjdfhklasdhflkasdhflkajsdhflkashdfkljahsdlfkjahsdlfkjhasldkfhalskdjfhalskdfhlaksdhfklasdhflkasdhflkasdhflkajsdhklajsdgh"))
+ ;; (save-excursion (insert text))
+ ;; (sit-for 2)
+ ;; (delete-region (point) (point-max))
+ (put-text-property 0 1 'cursor t text)
+ (overlay-put ol 'after-string text)
+ (redisplay 'force)
+ (throw 'result
+ ;; Make sure we do the see "hello" text.
+ (prog1 (equal (window-start) (point-min))
+ ;; (list (window-start) (window-end) (window-width))
+ (delete-overlay ol)))))
+ (let ((executing-kbd-macro t)) ;Force real minibuffer in `read-string'.
+ (read-string "toto: ")))))))
+
+;;; xdisp-tests.el ends here
diff --git a/test/src/xfaces-tests.el b/test/src/xfaces-tests.el
new file mode 100644
index 00000000000..bde3a354229
--- /dev/null
+++ b/test/src/xfaces-tests.el
@@ -0,0 +1,50 @@
+;;; xfaces-tests.el --- tests for xfaces.c -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+(require 'ert)
+
+(ert-deftest xfaces-color-distance ()
+ ;; Check symmetry (bug#41544).
+ (should (equal (color-distance "#222222" "#ffffff")
+ (color-distance "#ffffff" "#222222"))))
+
+(ert-deftest xfaces-internal-color-values-from-color-spec ()
+ (should (equal (color-values-from-color-spec "#f05")
+ '(#xffff #x0000 #x5555)))
+ (should (equal (color-values-from-color-spec "#1fb0C5")
+ '(#x1f1f #xb0b0 #xc5c5)))
+ (should (equal (color-values-from-color-spec "#1f8b0AC5e")
+ '(#x1f81 #xb0aa #xc5eb)))
+ (should (equal (color-values-from-color-spec "#1f83b0ADC5e2")
+ '(#x1f83 #xb0ad #xc5e2)))
+ (should (equal (color-values-from-color-spec "#1f83b0ADC5e2g") nil))
+ (should (equal (color-values-from-color-spec "#1f83b0ADC5e20") nil))
+ (should (equal (color-values-from-color-spec "#12345") nil))
+ (should (equal (color-values-from-color-spec "rgb:f/23/28a")
+ '(#xffff #x2323 #x28a2)))
+ (should (equal (color-values-from-color-spec "rgb:1234/5678/09ab")
+ '(#x1234 #x5678 #x09ab)))
+ (should (equal (color-values-from-color-spec "rgb:0//0") nil))
+ (should (equal (color-values-from-color-spec "rgbi:0/0.5/0.1")
+ '(0 32768 6554)))
+ (should (equal (color-values-from-color-spec "rgbi:1e-3/1.0e-2/1e0")
+ '(66 655 65535)))
+ (should (equal (color-values-from-color-spec "rgbi:0/0.5/10") nil)))
+
+(provide 'xfaces-tests)
diff --git a/test/src/xml-tests.el b/test/src/xml-tests.el
index 02a52e9115d..800f400b3ca 100644
--- a/test/src/xml-tests.el
+++ b/test/src/xml-tests.el
@@ -1,4 +1,4 @@
-;;; libxml-parse-tests.el --- Test suite for libxml parsing.
+;;; xml-tests.el --- Test suite for libxml parsing. -*- lexical-binding: t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
@@ -42,20 +42,6 @@
(comment nil "comment-b") (comment nil "comment-c"))))
"Alist of XML strings and their expected parse trees for preserved comments.")
-(defvar libxml-tests--data-comments-discarded
- `(;; simple case
- ("<?xml version=\"1.0\"?><foo baz=\"true\">bar</foo>"
- . (foo ((baz . "true")) "bar"))
- ;; toplevel comments -- first document child must not get lost
- (,(concat "<?xml version=\"1.0\"?><foo>bar</foo><!--comment-1-->"
- "<!--comment-2-->")
- . (foo nil "bar"))
- (,(concat "<?xml version=\"1.0\"?><!--comment-a--><foo a=\"b\">"
- "<bar>blub</bar></foo><!--comment-b--><!--comment-c-->")
- . (foo ((a . "b")) (bar nil "blub"))))
- "Alist of XML strings and their expected parse trees for discarded comments.")
-
-
(ert-deftest libxml-tests ()
"Test libxml."
(when (fboundp 'libxml-parse-xml-region)
@@ -64,11 +50,6 @@
(erase-buffer)
(insert (car test))
(should (equal (cdr test)
- (libxml-parse-xml-region (point-min) (point-max)))))
- (dolist (test libxml-tests--data-comments-discarded)
- (erase-buffer)
- (insert (car test))
- (should (equal (cdr test)
- (libxml-parse-xml-region (point-min) (point-max) nil t)))))))
+ (libxml-parse-xml-region (point-min) (point-max))))))))
;;; libxml-tests.el ends here