[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/rcirc-update 6d31d5b 1/7: Merge branch 'master' into feature/rci
|
From: |
Philip Kaludercic |
|
Subject: |
feature/rcirc-update 6d31d5b 1/7: Merge branch 'master' into feature/rcirc-update |
|
Date: |
Sat, 11 Sep 2021 11:06:42 -0400 (EDT) |
branch: feature/rcirc-update
commit 6d31d5b4b4649a25c6f1c8857c2371e14b7e3805
Merge: a66fd7b c4724ad
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>
Merge branch 'master' into feature/rcirc-update
---
ChangeLog.2 | 2 +-
ChangeLog.3 | 12 +-
Makefile.in | 1 +
admin/authors.el | 6 +-
admin/nt/dist-build/build-zips.sh | 2 +-
configure.ac | 61 +-
doc/emacs/back.texi | 11 +-
doc/emacs/basic.texi | 20 +-
doc/emacs/book-spine.texi | 2 +-
doc/emacs/calendar.texi | 14 +
doc/emacs/commands.texi | 2 +-
doc/emacs/custom.texi | 40 +-
doc/emacs/dired.texi | 13 +-
doc/emacs/display.texi | 8 +
doc/emacs/files.texi | 37 +-
doc/emacs/fixit.texi | 7 +-
doc/emacs/frames.texi | 52 +-
doc/emacs/maintaining.texi | 46 +-
doc/emacs/misc.texi | 29 +-
doc/emacs/mule.texi | 6 +
doc/emacs/programs.texi | 12 +-
doc/emacs/text.texi | 12 +-
doc/lispintro/emacs-lisp-intro.texi | 4 +-
doc/lispref/commands.texi | 3 +
doc/lispref/control.texi | 14 +
doc/lispref/display.texi | 14 +-
doc/lispref/elisp.texi | 1 +
doc/lispref/eval.texi | 13 +-
doc/lispref/files.texi | 63 +-
doc/lispref/frames.texi | 11 +-
doc/lispref/lists.texi | 10 +-
doc/lispref/minibuf.texi | 12 +
doc/lispref/modes.texi | 43 +-
doc/lispref/nonascii.texi | 4 +-
doc/lispref/package.texi | 9 +-
doc/lispref/searching.texi | 54 +-
doc/lispref/sequences.texi | 17 +
doc/lispref/text.texi | 9 +-
doc/lispref/tips.texi | 8 +
doc/lispref/variables.texi | 18 +-
doc/misc/cl.texi | 60 +-
doc/misc/gnus.texi | 50 +-
doc/misc/message.texi | 19 +-
doc/misc/mh-e.texi | 108 +-
doc/misc/smtpmail.texi | 12 +-
doc/misc/tramp.texi | 55 +-
doc/misc/trampver.texi | 2 +-
etc/DISTRIB | 3 +-
etc/NEWS | 4618 +++++++++++---------
etc/PROBLEMS | 10 +
etc/TODO | 8 +
etc/emacs.desktop | 1 -
etc/emacsclient-mail.desktop | 5 +-
etc/emacsclient.desktop | 4 +-
etc/facemenu-removal.txt | 20 -
etc/publicsuffix.txt | 749 +++-
etc/refcards/de-refcard.tex | 2 -
etc/refcards/fr-refcard.tex | 2 -
etc/refcards/pl-refcard.tex | 4 +-
etc/refcards/pt-br-refcard.tex | 2 -
etc/refcards/refcard.tex | 4 +-
etc/themes/wombat-theme.el | 2 +-
leim/SKK-DIC/SKK-JISYO.L | 5 +
lib-src/Makefile.in | 1 +
lib-src/emacsclient.c | 7 +-
lib-src/etags.c | 2 +-
lib-src/seccomp-filter.c | 9 +-
lisp/ChangeLog.7 | 2 +-
lisp/ChangeLog.8 | 2 +-
lisp/abbrev.el | 20 +-
lisp/apropos.el | 8 +-
lisp/arc-mode.el | 4 +-
lisp/autoinsert.el | 4 +-
lisp/bindings.el | 24 +-
lisp/bookmark.el | 14 +-
lisp/calc/calc-aent.el | 4 +-
lisp/calc/calc-ext.el | 6 +-
lisp/calc/calc-forms.el | 2 +-
lisp/calc/calc-graph.el | 23 +-
lisp/calc/calc-keypd.el | 2 +-
lisp/calc/calc-lang.el | 8 +-
lisp/calc/calc-prog.el | 16 +-
lisp/calc/calc-units.el | 2 +-
lisp/calc/calc.el | 13 +-
lisp/calc/calcalg2.el | 6 +-
lisp/calc/calcalg3.el | 6 +-
lisp/calendar/appt.el | 11 +-
lisp/calendar/cal-bahai.el | 2 +-
lisp/calendar/cal-coptic.el | 2 +-
lisp/calendar/cal-dst.el | 8 +-
lisp/calendar/cal-html.el | 2 +-
lisp/calendar/cal-persia.el | 2 +-
lisp/calendar/cal-tex.el | 20 +-
lisp/calendar/calendar.el | 18 +-
lisp/calendar/diary-lib.el | 29 +-
lisp/calendar/holidays.el | 2 +-
lisp/calendar/icalendar.el | 22 +-
lisp/calendar/iso8601.el | 6 +-
lisp/calendar/solar.el | 2 +-
lisp/calendar/time-date.el | 2 +-
lisp/calendar/timeclock.el | 28 +-
lisp/calendar/todo-mode.el | 10 +-
lisp/cedet/cedet-files.el | 4 +-
lisp/cedet/ede/speedbar.el | 4 +-
lisp/cedet/semantic/java.el | 2 +-
lisp/cedet/semantic/sb.el | 8 +-
lisp/cedet/semantic/wisent/python.el | 2 +-
lisp/comint.el | 117 +-
lisp/completion.el | 104 +-
lisp/cus-edit.el | 2 +-
lisp/cus-start.el | 3 +
lisp/cus-theme.el | 2 +-
lisp/delsel.el | 2 +-
lisp/descr-text.el | 2 +-
lisp/dired-aux.el | 17 +-
lisp/dired-x.el | 8 +-
lisp/dired.el | 51 +-
lisp/dos-fns.el | 12 +-
lisp/edmacro.el | 4 +-
lisp/emacs-lisp/autoload.el | 4 +-
lisp/emacs-lisp/bindat.el | 24 +-
lisp/emacs-lisp/byte-opt.el | 232 +-
lisp/emacs-lisp/bytecomp.el | 24 +-
lisp/emacs-lisp/cconv.el | 156 +-
lisp/emacs-lisp/cl-generic.el | 19 +-
lisp/emacs-lisp/cl-macs.el | 40 +-
lisp/emacs-lisp/comp-cstr.el | 2 +-
lisp/emacs-lisp/comp.el | 16 +-
lisp/emacs-lisp/debug.el | 25 +-
lisp/emacs-lisp/disass.el | 2 +
lisp/emacs-lisp/easy-mmode.el | 11 +-
lisp/emacs-lisp/easymenu.el | 14 +-
lisp/emacs-lisp/edebug.el | 18 +-
lisp/emacs-lisp/eieio-opt.el | 4 +-
lisp/emacs-lisp/eieio-speedbar.el | 4 +-
lisp/emacs-lisp/lisp-mnt.el | 25 +-
lisp/emacs-lisp/lisp.el | 32 +-
lisp/emacs-lisp/map-ynp.el | 2 +-
lisp/emacs-lisp/map.el | 86 +-
lisp/emacs-lisp/memory-report.el | 20 +-
lisp/emacs-lisp/nadvice.el | 67 +-
lisp/emacs-lisp/package.el | 19 +-
lisp/emacs-lisp/pcase.el | 40 +
lisp/emacs-lisp/radix-tree.el | 2 +-
lisp/emacs-lisp/re-builder.el | 2 +-
lisp/emacs-lisp/rx.el | 3 +-
lisp/emacs-lisp/seq.el | 23 +-
lisp/emacs-lisp/shortdoc.el | 27 +-
lisp/emacs-lisp/smie.el | 4 +-
lisp/emacs-lisp/subr-x.el | 1 +
lisp/emacs-lisp/tabulated-list.el | 84 +-
lisp/emacs-lisp/timer.el | 93 +-
lisp/emacs-lisp/warnings.el | 2 +-
lisp/emulation/viper-ex.el | 6 +-
lisp/env.el | 4 +-
lisp/epa-mail.el | 2 +-
lisp/epg.el | 36 +-
lisp/erc/erc-backend.el | 10 +-
lisp/erc/erc-dcc.el | 6 +-
lisp/erc/erc-ibuffer.el | 2 +-
lisp/erc/erc-speedbar.el | 12 +-
lisp/erc/erc-stamp.el | 51 +-
lisp/erc/erc.el | 12 +-
lisp/eshell/em-cmpl.el | 9 +-
lisp/eshell/em-glob.el | 2 +-
lisp/eshell/esh-cmd.el | 28 +-
lisp/eshell/esh-proc.el | 2 +-
lisp/eshell/esh-util.el | 2 +-
lisp/eshell/esh-var.el | 2 +-
lisp/faces.el | 29 +-
lisp/ffap.el | 53 +-
lisp/filecache.el | 35 +-
lisp/fileloop.el | 5 +-
lisp/files.el | 238 +-
lisp/finder.el | 2 +-
lisp/follow.el | 7 +-
lisp/font-lock.el | 14 +-
lisp/format.el | 6 +
lisp/forms.el | 2 +-
lisp/frame.el | 25 +-
lisp/frameset.el | 4 +-
lisp/fringe.el | 2 +-
lisp/gnus/gnus-art.el | 9 +-
lisp/gnus/gnus-group.el | 129 +-
lisp/gnus/gnus-icalendar.el | 54 +-
lisp/gnus/gnus-kill.el | 2 +-
lisp/gnus/gnus-mlspl.el | 4 +-
lisp/gnus/gnus-msg.el | 10 +-
lisp/gnus/gnus-rfc1843.el | 2 +-
lisp/gnus/gnus-search.el | 28 +-
lisp/gnus/gnus-spec.el | 2 +-
lisp/gnus/gnus-srvr.el | 21 +-
lisp/gnus/gnus-start.el | 5 +-
lisp/gnus/gnus-sum.el | 4 +-
lisp/gnus/gnus-topic.el | 170 +-
lisp/gnus/gnus-util.el | 6 +-
lisp/gnus/gnus-uu.el | 2 +-
lisp/gnus/gnus.el | 39 +-
lisp/gnus/message.el | 39 +-
lisp/gnus/mm-decode.el | 2 +-
lisp/gnus/mml-sec.el | 2 +-
lisp/gnus/mml-smime.el | 2 +-
lisp/gnus/mml2015.el | 2 +-
lisp/gnus/nnheader.el | 2 +-
lisp/gnus/nnimap.el | 11 +-
lisp/gnus/nnmaildir.el | 20 +-
lisp/gnus/nnmairix.el | 2 +-
lisp/gnus/nnrss.el | 11 +-
lisp/gnus/nntp.el | 4 +-
lisp/gnus/spam-report.el | 4 +-
lisp/help-fns.el | 6 +-
lisp/help-mode.el | 70 +-
lisp/help.el | 2 +-
lisp/hi-lock.el | 6 +-
lisp/hippie-exp.el | 4 +-
lisp/htmlfontify.el | 14 +-
lisp/ibuf-ext.el | 11 +
lisp/ibuffer.el | 2 +-
lisp/icomplete.el | 228 +-
lisp/ido.el | 10 +-
lisp/ielm.el | 3 +-
lisp/image-dired.el | 334 +-
lisp/image/image-converter.el | 14 +-
lisp/indent.el | 2 +-
lisp/info-look.el | 11 +
lisp/info-xref.el | 2 +-
lisp/info.el | 70 +-
lisp/international/mule-cmds.el | 68 +-
lisp/international/mule-diag.el | 21 +-
lisp/international/mule-util.el | 25 +-
lisp/international/mule.el | 7 +-
lisp/isearch.el | 6 +-
lisp/jit-lock.el | 10 +-
lisp/language/japan-util.el | 2 +-
lisp/language/korea-util.el | 2 +-
lisp/ldefs-boot.el | 343 +-
lisp/linum.el | 2 +-
lisp/ls-lisp.el | 74 +-
lisp/mail/footnote.el | 4 +-
lisp/mail/ietf-drums.el | 2 +-
lisp/mail/mail-extr.el | 5 +-
lisp/mail/mail-parse.el | 39 +
lisp/mail/mail-utils.el | 2 +-
lisp/mail/rfc2047.el | 4 +-
lisp/mail/rfc2231.el | 8 +-
lisp/mail/rfc6068.el | 83 +
lisp/mail/rmail.el | 4 +-
lisp/mail/rmailkwd.el | 2 +-
lisp/mail/rmailout.el | 4 +-
lisp/mail/rmailsum.el | 3 +-
lisp/mail/smtpmail.el | 18 +-
lisp/mail/uce.el | 8 +-
lisp/mail/undigest.el | 2 +-
lisp/man.el | 4 +-
lisp/mh-e/ChangeLog.1 | 2 +-
lisp/mh-e/mh-alias.el | 6 +-
lisp/mh-e/mh-comp.el | 7 +-
lisp/mh-e/mh-e.el | 45 +-
lisp/mh-e/mh-folder.el | 105 +-
lisp/mh-e/mh-funcs.el | 4 +-
lisp/mh-e/mh-junk.el | 202 +-
lisp/mh-e/mh-mime.el | 9 +-
lisp/mh-e/mh-scan.el | 34 +-
lisp/mh-e/mh-search.el | 22 +-
lisp/mh-e/mh-show.el | 9 +-
lisp/mh-e/mh-speed.el | 2 +-
lisp/mh-e/mh-utils.el | 4 +-
lisp/mh-e/mh-xface.el | 17 +-
lisp/minibuffer.el | 123 +-
lisp/mouse.el | 224 +-
lisp/mpc.el | 10 +-
lisp/mwheel.el | 48 +-
lisp/net/ange-ftp.el | 9 +-
lisp/net/browse-url.el | 7 +-
lisp/net/dictionary.el | 2 +-
lisp/net/eudc.el | 4 +-
lisp/net/eww.el | 32 +-
lisp/net/goto-addr.el | 23 +-
lisp/net/mailcap.el | 21 +-
lisp/net/mairix.el | 2 +-
lisp/net/newst-backend.el | 2 +-
lisp/net/pop3.el | 4 +-
lisp/net/rcirc.el | 2 +-
lisp/net/soap-client.el | 4 +-
lisp/net/socks.el | 2 +-
lisp/net/tramp-adb.el | 13 +-
lisp/net/tramp-cache.el | 10 +-
lisp/net/tramp-cmds.el | 2 +-
lisp/net/tramp-compat.el | 35 +-
lisp/net/tramp-gvfs.el | 19 +-
lisp/net/tramp-sh.el | 136 +-
lisp/net/tramp-smb.el | 339 +-
lisp/net/tramp-sudoedit.el | 23 +-
lisp/net/tramp.el | 114 +-
lisp/net/trampver.el | 6 +-
lisp/newcomment.el | 3 +-
lisp/nxml/nxml-mode.el | 11 +
lisp/nxml/nxml-outln.el | 2 +-
lisp/nxml/rng-cmpct.el | 6 +-
lisp/nxml/rng-uri.el | 4 +-
lisp/nxml/xmltok.el | 2 +-
lisp/obsolete/cl.el | 11 +-
lisp/obsolete/complete.el | 4 +-
lisp/obsolete/longlines.el | 4 +-
lisp/obsolete/nnir.el | 14 +-
lisp/{mail => obsolete}/rfc2368.el | 3 +-
lisp/obsolete/terminal.el | 9 +-
lisp/obsolete/tpu-edt.el | 6 +-
lisp/obsolete/url-ns.el | 2 +-
lisp/org/org-agenda.el | 2 +-
lisp/pcmpl-unix.el | 2 +-
lisp/play/5x5.el | 8 +-
lisp/play/decipher.el | 4 +-
lisp/play/dunnet.el | 20 +-
lisp/play/handwrite.el | 2 +-
lisp/proced.el | 2 +-
lisp/profiler.el | 2 +-
lisp/progmodes/bug-reference.el | 234 +-
lisp/progmodes/cc-awk.el | 2 +-
lisp/progmodes/cc-defs.el | 119 +-
lisp/progmodes/cc-engine.el | 1372 ++++--
lisp/progmodes/cc-fonts.el | 136 +-
lisp/progmodes/cc-langs.el | 195 +-
lisp/progmodes/cc-mode.el | 70 +-
lisp/progmodes/compile.el | 12 +-
lisp/progmodes/cperl-mode.el | 432 +-
lisp/progmodes/ebnf-abn.el | 3 +-
lisp/progmodes/ebnf2ps.el | 10 +-
lisp/progmodes/elisp-mode.el | 9 +-
lisp/progmodes/etags.el | 35 +-
lisp/progmodes/flymake.el | 16 +-
lisp/progmodes/gdb-mi.el | 108 +-
lisp/progmodes/grep.el | 13 +-
lisp/progmodes/gud.el | 184 +-
lisp/progmodes/hideif.el | 2 +-
lisp/progmodes/idlw-help.el | 2 +-
lisp/progmodes/idlw-shell.el | 10 +-
lisp/progmodes/idlwave.el | 8 +-
lisp/progmodes/make-mode.el | 7 +-
lisp/progmodes/octave.el | 2 +-
lisp/progmodes/perl-mode.el | 17 +-
lisp/progmodes/prog-mode.el | 28 +
lisp/progmodes/project.el | 89 +-
lisp/progmodes/prolog.el | 105 +-
lisp/progmodes/python.el | 120 +-
lisp/progmodes/ruby-mode.el | 8 +-
lisp/progmodes/sh-script.el | 5 +-
lisp/progmodes/sql.el | 6 +-
lisp/progmodes/verilog-mode.el | 1 -
lisp/progmodes/vhdl-mode.el | 2 +-
lisp/progmodes/which-func.el | 2 +-
lisp/progmodes/xref.el | 165 +-
lisp/progmodes/xscheme.el | 4 +-
lisp/repeat.el | 5 +-
lisp/replace.el | 286 +-
lisp/saveplace.el | 4 +-
lisp/select.el | 2 +-
lisp/ses.el | 4 +-
lisp/shadowfile.el | 72 +-
lisp/shell.el | 8 +-
lisp/simple.el | 146 +-
lisp/so-long.el | 231 +-
lisp/speedbar.el | 16 +-
lisp/startup.el | 6 +-
lisp/subr.el | 116 +-
lisp/tab-bar.el | 30 +-
lisp/tar-mode.el | 2 +-
lisp/term.el | 14 +-
lisp/term/linux.el | 3 +
lisp/term/pc-win.el | 2 +-
lisp/term/st.el | 10 +-
lisp/term/w32-win.el | 2 +-
lisp/term/xterm.el | 46 +-
lisp/textmodes/bibtex.el | 10 +-
lisp/textmodes/conf-mode.el | 12 +-
lisp/textmodes/css-mode.el | 59 +-
lisp/textmodes/flyspell.el | 47 +-
lisp/textmodes/ispell.el | 48 +-
lisp/textmodes/picture.el | 4 +-
lisp/textmodes/reftex-cite.el | 2 +-
lisp/textmodes/reftex-parse.el | 2 +-
lisp/textmodes/reftex-ref.el | 2 +-
lisp/textmodes/reftex.el | 2 +-
lisp/textmodes/tex-mode.el | 64 +-
lisp/thingatpt.el | 59 +-
lisp/thumbs.el | 6 +-
lisp/time-stamp.el | 167 +-
lisp/tmm.el | 25 +-
lisp/tooltip.el | 2 +-
lisp/transient.el | 14 +-
lisp/url/url-auth.el | 8 +-
lisp/url/url-handlers.el | 10 +-
lisp/url/url-http.el | 23 +-
lisp/url/url-mailto.el | 2 +-
lisp/url/url-news.el | 2 +-
lisp/url/url-util.el | 2 +-
lisp/url/url.el | 128 +-
lisp/userlock.el | 3 +-
lisp/vc/diff-mode.el | 31 +-
lisp/vc/ediff-wind.el | 34 +-
lisp/vc/log-edit.el | 4 +-
lisp/vc/smerge-mode.el | 3 +
lisp/vc/vc-bzr.el | 2 +-
lisp/vc/vc-cvs.el | 12 +-
lisp/vc/vc-git.el | 67 +-
lisp/vc/vc-hg.el | 4 +-
lisp/vc/vc-rcs.el | 48 +-
lisp/vc/vc-svn.el | 2 +-
lisp/vc/vc.el | 34 +-
lisp/whitespace.el | 7 +-
lisp/wid-browse.el | 2 +-
lisp/windmove.el | 2 +-
lisp/window.el | 9 +-
lisp/woman.el | 10 +-
lisp/xdg.el | 4 +-
lisp/xml.el | 4 +-
lisp/xwidget.el | 74 +-
oldXMenu/Activate.c | 20 +-
oldXMenu/AddPane.c | 20 +-
oldXMenu/AddSel.c | 20 +-
oldXMenu/ChgPane.c | 20 +-
oldXMenu/ChgSel.c | 20 +-
oldXMenu/Create.c | 20 +-
oldXMenu/DelPane.c | 20 +-
oldXMenu/DelSel.c | 20 +-
oldXMenu/Destroy.c | 20 +-
oldXMenu/Error.c | 20 +-
oldXMenu/EvHand.c | 20 +-
oldXMenu/FindPane.c | 20 +-
oldXMenu/FindSel.c | 20 +-
oldXMenu/InsPane.c | 20 +-
oldXMenu/InsSel.c | 20 +-
oldXMenu/Internal.c | 20 +-
oldXMenu/Locate.c | 20 +-
oldXMenu/Post.c | 20 +-
oldXMenu/Recomp.c | 20 +-
oldXMenu/SetAEQ.c | 20 +-
oldXMenu/SetFrz.c | 20 +-
oldXMenu/SetPane.c | 20 +-
oldXMenu/SetSel.c | 20 +-
oldXMenu/XCrAssoc.c | 20 +-
oldXMenu/XDelAssoc.c | 20 +-
oldXMenu/XDestAssoc.c | 20 +-
oldXMenu/XLookAssoc.c | 20 +-
oldXMenu/XMakeAssoc.c | 20 +-
oldXMenu/XMenu.h | 20 +-
oldXMenu/XMenuInt.h | 20 +-
src/Makefile.in | 7 +-
src/alloc.c | 4 +-
src/buffer.c | 65 +-
src/callint.c | 10 +-
src/callproc.c | 2 +
src/cmds.c | 2 +-
src/coding.c | 46 +-
src/comp.c | 225 +-
src/composite.c | 28 +-
src/data.c | 2 +
src/editfns.c | 7 +-
src/fileio.c | 111 +
src/fns.c | 15 +-
src/font.c | 42 +-
src/fontset.c | 6 +-
src/frame.c | 36 +-
src/fringe.c | 10 +
src/image.c | 4 +-
src/insdel.c | 9 +-
src/keyboard.c | 48 +-
src/lisp.h | 5 +-
src/menu.c | 14 +-
src/minibuf.c | 22 +-
src/nsfns.m | 9 +-
src/nsimage.m | 49 +-
src/nsmenu.m | 29 +-
src/nsterm.h | 85 +-
src/nsterm.m | 1436 +++---
src/process.c | 5 +-
src/search.c | 6 +-
src/syntax.c | 10 +-
src/term.c | 13 +-
src/w32.c | 9 +-
src/xdisp.c | 66 +-
src/xfaces.c | 4 +-
src/xfns.c | 1 -
src/xftfont.c | 6 +
test/infra/Dockerfile.emba | 2 +-
test/infra/gitlab-ci.yml | 6 +-
test/lisp/autorevert-tests.el | 8 +-
test/lisp/calendar/icalendar-tests.el | 7 +
test/lisp/custom-tests.el | 1 +
test/lisp/dom-tests.el | 8 +
test/lisp/electric-tests.el | 4 +-
test/lisp/emacs-lisp/bytecomp-tests.el | 48 +
test/lisp/emacs-lisp/check-declare-tests.el | 10 +-
test/lisp/emacs-lisp/checkdoc-tests.el | 8 +-
test/lisp/emacs-lisp/cl-generic-tests.el | 9 +-
test/lisp/emacs-lisp/cl-lib-tests.el | 16 -
test/lisp/emacs-lisp/edebug-tests.el | 4 +-
test/lisp/emacs-lisp/lisp-mnt-tests.el | 36 +
test/lisp/emacs-lisp/map-tests.el | 33 +-
test/lisp/emacs-lisp/memory-report-tests.el | 24 +
test/lisp/emacs-lisp/pcase-tests.el | 57 +
test/lisp/emacs-lisp/seq-tests.el | 24 +
test/lisp/ffap-tests.el | 19 +
test/lisp/files-resources/.dir-locals.el | 5 +-
test/lisp/files-resources/auto-test.zot1 | 1 +
test/lisp/files-resources/auto-test.zot2 | 1 +
test/lisp/files-resources/auto-test.zot3 | 1 +
test/lisp/files-tests.el | 294 +-
test/lisp/gnus/nnrss-tests.el | 16 +
.../international/mule-util-resources/utf-8.txt | 2 +
test/lisp/international/mule-util-tests.el | 40 +
test/lisp/international/ucs-normalize-tests.el | 1 +
test/lisp/mail/mail-parse-tests.el | 54 +
test/lisp/mail/rfc6068-tests.el | 52 +
test/lisp/mh-e/mh-xface-tests.el | 35 +
test/lisp/net/netrc-resources/netrc-folding | 6 +
test/lisp/net/netrc-tests.el | 7 +
test/lisp/net/network-stream-tests.el | 2 +-
test/lisp/net/socks-tests.el | 2 +-
test/lisp/net/tramp-tests.el | 174 +-
.../{gnus/nnrss-tests.el => newcomment-tests.el} | 26 +-
test/lisp/{mail => obsolete}/rfc2368-tests.el | 0
.../progmodes/cperl-mode-resources/here-docs.pl | 2 +-
test/lisp/progmodes/cperl-mode-tests.el | 162 +-
test/lisp/progmodes/perl-mode-tests.el | 7 +
test/lisp/progmodes/project-tests.el | 15 +
test/lisp/progmodes/ruby-mode-tests.el | 22 +
test/lisp/progmodes/sh-script-tests.el | 51 +
test/lisp/progmodes/xref-tests.el | 8 +
test/lisp/replace-tests.el | 9 +-
test/lisp/shadowfile-tests.el | 24 +-
test/lisp/simple-tests.el | 11 +
test/lisp/so-long-tests/so-long-tests-helpers.el | 32 +-
test/lisp/so-long-tests/so-long-tests.el | 265 +-
test/lisp/so-long-tests/spelling-tests.el | 2 +-
test/lisp/subr-tests.el | 73 +
test/lisp/term-tests.el | 2 +-
test/lisp/textmodes/fill-tests.el | 4 +-
test/lisp/thingatpt-tests.el | 8 +
test/lisp/time-stamp-tests.el | 2 +-
test/lisp/vc/diff-mode-tests.el | 12 +
test/lisp/vc/vc-tests.el | 158 +-
test/lisp/wdired-tests.el | 4 +-
test/src/buffer-tests.el | 86 +-
test/src/coding-tests.el | 2 +-
test/src/fileio-tests.el | 22 +
test/src/font-tests.el | 25 +
test/src/json-tests.el | 2 +-
.../gnus/nnrss-tests.el => src/search-tests.el} | 29 +-
test/src/syntax-tests.el | 6 +
550 files changed, 15316 insertions(+), 8227 deletions(-)
diff --git a/ChangeLog.2 b/ChangeLog.2
index 7b40c54..3e22767 100644
--- a/ChangeLog.2
+++ b/ChangeLog.2
@@ -35670,7 +35670,7 @@
2015-04-08 Artur Malabarba <bruce.connor.am@gmail.com>
* lisp/emacs-lisp/package.el (package-menu-mode): Mode-line notification
- while dowloading information.
+ while downloading information.
* lisp/emacs-lisp/package.el: More conservative `ensure-init-file'
(package--ensure-init-file): Check file contents before visiting.
diff --git a/ChangeLog.3 b/ChangeLog.3
index 8b872a0..9ec19e9 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -33355,9 +33355,9 @@
Fix the handling of font backend supersedence on MS-Windows
* src/w32font.c (syms_of_w32font): Don't make the Uniscribe
- font backend "superceded" here, ...
+ font backend "superseded" here, ...
* src/w32uniscribe.c (syms_of_w32uniscribe_for_pdumper):
- ... make it "superceded" here, only if the HarfBuzz DLL was
+ ... make it "superseded" here, only if the HarfBuzz DLL was
successfully loaded. This is because Emacs compiled with
HarfBuzz support might run on a system without the DLL.
* src/w32fns.c (Fx_create_frame, w32_create_tip_frame):
@@ -36933,7 +36933,7 @@
electric--sort-post-self-insertion-hook.
* lisp/emacs-lisp/syntax.el (syntax-propertize, syntax-ppss):
- Use new `depth` arg to make sure noone accidentally gets added
+ Use new `depth` arg to make sure no one accidentally gets added
after syntax-ppss-flush-cache.
* doc/lispref/modes.texi (Setting Hooks): Document new `depth` arg.
@@ -58138,7 +58138,7 @@
Use bignums when Emacs converts to and from system types like
off_t for file sizes whose values can exceed fixnum range.
- Formerly, Emacs sometimes generted floats and sometimes ad-hoc
+ Formerly, Emacs sometimes generated floats and sometimes ad-hoc
conses of integers. Emacs still accepts floats and conses for
these system types, in case some stray Lisp code is generating
them, though this usage is obsolescent.
@@ -133272,7 +133272,7 @@
(g_b_init_compare_string_w): Move declaration to file scope.
* src/w32heap.c (dumped_data_commit): Now static.
(FREEABLE_P): Avoid warnings about pointer comparison with integer.
- (mmap_realloc): Cast to 'char *' for arithmetics on void pointers.
+ (mmap_realloc): Cast to 'char *' for arithmetic on void pointers.
* src/w32console.c (ctrl_c_handler, sys_tputs, sys_tgetstr)
(evalcost, cmputc, cmcheckmagic, cmcostinit, cmgoto, Wcm_clear):
Provide prototypes.
@@ -144146,7 +144146,7 @@
Move package test files to new directory.
- * test/lisp/emacs-lisp/package-tests.el: Update resoruce file location.
+ * test/lisp/emacs-lisp/package-tests.el: Update resource file location.
* test/data/package: Moved to test/lisp/emacs-lisp/package-resources
2015-11-24 Phillip Lord <phillip.lord@russet.org.uk>
diff --git a/Makefile.in b/Makefile.in
index 97d954b..235b707 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -789,6 +789,7 @@ install-etc:
### Install native compiled Lisp files.
install-eln: lisp
ifeq ($(HAVE_NATIVE_COMP),yes)
+ umask 022 ; \
find native-lisp -type d -exec $(MKDIR_P) "$(ELN_DESTDIR){}" \; ; \
find native-lisp -type f -exec ${INSTALL_DATA} "{}" "$(ELN_DESTDIR){}"
\;
endif
diff --git a/admin/authors.el b/admin/authors.el
index 6c81c78..b4e6c93 100644
--- a/admin/authors.el
+++ b/admin/authors.el
@@ -1330,7 +1330,7 @@ to print a message if FILE is not found."
(unless (or valid
(member file authors-ignored-files)
(authors-obsolete-file-p file)
- (string-match "[*]" file)
+ (string-search "*" file)
(string-match "^[0-9.]+$" file)
laxlog)
(setq authors-invalid-file-names
@@ -1465,7 +1465,7 @@
Suggested\\|Trivial\\|Version\\|Originally\\|From:\\|Patch[ \t]+[Bb]y\\)")))
((looking-at "^[ \t]+\\*")
(let ((line (buffer-substring-no-properties
(match-end 0) (line-end-position))))
- (while (and (not (string-match ":" line))
+ (while (and (not (string-search ":" line))
(forward-line 1)
(not (looking-at ":\\|^[ \t]*$")))
(setq line (concat line
@@ -1475,7 +1475,7 @@
Suggested\\|Trivial\\|Version\\|Originally\\|From:\\|Patch[ \t]+[Bb]y\\)")))
(when (string-match ":" line)
(setq line (substring line 0 (match-beginning 0)))
(setq line (replace-regexp-in-string "[[(<{].*$" "" line))
- (setq line (replace-regexp-in-string "," "" line))
+ (setq line (string-replace "," "" line))
(dolist (file (split-string line))
(when (setq file (authors-canonical-file-name file
log-file pos (car authors)))
(dolist (author authors)
diff --git a/admin/nt/dist-build/build-zips.sh
b/admin/nt/dist-build/build-zips.sh
index 7bc6ea6..4c3a52a 100755
--- a/admin/nt/dist-build/build-zips.sh
+++ b/admin/nt/dist-build/build-zips.sh
@@ -134,7 +134,7 @@ while getopts "gb:hnsiV:" opt; do
echo " -g git update and worktree only"
echo " -i build installer only"
echo " -n do not configure"
- echo " -s snaphot build"
+ echo " -s snapshot build"
exit 0
;;
\?)
diff --git a/configure.ac b/configure.ac
index c924634..418a62f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1334,6 +1334,11 @@ if test -n "$BREW"; then
[`$BREW --prefix texinfo 2>/dev/null`/bin$PATH_SEPARATOR$PATH])
fi
+# Check MacPorts on macOS.
+if test $opsys = darwin; then
+ AC_PATH_PROG(HAVE_MACPORTS, port)
+fi
+
## Require makeinfo >= 4.13 (last of the 4.x series) to build the manuals.
: ${MAKEINFO:=makeinfo}
case `($MAKEINFO --version) 2>/dev/null` in
@@ -3792,7 +3797,7 @@ AC_DEFUN([libgccjit_dev_not_found], [
not found.
Please try installing libgccjit-dev or a similar package.
If you are sure you want Emacs be compiled without ELisp native compiler,
-pass the --without-nativecomp option to configure.])])
+pass the --without-native-compilation option to configure.])])
AC_DEFUN([libgccjit_broken], [
AC_MSG_ERROR([The installed libgccjit failed to compile and run a test
program using
@@ -3807,26 +3812,42 @@ source on this site:
<https://gcc.gnu.org/wiki/JIT>.])])
HAVE_NATIVE_COMP=no
-LIBGCCJIT_LIB=
+LIBGCCJIT_LIBS=
+LIBGCCJIT_CFLAGS=
if test "${with_native_compilation}" != "no"; then
if test "${HAVE_PDUMPER}" = no; then
- AC_MSG_ERROR(['--with-nativecomp' requires '--with-dumping=pdumper'])
+ AC_MSG_ERROR(['--with-native-compilation' requires
'--with-dumping=pdumper'])
fi
if test "${HAVE_ZLIB}" = no; then
- AC_MSG_ERROR(['--with-nativecomp' requires zlib])
+ AC_MSG_ERROR(['--with-native-compilation' requires zlib])
fi
# Ensure libgccjit installed by Homebrew can be found.
if test -n "$BREW"; then
- BREW_LIBGCCJIT_PREFIX=`$BREW --prefix --installed libgccjit 2>/dev/null`
- if test "$BREW_LIBGCCJIT_PREFIX"; then
- brew_libdir=`find ${BREW_LIBGCCJIT_PREFIX}/ -name \*.so \
- | sed -e '1!d;s|/[[^/]]*\.so$||'`
- CFLAGS="$CFLAGS -I${BREW_LIBGCCJIT_PREFIX}/include"
- LDFLAGS="$LDFLAGS -L${brew_libdir} -I${BREW_LIBGCCJIT_PREFIX}/include"
+ if test -n "`$BREW --prefix --installed libgccjit 2>/dev/null`"; then
+ BREW_LIBGCCJIT_INCLUDE=$(dirname $($BREW ls -v libgccjit | \
+ grep libgccjit.h))
+ BREW_LIBGCCJIT_LIB=$(dirname $($BREW ls -v libgccjit| \
+ grep libgccjit.so\$))
+ CFLAGS="$CFLAGS -I${BREW_LIBGCCJIT_INCLUDE}"
+ LDFLAGS="$LDFLAGS -L${BREW_LIBGCCJIT_LIB}"
fi
fi
+ # Ensure libgccjit installed by MacPorts can be found.
+ if test -n "$HAVE_MACPORTS"; then
+ # Determine which gcc version has been installed (gcc11, for
+ # instance).
+ PORT_PACKAGE=$(port installed active | grep '^ *gcc@<:@0-9@:>@* ' | \
+ awk '{ print $1; }')
+ MACPORTS_LIBGCCJIT_INCLUDE=$(dirname $(port contents $PORT_PACKAGE | \
+ grep libgccjit.h))
+ MACPORTS_LIBGCCJIT_LIB=$(dirname $(port contents $PORT_PACKAGE | \
+ grep libgccjit.dylib))
+ CFLAGS="$CFLAGS -I${MACPORTS_LIBGCCJIT_INCLUDE}"
+ LDFLAGS="$LDFLAGS -L${MACPORTS_LIBGCCJIT_LIB}"
+ fi
+
# Check if libgccjit is available.
AC_CHECK_LIB(gccjit, gcc_jit_context_acquire, [], [libgccjit_not_found])
AC_CHECK_HEADERS(libgccjit.h, [], [libgccjit_dev_not_found])
@@ -3841,17 +3862,24 @@ if test "${with_native_compilation}" != "no"; then
mingw32) ;;
# OpenBSD doesn't have libdl, all the functions are in libc
netbsd|openbsd)
- LIBGCCJIT_LIB="-lgccjit" ;;
+ LIBGCCJIT_LIBS="-lgccjit" ;;
*)
- LIBGCCJIT_LIB="-lgccjit -ldl" ;;
+ LIBGCCJIT_LIBS="-lgccjit -ldl" ;;
esac
NEED_DYNLIB=yes
AC_DEFINE(HAVE_NATIVE_COMP, 1, [Define to 1 if native compiler is
available.])
+
+ # Ensure libgccjit installed by MacPorts can be found.
+ if test -n "$HAVE_MACPORTS"; then
+ LIBGCCJIT_CFLAGS="$LIBGCCJIT_CFLAGS -I${MACPORTS_LIBGCCJIT_INCLUDE}"
+ LIBGCCJIT_LIBS="-L${MACPORTS_LIBGCCJIT_LIB} $LIBGCCJIT_LIBS"
+ fi
fi
AC_DEFINE_UNQUOTED(NATIVE_ELISP_SUFFIX, ".eln",
[System extension for native compiled elisp])
AC_SUBST(HAVE_NATIVE_COMP)
-AC_SUBST(LIBGCCJIT_LIB)
+AC_SUBST(LIBGCCJIT_CFLAGS)
+AC_SUBST(LIBGCCJIT_LIBS)
DYNLIB_OBJ=
if test "${NEED_DYNLIB}" = yes; then
@@ -4884,7 +4912,7 @@ emacs_broken_SIGIO=no
case $opsys in
dnl SIGIO exists, but the feature doesn't work in the way Emacs needs.
- hpux* | nacl | openbsd | solaris | unixware )
+ hpux* | nacl | solaris | unixware )
emacs_broken_SIGIO=yes
;;
@@ -5639,7 +5667,7 @@ gl_INIT
CFLAGS=$SAVE_CFLAGS
LIBS=$SAVE_LIBS
-# timer_getoverrun needs the same libarary as timer_settime
+# timer_getoverrun needs the same library as timer_settime
OLD_LIBS=$LIBS
LIBS="$LIB_TIMER_TIME $LIBS"
AC_CHECK_FUNCS(timer_getoverrun)
@@ -5660,7 +5688,8 @@ case "$opsys" in
if test "$HAVE_NS" = "yes"; then
libs_nsgui="-framework AppKit"
if test "$NS_IMPL_COCOA" = "yes"; then
- libs_nsgui="$libs_nsgui -framework IOKit -framework Carbon -framework
IOSurface"
+ libs_nsgui="$libs_nsgui -framework IOKit -framework Carbon \
+ -framework IOSurface -framework QuartzCore"
fi
else
libs_nsgui=
diff --git a/doc/emacs/back.texi b/doc/emacs/back.texi
index ae0121e..dc4e218 100644
--- a/doc/emacs/back.texi
+++ b/doc/emacs/back.texi
@@ -48,6 +48,7 @@ The ability to:
Create @strong{PostScript output} from plain-text files (special
editing modes for @LaTeX{} and @TeX{} are included).
+
@item
@strong{Compile} and @strong{debug} from inside Emacs.
@@ -67,7 +68,7 @@ Enjoy the use of extensive @strong{merge} and @strong{diff}
functions.
@item
Take advantage of built-in support for many @strong{version control
-systems}, including Git, Mercurial, Bazaar, Subversion, and CVS.
+systems,} including Git, Mercurial, Bazaar, Subversion, and CVS.
@item
And much more!
@@ -82,8 +83,8 @@ useful to expert users. It also includes appendices with
specific
material about X and GTK resources, and with details for users of
macOS and Microsoft Windows.
-And when you tire of all the work you can accomplish with it, Emacs
-contains games to play.
+And when you tire of all the work you can accomplish with Emacs, enjoy
+the games that come with it.
@strong{About the original and principal author:}
@@ -92,8 +93,10 @@ Emacs in 1984/85. He has received the ACM Grace Hopper
Award, a
MacArthur Foundation fellowship, the Electronic Frontier Foundation's
Pioneer award, the Takeda Award for Social/Economic Betterment, and
the ACM Software and System Award, as well as several doctorates
-honoris causa.
+@emph{honoris causa.}
@end quotation
@hfil
@bye
+
++++++++++++++++++++++++++++++++++++++++++++++++++++++++
diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi
index ba8d822..c4fa0d6 100644
--- a/doc/emacs/basic.texi
+++ b/doc/emacs/basic.texi
@@ -887,15 +887,19 @@ z z z}. The first @kbd{C-x z} repeats the command once,
and each
subsequent @kbd{z} repeats it once again.
@findex repeat-mode
- Also you can activate @code{repeat-mode} that temporarily enables
-a transient mode with short keys after a limited number of commands.
+@vindex repeat-exit-key
+@vindex repeat-exit-timeout
+ Also you can activate @code{repeat-mode} that temporarily enables a
+transient mode with short keys after a limited number of commands.
Currently supported shorter key sequences are @kbd{C-x u u} instead of
@kbd{C-x u C-x u} to undo many changes, @kbd{C-x o o} instead of
@kbd{C-x o C-x o} to switch several windows, @kbd{C-x @{ @{ @} @} ^ ^
v v} to resize the selected window interactively, @kbd{M-g n n p p} to
-navigate @code{next-error} matches. Any other key exits transient mode
-and then is executed normally. The user option @code{repeat-exit-key}
-defines an additional key to exit this transient mode. Also it's
-possible to break the repetition chain automatically after idle time
-by customizing the user option @code{repeat-exit-timeout} to a number
-of seconds.
+navigate @code{next-error} matches, and @kbd{C-x ] ] [ [} to navigate
+through pages. Any other key exits transient mode and then is
+executed normally. The user option @code{repeat-exit-key} defines an
+additional key to exit this transient mode. Also it's possible to
+break the repetition chain automatically after some idle time by
+customizing the user option @code{repeat-exit-timeout} to specify the
+idle time in seconds after which this transient mode will be turned
+off.
diff --git a/doc/emacs/book-spine.texi b/doc/emacs/book-spine.texi
index 20e23ca..9634cce 100644
--- a/doc/emacs/book-spine.texi
+++ b/doc/emacs/book-spine.texi
@@ -13,7 +13,7 @@
@center @titlefont{GNU Emacs Manual}
@sp 5
-@center @value{EDITION} edition, for Emacs Version @value{EMACSVER}
+@center @value{EDITION} edition, for Emacs version @value{EMACSVER}
@sp 5
@center by Richard M.@: Stallman et al.
diff --git a/doc/emacs/calendar.texi b/doc/emacs/calendar.texi
index 3750e78..18de721 100644
--- a/doc/emacs/calendar.texi
+++ b/doc/emacs/calendar.texi
@@ -1363,6 +1363,20 @@ the 11 above to @samp{'(1 2 3)} and have the entry apply
to the last
Thursday of January, February, and March. If the month is @code{t}, the
entry applies to all months of the year.
+@findex diary-offset
+@example
+%%(diary-offset '(diary-float t 3 4) 2) Monthly committee meeting
+@end example
+
+@noindent
+This entry applies to the Saturday after the third Thursday of each
+month. The 2 specifies number of days after when the sexp
+@w{@code{'(diary-float t 3 4)}} would evaluate to @code{t}. This is
+useful when for example your organization has a committee meeting two
+days after every monthly meeting which takes place on the third
+Thursday, or if you would like to attend a virtual meeting scheduled
+in a different timezone causing a difference in the date.
+
Each of the standard sexp diary entries takes an optional parameter
specifying the name of a face or a single-character string to use when
marking the entry in the calendar. Most generally, sexp diary entries
diff --git a/doc/emacs/commands.texi b/doc/emacs/commands.texi
index 82a917c..f56f820 100644
--- a/doc/emacs/commands.texi
+++ b/doc/emacs/commands.texi
@@ -121,7 +121,7 @@ C-k} is two key sequences, not one.
By default, the prefix keys in Emacs are @kbd{C-c}, @kbd{C-h},
@kbd{C-x}, @kbd{C-x @key{RET}}, @kbd{C-x @@}, @kbd{C-x a}, @kbd{C-x
n}, @kbd{C-x r}, @kbd{C-x t}, @kbd{C-x v}, @kbd{C-x 4}, @kbd{C-x 5},
-@kbd{C-x 6}, @key{ESC}, @kbd{M-g}, and @kbd{M-o}. (@key{F1} and
+@kbd{C-x 6}, @key{ESC}, and @kbd{M-g}. (@key{F1} and
@key{F2} are aliases for @kbd{C-h} and @kbd{C-x 6}.) This list is not
cast in stone; if you customize Emacs, you can make new prefix keys.
You could even eliminate some of the standard ones, though this is not
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index 999234e..9220a20 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -1721,6 +1721,17 @@ previous ones, but they are specifically for file name
completion.
They do not bind @key{SPC}.
@end itemize
+By default, @key{TAB}, @key{SPC} and @key{?} do completion in
+@code{minibuffer-local-completion-map}. If you commonly complete over
+collections that have elements with space or question mark characters in
+them, it may be convenient to disable completion on those keys by
+putting this in your init file:
+
+@lisp
+(define-key minibuffer-local-completion-map " " 'self-insert-command)
+(define-key minibuffer-local-completion-map "?" 'self-insert-command)
+@end lisp
+
@node Rebinding
@subsection Changing Key Bindings Interactively
@cindex key rebinding, this session
@@ -2355,14 +2366,19 @@ function @code{setq} to set the variable
@code{fill-column}
(@pxref{Filling}) to 60.
You can set any Lisp variable with @code{setq}, but with certain
-variables @code{setq} won't do what you probably want in the
-init file. Some variables automatically become buffer-local
-when set with @code{setq}; what you want in the init file is to set
-the default value, using @code{setq-default}. Some customizable minor
-mode variables do special things to enable the mode when you set them
-with Customize, but ordinary @code{setq} won't do that; to enable the
-mode in your init file, call the minor mode command. The
-following section has examples of both of these methods.
+variables @code{setq} won't do what you probably want in the init
+file. Some variables automatically become buffer-local when set with
+@code{setq}; what you want in the init file is to set the default
+value, using @code{setq-default}. (The following section has examples
+of both of these methods.)
+
+Some customizable minor mode variables do special things to enable the
+mode when you set them with Customize, but ordinary @code{setq} won't
+do that; to enable the mode in your init file, call the minor mode
+command. Finally, a few customizable user options are initialized in
+complex ways, and these have to be set either via the customize
+interface (@pxref{Customization}) or by using
+@code{customize-set-variable} (@pxref{Examining}).
The second argument to @code{setq} is an expression for the new
value of the variable. This can be a constant, a variable, or a
@@ -2511,6 +2527,14 @@ Turn on Auto Fill mode automatically in Text mode and
related modes
@end example
@item
+Change the coding system used when using the clipboard
+(@pxref{Communication Coding}).
+
+@example
+(customize-set-variable 'selection-coding-system 'utf-8)
+@end example
+
+@item
Load the installed Lisp library named @file{foo} (actually a file
@file{foo.elc} or @file{foo.el} in a standard Emacs directory).
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 3fbaf8b..540abc3 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -823,7 +823,9 @@ link.
Change the mode (also called @dfn{permission bits}) of the specified
files (@code{dired-do-chmod}). @var{modespec} can be in octal or
symbolic notation, like arguments handled by the @command{chmod}
-program.
+program. This command does not follow symbolic links, so it reports
+an error if you try to change the mode of a symbolic link on a
+platform where such modes are immutable.
@findex dired-do-chgrp
@kindex G @r{(Dired)}
@@ -850,8 +852,8 @@ different systems put @command{chown} in different places).
@cindex changing file time (in Dired)
@item T @var{timestamp} @key{RET}
Touch the specified files (@code{dired-do-touch}). This means
-updating their modification times to the present time. This is like
-the shell command @code{touch}.
+updating their modification times to @var{timestamp}, which defaults
+to the present time. This is like the shell command @command{touch}.
@findex dired-do-print
@kindex P @r{(Dired)}
@@ -1553,6 +1555,11 @@ image. You comment a file from the thumbnail buffer by
typing
@kbd{c}. You will be prompted for a comment. Type @kbd{C-t c} to add
a comment from Dired (@code{image-dired-dired-comment-files}).
+@vindex image-dired-thumb-visible-marks
+ Files that are marked in Dired will also be marked in Image-Dired if
+@code{image-dired-thumb-visible-marks} is non-@code{nil} (which is the
+default).
+
Image-Dired also provides simple image manipulation. In the
thumbnail buffer, type @kbd{L} to rotate the original image 90 degrees
anti clockwise, and @kbd{R} to rotate it 90 degrees clockwise. This
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index ae345c1..996c5a6 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -1767,6 +1767,10 @@ multiple screen lines. Setting the variable
@code{truncate-lines} in
any way makes it local to the current buffer; until that time, the
default value, which is normally @code{nil}, is in effect.
+ Since line truncation and word wrap (described in the next section)
+are contradictory, @code{toggle-truncate-lines} disables word wrap
+when it turns on line truncation.
+
If a split window becomes too narrow, Emacs may automatically enable
line truncation. @xref{Split Window}, for the variable
@code{truncate-partial-width-windows} which controls this.
@@ -1797,6 +1801,10 @@ mode is enabled, the mode line shows the string
@samp{wrap} in the
mode display. The command @kbd{M-x global-visual-line-mode} toggles
Visual Line mode in all buffers.
+ Since word wrap and line truncation (described in the previous
+section) are contradictory, turning on @code{visual-line-mode}
+disables line truncation.
+
@findex beginning-of-visual-line
@findex end-of-visual-line
@findex next-logical-line
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 7edf4d2..65a57cc 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -742,6 +742,17 @@ always supposed to end in newlines. Such major modes set
the variable
setting the latter variable, you can control how these modes handle
final newlines.
+@vindex file-preserve-symlinks-on-save
+If this option is non-@code{nil} and you're visiting a file via a
+symbolic link, Emacs will break the symbolic link upon saving the
+buffer, and will write the buffer to a file with the same name as the
+symbolic link, if the value of @code{file-precious-flag} is
+non-@code{nil} (@pxref{Saving Buffers, file-precious-flag,, elisp, The
+Emacs Lisp Reference Manual}). If you want Emacs to save the buffer
+to the file the symbolic link points to (thereby preserving the link)
+in these cases, customize the variable
+@code{file-preserve-symlinks-on-save} to @code{t}.
+
@vindex write-region-inhibit-fsync
Normally, when a program writes a file, the operating system briefly
caches the file's data in main memory before committing the data to
@@ -948,7 +959,7 @@ Manual}). For customizations, see the Custom group
@code{time-stamp}.
then change your mind, you can @dfn{revert} the changes and go back to
the saved version of the file. To do this, type @kbd{C-x x g}. Since
reverting unintentionally could lose a lot of work, Emacs asks for
-confirmation first.
+confirmation first if the buffer is modified.
The @code{revert-buffer} command tries to position point in such a
way that, if the file was edited only slightly, you will be at
@@ -991,6 +1002,17 @@ revert it automatically if it has changed---provided the
buffer itself
is not modified. (If you have edited the text, it would be wrong to
discard your changes.)
+@vindex revert-buffer-quick-short-answers
+@findex revert-buffer-quick
+ The @kbd{C-x x g} keystroke is bound to the
+@code{revert-buffer-quick} command. This is like the
+@code{revert-buffer} command, but prompts less. Unlike
+@code{revert-buffer}, it will not prompt if the current buffer visits
+a file, and the buffer is not modified. It also respects the
+@code{revert-buffer-quick-short-answers} user option. If this option
+is non-@code{nil}, use a shorter @kbd{y/n} query instead of a longer
+@kbd{yes/no} query.
+
You can also tell Emacs to revert buffers automatically when their
visited files change on disk; @pxref{Auto Revert}.
@@ -1169,6 +1191,13 @@ visited file. (You can inhibit this by setting the
variable
file name with @kbd{C-x C-w} or @code{set-visited-file-name} renames
any auto-save file to go with the new visited name.
+@vindex kill-buffer-delete-auto-save-files
+ Killing a buffer, by default, doesn't remove the buffer's auto-save
+file. If @code{kill-buffer-delete-auto-save-files} is non-@code{nil},
+killing a buffer that has an auto-save file will make Emacs prompt the
+user for whether the auto-save file should be deleted. (This is
+inhibited if @code{delete-auto-save-files} is @code{nil}.)
+
@node Auto Save Control
@subsection Controlling Auto-Saving
@@ -1717,12 +1746,16 @@ exists.
@kbd{M-x copy-file} copies the contents of the file @var{old} to the
file @var{new}.
+@vindex copy-directory-create-symlink
@findex copy-directory
@kbd{M-x copy-directory} copies directories, similar to the
@command{cp -r} shell command. If @var{new} is a directory name, it
creates a copy of the @var{old} directory and puts it in @var{new}.
Otherwise it copies all the contents of @var{old} into a new directory
-named @var{new}.
+named @var{new}. If @code{copy-directory-create-symlink} is
+non-@code{nil} and @var{old} is a symbolic link, this command will
+copy the symbolic link. If @code{nil}, this command will follow the
+link and copy the contents instead. (This is the default.)
@cindex renaming files
@findex rename-file
diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi
index b558ebc..85cdbff 100644
--- a/doc/emacs/fixit.texi
+++ b/doc/emacs/fixit.texi
@@ -462,10 +462,9 @@ use @code{flyspell-region} or @code{flyspell-buffer} for
that.
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. 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
+@kbd{mouse-3} instead, enable @code{context-menu-mode}. 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.
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index 70615f6..a32181e 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -366,20 +366,24 @@ This menu is for changing the default face within the
window's buffer.
@xref{Text Scale}.
@end table
- Some graphical applications use @kbd{mouse-3} for a mode-specific
-menu. If you prefer @kbd{mouse-3} in Emacs to bring up such a menu
-instead of running the @code{mouse-save-then-kill} command, rebind
-@kbd{mouse-3} by adding the following line to your init file
-(@pxref{Init Rebinding}):
-
-@smallexample
-(global-set-key [mouse-3]
- '(menu-item "Menu Bar" ignore
- :filter (lambda (_)
- (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))
- (mouse-menu-bar-map)
- (mouse-menu-major-mode-map)))))
-@end smallexample
+@cindex context menu
+@findex context-menu-mode
+@vindex context-menu-functions
+@kindex Down-mouse-3
+@kindex S-F10
+ Many GUI applications use @kbd{mouse-3} to display @dfn{context
+menus}: menus that provide access to various pertinent settings and
+actions for the location and context of the mouse click. If you
+prefer this in Emacs over the default function of @kbd{mouse-3}, which
+is bound to the @code{mouse-save-then-kill} command (@pxref{Mouse
+Commands}), you can enable the minor mode @code{context-menu-mode}.
+Then Emacs will show context menus when you click @kbd{mouse-3}. The
+exact contents of these context menus depends on the current major
+mode and the buffer contents around the place where you click the
+mouse. To customize the contents of the context menu, you can use the
+variable @code{context-menu-functions} (@pxref{Major Mode
+Conventions,,, elisp, The Emacs Lisp Reference Manual}).
+You can also invoke the context menu by pressing @kbd{S-@key{F10}}.
@node Mode Line Mouse
@section Mode Line Mouse Commands
@@ -448,7 +452,14 @@ buffer to select:
@item C-x 5 2
@kindex C-x 5 2
@findex make-frame-command
-Create a new frame (@code{make-frame-command}).
+Create a new frame using the default frame parameters
+(@code{make-frame-command}).
+
+@item C-x 5 c
+@kindex C-x 5 c
+@findex clone-frame
+Create a new frame using the parameters of the current frame
+(@code{clone-frame}).
@item C-x 5 b @var{bufname} @key{RET}
Select buffer @var{bufname} in another frame. This runs
@@ -480,9 +491,10 @@ frame. This runs @code{find-file-read-only-other-frame}.
@xref{Visiting}.
@item C-x 5 5
-A more general prefix command affects the buffer displayed by the next
-command invoked immediately after this prefix command. It requests
-the buffer of the next command to be displayed in another frame.
+A more general prefix command that affects the buffer displayed by the
+next command invoked immediately after this prefix command
+(@code{other-frame-prefix}). It requests the buffer of the next
+command to be displayed in another frame.
@end table
You can control the appearance and behavior of the newly-created
@@ -1217,7 +1229,9 @@ the use of menu bars at startup, customize the variable
terminals, where this makes one additional line available for text.
If the menu bar is off, you can still pop up a menu of its contents
with @kbd{C-mouse-3} on a display which supports pop-up menus.
-@xref{Menu Mouse Clicks}.
+Or you can enable @code{context-menu-mode} and customize the variable
+@code{context-menu-functions} to pop up a context menu with
+@kbd{mouse-3}. @xref{Menu Mouse Clicks}.
@xref{Menu Bar}, for information on how to invoke commands with the
menu bar. @xref{X Resources}, for how to customize the menu bar
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 3205e6d..5b33c9b 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1136,13 +1136,17 @@ Revert the work file(s) in the current VC fileset to
the last revision
@findex vc-revert
@vindex vc-revert-show-diff
If you want to discard all the changes you have made to the current
-VC fileset, type @kbd{C-x v u} (@code{vc-revert}). This shows
-you a diff between the work file(s) and the revision from which you
-started editing, and asks for confirmation for discarding the changes.
-If you agree, the fileset is reverted. If you don't want @kbd{C-x v
-u} to show a diff, set the variable @code{vc-revert-show-diff} to
-@code{nil} (you can still view the diff directly with @kbd{C-x v =};
-@pxref{Old Revisions}).
+VC fileset, type @kbd{C-x v u} (@code{vc-revert}). This will ask you
+for confirmation before discarding the changes. If you agree, the
+fileset is reverted.
+
+ If @code{vc-revert-show-diff} is non-@code{nil}, this command will
+show you a diff between the work file(s) and the revision from which
+you started editing. Afterwards, the diff buffer will either be
+killed (if this variable is @code{kill}), or the buffer will be buried
+(any other non-@code{nil} value). If you don't want @kbd{C-x v u} to
+show a diff, set this variable to @code{nil} (you can still view the
+diff directly with @kbd{C-x v =}; @pxref{Old Revisions}).
On locking-based version control systems, @kbd{C-x v u} leaves files
unlocked; you must lock again to resume editing. You can also use
@@ -2141,6 +2145,7 @@ identifier at point, it prompts for the identifier. (If
you want it
to always prompt, customize @code{xref-prompt-for-identifier} to
@code{t}.)
+@vindex xref-auto-jump-to-first-definition
If the specified identifier has only one definition, the command jumps
to it. If the identifier has more than one possible definition (e.g.,
in an object-oriented language, or if there's a function and a
@@ -2148,7 +2153,22 @@ variable by the same name), the command shows the
candidate
definitions in the @file{*xref*} buffer, together with the files in
which these definitions are found. Selecting one of these candidates
by typing @kbd{@key{RET}} or clicking @kbd{mouse-2} will pop a buffer
-showing the corresponding definition.
+showing the corresponding definition. If the value of the variable
+@code{xref-auto-jump-to-first-definition} is @code{move}, the first
+candidate is automatically selected, and if it's @code{t} or
+@code{show}, the first candidate is automatically shown. The default
+value is @code{nil}, which just shows the candidates in the
+@file{*xref*} buffer, but doesn't select any of them.
+
+@vindex xref-auto-jump-to-first-xref
+ If the value of the variable @code{xref-auto-jump-to-first-xref} is
+@code{t}, @emph{all} Xref commands automatically jump to the first
+result. If the value is @code{show}, the first result is shown, but
+the window showing the @file{*xref*} buffer is left selected. If the
+value is @code{move}, the first result is selected in the
+@file{*xref*} buffer, but is not shown. The default value is
+@code{nil}, which just shows the results in the @file{*xref*} buffer,
+but doesn't select any of them.
When entering the identifier argument to @kbd{M-.}, the usual
minibuffer completion commands can be used (@pxref{Completion}), with
@@ -2218,10 +2238,16 @@ the special XREF mode:
@table @kbd
@item @key{RET}
-@itemx mouse-2
+@itemx mouse-1
Display the reference on the current line (@code{xref-goto-xref}).
With prefix argument, also bury the @file{*xref*} buffer.
+@item mouse-2
+@findex xref-select-and-show-xref
+The same as @code{mouse-1}, but make the window displaying the
+@file{*xref*} buffer the selected window
+(@code{xref-select-and-show-xref}).
+
@item n
@itemx .
@findex xref-next-line
@@ -2259,8 +2285,8 @@ the match with @var{replacement}. @xref{Identifier
Search}.
Refresh the contents of the @file{*xref*} buffer
(@code{xref-revert-buffer}.
-@findex xref-quit
@item q
+@findex xref-quit
Quit the window showing the @file{*xref*} buffer (@code{xref-quit}).
@end table
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index aba98cf..47e3e11 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -163,14 +163,13 @@ List killed groups (@code{gnus-group-list-killed}).
List zombie groups (@code{gnus-group-list-zombies}).
@kindex u @r{(Gnus Group mode)}
-@findex gnus-group-unsubscribe-current-group
+@findex gnus-group-toggle-subscription
@cindex subscribe groups
@cindex unsubscribe groups
@item u
Toggle the subscription status of the group
-(@code{gnus-group-unsubscribe-current-group}) on the current line
-(i.e., turn a subscribed group into an unsubscribed group, or vice
-versa). Invoking this on a killed or zombie group turns it into an
+(@code{gnus-group-toggle-subscription}) on the current line.
+Invoking this on a killed or zombie group turns it into an
unsubscribed group.
@kindex C-k @r{(Gnus Group mode)}
@@ -1114,6 +1113,19 @@ subshell:
@end example
@end table
+By default, Shell mode handles common @acronym{ANSI} escape codes (for
+instance, for changing the color of text). Emacs also optionally
+supports some extend escape codes, like some of the @acronym{OSC}
+(Operating System Codes) if you put the following in your init file:
+
+@lisp
+(add-hook 'comint-output-filter-functions 'comint-osc-process-output)
+@end lisp
+
+With this enabled, the output from, for instance, @code{ls
+--hyperlink} will be made into clickable buttons in the Shell mode
+buffer.
+
@cindex Comint mode
@cindex mode, Comint
Shell mode is a derivative of Comint mode, a general-purpose mode for
@@ -2974,6 +2986,15 @@ URLs.
For more information, view the package commentary by typing @kbd{C-h P
browse-url @key{RET}}.
+@findex url-handler-mode
+ Emacs also has a minor mode that has some support for handling
+@acronym{URL}s as if they were files. @code{url-handler-mode} is a
+global minor mode that affects most of the Emacs commands and
+primitives that deal with file names. After switching on this mode,
+you can say, for instance, @kbd{C-x C-f https://www.gnu.org/ RET} to
+see the @acronym{HTML} for that web page, and you can then edit it and
+save it to a local file, for instance.
+
@node Goto Address mode
@subsection Activating URLs
@findex goto-address-mode
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index 22b3677..81aabfb 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -1330,6 +1330,12 @@ You can do this by putting
@noindent
in your init file.
+@findex w32-set-console-codepage
+ Setting @code{keyboard-coding-system} has no effect on MS-Windows,
+except on old Windows 9X systems, in which case the encoding must
+match the current codepage of the MS-Windows console, which can be
+changed by calling @code{w32-set-console-codepage}.
+
There is a similarity between using a coding system translation for
keyboard input, and using an input method: both define sequences of
keyboard input that translate into single characters. However, input
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index fe3ee57..09216c2 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -1098,13 +1098,13 @@ match the last comment before point in the buffer, and
then does a
expression that is the value of the variable @code{comment-start-skip}.
Make sure this regexp does not match the null string. It may match more
than the comment starting delimiter in the strictest sense of the word;
-for example, in C mode the value of the variable is
+for example, in C mode the value of the variable could be
@c This stops M-q from breaking the line inside that @code.
-@code{@w{"\\(//+\\|/\\*+\\)\\s *"}}, which matches extra stars and
-spaces after the @samp{/*} itself, and accepts C++ style comments
-also. (Note that @samp{\\} is needed in Lisp syntax to include a
-@samp{\} in the string, which is needed to deny the first star its
-special meaning in regexp syntax. @xref{Regexp Backslash}.)
+@code{@w{"/\\*+[ \t]*\\|//+[ \t]*"}}, which matches extra stars and
+spaces after the @samp{/*} itself, and accepts C++ style (@samp{//})
+comments also. (Note that @samp{\\} is needed in Lisp syntax to
+include a @samp{\} in the string, which is needed to deny the first
+star its special meaning in regexp syntax. @xref{Regexp Backslash}.)
@vindex comment-start
@vindex comment-end
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index c9c4be3..dc8ca90 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -572,7 +572,7 @@ Set the fill column (@code{set-fill-column}).
Fill each paragraph in the region (@code{fill-region}).
@item M-x fill-region-as-paragraph
Fill the region, considering it as one paragraph.
-@item M-o M-s
+@item M-x center-line
Center a line.
@end table
@@ -621,10 +621,9 @@ numeric argument, it uses that as the new fill column.
With just
@kbd{C-u} as argument, it sets @code{fill-column} to the current
horizontal position of point.
-@kindex M-o M-s @r{(Text mode)}
@cindex centering
@findex center-line
- The command @kbd{M-o M-s} (@code{center-line}) centers the current line
+ The command @kbd{M-x center-line} centers the current line
within the current fill column. With an argument @var{n}, it centers
@var{n} lines individually and moves past them. This binding is
made by Text mode and is available only in that and related modes
@@ -997,6 +996,13 @@ specific file (@pxref{File Variables}).
major mode's special commands. (The variable
@code{outline-minor-mode-prefix} controls the prefix used.)
+@vindex outline-minor-mode-cycle
+ If the @code{outline-minor-mode-cycle} user option is
+non-@code{nil}, the @kbd{TAB} and @kbd{S-TAB} keys are enabled on the
+outline heading lines. @kbd{TAB} cycles hiding, showing the
+sub-heading, and showing all for the current section. @kbd{S-TAB}
+does the same for the entire buffer.
+
@menu
* Outline Format:: What the text of an outline looks like.
* Outline Motion:: Special commands for moving through outlines.
diff --git a/doc/lispintro/emacs-lisp-intro.texi
b/doc/lispintro/emacs-lisp-intro.texi
index fade409..7933ebe 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -14650,7 +14650,9 @@ Let's re-use @kbd{C-c =} as a convenient keybinding:
Now we can try out @code{count-words-defun}: install both
@code{count-words-in-defun} and @code{count-words-defun}, and set the
-keybinding, and then place the cursor within the following definition:
+keybinding. Then copy the following to an Emacs Lisp buffer (like,
+for instance, @file{*scratch*}), place the cursor within the
+definition, and use the @kbd{C-c =} command.
@smallexample
@group
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index b4a8b73..6d45099 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -601,6 +601,9 @@ Put them into three windows, selecting the last one."
@node Command Modes
@subsection Specifying Modes For Commands
+@cindex commands, mode-specific
+@cindex commands, specify as mode-specific
+@cindex mode-specific commands
Many commands in Emacs are general, and not tied to any specific mode.
For instance, @kbd{M-x kill-region} can be used in pretty much any
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 22b665b..aacf66c 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -555,6 +555,16 @@ Two symbols to avoid are @code{t}, which behaves like
@code{_}
Likewise, it makes no sense to bind keyword symbols
(@pxref{Constant Variables}).
+@item (cl-type @var{type})
+Matches if @var{expval} is of type @var{type}, which is a type
+descriptor as accepted by @code{cl-typep} (@pxref{cl-typep,,,cl,Common
+Lisp Extensions}). Examples:
+
+@lisp
+(cl-type integer)
+(cl-type (integer 0 10))
+@end lisp
+
@item (pred @var{function})
Matches if the predicate @var{function} returns non-@code{nil}
when called on @var{expval}. The test can be negated with the syntax
@@ -1302,6 +1312,10 @@ element of @var{list}. The bindings are performed as if
by
up being equivalent to @code{dolist} (@pxref{Iteration}).
@end defmac
+@defmac pcase-setq pattern value@dots{}
+Assign values to variables in a @code{setq} form, destructuring each
+@var{value} according to its respective @var{pattern}.
+@end defmac
@node Iteration
@section Iteration
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 13d0a1b..510efaf 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -152,6 +152,9 @@ truncation; a @samp{\} on the rightmost column indicates a
line that
wraps. (The display table can specify alternate characters to use
for this; @pxref{Display Tables}).
+ Since wrapping and truncation of text contradict each other, Emacs
+turns off line truncation when wrapping is requested, and vice versa.
+
@defopt truncate-lines
If this buffer-local variable is non-@code{nil}, lines that extend
beyond the right edge of the window are truncated; otherwise, they are
@@ -646,9 +649,9 @@ If the value is zero, then command input is not echoed.
@defvar message-truncate-lines
Normally, displaying a long message resizes the echo area to display
-the entire message. But if the variable @code{message-truncate-lines}
-is non-@code{nil}, the echo area does not resize, and the message is
-truncated to fit it.
+the entire message, wrapping long line as needed. But if the variable
+@code{message-truncate-lines} is non-@code{nil}, long lines of
+echo-area message are instead truncated to fit the mini-window width.
@end defvar
The variable @code{max-mini-window-height}, which specifies the
@@ -1917,7 +1920,8 @@ This function returns a list of the overlays that overlap
the region
contains one or more characters in the region; empty overlays
(@pxref{Managing Overlays, empty overlay}) overlap if they are at
@var{beg}, strictly between @var{beg} and @var{end}, or at @var{end}
-when @var{end} denotes the position at the end of the buffer.
+when @var{end} denotes the position at the end of the accessible part
+of the buffer.
@end defun
@defun next-overlay-change pos
@@ -5969,7 +5973,7 @@ To @var{svg} add an embedded (raster) image placed at
@code{:base-uri} specifies a (possibly non-existing) file name of the
svg image to be created, thus all the embedded files are searched
relatively to the @code{:base-uri} filename's directory. If
-@code{:base-uri} is ommited, then filename from where svg image is
+@code{:base-uri} is omitted, then filename from where svg image is
loaded is used. Using @code{:base-uri} improves the performance of
embedding large images, comparing to @code{svg-embed}, because all the
work is done directly by librsvg.
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index 8b440c7..55bcf39 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -788,6 +788,7 @@ Defining Commands
* Interactive Codes:: The standard letter-codes for reading arguments
in various ways.
* Interactive Examples:: Examples of how to read interactive arguments.
+* Command Modes:: Specifying that commands are for a specific mode.
* Generic Commands:: Select among command alternatives.
diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi
index 7893895..e199884 100644
--- a/doc/lispref/eval.texi
+++ b/doc/lispref/eval.texi
@@ -862,8 +862,13 @@ expressions that were read, evaluated, and printed from
buffers
(including the minibuffer) by the standard Emacs commands which do
this. (Note that this does @emph{not} include evaluation in
@file{*ielm*} buffers, nor evaluation using @kbd{C-j}, @kbd{C-x C-e},
-and similar evaluation commands in @code{lisp-interaction-mode}.) The
-elements are ordered most recent first.
+and similar evaluation commands in @code{lisp-interaction-mode}.)
+
+This variable is obsolete, and will be removed in a future version,
+since it constantly enlarges the memory footprint of the Emacs
+process. For that reason, we recommend against using it.
+
+The elements of @code{values} are ordered most recent first.
@example
@group
@@ -880,8 +885,8 @@ values
@end group
@end example
-This variable is useful for referring back to values of forms recently
-evaluated. It is generally a bad idea to print the value of
+This variable could be useful for referring back to values of forms
+recently evaluated. It is generally a bad idea to print the value of
@code{values} itself, since this may be very long. Instead, examine
particular elements, like this:
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index c7e5537..d104570 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -936,6 +936,16 @@ file in @file{/foo/} will give an error:
@end example
@end defun
+@defmac with-existing-directory body@dots{}
+This macro ensures that @code{default-directory} is bound to an
+existing directory before executing @var{body}. If
+@code{default-directory} already exists, that's preferred, and
+otherwise some other directory is used. This macro can be useful, for
+instance, when calling an external command that requires that it's
+running in a directory that exists. The chosen directory is not
+guaranteed to be writable.
+@end defmac
+
@defun access-file filename string
If you can read @var{filename} this function returns @code{nil};
otherwise it signals an error
@@ -2343,49 +2353,26 @@ entirely of directory separators.
@end example
@end defun
- Given a directory name, you can combine it with a relative file name
-using @code{concat}:
+@defun file-name-concat directory &rest components
+Concatenate @var{components} to @var{directory}, inserting a slash
+before the components if @var{directory} or the preceding component
+didn't end with a slash.
@example
-(concat @var{dirname} @var{relfile})
-@end example
-
-@noindent
-Be sure to verify that the file name is relative before doing that.
-If you use an absolute file name, the results could be syntactically
-invalid or refer to the wrong file.
-
- If you want to use a directory file name in making such a
-combination, you must first convert it to a directory name using
-@code{file-name-as-directory}:
-
-@example
-(concat (file-name-as-directory @var{dirfile}) @var{relfile})
-@end example
-
-@noindent
-Don't try concatenating a slash by hand, as in
-
-@example
-;;; @r{Wrong!}
-(concat @var{dirfile} "/" @var{relfile})
+@group
+(file-name-concat "/tmp" "foo")
+ @result{} "/tmp/foo"
+@end group
@end example
-@noindent
-because this is not portable. Always use
-@code{file-name-as-directory}.
-
- To avoid the issues mentioned above, or if the @var{dirname} value
-might be @code{nil} (for example, from an element of @code{load-path}),
-use:
+A @var{directory} or components that are @code{nil} or the empty
+string are ignored---they are filtered out first and do not affect the
+results in any way.
-@example
-(expand-file-name @var{relfile} @var{dirname})
-@end example
-
-However, @code{expand-file-name} expands leading @samp{~} in
-@var{relfile}, which may not be what you want. @xref{File Name
-Expansion}.
+This is almost the same as using @code{concat}, but @var{dirname} (and
+the non-final components) may or may not end with slash characters,
+and this function will not double those characters.
+@end defun
To convert a directory name to its abbreviation, use this
function:
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 25706be..477c105 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -2692,18 +2692,19 @@ frame and defaults to the selected frame. It never
returns a frame
whose @code{no-other-frame} parameter (@pxref{Frame Interaction
Parameters}) is non-@code{nil}.
-The second argument, @var{minibuf}, says which frames to consider:
+The second argument, @var{minibuf}, says which frames to consider when
+deciding what the next frame should be:
@table @asis
@item @code{nil}
-Exclude minibuffer-only frames.
+Consider all frames except minibuffer-only frames.
@item @code{visible}
-Consider all visible frames.
+Consider only visible frames.
@item 0
-Consider all visible or iconified frames.
+Consider only visible or iconified frames.
@item a window
Consider only the frames using that particular window as their
-minibuffer.
+minibuffer window.
@item anything else
Consider all frames.
@end table
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index ac99835..bbe1dce 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1557,10 +1557,12 @@ of property lists and association lists.
@defun assoc key alist &optional testfn
This function returns the first association for @var{key} in
@var{alist}, comparing @var{key} against the alist elements using
-@var{testfn} if it is non-@code{nil} and @code{equal} otherwise
-(@pxref{Equality Predicates}). It returns @code{nil} if no
-association in @var{alist} has a @sc{car} equal to @var{key}. For
-example:
+@var{testfn} if it is a function, and @code{equal} otherwise
+(@pxref{Equality Predicates}). If @var{testfn} is a function, it is
+called with two arguments: the @sc{car} of an element from @var{alist}
+and @var{key}. The function returns @code{nil} if no
+association in @var{alist} has a @sc{car} equal to @var{key}, as
+tested by @var{testfn}. For example:
@smallexample
(setq trees '((pine . cones) (oak . acorns) (maple . seeds)))
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 196dd99..d54c654 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -469,6 +469,18 @@ If @var{default} is a non-@code{nil} list, the first
element of the
list is used in the prompt.
@end defun
+@defvar read-minibuffer-restore-windows
+If this option is non-@code{nil} (the default), getting input from the
+minibuffer will restore, on exit, the window configurations of the frame
+where the minibuffer was entered from and, if it is different, the frame
+that owns the minibuffer window. This means that if, for example, a
+user splits a window while getting input from the minibuffer on the same
+frame, that split will be undone when exiting the minibuffer.
+
+If this option is @code{nil}, no such restorations are done. Hence, the
+window split mentioned above will persist after exiting the minibuffer.
+@end defvar
+
@node Object from Minibuffer
@section Reading Lisp Objects with the Minibuffer
@cindex minibuffer input, reading lisp objects
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index b0dc0ff..ee55f98 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -471,6 +471,22 @@ Each face that the mode defines should, if possible,
inherit from an
existing Emacs face. @xref{Basic Faces}, and @ref{Faces for Font Lock}.
@item
+Consider adding a mode-specific menu to the menu bar. This should
+preferably include the most important menu-specific settings and
+commands that will allow users discovering the main features quickly
+and efficiently.
+
+@item
+@cindex context menus, for a major mode
+@vindex context-menu-functions
+Consider adding mode-specific context menus for the mode, to be used
+if and when users activate the @code{context-menu-mode} (@pxref{Menu
+Mouse Clicks,,, emacs, The Emacs Manual}). To this end, define a
+mode-specific function which builds one or more menus depending on the
+location of the @kbd{mouse-3} click in the buffer, and then add that
+function to the buffer-local value of @code{context-menu-functions}.
+
+@item
The mode should specify how Imenu should find the definitions or
sections of a buffer, by setting up a buffer-local value for the
variable @code{imenu-generic-expression}, for the two variables
@@ -1728,7 +1744,8 @@ anything that can be used with the @code{setf} function
(@pxref{Generalized Variables}).
@var{place} can also be a cons @code{(@var{get} . @var{set})},
where @var{get} is an expression that returns the current state,
-and @var{set} is a function of one argument (a state) that sets it.
+and @var{set} is a function of one argument (a state) which should be
+assigned to @var{place}.
@item :after-hook @var{after-hook}
This defines a single Lisp form which is evaluated after the mode hooks
@@ -2251,16 +2268,15 @@ number.
The format used to display column numbers when
@code{column-number-mode} (@pxref{Optional Mode Line,,, emacs, The GNU
Emacs Manual}) is switched on. @samp{%c} in the format will be
-replaced with the column number, and this is zero-based if
-@code{column-number-indicator-zero-based} is non-@code{nil}, and
-one-based if @code{column-number-indicator-zero-based} is @code{nil}.
+replaced with a zero-based column number, and @samp{%C} will be
+replaced with a one-based column number.
@end defvar
@defvar mode-line-position-column-line-format
The format used to display column numbers when both
@code{line-number-mode} and @code{column-number-mode} are switched on.
-See the previous two variables for the meaning of the @samp{%l} and
-@samp{%c} format specs.
+See the previous two variables for the meaning of the @samp{%l},
+@samp{%c} and @samp{%C} format specs.
@end defvar
@defvar minor-mode-alist
@@ -3299,6 +3315,11 @@ This function tells Font Lock mode to run the Lisp
function
current buffer. It calls @var{function} before calling the default
fontification functions, and gives it two arguments, @var{start} and
@var{end}, which specify the region to be fontified or refontified.
+If @var{function} performs fontifications, it can return a list of the
+form @w{@code{(jit-lock-bounds @var{beg} . @var{end})}}, to indicate
+the bounds of the region it actually fontified; JIT font-lock will use
+this information to optimize subsequent redisplay cycles and regions
+of buffer text it will pass to future calls to @var{function}.
The optional argument @var{contextual}, if non-@code{nil}, forces Font
Lock mode to always refontify a syntactically relevant part of the
@@ -3445,9 +3466,17 @@ for string constants.
@item font-lock-doc-face
@vindex font-lock-doc-face
-for documentation strings in the code. This inherits, by default, from
+for documentation embedded in program code inside specially-formed
+comments or strings. This face inherits, by default, from
@code{font-lock-string-face}.
+@item font-lock-doc-markup-face
+@vindex font-lock-doc-markup-face
+for mark-up elements in text using @code{font-lock-doc-face}.
+It is typically used for the mark-up constructs in documentation embedded
+in program code, following conventions such as Haddock, Javadoc or Doxygen.
+This face inherits, by default, from @code{font-lock-constant-face}.
+
@item font-lock-negation-char-face
@vindex font-lock-negation-char-face
for easily-overlooked negation characters.
diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi
index c22930d..0cc2b7e 100644
--- a/doc/lispref/nonascii.texi
+++ b/doc/lispref/nonascii.texi
@@ -1988,7 +1988,9 @@ for decoding keyboard input from @var{terminal}. If
@var{coding-system} is @code{nil}, that means not to decode keyboard
input. If @var{terminal} is a frame, it means that frame's terminal;
if it is @code{nil}, that means the currently selected frame's
-terminal. @xref{Multiple Terminals}.
+terminal. @xref{Multiple Terminals}. Note that on modern MS-Windows
+systems Emacs always uses Unicode input when decoding keyboard input,
+so the encoding set by this command has no effect on Windows.
@end deffn
@defun terminal-coding-system &optional terminal
diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi
index e8aaa3a..9c033fe 100644
--- a/doc/lispref/package.texi
+++ b/doc/lispref/package.texi
@@ -283,11 +283,14 @@ variable @code{load-file-name} (@pxref{Loading}). Here
is an example:
@section Creating and Maintaining Package Archives
@cindex package archive
+@cindex GNU ELPA
+@cindex non-GNU ELPA
Via the Package Menu, users may download packages from @dfn{package
archives}. Such archives are specified by the variable
-@code{package-archives}, whose default value contains a single entry:
-the archive hosted by the GNU project at @url{https://elpa.gnu.org}. This
-section describes how to set up and maintain a package archive.
+@code{package-archives}, whose default value lists the archives
+hosted on @url{https://elpa.gnu.org, GNU ELPA} and
+@url{https://elpa.nongnu.org, non-GNU ELPA}. This section describes
+how to set up and maintain a package archive.
@cindex base location, package archive
@defopt package-archives
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 1d3e2d9..68061f0 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -1649,6 +1649,24 @@ extra actual argument values not matched by any other
parameter in
Since the definition is global, it is recommended to give @var{name} a
package prefix to avoid name clashes with definitions elsewhere, as is
usual when naming non-local variables and functions.
+
+Forms defined this way only perform simple template substitution.
+For arbitrary computations, use them together with with the @code{rx}
+forms @code{eval}, @code{regexp} or @code{literal}. Example:
+
+@example
+@group
+(defun n-tuple-rx (n element)
+ `(seq "<"
+ (group-n 1 ,element)
+ ,@@(mapcar (lambda (i) `(seq ?, (group-n ,i ,element)))
+ (number-sequence 2 n))
+ ">"))
+(rx-define n-tuple (n element) (eval (n-tuple-rx n 'element)))
+(rx (n-tuple 3 (+ (in "0-9"))))
+ @result{} "<\\(?1:[0-9]+\\),\\(?2:[0-9]+\\),\\(?3:[0-9]+\\)>"
+@end group
+@end example
@end defmac
@defmac rx-let (bindings@dots{}) body@dots{}
@@ -2540,9 +2558,9 @@ associated with it still exists.
@cindex replacement after search
@cindex searching and replacing
- If you want to find all matches for a regexp in part of the buffer,
-and replace them, the best way is to write an explicit loop using
-@code{re-search-forward} and @code{replace-match}, like this:
+ If you want to find all matches for a regexp in part of the buffer
+and replace them, the most flexible way is to write an explicit loop
+using @code{re-search-forward} and @code{replace-match}, like this:
@example
(while (re-search-forward "foo[ \t]+bar" nil t)
@@ -2553,9 +2571,33 @@ and replace them, the best way is to write an explicit
loop using
@xref{Replacing Match,, Replacing the Text that Matched}, for a
description of @code{replace-match}.
- However, replacing matches in a string is more complex, especially
-if you want to do it efficiently. So Emacs provides two functions to do
-this.
+ It may be more convenient to limit the replacements to a specific
+region. The function @code{replace-regexp-in-region} does that.
+
+@defun replace-regexp-in-region regexp replacement &optional start end
+This function replaces all the occurrences of @var{regexp} with
+@var{replacement} in the region of buffer text between @var{start} and
+@var{end}; @var{start} defaults to position of point, and @var{end}
+defaults to the last accessible position of the buffer. The search
+for @var{regexp} is case-sensitive, and @var{replacement} is inserted
+without changing its letter-case. The @var{replacement} string can
+use the same special elements starting with @samp{\} as
+@code{replace-match} does. The function returns the number of
+replaced occurrences, or @code{nil} if @var{regexp} is not found. The
+function preserves the position of point.
+
+@example
+(replace-regexp-in-region "foo[ \t]+bar" "foobar")
+@end example
+@end defun
+
+@defun replace-string-in-region string replacement &optional start end
+ This function works similarly to @code{replace-regexp-in-region},
+but searches for, and replaces, literal @var{string}s instead of
+regular expressions.
+@end defun
+
+ Emacs also has special functions for replacing matches in a string.
@defun replace-regexp-in-string regexp rep string &optional fixedcase literal
subexp start
This function copies @var{string} and searches it for matches for
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 545fd40..20816ce 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -1111,6 +1111,23 @@ The @code{pcase} patterns provide an alternative
facility for
destructuring binding, see @ref{Destructuring with pcase Patterns}.
@end defmac
+@defmac seq-setq var-sequence val-sequence
+@cindex sequence destructuring
+ This macro works similarly to @code{seq-let}, except that values are
+assigned to variables as if by @code{setq} instead of as in a
+@code{let} binding.
+
+@example
+@group
+(let ((a nil)
+ (b nil))
+ (seq-setq (_ a _ b) '(1 2 3 4))
+ (list a b))
+@result{} (2 4)
+@end group
+@end example
+@end defmac
+
@defun seq-random-elt sequence
This function returns an element of @var{sequence} taken at random.
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index e18ba47..9e0401f 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -315,10 +315,11 @@ word on the same line is acceptable.
@defun thing-at-point thing &optional no-properties
Return the @var{thing} around or next to point, as a string.
-The argument @var{thing} is a symbol which specifies a kind of syntactic
-entity. Possibilities include @code{symbol}, @code{list}, @code{sexp},
-@code{defun}, @code{filename}, @code{url}, @code{word}, @code{sentence},
-@code{whitespace}, @code{line}, @code{page}, and others.
+The argument @var{thing} is a symbol which specifies a kind of
+syntactic entity. Possibilities include @code{symbol}, @code{list},
+@code{sexp}, @code{defun}, @code{filename}, @code{existing-filename},
+@code{url}, @code{word}, @code{sentence}, @code{whitespace},
+@code{line}, @code{page}, and others.
When the optional argument @var{no-properties} is non-@code{nil}, this
function strips text properties from the return value.
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi
index 8aa225a..f0eb107 100644
--- a/doc/lispref/tips.texi
+++ b/doc/lispref/tips.texi
@@ -755,6 +755,14 @@ anchor}. The Info file name defaults to @samp{emacs}.
For example,
See Info node `Font Lock' and Info node `(elisp)Font Lock Basics'.
@end smallexample
+To link to a customization group, write the single-quoted name of the
+group, preceded by @samp{customization group} (the first character in
+each word is case-insensitive). For example,
+
+@smallexample
+See the customization group `whitespace' for details.
+@end smallexample
+
Finally, to create a hyperlink to URLs, write the single-quoted URL,
preceded by @samp{URL}. For example,
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 9356fb9..3b03318 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -194,7 +194,7 @@ default scoping rule in Emacs Lisp is called @dfn{dynamic
scoping},
which simply states that the current binding at any given point in the
execution of a program is the most recently-created binding for that
variable that still exists. For details about dynamic scoping, and an
-alternative scoping rule called @dfn{lexical scoping}, @xref{Variable
+alternative scoping rule called @dfn{lexical scoping}, @pxref{Variable
Scoping}.
The special forms @code{let} and @code{let*} exist to create local
@@ -286,6 +286,22 @@ being run once:
@end lisp
@end defspec
+@cindex dynamic binding, temporarily
+@cindex dynamic let-binding
+@defspec dlet (bindings@dots{}) forms@dots{}
+This special form is like @code{let}, but it binds all variables
+dynamically. This is rarely useful---you usually want to bind normal
+variables lexically, and special variables (i.e., variables that are
+defined with @code{defvar}) dynamically, and this is what @code{let}
+does.
+
+@code{dlet} can be useful when interfacing with old code that assumes
+that certain variables are dynamically bound (@pxref{Dynamic
+Binding}), but it's impractical to @code{defvar} these variables.
+@code{dlet} will temporarily make the bound variables special, execute
+the forms, and then make the variables non-special again.
+@end defspec
+
Here is a complete list of the other facilities that create local
bindings:
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index c89e0e7..a6c3c32 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -3962,22 +3962,22 @@ In the simplest case, @var{name} and each of the
@var{slots}
are symbols. For example,
@example
-(cl-defstruct person name age sex)
+(cl-defstruct person first-name age sex)
@end example
@noindent
-defines a struct type called @code{person} that contains three
-slots. Given a @code{person} object @var{p}, you can access those
-slots by calling @code{(person-name @var{p})}, @code{(person-age @var{p})},
-and @code{(person-sex @var{p})}. You can also change these slots by
-using @code{setf} on any of these place forms, for example:
+defines a struct type called @code{person} that contains three slots.
+Given a @code{person} object @var{p}, you can access those slots by
+calling @code{(person-first-name @var{p})}, @code{(person-age
+@var{p})}, and @code{(person-sex @var{p})}. You can also change these
+slots by using @code{setf} on any of these place forms, for example:
@example
(cl-incf (person-age birthday-boy))
@end example
You can create a new @code{person} by calling @code{make-person},
-which takes keyword arguments @code{:name}, @code{:age}, and
+which takes keyword arguments @code{:first-name}, @code{:age}, and
@code{:sex} to specify the initial values of these slots in the
new object. (Omitting any of these arguments leaves the corresponding
slot ``undefined'', according to the Common Lisp standard; in Emacs
@@ -3989,7 +3989,7 @@ object of the same type whose slots are @code{eq} to
those of @var{p}.
Given any Lisp object @var{x}, @code{(person-p @var{x})} returns
true if @var{x} is a @code{person}, and false otherwise.
-Accessors like @code{person-name} normally check their arguments
+Accessors like @code{person-first-name} normally check their arguments
(effectively using @code{person-p}) and signal an error if the
argument is the wrong type. This check is affected by
@code{(optimize (safety @dots{}))} declarations. Safety level 1,
@@ -4002,13 +4002,13 @@ always print a descriptive error message for incorrect
inputs.
@xref{Declarations}.
@example
-(setq dave (make-person :name "Dave" :sex 'male))
+(setq dave (make-person :first-name "Dave" :sex 'male))
@result{} [cl-struct-person "Dave" nil male]
(setq other (copy-person dave))
@result{} [cl-struct-person "Dave" nil male]
(eq dave other)
@result{} nil
-(eq (person-name dave) (person-name other))
+(eq (person-first-name dave) (person-first-name other))
@result{} t
(person-p dave)
@result{} t
@@ -4021,7 +4021,7 @@ always print a descriptive error message for incorrect
inputs.
@end example
In general, @var{name} is either a name symbol or a list of a name
-symbol followed by any number of @dfn{struct options}; each @var{slot}
+symbol followed by any number of @dfn{structure options}; each @var{slot}
is either a slot symbol or a list of the form @samp{(@var{slot-name}
@var{default-value} @var{slot-options}@dots{})}. The @var{default-value}
is a Lisp form that is evaluated any time an instance of the
@@ -4029,7 +4029,7 @@ structure type is created without specifying that slot's
value.
@example
(cl-defstruct person
- (name nil :read-only t)
+ (first-name nil :read-only t)
age
(sex 'unknown))
@end example
@@ -4062,7 +4062,7 @@ enclosed in lists.)
(cl-defstruct (person (:constructor create-person)
(:type list)
:named)
- name age sex)
+ first-name age sex)
@end example
The following structure options are recognized.
@@ -4108,12 +4108,12 @@ option.
(person
(:constructor nil) ; no default constructor
(:constructor new-person
- (name sex &optional (age 0)))
- (:constructor new-hound (&key (name "Rover")
+ (first-name sex &optional (age 0)))
+ (:constructor new-hound (&key (first-name "Rover")
(dog-years 0)
&aux (age (* 7 dog-years))
(sex 'canine))))
- name age sex)
+ first-name age sex)
@end example
The first constructor here takes its arguments positionally rather
@@ -4165,16 +4165,16 @@ slot descriptors for slots in the included structure,
possibly with
modified default values. Borrowing an example from Steele:
@example
-(cl-defstruct person name (age 0) sex)
+(cl-defstruct person first-name (age 0) sex)
@result{} person
(cl-defstruct (astronaut (:include person (age 45)))
helmet-size
(favorite-beverage 'tang))
@result{} astronaut
-(setq joe (make-person :name "Joe"))
+(setq joe (make-person :first-name "Joe"))
@result{} [cl-struct-person "Joe" 0 nil]
-(setq buzz (make-astronaut :name "Buzz"))
+(setq buzz (make-astronaut :first-name "Buzz"))
@result{} [cl-struct-astronaut "Buzz" 45 nil nil tang]
(list (person-p joe) (person-p buzz))
@@ -4182,17 +4182,17 @@ modified default values. Borrowing an example from
Steele:
(list (astronaut-p joe) (astronaut-p buzz))
@result{} (nil t)
-(person-name buzz)
+(person-first-name buzz)
@result{} "Buzz"
-(astronaut-name joe)
- @result{} error: "astronaut-name accessing a non-astronaut"
+(astronaut-first-name joe)
+ @result{} error: "astronaut-first-name accessing a non-astronaut"
@end example
Thus, if @code{astronaut} is a specialization of @code{person},
then every @code{astronaut} is also a @code{person} (but not the
other way around). Every @code{astronaut} includes all the slots
of a @code{person}, plus extra slots that are specific to
-astronauts. Operations that work on people (like @code{person-name})
+astronauts. Operations that work on people (like @code{person-first-name})
work on astronauts just like other people.
@item :noinline
@@ -4230,10 +4230,10 @@ records, which are always tagged. Therefore,
@code{:named} is only
useful in conjunction with @code{:type}.
@example
-(cl-defstruct (person1) name age sex)
-(cl-defstruct (person2 (:type list) :named) name age sex)
-(cl-defstruct (person3 (:type list)) name age sex)
-(cl-defstruct (person4 (:type vector)) name age sex)
+(cl-defstruct (person1) first-name age sex)
+(cl-defstruct (person2 (:type list) :named) first-name age sex)
+(cl-defstruct (person3 (:type list)) first-name age sex)
+(cl-defstruct (person4 (:type vector)) first-name age sex)
(setq p1 (make-person1))
@result{} #s(person1 nil nil nil)
@@ -4254,10 +4254,10 @@ useful in conjunction with @code{:type}.
Since unnamed structures don't have tags, @code{cl-defstruct} is not
able to make a useful predicate for recognizing them. Also,
-accessors like @code{person3-name} will be generated but they
-will not be able to do any type checking. The @code{person3-name}
+accessors like @code{person3-first-name} will be generated but they
+will not be able to do any type checking. The @code{person3-first-name}
function, for example, will simply be a synonym for @code{car} in
-this case. By contrast, @code{person2-name} is able to verify
+this case. By contrast, @code{person2-first-name} is able to verify
that its argument is indeed a @code{person2} object before
proceeding.
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 9cdcf39..5f3fba0 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -2318,19 +2318,18 @@ commands listed in @ref{Browse Foreign Server} at hand.
@itemx u
@kindex S t @r{(Group)}
@kindex u @r{(Group)}
-@findex gnus-group-unsubscribe-current-group
-@c @icon{gnus-group-unsubscribe}
-Toggle subscription to the current group
-(@code{gnus-group-unsubscribe-current-group}).
+@findex gnus-group-toggle-subscription-at-point
+@c @icon{gnus-group-toggle-subscription-at-point}
+Toggle subscription to group under point
+(@code{gnus-group-toggle-subscription-at-point}).
@item S s
@itemx U
@kindex S s @r{(Group)}
@kindex U @r{(Group)}
-@findex gnus-group-unsubscribe-group
-Prompt for a group to subscribe, and then subscribe it. If it was
-subscribed already, unsubscribe it instead
-(@code{gnus-group-unsubscribe-group}).
+@findex gnus-group-toggle-subscription
+Prompt for group, and toggle its subscription.
+(@code{gnus-group-toggle-subscription}).
@item S k
@itemx C-k
@@ -3736,10 +3735,10 @@ Enter the current group
(@code{gnus-browse-select-group}).
@item u
@kindex u @r{(Browse)}
-@findex gnus-browse-unsubscribe-current-group
+@findex gnus-browse-toggle-subscription
@vindex gnus-browse-subscribe-newsgroup-method
-Unsubscribe to the current group, or, as will be the case here,
-subscribe to it (@code{gnus-browse-unsubscribe-current-group}). You
+Toggle subscription of the current group
+(@code{gnus-browse-toggle-subscription}). You
can affect the way the new group is entered into the Group buffer
using the variable @code{gnus-browse-subscribe-newsgroup-method}. See
@pxref{Subscription Methods} for available options.
@@ -4146,6 +4145,25 @@ The default is 2.
The @code{gnus-topic-display-empty-topics} says whether to display even
topics that have no unread articles in them. The default is @code{t}.
+@vindex gnus-topic-display-predicate
+If @code{gnus-topic-display-predicate} is non-@code{nil}, it should be
+a function that says whether the topic is to be displayed or not.
+The function will be called with one parameter (the name of the topic)
+and should return non-@code{nil} is the topic is to be displayed.
+
+For instance, if you don't even want to be reminded that work exists
+outside of office hours, you can gather all the work-related groups
+into a topic called @samp{"Work"}, and then say something like the
+following:
+
+@lisp
+(setq gnus-topic-display-predicate
+ (lambda (name)
+ (or (not (equal name "Work"))
+ (< 090000
+ (string-to-number (format-time-string "%H%M%S"))
+ 170000))))
+@end lisp
@node Topic Sorting
@subsection Topic Sorting
@@ -14517,7 +14535,8 @@ this should be set to @code{anonymous}. If this
variable isn't set,
the normal login methods will be used. If you wish to specify a
specific login method to be used, you can set this variable to either
@code{login} (the traditional @acronym{IMAP} login method),
-@code{plain} or @code{cram-md5}.
+@code{plain}, @code{cram-md5} or @code{xoauth2}. (The latter method
+requires using the @file{oauth2.el} library.)
@item nnimap-expunge
When to expunge deleted messages. If @code{never}, deleted articles
@@ -26861,9 +26880,10 @@ but at the common table.@*
If you want to investigate the person responsible for this outrage,
you can point your (feh!) web browser to
-@uref{https://quimby.gnus.org/}. This is also the primary
-distribution point for the new and spiffy versions of Gnus, and is
-known as The Site That Destroys Newsrcs And Drives People Mad.
+@uref{https://quimby.gnus.org/}. This used to be the primary
+distribution point for the new and spiffy versions of Gnus, and was
+known as The Site That Destroys Newsrcs And Drives People Mad, but
+these days Gnus is developed in the Emacs repository.
During the first extended alpha period of development, the new Gnus was
called ``(ding) Gnus''. @dfn{(ding)} is, of course, short for
diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index d2353e6..4136ad8 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/message.texi
@@ -1699,14 +1699,15 @@ result is inserted.
@cindex Sv
@cindex Re
Responses to messages have subjects that start with @samp{Re: }. This
-is @emph{not} an abbreviation of the English word ``response'', but is
-Latin, and means ``in response to''. Some illiterate nincompoops have
-failed to grasp this fact, and have ``internationalized'' their software
-to use abominations like @samp{Aw: } (``antwort'') or @samp{Sv: }
-(``svar'') instead, which is meaningless and evil. However, you may
-have to deal with users that use these evil tools, in which case you may
-set this variable to a regexp that matches these prefixes. Myself, I
-just throw away non-compliant mail.
+is @emph{not} an abbreviation of the English word ``response'', but it
+comes from the Latin ``res'', and means ``in the matter of''. Some
+illiterate nincompoops have failed to grasp this fact, and have
+``internationalized'' their software to use abominations like
+@samp{Aw: } (``antwort'') or @samp{Sv: } (``svar'') instead, which is
+meaningless and evil. However, you may have to deal with users that
+use these evil tools, in which case you may set this variable to a
+regexp that matches these prefixes. Myself, I just throw away
+non-compliant mail.
Here's an example of a value to deal with these headers when
responding to a message:
@@ -2084,7 +2085,7 @@ This optional header will be computed by Message.
@vindex user-mail-address
@findex system-name
@cindex Sun
-@cindex i-did-not-set--mail-host-address--so-tickle-me
+@cindex mail-host-address-is-not-set
This required header will be generated by Message. A unique ID will be
created based on the date, time, user name (for the local part) and the
domain part. For the domain part, message will look (in this order) at
diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi
index 6254028..d2b81a6 100644
--- a/doc/misc/mh-e.texi
+++ b/doc/misc/mh-e.texi
@@ -7383,8 +7383,8 @@ The name of the MH sequence for ticked messages (default:
@samp{'tick}).
@item mh-update-sequences-after-mh-show-flag
On means flush MH sequences to disk after message is shown (default:
@samp{on}).
-@item mh-whitelist-preserves-sequences-flag
-On means that sequences are preserved when messages are whitelisted
+@item mh-allowlist-preserves-sequences-flag
+On means that sequences are preserved when messages are allowlisted
(default: @samp{on}).
@end vtable
@@ -7540,17 +7540,17 @@ Marshall Rose once wrote a paper on MH entitled,
@cite{How to process
could be entitled, @cite{How to process 1000 spams a day and still get
some real work done}.
-@cindex blacklisting
+@cindex blocklisting
@cindex ham
@cindex viruses
-@cindex whitelisting
+@cindex allowlisting
@cindex worms
We use the terms @dfn{junk mail} and @dfn{spam} interchangeably for
any unwanted message which includes spam, @dfn{viruses}, and
@dfn{worms}. The opposite of spam is @dfn{ham}. The act of classifying
-a sender as one who sends junk mail is called @dfn{blacklisting}; the
-opposite is called @dfn{whitelisting}.
+a sender as one who sends junk mail is called @dfn{blocklisting}; the
+opposite is called @dfn{allowlisting}.
@table @kbd
@kindex J ?
@@ -7560,14 +7560,14 @@ Display cheat sheet for the commands of the current
prefix in
minibuffer (@code{mh-prefix-help}).
@c -------------------------
@kindex J b
-@findex mh-junk-blacklist
+@findex mh-junk-blocklist
@item J b
-Blacklist range as spam (@code{mh-junk-blacklist}).
+Blocklist range as spam (@code{mh-junk-blocklist}).
@c -------------------------
-@kindex J w
-@findex mh-junk-whitelist
-@item J w
-Whitelist range as ham (@code{mh-junk-whitelist}).
+@kindex J a
+@findex mh-junk-allowlist
+@item J a
+Allowlist range as ham (@code{mh-junk-allowlist}).
@c -------------------------
@item @code{mh-spamassassin-identify-spammers}
Identify spammers who are repeat offenders.
@@ -7597,31 +7597,31 @@ The following option in the @samp{mh-sequences}
customization group is
also available.
@vtable @code
-@item mh-whitelist-preserves-sequences-flag
-On means that sequences are preserved when messages are whitelisted
+@item mh-allowlist-preserves-sequences-flag
+On means that sequences are preserved when messages are allowlisted
(default: @samp{on}).
@end vtable
The following hooks are available.
@vtable @code
-@item mh-blacklist-msg-hook
-Hook run by @kbd{J b} (@code{mh-junk-blacklist}) after marking each
-message for blacklisting (default: @code{nil}).
+@item mh-blocklist-msg-hook
+Hook run by @kbd{J b} (@code{mh-junk-blocklist}) after marking each
+message for blocklisting (default: @code{nil}).
@c -------------------------
-@item mh-whitelist-msg-hook
-Hook run by @kbd{J w} (@code{mh-junk-whitelist}) after marking each
-message for whitelisting (default @samp{nil}).
+@item mh-allowlist-msg-hook
+Hook run by @kbd{J a} (@code{mh-junk-allowlist}) after marking each
+message for allowlisting (default @samp{nil}).
@end vtable
The following faces are available.
@vtable @code
-@item mh-folder-blacklisted
-Blacklisted message face.
+@item mh-folder-blocklisted
+Blocklisted message face.
@c -------------------------
-@item mh-folder-whitelisted
-Whitelisted message face
+@item mh-folder-allowlisted
+Allowlisted message face
@end vtable
@cindex SpamProbe
@@ -7647,21 +7647,21 @@ example, you have both SpamAssassin and bogofilter
installed and you
want to use bogofilter, then you can set this option to
@samp{Bogofilter}.
-@findex mh-junk-blacklist
+@findex mh-junk-blocklist
@kindex J b
@vindex mh-junk-disposition
-The command @kbd{J b} (@code{mh-junk-blacklist}) trains the spam
+The command @kbd{J b} (@code{mh-junk-blocklist}) trains the spam
program in use with the content of the range (@pxref{Ranges}) and then
handles the message(s) as specified by the option
@code{mh-junk-disposition}. By default, this option is set to
@samp{Delete Spam} but you can also specify the name of the folder
which is useful for building a corpus of spam for training purposes.
-@findex mh-junk-whitelist
-@kindex J w
+@findex mh-junk-allowlist
+@kindex J a
-In contrast, the command @kbd{J w} (@code{mh-junk-whitelist})
+In contrast, the command @kbd{J a} (@code{mh-junk-allowlist})
reclassifies a range of messages (@pxref{Ranges}) as ham if it were
incorrectly classified as spam. It then refiles the message into the
@file{+inbox} folder.
@@ -7671,12 +7671,12 @@ incorrectly classified as spam. It then refiles the
message into the
@cindex @samp{Previous-Sequence} MH profile component
@cindex sequence, @samp{cur}
@cindex sequence, @samp{Previous-Sequence}
-@vindex mh-whitelist-preserves-sequences-flag
+@vindex mh-allowlist-preserves-sequences-flag
If a message is in any sequence (except @samp{Previous-Sequence:} and
-@samp{cur}) when it is whitelisted, then it will still be in those
+@samp{cur}) when it is allowlisted, then it will still be in those
sequences in the destination folder. If this behavior is not desired,
-then turn off the option @code{mh-whitelist-preserves-sequences-flag}.
+then turn off the option @code{mh-allowlist-preserves-sequences-flag}.
@cindex @file{*MH-E Log*}
@cindex buffers, @file{*MH-E Log*}
@@ -7687,7 +7687,7 @@ By default, the programs are run in the foreground, but
this can be
slow when junking large numbers of messages. If you have enough memory
or don't junk that many messages at the same time, you might try
turning on the option @code{mh-junk-background}. @footnote{Note that
-the option @code{mh-junk-background} is used as the @code{display}
+the option @code{mh-junk-background} is used as the @code{destination}
argument in the call to @code{call-process}. Therefore, turning on
this option means setting its value to @samp{0}. You can also set its
value to @samp{t} to direct the programs' output to the @file{*MH-E
@@ -7756,33 +7756,33 @@ the @samp{+spam} folder for later review. The major
weakness of
rules-based filters is a plethora of false positives so it is
worthwhile to check.
-@findex mh-junk-blacklist
-@findex mh-junk-whitelist
+@findex mh-junk-blocklist
+@findex mh-junk-allowlist
@kindex J b
-@kindex J w
+@kindex J a
If SpamAssassin classifies a message incorrectly, or is unsure, you can
-use the MH-E commands @kbd{J b} (@code{mh-junk-blacklist}) and
-@kbd{J w} (@code{mh-junk-whitelist}).
+use the MH-E commands @kbd{J b} (@code{mh-junk-blocklist}) and
+@kbd{J a} (@code{mh-junk-allowlist}).
@cindex @command{sa-learn}
@cindex @file{.spamassassin/user_prefs}
@cindex files, @file{.spamassassin/user_prefs}
-The command @kbd{J b} (@code{mh-junk-blacklist}) adds a
+The command @kbd{J b} (@code{mh-junk-blocklist}) adds a
@samp{blacklist_from} entry to @file{~/spamassassin/user_prefs},
deletes the message, and sends the message to the Razor, so that
others might not see this spam. If the @command{sa-learn} command is
available, the message is also recategorized as spam.
-The command@kbd{J w} (@code{mh-junk-whitelist}) adds a
+The command@kbd{J a} (@code{mh-junk-allowlist}) adds a
@samp{whitelist_from} rule to @samp{~/.spamassassin/user_prefs}. If
the @command{sa-learn} command is available, the message is also
recategorized as ham.
Over time, you'll observe that the same host or domain occurs
repeatedly in the @samp{blacklist_from} entries, so you might think
-that you could avoid future spam by blacklisting all mail from a
+that you could avoid future spam by blocklisting all mail from a
particular domain. The utility function
@code{mh-spamassassin-identify-spammers} helps you do precisely that.
This function displays a frequency count of the hosts and domains in
@@ -7796,7 +7796,7 @@ blacklist_from *@@*amazingoffersdirect2u.com
@end smallexample
In versions of SpamAssassin (2.50 and on) that support a Bayesian
-classifier, @kbd{J b} @code{(mh-junk-blacklist}) uses the program
+classifier, @kbd{J b} @code{(mh-junk-blocklist}) uses the program
@command{sa-learn} to recategorize the message as spam. Neither MH-E,
nor SpamAssassin, rebuilds the database after adding words, so you
will need to run @samp{sa-learn --rebuild} periodically. This can be
@@ -7856,14 +7856,14 @@ spam/.
spam/unsure/.
@end smallexample
-@findex mh-junk-blacklist
-@findex mh-junk-whitelist
+@findex mh-junk-blocklist
+@findex mh-junk-allowlist
@kindex J b
-@kindex J w
+@kindex J a
If bogofilter classifies a message incorrectly, or is unsure, you can
-use the MH-E commands @kbd{J b} (@code{mh-junk-blacklist}) and @kbd{J
-w} (@code{mh-junk-whitelist}) to update bogofilter's training.
+use the MH-E commands @kbd{J b} (@code{mh-junk-blocklist}) and
+@kbd{J a} (@code{mh-junk-allowlist}) to update bogofilter's training.
The @cite{Bogofilter FAQ} suggests that you run the following
occasionally to shrink the database:
@@ -7908,14 +7908,14 @@ SCORE=| spamprobe receive
spam/.
@end smallexample
-@findex mh-junk-blacklist
-@findex mh-junk-whitelist
+@findex mh-junk-blocklist
+@findex mh-junk-allowlist
@kindex J b
-@kindex J w
+@kindex J a
If SpamProbe classifies a message incorrectly, you can use the MH-E
-commands @kbd{J b} (@code{mh-junk-blacklist}) and @kbd{J w}
-(@code{mh-junk-whitelist}) to update SpamProbe's training.
+commands @kbd{J b} (@code{mh-junk-blocklist}) and @kbd{J a}
+(@code{mh-junk-allowlist}) to update SpamProbe's training.
@subheading Other Things You Can Do
@@ -8816,8 +8816,8 @@ hands several times since then. Jim Larus wanted to do
something
similar for GNU Emacs, and ended up completely rewriting it that same
year. In 1989, Stephen Gildea picked it up and added many
improvements. Bill Wohler then took over in 2000 and moved its
-development to @uref{https://sourceforge.net/, SourceForge} where it
-lives today.
+development to @uref{https://sourceforge.net/, SourceForge}.
+Since 2016, MH-E development occurs within the Emacs repository.
@menu
* From Brian Reid::
diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi
index ca7dabe..f5d5675 100644
--- a/doc/misc/smtpmail.texi
+++ b/doc/misc/smtpmail.texi
@@ -264,12 +264,14 @@ file, @pxref{Top,,auth-source, auth, Emacs auth-source
Library}.
@cindex CRAM-MD5
@cindex PLAIN
@cindex LOGIN
-The process by which the SMTP library authenticates you to the server
-is known as ``Simple Authentication and Security Layer'' (SASL).
-There are various SASL mechanisms, and this library supports three of
-them: CRAM-MD5, PLAIN, and LOGIN, where the first uses a form of
+The process by which the @acronym{SMTP} library authenticates you to
+the server is known as ``Simple Authentication and Security Layer''
+(@acronym{SASL}). There are various @acronym{SASL} mechanisms, and
+this library supports three of them: @code{cram-md5}, @code{plain},
+@code{login} and @code{xoauth2}, where the first uses a form of
encryption to obscure your password, while the other two do not. It
-tries each of them, in that order, until one succeeds. You can
+tries each of them, in that order, until one succeeds.
+(@code{xoauth2} requires using the @file{oauth2.el} library. You can
override this by assigning a specific authentication mechanism to a
server by including a key @code{smtp-auth} with the value of your
preferred mechanism in the appropriate @file{~/.authinfo} entry.
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 088352e..b2dcddc 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -1290,7 +1290,7 @@ they are added here for the benefit of @ref{Archive file
names}.
If you want to use @acronym{GVFS}-based @option{ftp} or @option{smb}
methods, you must add them to @code{tramp-gvfs-methods}, and you must
-disable the corresponding Tramp package by setting
+disable the corresponding @value{tramp} package by setting
@code{tramp-ftp-method} or @code{tramp-smb-method} to @code{nil},
respectively:
@@ -2122,9 +2122,9 @@ to construct these lists.
@item @t{"remote-shell"}
-This property tells Tramp which remote shell to apply on the remote
-host. It is used in all connection methods of @file{tramp-sh.el}.
-The default value is @t{"/bin/sh"}.
+This property tells @value{tramp} which remote shell to apply on the
+remote host. It is used in all connection methods of
+@file{tramp-sh.el}. The default value is @t{"/bin/sh"}.
@item @t{"remote-shell-login"}
@@ -2310,9 +2310,9 @@ trouble with the shell prompt due to set zle options will
be avoided.
For @command{bash}, loading @file{~/.editrc} or @file{~/.inputrc} is
suppressed.
-Similar problems can happen with the local shell Tramp uses to create
-a process. By default, it uses the command @command{/bin/sh} for
-this, which could also be a link to another shell. In order to
+Similar problems can happen with the local shell @value{tramp} uses to
+create a process. By default, it uses the command @command{/bin/sh}
+for this, which could also be a link to another shell. In order to
overwrite this, you might apply
@vindex tramp-encoding-shell
@@ -3734,6 +3734,33 @@ To open @command{powershell} as a remote shell, use this:
@end lisp
+@subsection Remote process connection type
+@vindex process-connection-type
+@cindex tramp-process-connection-type
+
+Asynchronous processes differ in the way, whether they use a pseudo
+tty, or not. This is controlled by the variable
+@code{process-connection-type}, which can be @code{t} or @code{pty}
+(use a pseudo tty), or @code{nil} or @code{pipe} (don't use it).
+@value{tramp} is based on running shells on the remote host, which
+require a pseudo tty. Therefore, it declares the variable
+@code{tramp-process-connection-type}, which carries this information
+for remote processes. Per default, its value is @code{t}, and there's
+no need to change it. The name of the remote pseudo tty is returned
+by the function @code{process-tty-name}.
+
+If a remote process, started by @code{start-file-process}, shouldn't
+use a pseudo tty, this can be indicated by setting
+@code{process-connection-type} to @code{nil} or @code{pipe}. There is
+still a pseudo tty for the started process, but some terminal
+properties are changed, like suppressing translation of carriage
+return characters into newline.
+
+The function @code{make-process} allows an explicit setting by the
+@code{:connection-type} keyword. If this keyword is not used, the
+value of @code{process-connection-type} is applied instead.
+
+
@anchor{Improving performance of asynchronous remote processes}
@subsection Improving performance of asynchronous remote processes
@cindex Asynchronous remote processes
@@ -4255,7 +4282,9 @@ test, @ref{Cleanup remote connections}. Alternatively,
and often
better for analysis, reproduce the problem in a clean Emacs session
started with @command{emacs -Q}. Then, @value{tramp} does not load
the persistency file (@pxref{Connection caching}), and it does not use
-passwords from @file{auth-source.el} (@pxref{Password handling}).
+passwords from @file{auth-source.el} (@pxref{Password handling}). The
+latter does not happen for the @option{sudoedit} method, otherwise it
+would be unusable.
When including @value{tramp}'s messages in the bug report, increase
the verbosity level to 6 (@pxref{Traces and Profiles, Traces}) in the
@@ -4576,6 +4605,16 @@ supported on your proxy host.
@item
+Does @value{tramp} support @acronym{SSH} security keys?
+
+Yes. @command{OpenSSH} has added support for @acronym{FIDO} hardware
+devices via special key types @option{*-sk}. @value{tramp} supports
+the additional handshaking messages for them. This requires at least
+@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} compatible
+security key, like yubikey, solokey, or nitrokey.
+
+
+@item
@value{tramp} does not connect to Samba or MS Windows hosts running
SMB1 connection protocol
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index 10c951d..b11ee39 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -8,7 +8,7 @@
@c In the Tramp GIT, the version numbers are auto-frobbed from
@c tramp.el, and the bug report address is auto-frobbed from
@c configure.ac.
-@set trampver 2.5.1
+@set trampver 2.5.2-pre
@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
@set emacsver 25.1
diff --git a/etc/DISTRIB b/etc/DISTRIB
index 610c347..3dd1bf3 100644
--- a/etc/DISTRIB
+++ b/etc/DISTRIB
@@ -73,8 +73,7 @@ you can contribute.
Your donations will help to support the development of additional GNU
software. GNU/Linux systems (variants of GNU, based on the kernel
Linux) have millions of users, but there is still much to be done.
-For more information on GNU, see the file 'GNU' in this directory (see
-above).
+For more information on GNU, visit https://www.gnu.org/.
Richard M Stallman
Chief GNUisance, Founder of the FSF
diff --git a/etc/NEWS b/etc/NEWS
index e4b0809..f033176 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes.
-Copyright (C) 2017-2021 Free Software Foundation, Inc.
+Copyright (C) 2019-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Emacs bug reports to 'bug-gnu-emacs@gnu.org'.
@@ -31,9 +31,6 @@ and also requires GCC and Binutils to be available when Lisp
code is
natively compiled. See the Info node "(elisp) Native Compilation" for
more details.
----
-** Support for building with Motif has been removed.
-
** The Cairo graphics library is now used by default if present.
'--with-cairo' is now the default, if the appropriate development files
are found by 'configure'. Note that building with Cairo means using
@@ -52,11 +49,6 @@ 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
@@ -70,8 +62,12 @@ 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.
+** Building without double buffering support.
+'configure --with-xdbe=no' can now be used to disable double buffering
+at build time.
+
+---
+** Support for building with Motif has been removed.
---
** The configure option '--without-makeinfo' has been removed.
@@ -84,6 +80,10 @@ GCC has withdrawn the '-fcheck-pointer-bounds' option and
support for
its implementation has been removed from the Linux kernel.
---
+** The ftx font backend driver has been removed.
+It was declared obsolete in Emacs 27.1.
+
+---
** 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.
@@ -92,20 +92,16 @@ proper pty support that Emacs needs.
* Startup Changes in Emacs 28.1
---
-** File names given on the command line will now be pushed onto
-'file-name-history'.
-
----
** In GTK builds, Emacs now supports startup notification.
This means that Emacs won't steal keyboard focus upon startup
(when started via the Desktop) if the user is typing into another
application.
-** Emacs can support 24-bit color TTY without terminfo database.
-If your text-mode terminal supports 24-bit true color, but your system
-lacks the terminfo database, you can instruct Emacs to support 24-bit
-true color by setting 'COLORTERM=truecolor' in the environment. This is
-useful on systems such as FreeBSD which ships only with "etc/termcap".
+---
+** Errors in 'kill-emacs-hook' no longer prevent Emacs from shutting down.
+If a function in that hook signals an error in an interactive Emacs,
+the user will be prompted on whether to continue. If the user doesn't
+answer within five seconds, Emacs will continue shutting down anyway.
** Emacs now supports loading a Secure Computing filter.
This is supported only on capable GNU/Linux systems. To activate,
@@ -118,65 +114,56 @@ avoid security issues when executing untrusted code. See
the manual
page for 'seccomp' system call, for details about Secure Computing
filters.
-** Setting 'fill-column' to nil is obsolete.
-This undocumented use of 'fill-column' is now obsolete. To disable
-auto filling, turn off 'auto-fill-mode' instead.
-
-For instance, you could add something like the following to your init
-file:
+** 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".
- (add-hook 'foo-mode-hook (lambda () (auto-fill-mode -1))
+---
+** File names given on the command line are now be pushed onto history.
+The file names will be pushed onto 'file-name-history', like the names
+of files visited via 'C-x C-f' and other commands.
* Changes in Emacs 28.1
-** 'blink-cursor-mode' is now enabled by default regardless of the UI.
-It used to be enabled when Emacs is started in GUI mode but not when started
-in text mode. The cursor still only actually blinks in GUI frames.
-
+++
-** Etags now supports the Mercury programming language.
-See https://mercurylang.org.
-
-+++
-** Etags command line option '--declarations' now has Mercury-specific
behavior.
-All Mercury declarations are tagged by default. However, for
-compatibility with 'etags' support for Prolog, predicates and
-functions appearing first in clauses will also be tagged if 'etags' is
-invoked with the '--declarations' command-line option.
+** New command 'execute-extended-command-for-buffer'.
+This new command, bound to 'M-S-x', works like
+'execute-extended-command', but limits the set of commands to the
+commands that have been determined to be particularly useful with the
+current mode.
+++
-** New command 'font-lock-update', bound to 'C-x x f'.
-This command updates the syntax highlighting in this buffer.
-
-** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA.
+** New user option 'read-extended-command-predicate'.
+This user option controls how 'M-x' performs completion of commands when
+you type 'TAB'. By default, any command that matches what you have
+typed is considered a completion candidate, but you can customize this
+option to exclude commands that are not applicable to the current
+buffer's major and minor modes, and respect the command's completion
+predicate (if any).
+++
-** New command 'recenter-other-window', bound to 'S-M-C-l'.
-Like 'recenter-top-bottom' acting in the other window.
+** Completion on 'M-x' shows key bindings for commands.
+When 'suggest-key-bindings' is non-nil (as it is by default), the
+completion list popped up by 'M-x' shows the key bindings for all the
+commands shown in the list of candidate completions that have a key
+binding.
-** Minibuffer scrolling is now conservative by default.
-This is controlled by the new variable 'scroll-minibuffer-conservatively'.
+** New user option 'completions-detailed'.
+When non-nil, some commands like 'describe-symbol' show more detailed
+completions with more information in completion prefix and suffix.
+The default is nil.
-In addition, there is a new variable
-'redisplay-adhoc-scroll-in-resize-mini-windows' to disable the
-ad-hoc auto-scrolling when resizing minibuffer windows. It has been
-found that its heuristic can be counter productive in some corner
-cases, tho the cure may be worse than the disease. This said, the
-effect should be negligible in the vast majority of cases anyway.
+---
+** 'C-s' in 'M-x' now once again searches over completions.
+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.
-+++
-** Improved handling of minibuffers on switching frames.
-By default, when you switch to another frame, an active minibuffer now
-moves to the newly selected frame. Nevertheless, the effect of what
-you type in the minibuffer happens in the frame where the minibuffer
-was first activated. An alternative behavior is available by
-customizing 'minibuffer-follows-selected-frame' to nil. Here, the
-minibuffer stays in the frame where you first opened it, and you must
-switch back to this frame to continue or abort its command. The old
-behavior, which mixed these two, can be approximated by customizing
-'minibuffer-follows-selected-frame' to a value which is neither nil
-nor t.
+---
+** User option 'completions-format' supports a new value 'one-column'.
+++
** New system for displaying documentation for groups of functions.
@@ -185,71 +172,125 @@ choosing a group, or clicking a button in the "*Help*"
buffers when
looking at the doc string of a function that belongs to one of these
groups.
++++
+** New minor mode 'context-menu-mode' for context menus popped by 'mouse-3'.
+When this mode is enabled, clicking 'down-mouse-3' anywhere in the buffer
+pops up a menu whose contents depends on surrounding context near the
+mouse click. You can change the order of the default sub-menus in the
+context menu by customizing the user option 'context-menu-functions'.
+You can also invoke the context menu by pressing 'S-<F10>'.
+
++++
+** A new keymap for buffer actions has been added.
+The 'C-x x' keymap now holds keystrokes for various buffer-oriented
+commands. The new keystrokes are 'C-x x g' ('revert-buffer-quick'),
+'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), 'C-x x n'
+('clone-buffer'), 'C-x x i' ('insert-buffer'), 'C-x x t'
+('toggle-truncate-lines') and 'C-x x f' ('font-lock-update').
+
++++
+** Modifiers now go outside angle brackets in pretty-printed key bindings.
+For example, 'RET' with Control and Meta modifiers is now shown as
+'C-M-<return>' instead of '<C-M-return>'. Either variant can be used
+as input; functions such as 'kbd' and 'read-kbd-macro' accept both
+styles as equivalent (they have done so for a long time).
+
---
-** Improved "find definition" feature of "*Help*" buffers.
-Now clicking on the link to find the definition of functions generated
-by 'cl-defstruct', or variables generated by 'define-derived-mode',
-for example, will go to the exact place where they are defined.
+** 'eval-expression' 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 variable 'redisplay-skip-initial-frame' to enable batch redisplay tests.
-Setting it to nil forces the redisplay to do its job even in the
-initial frame used in batch mode.
++++
+** 'eval-last-sexp' now handles 'defvar'/'defcustom'/'defface' specially.
+This command would previously not redefine values defined by these
+forms, but this command has now been changed to work more like
+'eval-defun', and reset the values as specified.
---
-** 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.
+** New user option 'use-short-answers'.
+When non-nil, the function 'y-or-n-p' is used instead of
+'yes-or-no-p'. This eliminates the need to define an alias that maps
+one to another in the init file. The same user option also controls
+whether the function 'read-answer' accepts short answers.
+++
-** 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 user option 'kill-buffer-delete-auto-save-files'.
+If non-nil, killing a buffer that has an auto-save file will prompt
+the user for whether that file should be deleted. (Note that
+'delete-auto-save-files', if non-nil, was previously documented to
+result in deletion of auto-save files when killing a buffer without
+unsaved changes, but this has apparently not worked for several
+decades, so the documented semantics of this variable has been changed
+to match the behaviour.)
+++
-** 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.
+** New user option 'next-error-message-highlight'.
+In addition to a fringe arrow, 'next-error' error may now optionally
+highlight the current error message in the 'next-error' buffer.
+This user option can be also customized to keep highlighting on all
+visited errors, so you can have an overview what errors were already visited.
-** 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 choice 'next-error-quit-window' for 'next-error-found-function'.
+When 'next-error-found-function' is customized to 'next-error-quit-window',
+then typing the numeric prefix argument 0 before the command 'next-error'
+will quit the source window after visiting the next occurrence.
+++
-** New user option '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.
+** New user option 'file-preserve-symlinks-on-save'.
+This controls what Emacs does when saving buffers that visit files via
+symbolic links, and 'file-precious-flag' is non-nil.
+
++++
+** New user option 'copy-directory-create-symlink'.
+If non-nil, will make 'copy-directory' (when used on a symbolic
+link) copy the link instead of following the link. The default is
+nil, so the default behavior is unchanged.
+
++++
+** New user option 'ignored-local-variable-values'.
+This is the opposite of 'safe-local-variable-values' -- it's an alist
+of variable-value pairs that are to be ignored when reading a
+local-variables section of a file.
---
-** Rudimentary support for the 'st' terminal emulator.
-Emacs now supports 256 color display on the 'st' terminal emulator.
+** 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.
+
++++
+** ".dir-locals.el" now supports setting 'auto-mode-alist'.
+The new 'auto-mode-alist' specification in ".dir-locals.el" files can
+now be used to override the global 'auto-mode-alist' in the current
+directory tree.
---
-** 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.)
+** 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.
---
-** Mouse wheel scrolling now defaults to one line at a time.
+** 'remove-hook' is now an interactive command.
+
+** Frames
+++
-** Mouse wheel scrolling with Shift modifier now scrolls horizontally.
-This works in text buffers and over images. Typing a numeric prefix arg
-(e.g. 'M-5') before starting horizontal scrolling changes its step value.
-The value is saved in the user option 'mouse-wheel-scroll-amount-horizontal'.
+*** The 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.
+
++++
+*** New command 'clone-frame' (bound to 'C-x 5 c').
+This is like 'C-x 5 2', but uses the frame parameters of the current
+frame instead of 'default-frame-alist'.
---
-** The default value of 'frame-title-format' and 'icon-title-format' has
changed.
+*** Default values of 'frame-title-format' and 'icon-title-format' have
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
@@ -260,306 +301,309 @@ your init file:
("" invocation-name "@" system-name)))
+++
-** 'nobreak-char-display' now also affects all non-ASCII space characters.
-Previously, this was limited only to NO-BREAK-SPACE and hyphen
-characters. Now it also covers the rest of the non-ASCII Unicode
-space characters.
+*** New frame parameter 'drag-with-tab-line'.
+This parameter, similar to 'drag-with-header-line', allows moving frames
+by dragging the tab lines of their topmost windows with the mouse.
+
++++
+*** New optional behavior of 'delete-other-frames'.
+When invoked with a prefix argument, 'delete-other-frames' now
+iconifies frames, rather than deleting them.
---
-** Prefer "chat.freenode.net" to "irc.freenode.net".
-"chat.freenode.net" has been the preferred address for connecting to the
-freenode IRC network for years now. Occurrences of "irc.freenode.net"
-have been replaced with "chat.freenode.net" throughout Emacs.
+*** Commands 'set-frame-width' and 'set-frame-height' now prompt for values.
+These commands now prompt for the value via the minibuffer, instead of
+requiring the user to specify the value via the prefix argument.
-+++
-** New functions 'null-device' and 'path-separator'.
-These functions return the connection local value of the respective
-variables. This can be used for remote hosts.
+** Windows
-** Emacs now prints a backtrace when signaling an error in batch mode.
-This makes debugging Emacs Lisp scripts run in batch mode easier. To
-get back the old behavior, set the new variable
-'backtrace-on-error-noninteractive' to a nil value.
+*** 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.
-** 'redisplay-skip-fontification-on-input' helps Emacs keep up with fast input.
-This is another attempt to solve the problem of handling high key repeat rate
-and other "slow scrolling" situations. It is hoped it behaves better
-than 'fast-but-imprecise-scrolling' and 'jit-lock-defer-time'.
-It is not enabled by default.
+*** 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.
+++
-** Modifiers now go outside angle brackets in pretty-printed key bindings.
-For example, 'RET' with Control and Meta modifiers is now shown as
-'C-M-<return>' instead of '<C-M-return>'. Either variant can be used
-as input; functions such as 'kbd' and 'read-kbd-macro' accept both
-styles as equivalent (they have done so for a long time).
+*** New command 'recenter-other-window', bound to 'S-M-C-l'.
+Like 'recenter-top-bottom' acting on the other window.
+++
-** New user option 'lazy-highlight-no-delay-length'.
-Lazy highlighting of matches in Isearch now starts immediately if the
-search string is at least this long. 'lazy-highlight-initial-delay'
-still applies for shorter search strings, which avoids flicker in the
-search buffer due to too many matches being highlighted.
+*** New user option 'delete-window-choose-selected'.
+This allows to choose a window that will be the frame's selected
+window after deleting the currently selected one.
+++
-** A new keymap for buffer actions has been added.
-The 'C-x x' keymap now holds keystrokes for various buffer-oriented
-commands. The new keystrokes are 'C-x x g' ('revert-buffer'),
-'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), 'C-x x n'
-('clone-buffer'), 'C-x x i' ('insert-buffer'), 'C-x x t'
-('toggle-truncate-lines') and 'C-x x f' ('font-lock-update').
+*** New argument NO-OTHER for some window functions.
+'get-lru-window', 'get-mru-window' and 'get-largest-window' now accept a
+new optional argument NO-OTHER which, if non-nil, avoids returning a
+window whose 'no-other-window' parameter is non-nil.
----
-** Commands 'set-frame-width' and 'set-frame-height' can now get their
-input using the minibuffer.
++++
+*** New 'display-buffer' function 'display-buffer-use-least-recent-window'.
+This is like 'display-buffer-use-some-window', but won't reuse the
+current window, and when called repeatedly will try not to reuse a
+previously selected window.
----
-** New help window when Emacs prompts before opening a large file.
-Commands like 'find-file' or 'visit-tags-table' ask to visit a file
-normally or literally when the file is larger than a certain size (by
-default, 9.5 MiB). Press '?' or 'C-h' in that prompt to read more
-about the different options to visit a file, how you can disable the
-prompt, and how you can tweak the file size threshold.
+*** New function 'window-bump-use-time'.
+This updates the use time of a window.
-+++
-** New user option 'query-about-changed-file'.
-If non-nil (the default), users are prompted as before when
-re-visiting a file that has changed externally after it was visited
-the first time. If nil, the user is not prompted, but instead the
-buffer is opened with its contents before the change, and the user is
-given instructions how to revert the buffer.
+** Minibuffer
+
+*** Minibuffer scrolling is now conservative by default.
+This is controlled by the new variable 'scroll-minibuffer-conservatively'.
+It is t by default; setting it to nil will cause scrolling in the
+minibuffer obey the value of 'scroll-conservatively'.
+++
-** Improved support for terminal emulators that encode the Meta flag.
-Some terminal emulators set the 8th bit of Meta characters, and then
-encode the resulting character code as if it were non-ASCII character
-above codepoint 127. Previously, the only way of using these in Emacs
-was to set up the terminal emulator to use the 'ESC' characters to send
-Meta characters to Emacs, e.g., send "ESC x" when the user types
-'M-x'. You can now avoid the need for this setup of such terminal
-emulators by using the new input-meta-mode with the special value
-'encoded' with these terminal emulators.
+*** Improved handling of minibuffers on switching frames.
+By default, when you switch to another frame, an active minibuffer now
+moves to the newly selected frame. Nevertheless, the effect of what
+you type in the minibuffer happens in the frame where the minibuffer
+was first activated. An alternative behavior is available by
+customizing 'minibuffer-follows-selected-frame' to nil. Here, the
+minibuffer stays in the frame where you first opened it, and you must
+switch back to this frame to continue or abort its command. The old
+behavior, which mixed these two, can be approximated by customizing
+'minibuffer-follows-selected-frame' to a value which is neither nil
+nor t.
+++
-** New frame parameter 'drag-with-tab-line'.
-This parameter, similar to 'drag-with-header-line', allows moving frames
-by dragging the tab lines of their topmost windows with the mouse.
-
-
-* Editing Changes in Emacs 28.1
+*** New user option 'read-minibuffer-restore-windows'.
+When customized to nil, it uses 'minibuffer-restore-windows' in
+'minibuffer-exit-hook' to remove only the window showing the
+"*Completions*" buffer.
---
-** Dragging a file to Emacs will now also push the name of the file
-onto 'file-name-history'.
+*** New variable 'redisplay-adhoc-scroll-in-resize-mini-windows'.
+Customizing it to nil will disable the ad-hoc auto-scrolling of
+minibuffer text shown in mini-windows when resizing those windows.
+The default heuristics of that scrolling can be counter productive in
+some corner cases, though the cure might be worse than the disease.
+This said, the effect should be negligible in the vast majority of
+cases anyway.
-+++
-** A prefix arg now causes 'delete-other-frames' to only iconify frames.
+** Mode Line
+++
-** The "Edit => Clear" menu item now obeys a rectangular region.
+*** New user option 'mode-line-compact'.
+If non-nil, repeating spaces are compressed into a single space. If
+'long', this is only done when the mode line is longer than the
+current window width (in columns).
+++
-** New command 'execute-extended-command-for-buffer'.
-This new command, bound to 'M-S-x', works like
-'execute-extended-command', but limits the set of commands to the
-commands that have been determined to be particularly useful with the
-current mode.
+*** New user options to control format 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).
+
+** Tab Bars and Tab Lines
+
+*** The prefix key 'C-x t t' can be used to display a buffer in a new tab.
+Typing 'C-x t t' before a command will cause the buffer shown by that
+command to be displayed in a new tab. 'C-x t t" is bound to the
+command 'other-tab-prefix'.
+++
-** New user option 'read-extended-command-predicate'.
-This user option controls how 'M-x' performs completion of commands when
-you type 'TAB'. By default, any command that matches what you have
-typed is considered a completion candidate, but you can customize this
-option to exclude commands that are not applicable to the current
-buffer's major and minor modes, and respect the command's completion
-predicate (if any).
+*** New command 'C-x t C-r' to open file read-only in the other tab.
---
-** '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.
+*** 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'.
-+++
-** 'eval-last-sexp' now handles 'defvar'/'defcustom'/'defface' specially.
-This command would previously not redefine values defined by these
-forms, but this command has now been changed to work more like
-'eval-defun', and reset the values as specified.
+---
+*** New command 'toggle-frame-tab-bar'.
+It can be used to enable/disable the tab bar on the currently selected
+frame regardless of the values of 'tab-bar-mode' and 'tab-bar-show'.
-+++
-** Standalone 'M-y' allows interactive selection from previous kills.
-'M-y' can now be typed after a command that is not a yank command.
-When invoked like that, it prompts in the minibuffer for one of the
-previous kills, offering completion and minibuffer-history navigation
-through previous kills recorded in the kill ring. A similar feature
-in Isearch can be invoked if you bind 'C-s M-y' to the command
-'isearch-yank-pop'. When the user option 'yank-from-kill-ring-rotate'
-is nil the kill ring is not rotated after 'yank-from-kill-ring'.
+---
+*** New user option 'tab-bar-format' defines a list of tab bar items.
+When it contains 'tab-bar-format-global' (possibly appended after
+'tab-bar-format-align-right'), then after enabling 'display-time-mode'
+(or any other mode that uses 'global-mode-string') it displays time
+aligned to the right on the tab bar instead of on the mode line.
+When 'tab-bar-format-tabs' is replaced with 'tab-bar-format-tabs-groups',
+the tab bar displays tab groups.
---
-** New user options 'copy-region-blink-delay' and 'delete-pair-blink-delay'.
-'copy-region-blink-delay' specifies a delay to indicate the region
-copied by 'kill-ring-save'. 'delete-pair-blink-delay' specifies
-a delay to show a paired character to delete.
+*** 'Mod-9' bound to 'tab-last' now switches to the last tab.
+It also supports a negative argument.
-+++
-** New command 'undo-redo'.
-It undoes previous undo commands, but doesn't record itself as an
-undoable command.
+---
+*** New command 'tab-duplicate' bound to 'C-x t n'.
-+++
-** '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.
+---
+*** 'C-x t N' creates a new tab at the specified absolute position.
+The position is provided as prefix arg, and specifies an index that
+starts at 1. Negative values count from the end of the tab bar.
-+++
-** Input history for 'goto-line' can now be made local to every buffer.
-In any event, line numbers used with 'goto-line' are kept in their own
-history list. This should help make faster the process of finding
-line numbers that were previously jumped to. By default, all buffers
-share a single history list. To make every buffer have its own
-history list, customize the user option 'goto-line-history-local'.
+---
+*** 'C-x t M' moves the current tab to the specified absolute position.
+The position is provided as prefix arg, whose interpretation is as in
+'C-x t N'.
-+++
-** 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.
-'goto-line-relative' is bound to 'C-x n g'.
+---
+*** 'C-x t G' assigns a tab to a named group of tabs.
+'tab-close-group' closes all tabs that belong to the selected group.
+The user option 'tab-bar-new-tab-group' defines the default group of
+new tabs. After customizing 'tab-bar-tab-post-change-group-functions'
+to 'tab-bar-move-tab-to-group', changing the group of a tab will also
+move it closer to other tabs in the same group.
-+++
-** When called interactively, 'goto-char' now offers the number at
-point as default.
+---
+*** New user option 'tab-bar-tab-name-format-function'.
-+++
-** When 'suggest-key-bindings' is non-nil, the completion list of 'M-x'
-shows equivalent key bindings for all commands that have them.
+---
+*** New user option 'tab-line-tab-name-format-function'.
-** Autosaving via 'auto-save-visited-mode' can now be inhibited by
-setting the variable 'auto-save-visited-mode' buffer-locally to nil.
+---
+*** The tabs in the tab line can now be scrolled using horizontal scroll.
+If your mouse or trackpad supports it, you can now scroll tabs when
+the mouse pointer is in the tab line by scrolling left or right.
-** New 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.
+---
+*** New tab-line faces and options.
+The face 'tab-line-tab-special' is used for tabs whose buffers are
+special, i.e. buffers that don't visit a file. The face
+'tab-line-tab-inactive-alternate' is used to display inactive tabs
+with an alternating background color, making them easier to
+distinguish, especially if the face 'tab-line-tab' is configured to
+not display with a box; this alternate face is only applied when the
+option 'tab-line-tab-face-functions' is so configured. That option
+may also be used to customize tab-line faces in other ways.
-** Obsolete aliases are no longer hidden from command completion.
-Completion of command names now considers obsolete aliases as
-candidates, if they were marked obsolete in the current major version
-of Emacs. Invoking a command via an obsolete alias now mentions the
-obsolescence fact and shows the new name of the command.
+** Mouse wheel
-+++
-** 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.
+---
+*** Mouse wheel scrolling now defaults to one line at a time.
-+++
-** New command 'memory-report'.
-This command opens a new buffer called "*Memory Report*" and gives a
-summary of where Emacs is using memory currently.
+---
+*** 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.)
+++
-** New user option 'isearch-repeat-on-direction-change'.
-When this option is set, direction changes in Isearch move to another
-search match, if there is one, instead of moving point to the other
-end of the current match.
+*** Mouse wheel scrolling with Shift modifier now scrolls horizontally.
+This works in text buffers and over images. Typing a numeric prefix arg
+(e.g. 'M-5') before starting horizontal scrolling changes its step value.
+The value is saved in the user option 'mouse-wheel-scroll-amount-horizontal'.
-** Outline
+** Customize
-+++
-*** New commands to cycle heading visibility.
-Typing 'TAB' on a heading line cycles the current section between
-"hide all", "subheadings", and "show all" states. Typing 'S-TAB'
-anywhere in the buffer cycles the whole buffer between "only top-level
-headings", "all headings and subheadings", and "show all" states.
+---
+*** Customize buffers can now be reverted with 'C-x x g'.
-*** New user option 'outline-minor-mode-cycle'.
-This user option customizes 'outline-minor-mode', with the difference
-that 'TAB' and 'S-TAB' on heading lines cycle heading visibility.
-Typing 'TAB' on a heading line cycles the current section between
-"hide all", "subheadings", and "show all" states. Typing 'S-TAB' on a
-heading line cycles the whole buffer between "only top-level
-headings", "all headings and subheadings", and "show all" states.
+*** Most customize commands now hide obsolete user options.
+Obsolete user options are no longer shown in the listings produced by
+the commands 'customize', 'customize-group', 'customize-apropos' and
+'customize-changed'.
-*** New user option 'outline-minor-mode-highlight'.
-This user option customizes 'outline-minor-mode'. It puts
-highlighting on heading lines using standard outline faces. This
-works well only when there are no conflicts with faces used by the
-major mode.
+To customize obsolete user options, use 'customize-option' or
+'customize-saved'.
-** New commands 'copy-matching-lines' and 'kill-matching-lines'.
-These commands are similar to the command 'flush-lines',
-but add the matching lines to the kill ring as a single string,
-including the newlines that separate the lines.
+*** New SVG icons for checkboxes and arrows.
+They will be used automatically instead of the old icons. If Emacs is
+built without SVG support, the old icons will be used instead.
-
-* Changes in Specialized Modes and Packages in Emacs 28.1
+** Help
-** Completion List Mode
-New key bindings have been added: 'n' and 'p' to navigate completions,
-and 'M-g M-c' to switch to the minibuffer, and you can also switch back
-to the completion list buffer with 'M-g M-c'.
++++
+*** New command 'describe-command' shows help for a command.
+This can be used instead of 'describe-function' for interactive
+commands and is globally bound to 'C-h x'.
-** Benchmark
-*** New function 'benchmark-call' to measure the execution time of a function.
-Additionally, the number of repetitions can be expressed as a minimal duration
-in seconds.
++++
+*** New command 'describe-keymap' describes keybindings in a keymap.
-** Macroexp
----
-*** New function 'macroexp-file-name' to know the name of the current file.
----
-*** New function 'macroexp-compiling-p' to know if we're compiling.
----
-*** New function 'macroexp-warn-and-return' to help emit warnings.
-This used to be named 'macroexp--warn-and-return' and has proved useful
-and well-behaved enough to lose the "internal" marker.
+*** New command 'apropos-function'.
+This works like 'C-u M-x apropos-command' but is more discoverable.
-** Bindat
+---
+*** New keybinding 'C-h R' prompts for an Info manual and displays it.
-+++
-*** New 'Bindat type expression' description language.
-This new system is provided by the new macro 'bindat-type' and
-obsoletes the old data layout specifications. It supports
-arbitrary-size integers, recursive types, and more. See the Info node
-"(elisp) Byte Packing" in the ELisp manual for more details.
+---
+*** Keybindings in 'help-mode' use the new 'help-key-binding' face.
+This face is added by 'substitute-command-keys' to any "\[command]"
+substitution. The return value of that function should consequently
+be assumed to be a propertized string.
-** pcase
+Note that the new face will also be used in tooltips. When using the
+GTK toolkit, this is only true if 'x-gtk-use-system-tooltips' is t.
-+++
-*** The 'or' pattern now binds the union of the vars of its sub-patterns.
-If a variable is not bound by the subpattern that matched, it gets bound
-to nil. This was already sometimes the case, but it is now guaranteed.
+---
+*** The 'help-for-help' ('C-h C-h') screen has been redesigned.
+++
-*** The 'pred' pattern can now take the form '(pred (not FUN))'.
-This is like '(pred (lambda (x) (not (FUN x))))' but results
-in better code.
+*** New convenience commands with short keys in the Help buffer.
+New command 'help-view-source' ('s') will view the source file (if
+any) of the current help topic. New command 'help-goto-info' ('i')
+will look up the current symbol (if any) in Info. New command
+'help-customize' ('c') will customize the variable or the face
+(if any) whose doc string is being shown in the Help buffer.
---
-*** New function 'pcase-compile-patterns' to write other macros.
+*** New user option 'describe-bindings-outline'.
+It enables outlines in the output buffer of 'describe-bindings' that
+can provide a better overview in a long list of available bindings.
+++
-** profiler.el
-The results displayed by 'profiler-report' now have the usage figures
-at the left hand side followed by the function name. This is intended
-to make better use of the horizontal space, in particular eliminating
-the truncation of function names. There is no way to get the former
-layout back.
+*** New command 'lossage-size'.
+It allows users to change the maximum number of keystrokes and
+commands recorded for the purpose of 'view-lossage'.
-** Loading dunnet.el in batch mode doesn't start the game any more.
-Instead you need to do "emacs -f dun-batch" to start the game in
-batch mode.
+*** New commands to describe buttons and widgets.
+'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.
-** Emacs Server
+---
+*** Improved "find definition" feature of "*Help*" buffers.
+Now clicking on the link to find the definition of functions generated
+by 'cl-defstruct', or variables generated by 'define-derived-mode',
+for example, will go to the exact place where they are defined.
-+++
+*** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'.
+These new navigation commands are bound to 'n' and 'p' in
+'apropos-mode'.
+
+---
+*** 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.
+
+---
+*** Closing the "*Help*" buffer from the toolbar now buries the buffer.
+In previous Emacs versions, the "*Help*" buffer was killed instead when
+clicking the "X" icon in the tool bar.
+
+---
+*** 'g' ('revert-buffer') in 'help-mode' no longer requires confirmation.
+
+** File Locks
+
++++
+*** New user option 'lock-file-name-transforms'.
+This option allows controlling where lock files are written. It uses
+the same syntax as 'auto-save-file-name-transforms'.
+
++++
+*** New user option 'remote-file-name-inhibit-locks'.
+When non-nil, this option suppresses lock files for remote files.
+
++++
+*** New minor mode 'lock-file-mode'.
+This command, called interactively, toggles the local value of
+'create-lockfiles' in the current buffer.
+
+** Emacs Server
+
++++
*** New user option 'server-client-instructions'.
When emacsclient connects, Emacs will (by default) output a message
about how to exit the client frame. If 'server-client-instructions'
@@ -576,240 +620,396 @@ result of this command.
*** New desktop integration for connecting to the server.
If your operating system’s desktop environment is
freedesktop.org-compatible (which is true of most GNU/Linux and other
-recent Unix-like GUIs), you may use the new "Emacs (Client)" desktop
-menu entry to open files in an existing Emacs instance rather than
-starting a new one. The daemon starts if not already running.
-
-** Perl mode
-
----
-*** New face 'perl-non-scalar-variable'.
-This is used to fontify non-scalar variables.
-
-** Python mode
-
-*** 'python-shell-interpreter' now defaults to python3 on systems with python3.
-
-*** 'C-c C-r' can now be used on arbitrary regions.
-The command previously extended the start of the region to the start
-of the line, but will now actually send the marked region, as
-documented.
-
-** Ruby mode
+recent Unix-like desktops), you may use the new "Emacs (Client)"
+desktop menu entry to open files in an existing Emacs instance rather
+than starting a new one. The daemon starts if it is not already
+running.
-*** '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.
+** Miscellaneous
-** Icomplete
++++
+*** New command 'font-lock-update', bound to 'C-x x f'.
+This command updates the syntax highlighting in this buffer.
----
-*** New user option 'icomplete-matches-format'.
-This allows controlling the current/total number of matches for the
-prompt prefix.
++++
+*** New command 'memory-report'.
+This command opens a new buffer called "*Memory Report*" and gives a
+summary of where Emacs is using memory currently.
+++
-*** New minor mode 'icomplete-vertical-mode', alias 'fido-vertical-mode'.
-This mode is intended to be used with Icomplete ('M-x icomplete-mode')
-or Fido ('M-x fido-mode'), to display the list of completions
-candidates vertically instead of horizontally. When used with
-Icomplete, completions are rotated and selection kept at the top.
-When used with Fido, completions scroll like a typical dropdown
-widget.
+*** New command 'submit-emacs-patch'.
+This works like 'report-emacs-bug', but is more geared towards sending
+patches to the Emacs issue tracker.
-*** Default value of 'icomplete-compute-delay' has been changed to 0.15 s.
+*** New face 'apropos-button'.
+Applies to buttons that indicate a face.
-*** Default value of 'icomplete-max-delay-chars' has been changed to 2.
++++
+*** New face 'font-lock-doc-markup-face'.
+Intended for documentation mark-up syntax and tags inside text that
+uses 'font-lock-doc-face', with which it should harmonise. It would
+typically be used in structured documentation comments in program
+source code by language-specific modes, for mark-up conventions like
+Haddock, Javadoc or Doxygen. By default this face inherits from
+'font-lock-constant-face'.
-*** Reduced blinking while completing the next completions set.
-Icomplete doesn't hide the hint with the previously computed
-completions anymore when compute delay is in effect, or the previous
-computation has been aborted by input. Instead it shows the previous
-completions until the new ones are ready.
++++
+*** New face 'flat-button'.
+This is a plain 2D button, but uses the background color instead of
+the foreground color.
---
-** 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.
-
-** mspool.el
+*** New face 'shortdoc-heading'.
+Applies to headings of shortdoc sections.
---
-*** Autoload the main entry point 'mspool-show'.
+*** New face 'separator-line'.
+This is used by 'make-separator-line' (see below).
-** Windmove
+*** 'redisplay-skip-fontification-on-input' helps Emacs keep up with fast
input.
+This is another attempt to solve the problem of handling high key repeat rate
+and other "slow scrolling" situations. It is hoped it behaves better
+than 'fast-but-imprecise-scrolling' and 'jit-lock-defer-time'.
+It is not enabled by default.
-*** New user options to customize windmove keybindings.
-These options include 'windmove-default-keybindings',
-'windmove-display-default-keybindings',
-'windmove-delete-default-keybindings',
-'windmove-swap-states-default-keybindings'.
+*** Obsolete aliases are no longer hidden from command completion.
+Completion of command names now considers obsolete aliases as
+candidates, if they were marked obsolete in the current major version
+of Emacs. Invoking a command via an obsolete alias now mentions the
+obsolescence fact and shows the new name of the command.
-** Windows
+*** 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 'delete-window-choose-selected'.
-This allows to choose a frame's selected window after deleting the
-previously selected one.
+*** 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 only affects callers that were altered to use
+'format-prompt'.)
-+++
-*** New argument NO-OTHER for some window functions.
-'get-lru-window', ‘get-mru-window’ and 'get-largest-window' now accept a
-new optional argument NO-OTHER which, if non-nil, avoids returning a
-window whose 'no-other-window' parameter is non-nil.
+---
+*** New help window when Emacs prompts before opening a large file.
+Commands like 'find-file' or 'visit-tags-table' ask to visit a file
+normally or literally when the file is larger than a certain size (by
+default, 9.5 MiB). Press '?' or 'C-h' in that prompt to read more
+about the different options to visit a file, how you can disable the
+prompt, and how you can tweak the file size threshold.
+++
-*** New 'display-buffer' function 'display-buffer-use-least-recent-window'.
-This is like 'display-buffer-use-some-window', but won't reuse the
-current window, and when called repeatedly will try not to reuse a
-previously selected window.
-
-*** New function 'window-bump-use-time'.
-This updates the use time of a window.
-
-*** The key prefix 'C-x 4 1' displays next command buffer in the same window.
-It's bound to the command 'same-window-prefix' that requests the buffer
-of the next command to be displayed in the same window.
-
-*** 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.
-
-** Frames
-
-*** The key prefix 'C-x 5 5' displays next command buffer in a new frame.
-It's bound to the command 'other-frame-prefix' that requests the buffer
-of the next command to be displayed in a new frame.
+*** 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.
-** Tab Bars
+---
+*** 'global-display-fill-column-indicator-mode' skips some buffers.
+By default, turning on 'global-display-fill-column-indicator-mode'
+doesn't turn on 'display-fill-column-indicator-mode' in special-mode
+buffers. This can be controlled by customizing the variable
+'global-display-fill-column-indicator-modes'.
-*** 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.
++++
+*** 'nobreak-char-display' now also affects all non-ASCII space characters.
+Previously, this was limited only to 'NO-BREAK SPACE' and hyphen
+characters. Now it also covers the rest of the non-ASCII Unicode
+space characters.
+++
-*** New command 'C-x t C-r' to open file read-only in other tab.
+*** Improved support for terminal emulators that encode the Meta flag.
+Some terminal emulators set the 8th bit of Meta characters, and then
+encode the resulting character code as if it were non-ASCII character
+above codepoint 127. Previously, the only way of using these in Emacs
+was to set up the terminal emulator to use the 'ESC' characters to send
+Meta characters to Emacs, e.g., send "ESC x" when the user types
+'M-x'. You can now avoid the need for this setup of such terminal
+emulators by using the new input-meta-mode with the special value
+'encoded' with these terminal emulators.
---
-*** 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'.
+*** 'auto-composition-mode' can now be selectively disabled on some TTYs.
+Some text-mode terminals produce display glitches trying to compose
+characters. The 'auto-composition-mode' can now have a string value
+that names a terminal type; if the value returned by the 'tty-type'
+function compares equal with that string, automatic composition will
+be disabled in windows shown on that terminal. The Linux terminal
+sets this up by default.
---
-*** New command 'toggle-frame-tab-bar'.
-It can be used to enable/disable the tab bar individually on each frame
-independently from the value of 'tab-bar-mode' and 'tab-bar-show'.
+*** 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.
---
-*** New user option 'tab-bar-format' defines a list of tab bar items.
-When it contains 'tab-bar-format-global' (possibly appended after
-'tab-bar-format-align-right'), then after enabling 'display-time-mode'
-(or any other mode that uses 'global-mode-string') it displays time
-aligned to the right on the tab bar instead of the mode line.
-When 'tab-bar-format-tabs' is replaced with 'tab-bar-format-tabs-groups',
-then the tab bar displays tab groups.
+*** TTY menu navigation is now supported in 'xterm-mouse-mode'.
+TTY menus support mouse navigation and selection when 'xterm-mouse-mode'
+is active. When run on a terminal, clicking on the menu bar with the
+mouse now pops up a TTY menu by default instead of running the command
+'tmm-menubar'. To restore the old behavior, set the user option
+'tty-menu-open-use-tmm' to non-nil.
---
-*** 'Mod-9' bound to 'tab-last' now switches to the last tab.
-It also supports a negative argument.
+*** '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.
---
-*** New command 'tab-duplicate' bound to 'C-x t n'.
+*** 'C-u M-x dig' will now prompt for a query type to use.
---
-*** 'C-x t N' creates a new tab at the specified absolute position.
-It also supports a negative argument.
+*** Rudimentary support for the 'st' terminal emulator.
+Emacs now supports 256 color display on the 'st' terminal emulator.
---
-*** 'C-x t M' moves the current tab to the specified absolute position.
-It also supports a negative argument.
+*** Prefer "chat.freenode.net" to "irc.freenode.net".
+"chat.freenode.net" has been the preferred address for connecting to the
+freenode IRC network for years now. Occurrences of "irc.freenode.net"
+have been replaced with "chat.freenode.net" throughout Emacs.
----
-*** 'C-x t G' assigns a group name to the tab.
-'tab-close-group' can close all tabs that belong to the selected group.
-The user option 'tab-bar-new-tab-group' defines the default group of a
-new tab. After customizing 'tab-bar-tab-post-change-group-functions'
-to 'tab-bar-move-tab-to-group', changing the tab group will also move it
-closer to other tabs in the same group.
+
+* Editing Changes in Emacs 28.1
----
-*** New user option 'tab-bar-tab-name-format-function'.
+** Input methods
+
++++
+*** Emacs now supports "transient" input methods.
+A transient input method is enabled for inserting a single character,
+and is then automatically disabled. 'C-x \' temporarily enables the
+selected transient input method. Use 'C-u C-x \' to select a
+transient input method (which can be different from the input method
+enabled by 'C-\'). For example, 'C-u C-x \ compose RET' selects the
+'compose' input method; then typing 'C-x \ 1 2' will insert the
+character '½', and disable the 'compose' input method afterwards.
+You can use 'C-x \' in incremental search to insert a single character
+to the search string.
---
-*** New user option 'tab-line-tab-name-format-function'.
+*** New input method 'compose' based on X Multi_key sequences.
---
-*** The tabs in the tab line can now be scrolled using horizontal scroll.
-If your mouse or trackpad supports it, you can now scroll tabs when
-the mouse pointer is in the tab line by scrolling left or right.
+*** New input method 'iso-transl' with the same keys as 'C-x 8'.
+After selecting it as a transient input method with 'C-u C-x \
+iso-transl RET', it supports the same key sequences as 'C-x 8',
+so e.g. like 'C-x 8 [' inserts a left single quotation mark,
+'C-x \ [' does the same.
---
-*** New tab-line faces and options.
-The face 'tab-line-tab-special' is used for tabs whose buffers are
-special, i.e. not file-backed. The face
-'tab-line-tab-inactive-alternate' is used to display inactive tabs
-with an alternating background color, making them easier to
-distinguish between, especially if the face 'tab-line-tab' is
-configured to not display with a box; this alternate face is only
-applied when the option 'tab-line-tab-face-functions' is
-so-configured. That option may also be used to customize tab-line
-faces in other ways.
+*** New user option 'read-char-by-name-sort'.
+It defines the sorting order of characters for completion of 'C-x 8 RET TAB'
+and can be customized to sort them by codepoints instead of character names.
+Additionally, you can group characters by Unicode blocks after customizing
+'completions-group' and 'completions-group-sort'.
-** Occur mode
+---
+*** Improved language transliteration in Malayalam input methods.
+Added a new Mozhi scheme. The inapplicable ITRANS scheme is now
+deprecated. Errors in the Inscript method were corrected.
-*** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and
-'previous-error-no-select' bound to 'p'.
+---
+*** New input method 'cham'.
+There's also a Cham greeting in "etc/HELLO".
-*** The new command 'recenter-current-error', bound to 'l' in Occur or
-compilation buffers, recenters the current displayed occurrence/error.
+---
+*** New input methods for Lakota language orthographies.
+Two orthographies are represented here, the Suggested Lakota
+Orthography and what is known as the White Hat Orthography. Input
+methods 'lakota-slo-prefix', 'lakota-slo-postfix', and
+'lakota-white-hat-postfix' have been added. There is also a Lakota
+greeting in "etc/HELLO".
-** EIEIO
++++
+** Standalone 'M-y' allows interactive selection from previous kills.
+'M-y' can now be typed after a command that is not a yank command.
+When invoked like that, it prompts in the minibuffer for one of the
+previous kills, offering completion and minibuffer-history navigation
+through previous kills recorded in the kill ring. A similar feature
+in Isearch can be invoked if you bind 'C-s M-y' to the command
+'isearch-yank-pop'. When the user option 'yank-from-kill-ring-rotate'
+is nil the kill ring is not rotated after 'yank-from-kill-ring'.
+++
-*** 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.
+** 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.
-** New minor mode 'cl-font-lock-built-in-mode' for 'lisp-mode'.
-The mode provides refined highlighting of built-in functions, types,
-and variables.
++++
+** New command 'undo-redo'.
+It undoes previous undo commands, but doesn't record itself as an
+undoable command.
-** Archive mode
++++
+** New commands 'copy-matching-lines' and 'kill-matching-lines'.
+These commands are similar to the command 'flush-lines',
+but add the matching lines to the kill ring as a single string,
+including the newlines that separate the lines.
+
++++
+** New user option 'kill-transform-function'.
+This can be used to transform (and suppress) strings from entering the
+kill ring.
+
++++
+** 'save-interprogram-paste-before-kill' can now be a number.
+In that case, it's interpreted as a limit on the size of the clipboard
+data that will be saved to the 'kill-ring' prior to killing text: if
+the size of the clipboard data is greater than or equal to the limit,
+it will not be saved.
+
++++
+** New user option 'tab-first-completion'.
+If 'tab-always-indent' is 'complete', this new user option can be used to
+further tweak whether to complete or indent.
---
-*** Archive Mode can now parse ".squashfs" files.
+** 'indent-tabs-mode' is now a global minor mode instead of just a variable.
-*** Can now modify members of 'ar' archives.
+---
+** New choice 'permanent' for 'shift-select-mode'.
+When the mark was activated by shifted motion keys, non-shifted motion
+keys don't deactivate the mark after customizing 'shift-select-mode'
+to 'permanent'.
+
++++
+** The "Edit => Clear" menu item now obeys a rectangular region.
+
++++
+** 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.
+
++++
+** New command 'revert-buffer-quick'.
+This is bound to 'C-x x g' and is like 'revert-buffer', but prompts
+less.
+
++++
+** New user option 'revert-buffer-quick-short-answers'.
+This controls how the new 'revert-buffer-quick' ('C-x x g') command
+prompts.
+
++++
+** New user option 'query-about-changed-file'.
+If non-nil (the default), Emacs prompts as before when re-visiting a
+file that has changed externally after it was visited the first time.
+If nil, Emacs does not prompt, but instead shows the buffer with its
+contents before the change, and provides instructions how to revert
+the buffer.
-*** Display of summaries unified between backends.
+** New value 'save-some-buffers-root' of 'save-some-buffers-default-predicate'.
+They allow to ask about saving only those files that are under the
+project root or in subdirectories of the directory that was default
+during command invocation.
-*** New user option 'archive-hidden-columns' and command
-'archive-hideshow-column'. These let you control which columns are
-displayed and which are kept hidden.
+---
+** New user option 'save-place-abbreviate-file-names'.
+This can simplify sharing the 'save-place-file' file across
+different hosts.
---
-*** New command bound to 'C': 'archive-copy-file'.
-This command extracts the file under point and writes the data to a
-file.
+** New user options 'copy-region-blink-delay' and 'delete-pair-blink-delay'.
+'copy-region-blink-delay' specifies a delay to indicate the region
+copied by 'kill-ring-save'. 'delete-pair-blink-delay' specifies
+a delay to show the paired character to delete.
-** Emacs Lisp mode
+---
+** '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.
-*** The mode-line now indicates whether we're using lexical or dynamic scoping.
++++
+** Input history for 'goto-line' can now be made local to every buffer.
+In any event, line numbers used with 'goto-line' are kept in their own
+history list. This should help make faster the process of finding
+line numbers that were previously jumped to. By default, all buffers
+share a single history list. To make every buffer have its own
+history list, customize the user option 'goto-line-history-local'.
-*** 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.
++++
+** New command 'goto-line-relative' for 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.
+'goto-line-relative' is bound to 'C-x n g'.
-** Calendar
++++
+** 'got-char' prompts for the character position.
+When called interactively, 'goto-char' now offers the position at
+point as the default.
+
+** Autosaving via 'auto-save-visited-mode' can now be inhibited.
+Set the variable 'auto-save-visited-mode' buffer-locally to nil to
+achieve that.
+++
-*** 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".
+** New command 'C-x C-k Q' to force redisplay in keyboard macros.
+
+** 'blink-cursor-mode' is now enabled by default regardless of the UI.
+It used to be enabled when Emacs is started in GUI mode but not when started
+in text mode. The cursor still only actually blinks in GUI frames.
+
+
+* Changes in Specialized Modes and Packages in Emacs 28.1
+
+** Isearch and Replace
+
++++
+*** Interactive regular expression search now uses faces for sub-groups.
+E.g., 'C-M-s foo-\([0-9]+\)' will now use the 'isearch-group-1' face
+on the part of the regexp that matches the sub-expression "[0-9]+".
+By default, there are two faces for sub-group highlighting, but you
+can define more faces whose names are of the form 'isearch-group-N',
+where N are successive numbers above 2.
+
+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.
+
++++
+*** Interactive regular expression replace now uses faces for sub-groups.
+Like 'search-highlight-submatches', this is controlled by the new user option
+'query-replace-highlight-submatches'.
+
+*** New user option 'isearch-wrap-pause' defines how to wrap the search.
+There are choices to disable wrapping completely and to wrap immediately.
+When wrapping immediately, it consistently handles the numeric arguments
+of 'C-s' ('isearch-repeat-forward') and 'C-r' ('isearch-repeat-backward'),
+continuing with the remaining count after wrapping.
+
++++
+*** New user option 'isearch-repeat-on-direction-change'.
+When this option is set, direction changes in Isearch move to another
+search match, if there is one, instead of moving point to the other
+end of the current match.
+
+*** New key 'M-s M-.' starts isearch looking for the thing at point.
+This key is bound to the new command 'isearch-forward-thing-at-point'.
+The new user option 'isearch-forward-thing-at-point' defines
+a list of symbols to try to get the "thing" at point. By default,
+the first element of the list is 'region' that tries to yank
+the currently active region to the search string.
+
++++
+*** New user option 'lazy-highlight-no-delay-length'.
+Lazy highlighting of matches in Isearch now starts immediately if the
+search string is at least this long. 'lazy-highlight-initial-delay'
+still applies for shorter search strings, which avoids flicker in the
+search buffer due to too many matches being highlighted.
** Dired
@@ -818,6 +1018,12 @@ time zones will use a form like "+0100" instead of "CET".
If non-nil, Dired will kill the current buffer when selecting a new
directory to display.
++++
+*** Behavior change on 'dired-do-chmod'.
+As a security precaution, Dired's M command no longer follows symbolic
+links. Instead, it changes the symbolic link's own mode; this always
+fails on platforms where such modes are immutable.
+
---
*** Behavior change on 'dired-clean-confirm-killing-deleted-buffers'.
Previously, if 'dired-clean-up-buffers-too' was non-nil, and
@@ -871,14 +1077,16 @@ Non-nil reverts the destination Dired buffer after
performing one
of these operations: 'dired-do-copy', 'dired-do-rename',
'dired-do-symlink', 'dired-do-hardlink'.
-*** New user option 'dired-mark-region' affects all Dired commands
-that mark files. When non-nil and the region is active in Transient
-Mark mode, then Dired commands operate only on files in the active
-region. The values 'file' and 'line' of this user option define the
-details of marking the file at the end of the region.
+*** New user option 'dired-mark-region'.
+This option 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'.
+*** State changing VC operations are supported in Dired.
+These operations are supported on files and directories via the new
+command 'dired-vc-next-action'.
+++
*** 'dired-jump' and 'dired-jump-other-window' moved from 'dired-x' to 'dired'.
@@ -893,280 +1101,240 @@ 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
-
-*** vc-git now sets the GIT_LITERAL_PATHSPECS environment variable.
-This ensures that Git operations on files containing wildcard
-characters work as they're supposed to. However, this also affects
-scripts running from Git hooks, and these have to "unset
-GIT_LITERAL_PATHSPECS" to work as before.
-
-*** 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.
+---
+*** 'dired-query' now uses 'read-char-from-minibuffer'.
+Using it instead of 'read-char-choice' allows using 'C-x o'
+to switch to the help window displayed after typing 'C-h'.
-*** New command 'vc-dir-root' uses the root directory without asking.
+** Outline
----
-*** New face 'log-view-commit-body'.
-This is used when expanding commit messages from 'vc-print-root-log'
-and similar commands.
++++
+*** New commands to cycle heading visibility.
+Typing 'TAB' on a heading line cycles the current section between
+"hide all", "subheadings", and "show all" states. Typing 'S-TAB'
+anywhere in the buffer cycles the whole buffer between "only top-level
+headings", "all headings and subheadings", and "show all" states.
----
-*** New faces for 'vc-dir' buffers.
-Those are: 'vc-dir-header', 'vc-dir-header-value', 'vc-dir-directory',
-'vc-dir-file', 'vc-dir-mark-indicator', 'vc-dir-status-warning',
-'vc-dir-status-edited', 'vc-dir-status-up-to-date',
-'vc-dir-status-ignored'.
++++
+*** New user option 'outline-minor-mode-cycle'.
+This user option customizes 'outline-minor-mode', with the difference
+that 'TAB' and 'S-TAB' on heading lines cycle heading visibility.
+Typing 'TAB' on a heading line cycles the current section between
+"hide all", "subheadings", and "show all" states. Typing 'S-TAB' on a
+heading line cycles the whole buffer between "only top-level
+headings", "all headings and subheadings", and "show all" states.
---
-*** The responsible VC backend is now the most specific one.
-'vc-responsible-backend' loops over the backends in
-'vc-handled-backends' to determine which backend is responsible for a
-specific (unregistered) file. Previously the first matching backend
-was chosen, but now the one with the most specific path is chosen (in
-case there's a directory handled by one backend inside another).
+*** New user option 'outline-minor-mode-highlight'.
+This user option customizes 'outline-minor-mode'. It puts
+highlighting on heading lines using standard outline faces. This
+works well only when there are no conflicts with faces used by the
+major mode.
-*** New commands 'vc-dir-mark-registered-files' (bound to '* r') and
-'vc-dir-mark-unregistered-files'.
+** Ispell
-*** Support for bookmark.el.
-Bookmark locations can refer to VC directory buffers.
++++
+*** 'ispell-comments-and-strings' now accepts START and END arguments.
+These arguments default to active region when used interactively.
----
-*** 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 command 'ispell-comment-or-string-at-point'.
----
-*** 'vc-hg' now uses 'hg summary' to populate extra 'vc-dir' headers.
+** Flyspell mode
----
-*** 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.
++++
+*** 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 enabling 'context-menu-mode'.
---
-*** New user option 'vc-git-log-switches'.
-String or list of strings specifying switches for Git log under VC.
+*** The current dictionary is now displayed in the minor mode lighter.
+Clicking the dictionary name changes the current dictionary.
-** Gnus
+** Package
-+++
-*** New Summary buffer sort options for extra headers.
-The extra header sort option ('C-c C-s C-x') prompts for a header
-and fails if no sort function has been defined. Sorting by
-Newsgroups ('C-c C-s C-u') has been pre-defined.
+*** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA.
+Thus, packages on nonGNU ELPA will appear by default in the list shown
+by 'list-packages'.
-+++
-*** The '#' command in the Group and Summary buffer now toggles,
-instead of sets, the process mark.
+---
+*** '/ s' ('package-menu-filter-by-status') changes parameter handling.
+The command was documented to take a comma-separated list of statuses
+to filter by, but instead it used the parameter as a regexp. The
+command has been changed so that it now works as documented, and
+checks statuses not as a regexp, but instead an exact match from the
+comma-separated list.
+++
-*** New user option 'gnus-process-mark-toggle'.
-If non-nil (the default), the '#' command in the Group and Summary
-buffers will toggle, instead of set, the process mark.
-
+*** New command 'package-browse-url' and keystroke 'w'.
+++
-*** New user option 'gnus-registry-register-all'.
-If non-nil (the default), create registry entries for all messages.
-If nil, don't automatically create entries, they must be created
-manually.
+*** New commands to filter the package list.
+The filter commands are bound to the following keys:
-+++
-*** New user options to customise the summary line specs "%[" and "%]".
-Four new options introduced in customisation group
-'gnus-summary-format'. These are 'gnus-sum-opening-bracket',
-'gnus-sum-closing-bracket', 'gnus-sum-opening-bracket-adopted', and
-'gnus-sum-closing-bracket-adopted'. Their default values are "[", "]",
-"<", ">" respectively. These options control the appearance of "%["
-and "%]" specs in the summary line format. "%[" will normally display
-the value of 'gnus-sum-opening-bracket', but can also be
-'gnus-sum-opening-bracket-adopted' for the adopted articles. "%]" will
-normally display the value of 'gnus-sum-closing-bracket', but can also
-be 'gnus-sum-closing-bracket-adopted' for the adopted articles.
+key binding
+--- -------
+/ a package-menu-filter-by-archive
+/ d package-menu-filter-by-description
+/ k package-menu-filter-by-keyword
+/ N package-menu-filter-by-name-or-description
+/ n package-menu-filter-by-name
+/ s package-menu-filter-by-status
+/ v package-menu-filter-by-version
+/ m package-menu-filter-marked
+/ u package-menu-filter-upgradable
+/ / package-menu-filter-clear
-+++
-*** New user option 'gnus-paging-select-next'.
-This controls what happens when using commands like 'SPC' and 'DEL' to
-page the current article. If non-nil (the default), go to the
-next/prev article, but if nil, do nothing at the end/start of the article.
+*** Option to automatically native-compile packages upon installation.
+Customize the user option 'package-native-compile' to enable automatic
+native compilation of packages when they are installed. That option
+is nil by default; if set non-nil, and if your Emacs was built with
+native-compilation support, each package will be natively compiled
+when it is installed, by invoking an asynchronous Emacs subprocess to
+run the native-compilation of the package files. (Be sure to leave
+Emacs running until these asynchronous subprocesses exit, or else the
+native-compilation will be aborted when you exit Emacs.)
-+++
-*** New gnus-search library.
-A new unified search syntax which can be used across multiple
-supported search engines. Set 'gnus-search-use-parsed-queries' to
-non-nil to enable.
+---
+*** 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'.
-+++
-*** New value for user option 'smiley-style'.
-Smileys can now be rendered with emojis instead of small images when
-using the new 'emoji' value in 'smiley-style'.
+** Info
-+++
-*** New user option 'gnus-agent-eagerly-store-articles'.
-If non-nil (which is the default), the Gnus Agent will store all read
-articles in the Agent cache.
+---
+*** New user option 'Info-warn-on-index-alternatives-wrap'.
+This option affects what happens when using the ',' command after
+looking up an entry with 'i' in info buffers. If non-nil (the
+default), the ',' command will now display a warning when proceeding
+beyond the final index match, and tapping ',' once more will then take
+you to the first match.
-+++
-*** 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.
+** Abbrev mode
+++
-*** 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.
+*** 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.
-+++
-*** User-defined scoring is now possible.
-The new type is 'score-fn'. More information in the Gnus manual node
-"(gnus) Score File Format".
+** Bookmarks
-+++
-*** 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.
+*** 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.
-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'.
+---
+*** The 'list-bookmarks' menu is now based on 'tabulated-list-mode'.
+The interactive bookmark list will now benefit from features in
+'tabulated-list-mode' like sorting columns or changing column width.
-+++
-*** 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.
+Support for the optional "inline" header line, allowing for a header
+without using 'header-line-format', has been dropped. Consequently,
+the variables 'bookmark-bmenu-use-header-line' and
+'bookmark-bmenu-inline-header-height' are now declared obsolete.
-+++
-*** The 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.)
+---
+*** New user option 'bookmark-fontify'.
+If non-nil, setting a bookmark will colorize the current line with
+'bookmark-face'.
---
-*** 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'.
+*** New user option 'bookmark-menu-confirm-deletion'.
+In Bookmark Menu mode, Emacs by default does not prompt for
+confirmation when you type 'x' to execute the deletion of bookmarks
+that have been marked for deletion. However, if this new option is
+non-nil then Emacs will require confirmation with 'yes-or-no-p' before
+deleting.
-+++
-*** 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.
+** Recentf
-+++
-*** The 'W Q' summary mode command now takes a numerical prefix to
-allow adjusting the fill width.
+---
+*** The recentf files are no longer backed up.
-+++
-*** 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.
+---
+*** 'recentf-auto-cleanup' now repeats daily when set to a time string.
+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.
-** Message
+** Calc
---
-*** Respect 'message-forward-ignored-headers' more.
-Previously, this user option would not be consulted if
-'message-forward-show-mml' was nil and forwarding as MIME.
+*** 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.
+++
-*** New user option 'message-forward-included-mime-headers'.
-This is used when forwarding messages as MIME, but not using MML.
+*** Setting the word size to zero disables word clipping.
+The word size normally clips the results of certain bit-oriented
+operations such as shifts and bitwise XOR. A word size of zero, set
+by 'b w', makes the operation have effect on the whole argument values
+and the result is not truncated in any way.
-+++
-*** 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.
+---
+*** The '/' operator now has higher precedence in (La)TeX input mode.
+It no longer has lower precedence than '+' and '-'.
---
-*** 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.
+*** Calc now marks its windows dedicated.
+The new user option 'calc-make-windows-dedicated' controls this. It
+is t by default; set to nil to get back the old behavior.
+
+** Calendar
+++
-*** 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" or
-"~/.local/share/applications".
-Clicking on a 'mailto:' link in other applications will then open
-Emacs with headers filled out according to the link, e.g.
-"mailto:larsi@gnus.org?subject=This+is+a+test";. If you prefer
-emacsclient, use "emacsclient -e '(message-mailto "%u")'"
-or "emacsclient-mail.desktop".
+*** 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".
----
-*** 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.
+** ido
-+++
-*** 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".
+---
+*** Switching on 'ido-mode' now also overrides 'ffap-file-finder'.
-** Smtpmail
+---
+*** 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 user option 'smtpmail-store-queue-variables'.
-If non-nil, SMTP variables will be stored together with the queued
-messages, and will then be used when sending with
-'M-x smtpmail-send-queued-mail'.
+** So Long
-+++
-*** 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'.
+---
+*** New 'so-long-predicate' function 'so-long-statistics-excessive-p'.
+It efficiently detects the presence of a long line anywhere in the
+buffer using 'buffer-line-statistics' (see above). This is now the
+default predicate (replacing 'so-long-detected-long-line-p').
-** Search and Replace
+---
+*** Default values 'so-long-threshold' and 'so-long-max-lines' increased.
+The values of these variables have been raised to 10000 bytes and 500
+lines respectively, to reduce the likelihood of false-positives when
+'global-so-long-mode' is enabled. The latter value is now only used
+by the old predicate, as the new predicate knows the longest line in
+the entire buffer.
-*** New key 'M-s M-.' starts isearch with the thing found at point.
-This key is bound to the new command 'isearch-forward-thing-at-point'.
-The new user option 'isearch-forward-thing-at-point' defines
-a list of symbols to try to get the "thing" at point. By default,
-the first element of the list is 'region' that tries to yank
-the currently active region to the search string.
+---
+*** 'so-long-target-modes' now includes 'fundamental-mode' by default.
+This means that 'global-so-long-mode' will also process files which were
+not recognised. (This only has an effect if 'set-auto-mode' chooses
+'fundamental-mode'; buffers which are simply in 'fundamental-mode' by
+default are unaffected.)
-*** New user option 'isearch-wrap-pause' defines how to wrap the search.
-There are choices to disable wrapping completely and to wrap immediately.
-When wrapping immediately, it consistently handles the numeric arguments
-of 'C-s' ('isearch-repeat-forward') and 'C-r' ('isearch-repeat-backward'),
-continuing with the remaining count after wrapping.
+---
+*** New user options to preserve modes and variables.
+The new options 'so-long-mode-preserved-minor-modes' and
+'so-long-mode-preserved-variables' allow specified mode and variable
+states to be maintained if 'so-long-mode' replaces the original major
+mode. By default, these new options support 'view-mode'.
** Grep
@@ -1197,412 +1365,610 @@ This change is for better compatibility with old
versions of non-GNU
This returns the name of the file at point (if any) in 'grep-mode'
buffers.
-** Help
-
-+++
-*** New convenience commands with short keys in the Help buffer.
-New command 'help-view-source' ('s') will view the source file (if
-any) of the current help topic. New command 'help-goto-info' ('i')
-will look up the current symbol (if any) in Info. New command
-'help-customize' ('c') will customize the variable or the face
-(if any) whose doc string is being shown in the Help buffer.
+** Shell
---
-*** The 'help-for-help' ('C-h C-h') screen has been redesigned.
+*** New command in 'shell-mode': 'narrow-to-prompt'.
+This is bound to 'C-x n d' in 'shell-mode' buffers, and narrows to the
+command line under point (and any following output).
---
-*** Keybindings in 'help-mode' use the new 'help-key-binding' face.
-This face is added by 'substitute-command-keys' to any "\[command]"
-substitution. The return value of that function should consequently
-be assumed to be a propertized string.
+*** New user option 'shell-has-auto-cd'.
+If non-nil, 'shell-mode' handles implicit "cd" commands, changing the
+directory if the command is a directory. Useful for shells like "zsh"
+that has this feature.
-Note that the new face will also be used in tooltips. When using the
-GTK toolkit, this is only true if 'x-gtk-use-system-tooltips' is t.
+** term-mode
---
-*** 'g' ('revert-buffer') in 'help-mode' no longer requires confirmation.
+*** 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 command 'describe-command' shows help for a command.
-This can be used instead of 'describe-function' for interactive
-commands and is globally bound to 'C-h x'.
+---
+*** New 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.
-+++
-*** New command 'describe-keymap' describes keybindings in a keymap.
+** Eshell
---
-*** New user option 'describe-bindings-outline'.
-It enables outlines in the output buffer of 'describe-bindings' that
-can provide a better overview in a long list of available bindings.
+*** 'eshell-hist-ignoredups' can now also be used to mimic "erasedups" in bash.
---
-*** New keybinding 'C-h R' prompts for a manual to display and displays it.
+*** Environment variable 'INSIDE_EMACS' is now copied to subprocesses.
+Its value contains the result of evaluating '(format "%s,eshell"
+emacs-version)'. Other package names, like "tramp", could also be included.
---
-*** Closing the "*Help*" buffer from the toolbar now buries the buffer.
-In previous Emacs versions, the "*Help*" buffer was killed instead when
-clicking the "X" icon in the tool bar.
+*** 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.
-** Info
+** Archive mode
---
-*** New user option 'Info-warn-on-index-alternatives-wrap'.
-This option affects what happens when using the ',' command after
-looking up an entry with 'i' in info buffers. If non-nil (the
-default), the ',' command will now warn you when proceeding beyond the
-final entry, and tapping ',' once more will then take you to the
-first entry.
+*** Archive Mode can now parse ".squashfs" files.
-+++
-** New command 'lossage-size'.
-It allows users to set the maximum number of keystrokes and commands
-recorded for the purpose of 'view-lossage'.
+*** Can now modify members of 'ar' archives.
+
+*** Display of summaries is unified between backends.
+
+*** New user option and command to control displayed columns.
+New user option 'archive-hidden-columns' and new command
+'archive-hideshow-column' let you control which columns are displayed
+and which are kept hidden.
---
-*** 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.
+*** New command bound to 'C': 'archive-copy-file'.
+This command extracts the file at point and writes its data to a
+file.
-** Input methods
+** browse-url
-+++
-*** Emacs now supports "transient" input methods.
-A transient input method is enabled for inserting a single character,
-and is then automatically disabled. 'C-x \' temporarily enables the
-selected transient input method. Use 'C-u C-x \' to select a
-transient input method (which can be different from the input method
-enabled by 'C-\'). For example, 'C-u C-x \ compose RET' selects the
-'compose' input method; then typing 'C-x \ 1 2' will insert the
-character '½', and disable the 'compose' input method afterwards.
-You can use 'C-x \' in incremental search to insert a single character
-to the search string.
+*** 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).
----
-*** New input method 'compose' based on X Multi_key sequences.
+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 into 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.
---
-*** New input method 'iso-transl' with the same keys as 'C-x 8'.
-After selecting it as a transient input method with 'C-u C-x \
-iso-transl RET', it supports the same key sequences as 'C-x 8',
-so e.g. like 'C-x 8 [' inserts a left single quotation mark,
-'C-x \ [' does the same.
+*** Support for browsing of remote files.
+If a remote file is specified, a local temporary copy of that file is
+passed to the browser.
+
+*** Support for the conkeror browser is now obsolete.
+
+*** Support for the Mosaic browser has been removed.
+This support has been obsolete since 25.1.
+
+** Completion List Mode
+New key bindings have been added to 'completion-list-mode': 'n' and
+'p' now navigate completions, and 'M-g M-c' switches to the
+minibuffer and back to the completion list buffer.
+
++++
+** profiler.el
+The results displayed by 'profiler-report' now have the usage figures
+at the left hand side followed by the function name. This is intended
+to make better use of the horizontal space, in particular eliminating
+the truncation of function names. There is no way to get the former
+layout back.
+
+** Python mode
---
-*** New user option 'read-char-by-name-sort'.
-It defines the sorting order of characters for completion of 'C-x 8 RET TAB'
-and can be customized to sort them by codepoints instead of character names.
-Additionally, you can group characters by Unicode blocks after customizing
-'completions-group' and 'completions-group-sort'.
+*** New user option 'python-forward-sexp-function'.
+This allows the user easier customization of whether to use block-based
+navigation or not.
---
-*** 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.
+*** 'python-shell-interpreter' now defaults to python3 on systems with python3.
---
-*** New input method 'cham'.
-There's also a Cham greeting in "etc/HELLO".
+*** 'C-c C-r' can now be used on arbitrary regions.
+The command previously extended the start of the region to the start
+of the line, but will now actually send the marked region, as
+documented.
+
+** Perl mode
---
-*** New input methods for Lakota language orthographies.
-Two orthographies are represented here, the Suggested Lakota
-Orthography and what is known as the White Hat Orthography. Input
-methods 'lakota-slo-prefix', 'lakota-slo-postfix', and
-'lakota-white-hat-postfix' have been added. There is also a Lakota
-greeting in "etc/HELLO".
+*** New face 'perl-non-scalar-variable'.
+This is used to fontify non-scalar variables.
-** Ispell
+** Icomplete
-+++
-*** 'ispell-comments-and-strings' now accepts START and END arguments,
-defaulting to active region when used interactively.
+---
+*** New user option 'icomplete-matches-format'.
+This allows controlling the current/total number of matches for the
+prompt prefix.
+++
-*** New command 'ispell-comment-or-string-at-point' is provided.
+*** New minor modes 'icomplete-vertical-mode' and 'fido-vertical-mode'.
+These modes modify Icomplete ('M-x icomplete-mode') and Fido ('M-x
+fido-mode'), to display completion candidates vertically instead of
+horizontally. In Icomplete, completions are rotated and selection
+kept at the top. In Fido, completions scroll like a typical dropdown
+widget. Both these new minor modes will turn on their non-vertical
+counterparts first, if they are not on already.
---
-** The old non-SMIE indentation of 'sh-mode' has been removed.
+*** Default value of 'icomplete-compute-delay' has been changed to 0.15 s.
---
-** The sb-image.el library is now marked obsolete.
-This file was a compatibility kludge which is no longer needed.
+*** Default value of 'icomplete-max-delay-chars' has been changed to 2.
---
-** 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'.
-
-** Customize
+*** Reduced blinking while completing the next completions set.
+Icomplete doesn't hide the hint with the previously computed
+completions anymore when compute delay is in effect, or the previous
+computation has been aborted by input. Instead it shows the previous
+completions until the new ones are ready.
---
-*** Customize buffers can now be reverted with 'C-x x g'.
+*** 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. Also when this option
+is nil, completions are not shown when the minibuffer reads a file name
+with initial input as the default directory.
-*** Most customize commands now hide obsolete user options.
-Obsolete user options are no longer shown in the listings produced by
-the commands 'customize', 'customize-group', 'customize-apropos' and
-'customize-changed'.
+** mspool.el
-To customize obsolete user options, use 'customize-option' or
-'customize-saved'.
+---
+*** Autoload the main entry point 'mspool-show'.
-*** New SVG icons for checkboxes and arrows.
-They will be used automatically instead of the old icons. If Emacs is
-built without SVG support, the old icons will be used instead.
+** Windmove
-** Bookmarks
++++
+*** New user options to customize windmove keybindings.
+These options include 'windmove-default-keybindings',
+'windmove-display-default-keybindings',
+'windmove-delete-default-keybindings',
+'windmove-swap-states-default-keybindings'.
-*** 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.
+** Occur mode
----
-*** The 'list-bookmarks' menu is now based on 'tabulated-list-mode'.
-The interactive bookmark list will now benefit from features in
-'tabulated-list-mode' like sorting columns or changing column width.
+*** New bindings in occur-mode.
+The command 'next-error-no-select' is now bound to 'n' and
+'previous-error-no-select' is bound to 'p'.
-Support for the optional "inline" header line, allowing for a header
-without using 'header-line-format', has been dropped. Consequently,
-the variables 'bookmark-bmenu-use-header-line' and
-'bookmark-bmenu-inline-header-height' are now declared obsolete.
+*** The new command 'recenter-current-error'.
+It is bound to 'l' in Occur or compilation buffers, and recenters the
+current displayed occurrence/error.
+
+*** Matches in target buffers are now highlighted as in 'compilation-mode'.
+The method of highlighting is specified by the user options
+'next-error-highlight' and 'next-error-highlight-no-select'.
---
-*** New user option 'bookmark-fontify'.
-If non-nil, setting a bookmark will colorize the current line with
-'bookmark-face'.
+*** A fringe arrow in the "*Occur*" buffer indicates the selected match.
---
-*** New user option 'bookmark-menu-confirm-deletion'.
-In Bookmark Menu mode, Emacs by default does not prompt for
-confirmation when you type 'x' to execute the deletion of bookmarks
-that have been marked for deletion. However, if this new option is
-non-nil then Emacs will require confirmation with 'yes-or-no-p' before
-deleting.
+*** Occur mode may use a different type for 'occur-target' property values.
+The value was previously always a marker set to the start of the first
+match on the line but can now also be a list of '(BEGIN . END)' pairs
+of markers delimiting each match on the line.
+This is a fully compatible change to the internal occur-mode
+implementation, and code creating their own occur-mode buffers will
+work as before.
-** Edebug
+** New minor mode 'cl-font-lock-built-in-mode' for 'lisp-mode'.
+The mode provides refined highlighting of built-in functions, types,
+and variables.
-*** Obsoletions
----
-**** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'.
-+++
-**** The spec operator ':name NAME' is obsolete, use '&name' instead.
-+++
-**** The spec element 'function-form' is obsolete, use 'form' instead.
+** Emacs Lisp mode
-+++
-*** New function 'def-edebug-elem-spec' to define Edebug spec elements.
-These used to be defined with 'def-edebug-spec' thus conflating the
-two name spaces, which lead to name collisions.
-The use of 'def-edebug-spec' to define Edebug spec elements is
-declared obsolete.
+*** The mode-line now indicates whether we're using lexical or dynamic scoping.
-*** Edebug specification lists can use some new keywords:
+*** 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.
-+++
-**** '&interpose SPEC FUN ARGS..' lets FUN control parsing after SPEC.
-More specifically, FUN is called with 'HEAD PF ARGS..' where
-PF is a parsing function that expects a single argument (the specs to
-use) and HEAD is the code that matched SPEC.
+** Change Logs and VC
+++
-**** '&error MSG' unconditionally aborts the current edebug instrumentation.
+*** 'vc-revert-show-diff' now has a third possible value: 'kill'.
+If this user option is 'kill', then the diff buffer will be killed
+after the 'vc-revert' action instead of buried.
-+++
-**** '&name SPEC FUN' extracts the current name from the code matching SPEC.
+*** 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.
-** ElDoc
+*** New command 'vc-dir-root' uses the root directory without asking.
-+++
-*** New user option 'eldoc-echo-area-display-truncation-message'.
-If non-nil (the default), eldoc will display a message saying
-something like "(Documentation truncated. Use `M-x eldoc-doc-buffer'
-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 face 'log-view-commit-body'.
+This is used when expanding commit messages from 'vc-print-root-log'
+and similar commands.
-*** New hook 'eldoc-display-functions'.
-This hook is intended to be used for displaying doc strings. The
-functions receive the doc string composed according to
-'eldoc-documentation-strategy' and are tasked with displaying it to
-the user. Examples of such functions would use the echo area, a
-separate buffer, or a tooltip.
+---
+*** New faces for 'vc-dir' buffers.
+Those are: 'vc-dir-header', 'vc-dir-header-value', 'vc-dir-directory',
+'vc-dir-file', 'vc-dir-mark-indicator', 'vc-dir-status-warning',
+'vc-dir-status-edited', 'vc-dir-status-up-to-date',
+'vc-dir-status-ignored'.
-+++
-*** 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 synchronous and some asynchronous.
-The user option replaces 'eldoc-documentation-function', which is now
-obsolete.
+---
+*** The responsible VC backend is now the most specific one.
+'vc-responsible-backend' loops over the backends in
+'vc-handled-backends' to determine which backend is responsible for a
+specific (unregistered) file. Previously, the first matching backend
+was chosen, but now the one with the most specific path is chosen (in
+case there's a directory handled by one backend inside another).
-*** '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.
+*** New commands 'vc-dir-mark-registered-files' (bound to '* r') and
+'vc-dir-mark-unregistered-files'.
-** Shell
+*** Support for bookmark.el.
+Bookmark locations can refer to VC directory buffers.
---
-*** New command in 'shell-mode': 'narrow-to-prompt'.
-This is bound to 'C-x n d' in 'shell-mode' buffers, and narrows to the
-command line under point (and any following output).
+*** New user option '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 user option 'shell-has-auto-cd'.
-If non-nil, 'shell-mode' handles implicit "cd" commands, changing the
-directory if the command is a directory. Useful for shells like "zsh"
-that has this feature.
-
-+++
-*** 'comint-delete-output' can now save deleted text in the kill-ring.
-Interactively, 'C-u C-c C-o' triggers this new optional behavior.
-
-** Eshell
+*** 'vc-hg' now uses 'hg summary' to populate extra 'vc-dir' headers.
---
-*** 'eshell-hist-ignoredups' can now also be used to mimic "erasedups" in bash.
+*** 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.
---
-*** Environment variable 'INSIDE_EMACS' is now copied to subprocesses.
-Its value contains the result of evaluating '(format "%s,eshell"
-emacs-version)'. Other package names, like "tramp", could also be included.
+*** New user option 'vc-git-log-switches'.
+String or list of strings specifying switches for Git log under VC.
----
-*** 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.
+** Gnus
-** EUDC
++++
+*** New user option 'gnus-topic-display-predicate'.
+This can be used to inhibit the display of some topics completely.
+++
-*** New macOS Contacts backend.
-This backend works on newer versions of macOS and is generally
-preferred over the eudcb-mab.el backend.
+*** nnimap now supports the oauth2.el library.
-** Tramp
++++
+*** New Summary buffer sort options for extra headers.
+The extra header sort option ('C-c C-s C-x') prompts for a header
+and fails if no sort function has been defined. Sorting by
+Newsgroups ('C-c C-s C-u') has been pre-defined.
+++
-*** New connection method "mtp", which allows accessing media devices
-like cell phones, tablets or cameras.
+*** The '#' command in the Group and Summary buffer now toggles,
+instead of sets, the process mark.
+++
-*** New connection method "sshfs", which allows accessing remote files
-via a file system mounted with 'sshfs'.
+*** New user option 'gnus-process-mark-toggle'.
+If non-nil (the default), the '#' command in the Group and Summary
+buffers will toggle, instead of set, the process mark.
+
+++
-*** Trashed remote files are moved to the local trash directory.
-All remote files, which are trashed, are moved to the local trash
-directory. Except remote encrypted files, which are always deleted.
+*** New user option 'gnus-registry-register-all'.
+If non-nil (the default), create registry entries for all messages.
+If nil, don't automatically create entries, they must be created
+manually.
+++
-*** New 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.
+*** New user options to customise the summary line specs "%[" and "%]".
+Four new options introduced in customisation group
+'gnus-summary-format'. These are 'gnus-sum-opening-bracket',
+'gnus-sum-closing-bracket', 'gnus-sum-opening-bracket-adopted', and
+'gnus-sum-closing-bracket-adopted'. Their default values are "[", "]",
+"<", ">" respectively. These options control the appearance of "%["
+and "%]" specs in the summary line format. "%[" will normally display
+the value of 'gnus-sum-opening-bracket', but can also be
+'gnus-sum-opening-bracket-adopted' for the adopted articles. "%]" will
+normally display the value of 'gnus-sum-closing-bracket', but can also
+be 'gnus-sum-closing-bracket-adopted' for the adopted articles.
+++
-*** 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.
+*** New user option 'gnus-paging-select-next'.
+This controls what happens when using commands like 'SPC' and 'DEL' to
+page the current article. If non-nil (the default), go to the
+next/prev article, but if nil, do nothing at the end/start of the article.
+++
-*** New user option 'tramp-debug-to-file'.
-When non-nil, this user option instructs Tramp to mirror the debug
-buffer to a file under the "/tmp/" directory. This is useful, if (in
-rare cases) Tramp blocks Emacs, and we need further debug information.
+*** New gnus-search library.
+A new unified search syntax which can be used across multiple
+supported search engines. Set 'gnus-search-use-parsed-queries' to
+non-nil to enable.
+++
-*** Tramp supports lock files now.
-In order to deactivate this, set user option
-'remote-file-name-inhibit-locks' to t.
+*** New value for user option 'smiley-style'.
+Smileys can now be rendered with emojis instead of small images when
+using the new 'emoji' value in 'smiley-style'.
+++
-*** Writing sensitive auto-save, backup or lock files to the local
-temporary directory must be confirmed. In order to suppress this
-confirmation, set user option 'tramp-allow-unsafe-temporary-files' to
-t.
+*** New user option 'gnus-agent-eagerly-store-articles'.
+If non-nil (which is the default), the Gnus Agent will store all read
+articles in the Agent cache.
-** Tempo
++++
+*** 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.
----
-*** 'tempo-define-template' can now re-assign templates to tags.
-Previously, assigning a new template to an already defined tag had no
-effect.
++++
+*** 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.
-** map.el
++++
+*** User-defined scoring is now possible.
+The new type is 'score-fn'. More information in the Gnus manual node
+"(gnus) Score File Format".
-*** 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))'.
++++
+*** 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.
----
-*** The function 'map-copy' now uses 'copy-alist' on alists.
-This is a slightly deeper copy than the previous 'copy-sequence'.
+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'.
----
-*** The function 'map-contains-key' now supports plists.
++++
+*** 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.
-** Package
++++
+*** 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.)
---
-*** '/ s' ('package-menu-filter-by-status') changes parameter handling.
-The command was documented to take a comma-separated list of statuses
-to filter by, but instead it used the parameter as a regexp. The
-command has been changed so that it now works as documented, and
-checks statuses not as a regexp, but instead an exact match from the
-comma-separated list.
+*** 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'.
+++
-*** New command 'package-browse-url' and keystroke 'w'.
+*** 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.
+++
-*** New commands to filter the package list.
-The filter commands are bound to the following keys:
+*** The 'W Q' summary mode command now takes a numerical prefix to
+allow adjusting the fill width.
-key binding
---- -------
-/ a package-menu-filter-by-archive
-/ d package-menu-filter-by-description
-/ k package-menu-filter-by-keyword
-/ N package-menu-filter-by-name-or-description
-/ n package-menu-filter-by-name
-/ s package-menu-filter-by-status
-/ v package-menu-filter-by-version
-/ m package-menu-filter-marked
-/ u package-menu-filter-upgradable
-/ / package-menu-filter-clear
++++
+*** 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.
-*** Option to automatically native-compile packages upon installation.
-Customize the user option 'package-native-compile' to enable automatic
-native compilation of packages when they are installed. That option
-is nil by default; if set non-nil, and if your Emacs was built with
-native-compilation support, each package will be natively compiled
-when it is installed, by invoking an asynchronous Emacs subprocess to
-run the native-compilation of the package files.
+** Message
---
-*** 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'.
-
+*** Respect 'message-forward-ignored-headers' more.
+Previously, this user option would not be consulted if
+'message-forward-show-mml' was nil and forwarding as MIME.
+
++++
+*** New user option 'message-forward-included-mime-headers'.
+This is used when forwarding messages as MIME, but not using MML.
+
++++
+*** Message now supports the OpenPGP header.
+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" or
+"~/.local/share/applications".
+Clicking on a 'mailto:' link in other applications will then open
+Emacs with headers filled out according to the link, e.g.
+"mailto:larsi@gnus.org?subject=This+is+a+test";. If you prefer
+emacsclient, use "emacsclient -e '(message-mailto "%u")'"
+or "emacsclient-mail.desktop".
+
+---
+*** 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
+
++++
+*** smtpmail now supports using the oauth2.el library.
+
++++
+*** New user option 'smtpmail-store-queue-variables'.
+If non-nil, SMTP variables will be stored together with the queued
+messages, and will then be used when sending with
+'M-x smtpmail-send-queued-mail'.
+
++++
+*** Allow direct selection of smtp authentication mechanism.
+A server entry retrieved by auth-source can request a desired smtp
+authentication mechanism by setting a value for the key 'smtp-auth'.
+
+---
+** 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'.
+
+** ElDoc
+
++++
+*** New user option 'eldoc-echo-area-display-truncation-message'.
+If non-nil (the default), eldoc will display a message saying
+something like "(Documentation truncated. Use `M-x eldoc-doc-buffer'
+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 hook 'eldoc-display-functions'.
+This hook is intended to be used for displaying doc strings. The
+functions receive the doc string composed according to
+'eldoc-documentation-strategy' and are tasked with displaying it to
+the user. Examples of such functions would use the echo area, a
+separate buffer, or a tooltip.
+
++++
+*** New user option 'eldoc-documentation-strategy'.
+The built-in choices available for this user option let users compose
+the results of 'eldoc-documentation-functions' in various ways, even
+if some of those functions are synchronous and some asynchronous.
+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.
+
+** Tramp
+
++++
+*** New connection method "mtp".
+It allows accessing media devices like cell phones, tablets or
+cameras.
+
++++
+*** New connection method "sshfs".
+It allows accessing remote files via a file system mounted with
+'sshfs'.
+
++++
+*** Tramp supports SSH authentication via a hardware security key now.
+This requires at least OpenSSH 8.2, and a FIDO U2F compatible
+security key, like yubikey, solokey, or nitrokey.
+
++++
+*** Trashed remote files are moved to the local trash directory.
+All remote files, which are trashed, are moved to the local trash
+directory, except remote encrypted files, which are always deleted.
+
++++
+*** 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.
+
++++
+*** New user option 'tramp-debug-to-file'.
+When non-nil, this user option instructs Tramp to mirror the debug
+buffer to a file under the "/tmp/" directory. This is useful, if (in
+rare cases) Tramp blocks Emacs, and we need further debug information.
+
++++
+*** Tramp supports lock files now.
+In order to deactivate this, set user option
+'remote-file-name-inhibit-locks' to t.
+
++++
+*** Writing sensitive data locally requires confirmation.
+Writing auto-save, backup or lock files to the local temporary
+directory must be confirmed. In order to suppress this confirmation,
+set user option 'tramp-allow-unsafe-temporary-files' to t.
+
+** Tempo
+
+---
+*** 'tempo-define-template' can now re-assign templates to tags.
+Previously, assigning a new template to an already defined tag had no
+effect.
+
** gdb-mi
+*** New user option 'gdb-registers-enable-filter'.
+If non-nil, apply a register filter based on
+'gdb-registers-filter-pattern-list'.
+
+++
-*** gdb-mi can now store and restore window configurations.
+*** gdb-mi can now save 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 =>
@@ -1610,11 +1976,11 @@ 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.
+*** gdb-mi can now restore window configuration after quitting.
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-Windows" menu item.
+++
*** gdb-mi now has a better logic for displaying source buffers.
@@ -1627,12 +1993,6 @@ Control source file display by
'gdb-display-source-buffer-action'.
This means that the default coding-system is now used to decode strings
and source file names from GDB.
-** Gravatar
-
----
-*** New user option 'gravatar-service' for host to query for gravatars.
-Defaults to 'libravatar', with 'unicornify' and 'gravatar' as options.
-
** Compilation mode
---
@@ -1666,10 +2026,11 @@ be done (and this restores how this previously worked).
** Hi Lock mode
---
-*** 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.
+*** Matching in 'hi-lock-mode' can be case-sensitive.
+The matching is case-sensitive when a 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 default value of 'hi-lock-highlight-range' was enlarged.
@@ -1720,23 +2081,7 @@ t, which preserves the original behavior.
---
*** New user option 'rmail-show-message-set-modified'.
If set non-nil, showing an unseen message will set the Rmail buffer's
-modified flag.
-
----
-*** New faces for heading elements.
-Those are 'shr-h1', 'shr-h2', 'shr-h3', 'shr-h4', 'shr-h5', 'shr-h6'.
-
-** Apropos
-
-*** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'.
-These new navigation commands are bound to 'n' and 'p' in
-'apropos-mode'.
-
-*** New command 'apropos-function'.
-This works like 'C-u M-x apropos-command' but is more discoverable.
-
-*** New face 'apropos-button'.
-Applies to buttons that indicate a face.
+modified flag. The default is nil, to preserve the old behavior.
** CC Mode
@@ -1771,40 +2116,6 @@ To enable, add it to appropriate entries in
'c-offsets-alist', e.g.:
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 browsing of remote files.
-If a remote file is taken, a local temporary copy of that file is
-passed to the browser.
-
-*** Support for the conkeror browser is now obsolete.
-
-*** Support for the Mosaic browser has been removed.
-This support has been obsolete since 25.1.
-
** SHR
---
@@ -1825,6 +2136,10 @@ 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.
+---
+*** New faces for heading elements.
+Those are 'shr-h1', 'shr-h2', 'shr-h3', 'shr-h4', 'shr-h5', 'shr-h6'.
+
** Images
---
@@ -1890,7 +2205,7 @@ to prevent aliasing and other unwanted effects. The new
image
property ':transform-smoothing' can be set to t to force smoothing
and nil to disable smoothing.
-The default behaviour of smoothing on down-scaling and not smoothing
+The default behavior of smoothing on down-scaling and not smoothing
on up-scaling remains unchanged.
+++
@@ -1948,7 +2263,7 @@ information, see the related entry about 'shr-browse-url'
above.
*** New user option 'project-vc-merge-submodules'.
*** Project commands now have their own history.
-Previously used project directories are now suggested by all commands
+Previously, used project directories are now suggested by all commands
that prompt for a project directory.
+++
@@ -1978,19 +2293,38 @@ project's root directory, respectively.
+++
*** New user option 'project-list-file'.
+This specifies the file in which to save the list of known projects.
+++
*** New command 'project-remove-known-project'.
This command lets you interactively remove an entry from the list of projects
in 'project-list-file'.
-** xref
+*** 'project-find-file' now accepts non-existent file names.
+This is to allow easy creation of files inside some nested
+sub-directory.
+
+*** 'project-find-file' doesn't use the string at point as default input.
+Now it's only suggested as part of the "future history".
+
+** Xref
---
*** Prefix arg of 'xref-goto-xref' quits the "*xref*" buffer.
So typing 'C-u RET' in the "*xref*" buffer quits its window
before navigating to the selected location.
++++
+*** New user options to automatically show the first Xref match.
+The new user option 'xref-auto-jump-to-first-definition' controls the
+behavior of 'xref-find-definitions' and related commands: if it's t or
+'show', the first match is automatically displayed; if it's 'move',
+point in the "*xref*" buffer is automatically moved to the first match
+without displaying it.
+The new user option 'xref-auto-jump-to-first-xref' changes the behavior of
+all Xref commands in the same way as 'xref-auto-jump-to-first-definition'
+affects the "find-definitions" commands.
+
*** New user options 'xref-search-program' and 'xref-search-program-alist'.
So far 'grep' and 'ripgrep' are supported. 'ripgrep' seems to offer better
performance in certain cases, in particular for case-insensitive
@@ -2026,192 +2360,55 @@ supported, but we plan on removing it in a future
version; at that
time, the command 'xref-quit-and-goto-xref' will no longer have a key
binding in 'xref--xref-buffer-mode-map'.
-** json.el
+---
+*** New user option 'etags-xref-prefer-current-file'.
+When non-nil, matches for identifiers in the file visited by the
+current buffer will be shown first in the "*xref*" buffer.
+
+** Battery
---
-*** 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.
+*** 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.
---
-*** Some JSON encoding functions are now obsolete.
-The functions 'json-encode-number', 'json-encode-hash-table',
-'json-encode-key', and 'json-encode-list' are now obsolete.
+*** 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.
-The first two are kept as aliases of 'json-encode', which should be
-used instead. Uses of 'json-encode-list' should be changed to call
-one of 'json-encode', 'json-encode-alist', 'json-encode-plist', or
-'json-encode-array' instead.
+** bug-reference.el
-** json.c
+---
+*** Bug reference mode uses 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 the 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'.
-+++
-*** New function 'json-available-p'.
-This predicate returns non-nil if Emacs is built with libjansson
-support, and it is available on the current system.
-
-+++
-*** Native JSON functions now signal an error if libjansson is unavailable.
-This affects 'json-serialize', 'json-insert', 'json-parse-srtring',
-and 'json-parse-buffer'. This can happen if Emacs was compiled with
-libjansson, but the DLL cannot be found and/or loaded by Emacs at run
-time. Previously, Emacs would display a message and return nil in
-these cases.
-
-*** The JSON functions 'json-serialize', 'json-insert',
-'json-parse-string', and 'json-parse-buffer' now implement some of the
-semantics of RFC 8259 instead of the earlier RFC 4627. In particular,
-these functions now accept top-level JSON values that are neither
-arrays nor objects.
-
-** xml.el
-
-*** XML serialization functions now reject invalid characters.
-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.
-
-** erc
-
----
-*** erc-services.el now supports NickServ passwords from auth-source.
-The 'erc-use-auth-source-for-nickserv-password' user option enables
-querying auth-source for NickServ passwords. To enable this, add the
-following to your init file:
-
- (setq erc-prompt-for-nickserv-password nil
- erc-use-auth-source-for-nickserv-password t)
-
----
-*** The '/ignore' command will now ask for a timeout to stop ignoring the user.
-Allowed inputs are seconds or ISO8601-like periods like "1h" or "4h30m".
-
----
-*** 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.
-
-+++
-*** erc-tls now supports specifying a TLS client certificate.
-The 'erc-tls' function has been updated to allow specifying a TLS
-client certificate for authentication, as an alternative to NickServ
-password-based authentication. This is referred to as "CertFP" (short
-for Certificate Fingerprint) by several IRC networks. See the Info
-node "(erc) Connecting" in the ERC manual for more details and
-examples on how to specify and use TLS client certificates with
-'erc-tls'.
-
-** Battery
-
----
-*** 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
+** 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.
-
----
-*** '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.
-
-** 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.
-
-+++
-*** Setting the word size to zero disables word clipping.
-The word size normally clips the results of certain bit-oriented
-operations such as shifts and bitwise XOR. A word size of zero, set
-by 'b w', makes the operation have effect on the whole argument values
-and the result is not truncated in any way.
-
----
-*** The '/' operator now has higher precedence in (La)TeX input mode.
-It no longer has lower precedence than '+' and '-'.
-
----
-*** Calc now marks its windows dedicated.
-The new user option 'calc-make-windows-dedicated' controls this. It
-is t by default; set to nil to get back the old behavior.
-
-** term-mode
-
----
-*** 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.
-
** Widget
+++
@@ -2227,6 +2424,11 @@ a list.
** Diff
---
+*** New face 'diff-changed-unspecified'.
+This is used to highlight "changed" lines (those marked with '!') in
+context diffs, when 'diff-use-changed-face' is non-nil.
+
+---
*** New 'diff-mode' font locking face 'diff-error'.
This face is used for error messages from 'diff'.
@@ -2248,322 +2450,303 @@ buttons in it.
This function takes a string and returns a string propertized in a way
that makes it a valid button.
-** subr-x
-+++
-*** A number of new string manipulation functions have been added.
-'string-clean-whitespace', 'string-fill', 'string-limit',
-'string-lines', 'string-pad' and 'string-chop-newline'.
-
-*** New macro 'named-let' that provides Scheme's "named let" looping construct.
+** thing-at-point
-** thingatpt
++++
+*** New 'thing-at-point' target: 'existing-filename'.
+This is like 'filename', but is a full path, and is nil if the file
+doesn't exist.
+++
*** New variable 'thing-at-point-provider-alist'.
This allows mode-specific alterations to how 'thing-at-point' works.
-** Enriched mode
-
---
-*** 'C-a' is by default no longer bound to 'beginning-of-line-text'.
-This is so 'C-a' works as in other modes, and in particular holding
-Shift while typing 'C-a', i.e. 'C-S-a', will now highlight the text.
+*** thing-at-point now respects fields.
+'thing-at-point' (and all functions that use it, like
+'symbol-at-point') will narrow to the current field (if any) before
+trying to identify the thing at point.
+
+** image-dired
-** ERT
+---
+*** 'image-dired-mouse-toggle-mark' now toggles files in the active region.
+++
-*** ERT can now output more verbose test failure reports.
-If the 'EMACS_TEST_VERBOSE' environment variable is set, failure
-summaries will include the failing condition.
+*** New user option 'image-dired-thumb-visible-marks'.
+If non-nil (the default), use 'image-dired-thumb-mark' to say what
+images are marked.
-** File Locks
+---
+*** New command 'image-dired-delete-marked'.
-+++
-*** New user option 'lock-file-name-transforms'.
-This option allows controlling where lock files are written. It uses
-the same syntax as 'auto-save-file-name-transforms'.
+** Flymake mode
+++
-*** New user option 'remote-file-name-inhibit-locks'.
-When non-nil, this option suppresses lock files for remote files.
+*** New user options to customize Flymake's mode-line.
+The new user option 'flymake-mode-line-format' is a mix of strings and
+symbols like 'flymake-mode-line-title', 'flymake-mode-line-exception'
+and 'flymake-mode-line-counters'. The new user option
+'flymake-mode-line-counter-format' is a mix of strings and symbols
+like 'flymake-mode-line-error-counter',
+'flymake-mode-line-warning-counter' and 'flymake-mode-line-note-counter'.
-+++
-*** New minor mode 'lock-file-mode'.
-This command, called interactively, toggles the local value of
-'create-lockfiles' in the current buffer.
+** Time
-** Miscellaneous
+---
+*** '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.
-+++
-*** .dir-locals.el now supports setting 'auto-mode-alist'.
-The new 'auto-mode-alist' specification in .dir-local.el files can now
-be used to override the global 'auto-mode-alist' in the current
-directory tree.
+The following commands have been renamed:
----
-*** New utility function 'make-separator-line'.
+ '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'
----
-*** New face 'separator-line'.
-This is used by 'make-separator-line'.
+The following user options have been renamed:
-+++
-*** New user option 'ignored-local-variable-values'.
-This is the opposite of 'safe-local-variable-values' -- it's an alist
-of variable-value pairs that are to be ignored when reading a
-local-variables section of a file.
+ '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.
---
-*** 'indent-tabs-mode' is now a global minor mode instead of just a variable.
+*** 'world-clock-mode' can no longer be turned on interactively.
+Use 'world-clock' to turn on that mode.
+
+** CPerl Mode
---
-*** New user option 'save-place-abbreviate-file-names'.
+*** New face 'perl-heredoc', used for heredoc elements.
---
-*** 'tabulated-list-mode' can now restore original display order.
-Many commands (like 'C-x C-b') are derived from 'tabulated-list-mode',
-and that mode allow the user to sort on any column. There was
-previously no easy way to get back to the original displayed order
-after sorting, but giving a -1 numerical prefix to the sorting command
-will now restore the original order.
+*** 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.
+
+** Octave Mode
+++
-*** New utility function 'insert-into-buffer'.
-This is like 'insert-buffer-substring', but works in the opposite
-direction.
+*** Line continuations in double-quoted strings now use a backslash.
+Typing 'C-M-j' (bound to 'octave-indent-new-comment-line') now follows
+the behavior introduced in Octave 3.8 of using a backslash as a line
+continuation marker within double-quoted strings, and an ellipsis
+everywhere else.
+++
-*** New user option 'kill-transform-function'.
-This can be used to transform (and suppress) strings from entering the
-kill ring.
+** EasyPG
+GPG key servers can now be queried for keys with the
+'M-x epa-search-keys' command. Keys can then be added to your
+personal key ring.
----
-*** 'C-u M-x dig' will now prompt for a query type to use.
+** Etags
+++
-*** rcirc now supports SASL authentication.
+*** Etags now supports the Mercury programming language.
+See https://mercurylang.org.
+++
-*** 'save-interprogram-paste-before-kill' can now be a number.
-In that case, it's interpreted as a limit on the size of the clipboard
-data that will be saved to the 'kill-ring' prior to killing text: if
-the size of the clipboard data is greater than or equal to the limit,
-it will not be saved.
+*** Etags command line option '--declarations' now has Mercury-specific
behavior.
+All Mercury declarations are tagged by default. However, for
+compatibility with 'etags' support for Prolog, predicates and
+functions appearing first in clauses will also be tagged if 'etags' is
+invoked with the '--declarations' command-line option.
----
-*** New variable 'hl-line-overlay-priority'.
-This can be used to change the priority of the hl-line overlays.
+** Comint
+++
-*** New command 'mailcap-view-file'.
-This command will open a viewer based on the file type, as determined
-by "~/.mailcap" and related files and variables.
+*** Support for OSC escape sequences.
+Adding the new 'comint-osc-process-output' to
+'comint-output-filter-functions' enables the interpretation of OSC
+("Operating System Command") escape sequences in comint buffers. By
+default, only OSC 8, for hyperlinks, and OSC 7, for directory
+tracking, are acted upon. Adding more entries to
+'comint-osc-handlers' allows a customized treatment of further escape
+sequences.
+++
-*** New command 'C-x C-k Q' to force redisplay in keyboard macros.
+*** 'comint-delete-output' can now save deleted text in the kill-ring.
+Interactively, 'C-u C-c C-o' triggers this new optional behavior.
----
-*** New user option 'remember-diary-regexp'.
+** erc
---
-*** New user option 'remember-text-format-function'.
-
-*** New function 'buffer-line-statistics'.
-This function returns some statistics about the line lengths in a buffer.
+*** erc-services.el now supports NickServ passwords from auth-source.
+The 'erc-use-auth-source-for-nickserv-password' user option enables
+querying auth-source for NickServ passwords. To enable this, add the
+following to your init file:
-+++
-*** New variable 'inhibit-interaction' to make user prompts signal an error.
-If this is bound to something non-nil, functions like
-'read-from-minibuffer', 'read-char' (and related) will signal an
-'inhibited-interaction' error.
+ (setq erc-prompt-for-nickserv-password nil
+ erc-use-auth-source-for-nickserv-password t)
---
-*** 'process-attributes' now works under OpenBSD, too.
-
-+++
-*** New button face 'flat-button'.
-This is a plain 2D button, but uses the background color instead of
-the foreground color.
+*** 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".
---
-*** New face 'shortdoc-heading'.
-Applies to headings of shortdoc sections.
-
-+++
-*** New predicate functions 'length<', 'length>' and 'length='.
-Using these functions may be more efficient than using 'length' (if
-the length of a (long) list is being computed just to compare this
-length to a number).
+*** ERC now recognizes 'C-]' for italic text.
+Italic text is displayed in the new 'erc-italic-face'.
---
-*** 'remove-hook' is now an interactive command.
+*** 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.
---
-*** New user option 'authinfo-hide-elements'.
-This can be set to nil to inhibit hiding passwords in ".authinfo" files.
+*** 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.
-+++
-*** New variable 'current-minibuffer-command'.
-This is like 'this-command', but it is bound recursively when entering
-the minibuffer.
+*** 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.
+++
-*** New function 'object-intervals'.
-This function returns a copy of the list of intervals (i.e., text
-properties) in the object in question (which must either be a string
-or a buffer).
+*** erc-tls now supports specifying a TLS client certificate.
+The 'erc-tls' function has been updated to allow specifying a TLS
+client certificate for authentication, as an alternative to NickServ
+password-based authentication. This is referred to as "CertFP" (short
+for Certificate Fingerprint) by several IRC networks. See the Info
+node "(erc) Connecting" in the ERC manual for more details and
+examples on how to specify and use TLS client certificates with
+'erc-tls'.
----
-*** 'hexl-mode' scrolling commands now heed 'next-screen-context-lines'.
-Previously, 'hexl-scroll-down' and 'hexl-scroll-up' would scroll
-up/down an entire window, but they now work more like the standard
-scrolling commands.
+** xwidget-webkit mode
----
-*** Errors in 'kill-emacs-hook' no longer prevent Emacs from shutting down.
-If a function in that hook signals an error in an interactive Emacs,
-the user will be prompted on whether to continue. If the user doesn't
-answer within five seconds, Emacs will continue shutting down anyway.
+*** 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).
----
-*** iso-transl is now preloaded.
-This means that keystrokes like 'Alt-[' are defined by default,
-instead of only becoming available after doing (for instance)
-'C-x 8 <letter>'.
+*** 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 user option 'completions-detailed'.
-When non-nil, some commands like 'describe-symbol' show more detailed
-completions with more information in completion prefix and suffix.
+*** 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.
----
-*** User option 'completions-format' supports a new value 'one-column'.
+*** 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'.
+
+** Enriched mode
---
-*** New user option 'bibtex-unify-case-function'.
-This new option allows the user to customize how case is converted
-when unifying entries.
+*** 'C-a' is by default no longer bound to 'beginning-of-line-text'.
+This is so 'C-a' works as in other modes, and in particular holding
+Shift while typing 'C-a', i.e. 'C-S-a', will now highlight the text.
+
+** Gravatar
---
-*** The user option 'bibtex-maintain-sorted-entries' now permits
-user-defined sorting schemes.
+*** New user option 'gravatar-service' for host to query for gravatars.
+Defaults to 'libravatar', with 'unicornify' and 'gravatar' as options.
+
+** MH-E mail handler for Emacs
+
+Functions and variables related to handling junk mail have been
+renamed to not associate color with sender quality.
+++
-*** 'format-seconds' can now be used for sub-second times.
-The new optional "," parameter has been added, and
-'(format-seconds "%mm %,1ss" 66.4)' will now result in "1m 6.4s".
+*** New names for mh-junk interactive functions.
+Function 'mh-junk-whitelist' is renamed 'mh-junk-allowlist'.
+Function 'mh-junk-blacklist' is renamed 'mh-junk-blocklist'.
----
-*** 'global-display-fill-column-indicator-mode' skips some buffers.
-By default, turning on 'global-display-fill-column-indicator-mode'
-doesn't turn on 'display-fill-column-indicator-mode' in special-mode
-buffers. This can be controlled by customizing the variable
-'global-display-fill-column-indicator-modes'.
++++
+*** New binding for 'mh-junk-allowlist'.
+The key binding for 'mh-junk-allowlist' is changed from 'J w' to 'J a'.
+The old binding is supported but warns that it is obsolete.
+++
-*** New user option 'next-error-message-highlight'.
-In addition to a fringe arrow, 'next-error' error may now optionally
-highlight the current error message in the 'next-error' buffer.
-This user option can be also customized to keep highlighting on all
-visited errors, so you can have an overview what errors were already visited.
+*** New names for some hooks.
+'mh-whitelist-msg-hook' is renamed 'mh-allowlist-msg-hook'.
+'mh-blacklist-msg-hook' is renamed 'mh-blocklist-msg-hook'.
----
-*** New choice 'next-error-quit-window' for 'next-error-found-function'.
-When 'next-error-found-function' is customized to 'next-error-quit-window',
-then typing the numeric prefix argument 0 before the command 'next-error'
-will quit the source window after visiting the next occurrence.
++++
+*** New names for some variables.
+Variable 'mh-whitelist-preserves-sequences-flag' is renamed
+'mh-allowlist-preserves-sequences-flag'.
+++
-*** New user option 'tab-first-completion'.
-If 'tab-always-indent' is 'complete', this new user option can be used to
-further tweak whether to complete or indent.
+*** New names for some faces.
+Face 'mh-folder-blacklisted' is renamed 'mh-folder-blocklisted'.
+Face 'mh-folder-whitelisted' is renamed 'mh-folder-allowlisted'.
+
+** Miscellaneous
---
-*** 'dired-query' now uses 'read-char-from-minibuffer'.
-Using it instead of 'read-char-choice' allows using 'C-x o'
-to switch to the help window displayed after typing 'C-h'.
+*** 'shell-script-mode' now supports 'outline-minor-mode'.
+The outline headings have lines that start with "###".
---
-*** '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.
+*** fileloop will now skip missing files instead of signalling an error.
-+++
-*** Interactive regular expression search now uses faces for sub-groups.
-E.g., 'C-M-s foo-\([0-9]+\)' will now use the 'isearch-group-1' face
-on the part of the regexp that matches the sub-expression "[0-9]+".
-By default, there are two faces for sub-group highlighting, but you
-can define more faces whose names are of the form 'isearch-group-N',
-where N are successive numbers above 2.
+---
+*** 'tabulated-list-mode' can now restore original display order.
+Many commands (like 'C-x C-b') are derived from 'tabulated-list-mode',
+and that mode allows the user to sort on any column. There was
+previously no easy way to get back to the original displayed order
+after sorting, but giving a -1 numerical prefix to the sorting command
+will now restore the original order.
-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.
+---
+*** 'M-left' and 'M-right' now move between columns in 'tabulated-list-mode'.
+++
-*** Interactive regular expression replace now uses faces for sub-groups.
-Like 'search-highlight-submatches', this is controlled by the new user option
-'query-replace-highlight-submatches'.
+*** rcirc now supports SASL authentication.
---
-*** 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 variable 'hl-line-overlay-priority'.
+This can be used to change the priority of the hl-line overlays.
+++
-*** New user option 'mode-line-compact'.
-If non-nil, repeating spaces are compressed into a single space. If
-'long', this is only done when the mode line is longer than the
-current window width (in characters).
+*** New command 'mailcap-view-file'.
+This command will open a viewer based on the file type, as determined
+by "~/.mailcap" and related files and variables.
-+++
-*** 'global-mode-string' constructs should end with a space.
-This was previously not formalized, which led to combinations of modes
-displaying data "smushed together" on the mode line.
+---
+*** New user option 'remember-diary-regexp'.
-+++
-*** New command 'submit-emacs-patch'.
-This works like 'report-emacs-bug', but is more geared towards sending
-patches to the Emacs issue tracker.
+---
+*** New user option 'remember-text-format-function'.
-+++
-*** 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 user option 'authinfo-hide-elements'.
+This can be set to nil to inhibit hiding passwords in ".authinfo" files.
-+++
-*** New global mode 'global-goto-address-mode'.
-This will enable 'goto-address-mode' in all buffers.
+---
+*** 'hexl-mode' scrolling commands now heed 'next-screen-context-lines'.
+Previously, 'hexl-scroll-down' and 'hexl-scroll-up' would scroll
+up/down an entire window, but they now work more like the standard
+scrolling commands.
---
-*** '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.
+*** New user option 'bibtex-unify-case-function'.
+This new option allows the user to customize how case is converted
+when unifying entries.
---
-*** '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.
+*** The user option 'bibtex-maintain-sorted-entries' now permits
+user-defined sorting schemes.
---
-*** 'count-windows' now takes an optional parameter ALL-FRAMES.
-The semantics are as with 'walk-windows'.
+*** 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 variable 'ffap-file-name-with-spaces'.
@@ -2577,202 +2760,31 @@ 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. Also when this option
-is nil, completions are not shown when the minibuffer reads a file name
-with initial input as the default directory.
-
----
*** The width of the buffer-name column in 'list-buffers' is now dynamic.
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.
----
-*** 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.
-
-** xterm-mouse mode
-
----
-*** TTY menu navigation is now supported in 'xterm-mouse-mode'.
-TTY menus support mouse navigation and selection when 'xterm-mouse-mode'
-is active. When run on a terminal, clicking on the menu bar with the
-mouse now pops up a TTY menu by default instead of running the command
-'tmm-menubar'. To restore the old behavior, set the user option
-'tty-menu-open-use-tmm' to non-nil.
-
-** text-scale-mode
++++
+*** New diary sexp 'diary-offset'.
+It offsets another diary sexp by a number of days. This is useful
+when for example your organization has a committee meeting two days
+after every monthly meeting which takes place on the third Thursday,
+or if you would like to attend a virtual meeting scheduled in a
+different timezone causing a difference in the date.
---
-*** 'text-scale-mode' can now adjust font size of the header line.
-When the new buffer local variable 'text-scale-remap-header-line'
-is non-nil, 'text-scale-adjust' will also scale the text in the header
-line when displaying that buffer.
-
-This is useful for major modes that arrange their display in a tabular
-form below the header line. It is enabled by default in
-'tabulated-list-mode' and its derived modes.
-
-** xwidget-webkit mode
+*** The old non-SMIE indentation of 'sh-mode' has been removed.
-*** 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).
+*** Loading dunnet.el in batch mode doesn't start the game any more.
+Instead you need to do "emacs -f dun-batch" to start the game in
+batch mode.
-*** 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'.
-
-** ido
-
----
-*** Switching on 'ido-mode' now also overrides 'ffap-file-finder'.
-
----
-*** Killing virtual ido buffers interactively will make them go away.
-Previously, killing a virtual ido buffer with 'ido-kill-buffer' didn't
-do anything. This has now been changed, and killing virtual buffers
-with that command will remove the buffer from recentf.
-
-** Flymake mode
-
-+++
-*** New user options to customize Flymake's mode-line.
-The new user option 'flymake-mode-line-format' is a mix of strings and
-symbols like 'flymake-mode-line-title', 'flymake-mode-line-exception'
-and 'flymake-mode-line-counters'. The new user option
-'flymake-mode-line-counter-format' is a mix of strings and symbols
-like 'flymake-mode-line-error-counter',
-'flymake-mode-line-warning-counter' and 'flymake-mode-line-note-counter'.
-
-** Flyspell mode
-
-+++
-*** 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.
-
----
-*** 'world-clock-mode' can no longer be turned on interactively.
-Use 'world-clock' to turn on that mode.
-
-** 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 the new command 'dbus-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.
-
-** CPerl Mode
-
----
-*** New face 'perl-heredoc', used for heredoc elements.
-
-+++
-** A function can now be thrown to the 'exit' label in addition to t or nil.
-The command loop will call it with zero arguments before returning.
-
-+++
-** New error symbol 'minibuffer-quit'.
-Signaling it has almost the same effect as 'quit' except that it
-doesn't cause keyboard macro termination.
-
----
-*** The command 'cperl-set-style' offers the new value "PBP".
-This value customizes Emacs to use the style recommended in Damian
-Conway's book "Perl Best Practices" for indentation and formatting
-of conditionals.
-
-** Abbrev mode
-
-+++
-*** 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.
-
-** Octave Mode
-
-+++
-*** Line continuations in double-quoted strings now use a backslash.
-Typing 'C-M-j' (bound to 'octave-indent-new-comment-line') now follows
-the behavior introduced in Octave 3.8 of using a backslash as a line
-continuation marker within double-quoted strings, and an ellipsis
-everywhere else.
-
-** Repeat
+
+* New Modes and Packages in Emacs 28.1
+++
-*** New transient mode 'repeat-mode' to allow shorter key sequences.
+** New transient mode 'repeat-mode' to allow shorter key sequences.
You can type 'C-x u u' instead of 'C-x u C-x u' to undo many changes,
'C-x o o' instead of 'C-x o C-x o' to switch several windows,
'C-x { { } } ^ ^ v v' to resize the selected window interactively,
@@ -2787,24 +2799,6 @@ direction with e.g. 'C-x o M-- o o'. Also it can help
to set a new
step with e.g. 'C-x { C-5 { { {', which will set the window resizing
step to 5 columns.
-+++
-** EasyPG
-GPG key servers can now be queried for keys with the
-'M-x epa-search-keys' command. Keys can then be added to your
-personal key ring.
-
-
-* New Modes and Packages in Emacs 28.1
-
-** Lisp Data mode
-The new command 'lisp-data-mode' enables a major mode for buffers
-composed of Lisp symbolic expressions that do not form a computer
-program. The ".dir-locals.el" file is automatically set to use this
-mode, as are other data files produced by Emacs.
-
-** hierarchy.el
-It's a library to create, query, navigate and display hierarchy structures.
-
** New themes 'modus-vivendi' and 'modus-operandi'.
These themes are designed to conform with the highest standard for
color-contrast accessibility (WCAG AAA). You can load either of them
@@ -2820,18 +2814,33 @@ This is a mode for searching a RFC 2229 dictionary
server.
the mouse in 'dictionary-tooltip-dictionary' (which must be customized
first).
-** transient.el
+** Lisp Data mode
+The new command 'lisp-data-mode' enables a major mode for buffers
+composed of Lisp symbolic expressions that do not form a computer
+program. The ".dir-locals.el" file is automatically set to use this
+mode, as are other data files produced by Emacs.
++++
+** New global mode 'global-goto-address-mode'.
+This will enable 'goto-address-mode' in all buffers.
+
+** transient.el
This library implements support for powerful keyboard-driven menus.
Such menus can be used as simple visual command dispatchers. More
complex menus take advantage of infix arguments, which are somewhat
similar to prefix arguments, but are more flexible and discoverable.
+** hierarchy.el
+It's a library to create, query, navigate and display hierarchical
+structures.
+
* Incompatible Editing Changes in Emacs 28.1
-** 'revert-buffer' will now preserve buffer-readedness.
-It previously switched the read-only flag off.
+---
+** 'toggle-truncate-lines' now disables 'visual-line-mode'.
+This is for symmetry with 'visual-line-mode', which disables
+'truncate-lines'.
** 'electric-indent-mode' now also indents inside strings and comments,
(unless the indentation function doesn't, of course).
@@ -2864,16 +2873,18 @@ before, you can add the following to your init file:
Use 'M-x font-lock-fontify-block' instead, or the new 'C-x x f'
command, which updates the syntax highlighting in the current buffer.
-** In 'f90-mode', the backslash character ('\') no longer escapes.
-For about a decade, the backslash character has no longer had a
-special escape syntax in Fortran F90. To get the old behaviour back,
-say something like:
-
- (modify-syntax-entry ?\\ "\\" f90-mode-syntax-table)
+** The escape sequence '\e[29~' in Xterm is now mapped to 'menu'.
+Xterm sends this sequence for both 'F16' and 'Menu' keys
+It used to be mapped to 'print' but we couldn't find a terminal
+that uses this sequence for any kind of 'Print' key.
+This makes the Menu key (see https://en.wikipedia.org/wiki/Menu_key)
+work for 'context-menu-mode' in Xterm.
-** 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.
+---
+** New user option 'xterm-store-paste-on-kill-ring'.
+If non-nil (the default), Emacs pushes pasted text onto the kill ring
+(if using an xterm-like terminal that supports bracketed paste).
+Setting this to nil inhibits that.
** 'vc-print-branch-log' shows the change log for BRANCH from its root
directory instead of the default directory.
@@ -2882,16 +2893,33 @@ directory instead of the default directory.
** 'project-shell' and 'shell' now use 'pop-to-buffer-same-window'.
This is to keep the same behavior as Eshell.
+** 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.
+
+** In 'f90-mode', the backslash character ('\') no longer escapes.
+For about a decade, the backslash character has no longer had a
+special escape syntax in Fortran F90. To get the old behavior back,
+say something like:
+
+ (modify-syntax-entry ?\\ "\\" f90-mode-syntax-table)
+
+** Setting 'fill-column' to nil is obsolete.
+This undocumented use of 'fill-column' is now obsolete. To disable
+auto filling, turn off 'auto-fill-mode' instead.
+
+For instance, you could add something like the following to your init
+file:
+
+ (add-hook 'foo-mode-hook (lambda () (auto-fill-mode -1))
+
* Incompatible Lisp Changes in Emacs 28.1
----
-** 'kill-all-local-variables' has changed how it handles non-symbol hooks.
-The function is documented to eliminated all buffer-local bindings
-except variables with a 'permanent-local' property, or hooks that
-have elements with a 'permanent-local-hook' property. In addition, it
-would also keep lambda expressions in hooks sometimes. The latter has
-now been changed: The function will now also remove these.
+** Emacs now prints a backtrace when signaling an error in batch mode.
+This makes debugging Emacs Lisp scripts run in batch mode easier. To
+get back the old behavior, set the new variable
+'backtrace-on-error-noninteractive' to a nil value.
---
** Some floating-point numbers are now handled differently by the Lisp reader.
@@ -2901,6 +2929,12 @@ integer 2. Such numerals are now read as floats with
the exponent included:
2.e6 is now read as the floating-point value 2000000.0.
That is, '(read-from-string "1.e3")' => '(1000.0 . 4)' now.
+** '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.
+
+++
** The 'lexical-binding' local variable is always enabled.
Previously, if 'enable-local-variables' was nil, a 'lexical-binding'
@@ -2908,84 +2942,201 @@ local variable would not be heeded. This has now
changed, and a file
with a 'lexical-binding' cookie is always heeded. To revert to the
old behavior, set 'permanently-enabled-local-variables' to nil.
-+++
-** 'completing-read-default' sets completion variables buffer-locally.
-'minibuffer-completion-table' and related variables are now set buffer-locally
-in the minibuffer instead of being set via a global let-binding.
+---
+** 'kill-all-local-variables' has changed how it handles non-symbol hooks.
+The function is documented to eliminate all buffer-local bindings
+except variables with a 'permanent-local' property, or hooks that
+have elements with a 'permanent-local-hook' property. In addition, it
+would also keep lambda expressions in hooks sometimes. The latter has
+now been changed: The function will now also remove these.
+++
-** The use of positional arguments in 'define-minor-mode' is obsolete.
-These were actually rendered obsolete in Emacs 21 but were never
-marked as such.
-
-** 'facemenu-color-alist' is now obsolete, and is not used.
-
-** 'facemenu.el' is no longer preloaded.
-To use functions/variables from the package, you now have to say
-'(require 'facemenu)' or similar.
+** Temporary buffers no longer run certain buffer hooks.
+The macros 'with-temp-buffer' and 'with-temp-file' no longer run the
+hooks 'kill-buffer-hook', 'kill-buffer-query-functions', and
+'buffer-list-update-hook' for the temporary buffers they create. This
+avoids slowing them down when a lot of these hooks are defined.
-** 'pcomplete-ignore-case' is now an obsolete alias of
'completion-ignore-case'.
+** New face 'child-frame-border' and frame parameter
'child-frame-border-width'.
+The face and width of child frames borders can now be determined
+separately from those of normal frames. To minimize backward
+incompatibility, child frames without a 'child-frame-border-width'
+parameter will fall back to using 'internal-border-width'. However,
+the new 'child-frame-border' face does constitute a breaking change
+since child frames' borders no longer use the 'internal-border' face.
-** 'completions-annotations' face is not used when the caller puts own face.
-This affects the suffix specified by completion 'annotation-function'.
+---
+** 'run-at-time' now tries harder to implement the t TIME parameter.
+If TIME is t, the timer runs at an integral multiple of REPEAT.
+(I.e., if given a REPEAT of 60, it'll run at 08:11:00, 08:12:00,
+08:13:00.) However, when a machine goes to sleep (or otherwise didn't
+get a time slot to run when the timer was scheduled), the timer would
+then fire every 60 seconds after the time the timer was fired. This
+has now changed, and the timer code now recomputes the integral
+multiple every time it runs, which means that if the laptop wakes at
+08:16:43, it'll fire at that time, but then at 08:17:00, 08:18:00...
-** 'set-process-buffer' now updates the process mark.
-The mark will be set to point to the end of the new buffer.
+---
+** 'parse-partial-sexp' now signals an error if TO is smaller than FROM.
+Previously, this would lead to the function interpreting FROM as TO and
+vice versa, which would be confusing when passing in OLDSTATE, which
+refers to the old state at FROM.
+++
-** An active minibuffer now has major mode 'minibuffer-mode', not the
-erroneous 'minibuffer-inactive-mode' it formerly had.
+** 'global-mode-string' constructs should end with a space.
+This was previously not formalized, which led to combinations of modes
+displaying data "smushed together" on the mode line.
+++
-** 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'.
+** 'overlays-in' now handles zero-length overlays slightly differently.
+Previously, zero-length overlays at the end of the buffer were included
+in the result (if the region queried for stopped at that position).
+The same was not the case if the buffer had been narrowed to exclude
+the real end of the buffer. This has now been changed, and
+zero-length overlays at 'point-max' are always included in the results.
-** '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.
+---
+** 'replace-match' now runs modification hooks slightly later.
+The function is documented to leave point after the replacement text,
+but this was not always the case if a modification hook inserted text
+in front of the replaced text -- 'replace-match' would instead leave
+point where the end of the inserted text would have been before the
+hook ran. 'replace-match' now always leaves point after the
+replacement text.
+
++++
+** 'completing-read-default' sets completion variables buffer-locally.
+'minibuffer-completion-table' and related variables are now set buffer-locally
+in the minibuffer instead of being set via a global let-binding.
+
+** 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.
+
+---
+** JSON
+
+*** 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.
+
+*** JSON functions support the semantics of RFC 8259.
+The JSON functions 'json-serialize', 'json-insert',
+'json-parse-string', and 'json-parse-buffer' now implement some of the
+semantics of RFC 8259 instead of the earlier RFC 4627. In particular,
+these functions now accept top-level JSON values that are neither
+arrays nor objects.
-** When its first argument is a string, 'make-text-button' no longer
+---
+*** Some JSON encoding functions are now obsolete.
+The functions 'json-encode-number', 'json-encode-hash-table',
+'json-encode-key', and 'json-encode-list' are now obsolete.
+
+The first two are kept as aliases of 'json-encode', which should be
+used instead. Uses of 'json-encode-list' should be changed to call
+one of 'json-encode', 'json-encode-alist', 'json-encode-plist', or
+'json-encode-array' instead.
+
++++
+*** Native JSON functions now signal an error if libjansson is unavailable.
+This affects 'json-serialize', 'json-insert', 'json-parse-string',
+and 'json-parse-buffer'. This can happen if Emacs was compiled with
+libjansson, but the DLL cannot be found and/or loaded by Emacs at run
+time. Previously, Emacs would display a message and return nil in
+these cases.
+
++++
+** The use of positional arguments in 'define-minor-mode' is obsolete.
+These were actually rendered obsolete in Emacs 21 but were never
+marked as such.
+
+** 'pcomplete-ignore-case' is now an obsolete alias of
'completion-ignore-case'.
+
+** 'completions-annotations' face is not used when the caller puts own face.
+This affects the suffix specified by completion 'annotation-function'.
+
++++
+** An active minibuffer now has major mode 'minibuffer-mode'.
+This is instead of the erroneous 'minibuffer-inactive-mode' it
+formerly had.
+
+** 'make-text-button' no longer text properties of its first argument.
+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.
+++
-** Temporary buffers no longer run certain buffer hooks.
-The macros 'with-temp-buffer' and 'with-temp-file' no longer run the
-hooks 'kill-buffer-hook', 'kill-buffer-query-functions', and
-'buffer-list-update-hook' for the temporary buffers they create. This
-avoids slowing them down when a lot of these hooks are defined.
-
-** New face 'child-frame-border' and frame parameter
'child-frame-border-width'.
-The face and width of child frames borders can now be determined
-separately from those of normal frames. To minimize backward
-incompatibility, child frames without a 'child-frame-border-width'
-parameter will fall back to using 'internal-border-width'. However,
-the new 'child-frame-border' face does constitute a breaking change
-since child frames' borders no longer use the 'internal-border' face.
-
----
-** The obsolete function 'thread-alive-p' has been removed.
+** 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'.
** '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 '&define' keyword in an Edebug specification now disables backtracking.
+The implementation was buggy, and multiple '&define' forms in an '&or'
+form should be exceedingly rare. See the Info node "(elisp) Backtracking" in
+the Emacs Lisp reference manual for background.
+
++++
+** The error 'ftp-error' belongs also to category 'remote-file-error'.
+
+** The WHEN argument of 'make-obsolete' and related functions is mandatory.
+The use of those functions without a WHEN argument was marked obsolete
+back in Emacs 23.1. The affected functions are: 'make-obsolete',
+'define-obsolete-function-alias', 'make-obsolete-variable',
+'define-obsolete-variable-alias'.
+
++++
+** 'inhibit-nul-byte-detection' is renamed to 'inhibit-null-byte-detection'.
+
---
-** The new function 'dns-query-asynchronous' has been added.
-It takes the same parameters as 'dns-query', but adds a callback
-parameter.
+** Some functions are no longer considered safe by 'unsafep':
+'replace-regexp-in-string', 'catch', 'throw', 'error', 'signal'
+and 'play-sound-file'.
+
+---
+** '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.
+
+---
+** 'sql-*-statement-starters' are no longer user options.
+These variables describe facts about the SQL standard and
+product-specific additions. There should be no need for users to
+customize them.
-** The Lisp variables 'previous-system-messages-locale' and
+** Some locale-related variables have been removed.
+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.
---
+** Function 'lm-maintainer' is replaced with 'lm-maintainers'.
+The former is now declared obsolete.
+
+** 'facemenu.el' is no longer preloaded.
+To use functions/variables from the package, you now have to say
+'(require 'facemenu)' or similar.
+
+** 'facemenu-color-alist' is now obsolete, and is not used.
+
+** The variable 'keyboard-type' is obsolete and not dynamically scoped any
more.
+
++++
+** The 'values' variable is now obsolete.
+Using it just contributes to the growth of the Emacs memory
+footprint.
+
+---
** 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.
@@ -2996,18 +3147,39 @@ This is no longer supported, and setting this variable
has no effect.
Use macro 'with-current-buffer-window' with action alist entry 'body-function'.
---
+** The rfc2368.el library is now obsolete.
+Use rfc6068.el instead. The main difference is that
+'rfc2368-parse-mailto-url' and 'rfc2368-unhexify-string' assumed that
+the strings were all-ASCII, while 'rfc6068-parse-mailto-url' and
+'rfc6068-unhexify-string' parse UTF-8 strings.
+
+---
** The inversion.el library is now obsolete.
---
** The metamail.el library is now obsolete.
+** Edebug changes
+
---
-** 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.
+*** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'.
+
++++
+*** The spec operator ':name NAME' is obsolete, use '&name' instead.
+
++++
+*** The spec element 'function-form' is obsolete, use 'form' instead.
+
++++
+*** New function 'def-edebug-elem-spec' to define Edebug spec elements.
+These used to be defined with 'def-edebug-spec' thus conflating the
+two name spaces, which lead to name collisions.
+The use of 'def-edebug-spec' to define Edebug spec elements is
+declared obsolete.
+
+---
+** The sb-image.el library is now obsolete.
+This was a compatibility kludge which is no longer needed.
---
** Some libraries obsolete since Emacs 23 have been removed:
@@ -3032,7 +3204,7 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'erc-announced-server-name', 'erc-default-coding-system',
'erc-process', 'erc-send-command', 'eshell-report-bug',
'eval-next-after-load', 'exchange-dot-and-mark', 'ffap-bug',
-'ffap-submit-bug', 'ffap-version', 'file-cache-choose-completion',
+'ffap-submit-bug', 'ffap-version', 'file-cache-mouse-choose-completion',
'forward-point', 'generic-char-p', 'global-highlight-changes',
'hi-lock-face-history', 'hi-lock-regexp-history',
'highlight-changes-active-string', 'highlight-changes-initial-state',
@@ -3091,132 +3263,481 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'gnus-treat-display-xface', 'gnus-treat-strip-pgp',
'nnmail-spool-file'.
-** The WHEN argument of 'make-obsolete' and related functions is mandatory.
-The use of those functions without a WHEN argument was marked obsolete
-back in Emacs 23.1. The affected functions are: 'make-obsolete',
-'define-obsolete-function-alias', 'make-obsolete-variable',
-'define-obsolete-variable-alias'.
+---
+** The obsolete function 'thread-alive-p' has been removed.
-** The variable 'keyboard-type' is obsolete and not dynamically scoped any
more.
+---
+** The variable 'force-new-style-backquotes' has been removed.
+This removes the final remaining trace of old-style backquotes.
+
+---
+** 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.
+
+
+* Lisp Changes in Emacs 28.1
+
++++
+** The 'interactive' syntax has been extended to allow listing applicable
modes.
+Forms like '(interactive "p" dired-mode)' can be used to annotate the
+commands as being applicable for modes derived from 'dired-mode',
+or if the mode is a minor mode, that the current buffer has that
+minor mode activated. Note that using this form will create byte code
+that is not compatible with byte code in previous Emacs versions.
+
++++
+** New forms to declare how completion should happen has been added.
+'(declare (completion PREDICATE))' can be used as a general predicate
+to say whether the command should be present when completing with
+'M-x TAB'. '(declare (modes MODE...))' can be used as a short-hand
+way of saying that the command should be present when completing from
+buffers in major modes derived from MODE..., or, if it's a minor mode,
+whether that minor mode is enabled in the current buffer.
+
++++
+** 'define-minor-mode' now takes an ':interactive' argument.
+This can be used for specifying which modes this minor mode is meant
+for, or to make the new minor mode non-interactive. The default value
+is t.
+
++++
+** 'define-derived-mode' now takes an ':interactive' argument.
+This can be used to control whether the defined mode is a command
+or not, and is useful when defining commands that aren't meant to be
+used by users directly.
+
++++
+** 'define-globalized-minor-mode' now takes a ':predicate' parameter.
+This can be used to control which major modes the minor mode should be
+used in.
+
++++
+** 'condition-case' now allows for a success handler.
+It is written as '(:success BODY...)' where BODY is executed
+whenever the protected form terminates without error, with the
+specified variable bound to the the value of the protected form.
+
+** New function 'benchmark-call' to measure the execution time of a function.
+Additionally, the number of repetitions can be expressed as a minimal duration
+in seconds.
+
++++
+** The value thrown to the 'exit' label can now be a function.
+This is in addition to values t or nil. If the value is a function,
+the command loop will call it with zero arguments before returning.
+
++++
+** 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".
+
+---
+** 'defvar' detects the error of defining a variable currently lexically bound.
+Such mixes are always signs that the outer lexical binding was an
+error and should have used dynamic binding instead.
+
+---
+** New variable 'inhibit-mouse-event-check'.
+If bound to non-nil, a command with '(interactive "e")' doesn't signal
+an error when invoked by input event that is not a mouse click (e.g.,
+a key sequence).
+
+** New variable 'redisplay-skip-initial-frame' to enable batch redisplay tests.
+Setting it to nil forces the redisplay to do its job even in the
+initial frame used in batch mode.
+
++++
+** Doc strings can now link to customization groups.
+Text like "customization group `whitespace'" will be made into a
+button. When clicked, it'll take the user to a Custom buffer
+displaying that customization group.
+
++++
+** Buffers can now be created with certain hooks disabled.
+The functions 'get-buffer-create' and 'generate-new-buffer' accept a
+new optional argument INHIBIT-BUFFER-HOOKS. If non-nil, the new
+buffer does not run the hooks 'kill-buffer-hook',
+'kill-buffer-query-functions', and 'buffer-list-update-hook'. This
+avoids slowing down internal or temporary buffers that are never
+presented to users or passed on to other applications.
+
++++
+** 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.
+
+---
+** Dragging a file into Emacs pushes the file name onto 'file-name-history'.
+
+---
+** The 'easymenu' library is now preloaded.
+
+---
+** The 'iso-transl' library is now preloaded.
+This means that keystrokes like 'Alt-[' are defined by default,
+instead of only becoming available after doing (for instance)
+'C-x 8 <letter>'.
+
+---
+** ':safe' settings in 'defcustom' are now propagated to the loaddefs files.
+
++++
+** ERT can now output more verbose test failure reports.
+If the 'EMACS_TEST_VERBOSE' environment variable is set, failure
+summaries will include the failing condition.
+
+** Byte compiler changes
+
++++
+*** New byte-compiler check for missing dynamic variable declarations.
+It is meant as an (experimental) aid for converting Emacs Lisp code
+to lexical binding, where dynamic (special) variables bound in one
+file can affect code in another. For details, see the manual section
+"(elisp) Converting to Lexical Binding".
+
++++
+*** 'byte-recompile-directory' can now compile symlinked ".el" files.
+This is achieved by giving a non-nil FOLLOW-SYMLINKS parameter.
+
+---
+*** The byte-compiler now warns about too wide documentation strings.
+By default, it will warn if a documentation string is wider than the
+largest of 'byte-compile-docstring-max-column' or 'fill-column'
+characters.
+
++++
+*** 'byte-compile-file' optional argument LOAD is now obsolete.
+To load the file after byte-compiling, add a call to 'load' from Lisp
+or use 'M-x emacs-lisp-byte-compile-and-load' interactively.
+
+** Macroexp
+---
+*** New function 'macroexp-file-name' to know the name of the current file.
+---
+*** New function 'macroexp-compiling-p' to know if we're compiling.
+---
+*** New function 'macroexp-warn-and-return' to help emit warnings.
+This used to be named 'macroexp--warn-and-return' and has proved useful
+and well-behaved enough to lose the "internal" marker.
+
+** map.el
+
+*** 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))'.
+
+---
+*** The function 'map-copy' now uses 'copy-alist' on alists.
+This is a slightly deeper copy than the previous 'copy-sequence'.
+
+---
+*** The function 'map-contains-key' now supports plists.
+
+---
+*** More consistent duplicate key handling in 'map-merge-with'.
+Until now, 'map-merge-with' promised to call its function argument
+whenever multiple maps contained 'eql' keys. However, this did not
+always coincide with the keys that were actually merged, which could
+be 'equal' instead. The function argument is now called whenever keys
+are merged, for greater consistency with 'map-merge' and 'map-elt'.
+
+** pcase
+
++++
+*** The 'or' pattern now binds the union of the vars of its sub-patterns.
+If a variable is not bound by the subpattern that matched, it gets bound
+to nil. This was already sometimes the case, but it is now guaranteed.
+
++++
+*** The 'pred' pattern can now take the form '(pred (not FUN))'.
+This is like '(pred (lambda (x) (not (FUN x))))' but results
+in better code.
+
+---
+*** New function 'pcase-compile-patterns' to write other macros.
+
+*** Added 'cl-type' pattern.
+The new 'cl-type' pattern compares types using 'cl-typep', which allows
+comparing simple types like '(cl-type integer)', as well as forms like
+'(cl-type (integer 0 10))'.
+
+*** New macro 'pcase-setq'.
+This macro is the 'setq' equivalent of 'pcase-let', which allows for
+destructuring patterns in a 'setq' form.
+
+** Edebug
+
+*** Edebug specification lists can use some new keywords:
+
++++
+**** '&interpose SPEC FUN ARGS..' lets FUN control parsing after SPEC.
+More specifically, FUN is called with 'HEAD PF ARGS..' where
+PF is a parsing function that expects a single argument (the specs to
+use) and HEAD is the code that matched SPEC.
+
++++
+**** '&error MSG' unconditionally aborts the current edebug instrumentation.
+
++++
+**** '&name SPEC FUN' extracts the current name from the code matching SPEC.
+
+** Dynamic modules changes
+
++++
+*** Type aliases for module functions and finalizers.
+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.
+The finalizer 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.
+Modules can use the new module function 'open_channel' to do that.
+On capable systems, modules can use this functionality to
+asynchronously send data back to Emacs.
+
++++
+*** A new module API 'make_unibyte_string'.
+It can be used to create Lisp strings with arbitrary byte sequences
+(a.k.a. "raw bytes").
+
++++
+** 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
+it matches on fixed strings instead of regexps, and does not change
+the global match state.
+
++++
+** New function 'split-string-shell-command'.
+This splits a shell command string into separate components,
+respecting quoting with single ('like this') and double ("like this")
+quotes, as well as backslash quoting (like\ this).
+
+** New string manipulation functions added to subr-x.el.
+the functions are 'string-clean-whitespace', 'string-fill',
+'string-limit', 'string-lines', 'string-pad' and
+'string-chop-newline'.
+
++++
+** New function 'replace-regexp-in-region'.
+
++++
+** New function 'replace-string-in-region'.
+
++++
+** New function 'file-name-with-extension'.
+This function allows a canonical way to set/replace the extension of a
+file name.
+
++++
+** New function 'file-modes-number-to-symbolic' to convert a numeric
+file mode specification into symbolic form.
+
++++
+** New function 'file-name-concat'.
+This appends file name components to a directory name and returns the
+result.
+
++++
+** New function 'file-backup-file-names'.
+This function returns the list of file names of all the backup files
+for the specified file.
+
++++
+** New function 'directory-empty-p'.
+This predicate tests whether a given file name is an accessible
+directory and whether it contains no other directories or files.
+
++++
+** New function 'buffer-local-boundp'.
+This predicate says whether a symbol is bound in a specific buffer.
-** The 'values' variable is now obsolete.
++++
+** New function 'always'.
+This is identical to 'ignore', but returns t instead.
+++
-** The '&define' keyword in an Edebug specification now disables backtracking.
-The implementation was buggy, and multiple '&define' forms in an '&or'
-form should be exceedingly rare. See the Info node "(elisp) Backtracking" in
-the Emacs Lisp reference manual for background.
+** New function 'sxhash-equal-including-properties'.
+This is identical to 'sxhash-equal' but also accounts for string
+properties.
+
+** New function 'buffer-line-statistics'.
+This function returns some statistics about the line lengths in a buffer.
---
-** 'sql-*-statement-starters' are no longer user options.
-These variables describe facts about the SQL standard and
-product-specific additions. There should be no need for users to
-customize them.
+** 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.
---
-** Function 'lm-maintainer' is replaced with 'lm-maintainers'.
-The former is now declared obsolete.
+** New function 'custom-add-choice'.
+This function can be used by modes to add elements to the
+'choice' customization type of a variable.
-
-* Lisp Changes in Emacs 28.1
+---
+** New function 'decoded-time-period'.
+It interprets a decoded time structure as a period and returns the
+equivalent period in seconds.
+++
-*** New function 'split-string-shell-command'.
-This splits a shell command string into separate components,
-respecting quoting with single ('like this') and double ("like this")
-quotes, as well as backslash quoting (like\ this).
+** New function 'dom-print'.
+
++++
+** New function 'dom-remove-attribute'.
+
+---
+** New function 'dns-query-asynchronous'.
+It takes the same parameters as 'dns-query', but adds a callback
+parameter.
+
+** New function 'garbage-collect-maybe' to trigger GC early.
---
-*** ':safe' settings in 'defcustom' are now propagated to the loaddefs files.
+** New function 'get-locale-names'.
+This utility function returns a list of names of locales available on
+the current system.
+++
-** New function 'syntax-class-to-char'.
-This does almost the opposite of 'string-to-syntax' -- it returns the
-syntax descriptor (a character) given a raw syntax descriptor (an
-integer).
+** New function 'insert-into-buffer'.
+This is like 'insert-buffer-substring', but works in the opposite
+direction.
+++
-** New function 'buffer-local-boundp'.
-This predicate says whether a symbol is bound in a specific buffer.
+** New function 'json-available-p'.
+This predicate returns non-nil if Emacs is built with libjansson
+support, and it is available on the current system.
---
-** Emacs now attempts to test for high-rate subprocess output more fairly.
-When several subprocesses produce output simultaneously at high rate,
-Emacs will now by default attempt to service them all in a round-robin
-fashion. Set the new variable 'process-prioritize-lower-fds' to a
-non-nil value to get back the old behavior, whereby after reading
-from a subprocess, Emacs would check for output of other subprocesses
-in a way that is likely to read from the same process again.
+** New function 'mail-header-parse-addresses-lax'.
+This takes a comma-separated string and returns a list of mail/name
+pairs.
+
+---
+** New function 'mail-header-parse-address-lax'.
+Parse a string as a mail address-like string.
+
+---
+** New function 'make-separator-line'.
+Make a string appropriate for usage as a visual separator line.
+++
-** New function 'sxhash-equal-including-properties'.
-This is identical to 'sxhash-equal' but accounting also for string
-properties.
+** New function 'object-intervals'.
+This function returns a copy of the list of intervals (i.e., text
+properties) in the object in question (which must either be a string
+or a buffer).
+++
-** 'unlock-buffer' displays warnings instead of signaling.
-Instead of signaling 'file-error' conditions for file system level
-errors, the function now calls 'display-warning' and continues as if
-the error did not occur.
+** New function '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.
+++
-** New function 'always'.
-This is identical to 'ignore', but returns t instead.
+** New function 'require-theme'.
+This function is like 'require', but searches 'custom-theme-load-path'
+instead of 'load-path'. It can be used by Custom themes to load
+supporting Lisp files when 'require' is unsuitable.
+++
-** New forms to declare how completion should happen has been added.
-'(declare (completion PREDICATE))' can be used as a general predicate
-to say whether the command should be present when completing with
-'M-x TAB'. '(declare (modes MODE...))' can be used as a short-hand
-way of saying that the command should be present when completing from
-buffers in major modes derived from MODE..., or, if it's a minor mode,
-whether that minor mode is enabled in the current buffer.
+** New function 'syntax-class-to-char'.
+This does almost the opposite of 'string-to-syntax' -- it returns the
+syntax descriptor (a character) given a raw syntax descriptor (an
+integer).
+++
-** The 'interactive' syntax has been extended to allow listing applicable
modes.
-Forms like '(interactive "p" dired-mode)' can be used to annotate the
-commands as being applicable for modes derived from 'dired-mode',
-or if the mode is a minor mode, that the current buffer has that
-minor mode activated. Note that using this form will create byte code
-that is not compatible with byte code in previous Emacs versions.
+** New functions 'null-device' and 'path-separator'.
+These functions return the connection local value of the respective
+variables. This can be used for remote hosts.
+++
-** New buffer-local variable 'local-minor-modes'.
-This permanently buffer-local variable holds a list of currently
-enabled non-global minor modes in the current buffer (as a list of
-symbols).
+** New predicate functions 'length<', 'length>' and 'length='.
+Using these functions may be more efficient than using 'length' (if
+the length of a (long) list is being computed just to compare this
+length to a number).
+++
-** New variable 'global-minor-modes'.
-This variable holds a list of currently enabled global minor modes (as
-a list of symbols).
+** New macro 'dlet' to dynamically bind variables.
+++
-** 'define-minor-mode' now takes an ':interactive' argument.
-This can be used for specifying which modes this minor mode is meant
-for, or to make the new minor mode non-interactive. The default value
-is t.
+** New macro 'with-existing-directory'.
+This macro binds 'default-directory' to some other existing directory
+if 'default-directory' doesn't exist, and then executes the body forms.
+++
-** 'define-derived-mode' now takes an ':interactive' argument.
-This can be used to control whether the defined mode is a command
-or not, and is useful when defining commands that aren't meant to be
-used by users directly.
+** New variable 'current-minibuffer-command'.
+This is like 'this-command', but it is bound recursively when entering
+the minibuffer.
----
-** The 'easymenu' library is now preloaded.
++++
+** New variable 'inhibit-interaction' to make user prompts signal an error.
+If this is bound to something non-nil, functions like
+'read-from-minibuffer', 'read-char' (and related) will signal an
+'inhibited-interaction' error.
---
** New variable 'indent-line-ignored-functions'.
This allows modes to cycle through a set of indentation functions
appropriate for those modes.
-** New function 'garbage-collect-maybe' to trigger GC early.
++++
+** New variable 'print-integers-as-characters' modifies integer printing.
+If this variable is non-nil, character syntax is used for printing
+numbers when this makes sense, such as '?A' for 65.
+
++++
+** New variable 'tty-menu-calls-mouse-position-function'.
+This controls whether 'mouse-position-function' is called by functions
+that retrieve the mouse position when that happens during TTY menu
+handling. Lisp programs that set 'mouse-position-function' should
+also set this variable non-nil if they are compatible with the tty
+menu handling.
+
++++
+** 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.
---
-** 'defvar' detects the error of defining a variable currently lexically bound.
-Such mixes are always signs that the outer lexical binding was an
-error and should have used dynamic binding instead.
+** New variables 'read-char-choice-use-read-key' and 'y-or-n-p-use-read-key'.
+When non-nil, then functions 'read-char-choice' and 'y-or-n-p'
+(respectively) use the function 'read-key' to read a character instead
+of using the minibuffer.
+
++++
+** New variable 'global-minor-modes'.
+This variable holds a list of currently enabled global minor modes (as
+a list of symbols).
+
++++
+** New buffer-local variable 'local-minor-modes'.
+This permanently buffer-local variable holds a list of currently
+enabled non-global minor modes in the current buffer (as a list of
+symbols).
+++
** New completion function 'affixation-function' to add prefix/suffix.
@@ -3229,87 +3750,76 @@ a prefix string, and a suffix string.
It takes two arguments: a completion candidate and a 'transform' flag.
+++
-** 'read-char-from-minibuffer' and 'y-or-n-p' support 'help-form'.
-If you bind 'help-form' to a non-nil value while calling these functions,
-then pressing 'C-h' ('help-char') causes the function to evaluate 'help-form'
-and display the result.
+** New error symbol 'minibuffer-quit'.
+Signaling it has almost the same effect as 'quit' except that it
+doesn't cause keyboard macro termination.
----
-** New variables 'read-char-choice-use-read-key' and 'y-or-n-p-use-read-key'.
-When non-nil, then functions 'read-char-choice' and 'y-or-n-p' (respectively)
-use the function 'read-key' to read a character instead of using the
minibuffer.
++++
+** New error 'remote-file-error', a subcategory of 'file-error'.
+It is signaled if a remote file operation fails due to internal
+reasons, and could block Emacs. It does not replace 'file-error'
+signals for the usual cases. Timers, process filters and process
+functions, which run remote file operations, shall protect themselves
+against this error.
----
-** New user option 'use-short-answers'.
-When non-nil, the function 'y-or-n-p' is used instead of
-'yes-or-no-p'. This eliminates the need to define an alias that maps
-one to another in the init file. The same user option also controls
-whether the function 'read-answer' accepts short answers.
+If such an error occurs, please report this as bug via 'M-x report-emacs-bug'.
+Until it is solved you could ignore such errors by performing
-+++
-** 'set-window-configuration' now takes two optional parameters,
-'dont-set-frame' and 'dont-set-miniwindow'. The first of these, when
-non-nil, instructs the function not to select the frame recorded in
-the configuration. The second prevents the current minibuffer being
-replaced by the one stored in the configuration.
+ (setq debug-ignored-errors (cons 'remote-file-error debug-ignored-errors))
-+++
-** 'define-globalized-minor-mode' now takes a ':predicate' parameter.
-This can be used to control which major modes the minor mode should be
-used in.
+** New macro 'named-let' added to subr-x.el.
+It provides Scheme's "named let" looping construct.
-+++
-** 'truncate-string-ellipsis' now uses '…' by default.
-Modes that use 'truncate-string-to-width' with non-nil, non-string
-argument ELLIPSIS, will now indicate truncation using '…' when
-the selected frame can display it, and using "..." otherwise.
+---
+** Emacs now attempts to test for high-rate subprocess output more fairly.
+When several subprocesses produce output simultaneously at high rate,
+Emacs will now by default attempt to service them all in a round-robin
+fashion. Set the new variable 'process-prioritize-lower-fds' to a
+non-nil value to get back the old behavior, whereby after reading
+from a subprocess, Emacs would check for output of other subprocesses
+in a way that is likely to read from the same process again.
-+++
-** 'string-width' now accepts two optional arguments FROM and TO.
-This allows calculating the width of a substring without consing a
-new string.
+** 'set-process-buffer' now updates the process mark.
+The mark will be set to point to the end of the new buffer.
+++
-** 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.
+** 'unlock-buffer' displays warnings instead of signaling.
+Instead of signaling 'file-error' conditions for file system level
+errors, the function now calls 'display-warning' and continues as if
+the error did not occur.
+++
-** New function 'string-search'.
-This function takes two string parameters and returns the position of
-the first instance of the former string in the latter.
+** 'read-char-from-minibuffer' and 'y-or-n-p' support 'help-form'.
+If you bind 'help-form' to a non-nil value while calling these functions,
+then pressing 'C-h' ('help-char') causes the function to evaluate 'help-form'
+and display the result.
+++
-** New 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.
+** '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.
+++
-** 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.
+** 'set-window-configuration' now takes two optional parameters,
+'dont-set-frame' and 'dont-set-miniwindow'. The first of these, when
+non-nil, instructs the function not to select the frame recorded in
+the configuration. The second prevents the current minibuffer being
+replaced by the one stored in the configuration.
---
-** 'ascii' is now a coding system alias for 'us-ascii'.
-
-+++
-** New function 'file-name-with-extension'.
-This function allows a canonical way to set/replace the extension of a
-file name.
+** 'count-windows' now takes an optional parameter ALL-FRAMES.
+The semantics are as with 'walk-windows'.
-+++
-** New function 'file-backup-file-names'.
-This function returns the list of file names of all the backup files
-of its file argument.
++++
+** 'truncate-string-ellipsis' now uses '…' by default.
+Modes that use 'truncate-string-to-width' with non-nil, non-string
+argument ELLIPSIS, will now indicate truncation using '…' when
+the selected frame can display it, and using "..." otherwise.
+++
-** New utility function 'directory-empty-p'.
-This predicate tests whether a given file name is an accessible
-directory and whether it contains no other directories or files.
+** 'string-width' now accepts two optional arguments FROM and TO.
+This allows calculating the width of a substring without consing a
+new string.
+++
** 'directory-files' now takes an additional COUNT parameter.
@@ -3319,7 +3829,7 @@ first COUNT file names that match the expression. The
same COUNT
parameter has been added to 'directory-files-and-attributes'.
+++
-** The 'count-lines' function now takes an optional parameter to
+** 'count-lines' now takes an optional parameter to
ignore invisible lines.
---
@@ -3328,86 +3838,19 @@ 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 'require-theme'.
-This function is like 'require', but searches 'custom-theme-load-path'
-instead of 'load-path'. It can be used by Custom themes to load
-supporting Lisp files when 'require' is unsuitable.
-
-+++
-** New function 'file-modes-number-to-symbolic' to convert a numeric
-file mode specification into symbolic form.
-
-** 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.
-
-** Mode Lines
-
-+++
-*** New user options to control the line/column numbers in the mode line.
-'mode-line-position-line-format' is the line number format (when
-'line-number-mode' is on), 'mode-line-position-column-format' is
-the column number format (when 'column-number-mode' is on), and
-'mode-line-position-column-line-format' is the combined format (when
-both modes are on).
-
-+++
-*** New user option 'mode-line-compact'.
-If non-nil, repeating spaces are compressed into a single space. If
-'long', this is only done when the mode line is longer than the
-current window width (in characters).
-
+++
-*** 'global-mode-string' constructs should end with a space.
-This was previously not formalized, which led to combinations of modes
-displaying data "smushed together" on the mode line.
-
-** Changes in handling dynamic modules
-
-*** The module header 'emacs-module.h' now contains type aliases
-'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.
-
-*** A new module API 'make_unibyte_string' is provided.
-It can be used to create Lisp strings with arbitrary byte sequences
-(a.k.a. "raw bytes").
-
-** '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.
+** File-related APIs can optionally follow symlinks.
+The functions 'file-modes', 'set-file-modes', and 'set-file-times' now
+have an optional argument specifying whether to follow symbolic links.
+++
-** The new function 'dom-remove-attribute' has been added.
+** 'format-seconds' can now be used for sub-second times.
+The new optional "," parameter has been added, and
+'(format-seconds "%mm %,1ss" 66.4)' will now result in "1m 6.4s".
+++
-** The new function 'dom-print' has been added.
+** 'parse-time-string' can now parse ISO 8601 format strings.
+These have the format like "2020-01-15T16:12:21-08:00".
---
** 'make-network-process', 'make-serial-process' ':coding' behavior change.
@@ -3434,17 +3877,8 @@ 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".
+---
+** 'process-attributes' now works under OpenBSD, too.
+++
** 'format-spec' now takes an optional SPLIT parameter.
@@ -3452,94 +3886,85 @@ If non-nil, 'format-spec' will split the resulting
string into a list
of strings, based on where the format specs (and expansions) were.
---
-** New function 'color-values-from-color-spec'.
-This can be used to parse RGB color specs in several formats and
-convert them to a list '(R G B)' of primary color values.
+** 'unload-feature' now also tries to undo additions to buffer-local hooks.
---
-** 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.
+** 'while-no-input-ignore-events' accepts more special events.
+The special events 'dbus-event' and 'file-notify' are now ignored in
+'while-no-input' when added to this variable.
-+++
-** New variable 'tty-menu-calls-mouse-position-function'.
-This controls whether 'mouse-position-function' is called by functions
-that retrieve the mouse position when that happens during TTY menu
-handling. Lisp programs that set 'mouse-position-function' should
-also set this variable non-nil if they are compatible with the tty
-menu handling.
+---
+** 'start-process-shell-command' and 'start-file-process-shell-command'
+do not support the old calling conventions any longer.
+++
-** 'inhibit-nul-byte-detection' is renamed to 'inhibit-null-byte-detection'.
-
-** Byte compiler
+** The 'uniquify' argument in 'auto-save-file-name-transforms' can be a symbol.
+If this symbol is one of the members of 'secure-hash-algorithms',
+Emacs constructs the nondirectory part of the auto-save file name by
+applying that 'secure-hash' to the buffer file name. This avoids any
+risk of excessively long file names.
-+++
-*** New byte-compiler check for missing dynamic variable declarations.
-It is meant as an (experimental) aid for converting Emacs Lisp code
-to lexical binding, where dynamic (special) variables bound in one
-file can affect code in another. For details, see the manual section
-"(elisp) Converting to Lexical Binding".
+---
+** File names checked for null bytes.
+Functions operating on local file names now check that the file names
+don't contain any NUL bytes. This avoids subtle bugs caused by
+silently using only the part of the file name until the first NUL byte.
+++
-*** 'byte-recompile-directory' can now compile symlinked ".el" files.
-This is achieved by giving a non-nil FOLLOW-SYMLINKS parameter.
+** 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 byte-compiler now warns about too wide documentation strings.
-By default, it will warn if a documentation string is wider than the
-largest of 80 characters or 'fill-column'. This is controlled by the
-new user option 'byte-compile-docstring-max-column'.
+** EIEIO Changes
+++
-*** 'byte-compile-file' optional argument LOAD is now obsolete.
-To load the file after byte-compiling, add a call to 'load' from Lisp
-or use 'M-x emacs-lisp-byte-compile-and-load' interactively.
+*** The 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.
---
-** 'unload-feature' now also tries to undo additions to buffer-local hooks.
+*** 'form' in '(eql form)' specializers in 'cl-defmethod' is now evaluated.
+This corresponds to the behavior of defmethod in Common Lisp Object System.
+For compatibility, '(eql SYMBOL)' does not evaluate SYMBOL, for now.
----
-** Some functions are no longer considered safe by 'unsafep':
-'replace-regexp-in-string', 'catch', 'throw', 'error', 'signal'
-and 'play-sound-file'.
+** D-Bus
+++
-** New variable 'print-integers-as-characters' modifies integer printing.
-If this variable is non-nil, character syntax is used for printing
-numbers when this makes sense, such as '?A' for 65.
+*** Property values can be typed explicitly.
+'dbus-register-property' and 'dbus-set-property' accept now optional
+type symbols. Both functions propagate D-Bus errors.
+++
-** New error 'remote-file-error', a subcategory of 'file-error'.
-It is signaled if a remote file operation fails due to internal
-reasons, and could block Emacs. It does not replace 'file-error'
-signals for the usual cases. Timers, process filters and process
-functions, which run remote file operations, shall protect themselves
-against this error.
+*** Registered properties can have the new access type ':write'.
-If such an error occurs, please report this as bug via 'M-x report-emacs-bug'.
-Until it is solved you could ignore such errors by performing
++++
+*** In case of problems, handlers can emit proper D-Bus error messages now.
- (setq debug-ignored-errors (cons 'remote-file-error debug-ignored-errors))
++++
+*** D-Bus errors, which have been converted from incoming D-Bus error
+messages, contain the error name of that message now.
+++
-** The error 'ftp-error' belongs also to category 'remote-file-error'.
+*** D-Bus messages can be monitored with the new command 'dbus-monitor'.
+++
-** Buffers can now be created with certain hooks disabled.
-The functions 'get-buffer-create' and 'generate-new-buffer' accept a
-new optional argument INHIBIT-BUFFER-HOOKS. If non-nil, the new
-buffer does not run the hooks 'kill-buffer-hook',
-'kill-buffer-query-functions', and 'buffer-list-update-hook'. This
-avoids slowing down internal or temporary buffers that are never
-presented to users or passed on to other applications.
+*** 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.
---
-** 'start-process-shell-command' and 'start-file-process-shell-command'
-do not support the old calling conventions any longer.
+** 'text-scale-mode' can now adjust font size of the header line.
+When the new buffer local variable 'text-scale-remap-header-line'
+is non-nil, 'text-scale-adjust' will also scale the text in the header
+line when displaying that buffer.
-** Functions operating on local file names now check that the file names
-don't contain any NUL bytes. This avoids subtle bugs caused by
-silently using only the part of the file name until the first NUL byte.
+This is useful for major modes that arrange their display in a tabular
+form below the header line. It is enabled by default in
+'tabulated-list-mode' and its derived modes.
+
+---
+** 'ascii' is now a coding system alias for 'us-ascii'.
** New coding-systems for EBCDIC variants.
New coding-systems 'ibm256', 'ibm273', 'ibm274', 'ibm277', 'ibm278',
@@ -3550,58 +3975,20 @@ locales. They are also available as aliases
'ebcdic-cp-*' (e.g.,
'cp278' for 'ibm278'). There are also new charsets 'ibm2xx' to
support these coding-systems.
----
-** 'while-no-input-ignore-events' accepts more special events.
-The special events 'dbus-event' and 'file-notify' are now ignored in
-'while-no-input' when added to this variable.
-
-+++
-** 'condition-case' now allows for a success handler.
-It is written as '(:success BODY...)' where BODY is executed
-whenever the protected form terminates without error, with the
-specified variable bound to the the value of the protected form.
-
+++
-** 'The 'uniquify' argument in 'auto-save-file-name-transforms' can be a
symbol.
-If this symbol is one of the members of 'secure-hash-algorithms',
-Emacs constructs the nondirectory part of the auto-save file name by
-applying that 'secure-hash' to the buffer file name. This avoids any
-risk of excessively long file names.
+** New 'Bindat type expression' description language.
+This new system is provided by the new macro 'bindat-type' and
+obsoletes the old data layout specifications. It supports
+arbitrary-size integers, recursive types, and more. See the Info node
+"(elisp) Byte Packing" in the ELisp manual for more details.
* 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
+images in JPEG, PNG, GIF and TIFF formats. This support is available
unless Emacs was configured '--without-native-image-api'.
This feature is experimental, and needs to be turned on to be used.
@@ -3609,14 +3996,51 @@ 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.
++++
+** 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 macOS, 's-<left>' and 's-<right>' are now bound to
'move-beginning-of-line' and 'move-end-of-line' respectively. The commands
to select previous/next frame are still bound to 's-~' and 's-`'.
++++
+** 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 macOS, the user option 'make-pointer-invisible' is now honored.
+
+---
+** 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 command 'xwidget-webkit-clone-and-split-below'.
+*** New command 'xwidget-webkit-clone-and-split-right'.
+These are used in 'xwidget-webkit-mode'.
+
+---
+*** New variable 'xwidget-webkit-enable-plugins'.
+If non-nil, enable plugins in xwidget. (This is only available on
+macOS.)
+
++++
+** New macOS Contacts back-end for EUDC.
+This backend works on newer versions of macOS and is generally
+preferred over the eudcb-mab.el backend.
+
----------------------------------------------------------------------
This file is part of GNU Emacs.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 15e34ea..f904187 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -2660,6 +2660,16 @@ 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.
+** Synthetic fonts on macOS
+
+Synthetic bold looks thinner if the background is darker than the
+foreground and font smoothing is turned on. In such cases, you can
+turn off synthetic bold for particular fonts and use overstriking
+instead by customizing the variable 'face-ignored-fonts'. For
+instance, if the problem is with the Monaco font, you could put
+something like the following in your init file:
+
+(push "\\`-[^-]*-monaco-bold-" face-ignored-fonts)
* Build-time problems
diff --git a/etc/TODO b/etc/TODO
index 1d6824c..8fe698b 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -1538,6 +1538,14 @@ cannot represent in Unicode.
*** Performance
+**** Make the implementation of markers more efficient
+Markers are implemented as a non-sorted singly linked list of markers.
+This makes them scale badly when thousands of markers are created in a
+buffer for some purpose, because some low-level primitives in Emacs
+traverse the markers' list (e.g., when converting between character
+and byte positions), and also because searching for a marker (e.g.,
+with 'buffer-has-markers-at') becomes very slow.
+
**** Explore whether overlay-recenter can cure overlays performance problems
**** Cache schemas. Need to have list of files and mtimes
diff --git a/etc/emacs.desktop b/etc/emacs.desktop
index 81c53c6..0d7cac1 100644
--- a/etc/emacs.desktop
+++ b/etc/emacs.desktop
@@ -10,4 +10,3 @@ Terminal=false
Categories=Development;TextEditor;
StartupNotify=true
StartupWMClass=Emacs
-Keywords=Text;Editor;
diff --git a/etc/emacsclient-mail.desktop b/etc/emacsclient-mail.desktop
index 8d51dcd..b575a41 100644
--- a/etc/emacsclient-mail.desktop
+++ b/etc/emacsclient-mail.desktop
@@ -1,18 +1,19 @@
[Desktop Entry]
Categories=Network;Email;
Comment=GNU Emacs is an extensible, customizable text editor - and more
-Exec=sh -c 'exec emacsclient --alternate-editor= --display="$DISPLAY" --eval
"(message-mailto \"%u\")"'
+Exec=sh -c "exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\"
--eval \\\\(message-mailto\\\\ \\\\\\"%u\\\\\\"\\\\)"
Icon=emacs
Name=Emacs (Mail, Client)
MimeType=x-scheme-handler/mailto;
NoDisplay=true
Terminal=false
Type=Application
+Keywords=emacsclient;
Actions=new-window;new-instance;
[Desktop Action new-window]
Name=New Window
-Exec=emacsclient --alternate-editor= --create-frame --eval '(message-mailto
"%u")'
+Exec=emacsclient --alternate-editor= --create-frame --eval "(message-mailto
\\"%u\\")"
[Desktop Action new-instance]
Name=New Instance
diff --git a/etc/emacsclient.desktop b/etc/emacsclient.desktop
index cd45463..1ecdecf 100644
--- a/etc/emacsclient.desktop
+++ b/etc/emacsclient.desktop
@@ -3,14 +3,14 @@ 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=sh -c 'if [ -n "$*" ]; then exec emacsclient --alternate-editor=
--display="$DISPLAY" "$@"; else exec emacsclient --alternate-editor=
--create-frame; fi' placeholder %F
+Exec=sh -c "if [ -n \\"\\$*\\" ]; then exec emacsclient --alternate-editor=
--display=\\"\\$DISPLAY\\" \\"\\$@\\"; else exec emacsclient
--alternate-editor= --create-frame; fi" placeholder %F
Icon=emacs
Type=Application
Terminal=false
Categories=Development;TextEditor;
StartupNotify=true
StartupWMClass=Emacs
-Keywords=Text;Editor;
+Keywords=emacsclient;
Actions=new-window;new-instance;
[Desktop Action new-window]
diff --git a/etc/facemenu-removal.txt b/etc/facemenu-removal.txt
deleted file mode 100644
index 9a969df..0000000
--- a/etc/facemenu-removal.txt
+++ /dev/null
@@ -1,20 +0,0 @@
-`facemenu-keymap' (normally bound to `M-o') has been disabled.
-==============================================================
-
-We've disabled the normal `M-o' keymap for a month (until March the
-10th, 2021) in the development version of Emacs to see whether anybody
-uses this feature.
-
-If the removal of this key binding doesn't annoy too many people, the
-plan is to then leave the it unbound, for usage by third-party
-packages and users.
-
-If you wish to restore the binding during the trial period, you can
-put the following in your .emacs file:
-
-(facemenu-keymap-restore)
-
-After the trial period is over, the function will be removed.
-
-If you wish to protest the removal of the `M-o' key binding, please
-send your thoughts to the emacs-devel@gnu.org mailing list.
diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt
index 1ede2b9..986f110 100644
--- a/etc/publicsuffix.txt
+++ b/etc/publicsuffix.txt
@@ -734,7 +734,6 @@ gouv.ci
// cl : https://www.nic.cl
// Confirmed by .CL registry <hsalgado@nic.cl>
cl
-aprendemas.cl
co.cl
gob.cl
gov.cl
@@ -4594,15 +4593,17 @@ gob.mx
edu.mx
net.mx
-// my : http://www.mynic.net.my/
+// my : http://www.mynic.my/
+// Available strings: https://mynic.my/resources/domains/buying-a-domain/
my
+biz.my
com.my
-net.my
-org.my
-gov.my
edu.my
+gov.my
mil.my
name.my
+net.my
+org.my
// mz : http://www.uem.mz/
// Submitted by registry <antonio@uem.mz>
@@ -6085,8 +6086,10 @@ biz.ss
com.ss
edu.ss
gov.ss
+me.ss
net.ss
org.ss
+sch.ss
// st : http://www.nic.st/html/policyrules/
st
@@ -6095,7 +6098,6 @@ com.st
consulado.st
edu.st
embaixada.st
-gov.st
mil.st
net.st
org.st
@@ -6712,9 +6714,10 @@ mil.vc
edu.vc
// ve : https://registro.nic.ve/
-// Submitted by registry
+// Submitted by registry nic@nic.ve and nicve@conatel.gob.ve
ve
arts.ve
+bib.ve
co.ve
com.ve
e12.ve
@@ -6726,7 +6729,9 @@ info.ve
int.ve
mil.ve
net.ve
+nom.ve
org.ve
+rar.ve
rec.ve
store.ve
tec.ve
@@ -6805,6 +6810,9 @@ yt
// xn--90ae ("bg", Bulgarian) : BG
бг
+// xn--mgbcpq6gpa1a ("albahrain", Arabic) : BH
+البحرين
+
// xn--90ais ("bel", Belarusian/Russian Cyrillic) : BY
// Operated by .by registry
бел
@@ -6937,6 +6945,9 @@ yt
// xn--80ao21a ("Kaz", Kazakh) : KZ
қаз
+// xn--q7ce6a ("Lao", Lao) : LA
+ລາວ
+
// xn--fzc2c9e2c ("Lanka", Sinhalese-Sinhala) : LK
// https://nic.lk
ලංකා
@@ -7062,7 +7073,13 @@ yt
xxx
// ye : http://www.y.net.ye/services/domain_name.htm
-*.ye
+ye
+com.ye
+edu.ye
+gov.ye
+net.ye
+mil.ye
+org.ye
// za : https://www.zadna.org.za/content/page/domain-information/
ac.za
@@ -7111,7 +7128,7 @@ org.zw
// newGTLDs
-// List of new gTLDs imported from
https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on
2020-11-30T20:26:10Z
+// List of new gTLDs imported from
https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on
2021-08-19T15:13:52Z
// This list is auto-generated, don't edit it manually.
// aaa : 2015-02-26 American Automobile Association, Inc.
aaa
@@ -7137,7 +7154,7 @@ abc
// able : 2015-06-25 Able Inc.
able
-// abogado : 2014-04-24 Minds + Machines Group Limited
+// abogado : 2014-04-24 Registry Services, LLC
abogado
// abudhabi : 2015-07-30 Abu Dhabi Systems and Information Centre
@@ -7335,7 +7352,7 @@ autos
// avianca : 2015-01-08 Avianca Holdings S.A.
avianca
-// aws : 2015-06-25 Amazon Registry Services, Inc.
+// aws : 2015-06-25 AWS Registry LLC
aws
// axa : 2013-12-19 AXA Group Operations SAS
@@ -7413,7 +7430,7 @@ beats
// beauty : 2015-12-03 XYZ.COM LLC
beauty
-// beer : 2014-01-09 Minds + Machines Group Limited
+// beer : 2014-01-09 Registry Services, LLC
beer
// bentley : 2014-12-18 Bentley Motors Limited
@@ -7530,7 +7547,7 @@ bridgestone
// broadway : 2014-12-22 Celebrate Broadway, Inc.
broadway
-// broker : 2014-12-11 Dotbroker Registry Limited
+// broker : 2014-12-11 Dog Beach, LLC
broker
// brother : 2015-01-29 Brother Industries, Ltd.
@@ -7623,15 +7640,12 @@ careers
// cars : 2014-11-13 XYZ.COM LLC
cars
-// casa : 2013-11-21 Minds + Machines Group Limited
+// casa : 2013-11-21 Registry Services, LLC
casa
// case : 2015-09-03 CNH Industrial N.V.
case
-// caseih : 2015-09-03 CNH Industrial N.V.
-caseih
-
// cash : 2014-03-06 Binky Moon, LLC
cash
@@ -7656,9 +7670,6 @@ cbre
// cbs : 2015-08-06 CBS Domains Inc.
cbs
-// ceb : 2015-04-09 The Corporate Executive Board Company
-ceb
-
// center : 2013-11-07 Binky Moon, LLC
center
@@ -7671,7 +7682,7 @@ cern
// cfa : 2014-08-28 CFA Institute
cfa
-// cfd : 2014-12-11 DotCFD Registry Limited
+// cfd : 2014-12-11 ShortDot SA
cfd
// chanel : 2015-04-09 Chanel International B.V.
@@ -7749,7 +7760,7 @@ clothing
// cloud : 2015-04-16 Aruba PEC S.p.A.
cloud
-// club : 2013-11-08 .CLUB DOMAINS, LLC
+// club : 2013-11-08 Registry Services, LLC
club
// clubmed : 2015-06-25 Club Méditerranée S.A.
@@ -7806,7 +7817,7 @@ contact
// contractors : 2013-09-10 Binky Moon, LLC
contractors
-// cooking : 2013-11-21 Minds + Machines Group Limited
+// cooking : 2013-11-21 Registry Services, LLC
cooking
// cookingchannel : 2015-07-02 Lifestyle Domain Holdings, Inc.
@@ -7839,7 +7850,7 @@ credit
// creditcard : 2014-03-20 Binky Moon, LLC
creditcard
-// creditunion : 2015-01-22 CUNA Performance Resources, LLC
+// creditunion : 2015-01-22 DotCooperation LLC
creditunion
// cricket : 2014-10-09 dot Cricket Limited
@@ -7896,7 +7907,7 @@ day
// dclk : 2014-11-20 Charleston Road Registry Inc.
dclk
-// dds : 2015-05-07 Minds + Machines Group Limited
+// dds : 2015-05-07 Registry Services, LLC
dds
// deal : 2015-06-25 Amazon Registry Services, Inc.
@@ -7935,7 +7946,7 @@ dentist
// desi : 2013-11-14 Desi Networks LLC
desi
-// design : 2014-11-07 Top Level Design, LLC
+// design : 2014-11-07 Registry Services, LLC
design
// dev : 2014-10-16 Charleston Road Registry Inc.
@@ -8124,7 +8135,7 @@ farm
// farmers : 2015-07-09 Farmers Insurance Exchange
farmers
-// fashion : 2014-07-03 Minds + Machines Group Limited
+// fashion : 2014-07-03 Registry Services, LLC
fashion
// fast : 2014-12-18 Amazon Registry Services, Inc.
@@ -8175,10 +8186,10 @@ firmdale
// fish : 2013-12-12 Binky Moon, LLC
fish
-// fishing : 2013-11-21 Minds + Machines Group Limited
+// fishing : 2013-11-21 Registry Services, LLC
fishing
-// fit : 2014-11-07 Minds + Machines Group Limited
+// fit : 2014-11-07 Registry Services, LLC
fit
// fitness : 2014-03-06 Binky Moon, LLC
@@ -8217,7 +8228,7 @@ football
// ford : 2014-11-13 Ford Motor Company
ford
-// forex : 2014-12-11 Dotforex Registry Limited
+// forex : 2014-12-11 Dog Beach, LLC
forex
// forsale : 2014-05-22 Dog Beach, LLC
@@ -8256,10 +8267,7 @@ ftr
// fujitsu : 2015-07-30 Fujitsu Limited
fujitsu
-// fujixerox : 2015-07-23 Xerox DNHC LLC
-fujixerox
-
-// fun : 2016-01-14 DotSpace Inc.
+// fun : 2016-01-14 Radix FZC
fun
// fund : 2014-03-20 Binky Moon, LLC
@@ -8295,7 +8303,7 @@ games
// gap : 2015-07-31 The Gap, Inc.
gap
-// garden : 2014-06-26 Minds + Machines Group Limited
+// garden : 2014-06-26 Registry Services, LLC
garden
// gay : 2019-05-23 Top Level Design, LLC
@@ -8511,13 +8519,13 @@ homesense
// honda : 2014-12-18 Honda Motor Co., Ltd.
honda
-// horse : 2013-11-21 Minds + Machines Group Limited
+// horse : 2013-11-21 Registry Services, LLC
horse
// hospital : 2016-10-20 Binky Moon, LLC
hospital
-// host : 2014-04-17 DotHost Inc.
+// host : 2014-04-17 Radix FZC
host
// hosting : 2014-05-29 UNR Corp.
@@ -8640,9 +8648,6 @@ itau
// itv : 2015-07-09 ITV Services Limited
itv
-// iveco : 2015-09-03 CNH Industrial N.V.
-iveco
-
// jaguar : 2014-11-13 Jaguar Land Rover Ltd
jaguar
@@ -8715,6 +8720,9 @@ kfh
// kia : 2015-07-09 KIA MOTORS CORPORATION
kia
+// kids : 2021-08-13 DotKids Foundation Limited
+kids
+
// kim : 2013-09-23 Afilias Limited
kim
@@ -8793,7 +8801,7 @@ latino
// latrobe : 2014-06-16 La Trobe University
latrobe
-// law : 2015-01-22 LW TLD Limited
+// law : 2015-01-22 Registry Services, LLC
law
// lawyer : 2014-03-20 Dog Beach, LLC
@@ -8922,10 +8930,7 @@ ltda
// lundbeck : 2015-08-06 H. Lundbeck A/S
lundbeck
-// lupin : 2014-11-07 LUPIN LIMITED
-lupin
-
-// luxe : 2014-01-09 Minds + Machines Group Limited
+// luxe : 2014-01-09 Registry Services, LLC
luxe
// luxury : 2013-10-17 Luxury Partners, LLC
@@ -8964,7 +8969,7 @@ market
// marketing : 2013-11-07 Binky Moon, LLC
marketing
-// markets : 2014-12-11 Dotmarkets Registry Limited
+// markets : 2014-12-11 Dog Beach, LLC
markets
// marriott : 2014-10-09 Marriott Worldwide Corporation
@@ -9093,6 +9098,9 @@ mtn
// mtr : 2015-03-12 MTR Corporation Limited
mtr
+// music : 2021-05-04 DotMusic Limited
+music
+
// mutual : 2015-04-02 Northwestern Mutual MU TLD Registry, LLC
mutual
@@ -9102,9 +9110,6 @@ nab
// nagoya : 2013-10-24 GMO Registry, Inc.
nagoya
-// nationwide : 2015-07-23 Nationwide Mutual Insurance Company
-nationwide
-
// natura : 2015-03-12 NATURA COSMÉTICOS S.A.
natura
@@ -9132,9 +9137,6 @@ neustar
// new : 2014-01-30 Charleston Road Registry Inc.
new
-// newholland : 2015-09-03 CNH Industrial N.V.
-newholland
-
// news : 2014-12-18 Dog Beach, LLC
news
@@ -9207,7 +9209,7 @@ nyc
// obi : 2014-09-25 OBI Group Holding SE & Co. KGaA
obi
-// observer : 2015-04-30 Top Level Spectrum, Inc.
+// observer : 2015-04-30 Dog Beach, LLC
observer
// off : 2015-07-23 Johnson Shareholdings, Inc.
@@ -9243,12 +9245,9 @@ ong
// onl : 2013-09-16 iRegistry GmbH
onl
-// online : 2015-01-15 DotOnline Inc.
+// online : 2015-01-15 Radix FZC
online
-// onyourside : 2015-07-23 Nationwide Mutual Insurance Company
-onyourside
-
// ooo : 2014-01-09 INFIBEAM AVENUES LIMITED
ooo
@@ -9402,7 +9401,7 @@ pramerica
// praxi : 2013-12-05 Praxi S.p.A.
praxi
-// press : 2014-04-03 DotPress Inc.
+// press : 2014-04-03 Radix FZC
press
// prime : 2015-06-25 Amazon Registry Services, Inc.
@@ -9474,7 +9473,7 @@ realestate
// realtor : 2014-05-29 Real Estate Domains LLC
realtor
-// realty : 2015-03-19 Fegistry, LLC
+// realty : 2015-03-19 Dog Beach, LLC
realty
// recipes : 2013-10-17 Binky Moon, LLC
@@ -9564,7 +9563,7 @@ rocher
// rocks : 2013-11-14 Dog Beach, LLC
rocks
-// rodeo : 2013-12-19 Minds + Machines Group Limited
+// rodeo : 2013-12-19 Registry Services, LLC
rodeo
// rogers : 2015-08-06 Rogers Communications Canada Inc.
@@ -9642,7 +9641,7 @@ saxo
// sbi : 2015-03-12 STATE BANK OF INDIA
sbi
-// sbs : 2014-11-07 SPECIAL BROADCASTING SERVICE CORPORATION
+// sbs : 2014-11-07 ShortDot SA
sbs
// sca : 2014-03-13 SVENSKA CELLULOSA AKTIEBOLAGET SCA (publ)
@@ -9765,7 +9764,7 @@ sina
// singles : 2013-08-27 Binky Moon, LLC
singles
-// site : 2015-01-15 DotSite Inc.
+// site : 2015-01-15 Radix FZC
site
// ski : 2015-04-09 Afilias Limited
@@ -9825,7 +9824,7 @@ soy
// spa : 2019-09-19 Asia Spa and Wellness Promotion Council Limited
spa
-// space : 2014-04-03 DotSpace Inc.
+// space : 2014-04-03 Radix FZC
space
// sport : 2017-11-16 Global Association of International Sports Federations
(GAISF)
@@ -9834,9 +9833,6 @@ sport
// spot : 2015-02-26 Amazon Registry Services, Inc.
spot
-// spreadbetting : 2014-12-11 Dotspreadbetting Registry Limited
-spreadbetting
-
// srl : 2015-05-07 InterNetX, Corp
srl
@@ -9867,7 +9863,7 @@ stockholm
// storage : 2014-12-22 XYZ.COM LLC
storage
-// store : 2015-04-09 DotStore Inc.
+// store : 2015-04-09 Radix FZC
store
// stream : 2016-01-08 dot Stream Limited
@@ -9894,7 +9890,7 @@ supply
// support : 2013-10-24 Binky Moon, LLC
support
-// surf : 2014-01-09 Minds + Machines Group Limited
+// surf : 2014-01-09 Registry Services, LLC
surf
// surgery : 2014-03-20 Binky Moon, LLC
@@ -9957,7 +9953,7 @@ tdk
// team : 2015-03-05 Binky Moon, LLC
team
-// tech : 2015-01-30 Personals TLD Inc.
+// tech : 2015-01-30 Radix FZC
tech
// technology : 2013-09-13 Binky Moon, LLC
@@ -9984,7 +9980,7 @@ theatre
// tiaa : 2015-07-23 Teachers Insurance and Annuity Association of America
tiaa
-// tickets : 2015-02-05 Accent Media Limited
+// tickets : 2015-02-05 XYZ.COM LLC
tickets
// tienda : 2013-11-14 Binky Moon, LLC
@@ -10050,7 +10046,7 @@ toys
// trade : 2014-01-23 Elite Registry Limited
trade
-// trading : 2014-12-11 Dottrading Registry Limited
+// trading : 2014-12-11 Dog Beach, LLC
trading
// training : 2013-11-07 Binky Moon, LLC
@@ -10101,7 +10097,7 @@ unicom
// university : 2014-03-06 Binky Moon, LLC
university
-// uno : 2013-09-11 DotSite Inc.
+// uno : 2013-09-11 Radix FZC
uno
// uol : 2014-05-01 UBN INTERNET LTDA.
@@ -10152,7 +10148,7 @@ villas
// vin : 2015-06-18 Binky Moon, LLC
vin
-// vip : 2015-01-22 Minds + Machines Group Limited
+// vip : 2015-01-22 Registry Services, LLC
vip
// virgin : 2014-09-25 Virgin Enterprises Limited
@@ -10173,7 +10169,7 @@ vivo
// vlaanderen : 2014-02-06 DNS.be vzw
vlaanderen
-// vodka : 2013-12-19 Minds + Machines Group Limited
+// vodka : 2013-12-19 Registry Services, LLC
vodka
// volkswagen : 2015-05-14 Volkswagen Group of America Inc.
@@ -10215,7 +10211,7 @@ wanggou
// watch : 2013-11-14 Binky Moon, LLC
watch
-// watches : 2014-12-22 Richemont DNS Inc.
+// watches : 2014-12-22 Afilias Limited
watches
// weather : 2015-01-08 International Business Machines Corporation
@@ -10230,10 +10226,10 @@ webcam
// weber : 2015-06-04 Saint-Gobain Weber SA
weber
-// website : 2014-04-03 DotWebsite Inc.
+// website : 2014-04-03 Radix FZC
website
-// wedding : 2014-04-24 Minds + Machines Group Limited
+// wedding : 2014-04-24 Registry Services, LLC
wedding
// weibo : 2015-03-05 Sina Corporation
@@ -10275,7 +10271,7 @@ wolterskluwer
// woodside : 2015-07-09 Woodside Petroleum Limited
woodside
-// work : 2013-12-19 Minds + Machines Group Limited
+// work : 2013-12-19 Registry Services, LLC
work
// works : 2013-11-14 Binky Moon, LLC
@@ -10593,7 +10589,7 @@ xyz
// yachts : 2014-01-09 XYZ.COM LLC
yachts
-// yahoo : 2015-04-02 Yahoo! Domain Services Inc.
+// yahoo : 2015-04-02 Oath Inc.
yahoo
// yamaxun : 2014-12-18 Amazon Registry Services, Inc.
@@ -10605,7 +10601,7 @@ yandex
// yodobashi : 2014-11-20 YODOBASHI CAMERA CO.,LTD.
yodobashi
-// yoga : 2014-05-29 Minds + Machines Group Limited
+// yoga : 2014-05-29 Registry Services, LLC
yoga
// yokohama : 2013-12-12 GMO Registry, Inc.
@@ -10652,11 +10648,22 @@ ltd.ua
// 611coin : https://611project.org/
611.to
+// Aaron Marais' Gitlab pages: https://lab.aaronleem.co.za
+// Submitted by Aaron Marais <its_me@aaronleem.co.za>
+graphox.us
+
+// accesso Technology Group, plc. : https://accesso.com/
+// Submitted by accesso Team <accessoecommerce@accesso.com>
+*.devcdnaccesso.com
+
// Adobe : https://www.adobe.com/
-// Submitted by Ian Boston <boston@adobe.com>
+// Submitted by Ian Boston <boston@adobe.com> and Lars Trieloff
<trieloff@adobe.com>
adobeaemcloud.com
-adobeaemcloud.net
*.dev.adobeaemcloud.com
+hlx.live
+adobeaemcloud.net
+hlx.page
+hlx3.page
// Agnat sp. z o.o. : https://domena.pl
// Submitted by Przemyslaw Plewa <it-admin@domena.pl>
@@ -10722,6 +10729,10 @@ us-west-2.elasticbeanstalk.com
*.elb.amazonaws.com
*.elb.amazonaws.com.cn
+// Amazon Global Accelerator : https://aws.amazon.com/global-accelerator/
+// Submitted by Daniel Massaguer <psl-maintainers@amazon.com>
+awsglobalaccelerator.com
+
// Amazon S3 : https://aws.amazon.com/s3/
// Submitted by Luke Wells <psl-maintainers@amazon.com>
s3.amazonaws.com
@@ -10792,6 +10803,15 @@ tele.amune.org
// Submitted by Apigee Security Team <security@apigee.com>
apigee.io
+// Appspace : https://www.appspace.com
+// Submitted by Appspace Security Team <security@appspace.com>
+appspacehosted.com
+appspaceusercontent.com
+
+// Appudo UG (haftungsbeschränkt) : https://www.appudo.com
+// Submitted by Alexander Hochbaum <admin@appudo.com>
+appudo.net
+
// Aptible : https://www.aptible.com/
// Submitted by Thomas Orozco <thomas@aptible.com>
on-aptible.com
@@ -10817,15 +10837,27 @@ sweetpepper.org
// Submitted by Vincent Tseng <vincenttseng@asustor.com>
myasustor.com
+// Atlassian : https://atlassian.com
+// Submitted by Sam Smyth <devloop@atlassian.com>
+cdn.prod.atlassian-dev.net
+
// AVM : https://avm.de
// Submitted by Andreas Weise <a.weise@avm.de>
myfritz.net
+// AVStack Pte. Ltd. : https://avstack.io
+// Submitted by Jasper Hugo <jasper@avstack.io>
+onavstack.net
+
// AW AdvisorWebsites.com Software Inc : https://advisorwebsites.com
// Submitted by James Kennedy <domains@advisorwebsites.com>
*.awdev.ca
*.advisor.ws
+// AZ.pl sp. z.o.o: https://az.pl
+// Submited by Krzysztof Wolski <krzysztof.wolski@home.eu>
+ecommerce-shop.pl
+
// b-data GmbH : https://www.b-data.io
// Submitted by Olivier Benz <olivier.benz@b-data.ch>
b-data.io
@@ -10838,6 +10870,11 @@ backplaneapp.io
// Submitted by Petros Angelatos <petrosagg@balena.io>
balena-devices.com
+// University of Banja Luka : https://unibl.org
+// Domains for Republic of Srpska administrative entity.
+// Submitted by Marko Ivanovic <kormang@hotmail.rs>
+rs.ba
+
// Banzai Cloud
// Submitted by Janos Matyas <info@banzaicloud.com>
*.banzai.cloud
@@ -10853,6 +10890,10 @@ betainabox.com
// Submitted by Nathan O'Sullivan <nathan@mammoth.com.au>
bnr.la
+// Bitbucket : http://bitbucket.org
+// Submitted by Andy Ortlieb <aortlieb@atlassian.com>
+bitbucket.io
+
// Blackbaud, Inc. : https://www.blackbaud.com
// Submitted by Paul Crowder <paul.crowder@blackbaud.com>
blackbaudcdn.net
@@ -10861,10 +10902,18 @@ blackbaudcdn.net
// Submitted by Luke Bratch <luke@bratch.co.uk>
of.je
+// Blue Bite, LLC : https://bluebite.com
+// Submitted by Joshua Weiss <admin.engineering@bluebite.com>
+bluebite.io
+
// Boomla : https://boomla.com
// Submitted by Tibor Halter <thalter@boomla.com>
boomla.net
+// Boutir : https://www.boutir.com
+// Submitted by Eric Ng Ka Ka <ngkaka@boutir.com>
+boutir.com
+
// Boxfuse : https://boxfuse.com
// Submitted by Axel Fontaine <axel@boxfuse.com>
boxfuse.io
@@ -10878,6 +10927,10 @@ square7.de
bplaced.net
square7.net
+// Brendly : https://brendly.rs
+// Submitted by Dusan Radovanovic <dusan.radovanovic@brendly.rs>
+shop.brendly.rs
+
// BrowserSafetyMark
// Submitted by Dave Tharp <browsersafetymark.io@quicinc.com>
browsersafetymark.io
@@ -10888,15 +10941,21 @@ uk0.bigv.io
dh.bytemark.co.uk
vm.bytemark.co.uk
+// Caf.js Labs LLC : https://www.cafjs.com
+// Submitted by Antonio Lain <antlai@cafjs.com>
+cafjs.com
+
// callidomus : https://www.callidomus.com/
// Submitted by Marcus Popp <admin@callidomus.com>
mycd.eu
// Carrd : https://carrd.co
// Submitted by AJ <aj@carrd.co>
+drr.ac
+uwu.ai
carrd.co
crd.co
-uwu.ai
+ju.mp
// CentralNic : http://www.centralnic.com/names/domains
// Submitted by registry <gavin.brown@centralnic.com>
@@ -10962,11 +11021,6 @@ nz.basketball
radio.am
radio.fm
-// Globe Hosting SRL : https://www.globehosting.com/
-// Submitted by Gavin Brown <gavin.brown@centralnic.com>
-co.ro
-shop.ro
-
// c.la : http://www.c.la/
c.la
@@ -10974,6 +11028,10 @@ c.la
// Submitted by B. Blechschmidt <hostmaster@certmgr.org>
certmgr.org
+// Cityhost LLC : https://cityhost.ua
+// Submitted by Maksym Rivtin <support@cityhost.net.ua>
+cx.ua
+
// Civilized Discourse Construction Kit, Inc. : https://www.discourse.org/
// Submitted by Rishabh Nambiar & Michael Brown <team@discourse.org>
discourse.group
@@ -10988,14 +11046,22 @@ virtueeldomein.nl
cleverapps.io
// Clerk : https://www.clerk.dev
-// Submitted by Colin Sidoti <colin@clerk.dev>
+// Submitted by Colin Sidoti <systems@clerk.dev>
+clerk.app
+clerkstage.app
*.lcl.dev
+*.lclstage.dev
*.stg.dev
+*.stgstage.dev
// Clic2000 : https://clic2000.fr
// Submitted by Mathilde Blanchemanche <mathilde@clic2000.fr>
clic2000.net
+// ClickRising : https://clickrising.com/
+// Submitted by Umut Gumeli <infrastructure-publicsuffixlist@clickrising.com>
+clickrising.net
+
// Cloud66 : https://www.cloud66.com/
// Submitted by Khash Sajadi <khash@cloud66.com>
c66.me
@@ -11016,8 +11082,8 @@ cloudcontrolled.com
cloudcontrolapp.com
// Cloudera, Inc. : https://www.cloudera.com/
-// Submitted by Philip Langdale <security@cloudera.com>
-cloudera.site
+// Submitted by Kedarnath Waikar <security@cloudera.com>
+*.cloudera.site
// Cloudflare, Inc. : https://www.cloudflare.com/
// Submitted by Cloudflare Team <publicsuffixlist@cloudflare.com>
@@ -11166,18 +11232,37 @@ dyndns.dappnode.io
// Submitted by Paul Biggar <ops@darklang.com>
builtwithdark.com
+// DataDetect, LLC. : https://datadetect.com
+// Submitted by Andrew Banchich <abanchich@sceven.com>
+demo.datadetect.com
+instance.datadetect.com
+
// Datawire, Inc : https://www.datawire.io
// Submitted by Richard Li <secalert@datawire.io>
edgestack.me
+// DDNS5 : https://ddns5.com
+// Submitted by Cameron Elliott <cameron@cameronelliott.com>
+ddns5.com
+
// Debian : https://www.debian.org/
// Submitted by Peter Palfrader / Debian Sysadmin Team
<dsa-publicsuffixlist@debian.org>
debian.net
+// Deno Land Inc : https://deno.com/
+// Submitted by Luca Casonato <hostmaster@deno.com>
+deno.dev
+deno-staging.dev
+
// deSEC : https://desec.io/
// Submitted by Peter Thomassen <peter@desec.io>
dedyn.io
+// Diher Solutions : https://diher.solutions
+// Submitted by Didi Hermawan <mail@diher.solutions>
+*.rss.my.id
+*.diher.solutions
+
// DNS Africa Ltd https://dns.business
// Submitted by Calvin Browne <calvin@dns.business>
jozi.biz
@@ -11195,6 +11280,10 @@ shop.th
// Submitted by Paul Fang <mis@draytek.com>
drayddns.com
+// DreamCommerce : https://shoper.pl/
+// Submitted by Konrad Kotarba <konrad.kotarba@dreamcommerce.com>
+shoparena.pl
+
// DreamHost : http://www.dreamhost.com/
// Submitted by Andrew Farmer <andrew.farmer@dreamhost.com>
dreamhosters.com
@@ -11554,10 +11643,26 @@ blogsite.xyz
// Submitted by Dominik Menke <dom@digineo.de>
dynv6.net
+// Ellucian : https://ellucian.com
+// Submitted by Josue Colon <CloudOps-Network@ellucian.com>
+elluciancrmadvance.com
+elluciancrmadvise.com
+elluciancrmrecruit.com
+
// E4YOU spol. s.r.o. : https://e4you.cz/
// Submitted by Vladimir Dudr <info@e4you.cz>
e4.cz
+// eero : https://eero.com/
+// Submitted by Yue Kang <eero-dynamic-dns@amazon.com>
+eero.online
+eero-stage.online
+
+// Elementor : Elementor Ltd.
+// Submitted by Anton Barkan <antonb@elementor.com>
+elementor.cloud
+elementor.cool
+
// En root‽ : https://en-root.org
// Submitted by Emmanuel Raviart <emmanuel@raviart.com>
en-root.fr
@@ -11565,6 +11670,7 @@ en-root.fr
// Enalean SAS: https://www.enalean.com
// Submitted by Thomas Cottier <thomas.cottier@enalean.com>
mytuleap.com
+tuleap-partners.com
// ECG Robotics, Inc: https://ecgrobotics.org
// Submitted by <frc1533@ecgrobotics.org>
@@ -11575,11 +11681,6 @@ staging.onred.one
// Submitted by Jacob Bunk Nielsen <jbn@one.com>
service.one
-// Enonic : http://enonic.com/
-// Submitted by Erik Kaareng-Sunde <esu@enonic.com>
-enonic.io
-customer.enonic.io
-
// EU.org https://eu.org/
// Submitted by Pierre Beyssac <hostmaster@eu.org>
eu.org
@@ -11639,6 +11740,10 @@ tr.eu.org
uk.eu.org
us.eu.org
+// Eurobyte : https://eurobyte.ru
+// Submitted by Evgeniy Subbotin <e.subbotin@eurobyte.ru>
+eurodir.ru
+
// Evennode : http://www.evennode.com/
// Submitted by Michal Kralik <support@evennode.com>
eu-1.evennode.com
@@ -11749,6 +11854,7 @@ u.channelsdvr.net
// Fastly Inc. : http://www.fastly.com/
// Submitted by Fastly Security <security@fastly.com>
+edgecompute.app
fastly-terrarium.com
fastlylb.net
map.fastlylb.net
@@ -11768,10 +11874,6 @@ myfast.host
fastvps.site
myfast.space
-// Featherhead : https://featherhead.xyz/
-// Submitted by Simon Menke <simon@featherhead.xyz>
-fhapp.xyz
-
// Fedora : https://fedoraproject.org/
// submitted by Patrick Uiterwijk <puiterwijk@fedoraproject.org>
fedorainfracloud.org
@@ -11782,10 +11884,11 @@ app.os.stg.fedoraproject.org
// FearWorks Media Ltd. : https://fearworksmedia.co.uk
// submitted by Keith Fairley <domains@fearworksmedia.co.uk>
-conn.uk
-copro.uk
couk.me
ukco.me
+conn.uk
+copro.uk
+hosp.uk
// Fermax : https://fermax.com/
// submitted by Koen Van Isterdael <k.vanisterdael@fermax.be>
@@ -11809,6 +11912,14 @@ filegear-sg.me
// Submitted by Chris Raynor <chris@firebase.com>
firebaseapp.com
+// Firewebkit : https://www.firewebkit.com
+// Submitted by Majid Qureshi <mqureshi@amrayn.com>
+fireweb.app
+
+// FLAP : https://www.flap.cloud
+// Submitted by Louis Chemineau <louis@chmn.me>
+flap.id
+
// fly.io: https://fly.io
// Submitted by Kurt Mackey <kurt@fly.io>
fly.dev
@@ -11819,6 +11930,24 @@ shw.io
// Submitted by Jonathan Rudenberg <jonathan@flynn.io>
flynnhosting.net
+// Forgerock : https://www.forgerock.com
+// Submitted by Roderick Parr <roderick.parr@forgerock.com>
+forgeblocks.com
+id.forgerock.io
+
+// Framer : https://www.framer.com
+// Submitted by Koen Rouwhorst <koenrh@framer.com>
+framer.app
+framercanvas.com
+
+// Frusky MEDIA&PR : https://www.frusky.de
+// Submitted by Victor Pupynin <hallo@frusky.de>
+*.frusky.de
+
+// RavPage : https://www.ravpage.co.il
+// Submitted by Roni Horowitz <roni@responder.co.il>
+ravpage.co.il
+
// Frederik Braun https://frederik-braun.com
// Submitted by Frederik Braun <fb@frederik-braun.com>
0e.vc
@@ -11836,6 +11965,10 @@ freeboxos.fr
// Submitted by Daniel Stone <daniel@fooishbar.org>
freedesktop.org
+// freemyip.com : https://freemyip.com
+// Submitted by Cadence <contact@freemyip.com>
+freemyip.com
+
// FunkFeuer - Verein zur Förderung freier Netze : https://www.funkfeuer.at
// Submitted by Daniel A. Maierhofer <vorstand@funkfeuer.at>
wien.funkfeuer.at
@@ -11867,10 +12000,19 @@ gentlentapis.com
lab.ms
cdn-edges.net
+// Ghost Foundation : https://ghost.org
+// Submitted by Matt Hanley <security@ghost.org>
+ghost.io
+
+// GignoSystemJapan: http://gsj.bz
+// Submitted by GignoSystemJapan <kakutou-ec@gsj.bz>
+gsj.bz
+
// GitHub, Inc.
// Submitted by Patrick Toomey <security@github.com>
-github.io
githubusercontent.com
+githubpreview.dev
+github.io
// GitLab, Inc.
// Submitted by Alex Hanselka <alex@gitlab.com>
@@ -11885,12 +12027,21 @@ gitpage.si
// Submitted by Mads Hartmann <mads@glitch.com>
glitch.me
+// Global NOG Alliance : https://nogalliance.org/
+// Submitted by Sander Steffann <sander@nogalliance.org>
+nog.community
+
+// Globe Hosting SRL : https://www.globehosting.com/
+// Submitted by Gavin Brown <gavin.brown@centralnic.com>
+co.ro
+shop.ro
+
// GMO Pepabo, Inc. : https://pepabo.com/
// Submitted by dojineko <admin@pepabo.com>
lolipop.io
// GOV.UK Platform as a Service : https://www.cloud.service.gov.uk/
-// Submitted by Tom Whitwell <tom.whitwell@digital.cabinet-office.gov.uk>
+// Submitted by Tom Whitwell
<gov-uk-paas-support@digital.cabinet-office.gov.uk>
cloudapps.digital
london.cloudapps.digital
@@ -11929,7 +12080,6 @@ withyoutube.com
cloud.goog
translate.goog
cloudfunctions.net
-
blogspot.ae
blogspot.al
blogspot.am
@@ -12005,14 +12155,19 @@ blogspot.tw
blogspot.ug
blogspot.vn
-// Aaron Marais' Gitlab pages: https://lab.aaronleem.co.za
-// Submitted by Aaron Marais <its_me@aaronleem.co.za>
-graphox.us
+// Goupile : https://goupile.fr
+// Submitted by Niels Martignene <hello@goupile.fr>
+goupile.fr
// Group 53, LLC : https://www.group53.com
// Submitted by Tyler Todd <noc@nova53.net>
awsmppl.com
+// GünstigBestellen : https://günstigbestellen.de
+// Submitted by Furkan Akkoc <info@hendelzon.de>
+günstigbestellen.de
+günstigliefern.de
+
// Hakaran group: http://hakaran.cz
// Submited by Arseniy Sokolov <security@hakaran.cz>
fin.ci
@@ -12034,6 +12189,10 @@ hashbang.sh
hasura.app
hasura-app.io
+// Heilbronn University of Applied Sciences - Faculty Informatics (GitLab
Pages): https://www.hs-heilbronn.de
+// Submitted by Richard Zowalla <mi-admin@hs-heilbronn.de>
+pages.it.hs-heilbronn.de
+
// Hepforge : https://www.hepforge.org
// Submitted by David Grellscheid <admin@hepforge.org>
hepforge.org
@@ -12051,24 +12210,26 @@ ravendb.me
development.run
ravendb.run
+// home.pl S.A.: https://home.pl
+// Submited by Krzysztof Wolski <krzysztof.wolski@home.eu>
+homesklep.pl
+
// Hong Kong Productivity Council: https://www.hkpc.org/
// Submitted by SECaaS Team <summchan@hkpc.org>
secaas.hk
// HOSTBIP REGISTRY : https://www.hostbip.com/
// Submitted by Atanunu Igbunuroghene <publicsuffixlist@hostbip.com>
-bpl.biz
orx.biz
-ng.city
biz.gl
-ng.ink
col.ng
firm.ng
gen.ng
ltd.ng
ngo.ng
-ng.school
+edu.scot
sch.so
+org.yt
// HostyHosting (hostyhosting.com)
hostyhosting.io
@@ -12086,6 +12247,19 @@ moonscale.net
// Submitted by Hannu Aronsson <haa@iki.fi>
iki.fi
+// Impertrix Solutions : <https://impertrixcdn.com>
+// Submitted by Zhixiang Zhao <csuite@impertrix.com>
+impertrixcdn.com
+impertrix.com
+
+// Incsub, LLC: https://incsub.com/
+// Submitted by Aaron Edwards <sysadmins@incsub.com>
+smushcdn.com
+wphostedmail.com
+wpmucdn.com
+tempurl.host
+wpmudev.host
+
// Individual Network Berlin e.V. : https://www.in-berlin.de/
// Submitted by Christian Seitz <chris@in-berlin.de>
dyn-berlin.de
@@ -12178,7 +12352,8 @@ vip.jelastic.cloud
jele.cloud
it1.eur.aruba.jenv-aruba.cloud
it1.jenv-aruba.cloud
-it1-eur.jenv-arubabiz.cloud
+keliweb.cloud
+cs.keliweb.cloud
oxa.cloud
tn.oxa.cloud
uk.oxa.cloud
@@ -12190,13 +12365,9 @@ us.reclaim.cloud
ch.trendhosting.cloud
de.trendhosting.cloud
jele.club
+amscompute.com
clicketcloud.com
-ams.cloudswitches.com
-au.cloudswitches.com
-sg.cloudswitches.com
dopaas.com
-elastyco.com
-nv.elastyco.com
hidora.com
paas.hosted-by-previder.com
rag-cloud.hosteur.com
@@ -12211,29 +12382,26 @@ lon.wafaicloud.com
ryd.wafaicloud.com
j.scaleforce.com.cy
jelastic.dogado.eu
-paas.leviracloud.eu
fi.cloudplatform.fi
demo.datacenter.fi
paas.datacenter.fi
jele.host
mircloud.host
+paas.beebyte.io
+sekd1.beebyteapp.io
jele.io
-ocs.opusinteractive.io
-cloud.unispace.io
-cloud-de.unispace.io
cloud-fr1.unispace.io
jc.neen.it
cloud.jelastic.open.tim.it
jcloud.kz
upaas.kazteleport.kz
-jl.serv.net.mx
cloudjiffy.net
fra1-de.cloudjiffy.net
west1-us.cloudjiffy.net
-ams1.jls.docktera.net
jls-sto1.elastx.net
jls-sto2.elastx.net
jls-sto3.elastx.net
+faststacks.net
fr-1.paas.massivegrid.net
lon-1.paas.massivegrid.net
lon-2.paas.massivegrid.net
@@ -12244,8 +12412,7 @@ jelastic.saveincloud.net
nordeste-idc.saveincloud.net
j.scaleforce.net
jelastic.tsukaeru.net
-atl.jelastic.vps-host.net
-njs.jelastic.vps-host.net
+sdscloud.pl
unicloud.pl
mircloud.ru
jelastic.regruhosting.ru
@@ -12265,6 +12432,10 @@ myjino.ru
*.spectrum.myjino.ru
*.vps.myjino.ru
+// Jotelulu S.L. : https://jotelulu.com
+// Submitted by Daniel Fariña <ingenieria@jotelulu.com>
+jotelulu.cloud
+
// Joyent : https://www.joyent.com/
// Submitted by Brian Bennett <brian.bennett@joyent.com>
*.triton.zone
@@ -12296,10 +12467,20 @@ knightpoint.systems
// Submitted by DisposaBoy <security@oya.to>
oya.to
+// Katholieke Universiteit Leuven: https://www.kuleuven.be
+// Submitted by Abuse KU Leuven <abuse@kuleuven.be>
+kuleuven.cloud
+ezproxy.kuleuven.be
+
// .KRD : http://nic.krd/data/krd/Registration%20Policy.pdf
co.krd
edu.krd
+// Krellian Ltd. : https://krellian.com
+// Submitted by Ben Francis <ben@krellian.com>
+krellian.net
+webthings.io
+
// LCube - Professional hosting e.K. : https://www.lcube-webhosting.de
// Submitted by Lars Laehn <info@lcube.de>
git-repos.de
@@ -12357,6 +12538,14 @@ loginline.io
loginline.services
loginline.site
+// Lokalized : https://lokalized.nl
+// Submitted by Noah Taheij <noah@lokalized.nl>
+servers.run
+
+// Lõhmus Family, The
+// Submitted by Heiki Lõhmus <hostmaster at lohmus dot me>
+lohmus.me
+
// LubMAN UMCS Sp. z o.o : https://lubman.pl/
// Submitted by Ireneusz Maliszewski <ireneusz.maliszewski@lubman.pl>
krasnik.pl
@@ -12393,6 +12582,7 @@ barsy.online
barsy.org
barsy.pro
barsy.pub
+barsy.ro
barsy.shop
barsy.site
barsy.support
@@ -12411,15 +12601,34 @@ mayfirst.org
// Submitted by Ilya Zaretskiy <zaretskiy@corp.mail.ru>
hb.cldmail.ru
+// Mail Transfer Platform : https://www.neupeer.com
+// Submitted by Li Hui <lihui@neupeer.com>
+cn.vu
+
+// Maze Play: https://www.mazeplay.com
+// Submitted by Adam Humpherys <adam@mws.dev>
+mazeplay.com
+
// mcpe.me : https://mcpe.me
// Submitted by Noa Heyl <hi@noa.dev>
mcpe.me
// McHost : https://mchost.ru
// Submitted by Evgeniy Subbotin <e.subbotin@mchost.ru>
+mcdir.me
mcdir.ru
+mcpre.ru
vps.mcdir.ru
+// Mediatech : https://mediatech.by
+// Submitted by Evgeniy Kozhuhovskiy <ugenk@mediatech.by>
+mediatech.by
+mediatech.dev
+
+// Medicom Health : https://medicomhealth.com
+// Submitted by Michael Olson <molson@medicomhealth.com>
+hra.health
+
// Memset hosting : https://www.memset.com
// Submitted by Tom Whitwell <domains@memset.com>
miniserver.com
@@ -12460,6 +12669,10 @@ westus2.azurestaticapps.net
// Submitted by Robert Böttinger <r@minion.systems>
csx.cc
+// Mintere : https://mintere.com/
+// Submitted by Ben Aubin <security@mintere.com>
+mintere.site
+
// MobileEducation, LLC : https://joinforte.com
// Submitted by Grayson Martin <grayson.martin@mobileeducation.us>
forte.id
@@ -12482,8 +12695,11 @@ pp.ru
// Submitted by Paul Cammish <kelduum@mythic-beasts.com>
hostedpi.com
customer.mythic-beasts.com
+caracal.mythic-beasts.com
+fentiger.mythic-beasts.com
lynx.mythic-beasts.com
ocelot.mythic-beasts.com
+oncilla.mythic-beasts.com
onza.mythic-beasts.com
sphinx.mythic-beasts.com
vs.mythic-beasts.com
@@ -12538,6 +12754,20 @@ nh-serv.co.uk
// Submitted by Jeff Wheelhouse <support@nearlyfreespeech.net>
nfshost.com
+// Noop : https://noop.app
+// Submitted by Nathaniel Schweinberg <noop@rearc.io>
+*.developer.app
+noop.app
+
+// Northflank Ltd. : https://northflank.com/
+// Submitted by Marco Suter <marco@northflank.com>
+*.northflank.app
+*.code.run
+
+// Noticeable : https://noticeable.io
+// Submitted by Laurent Pellegrino <security@noticeable.io>
+noticeable.news
+
// Now-DNS : https://now-dns.com
// Submitted by Steve Russell <steve@now-dns.com>
dnsking.ch
@@ -12676,60 +12906,6 @@ pcloud.host
// Submitted by Matthew Brown <mattbrown@nyc.mn>
nyc.mn
-// NymNom : https://nymnom.com/
-// Submitted by NymNom <psl@nymnom.com>
-nom.ae
-nom.af
-nom.ai
-nom.al
-nym.by
-nom.bz
-nym.bz
-nom.cl
-nym.ec
-nom.gd
-nom.ge
-nom.gl
-nym.gr
-nom.gt
-nym.gy
-nym.hk
-nom.hn
-nym.ie
-nom.im
-nom.ke
-nym.kz
-nym.la
-nym.lc
-nom.li
-nym.li
-nym.lt
-nym.lu
-nom.lv
-nym.me
-nom.mk
-nym.mn
-nym.mx
-nom.nu
-nym.nz
-nym.pe
-nym.pt
-nom.pw
-nom.qa
-nym.ro
-nom.rs
-nom.si
-nym.sk
-nom.st
-nym.su
-nym.sx
-nom.tj
-nym.tw
-nom.ug
-nom.uy
-nom.vc
-nom.vg
-
// Observable, Inc. : https://observablehq.com
// Submitted by Mike Bostock <dns@observablehq.com>
static.observableusercontent.com
@@ -12762,18 +12938,29 @@ opensocial.site
// Submitted by Sven Marnach <sven@opencraft.com>
opencraft.hosting
+// OpenResearch GmbH: https://openresearch.com/
+// Submitted by Philipp Schmid <ops@openresearch.com>
+orsites.com
+
// Opera Software, A.S.A.
// Submitted by Yngve Pettersen <yngve@opera.com>
operaunite.com
-// Oursky Limited : https://skygear.io/
-// Submited by Skygear Developer <hello@skygear.io>
+// Oursky Limited : https://authgear.com/, https://skygear.io/
+// Submited by Authgear Team <hello@authgear.com>, Skygear Developer
<hello@skygear.io>
+authgear-staging.com
+authgearapps.com
skygearapp.com
// OutSystems
// Submitted by Duarte Santos <domain-admin@outsystemscloud.com>
outsystemscloud.com
+// OVHcloud: https://ovhcloud.com
+// Submitted by Vincent Cassé <vincent.casse@ovhcloud.com>
+*.webpaas.ovh.net
+*.hosting.ovh.net
+
// OwnProvider GmbH: http://www.ownprovider.com
// Submitted by Jan Moennich <jan.moennich@ownprovider.com>
ownprovider.com
@@ -12803,6 +12990,10 @@ pagefrontapp.com
// Submitted by Yann Guichard <yann@pagexl.com>
pagexl.com
+// Paywhirl, Inc : https://paywhirl.com/
+// Submitted by Daniel Netzer <dan@paywhirl.com>
+*.paywhirl.com
+
// pcarrier.ca Software Inc: https://pcarrier.ca/
// Submitted by Pierre Carrier <pc@rrier.ca>
bar0.net
@@ -12834,8 +13025,6 @@ perspecta.cloud
// PE Ulyanov Kirill Sergeevich : https://airy.host
// Submitted by Kirill Ulyanov <k.ulyanov@airy.host>
lk3.ru
-ra-ru.ru
-zsew.ru
// Planet-Work : https://www.planet-work.com/
// Submitted by Frédéric VANNIÈRE <f.vanniere@planet-work.com>
@@ -12848,6 +13037,7 @@ ent.platform.sh
eu.platform.sh
us.platform.sh
*.platformsh.site
+*.tst.site
// Platter: https://platter.dev
// Submitted by Patrick Flor <patrick@platter.dev>
@@ -12869,6 +13059,13 @@ dyn53.io
// Submitted by Zulfais <pc@co.bn>
co.bn
+// Postman, Inc : https://postman.com
+// Submitted by Rahul Dhawan <security@postman.com>
+postman-echo.com
+pstmn.io
+mock.pstmn.io
+httpbin.org
+
// prgmr.com : https://prgmr.com/
// Submitted by Sarah Newman <owner@prgmr.com>
xen.prgmr.com
@@ -12898,6 +13095,11 @@ byen.site
// Submitted by Kor Nielsen <kor@pubtls.org>
pubtls.org
+// PythonAnywhere LLP: https://www.pythonanywhere.com
+// Submitted by Giles Thomas <giles@pythonanywhere.com>
+pythonanywhere.com
+eu.pythonanywhere.com
+
// QOTO, Org.
// Submitted by Jeffrey Phillips Freeman <jeffrey.freeman@qoto.org>
qoto.io
@@ -12910,6 +13112,10 @@ qualifioapp.com
// Submitted by Dani Biro <dani@pymet.com>
qbuser.com
+// Rad Web Hosting: https://radwebhosting.com
+// Submitted by Scott Claeys <s.claeys@radwebhosting.com>
+cloudsite.builders
+
// Redstar Consultants : https://www.redstarconsultants.com/
// Submitted by Jons Slemmer <jons@redstarconsultants.com>
instantcloud.cn
@@ -12973,6 +13179,7 @@ onrender.com
// Repl.it : https://repl.it
// Submitted by Mason Clayton <mason@repl.it>
repl.co
+id.repl.co
repl.run
// Resin.io : https://resin.io
@@ -12989,10 +13196,31 @@ hzc.io
wellbeingzone.eu
wellbeingzone.co.uk
+// Rico Developments Limited : https://adimo.co
+// Submitted by Colin Brown <hello@adimo.co>
+adimo.co.uk
+
+// Riseup Networks : https://riseup.net
+// Submitted by Micah Anderson <micah@riseup.net>
+itcouldbewor.se
+
// Rochester Institute of Technology : http://www.rit.edu/
// Submitted by Jennifer Herting <jchits@rit.edu>
git-pages.rit.edu
+// Rusnames Limited: http://rusnames.ru/
+// Submitted by Sergey Zotov <admin@rusnames.ru>
+биз.рус
+ком.рус
+крым.рус
+мир.рус
+мск.рус
+орг.рус
+самара.рус
+сочи.рус
+спб.рус
+я.рус
+
// Sandstorm Development Group, Inc. : https://sandcats.io/
// Submitted by Asheesh Laroia <asheesh@sandstorm.io>
sandcats.io
@@ -13009,6 +13237,7 @@ schokokeks.net
// Scottish Government: https://www.gov.scot
// Submitted by Martin Ellis <martin.ellis@gov.scot>
gov.scot
+service.gov.scot
// Scry Security : http://www.scrysec.com
// Submitted by Shante Adam <shante@skyhat.io>
@@ -13031,16 +13260,33 @@ spdns.org
// Submitted by Artem Kondratev <accounts@seidat.com>
seidat.net
+// Sellfy : https://sellfy.com
+// Submitted by Yuriy Romadin <contact@sellfy.com>
+sellfy.store
+
// Senseering GmbH : https://www.senseering.de
// Submitted by Felix Mönckemeyer <f.moenckemeyer@senseering.de>
senseering.net
+// Sendmsg: https://www.sendmsg.co.il
+// Submitted by Assaf Stern <domains@comstar.co.il>
+minisite.ms
+
+// Service Magnet : https://myservicemagnet.com
+// Submitted by Dave Sanders <dave@myservicemagnet.com>
+magnet.page
+
// Service Online LLC : http://drs.ua/
// Submitted by Serhii Bulakh <support@drs.ua>
biz.ua
co.ua
pp.ua
+// Shift Crypto AG : https://shiftcrypto.ch
+// Submitted by alex <alex@shiftcrypto.ch>
+shiftcrypto.dev
+shiftcrypto.io
+
// ShiftEdit : https://shiftedit.net/
// Submitted by Adam Jimenez <adam@shiftcreate.com>
shiftedit.io
@@ -13049,6 +13295,10 @@ shiftedit.io
// Submitted by Alex Bowers <alex@shopblocks.com>
myshopblocks.com
+// Shopify : https://www.shopify.com
+// Submitted by Alex Richter <alex.richter@shopify.com>
+myshopify.com
+
// Shopit : https://www.shopitcommerce.com/
// Submitted by Craig McMahon <craig@shopitcommerce.com>
shopitsite.com
@@ -13083,16 +13333,43 @@ beta.bounty-full.com
// Submitted by Aral Balkan <aral@small-tech.org>
small-web.org
+// Smoove.io : https://www.smoove.io/
+// Submitted by Dan Kozak <dan@smoove.io>
+vp4.me
+
+// Snowplow Analytics : https://snowplowanalytics.com/
+// Submitted by Ian Streeter <ian@snowplowanalytics.com>
+try-snowplow.com
+
+// SourceHut : https://sourcehut.org
+// Submitted by Drew DeVault <sir@cmpwn.com>
+srht.site
+
// Stackhero : https://www.stackhero.io
// Submitted by Adrien Gillon <adrien+public-suffix-list@stackhero.io>
stackhero-network.com
+// Staclar : https://staclar.com
+// Submitted by Matthias Merkel <matthias.merkel@staclar.com>
+novecore.site
+
// staticland : https://static.land
// Submitted by Seth Vincent <sethvincent@gmail.com>
static.land
dev.static.land
sites.static.land
+// Storebase : https://www.storebase.io
+// Submitted by Tony Schirmer <tony@storebase.io>
+storebase.store
+
+// Strategic System Consulting (eApps Hosting): https://www.eapps.com/
+// Submitted by Alex Oancea <aoancea@cloudscale365.com>
+vps-host.net
+atl.jelastic.vps-host.net
+njs.jelastic.vps-host.net
+ric.jelastic.vps-host.net
+
// Sony Interactive Entertainment LLC : https://sie.com/
// Submitted by David Coles <david.coles@sony.com>
playstation-cloud.com
@@ -13110,6 +13387,28 @@ spacekit.io
// Submitted by Stefan Neufeind <info@speedpartner.de>
customer.speedpartner.de
+// Spreadshop (sprd.net AG) : https://www.spreadshop.com/
+// Submitted by Martin Breest <security@spreadshop.com>
+myspreadshop.at
+myspreadshop.com.au
+myspreadshop.be
+myspreadshop.ca
+myspreadshop.ch
+myspreadshop.com
+myspreadshop.de
+myspreadshop.dk
+myspreadshop.es
+myspreadshop.fi
+myspreadshop.fr
+myspreadshop.ie
+myspreadshop.it
+myspreadshop.net
+myspreadshop.nl
+myspreadshop.no
+myspreadshop.pl
+myspreadshop.se
+myspreadshop.co.uk
+
// Standard Library : https://stdlib.com
// Submitted by Jacob Lee <jacob@stdlib.com>
api.stdlib.com
@@ -13131,10 +13430,12 @@ user.srcf.net
// Submitted by Dan Miller <dm@sub6.com>
temp-dns.com
-// Swisscom Application Cloud: https://developer.swisscom.com
-// Submitted by Matthias.Winzeler <matthias.winzeler@swisscom.com>
-applicationcloud.io
-scapp.io
+// Supabase : https://supabase.io
+// Submitted by Inian Parameshwaran <security@supabase.io>
+supabase.co
+supabase.in
+supabase.net
+su.paba.se
// Symfony, SAS : https://symfony.com/
// Submitted by Fabien Potencier <fabien@symfony.com>
@@ -13163,6 +13464,10 @@ synology.me
vpnplus.to
direct.quickconnect.to
+// Tabit Technologies Ltd. : https://tabit.cloud/
+// Submitted by Oren Agiv <oren@tabit.cloud>
+tabitorder.co.il
+
// TAIFUN Software AG : http://taifun-software.de
// Submitted by Bjoern Henke <dev-server@taifun-software.de>
taifun-dns.de
@@ -13190,13 +13495,17 @@ gwiddle.co.uk
// Thingdust AG : https://thingdust.com/
// Submitted by Adrian Imboden <adi@thingdust.com>
+*.firenet.ch
+*.svc.firenet.ch
+reservd.com
thingdustdata.com
cust.dev.thingdust.io
cust.disrec.thingdust.io
cust.prod.thingdust.io
cust.testing.thingdust.io
-*.firenet.ch
-*.svc.firenet.ch
+reservd.dev.thingdust.io
+reservd.disrec.thingdust.io
+reservd.testing.thingdust.io
// Tlon.io : https://tlon.io
// Submitted by Mark Staarink <mark@tlon.io>
@@ -13204,11 +13513,20 @@ arvo.network
azimuth.network
tlon.network
+// Tor Project, Inc. : https://torproject.org
+// Submitted by Antoine Beaupré <anarcat@torproject.org
+torproject.net
+pages.torproject.net
+
// TownNews.com : http://www.townnews.com
// Submitted by Dustin Ward <dward@townnews.com>
bloxcms.com
townnews-staging.com
+// TradableBits: https://tradablebits.com
+// Submitted by Dmitry Khrisanov dmitry@tradablebits.com
+tbits.me
+
// TrafficPlex GmbH : https://www.trafficplex.de/
// Submitted by Phillipp Röll <phillipp.roell@trafficplex.de>
12hp.at
@@ -13336,7 +13654,6 @@ at.md
de.md
jp.md
to.md
-uwu.nu
indie.porn
vxl.sh
ch.tc
@@ -13369,6 +13686,13 @@ fastblog.net
// Submitted by Arnold Hendriks <info@webhare.com>
*.webhare.dev
+// WebHotelier Technologies Ltd: https://www.webhotelier.net/
+// Submitted by Apostolos Tsakpinis <apostolos.tsakpinis@gmail.com>
+reserve-online.net
+reserve-online.com
+bookonline.app
+hotelwithflight.com
+
// WeDeploy by Liferay, Inc. : https://www.wedeploy.com
// Submitted by Henrique Vicente <security@wedeploy.com>
wedeploy.io
@@ -13396,15 +13720,29 @@ daemon.panel.gg
// WoltLab GmbH : https://www.woltlab.com
// Submitted by Tim Düsterhus <security@woltlab.cloud>
+woltlab-demo.com
myforum.community
community-pro.de
diskussionsbereich.de
community-pro.net
meinforum.net
-// www.com.vc : http://www.com.vc
-// Submitted by Li Hui <lihui@sinopub.com>
-cn.vu
+// Woods Valldata : https://www.woodsvalldata.co.uk/
+// Submitted by Chris Whittle <chris.whittle@woodsvalldata.co.uk>
+affinitylottery.org.uk
+raffleentry.org.uk
+weeklylottery.org.uk
+
+// WP Engine : https://wpengine.com/
+// Submitted by Michael Smith <michael.smith@wpengine.com>
+// Submitted by Brandon DuRette <brandon.durette@wpengine.com>
+wpenginepowered.com
+js.wpenginepowered.com
+
+// Wix.com, Inc. : https://www.wix.com
+// Submitted by Shahar Talmi <shahart@wix.com>
+wixsite.com
+editorx.io
// XenonCloud GbR: https://xenoncloud.net
// Submitted by Julian Uphoff <publicsuffixlist@xenoncloud.net>
@@ -13448,6 +13786,7 @@ ybo.trade
// Yunohost : https://yunohost.org
// Submitted by Valentin Grimaud <security@yunohost.org>
+ynh.fr
nohost.me
noho.st
@@ -13466,26 +13805,4 @@ basicserver.io
virtualserver.io
enterprisecloud.nu
-// Mintere : https://mintere.com/
-// Submitted by Ben Aubin <security@mintere.com>
-mintere.site
-
-// Cityhost LLC : https://cityhost.ua
-// Submitted by Maksym Rivtin <support@cityhost.net.ua>
-cx.ua
-
-// WP Engine : https://wpengine.com/
-// Submitted by Michael Smith <michael.smith@wpengine.com>
-// Submitted by Brandon DuRette <brandon.durette@wpengine.com>
-wpenginepowered.com
-js.wpenginepowered.com
-
-// Impertrix Solutions : <https://impertrixcdn.com>
-// Submitted by Zhixiang Zhao <csuite@impertrix.com>
-impertrixcdn.com
-impertrix.com
-
-// GignoSystemJapan: http://gsj.bz
-// Submitted by GignoSystemJapan <kakutou-ec@gsj.bz>
-gsj.bz
// ===END PRIVATE DOMAINS===
diff --git a/etc/refcards/de-refcard.tex b/etc/refcards/de-refcard.tex
index c890acb..9cd0df7 100644
--- a/etc/refcards/de-refcard.tex
+++ b/etc/refcards/de-refcard.tex
@@ -443,8 +443,6 @@ einen Rahmen statt eines Fensters.
\key{Spalte f\"ur Umbruch auf {\it Argument\/} setzen}{C-x f}
\key{Pr\"afix f\"ur jede Zeile setzen}{C-x .}
-\key{Face setzen}{M-o}
-
\section{Gro\ss{}- und Kleinschreibung}
\key{Wort in Gro\ss{}buchstaben}{M-u}
diff --git a/etc/refcards/fr-refcard.tex b/etc/refcards/fr-refcard.tex
index 34d7ebd..ad6db63 100644
--- a/etc/refcards/fr-refcard.tex
+++ b/etc/refcards/fr-refcard.tex
@@ -446,8 +446,6 @@ pas les fen\^etres mais les cadres.
\key{Placer la marge droite \`a {\it arg\/} colonnes}{C-u {\it arg\/} C-x f}
\key{D\'efinir le pr\'efixe des lignes}{C-x .}
-\key{D\'efinir la fonte}{M-o}
-
\section{Modifier la casse}
\key{Mettre le mot en capitales}{M-u}
diff --git a/etc/refcards/pl-refcard.tex b/etc/refcards/pl-refcard.tex
index b31b427..5c12dbf 100644
--- a/etc/refcards/pl-refcard.tex
+++ b/etc/refcards/pl-refcard.tex
@@ -394,7 +394,7 @@ po polsku.
\key{szukaj wstecz tekstu zgodnego z~wpisywanym wyra/zeniem regularnym}{C-M-r}
%\key{select previous search string}{M-p}
-%\key{select next later search string}{M-n}
+%\key{select next search string}{M-n}
%\key{exit incremental search}{RET}
%\key{undo effect of last character}{DEL}
%\key{abort current search}{C-g}
@@ -679,7 +679,7 @@ Napisz \kbd{F10} aby uaktywni/c menu w minibuforze.
\key{przestaw {\bf linie}}{C-x C-t}
\key{przestaw {\bf s-wyra/zenia}}{C-M-t}
-% Removed -- there is no Polish disctionary for ispell.
+% Removed -- there is no Polish dictionary for ispell.
%\section{Spelling Check}
%
%\key{check spelling of current word}{M-\$}
diff --git a/etc/refcards/pt-br-refcard.tex b/etc/refcards/pt-br-refcard.tex
index 2d6680f..9226a6d 100644
--- a/etc/refcards/pt-br-refcard.tex
+++ b/etc/refcards/pt-br-refcard.tex
@@ -452,8 +452,6 @@ para frame.
\key{define a coluna limite de preenchimento}{C-x f}
\key{define um prefixo para cada linha}{C-x .}
-\key{formata fonte}{M-o}
-
\section{Mai{\'u}sculas e Min{\'u}sculas}
\key{Palavra para mai{\'u}sculas}{M-u}
diff --git a/etc/refcards/refcard.tex b/etc/refcards/refcard.tex
index f7b5da4..ae39a4e 100644
--- a/etc/refcards/refcard.tex
+++ b/etc/refcards/refcard.tex
@@ -322,7 +322,7 @@ the directions. If you are a first-time user, type
\kbd{C-h t} for a
\key{reverse regular expression search}{C-M-r}
\key{select previous search string}{M-p}
-\key{select next later search string}{M-n}
+\key{select next search string}{M-n}
\key{exit incremental search}{RET}
\key{undo effect of last character}{DEL}
\key{abort current search}{C-g}
@@ -457,8 +457,6 @@ frame instead of a window.
\key{set fill column to {\it arg}}{C-x f}
\key{set prefix each line starts with}{C-x .}
-\key{set face}{M-o}
-
\section{Case Change}
\key{uppercase word}{M-u}
diff --git a/etc/themes/wombat-theme.el b/etc/themes/wombat-theme.el
index d625b7f..922114f 100644
--- a/etc/themes/wombat-theme.el
+++ b/etc/themes/wombat-theme.el
@@ -36,7 +36,7 @@ are included.")
`(fringe ((,class (:background "#303030"))))
`(highlight ((,class (:background "#454545" :foreground "#ffffff"
:underline t))))
- `(region ((,class (:background "#444444" :foreground "#f6f3e8"))))
+ `(region ((,class (:background "#444444"))))
`(secondary-selection ((,class (:background "#333366" :foreground
"#f6f3e8"))))
`(isearch ((,class (:background "#343434" :foreground "#857b6f"))))
`(lazy-highlight ((,class (:background "#384048" :foreground "#a0a8b0"))))
diff --git a/leim/SKK-DIC/SKK-JISYO.L b/leim/SKK-DIC/SKK-JISYO.L
index 78d6e08..f1e06cc 100644
--- a/leim/SKK-DIC/SKK-JISYO.L
+++ b/leim/SKK-DIC/SKK-JISYO.L
@@ -46444,7 +46444,9 @@ zyklus /
���� /�Ź�;code/�Ź�;�����ΰ���/
������ /�Ź沽/
�������� /�Ź渰;[����]encryption key/
+���������� /�Ź��/
�������礦 /�Ź�Ģ/
+�����Ĥ��� /�Ź��̲�/
�����Ҥ礦 /�Ź�ɽ/
�����֤� /�Ź�ʸ/
���� /�Ż�/
@@ -61914,6 +61916,7 @@ zyklus /
���������� /������/
�������������礦 /�������/
����������ޤ� /����ü��/
+�������Ĥ��� /�����̲�/
�������Ƥ� /����Ū/����Ũ;imaginary enemy/
�������Ƥ����� /����Ũ��/
�������� /�����/
@@ -138362,6 +138365,7 @@ zyklus /
�ˤ��夦����� /����;Make a wish!/
�ˤ��夦���� /�ͻ�;��ˡܵ����ܵ����ˡ�����/
�ˤ��夦�����ä� /���ᵤ/
+�ˤ��夦���Ϥ餤 /��Ż�ʧ/
�ˤ��夦���礦 /��ž�/
�ˤ��夦���� /��ſͳ�/
�ˤ��夦���� /�����;dualism/�����;[ŷʸ]double star/
@@ -138476,6 +138480,7 @@ zyklus /
�ˤ��� /��ê/
�ˤ��� /����/
�ˤ��� /���ʳ�/2�ʳ�/
+�ˤ����ˤ礦 /���ʳ�ǧ��/
�ˤ��Ĥ褦 /���ʳ���/
�ˤ����� /���ʽŤ�/
�ˤ��ޤ� /���ʹ���;with a fallback/
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index 7af89eb..e6cda73 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -52,6 +52,7 @@ top_builddir = @top_builddir@
# Location to install Emacs.app under GNUstep / macOS.
# Later values may use this.
ns_appbindir=@ns_appbindir@
+ns_applibexecdir=@ns_applibexecdir@
# The default location for installation. Everything is placed in
# subdirectories of this directory. The default values for many of
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 8346524..018e81e 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -1401,10 +1401,8 @@ local_sockname (int s, char sockname[socknamesize], int
tmpdirlen,
/* Put the full address name into the buffer, since the caller might
need it for diagnostics. But don't overrun the buffer. */
uintmax_t uidmax = uid;
- int emacsdirlen;
int suffixlen = snprintf (sockname + tmpdirlen, socknamesize - tmpdirlen,
- "/emacs%"PRIuMAX"%n/%s", uidmax, &emacsdirlen,
- server_name);
+ "/emacs%"PRIuMAX"/%s", uidmax, server_name);
if (! (0 <= suffixlen && suffixlen < socknamesize - tmpdirlen))
return ENAMETOOLONG;
@@ -1412,7 +1410,8 @@ local_sockname (int s, char sockname[socknamesize], int
tmpdirlen,
this user's directory and does not let others write to it; this
fends off some symlink attacks. To avoid races, keep the parent
directory open while checking. */
- char *emacsdirend = sockname + tmpdirlen + emacsdirlen;
+ char *emacsdirend = sockname + tmpdirlen + suffixlen -
+ strlen(server_name) - 1;
*emacsdirend = '\0';
int dir = openat (AT_FDCWD, sockname,
O_PATH | O_DIRECTORY | O_NOFOLLOW | O_CLOEXEC);
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 88b49f8..bd4d4fc 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -6259,7 +6259,7 @@ test_objc_is_mercury (char *this_file, language **lang)
}
}
- /* Fallback heuristic test. Not failsafe but errless in pratice. */
+ /* Fallback heuristic test. Not failsafe but errless in practice. */
ratio = ((float) rule_signs + percentage_signs + mercury_dots) / lines;
out:
diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c
index dc568e0..d378e0b 100644
--- a/lib-src/seccomp-filter.c
+++ b/lib-src/seccomp-filter.c
@@ -131,9 +131,12 @@ export_filter (const char *file,
int (*function) (const scmp_filter_ctx, int),
const char *name)
{
- int fd = TEMP_FAILURE_RETRY (
- open (file, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY | O_CLOEXEC,
- 0644));
+ int fd;
+ do
+ fd = open (file,
+ O_WRONLY | O_CREAT | O_TRUNC | O_BINARY | O_CLOEXEC,
+ 0644);
+ while (fd < 0 && errno == EINTR);
if (fd < 0)
fail (errno, "open %s", file);
int status = function (ctx, fd);
diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7
index 3de3f2f..3dd8313 100644
--- a/lisp/ChangeLog.7
+++ b/lisp/ChangeLog.7
@@ -15867,7 +15867,7 @@
the key line of an entry.
* bibtex.el (bibtex-autokey-year-use-crossref-entry): New variable
- to determine if crossreferenced entry should be used for autokey
+ to determine if cross-referenced entry should be used for autokey
generation, if year field of current entry is absent.
(bibtex-generate-autokey): Use this new variable.
diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8
index 3027463..39e757b 100644
--- a/lisp/ChangeLog.8
+++ b/lisp/ChangeLog.8
@@ -1147,7 +1147,7 @@
(bibtex-submit-bug-report): Use bibtex-version and
bibtex-maintainer-salutation.
(bibtex-entry-field-alist): Made booktitle field optional for
- @inproceedings entries when crossreferenced.
+ @inproceedings entries when cross-referenced.
(bibtex-entry-field-alist): Add booktitle field to proceedings
entry type (for cross referencing). Thanks to Wagner Toledo Correa
for the suggestion.
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 54783db..f370bd3 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -288,6 +288,10 @@ or zero means the region is the expansion.
A negative argument means to undefine the specified abbrev.
Reads the abbreviation in the minibuffer.
+See also `inverse-add-mode-abbrev', which performs the opposite task:
+if the abbrev text is already in the buffer, use this command to
+define an abbrev by specifying the expansion in the minibuffer.
+
Don't use this function in a Lisp program; use `define-abbrev' instead."
(interactive "p")
(add-abbrev
@@ -304,6 +308,10 @@ expansion; or zero means the region is the expansion.
A negative argument means to undefine the specified abbrev.
This command uses the minibuffer to read the abbreviation.
+See also `inverse-add-global-abbrev', which performs the opposite task:
+if the abbrev text is already in the buffer, use this command to
+define an abbrev by specifying the expansion in the minibuffer.
+
Don't use this function in a Lisp program; use `define-abbrev' instead."
(interactive "p")
(add-abbrev global-abbrev-table "Global" arg))
@@ -330,7 +338,11 @@ Don't use this function in a Lisp program; use
`define-abbrev' instead."
"Define last word before point as a mode-specific abbrev.
With prefix argument N, defines the Nth word before point.
This command uses the minibuffer to read the expansion.
-Expands the abbreviation after defining it."
+Expands the abbreviation after defining it.
+
+See also `add-mode-abbrev', which performs the opposite task:
+if the expansion is already in the buffer, use this command
+to define an abbrev by specifying the abbrev in the minibuffer."
(interactive "p")
(inverse-add-abbrev
(if only-global-abbrevs
@@ -343,7 +355,11 @@ Expands the abbreviation after defining it."
"Define last word before point as a global (mode-independent) abbrev.
With prefix argument N, defines the Nth word before point.
This command uses the minibuffer to read the expansion.
-Expands the abbreviation after defining it."
+Expands the abbreviation after defining it.
+
+See also `add-global-abbrev', which performs the opposite task:
+if the expansion is already in the buffer, use this command
+to define an abbrev by specifying the abbrev in the minibuffer."
(interactive "p")
(inverse-add-abbrev global-abbrev-table "Global" n))
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 376c1b2..a147053 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -616,7 +616,7 @@ while a list of strings is used as a word list."
(if (eq doc 'error)
"(documentation error)"
(setq score (+ score (apropos-score-doc doc)))
- (substring doc 0 (string-match "\n" doc)))
+ (substring doc 0 (string-search "\n" doc)))
"(not documented)")))
(and var-predicate
(funcall var-predicate symbol)
@@ -625,7 +625,7 @@ while a list of strings is used as a word list."
(progn
(setq score (+ score (apropos-score-doc doc)))
(substring doc 0
- (string-match "\n" doc)))))))
+ (string-search "\n" doc)))))))
(setcar (cdr (car p)) score)
(setq p (cdr p))))
(and (let ((apropos-multi-type do-all))
@@ -639,7 +639,7 @@ while a list of strings is used as a word list."
"Like (documentation-property SYMBOL PROPERTY RAW) but handle errors."
(condition-case ()
(let ((doc (documentation-property symbol property raw)))
- (if doc (substring doc 0 (string-match "\n" doc))
+ (if doc (substring doc 0 (string-search "\n" doc))
"(not documented)"))
(error "(error retrieving documentation)")))
@@ -767,7 +767,7 @@ the output includes key-bindings of commands."
"(alias for undefined function)")
(error
"(can't retrieve function documentation)")))
- (substring doc 0 (string-match "\n" doc))
+ (substring doc 0 (string-search "\n" doc))
"(not documented)"))
(when (boundp symbol)
(apropos-documentation-property
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 83c5161..71ad7bd 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -1707,7 +1707,7 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
(= (get-byte p) ?\C-z)
(> (get-byte (1+ p)) 0))
(let* ((namefld (buffer-substring (+ p 2) (+ p 2 13)))
- (fnlen (or (string-match "\0" namefld) 13))
+ (fnlen (or (string-search "\0" namefld) 13))
(efnname (decode-coding-string (substring namefld 0 fnlen)
archive-file-name-coding-system))
(csize (archive-l-e (+ p 15) 4))
@@ -2089,7 +2089,7 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
(dirtype (get-byte (+ p 4)))
(lfnlen (if (= dirtype 2) (get-byte (+ p 56)) 0))
(ldirlen (if (= dirtype 2) (get-byte (+ p 57)) 0))
- (fnlen (or (string-match "\0" namefld) 13))
+ (fnlen (or (string-search "\0" namefld) 13))
(efnname (let ((str
(concat
(if (> ldirlen 0)
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index 0392903..995d9e2 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -93,8 +93,8 @@ If this contains a %s, that will be replaced by the matching
rule."
'((("\\.\\([Hh]\\|hh\\|hpp\\|hxx\\|h\\+\\+\\)\\'" . "C / C++ header")
(replace-regexp-in-string
"[^A-Z0-9]" "_"
- (replace-regexp-in-string
- "\\+" "P"
+ (string-replace
+ "+" "P"
(upcase (file-name-nondirectory buffer-file-name))))
"#ifndef " str \n
"#define " str "\n\n"
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 4b194c0..b8bf0c1 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -463,7 +463,9 @@ displayed in `mode-line-position', a component of the
default
(defcustom mode-line-position-line-format '(" L%l")
"Format used to display line numbers in the mode line.
This is used when `line-number-mode' is switched on. The \"%l\"
-format spec will be replaced by the line number."
+format spec will be replaced by the line number.
+
+Also see `mode-line-position-column-line-format'."
:type '(list string)
:version "28.1"
:group 'mode-line)
@@ -471,9 +473,10 @@ format spec will be replaced by the line number."
(defcustom mode-line-position-column-format '(" C%c")
"Format used to display column numbers in the mode line.
This is used when `column-number-mode' is switched on. The
-\"%c\" format spec will be replaced by the column number, which
-is zero-based if `column-number-indicator-zero-based' is non-nil,
-and one-based if `column-number-indicator-zero-based' is nil."
+\"%c\" format spec is replaced by the zero-based column number,
+and \"%C\" is replaced by the one-based column number.
+
+Also see `mode-line-position-column-line-format'."
:type '(list string)
:version "28.1"
:group 'mode-line)
@@ -1431,6 +1434,17 @@ if `inhibit-field-text-motion' is non-nil."
(define-key ctl-x-map "[" 'backward-page)
(define-key ctl-x-map "]" 'forward-page)
+
+(defvar page-navigation-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "]" #'forward-page)
+ (define-key map "[" #'backward-page)
+ map)
+ "Keymap to repeat page navigation key sequences. Used in `repeat-mode'.")
+
+(put 'forward-page 'repeat-map 'page-navigation-repeat-map)
+(put 'backward-page 'repeat-map 'page-navigation-repeat-map)
+
(define-key ctl-x-map "\C-p" 'mark-page)
(define-key ctl-x-map "l" 'count-lines-page)
(define-key ctl-x-map "np" 'narrow-to-page)
@@ -1466,7 +1480,7 @@ if `inhibit-field-text-motion' is non-nil."
(defvar ctl-x-x-map
(let ((map (make-sparse-keymap)))
(define-key map "f" #'font-lock-update)
- (define-key map "g" #'revert-buffer)
+ (define-key map "g" #'revert-buffer-quick)
(define-key map "r" #'rename-buffer)
(define-key map "u" #'rename-uniquely)
(define-key map "n" #'clone-buffer)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 52b96fd..b340d37 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -27,7 +27,7 @@
;; associates a string with a location in a certain file. Thus, you
;; can navigate your way to that location by providing the string.
;;
-;; Type `M-x customize-group RET boomark RET' for user options.
+;; Type `M-x customize-group RET bookmark RET' for user options.
;;; Code:
@@ -561,10 +561,14 @@ old one."
(set-text-properties 0 (length stripped-name) nil stripped-name)
(if (and (not no-overwrite)
(bookmark-get-bookmark stripped-name 'noerror))
- ;; already existing bookmark under that name and
- ;; no prefix arg means just overwrite old bookmark
- ;; Use the new (NAME . ALIST) format.
- (setcdr (bookmark-get-bookmark stripped-name) alist)
+ ;; Already existing bookmark under that name and
+ ;; no prefix arg means just overwrite old bookmark.
+ (let ((bm (bookmark-get-bookmark stripped-name)))
+ ;; First clean up if previously location was fontified.
+ (when bookmark-fontify
+ (bookmark--unfontify bm))
+ ;; Modify using the new (NAME . ALIST) format.
+ (setcdr bm alist))
;; otherwise just cons it onto the front (either the bookmark
;; doesn't exist already, or there is no prefix arg. In either
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 1e31c3c..db4751a 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -1139,7 +1139,7 @@ If the current Calc language does not use placeholders,
return nil."
0)
(setq sym (intern (substring (symbol-name sym)
1))))
- (or (string-match "-" (symbol-name sym))
+ (or (string-search "-" (symbol-name sym))
(setq sym (intern
(concat "calcFunc-"
(symbol-name sym))))))
@@ -1149,7 +1149,7 @@ If the current Calc language does not use placeholders,
return nil."
(let ((val (list 'var
(intern (math-remove-dashes
(symbol-name sym)))
- (if (string-match "-" (symbol-name sym))
+ (if (string-search "-" (symbol-name sym))
sym
(intern (concat "var-"
(symbol-name sym)))))))
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index e85ecf0..45337e1 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -3088,7 +3088,7 @@ If X is not an error form, return 1."
(math-read-big-err-msg nil)
math-read-big-baseline math-read-big-h2
new-pos p)
- (while (setq new-pos (string-match "\n" str pos))
+ (while (setq new-pos (string-search "\n" str pos))
(setq math-read-big-lines
(cons (substring str pos new-pos) math-read-big-lines)
pos (1+ new-pos)))
@@ -3249,7 +3249,7 @@ If X is not an error form, return 1."
(t
(let ((str (math-format-flat-expr x 0))
(pos 0) p)
- (or (string-match "\"" str)
+ (or (string-search "\"" str)
(while (<= (setq p (+ pos w)) (length str))
(while (and (> (setq p (1- p)) pos)
(not (= (aref str p) ? ))))
@@ -3278,7 +3278,7 @@ If X is not an error form, return 1."
(math-format-radix-float a prec))
(format "%d#%s" calc-number-radix
(math-format-radix-float a prec)))))
- (if (and prec (> prec 191) (string-match "\\*" str))
+ (if (and prec (> prec 191) (string-search "*" str))
(concat "(" str ")")
str))))
((eq (car a) 'frac)
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index ee53b94..ac57011d 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -2238,7 +2238,7 @@ and ends on the last Sunday of October at 2 a.m."
(if (eq (car-safe str2) 'error)
str2
(append '(calcFunc-lambda) (cdr str1) (list str2)))))
- (if (string-match "#" str)
+ (if (string-search "#" str)
(let ((calc-hashes-used 0))
(and (setq str (math-read-expr str))
(if (eq (car-safe str) 'error)
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index 423d1e6..9dfdba3 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -391,6 +391,13 @@
((>= calc-gnuplot-version 3)
"dumb")
(t "postscript"))))
+ (unless (equal device calc-graph-last-device)
+ (setq calc-graph-last-device device)
+ (unless (calc-gnuplot-command "set terminal" device)
+ ;; If gnuplot doesn't support the terminal, then set it
+ ;; to "dumb".
+ (calc-gnuplot-command "set terminal dumb")
+ (setq device "dumb")))
(if (equal device "dumb")
(setq device (format "dumb %d %d"
(1- (frame-width)) (1- (frame-height)))))
@@ -404,10 +411,6 @@
(setq tempoutfile (calc-temp-file-name -1)
output tempoutfile))
(setq output (eval output t)))
- (or (equal device calc-graph-last-device)
- (progn
- (setq calc-graph-last-device device)
- (calc-gnuplot-command "set terminal" device)))
(or (equal output calc-graph-last-output)
(progn
(setq calc-graph-last-output output)
@@ -1025,7 +1028,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(calc-pop-stack 1))))
(if (string-match "\\[.+\\]" range)
(setq range (substring range 1 -1)))
- (if (and (not (string-match ":" range))
+ (if (and (not (string-search ":" range))
(or (string-match "," range)
(string-match " " range)))
(aset range (match-beginning 0) ?\:))
@@ -1411,6 +1414,8 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(calc-graph-view-trail)))
(defun calc-gnuplot-command (&rest args)
+ "Send ARGS to Gnuplot.
+Returns nil if Gnuplot signalled an error."
(calc-graph-init)
(let ((cmd (concat (mapconcat 'identity args " ") "\n")))
(or (calc-graph-w32-p)
@@ -1428,9 +1433,11 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(or (calc-graph-w32-p)
(accept-process-output (and (not calc-graph-no-wait)
calc-gnuplot-process)))
- (calc-gnuplot-check-for-errors)
- (if (get-buffer-window calc-gnuplot-buffer)
- (calc-graph-view-trail)))))
+ (prog1
+ ;; Return nil if we got an error.
+ (not (calc-gnuplot-check-for-errors))
+ (if (get-buffer-window calc-gnuplot-buffer)
+ (calc-graph-view-trail))))))
(defun calc-graph-init-buffers ()
(or (and calc-gnuplot-buffer
diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el
index 1902a4f..acbef27 100644
--- a/lisp/calc/calc-keypd.el
+++ b/lisp/calc/calc-keypd.el
@@ -481,7 +481,7 @@
":"
(if (and (equal cmd "e")
(or (not input)
- (string-match
+ (string-search
"#" input))
(> radix 14))
(format "*%d.^" radix)
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index 0117f44..aef3173 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -660,7 +660,7 @@
(setq math-exp-pos (match-end 0)
math-exp-token 'punc
math-expr-data "[")
- (let ((right (string-match "}" math-exp-str math-exp-pos)))
+ (let ((right (string-search "}" math-exp-str math-exp-pos)))
(and right
(setq math-exp-str (copy-sequence math-exp-str))
(aset math-exp-str right ?\]))))))))))
@@ -899,7 +899,7 @@
(setq math-exp-pos (match-end 0)
math-exp-token 'punc
math-expr-data "[")
- (let ((right (string-match "}" math-exp-str math-exp-pos)))
+ (let ((right (string-search "}" math-exp-str math-exp-pos)))
(and right
(setq math-exp-str (copy-sequence math-exp-str))
(aset math-exp-str right ?\]))))))))))
@@ -2342,7 +2342,7 @@ order to Calc's."
(math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)
(if (= (math-read-big-char widest v) ?\()
(progn
- (setq line (if (string-match "-" p)
+ (setq line (if (string-search "-" p)
(intern p)
(intern (concat "calcFunc-" p)))
h (1+ widest)
@@ -2362,7 +2362,7 @@ order to Calc's."
(setq p (cons line (nreverse p))))
(setq p (list 'var
(intern (math-remove-dashes p))
- (if (string-match "-" p)
+ (if (string-search "-" p)
(intern p)
(intern (concat "var-" p)))))))
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 4e27d76..f9dd9eb 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -604,7 +604,7 @@
((equal name "#")
(search-backward "#")
(error "Token `#' is reserved"))
- ((and unquoted (string-match "#" name))
+ ((and unquoted (string-search "#" name))
(error "Tokens containing `#' must be quoted"))
((not (string-match "[^ ]" name))
(search-backward "\"" nil t)
@@ -802,8 +802,8 @@
(when match
(kill-line 1)
(setq line (concat line (substring curline 0 match))))
- (setq line (replace-regexp-in-string "SPC" " SPC "
- (replace-regexp-in-string " " "" line)))
+ (setq line (string-replace "SPC" " SPC "
+ (string-replace " " "" line)))
(insert line "\t\t\t")
(if (> (current-column) 24)
(delete-char -1))
@@ -830,7 +830,7 @@
(when match
(kill-line 1)
(setq line (concat line (substring curline 0 match))))
- (setq line (replace-regexp-in-string " " "" line))
+ (setq line (string-replace " " "" line))
(insert cmdbeg " " line "\t\t\t")
(if (> (current-column) 24)
(delete-char -1))
@@ -857,7 +857,7 @@
(when match
(kill-line 1)
(setq line (concat line (substring curline 0 match))))
- (setq line (replace-regexp-in-string " " "" line))
+ (setq line (string-replace " " "" line))
(insert line "\t\t\t")
(if (> (current-column) 24)
(delete-char -1))
@@ -1068,7 +1068,7 @@ Redefine the corresponding command."
(insert (setq str (prin1-to-string
(cons 'defun (cons cmd (cdr fcmd)))))
"\n")
- (or (and (string-match "\"" str) (not q-ok))
+ (or (and (string-search "\"" str) (not q-ok))
(fill-region pt (point)))
(indent-rigidly pt (point) 2)
(delete-region pt (1+ pt))
@@ -1087,7 +1087,7 @@ Redefine the corresponding command."
(cons 'defun (cons func
(cdr ffunc)))))
"\n")
- (or (and (string-match "\"" str) (not q-ok))
+ (or (and (string-search "\"" str) (not q-ok))
(fill-region pt (point)))
(indent-rigidly pt (point) 2)
(delete-region pt (1+ pt))
@@ -2132,7 +2132,7 @@ Redefine the corresponding command."
(cdr prim))
((memq exp math-exp-env)
exp)
- ((string-match "-" name)
+ ((string-search "-" name)
exp)
(t
(intern (concat "var-" name))))))
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index c3adc3d..8b6f063 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -406,7 +406,7 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
If EXPR is nil, return nil."
(if expr
(let ((cexpr (math-compose-expr expr 0)))
- (replace-regexp-in-string
+ (string-replace
" / " "/"
(if (stringp cexpr)
cexpr
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 1e7d5e7..800ec7a 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -139,6 +139,7 @@
;;; Code:
(require 'calc-macs)
+(require 'rect)
;; Declare functions which are defined elsewhere.
(declare-function calc-set-language "calc-lang" (lang &optional option
no-refresh))
@@ -2126,7 +2127,7 @@ the United States."
(goto-char (point-max))
(cond ((null prefix) (insert " "))
((and (> (length prefix) 4)
- (string-match " " prefix 4))
+ (string-search " " prefix 4))
(insert (substring prefix 0 4) " "))
(t (insert (format "%4s " prefix))))
(insert fval "\n")
@@ -2469,7 +2470,7 @@ the United States."
(calc-minibuffer-contains
"[-+]?\\(.*\\+/- *\\|.*mod *\\)?\\([0-9]+\\.?0*[@oh]
*\\)?\\([0-9]+\\.?0*['m]
*\\)?[0-9]*\\(\\.?[0-9]*\\(e[-+]?[0-3]?[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?\\)?\\|[0-9]:\\([0-9]+:\\)?[0-9]*\\)?[\"s]?\\'"))
(if (and (memq last-command-event '(?@ ?o ?h ?\' ?m))
- (string-match " " calc-hms-format))
+ (string-search " " calc-hms-format))
(insert " "))
(if (and (memq last-command '(calcDigit-start calcDigit-key))
(eq last-command-event ?.))
@@ -3059,7 +3060,7 @@ the United States."
(defun calc-count-lines (s)
(let ((pos 0)
(num 1))
- (while (setq pos (string-match "\n" s pos))
+ (while (setq pos (string-search "\n" s pos))
(setq pos (1+ pos)
num (1+ num)))
num))
@@ -3388,7 +3389,9 @@ and all digits are kept, regardless of Calc's current
precision."
"Parse the region as a vector of numbers and push it on the Calculator
stack."
(interactive "r\nP")
(require 'calc-ext)
- (calc-do-grab-region top bot arg))
+ (if rectangle-mark-mode
+ (calc-do-grab-rectangle top bot arg)
+ (calc-do-grab-region top bot arg)))
;;;###autoload
(defun calc-grab-rectangle (top bot arg)
@@ -3397,12 +3400,14 @@ and all digits are kept, regardless of Calc's current
precision."
(require 'calc-ext)
(calc-do-grab-rectangle top bot arg))
+;;;###autoload
(defun calc-grab-sum-down (top bot arg)
"Parse a rectangle as a matrix of numbers and sum its columns."
(interactive "r\nP")
(require 'calc-ext)
(calc-do-grab-rectangle top bot arg 'calcFunc-reduced))
+;;;###autoload
(defun calc-grab-sum-across (top bot arg)
"Parse a rectangle as a matrix of numbers and sum its rows."
(interactive "r\nP")
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el
index 94b99aa..8d93ae9 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -158,7 +158,7 @@
(calc-top-n 2)
(calc-top-n 1)))
(let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
+ (not (string-search "[" var)))
(math-read-expr (concat "[" var "]"))
(math-read-expr var))))
(if (eq (car-safe var) 'error)
@@ -175,7 +175,7 @@
(calc-top-n 2)
(calc-top-n 1)))
(let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
+ (not (string-search "[" var)))
(math-read-expr (concat "[" var "]"))
(math-read-expr var))))
(if (eq (car-safe var) 'error)
@@ -1028,7 +1028,7 @@
(fset 'calcFunc-integ math-old-integ))))
;; See if the function is a symbolic derivative.
- (and (string-match "'" (symbol-name (car expr)))
+ (and (string-search "'" (symbol-name (car expr)))
(let ((name (symbol-name (car expr)))
(p expr) (n 0) (which nil) (bad nil))
(while (setq n (1+ n) p (cdr p))
diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el
index ee3ae0a..3cb1886 100644
--- a/lisp/calc/calcalg3.el
+++ b/lisp/calc/calcalg3.el
@@ -56,7 +56,7 @@
(calc-top-n 1)
(calc-top-n 2)))
(let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
+ (not (string-search "[" var)))
(math-read-expr (concat "[" var "]"))
(math-read-expr var))))
(if (eq (car-safe var) 'error)
@@ -81,7 +81,7 @@
(calc-top-n 1)
(calc-top-n 2)))
(let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
+ (not (string-search "[" var)))
(math-read-expr (concat "[" var "]"))
(math-read-expr var))))
(if (eq (car-safe var) 'error)
@@ -490,7 +490,7 @@
defc)
",")))))
(coefs nil))
- (setq vars (if (string-match "\\[" vars)
+ (setq vars (if (string-search "[" vars)
(math-read-expr vars)
(math-read-expr (concat "[" vars "]"))))
(if (eq (car-safe vars) 'error)
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index 29bcd6d..f523863 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -402,11 +402,12 @@ displayed in a window:
(appt-display-message string-list min-list))
(when appt-display-mode-line
(setq appt-mode-string
- (concat " " (propertize
- (appt-mode-line (mapcar #'number-to-string
- min-list)
- t)
- 'face 'mode-line-emphasis))))
+ (concat (propertize
+ (appt-mode-line (mapcar #'number-to-string
+ min-list)
+ t)
+ 'face 'mode-line-emphasis)
+ " ")))
;; Reset count to 0 in case we display another appt on the next cycle.
(setq appt-display-count (if (eq '(0) min-list) 0
(1+ prev-appt-display-count))))
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index ff419c7..350b7e5 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -126,7 +126,7 @@ Defaults to today's date if DATE is not given."
"" ; pre-Bahai
(let ((m (calendar-extract-month bahai-date))
(d (calendar-extract-day bahai-date)))
- (calendar-dlet*
+ (calendar-dlet
((monthname (if (and (= m 19)
(<= d 0))
"Ayyám-i-Há"
diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el
index 346585e..11785c4 100644
--- a/lisp/calendar/cal-coptic.el
+++ b/lisp/calendar/cal-coptic.el
@@ -116,7 +116,7 @@ Defaults to today's date if DATE is not given."
(m (calendar-extract-month coptic-date)))
(if (< y 1)
""
- (calendar-dlet*
+ (calendar-dlet
((monthname (aref calendar-coptic-month-name-array (1- m)))
(day (number-to-string (calendar-extract-day coptic-date)))
(dayname nil)
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index 9e6c295..2986411 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -200,7 +200,7 @@ The result has the proper form for
`calendar-daylight-savings-starts'."
(calendar-persian-to-absolute `(7 1 ,(- year 621))))))))
(prevday-sec (- -1 utc-diff)) ; last sec of previous local day
new-rules)
- (calendar-dlet* ((year (1+ y)))
+ (calendar-dlet ((year (1+ y)))
;; Scan through the next few years until only one rule remains.
(while (cdr candidate-rules)
(dolist (rule candidate-rules)
@@ -397,7 +397,7 @@ This function respects the value of
`calendar-dst-check-each-year-flag'."
(or (let ((expr (if calendar-dst-check-each-year-flag
(cadr (calendar-dst-find-startend year))
(nth 4 calendar-current-time-zone-cache))))
- (calendar-dlet* ((year year))
+ (calendar-dlet ((year year))
(if expr (eval expr))))
;; New US rules commencing 2007. https://www.iana.org/time-zones
(and (not (zerop calendar-daylight-time-offset))
@@ -409,7 +409,7 @@ This function respects the value of
`calendar-dst-check-each-year-flag'."
(or (let ((expr (if calendar-dst-check-each-year-flag
(nth 2 (calendar-dst-find-startend year))
(nth 5 calendar-current-time-zone-cache))))
- (calendar-dlet* ((year year))
+ (calendar-dlet ((year year))
(if expr (eval expr))))
;; New US rules commencing 2007. https://www.iana.org/time-zones
(and (not (zerop calendar-daylight-time-offset))
@@ -419,7 +419,7 @@ This function respects the value of
`calendar-dst-check-each-year-flag'."
(defun dst-in-effect (date)
"True if on absolute DATE daylight saving time is in effect.
Fractional part of DATE is local standard time of day."
- (calendar-dlet* ((year (calendar-extract-year
+ (calendar-dlet ((year (calendar-extract-year
(calendar-gregorian-from-absolute (floor date)))))
(let* ((dst-starts-gregorian (eval calendar-daylight-savings-starts))
(dst-ends-gregorian (eval calendar-daylight-savings-ends))
diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el
index e5810c3..58a5a0f 100644
--- a/lisp/calendar/cal-html.el
+++ b/lisp/calendar/cal-html.el
@@ -151,7 +151,7 @@
(defun cal-html-comment (string)
"Return STRING as html comment."
(format "<!-- ====== %s ====== -->\n"
- (replace-regexp-in-string "--" "++" string)))
+ (string-replace "--" "++" string)))
(defun cal-html-href (link string)
"Return a hyperlink to url LINK with text STRING."
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el
index ca37d80..dd005e8 100644
--- a/lisp/calendar/cal-persia.el
+++ b/lisp/calendar/cal-persia.el
@@ -140,7 +140,7 @@ Gregorian date Sunday, December 31, 1 BC."
(or date (calendar-current-date)))))
(y (calendar-extract-year persian-date))
(m (calendar-extract-month persian-date)))
- (calendar-dlet*
+ (calendar-dlet
((monthname (aref calendar-persian-month-name-array (1- m)))
(day (number-to-string (calendar-extract-day persian-date)))
(year (number-to-string y))
diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el
index f593201..7b55d42 100644
--- a/lisp/calendar/cal-tex.el
+++ b/lisp/calendar/cal-tex.el
@@ -974,11 +974,11 @@ Uses the 24-hour clock if `cal-tex-24' is non-nil. Note
that the hours
shown are hard-coded to 8-12, 13-17."
(with-suppressed-warnings ((lexical date))
(defvar date)) ;For `cal-tex-daily-string'.
- (let ((date thedate)
- (month (calendar-extract-month date))
- (day (calendar-extract-day date))
- ;; (year (calendar-extract-year date))
- morning afternoon s)
+ (let* ((date thedate)
+ (month (calendar-extract-month date))
+ (day (calendar-extract-day date))
+ ;; (year (calendar-extract-year date))
+ morning afternoon s)
(cal-tex-comment "begin cal-tex-week-hours")
(cal-tex-cmd "\\ \\\\[-.2cm]")
(cal-tex-cmd "\\noindent")
@@ -1465,10 +1465,10 @@ hourly sections for the period specified by
`cal-tex-daily-start'
and `cal-tex-daily-end'."
(with-suppressed-warnings ((lexical date))
(defvar date)) ;For `cal-tex-daily-string'.
- (let ((date thedate)
- (month-name (cal-tex-month-name (calendar-extract-month date)))
- (i (1- cal-tex-daily-start))
- hour)
+ (let* ((date thedate)
+ (month-name (cal-tex-month-name (calendar-extract-month date)))
+ (i (1- cal-tex-daily-start))
+ hour)
(cal-tex-banner "cal-tex-daily-page")
(cal-tex-b-makebox "4cm" "l")
(cal-tex-b-parbox "b" "3.8cm")
@@ -1755,7 +1755,7 @@ current contents."
COMMENT may contain newlines, which are prefixed by \"% \" in the output."
(insert (format "%% %s\n"
(if comment
- (replace-regexp-in-string "\n" "\n% " comment)
+ (string-replace "\n" "\n% " comment)
""))))
(defun cal-tex-banner (comment)
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 3f9fe1c..7c929eb 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -137,7 +137,7 @@
;; - whatever is passed to diary-sexp-entry
;; - whatever is passed to diary-remind
-(defmacro calendar-dlet* (binders &rest body)
+(defmacro calendar-dlet (binders &rest body)
"Like `dlet' but without warnings about non-prefixed var names."
(declare (indent 1) (debug let))
(let ((vars (mapcar (lambda (binder)
@@ -1308,7 +1308,9 @@ This function is suitable for execution in an init file."
;; Avoid loading cal-x unless it will be used.
(if (and (memq calendar-setup '(one-frame two-frames calendar-only))
(display-multi-frame-p))
- (calendar-frame-setup calendar-setup arg)
+ ;; Calendar does its own frame setup.
+ (let ((pop-up-frames nil))
+ (calendar-frame-setup calendar-setup arg))
(calendar-basic-setup arg)))
(defun calendar-basic-setup (&optional arg nodisplay)
@@ -1499,7 +1501,7 @@ first INDENT characters on the line."
(goto-char (point-min))
(calendar-move-to-column indent)
(insert
- (calendar-dlet* ((month month) (year year))
+ (calendar-dlet ((month month) (year year))
(calendar-string-spread (list calendar-month-header)
?\s calendar-month-digit-width)))
(calendar-ensure-newline)
@@ -1516,7 +1518,7 @@ first INDENT characters on the line."
calendar-day-header-width nil ?\s)
(make-string (- calendar-column-width calendar-day-header-width) ?\s)))
(calendar-ensure-newline)
- (calendar-dlet* ((day day) (month month) (year year))
+ (calendar-dlet ((day day) (month month) (year year))
(calendar-insert-at-column indent calendar-intermonth-text trunc))
;; Add blank days before the first of the month.
(insert (make-string (* blank-days calendar-column-width) ?\s))
@@ -1527,7 +1529,7 @@ first INDENT characters on the line."
(insert (propertize
(format (format "%%%dd" calendar-day-digit-width) day)
'mouse-face 'highlight
- 'help-echo (calendar-dlet* ((day day) (month month) (year year))
+ 'help-echo (calendar-dlet ((day day) (month month) (year year))
(eval calendar-date-echo-text t))
;; 'date property prevents intermonth text confusing re-searches.
;; (Tried intangible, it did not really work.)
@@ -1538,7 +1540,7 @@ first INDENT characters on the line."
(/= day last))
(calendar-ensure-newline)
(setq day (1+ day)) ; first day of next week
- (calendar-dlet* ((day day) (month month) (year year))
+ (calendar-dlet ((day day) (month month) (year year))
(calendar-insert-at-column indent calendar-intermonth-text trunc))))))
(defun calendar-redraw ()
@@ -1833,7 +1835,7 @@ concatenated and the result truncated."
(bufferp (get-buffer calendar-buffer)))
(with-current-buffer calendar-buffer
(let ((start (- calendar-left-margin 2)))
- (calendar-dlet* ((date (condition-case nil
+ (calendar-dlet ((date (condition-case nil
(calendar-cursor-to-nearest-date)
(error (calendar-current-date)))))
(setq mode-line-format
@@ -2561,7 +2563,7 @@ and day names to be abbreviated as specified by
respectively. An optional parameter NODAYNAME, when t, omits the
name of the day of the week."
(let ((month (calendar-extract-month date)))
- (calendar-dlet*
+ (calendar-dlet
((dayname (unless nodayname (calendar-day-name date abbreviate)))
(monthname (calendar-month-name month abbreviate))
(day (number-to-string (calendar-extract-day date)))
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 4efa366..9ca7ce3 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -663,7 +663,7 @@ any entries were found."
(calendar-month-name-array (or months calendar-month-name-array))
(case-fold-search t)
entry-found)
- (calendar-dlet*
+ (calendar-dlet
((dayname (format "%s\\|%s\\.?" (calendar-day-name date)
(calendar-day-name date 'abbrev)))
(monthname (format "\\*\\|%s%s" (calendar-month-name month)
@@ -858,7 +858,7 @@ LIST-ONLY is non-nil, in which case it just returns the
list."
;; every time, diary-include-other-diary-files
;; binds it to nil (essentially) when it runs
;; in included files.
- (calendar-dlet* ((number number)
+ (calendar-dlet ((number number)
(list-only list-only))
(run-hooks 'diary-nongregorian-listing-hook
'diary-list-entries-hook))
@@ -877,7 +877,7 @@ LIST-ONLY is non-nil, in which case it just returns the
list."
(copy-sequence
(car display-buffer-fallback-action))))))
(funcall diary-display-function)))
- (calendar-dlet* ((number number)
+ (calendar-dlet ((number number)
(original-date original-date))
(run-hooks 'diary-hook))))))
(and temp-buff (buffer-name temp-buff) (kill-buffer temp-buff)))
@@ -1266,7 +1266,7 @@ MARKFUNC is a function that marks entries of the
appropriate type
matching a given date pattern. MONTHS is an array of month names.
SYMBOL marks diary entries of the type in question. ABSFUNC is a
function that converts absolute dates to dates of the appropriate type."
- (calendar-dlet*
+ (calendar-dlet
((dayname (diary-name-pattern calendar-day-name-array
calendar-day-abbrev-array))
(monthname (format "%s\\|\\*"
@@ -1435,7 +1435,7 @@ marks. This is intended to deal with deleted diary
entries."
(defun diary-sexp-entry (sexp entry date)
"Process a SEXP diary ENTRY for DATE."
(let ((result
- (calendar-dlet* ((date date)
+ (calendar-dlet ((date date)
(entry entry))
(if calendar-debug-sexp
(let ((debug-on-error t))
@@ -2014,6 +2014,17 @@ string to use when highlighting the day in the calendar."
(and (>= diff 0) (zerop (% diff n))
(cons mark (format entry cycle (diary-ordinal-suffix cycle))))))
+;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
+(defun diary-offset (sexp days)
+ "Offsetted diary entry. Offsets SEXP by DAYS days.
+Entry applies if the date is DAYS days after another diary-sexp SEXP."
+ (with-no-warnings (defvar date))
+ (unless (integerp days)
+ (user-error "Days must be an integer"))
+ (let ((date (calendar-gregorian-from-absolute
+ (- (calendar-absolute-from-gregorian date) days))))
+ (eval sexp)))
+
(defun diary-day-of-year ()
"Day of year and number of days remaining in the year of date diary entry."
(with-no-warnings (defvar date))
@@ -2043,7 +2054,7 @@ calendar."
(and (integerp days)
(< days 0)
(setq days (number-sequence 1 (- days))))
- (calendar-dlet* ((diary-entry (eval sexp)))
+ (calendar-dlet ((diary-entry (eval sexp)))
(cond
;; Diary entry applies on date.
((and diary-entry
@@ -2059,7 +2070,7 @@ calendar."
(when (setq diary-entry (eval sexp))
;; Discard any mark portion from diary-anniversary, etc.
(if (consp diary-entry) (setq diary-entry (cdr diary-entry)))
- (calendar-dlet* ((days days))
+ (calendar-dlet ((days days))
(mapconcat #'eval diary-remind-message "")))))
;; Diary entry may apply to one of a list of days before date.
((and (listp days) days)
@@ -2264,7 +2275,7 @@ If given, optional SYMBOL must be a prefix to entries. If
optional ABBREV-ARRAY is present, also matches the abbreviations
from this array (with or without a final `.'), in addition to the
full month names."
- (calendar-dlet*
+ (calendar-dlet
((dayname (diary-name-pattern calendar-day-name-array
calendar-day-abbrev-array t))
(monthname (format "\\(%s\\|\\*\\)"
@@ -2400,7 +2411,7 @@ return a font-lock pattern matching array of MONTHS and
marking SYMBOL."
This depends on the calendar date style."
(declare (obsolete nil "28.1"))
(concat
- (calendar-dlet*
+ (calendar-dlet
((dayname (diary-name-pattern calendar-day-name-array nil t))
(monthname (diary-name-pattern calendar-month-name-array nil t))
(day "1")
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 4bc17de..3eae2dc 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -683,7 +683,7 @@ nil, or if the date is not visible, there is no holiday."
(y displayed-year))
(calendar-increment-month m y -1)
(holiday-filter-visible-calendar
- (calendar-dlet* (year date)
+ (calendar-dlet (year date)
(list
(progn
(setq year y
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 6eb086a..eaee2e9 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -998,15 +998,15 @@ TIMESTRING and has the same result as \"9:00\"."
(defun icalendar--convert-string-for-export (string)
"Escape comma and other critical characters in STRING."
- (replace-regexp-in-string "," "\\\\," string))
+ (string-replace "," "\\," string))
(defun icalendar--convert-string-for-import (string)
"Remove escape chars for comma, semicolon etc. from STRING."
- (replace-regexp-in-string
- "\\\\n" "\n " (replace-regexp-in-string
- "\\\\\"" "\"" (replace-regexp-in-string
- "\\\\;" ";" (replace-regexp-in-string
- "\\\\," "," string)))))
+ (string-replace
+ "\\n" "\n " (string-replace
+ "\\\"" "\"" (string-replace
+ "\\;" ";" (string-replace
+ "\\," "," string)))))
;; ======================================================================
;; Export -- convert emacs-diary to iCalendar
@@ -1273,7 +1273,7 @@ Returns an alist."
(concat "\\(" icalendar-import-format-uid "\\)??"))))
;; Need the \' regexp in order to detect multi-line items
(setq s (concat "\\`"
- (replace-regexp-in-string "%s" "\\(.*?\\)" s nil t)
+ (replace-regexp-in-string "%s" "\\([^z-a]*?\\)" s nil
t)
"\\'"))
(if (string-match s summary-and-rest)
(let (cla des loc org sta url uid) ;; sum
@@ -1783,8 +1783,8 @@ entries. ENTRY-MAIN is the first line of the diary
entry."
;;BUT remove today if `diary-float'
;;expression does not hold true for today:
(when
- (null (calendar-dlet* ((date (calendar-current-date))
- (entry entry-main))
+ (null (calendar-dlet ((date (calendar-current-date))
+ (entry entry-main))
(diary-float month dayname n)))
(concat
"\nEXDATE;VALUE=DATE:"
@@ -1985,9 +1985,7 @@ Argument ICAL-FILENAME output iCalendar file.
Argument DIARY-FILENAME input `diary-file'.
Optional argument NON-MARKING determines whether events are created as
non-marking or not."
- (interactive "fImport iCalendar data from file: \n\
-Finto diary file:
-P")
+ (interactive "fImport iCalendar data from file: \nFInto diary file: \nP")
;; clean up the diary file
(save-current-buffer
;; now load and convert from the ical file
diff --git a/lisp/calendar/iso8601.el b/lisp/calendar/iso8601.el
index f22f060..1de1796 100644
--- a/lisp/calendar/iso8601.el
+++ b/lisp/calendar/iso8601.el
@@ -57,7 +57,7 @@
(defun iso8601--concat-regexps (regexps)
(mapconcat (lambda (regexp)
(concat "\\(?:"
- (replace-regexp-in-string "(" "(?:" regexp)
+ (string-replace "(" "(?:" regexp)
"\\)"))
regexps "\\|"))
@@ -92,13 +92,13 @@
"\\(Z\\|\\([+-]\\)\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?\\)")
(defconst iso8601--full-time-match
- (concat "\\(" (replace-regexp-in-string "(" "(?:" iso8601--time-match) "\\)"
+ (concat "\\(" (string-replace "(" "(?:" iso8601--time-match) "\\)"
"\\(" iso8601--zone-match "\\)?"))
(defconst iso8601--combined-match
(concat "\\(" iso8601--date-match "\\)"
"\\(?:T\\("
- (replace-regexp-in-string "(" "(?:" iso8601--time-match)
+ (string-replace "(" "(?:" iso8601--time-match)
"\\)"
"\\(" iso8601--zone-match "\\)?\\)?"))
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index 372490d..b5f2f45 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -552,7 +552,7 @@ degrees to find out if polar regions have 24 hours of sun
or only night."
Format used is given by `calendar-time-display-form'."
(let* ((time (round (* 60 time)))
(24-hours (/ time 60)))
- (calendar-dlet*
+ (calendar-dlet
((time-zone time-zone)
(minutes (format "%02d" (% time 60)))
(12-hours (format "%d" (1+ (% (+ 24-hours 11) 12))))
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 1c169b7..0aa3816 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -357,7 +357,7 @@ is output until the first non-zero unit is encountered."
(format " %s%s" name
(if (= num 1) "" "s"))))
t t string))))))
- (replace-regexp-in-string "%%" "%" string))
+ (string-replace "%%" "%" string))
(defvar seconds-to-string
(list (list 1 "ms" 0.001)
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index 4a4b65d..0b94bcb 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -35,14 +35,14 @@
;; working day), and `timeclock-when-to-leave' to calculate when you're free.
;; You'll probably want to bind the timeclock commands to some handy
-;; keystrokes. At the moment, C-x t is unused:
+;; keystrokes. Assuming C-c t is unbound, you might use:
;;
-;; (define-key ctl-x-map "ti" 'timeclock-in)
-;; (define-key ctl-x-map "to" 'timeclock-out)
-;; (define-key ctl-x-map "tc" 'timeclock-change)
-;; (define-key ctl-x-map "tr" 'timeclock-reread-log)
-;; (define-key ctl-x-map "tu" 'timeclock-update-mode-line)
-;; (define-key ctl-x-map "tw" 'timeclock-when-to-leave-string)
+;; (define-key (kbd "C-c t i") 'timeclock-in)
+;; (define-key (kbd "C-c t o") 'timeclock-out)
+;; (define-key (kbd "C-c t c") 'timeclock-change)
+;; (define-key (kbd "C-c t r") 'timeclock-reread-log)
+;; (define-key (kbd "C-c t u") 'timeclock-update-mode-line)
+;; (define-key (kbd "C-c t w") 'timeclock-when-to-leave-string)
;; If you want Emacs to display the amount of time "left" to your
;; workday in the mode-line, you can either set the value of
@@ -88,6 +88,8 @@
"The length of a work period in seconds."
:type 'integer)
+(defvar timeclock--previous-workday nil)
+
(defcustom timeclock-relative t
"Whether to make reported time relative to `timeclock-workday'.
For example, if the length of a normal workday is eight hours, and you
@@ -269,7 +271,10 @@ will be updated whenever the time display is updated.
Otherwise,
the timeclock will use its own sixty second timer to do its
updating. With prefix ARG, turn mode line display on if and only
if ARG is positive. Returns the new status of timeclock mode line
-display (non-nil means on)."
+display (non-nil means on).
+
+If using a customized `timeclock-workday' value, this should be
+set before switching this mode on."
:global t
;; cf display-time-mode.
(setq timeclock-mode-string "")
@@ -1058,7 +1063,9 @@ discrepancy, today's discrepancy, and the time worked
today."
(first t) (accum 0) (elapsed 0)
event beg last-date
last-date-limited last-date-seconds)
- (unless timeclock-discrepancy
+ (when (or (not timeclock-discrepancy)
+ ;; The length of the workday has changed, so recompute.
+ (not (equal timeclock-workday timeclock--previous-workday)))
(when (file-readable-p timeclock-file)
(setq timeclock-project-list nil
timeclock-last-project nil
@@ -1114,7 +1121,8 @@ discrepancy, today's discrepancy, and the time worked
today."
last-date-seconds
timeclock-workday))
(forward-line))
- (setq timeclock-discrepancy accum))))
+ (setq timeclock-discrepancy accum
+ timeclock--previous-workday timeclock-workday))))
(unless timeclock-last-event-workday
(setq timeclock-last-event-workday timeclock-workday))
(setq accum (or timeclock-discrepancy 0)
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index dab468d..371d106 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -191,7 +191,7 @@ The final element is \"*\", indicating an unspecified
month.")
(defconst todo-date-pattern
(let ((dayname (diary-name-pattern calendar-day-name-array nil t)))
(concat "\\(?4:\\(?5:" dayname "\\)\\|"
- (calendar-dlet*
+ (calendar-dlet
((dayname)
(monthname (format "\\(?6:%s\\)" (diary-name-pattern
todo-month-name-array
@@ -2431,7 +2431,7 @@ made in the number or names of categories."
;; changed, rebuild the date string.
(when (memq what '(year month day))
(setq ndate
- (calendar-dlet*
+ (calendar-dlet
;; Needed by calendar-date-display-form.
((year year)
(monthname monthname)
@@ -4546,7 +4546,7 @@ its priority has changed, and `same' otherwise."
(let ((bufname (buffer-name)))
(string-match "\"\\([^\"]+\\)\"" bufname)
(let* ((filename-str (substring bufname (match-beginning 1) (match-end 1)))
- (filename-base (replace-regexp-in-string ", " "-" filename-str))
+ (filename-base (string-replace ", " "-" filename-str))
(top-priorities (string-match "top priorities" bufname))
(diary-items (string-match "diary items" bufname))
(regexp-items (string-match "regexp items" bufname)))
@@ -4658,7 +4658,7 @@ strings built using the default value of
(defun todo-convert-legacy-date-time ()
"Return converted date-time string.
Helper function for `todo-convert-legacy-files'."
- (calendar-dlet*
+ (calendar-dlet
((year (match-string 1))
(month (match-string 2))
(monthname (calendar-month-name (string-to-number month) t))
@@ -6036,7 +6036,7 @@ indicating an unspecified month, day, or year.
When ARG is `day', non-nil arguments MO and YR determine the
number of the last the day of the month."
- (calendar-dlet*
+ (calendar-dlet
(year monthname month day dayname) ;Needed by calendar-date-display-form.
(when (or (not arg) (eq arg 'year))
(while (if (natnump year) (< year 1) (not (eq year '*)))
diff --git a/lisp/cedet/cedet-files.el b/lisp/cedet/cedet-files.el
index c9d557f597..f540fb5 100644
--- a/lisp/cedet/cedet-files.el
+++ b/lisp/cedet/cedet-files.el
@@ -59,7 +59,7 @@ to the file's truename, and dodging platform tricks."
;; doubling `!'s in the original name...
(setq file (subst-char-in-string
?/ ?!
- (replace-regexp-in-string "!" "!!" file)))
+ (string-replace "!" "!!" file)))
file))
(defun cedet-file-name-to-directory-name (referencefile &optional testmode)
@@ -71,7 +71,7 @@ specific conversions during tests."
;; Replace the ! with /
(setq file (subst-char-in-string ?! ?/ file))
;; Occurrences of // meant there was once a single !.
- (setq file (replace-regexp-in-string "//" "!" file))
+ (setq file (string-replace "//" "!" file))
;; Handle Windows special cases
(when (or (memq system-type '(windows-nt ms-dos)) testmode)
diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el
index 01d4f94..b321cb6 100644
--- a/lisp/cedet/ede/speedbar.el
+++ b/lisp/cedet/ede/speedbar.el
@@ -276,7 +276,7 @@ INDENT is the current indentation level."
Etags does not support this feature. TEXT will be the button
string. TOKEN will be the list, and INDENT is the current indentation
level."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -284,7 +284,7 @@ level."
(speedbar-insert-generic-list indent token
'ede-tag-expand
'ede-tag-find))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el
index f48b835..0c2fb84 100644
--- a/lisp/cedet/semantic/java.el
+++ b/lisp/cedet/semantic/java.el
@@ -141,7 +141,7 @@ corresponding compound declaration."
(semantic-tag-put-attribute clone :dereference (+ dim0 (cdr dim)))
(semantic-tag-set-bounds clone start end)))
- ((and (eq class 'type) (string-match "\\." (semantic-tag-name tag)))
+ ((and (eq class 'type) (string-search "." (semantic-tag-name tag)))
;; javap outputs files where the package name is stuck onto the class or
interface
;; name. To make this more regular, we extract the package name into a
package statement,
;; then make the class name regular.
diff --git a/lisp/cedet/semantic/sb.el b/lisp/cedet/semantic/sb.el
index debdfd1..fe981d3 100644
--- a/lisp/cedet/semantic/sb.el
+++ b/lisp/cedet/semantic/sb.el
@@ -279,7 +279,7 @@ Optional MODIFIERS is additional text needed for variables."
(defun semantic-sb-show-extra (text token indent)
"Display additional information about the token as an expansion.
TEXT TOKEN and INDENT are the details."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -288,7 +288,7 @@ TEXT TOKEN and INDENT are the details."
(narrow-to-region (point) (point))
;; Add in stuff specific to this type of token.
(semantic-sb-insert-details token (1+ indent))))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
@@ -325,7 +325,7 @@ TEXT TOKEN and INDENT are the details."
(defun semantic-sb-expand-group (text token indent)
"Expand a group which has semantic tokens.
TEXT TOKEN and INDENT are the details."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -333,7 +333,7 @@ TEXT TOKEN and INDENT are the details."
(save-restriction
(narrow-to-region (point-min) (point))
(semantic-sb-buttons-plain (1+ indent) token)))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
diff --git a/lisp/cedet/semantic/wisent/python.el
b/lisp/cedet/semantic/wisent/python.el
index 9ac4ed9..fb878dd 100644
--- a/lisp/cedet/semantic/wisent/python.el
+++ b/lisp/cedet/semantic/wisent/python.el
@@ -555,7 +555,7 @@ SELF or the instance name \"self\" if SELF is nil."
(rx-to-string
`(seq string-start ,(or self "self") "."))
name)
- (not (string-match "\\." (substring name 5)))))))
+ (not (string-search "." (substring name 5)))))))
(defun semantic-python-docstring-p (tag)
"Return non-nil, when TAG is a Python documentation string."
diff --git a/lisp/comint.el b/lisp/comint.el
index 7801261..e058e6b 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -665,7 +665,8 @@ to continue it.
\\{comint-mode-map}
Entry to this mode runs the hooks on `comint-mode-hook'."
- (setq mode-line-process '(":%s"))
+ (setq mode-line-process
+ (list (propertize ":%s" 'help-echo "Process status")))
(setq-local window-point-insertion-type t)
(setq-local comint-last-input-start (point-min-marker))
(setq-local comint-last-input-end (point-min-marker))
@@ -2157,9 +2158,9 @@ Make backspaces delete the previous character."
'comint-highlight-prompt))
(setq comint-last-prompt
(cons (copy-marker prompt-start) (point-marker)))
- (font-lock-prepend-text-property prompt-start (point)
- 'font-lock-face
- 'comint-highlight-prompt)
+ (font-lock-append-text-property prompt-start (point)
+ 'font-lock-face
+ 'comint-highlight-prompt)
(add-text-properties prompt-start (point)
`(rear-nonsticky
,comint--prompt-rear-nonsticky)))
@@ -2439,7 +2440,7 @@ carriage returns (\\r) in STRING.
This function could be in the list `comint-output-filter-functions'."
(when (let ((case-fold-search t))
(string-match comint-password-prompt-regexp
- (replace-regexp-in-string "\r" "" string)))
+ (string-replace "\r" "" string)))
(let ((comint--prompt-recursion-depth (1+ comint--prompt-recursion-depth)))
(if (> comint--prompt-recursion-depth 10)
(message "Password prompt recursion too deep")
@@ -3887,6 +3888,112 @@ REGEXP-GROUP is the regular expression group in REGEXP
to use."
;; don't advance, so ensure forward progress.
(forward-line 1)))
(nreverse results))))
+
+
+;;; OSC escape sequences (Operating System Commands)
+;;============================================================================
+;; Adding `comint-osc-process-output' to `comint-output-filter-functions'
+;; enables the interpretation of OSC escape sequences. By default, only
+;; OSC 8, for hyperlinks, is acted upon. Adding more entries to
+;; `comint-osc-handlers' allows a customized treatment of further sequences.
+
+(defvar-local comint-osc-handlers '(("7" . comint-osc-directory-tracker)
+ ("8" . comint-osc-hyperlink-handler))
+ "Alist of handlers for OSC escape sequences.
+See `comint-osc-process-output' for details.")
+
+(defvar-local comint-osc--marker nil)
+
+(defun comint-osc-process-output (_)
+ "Interpret OSC escape sequences in comint output.
+This function is intended to be added to
+`comint-output-filter-functions' in order to interpret escape
+sequences of the forms
+
+ ESC ] command ; text BEL
+ ESC ] command ; text ESC \\
+
+Specifically, every occurrence of such escape sequences is
+removed from the buffer. Then, if `command' is a key of the
+`comint-osc-handlers' alist, the corresponding value, which
+should be a function, is called with `command' and `text' as
+arguments, with point where the escape sequence was located."
+ (let ((bound (process-mark (get-buffer-process (current-buffer)))))
+ (save-excursion
+ ;; Start one char before last output to catch a possibly stray ESC
+ (goto-char (or comint-osc--marker (1- comint-last-output-start)))
+ (when (eq (char-before) ?\e) (backward-char))
+ (while (re-search-forward "\e]" bound t)
+ (let ((pos0 (match-beginning 0))
+ (code (and (re-search-forward "\\=\\([0-9A-Za-z]*\\);" bound t)
+ (match-string 1)))
+ (pos1 (point)))
+ (if (re-search-forward "\a\\|\e\\\\" bound t)
+ (let ((text (buffer-substring-no-properties
+ pos1 (match-beginning 0))))
+ (setq comint-osc--marker nil)
+ (delete-region pos0 (point))
+ (when-let ((fun (cdr (assoc-string code comint-osc-handlers))))
+ (funcall fun code text)))
+ (put-text-property pos0 bound 'invisible t)
+ (setq comint-osc--marker (copy-marker pos0))))))))
+
+;; Current directory tracking (OSC 7)
+
+(declare-function url-host "url-parse.el")
+(declare-function url-type "url-parse.el")
+(declare-function url-filename "url-parse.el")
+(defun comint-osc-directory-tracker (_ text)
+ "Update `default-directory' from OSC 7 escape sequences.
+
+This function is intended to be included as an entry of
+`comint-osc-handlers'. You should moreover arrange for your
+shell to print the appropriate escape sequence at each prompt,
+say with the following command:
+
+ printf \"\\e]7;file://%s%s\\e\\\\\" \"$HOSTNAME\" \"$PWD\"
+
+This functionality serves as an alternative to `dirtrack-mode'
+and `shell-dirtrack-mode'."
+ (let ((url (url-generic-parse-url text)))
+ (when (and (string= (url-type url) "file")
+ (or (null (url-host url))
+ (string= (url-host url) (system-name))))
+ (ignore-errors
+ (cd-absolute (url-unhex-string (url-filename url)))))))
+
+;; Hyperlink handling (OSC 8)
+
+(defvar comint-osc-hyperlink-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c\r" 'browse-url-button-open)
+ (define-key map [mouse-2] 'browse-url-button-open)
+ (define-key map [follow-link] 'mouse-face)
+ map)
+ "Keymap used by OSC 8 hyperlink buttons.")
+
+(define-button-type 'comint-osc-hyperlink
+ 'keymap comint-osc-hyperlink-map
+ 'help-echo (lambda (_ buffer pos)
+ (when-let ((url (get-text-property pos 'browse-url-data
buffer)))
+ (format "mouse-2, C-c RET: Open %s" url))))
+
+(defvar-local comint-osc-hyperlink--state nil)
+
+(defun comint-osc-hyperlink-handler (_ text)
+ "Create a hyperlink from an OSC 8 escape sequence.
+This function is intended to be included as an entry of
+`comint-osc-handlers'."
+ (when comint-osc-hyperlink--state
+ (let ((start (car comint-osc-hyperlink--state))
+ (url (cdr comint-osc-hyperlink--state)))
+ (make-text-button start (point)
+ 'type 'comint-osc-hyperlink
+ 'browse-url-data url)))
+ (setq comint-osc-hyperlink--state
+ (and (string-match ";\\(.+\\)" text)
+ (cons (point-marker) (match-string-no-properties 1 text)))))
+
;;; Converting process modes to use comint mode
;;============================================================================
diff --git a/lisp/completion.el b/lisp/completion.el
index dc0af36..93a869e 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -1917,68 +1917,64 @@ If file is not specified, then use
`save-completions-file-name'."
(clear-visited-file-modtime)
(erase-buffer)
- (let ((insert-okay-p nil)
- (buffer (current-buffer))
+ (let ((buffer (current-buffer))
string entry last-use-time
cmpl-entry cmpl-last-use-time
(current-completion-source cmpl-source-init-file)
(total-in-file 0) (total-perm 0))
;; insert the file into a buffer
(condition-case nil
- (progn (insert-file-contents filename t)
- (setq insert-okay-p t))
-
+ (insert-file-contents filename t)
(file-error
(message "File error trying to load completion file %s."
- filename)))
- ;; parse it
- (if insert-okay-p
- (progn
- (goto-char (point-min))
-
- (condition-case nil
- (while t
- (setq entry (read buffer))
- (setq total-in-file (1+ total-in-file))
- (cond
- ((and (consp entry)
- (stringp (setq string (car entry)))
- (cond
- ((eq (setq last-use-time (cdr entry)) 'T)
- ;; handle case sensitivity
- (setq total-perm (1+ total-perm))
- (setq last-use-time t))
- ((eq last-use-time t)
- (setq total-perm (1+ total-perm)))
- ((integerp last-use-time))))
- ;; Valid entry
- ;; add it in
- (setq cmpl-last-use-time
- (completion-last-use-time
- (setq cmpl-entry
- (add-completion-to-tail-if-new
string))))
- (if (or (eq last-use-time t)
- (and (> last-use-time
1000);;backcompatibility
- (not (eq cmpl-last-use-time t))
- (or (not cmpl-last-use-time)
- ;; more recent
- (> last-use-time
cmpl-last-use-time))))
- ;; update last-use-time
- (set-completion-last-use-time cmpl-entry
last-use-time)))
- (t
- ;; Bad format
- (message "Error: invalid saved completion - %s"
- (prin1-to-string entry))
- ;; try to get back in sync
- (search-forward "\n("))))
- (search-failed
- (message "End of file while reading completions."))
- (end-of-file
- (if (= (point) (point-max))
- (if (not no-message-p)
- (message "Loading completions from file %s . . .
Done."
- filename))
- (message "End of file while reading completions."))))))
+ filename))
+ (:success
+ ;; parse it
+ (goto-char (point-min))
+
+ (condition-case nil
+ (while t
+ (setq entry (read buffer))
+ (setq total-in-file (1+ total-in-file))
+ (cond
+ ((and (consp entry)
+ (stringp (setq string (car entry)))
+ (cond
+ ((eq (setq last-use-time (cdr entry)) 'T)
+ ;; handle case sensitivity
+ (setq total-perm (1+ total-perm))
+ (setq last-use-time t))
+ ((eq last-use-time t)
+ (setq total-perm (1+ total-perm)))
+ ((integerp last-use-time))))
+ ;; Valid entry
+ ;; add it in
+ (setq cmpl-last-use-time
+ (completion-last-use-time
+ (setq cmpl-entry
+ (add-completion-to-tail-if-new string))))
+ (if (or (eq last-use-time t)
+ (and (> last-use-time 1000);;backcompatibility
+ (not (eq cmpl-last-use-time t))
+ (or (not cmpl-last-use-time)
+ ;; more recent
+ (> last-use-time
cmpl-last-use-time))))
+ ;; update last-use-time
+ (set-completion-last-use-time cmpl-entry
last-use-time)))
+ (t
+ ;; Bad format
+ (message "Error: invalid saved completion - %s"
+ (prin1-to-string entry))
+ ;; try to get back in sync
+ (search-forward "\n("))))
+ (search-failed
+ (message "End of file while reading completions."))
+ (end-of-file
+ (if (= (point) (point-max))
+ (if (not no-message-p)
+ (message "Loading completions from file %s . . .
Done."
+ filename))
+ (message "End of file while reading completions."))))))
))))))
(defun completion-initialize ()
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 980a1cc..7eae2e4 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1910,7 +1910,7 @@ item in another window.\n\n"))
(widget-put (get 'editable-field 'widget-type)
:custom-show (lambda (_widget value)
(let ((pp (pp-to-string value)))
- (cond ((string-match-p "\n" pp)
+ (cond ((string-search "\n" pp)
nil)
((> (length pp) 40)
nil)
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 7df70d7..1a3e568 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -171,6 +171,8 @@ Leaving \"Default\" unchecked is equivalent with specifying
a default of
(const :tag "Right to Left" right-to-left)
(const :tag "Dynamic, according to paragraph text" nil))
"24.1")
+ (delete-auto-save-files auto-save boolean)
+ (kill-buffer-delete-auto-save-files auto-save boolean "28.1")
;; callint.c
(mark-even-if-inactive editing-basics boolean)
;; callproc.c
@@ -431,6 +433,7 @@ Leaving \"Default\" unchecked is equivalent with specifying
a default of
"21.1"
:set minibuffer-prompt-properties--setter)
(minibuffer-auto-raise minibuffer boolean)
+ (read-minibuffer-restore-windows minibuffer boolean "28.1")
;; options property set at end
(read-buffer-function minibuffer
(choice (const nil)
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index f4885d0..7457d9e 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -66,7 +66,7 @@ Do not call this mode function yourself. It is meant for
internal use."
shadow secondary-selection trailing-whitespace
font-lock-builtin-face font-lock-comment-delimiter-face
font-lock-comment-face font-lock-constant-face
- font-lock-doc-face font-lock-function-name-face
+ font-lock-doc-face font-lock-doc-markup-face font-lock-function-name-face
font-lock-keyword-face font-lock-negation-char-face
font-lock-preprocessor-face font-lock-regexp-grouping-backslash
font-lock-regexp-grouping-construct font-lock-string-face
diff --git a/lisp/delsel.el b/lisp/delsel.el
index 3c99dd2..93fdc6a 100644
--- a/lisp/delsel.el
+++ b/lisp/delsel.el
@@ -300,7 +300,7 @@ then it takes a second \\[keyboard-quit] to abort the
minibuffer."
(interactive)
(if (and delete-selection-mode (region-active-p))
(setq deactivate-mark t)
- (abort-recursive-edit)))
+ (abort-minibuffers)))
(define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit)
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 85017de..f5e467d 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -50,7 +50,7 @@
(when (string-match-p "\n\\'" pp)
(setq pp (substring pp 0 (1- (length pp)))))
- (if (and (not (string-match-p "\n" pp))
+ (if (and (not (string-search "\n" pp))
(<= (length pp) (- (window-width) (current-column))))
(insert pp)
(insert-text-button
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 060f3a8..c728642 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -508,7 +508,7 @@ has no effect on MS-Windows."
(default
(and (stringp modestr)
(string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
- (replace-regexp-in-string
+ (string-replace
"-" ""
(format "u=%s,g=%s,o=%s"
(match-string 1 modestr)
@@ -1137,12 +1137,12 @@ present. A FMT of \"\" will suppress the messaging."
("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xf -")
("\\.tar\\.xz\\'" "" "xz -dc %i | tar -xf -")
("\\.tgz\\'" "" "gzip -dc %i | tar -xf -")
- ("\\.gz\\'" "" "gunzip")
+ ("\\.gz\\'" "" "gzip -d")
("\\.lz\\'" "" "lzip -d")
("\\.Z\\'" "" "uncompress")
;; For .z, try gunzip. It might be an old gzip file,
;; or it might be from compact? pack? (which?) but gunzip handles both.
- ("\\.z\\'" "" "gunzip")
+ ("\\.z\\'" "" "gzip -d")
("\\.dz\\'" "" "dictunzip")
("\\.tbz\\'" ".tar" "bunzip2")
("\\.bz2\\'" "" "bunzip2")
@@ -1288,7 +1288,7 @@ Return nil if no change in files."
nil t)
nil t)))
;; We found an uncompression rule.
- (let ((match (string-match " " command))
+ (let ((match (string-search " " command))
(msg (concat "Uncompressing " file)))
(unless (if match
(dired-check-process msg
@@ -2769,7 +2769,7 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME
as well."
(setq dir (car (car s-alist))
s-alist (cdr s-alist))
(and (or kill-root (not (string-equal dir dirname)))
- (file-in-directory-p dir dirname)
+ (dired-in-this-tree-p dir dirname)
(dired-goto-subdir dir)
(setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
m-alist))
@@ -3002,7 +3002,7 @@ Lower levels are unaffected."
(while rest
(setq elt (car rest)
rest (cdr rest))
- (if (file-in-directory-p (directory-file-name (car elt)) dir)
+ (if (dired-in-this-tree-p (directory-file-name (car elt)) dir)
(setq rest nil
pos (dired-goto-subdir (car elt))))))
(if pos
@@ -3245,10 +3245,13 @@ REGEXP should use constructs supported by your local
`grep' command."
(list (nth 0 common) (nth 1 common))))
(require 'xref)
(defvar xref-show-xrefs-function)
+ (defvar xref-auto-jump-to-first-xref)
(with-current-buffer
(let ((xref-show-xrefs-function
;; Some future-proofing (bug#44905).
- (custom--standard-value 'xref-show-xrefs-function)))
+ (custom--standard-value 'xref-show-xrefs-function))
+ ;; Disable auto-jumping, it will mess up replacement logic.
+ xref-auto-jump-to-first-xref)
(dired-do-find-regexp from))
(xref-query-replace-in-results from to)))
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index a7bfae7..380e477 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -1044,11 +1044,11 @@ results in
len2 (length file2))
;; Find common initial file name components:
(let (next)
- (while (and (setq next (string-match "/" file1 index))
+ (while (and (setq next (string-search "/" file1 index))
(< (setq next (1+ next)) (min len1 len2))
;; For the comparison, both substrings must end in
;; `/', so NEXT is *one plus* the result of the
- ;; string-match.
+ ;; string-search.
;; E.g., consider the case of linking "/tmp/a/abc"
;; to "/tmp/abc" erroneously giving "/tmp/a" instead
;; of "/tmp/" as common initial component
@@ -1066,7 +1066,7 @@ results in
(start 0)
(count 0))
;; Count number of slashes we must compensate for ...
- (while (setq start (string-match "/" tem start))
+ (while (setq start (string-search "/" tem start))
(setq count (1+ count)
start (1+ start)))
;; ... and prepend a "../" for each slash found:
@@ -1193,7 +1193,7 @@ NOSELECT the files are merely found but not selected."
(interactive)
(require 'man)
(let* ((file (dired-get-filename))
- (manual-program (replace-regexp-in-string "\\*" "%s"
+ (manual-program (string-replace "*" "%s"
(dired-guess-shell-command
"Man command: " (list file)))))
(Man-getpage-in-background file)))
diff --git a/lisp/dired.el b/lisp/dired.el
index 28448be..958677c 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -137,10 +137,9 @@ For more details, see Info node `(emacs)ls in Lisp'."
(const :tag "Do not use --dired" nil)
(other :tag "Always use --dired" t)))
-(defcustom dired-chmod-program "chmod"
- "Name of chmod command (usually `chmod')."
- :group 'dired
- :type 'file)
+(defvar dired-chmod-program "chmod"
+ "Name of chmod command (usually `chmod').")
+(make-obsolete-variable 'dired-chmod-program nil "28.1")
(defcustom dired-touch-program "touch"
"Name of touch command (usually `touch')."
@@ -1587,8 +1586,8 @@ see `dired-use-ls-dired' for more details.")
;; because newlines in dirnames are uncommon, and people may
;; have gotten used to seeing unescaped "\" in the headers.
;; Note: adjust dired-build-subdir-alist if you change this.
- (setq dir (replace-regexp-in-string "\\\\" "\\\\" dir nil t)
- dir (replace-regexp-in-string "\n" "\\n" dir nil t)))
+ (setq dir (string-replace "\\" "\\\\" dir)
+ dir (string-replace "\n" "\\n" dir)))
;; If we used --dired and it worked, the lines are already indented.
;; Otherwise, indent them.
(unless (save-excursion
@@ -2194,6 +2193,21 @@ Do so according to the former subdir alist
OLD-SUBDIR-ALIST."
["Delete Image Tag..." image-dired-delete-tag
:help "Delete image tag from current or marked files"]))
+(defun dired-context-menu (menu)
+ (when (mouse-posn-property (event-start last-input-event) 'dired-filename)
+ (define-key menu [dired-separator] menu-bar-separator)
+ (let ((easy-menu (make-sparse-keymap "Immediate")))
+ (easy-menu-define nil easy-menu nil
+ '("Immediate"
+ ["Find This File" dired-mouse-find-file
+ :help "Edit file at mouse click"]
+ ["Find in Other Window" dired-mouse-find-file-other-window
+ :help "Edit file at mouse click in other window"]))
+ (dolist (item (reverse (lookup-key easy-menu [menu-bar immediate])))
+ (when (consp item)
+ (define-key menu (vector (car item)) (cdr item))))))
+ menu)
+
;;; Dired mode
@@ -2293,6 +2307,7 @@ Keybindings:
(append dired-dnd-protocol-alist dnd-protocol-alist)))
(add-hook 'file-name-at-point-functions #'dired-file-name-at-point nil t)
(add-hook 'isearch-mode-hook #'dired-isearch-filenames-setup nil t)
+ (add-hook 'context-menu-functions 'dired-context-menu 5 t)
(run-mode-hooks 'dired-mode-hook))
@@ -2872,7 +2887,7 @@ dired-buffers."
((null (buffer-name buf))
;; Buffer is killed - clean up:
(setq dired-buffers (delq elt dired-buffers)))
- ((file-in-directory-p (car elt) dir)
+ ((dired-in-this-tree-p (car elt) dir)
(with-current-buffer buf
(when (and (or subdirs
(assoc dir dired-subdir-alist))
@@ -2909,7 +2924,7 @@ dired-buffers."
(if (= (aref pattern (1+ set-start)) ?^)
(+ 3 set-start)
(+ 2 set-start)))
- (set-end (string-match-p "]" pattern set-cont))
+ (set-end (string-search "]" pattern set-cont))
(set (substring pattern set-start (1+ set-end))))
(setq regexp (concat regexp set))
(setq matched-in-pattern (1+ set-end))))
@@ -2947,7 +2962,7 @@ dired-buffers."
;;"Is FILE part of the directory tree starting at DIR?"
(let (case-fold-search)
(string-match-p (concat "^" (regexp-quote dir)) file)))
-(make-obsolete 'dired-in-this-tree-p 'file-in-directory-p "28.1")
+
(define-obsolete-function-alias 'dired-in-this-tree
'dired-in-this-tree-p "27.1")
@@ -3167,15 +3182,15 @@ the quoted forms of those characters.
FULL-NAME specifies the actual file name the listing must have,
as returned by `dired-get-filename'. LIMIT is the search limit."
(let (str)
- (setq str (replace-regexp-in-string "\^m" "\\^m" file nil t))
- (setq str (replace-regexp-in-string "\\\\" "\\\\" str nil t))
+ (setq str (string-replace "\^m" "\\^m" file))
+ (setq str (string-replace "\\" "\\\\" str))
(and (dired-switches-escape-p dired-actual-switches)
(string-match-p "[ \t\n]" str)
;; FIXME: to fix this for embedded control characters etc, we
;; should escape everything that `ls -b' does.
- (setq str (replace-regexp-in-string " " "\\ " str nil t)
- str (replace-regexp-in-string "\t" "\\t" str nil t)
- str (replace-regexp-in-string "\n" "\\n" str nil t)))
+ (setq str (string-replace " " "\\ " str)
+ str (string-replace "\t" "\\t" str)
+ str (string-replace "\n" "\\n" str)))
(let ((found nil)
;; filenames are preceded by SPC, this makes the search faster
;; (e.g. for the filename "-").
@@ -4479,11 +4494,17 @@ Ask means pop up a menu for the user to select one of
copy, move or link."
;;;###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 a buffer visiting a file, Dired that file's directory and
+move to that file's line in the directory listing.
+
+If the current buffer isn't visiting a file, Dired `default-directory'.
+
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
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el
index 255edd0..e0a533c 100644
--- a/lisp/dos-fns.el
+++ b/lisp/dos-fns.el
@@ -86,7 +86,7 @@ sure to obey the 8.3 limitations."
;; close to the beginning, change that to a period. This
;; is so we could salvage more characters of the original
;; name by pushing them into the extension.
- (if (and (not (string-match "\\." string))
+ (if (and (not (string-search "." string))
(> (length string) 8)
;; We don't gain anything if we put the period closer
;; than 5 chars from the beginning (5 + 3 = 8).
@@ -100,21 +100,21 @@ sure to obey the 8.3 limitations."
;; If we don't have a period in the first 8 chars, insert one.
;; This enables having 3 more characters from the original
;; name in the extension.
- (if (> (or (string-match "\\." string) (length string))
+ (if (> (or (string-search "." string) (length string))
8)
(setq string
(concat (substring string 0 8)
"."
(substring string 8))))
- (setq firstdot (or (string-match "\\." string)
+ (setq firstdot (or (string-search "." string)
(1- (length string))))
;; Truncate to 3 chars after the first period.
(if (> (length string) (+ firstdot 4))
(setq string (substring string 0 (+ firstdot 4))))
;; Change all periods except the first one into underscores.
;; (DOS doesn't allow more than one period.)
- (while (string-match "\\." string (1+ firstdot))
- (setq i (string-match "\\." string (1+ firstdot)))
+ (while (string-search "." string (1+ firstdot))
+ (setq i (string-search "." string (1+ firstdot)))
(aset string i ?_))
;; If the last character of the original filename was `~' or `#',
;; make sure the munged name ends with it also. This is so that
@@ -160,7 +160,7 @@ sure to obey the 8.3 limitations."
(strlen (length string))
(lastchar (aref string (1- strlen)))
firstdot)
- (setq firstdot (string-match "\\." string))
+ (setq firstdot (string-search "." string))
(cond
(firstdot
;; Truncate the extension to 3 characters.
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 84de69a..e18aad1 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -559,7 +559,7 @@ doubt, use whitespace."
(or fkey key) " "))))
(if prefix
(setq desc (concat (edmacro-sanitize-for-string prefix) desc)))
- (unless (string-match " " desc)
+ (unless (string-search " " desc)
(let ((times 1) (pos bind-len))
(while (not (cl-mismatch rest-mac rest-mac
:start1 0 :end1 bind-len
@@ -612,7 +612,7 @@ This function assumes that the events can be stored in a
string."
((eq (car ev) 'switch-frame))
((equal ev '(menu-bar))
(push 'menu-bar result))
- ((equal (cl-cadadr ev) '(menu-bar))
+ ((equal (cadadr ev) '(menu-bar))
(push (vector 'menu-bar (car ev)) result))
;; It would be nice to do pop-up menus, too, but not enough
;; info is recorded in macros to make this possible.
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 9d1ae70..e9a2063 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -626,8 +626,8 @@ Don't try to split prefixes that are already longer than
that.")
(radix-tree-iter-mappings
(cdr x) (lambda (s _)
(push (concat prefix s) dropped)))
- (message "Not registering prefix \"%s\" from %s.
Affects: %S"
- prefix file dropped)
+ (message "%s:0: Warning: Not registering prefix \"%s\".
Affects: %S"
+ file prefix dropped)
nil))))
prefixes)))
`(register-definition-prefixes ,file ',(sort (delq nil strings)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 247fb91..76c2e80 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -657,33 +657,33 @@ The port (if any) is omitted. IP can be a string, as
well."
OP can be one of: unpack', (pack VAL), or (length VAL) where VAL
is the name of a variable that will hold the value we need to pack.")
-(cl-defmethod bindat--type (op (_ (eql byte)))
+(cl-defmethod bindat--type (op (_ (eql 'byte)))
(bindat--pcase op
('unpack `(bindat--unpack-u8))
(`(length . ,_) `(cl-incf bindat-idx 1))
(`(pack . ,args) `(bindat--pack-u8 . ,args))))
-(cl-defmethod bindat--type (op (_ (eql uint)) n)
+(cl-defmethod bindat--type (op (_ (eql 'uint)) n)
(if (eq n 8) (bindat--type op 'byte)
(bindat--pcase op
('unpack `(bindat--unpack-uint ,n))
(`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
(`(pack . ,args) `(bindat--pack-uint ,n . ,args)))))
-(cl-defmethod bindat--type (op (_ (eql uintr)) n)
+(cl-defmethod bindat--type (op (_ (eql 'uintr)) n)
(if (eq n 8) (bindat--type op 'byte)
(bindat--pcase op
('unpack `(bindat--unpack-uintr ,n))
(`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
(`(pack . ,args) `(bindat--pack-uintr ,n . ,args)))))
-(cl-defmethod bindat--type (op (_ (eql str)) len)
+(cl-defmethod bindat--type (op (_ (eql 'str)) len)
(bindat--pcase op
('unpack `(bindat--unpack-str ,len))
(`(length . ,_) `(cl-incf bindat-idx ,len))
(`(pack . ,args) `(bindat--pack-str ,len . ,args))))
-(cl-defmethod bindat--type (op (_ (eql strz)) &optional len)
+(cl-defmethod bindat--type (op (_ (eql 'strz)) &optional len)
(bindat--pcase op
('unpack `(bindat--unpack-strz ,len))
(`(length ,val)
@@ -701,25 +701,25 @@ is the name of a variable that will hold the value we
need to pack.")
(bindat--pack-str ,len . ,args)
(bindat--pack-strz . ,args))))))
-(cl-defmethod bindat--type (op (_ (eql bits)) len)
+(cl-defmethod bindat--type (op (_ (eql 'bits)) len)
(bindat--pcase op
('unpack `(bindat--unpack-bits ,len))
(`(length . ,_) `(cl-incf bindat-idx ,len))
(`(pack . ,args) `(bindat--pack-bits ,len . ,args))))
-(cl-defmethod bindat--type (_op (_ (eql fill)) len)
+(cl-defmethod bindat--type (_op (_ (eql 'fill)) len)
`(progn (cl-incf bindat-idx ,len) nil))
-(cl-defmethod bindat--type (_op (_ (eql align)) len)
+(cl-defmethod bindat--type (_op (_ (eql 'align)) len)
`(progn (cl-callf bindat--align bindat-idx ,len) nil))
-(cl-defmethod bindat--type (op (_ (eql type)) exp)
+(cl-defmethod bindat--type (op (_ (eql 'type)) exp)
(bindat--pcase op
('unpack `(funcall (bindat--type-ue ,exp)))
(`(length . ,args) `(funcall (bindat--type-le ,exp) . ,args))
(`(pack . ,args) `(funcall (bindat--type-pe ,exp) . ,args))))
-(cl-defmethod bindat--type (op (_ (eql vec)) count &rest type)
+(cl-defmethod bindat--type (op (_ (eql 'vec)) count &rest type)
(unless type (setq type '(byte)))
(let ((fun (macroexpand-all (bindat--fun type) macroexpand-all-environment)))
(bindat--pcase op
@@ -743,10 +743,10 @@ is the name of a variable that will hold the value we
need to pack.")
`(dotimes (bindat--i ,count)
(funcall ,fun (elt ,val bindat--i)))))))
-(cl-defmethod bindat--type (op (_ (eql unit)) val)
+(cl-defmethod bindat--type (op (_ (eql 'unit)) val)
(pcase op ('unpack val) (_ nil)))
-(cl-defmethod bindat--type (op (_ (eql struct)) &rest args)
+(cl-defmethod bindat--type (op (_ (eql 'struct)) &rest args)
(apply #'bindat--type op args))
(cl-defmethod bindat--type (op (_ (eql :pack-var)) var &rest fields)
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index ad9f827..ff512cc 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -310,14 +310,6 @@ Earlier variables shadow later ones with the same name.")
;;; implementing source-level optimizers
-(defconst byte-optimize-enable-variable-constprop t
- "If non-nil, enable constant propagation through local variables.")
-
-(defconst byte-optimize-warn-eliminated-variable nil
- "Whether to warn when a variable is optimised away entirely.
-This does usually not indicate a problem and makes the compiler
-very chatty, but can be useful for debugging.")
-
(defvar byte-optimize--vars-outside-condition nil
"Alist of variables lexically bound outside conditionally executed code.
Variables here are sensitive to mutation inside the conditional code,
@@ -402,19 +394,24 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
((and for-effect
(or byte-compile-delete-errors
(not (symbolp form))
- (eq form t)))
+ (eq form t)
+ (keywordp form)))
nil)
((symbolp form)
(let ((lexvar (assq form byte-optimize--lexvars)))
- (if (cddr lexvar) ; Value available?
- (if (assq form byte-optimize--vars-outside-loop)
- ;; Cannot substitute; mark for retention to avoid the
- ;; variable being eliminated.
- (progn
- (setcar (cdr lexvar) t)
- form)
- (caddr lexvar)) ; variable value to use
- form)))
+ (cond
+ ((not lexvar) form)
+ (for-effect nil)
+ ((cddr lexvar) ; Value available?
+ (if (assq form byte-optimize--vars-outside-loop)
+ ;; Cannot substitute; mark for retention to avoid the
+ ;; variable being eliminated.
+ (progn
+ (setcar (cdr lexvar) t)
+ form)
+ ;; variable value to use
+ (caddr lexvar)))
+ (t form))))
(t form)))
(`(quote . ,v)
(if (or (not v) (cdr v))
@@ -447,10 +444,13 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(macroexp-progn (byte-optimize-body exps for-effect))
(byte-optimize-form (car exps) for-effect)))
(`(prog1 ,exp . ,exps)
- (if exps
- `(prog1 ,(byte-optimize-form exp for-effect)
- . ,(byte-optimize-body exps t))
- (byte-optimize-form exp for-effect)))
+ (let ((exp-opt (byte-optimize-form exp for-effect)))
+ (if exps
+ (let ((exps-opt (byte-optimize-body exps t)))
+ (if (macroexp-const-p exp-opt)
+ `(progn ,@exps-opt ,exp-opt)
+ `(prog1 ,exp-opt ,@exps-opt)))
+ exp-opt)))
(`(,(or `save-excursion `save-restriction `save-current-buffer) . ,exps)
;; Those subrs which have an implicit progn; it's not quite good
@@ -562,13 +562,6 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
`(catch ,(byte-optimize-form tag nil)
. ,(byte-optimize-body exps for-effect))))
- (`(ignore . ,exps)
- ;; Don't treat the args to `ignore' as being
- ;; computed for effect. We want to avoid the warnings
- ;; that might occur if they were treated that way.
- ;; However, don't actually bother calling `ignore'.
- `(prog1 nil . ,(mapcar #'byte-optimize-form exps)))
-
;; Needed as long as we run byte-optimize-form after cconv.
(`(internal-make-closure . ,_)
;; Look up free vars and mark them to be kept, so that they
@@ -601,15 +594,9 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(lexvar (assq var byte-optimize--lexvars))
(value (byte-optimize-form expr nil)))
(when lexvar
- ;; Set a new value or inhibit further substitution.
- (setcdr (cdr lexvar)
- (and
- ;; Inhibit if bound outside conditional code.
- (not (assq var byte-optimize--vars-outside-condition))
- ;; The new value must be substitutable.
- (byte-optimize--substitutable-p value)
- (list value)))
- (setcar (cdr lexvar) t)) ; Mark variable to be kept.
+ (setcar (cdr lexvar) t) ; Mark variable to be kept.
+ (setcdr (cdr lexvar) nil)) ; Inhibit further substitution.
+
(push var var-expr-list)
(push value var-expr-list))
(setq args (cddr args)))
@@ -652,8 +639,15 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(byte-optimize-constant-args form)
form))))))
-(defun byte-optimize-form (form &optional for-effect)
+(defun byte-optimize-one-form (form &optional for-effect)
"The source-level pass of the optimizer."
+ ;; Make optimiser aware of lexical arguments.
+ (let ((byte-optimize--lexvars
+ (mapcar (lambda (v) (list (car v) t))
+ byte-compile--lexical-environment)))
+ (byte-optimize-form form for-effect)))
+
+(defun byte-optimize-form (form &optional for-effect)
(while
(progn
;; First, optimize all sub-forms of this one.
@@ -676,33 +670,24 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
;; Recursively enter the optimizer for the bindings and body
;; of a let or let*. This for depth-firstness: forms that
;; are more deeply nested are optimized first.
- (if (and lexical-binding byte-optimize-enable-variable-constprop)
+ (if lexical-binding
(let* ((byte-optimize--lexvars byte-optimize--lexvars)
(new-lexvars nil)
(let-vars nil))
(dolist (binding (car form))
- (let (name expr)
- (cond ((consp binding)
- (setq name (car binding))
- (unless (symbolp name)
- (byte-compile-warn "let-bind nonvariable: `%S'" name))
- (setq expr (byte-optimize-form (cadr binding) nil)))
- ((symbolp binding)
- (setq name binding))
- (t (byte-compile-warn "malformed let binding: `%S'"
binding)))
- (let* (
- (value (and (byte-optimize--substitutable-p expr)
- (list expr)))
- (lexical (not (or (and (symbolp name)
- (special-variable-p name))
- (memq name byte-compile-bound-variables)
- (memq name byte-optimize--dynamic-vars))))
- (lexinfo (and lexical (cons name (cons nil value)))))
- (push (cons name (cons expr (cdr lexinfo))) let-vars)
- (when lexinfo
- (push lexinfo (if (eq head 'let*)
- byte-optimize--lexvars
- new-lexvars))))))
+ (let* ((name (car binding))
+ (expr (byte-optimize-form (cadr binding) nil))
+ (value (and (byte-optimize--substitutable-p expr)
+ (list expr)))
+ (lexical (not (or (special-variable-p name)
+ (memq name byte-compile-bound-variables)
+ (memq name byte-optimize--dynamic-vars))))
+ (lexinfo (and lexical (cons name (cons nil value)))))
+ (push (cons name (cons expr (cdr lexinfo))) let-vars)
+ (when lexinfo
+ (push lexinfo (if (eq head 'let*)
+ byte-optimize--lexvars
+ new-lexvars)))))
(setq byte-optimize--lexvars
(append new-lexvars byte-optimize--lexvars))
;; Walk the body expressions, which may mutate some of the records,
@@ -712,10 +697,8 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(bindings nil))
(dolist (var let-vars)
;; VAR is (NAME EXPR [KEEP [VALUE]])
- (if (and (nthcdr 3 var) (not (nth 2 var)))
- ;; Value present and not marked to be kept: eliminate.
- (when byte-optimize-warn-eliminated-variable
- (byte-compile-warn "eliminating local variable %S" (car
var)))
+ (when (or (not (nthcdr 3 var)) (nth 2 var))
+ ;; Value not present, or variable marked to be kept.
(push (list (nth 0 var) (nth 1 var)) bindings)))
(cons bindings opt-body)))
@@ -744,8 +727,12 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(while rest
(setq fe (or all-for-effect (cdr rest)))
(setq new (and (car rest) (byte-optimize-form (car rest) fe)))
- (if (or new (not fe))
- (setq result (cons new result)))
+ (when (and (consp new) (eq (car new) 'progn))
+ ;; Flatten `progn' form into the body.
+ (setq result (append (reverse (cdr new)) result))
+ (setq new (pop result)))
+ (when (or new (not fe))
+ (setq result (cons new result)))
(setq rest (cdr rest)))
(nreverse result)))
@@ -977,24 +964,25 @@ See Info node `(elisp) Integer Basics'."
(_ (byte-optimize-binary-predicate form))))
(defun byte-optimize-member (form)
- ;; Replace `member' or `memql' with `memq' if the first arg is a symbol,
- ;; or the second arg is a list of symbols. Same with fixnums.
- (if (= (length (cdr form)) 2)
- (if (or (byte-optimize--constant-symbol-p (nth 1 form))
- (byte-optimize--fixnump (nth 1 form))
- (let ((arg2 (nth 2 form)))
- (and (macroexp-const-p arg2)
- (let ((listval (eval arg2)))
- (and (listp listval)
- (not (memq nil (mapcar
- (lambda (o)
- (or (symbolp o)
- (byte-optimize--fixnump o)))
- listval))))))))
- (cons 'memq (cdr form))
- form)
- ;; Arity errors reported elsewhere.
- form))
+ (cond
+ ((/= (length (cdr form)) 2) form) ; arity error
+ ((null (nth 2 form)) ; empty list
+ `(progn ,(nth 1 form) nil))
+ ;; Replace `member' or `memql' with `memq' if the first arg is a symbol
+ ;; or fixnum, or the second arg is a list of symbols or fixnums.
+ ((or (byte-optimize--constant-symbol-p (nth 1 form))
+ (byte-optimize--fixnump (nth 1 form))
+ (let ((arg2 (nth 2 form)))
+ (and (macroexp-const-p arg2)
+ (let ((listval (eval arg2)))
+ (and (listp listval)
+ (not (memq nil (mapcar
+ (lambda (o)
+ (or (symbolp o)
+ (byte-optimize--fixnump o)))
+ listval))))))))
+ (cons 'memq (cdr form)))
+ (t form)))
(defun byte-optimize-assoc (form)
;; Replace 2-argument `assoc' with `assq', `rassoc' with `rassq',
@@ -1002,22 +990,35 @@ See Info node `(elisp) Integer Basics'."
(cond
((/= (length form) 3)
form)
+ ((null (nth 2 form)) ; empty list
+ `(progn ,(nth 1 form) nil))
((or (byte-optimize--constant-symbol-p (nth 1 form))
(byte-optimize--fixnump (nth 1 form)))
(cons (if (eq (car form) 'assoc) 'assq 'rassq)
(cdr form)))
(t (byte-optimize-constant-args form))))
+(defun byte-optimize-assq (form)
+ (cond
+ ((/= (length form) 3)
+ form)
+ ((null (nth 2 form)) ; empty list
+ `(progn ,(nth 1 form) nil))
+ (t (byte-optimize-constant-args form))))
+
(defun byte-optimize-memq (form)
- ;; (memq foo '(bar)) => (and (eq foo 'bar) '(bar))
(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))
- `(and (eq ,(nth 1 form) ',(nth 0 list))
- ',list)
- form))
+ (cond
+ ((null list) ; empty list
+ `(progn ,(nth 1 form) nil))
+ ;; (memq foo '(bar)) => (and (eq foo 'bar) '(bar))
+ ((and (eq (car-safe list) 'quote)
+ (listp (setq list (cadr list)))
+ (= (length list) 1))
+ `(and (eq ,(nth 1 form) ',(nth 0 list))
+ ',list))
+ (t form)))
;; Arity errors reported elsewhere.
form))
@@ -1054,6 +1055,8 @@ See Info node `(elisp) Integer Basics'."
(put 'member 'byte-optimizer #'byte-optimize-member)
(put 'assoc 'byte-optimizer #'byte-optimize-assoc)
(put 'rassoc 'byte-optimizer #'byte-optimize-assoc)
+(put 'assq 'byte-optimizer #'byte-optimize-assq)
+(put 'rassq 'byte-optimizer #'byte-optimize-assq)
(put '+ 'byte-optimizer #'byte-optimize-plus)
(put '* 'byte-optimizer #'byte-optimize-multiply)
@@ -1240,18 +1243,31 @@ See Info node `(elisp) Integer Basics'."
(put 'let 'byte-optimizer #'byte-optimize-letX)
(put 'let* 'byte-optimizer #'byte-optimize-letX)
(defun byte-optimize-letX (form)
- (cond ((null (nth 1 form))
- ;; No bindings
- (cons 'progn (cdr (cdr form))))
- ((or (nth 2 form) (nthcdr 3 form))
- form)
- ;; The body is nil
- ((eq (car form) 'let)
- (append '(progn) (mapcar 'car-safe (mapcar 'cdr-safe (nth 1 form)))
- '(nil)))
- (t
- (let ((binds (reverse (nth 1 form))))
- (list 'let* (reverse (cdr binds)) (nth 1 (car binds)) nil)))))
+ (pcase form
+ ;; No bindings.
+ (`(,_ () . ,body)
+ `(progn . ,body))
+
+ ;; Body is empty or just contains a constant.
+ (`(,head ,bindings . ,(or '() `(,(and const (pred macroexp-const-p)))))
+ (if (eq head 'let)
+ `(progn ,@(mapcar (lambda (binding)
+ (and (consp binding) (cadr binding)))
+ bindings)
+ ,const)
+ `(let* ,(butlast bindings) ,(cadar (last bindings)) ,const)))
+
+ ;; Body is last variable.
+ (`(,head ,bindings ,(and var (pred symbolp) (pred (not keywordp))
+ (pred (not booleanp))
+ (guard (eq var (caar (last bindings))))))
+ (if (eq head 'let)
+ `(progn ,@(mapcar (lambda (binding)
+ (and (consp binding) (cadr binding)))
+ bindings))
+ `(let* ,(butlast bindings) ,(cadar (last bindings)))))
+
+ (_ form)))
(put 'nth 'byte-optimizer #'byte-optimize-nth)
@@ -1339,6 +1355,7 @@ See Info node `(elisp) Integer Basics'."
elt encode-char exp expt encode-time error-message-string
fboundp fceiling featurep ffloor
file-directory-p file-exists-p file-locked-p file-name-absolute-p
+ file-name-concat
file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
float float-time floor format format-time-string frame-first-window
frame-root-window frame-selected-window
@@ -1353,6 +1370,7 @@ See Info node `(elisp) Integer Basics'."
local-variable-if-set-p local-variable-p locale-info
log log10 logand logb logcount logior lognot logxor lsh
make-byte-code make-list make-string make-symbol mark marker-buffer max
+ match-beginning match-end
member memq memql min minibuffer-selected-window minibuffer-window
mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string
parse-colon-path plist-get plist-member
@@ -1398,7 +1416,9 @@ See Info node `(elisp) Integer Basics'."
fixnump floatp following-char framep
get-largest-window get-lru-window
hash-table-p
- identity ignore integerp integer-or-marker-p interactive-p
+ ;; `ignore' isn't here because we don't want calls to it elided;
+ ;; see `byte-compile-ignore'.
+ identity integerp integer-or-marker-p interactive-p
invocation-directory invocation-name
keymapp keywordp
list listp
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index f615006..8ea591b 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -192,7 +192,7 @@ otherwise adds \".elc\"."
(autoload 'byte-compile-inline-expand "byte-opt")
;; This is the entry point to the lapcode optimizer pass1.
-(autoload 'byte-optimize-form "byte-opt")
+(autoload 'byte-optimize-one-form "byte-opt")
;; This is the entry point to the lapcode optimizer pass2.
(autoload 'byte-optimize-lapcode "byte-opt")
@@ -322,8 +322,9 @@ Elements of the list may be:
make-local calls to make-variable-buffer-local that may be incorrect.
mapcar mapcar called for effect.
constants let-binding of, or assignment to, constants/nonvariables.
- docstrings docstrings that are too wide (longer than 80 characters,
- or `fill-column', whichever is bigger)
+ docstrings docstrings that are too wide (longer than
+ `byte-compile-docstring-max-column' or
+ `fill-column' characters, whichever is bigger).
suspicious constructs that usually don't do what the coder wanted.
If the list begins with `not', then the remaining elements specify warnings to
@@ -1857,8 +1858,8 @@ also be compiled."
(while directories
(setq directory (car directories))
(message "Checking %s..." directory)
- (dolist (file (directory-files directory))
- (let ((source (expand-file-name file directory)))
+ (dolist (source (directory-files directory t))
+ (let ((file (file-name-nondirectory source)))
(if (file-directory-p source)
(and (not (member file '("RCS" "CVS")))
(not (eq ?\. (aref file 0)))
@@ -2455,7 +2456,7 @@ list that represents a doc string reference.
(defun byte-compile-keep-pending (form &optional handler)
(if (memq byte-optimize '(t source))
- (setq form (byte-optimize-form form t)))
+ (setq form (byte-optimize-one-form form t)))
(if handler
(let ((byte-compile--for-effect t))
;; To avoid consing up monstrously large forms at load time, we split
@@ -3155,7 +3156,7 @@ for symbols generated by the byte compiler itself."
(byte-compile-output nil)
(byte-compile-jump-tables nil))
(if (memq byte-optimize '(t source))
- (setq form (byte-optimize-form form byte-compile--for-effect)))
+ (setq form (byte-optimize-one-form form byte-compile--for-effect)))
(while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
(setq form (nth 1 form)))
;; Set up things for a lexically-bound function.
@@ -4206,6 +4207,7 @@ discarding."
(byte-defop-compiler-1 funcall)
(byte-defop-compiler-1 let)
(byte-defop-compiler-1 let* byte-compile-let)
+(byte-defop-compiler-1 ignore)
(defun byte-compile-progn (form)
(byte-compile-body-do-effect (cdr form)))
@@ -4221,6 +4223,11 @@ discarding."
(if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
,tag))
+(defun byte-compile-ignore (form)
+ (dolist (arg (cdr form))
+ (byte-compile-form arg t))
+ (byte-compile-form nil))
+
;; Return the list of items in CONDITION-PARAM that match PRED-LIST.
;; Only return items that are not in ONLY-IF-NOT-PRESENT.
(defun byte-compile-find-bound-condition (condition-param
@@ -4362,7 +4369,8 @@ Return (TAIL VAR TEST CASES), where:
(and (or (eq var switch-var) (not switch-var))
(progn
(setq switch-var var)
- (setq switch-test 'eq)
+ (setq switch-test
+ (byte-compile--common-test switch-test 'eq))
(unless (memq nil keys)
(push nil keys)
(push (cons (list nil) (or body '(t))) cases))
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index ea0b098..3abbf71 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -357,81 +357,91 @@ places where they originally did not directly appear."
"Malformed `%S' binding: %S"
letsym binder))
(setq value (cadr binder))
- (car binder)))
- (new-val
- (pcase (cconv--var-classification binder form)
- ;; Check if var is a candidate for lambda lifting.
- ((and :lambda-candidate
- (guard
- (progn
- (cl-assert (and (eq (car value) 'function)
- (eq (car (cadr value)) 'lambda)))
- (cl-assert (equal (cddr (cadr value))
- (caar cconv-freevars-alist)))
- ;; Peek at the freevars to decide whether to
λ-lift.
- (let* ((fvs (cdr (car cconv-freevars-alist)))
- (fun (cadr value))
- (funargs (cadr fun))
- (funcvars (append fvs funargs)))
+ (car binder))))
+ (cond
+ ;; Ignore bindings without a valid name.
+ ((not (symbolp var))
+ (byte-compile-warn "attempt to let-bind nonvariable `%S'" var))
+ ((or (booleanp var) (keywordp var))
+ (byte-compile-warn "attempt to let-bind constant `%S'" var))
+ (t
+ (let ((new-val
+ (pcase (cconv--var-classification binder form)
+ ;; Check if var is a candidate for lambda lifting.
+ ((and :lambda-candidate
+ (guard
+ (progn
+ (cl-assert (and (eq (car value) 'function)
+ (eq (car (cadr value))
'lambda)))
+ (cl-assert (equal (cddr (cadr value))
+ (caar cconv-freevars-alist)))
+ ;; Peek at the freevars to decide whether
+ ;; to λ-lift.
+ (let* ((fvs (cdr (car cconv-freevars-alist)))
+ (fun (cadr value))
+ (funargs (cadr fun))
+ (funcvars (append fvs funargs)))
; lambda lifting condition
- (and fvs (>= cconv-liftwhen
- (length funcvars)))))))
+ (and fvs (>= cconv-liftwhen
+ (length funcvars)))))))
; Lift.
- (let* ((fvs (cdr (pop cconv-freevars-alist)))
- (fun (cadr value))
- (funargs (cadr fun))
- (funcvars (append fvs funargs))
- (funcbody (cddr fun))
- (funcbody-env ()))
- (push `(,var . (apply-partially ,var . ,fvs)) new-env)
- (dolist (fv fvs)
- (cl-pushnew fv new-extend)
- (if (and (eq 'car-safe (car-safe (cdr (assq fv env))))
- (not (memq fv funargs)))
- (push `(,fv . (car-safe ,fv)) funcbody-env)))
- `(function (lambda ,funcvars .
- ,(cconv--convert-funcbody
- funargs funcbody funcbody-env value)))))
-
- ;; Check if it needs to be turned into a "ref-cell".
- (:captured+mutated
- ;; Declared variable is mutated and captured.
- (push `(,var . (car-safe ,var)) new-env)
- `(list ,(cconv-convert value env extend)))
-
- ;; Check if it needs to be turned into a "ref-cell".
- (:unused
- ;; Declared variable is unused.
- (if (assq var new-env) (push `(,var) new-env))
;FIXME:Needed?
- (let ((newval
- `(ignore ,(cconv-convert value env extend)))
- (msg (cconv--warn-unused-msg var "variable")))
- (if (null msg) newval
- (macroexp--warn-wrap msg newval 'lexical))))
-
- ;; Normal default case.
- (_
- (if (assq var new-env) (push `(,var) new-env))
- (cconv-convert value env extend)))))
-
- (when (and (eq letsym 'let*) (memq var new-extend))
- ;; One of the lambda-lifted vars is shadowed, so add
- ;; a reference to the outside binding and arrange to use
- ;; that reference.
- (let ((closedsym (make-symbol (format "closed-%s" var))))
- (setq new-env (cconv--remap-llv new-env var closedsym))
- (setq new-extend (cons closedsym (remq var new-extend)))
- (push `(,closedsym ,var) binders-new)))
-
- ;; We push the element after redefined free variables are
- ;; processed. This is important to avoid the bug when free
- ;; variable and the function have the same name.
- (push (list var new-val) binders-new)
-
- (when (eq letsym 'let*)
- (setq env new-env)
- (setq extend new-extend))
- )) ; end of dolist over binders
+ (let* ((fvs (cdr (pop cconv-freevars-alist)))
+ (fun (cadr value))
+ (funargs (cadr fun))
+ (funcvars (append fvs funargs))
+ (funcbody (cddr fun))
+ (funcbody-env ()))
+ (push `(,var . (apply-partially ,var . ,fvs)) new-env)
+ (dolist (fv fvs)
+ (cl-pushnew fv new-extend)
+ (if (and (eq 'car-safe (car-safe
+ (cdr (assq fv env))))
+ (not (memq fv funargs)))
+ (push `(,fv . (car-safe ,fv)) funcbody-env)))
+ `(function (lambda ,funcvars .
+ ,(cconv--convert-funcbody
+ funargs funcbody funcbody-env
value)))))
+
+ ;; Check if it needs to be turned into a "ref-cell".
+ (:captured+mutated
+ ;; Declared variable is mutated and captured.
+ (push `(,var . (car-safe ,var)) new-env)
+ `(list ,(cconv-convert value env extend)))
+
+ ;; Check if it needs to be turned into a "ref-cell".
+ (:unused
+ ;; Declared variable is unused.
+ (if (assq var new-env)
+ (push `(,var) new-env)) ;FIXME:Needed?
+ (let ((newval
+ `(ignore ,(cconv-convert value env extend)))
+ (msg (cconv--warn-unused-msg var "variable")))
+ (if (null msg) newval
+ (macroexp--warn-wrap msg newval 'lexical))))
+
+ ;; Normal default case.
+ (_
+ (if (assq var new-env) (push `(,var) new-env))
+ (cconv-convert value env extend)))))
+
+ (when (and (eq letsym 'let*) (memq var new-extend))
+ ;; One of the lambda-lifted vars is shadowed, so add
+ ;; a reference to the outside binding and arrange to use
+ ;; that reference.
+ (let ((closedsym (make-symbol (format "closed-%s" var))))
+ (setq new-env (cconv--remap-llv new-env var closedsym))
+ (setq new-extend (cons closedsym (remq var new-extend)))
+ (push `(,closedsym ,var) binders-new)))
+
+ ;; We push the element after redefined free variables are
+ ;; processed. This is important to avoid the bug when free
+ ;; variable and the function have the same name.
+ (push (list var new-val) binders-new)
+
+ (when (eq letsym 'let*)
+ (setq env new-env)
+ (setq extend new-extend))))))
+ ) ; end of dolist over binders
(when (not (eq letsym 'let*))
;; We can't do the cconv--remap-llv at the same place for let and
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 544704b..4a69df1 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1153,12 +1153,27 @@ These match if the argument is a cons cell whose car is
`eql' to VAL."
(cl-generic-define-generalizer cl--generic-eql-generalizer
100 (lambda (name &rest _) `(gethash ,name cl--generic-eql-used))
- (lambda (tag &rest _) (if (eq (car-safe tag) 'eql) (list tag))))
+ (lambda (tag &rest _) (if (eq (car-safe tag) 'eql) (cdr tag))))
(cl-defmethod cl-generic-generalizers ((specializer (head eql)))
"Support for (eql VAL) specializers.
These match if the argument is `eql' to VAL."
- (puthash (cadr specializer) specializer cl--generic-eql-used)
+ (let* ((form (cadr specializer))
+ (val (if (or (not (symbolp form)) (macroexp-const-p form))
+ (eval form t)
+ ;; FIXME: Compatibility with Emacs<28. For now emitting
+ ;; a warning would be annoying for third party packages
+ ;; which can't use the new form without breaking compatibility
+ ;; with older Emacsen, but in the future we should emit
+ ;; a warning.
+ ;; (message "Quoting obsolete `eql' form: %S" specializer)
+ form))
+ (specializers (cdr (gethash val cl--generic-eql-used))))
+ ;; The `specializers-function' needs to return all the (eql EXP) that
+ ;; were used for the same VALue (bug#49866).
+ ;; So we keep this info in `cl--generic-eql-used'.
+ (cl-pushnew specializer specializers :test #'equal)
+ (puthash val `(eql . ,specializers) cl--generic-eql-used))
(list cl--generic-eql-generalizer))
(cl--generic-prefill-dispatchers 0 (eql nil))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index cff4368..4ea583d 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2868,16 +2868,21 @@ in SLOTs. It defines a `make-NAME' constructor, a
`copy-NAME'
copier, a `NAME-p' predicate, and slot accessors named `NAME-SLOT'.
You can use the accessors to set the corresponding slots, via `setf'.
-NAME may instead take the form (NAME OPTIONS...), where each
-OPTION is either a single keyword or (KEYWORD VALUE) where
-KEYWORD can be one of `:conc-name', `:constructor', `:copier',
-`:predicate', `:type', `:named', `:initial-offset',
-`:print-function', `:noinline', or `:include'. See Info
-node `(cl)Structures' for the description of the options.
-
-Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where
-SDEFAULT is the default value of that slot and SOPTIONS are keyword-value
-pairs for that slot.
+NAME is usually a symbol, but may instead take the form (NAME
+OPTIONS...), where each OPTION is either a single keyword
+or (KEYWORD VALUE) where KEYWORD can be one of `:conc-name',
+`:constructor', `:copier', `:predicate', `:type', `:named',
+`:initial-offset', `:print-function', `:noinline', or `:include'.
+See Info node `(cl)Structures' for the description of the
+options.
+
+The first element in SLOTS can be a doc string.
+
+The rest of the elements in SLOTS is a list of SLOT elements,
+each of which should either be a symbol, or take the form (SNAME
+SDEFAULT SOPTIONS...), where SDEFAULT is the default value of
+that slot and SOPTIONS are keyword-value pairs for that slot.
+
Supported keywords for slots are:
- `:read-only': If this has a non-nil value, that slot cannot be set via
`setf'.
- `:documentation': this is a docstring describing the slot.
@@ -3283,6 +3288,7 @@ STRUCT-TYPE is a symbol naming a struct type. Return
`record',
(push (cdr x) res))
(nreverse res)))
+;;;###autoload
(defun cl-struct-slot-info (struct-type)
"Return a list of slot names of struct STRUCT-TYPE.
Each entry is a list (SLOT-NAME . OPTS), where SLOT-NAME is a
@@ -3332,14 +3338,16 @@ Of course, we really can't know that for sure, so it's
just a heuristic."
'((array . arrayp)
(atom . atom)
(base-char . characterp)
+ (bignum . bignump)
(boolean . booleanp)
(bool-vector . bool-vector-p)
(buffer . bufferp)
(character . natnump)
(char-table . char-table-p)
+ (command . commandp)
(hash-table . hash-table-p)
(cons . consp)
- (fixnum . integerp)
+ (fixnum . fixnump)
(float . floatp)
(function . functionp)
(integer . integerp)
@@ -3597,8 +3605,6 @@ The type name can then be used in `cl-typecase',
`cl-check-type', etc."
(cl-deftype extended-char () '(and character (not base-char)))
;; Define fixnum so `cl-typep' recognize it and the type check emitted
;; by `cl-the' is effective.
-(cl-deftype fixnum () 'fixnump)
-(cl-deftype bignum () 'bignump)
;;; Additional functions that we can now define because we've defined
;;; `cl-defsubst' and `cl-typep'.
@@ -3623,6 +3629,14 @@ STRUCT and SLOT-NAME are symbols. INST is a structure
instance."
"use `with-eval-after-load' instead." "28.1")
(run-hooks 'cl-macs-load-hook)
+;;; Pcase type pattern.
+
+;;;###autoload
+(pcase-defmacro cl-type (type)
+ "Pcase pattern that matches objects of TYPE.
+TYPE is a type descriptor as accepted by `cl-typep', which see."
+ `(pred (pcase--flip cl-typep ',type)))
+
;; Local variables:
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 3c55782..6a3f604 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -152,7 +152,7 @@ Integer values are handled in the `range' slot.")
(defun comp-cstrs-homogeneous (cstrs)
"Check if constraints CSTRS are all homogeneously negated or non-negated.
Return `pos' if they are all positive, `neg' if they are all
-negated or nil othewise."
+negated or nil otherwise."
(cl-loop
for cstr in cstrs
unless (comp-cstr-neg cstr)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 638d4b2..80a1da5 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -116,9 +116,9 @@ or one if there's just one execution unit."
:version "28.1")
(defcustom native-comp-async-cu-done-functions nil
- "List of functions to call after asynchronously compiling one compilation
unit.
-Called with one argument FILE, the filename used as input to
-compilation."
+ "List of functions to call when asynchronous compilation of a file is done.
+Each function is called with one argument FILE, the filename whose
+compilation has completed."
:type 'hook
:version "28.1")
@@ -1171,7 +1171,7 @@ clashes."
do (aset str j (aref byte 0))
(aset str (1+ j) (aref byte 1))
finally return str))
- (human-readable (replace-regexp-in-string
+ (human-readable (string-replace
"-" "_" orig-name))
(human-readable (replace-regexp-in-string
(rx (not (any "0-9a-z_"))) "" human-readable)))
@@ -3918,7 +3918,9 @@ display a message."
do (let* ((expr `((require 'comp)
,(when (boundp 'backtrace-line-length)
`(setf backtrace-line-length
,backtrace-line-length))
- (setf native-comp-speed ,native-comp-speed
+ (setf comp-file-preloaded-p ,comp-file-preloaded-p
+ native-compile-target-directory
,native-compile-target-directory
+ native-comp-speed ,native-comp-speed
native-comp-debug ,native-comp-debug
native-comp-verbose ,native-comp-verbose
comp-libgccjit-reproducer
,comp-libgccjit-reproducer
@@ -3936,7 +3938,9 @@ display a message."
(concat "emacs-async-comp-"
(file-name-base source-file) "-")
nil ".el"))
- (expr-strings (mapcar #'prin1-to-string expr))
+ (expr-strings (let ((print-length nil)
+ (print-level nil))
+ (mapcar #'prin1-to-string expr)))
(_ (progn
(with-temp-file temp-file
(mapc #'insert expr-strings))
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 069c7a9..f76ae3f 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -182,7 +182,11 @@ the debugger will not be entered."
(equal "initial_terminal" (terminal-name)))))
;; Don't let `inhibit-message' get in our way (especially important
if
;; `non-interactive-frame' evaluated to a non-nil value.
- (inhibit-message nil))
+ (inhibit-message nil)
+ ;; We may be entering the debugger from a context that has
+ ;; let-bound `inhibit-read-only', which means that all
+ ;; buffers would be read/write while the debugger is running.
+ (inhibit-read-only nil))
(unless non-interactive-frame
(message "Entering debugger..."))
(let (debugger-value
@@ -262,16 +266,15 @@ the debugger will not be entered."
(window-frame debugger-previous-window)))
`((previous-window . ,debugger-previous-window))))))
(setq debugger-window (selected-window))
- (if (eq debugger-previous-window debugger-window)
- (when debugger-jumping-flag
- ;; Try to restore previous height of debugger
- ;; window.
- (condition-case nil
- (window-resize
- debugger-window
- (- debugger-previous-window-height
- (window-total-height debugger-window)))
- (error nil)))
+ (when debugger-jumping-flag
+ ;; Try to restore previous height of debugger
+ ;; window.
+ (condition-case nil
+ (window-resize
+ debugger-window
+ (- debugger-previous-window-height
+ (window-total-height debugger-window)))
+ (error nil))
(setq debugger-previous-window debugger-window))
(message "")
(let ((standard-output nil)
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 6ac76f1..712fa51 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -95,6 +95,8 @@ redefine OBJECT if it is a symbol."
(re-search-forward (concat "^.*"
(regexp-quote
(concat "<"
+ (when (eq system-type
'darwin)
+ "_")
(comp-c-func-name
(subr-name obj) "F" t)
">:"))))
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 3a00fdb..d9b5ea7 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -178,9 +178,9 @@ BODY contains code to execute each time the mode is enabled
or disabled.
named variable, or a generalized variable.
PLACE can also be of the form (GET . SET), where GET is
an expression that returns the current state, and SET is
- a function that takes one argument, the new state, and
- sets it. If you specify a :variable, this function does
- not define a MODE variable (nor any of the terms used
+ a function that takes one argument, the new state, which should
+ be assigned to PLACE. If you specify a :variable, this
function
+ does not define a MODE variable (nor any of the terms used
in :variable).
:after-hook A single lisp form which is evaluated after the mode hooks
have been run. It should not be quoted.
@@ -497,8 +497,11 @@ on if the hook has explicitly disabled it.
,(concat (format "Toggle %s in all buffers.\n" pretty-name)
(internal--format-docstring-line
"With prefix ARG, enable %s if ARG is positive; otherwise, \
-disable it. If called from Lisp, enable the mode if ARG is omitted or
nil.\n\n"
+disable it.\n\n"
pretty-global-name)
+ "If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.\n\n"
(internal--format-docstring-line
"%s is enabled in all buffers where `%s' would do it.\n\n"
pretty-name turn-on)
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index f666154..360e685 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -175,16 +175,14 @@ This is expected to be bound to a mouse event."
(set symbol keymap)
(defalias symbol
(lambda (event) (:documentation doc) (interactive "@e")
- ;; FIXME: XEmacs uses popup-menu which calls the binding
- ;; while x-popup-menu only returns the selection.
(x-popup-menu event
- (or (and (symbolp symbol)
+ (or (and (symbolp keymap)
(funcall
- (or (plist-get (get symbol 'menu-prop)
+ (or (plist-get (get keymap 'menu-prop)
:filter)
#'identity)
- (symbol-function symbol)))
- symbol))))
+ (symbol-function keymap)))
+ keymap))))
;; These symbols are commands, but not interesting for users
;; to `M-x TAB'.
(function-put symbol 'completion-predicate #'ignore))
@@ -257,7 +255,7 @@ possibly preceded by keyword pairs as described in
`easy-menu-define'."
;; anyway, so we'd better not convert it at all (it will
;; be converted on the fly by easy-menu-filter-return).
menu-items
- (append menu (mapcar 'easy-menu-convert-item menu-items))))
+ (append menu (mapcar #'easy-menu-convert-item menu-items))))
(when prop
(setq menu (easy-menu-make-symbol menu 'noexp))
(put menu 'menu-prop prop))
@@ -667,7 +665,7 @@ In some cases we use that to select between the local and
global maps."
(let* ((name (if path (format "%s" (car (reverse path)))))
(newmap (make-sparse-keymap name)))
(define-key (or map (current-local-map))
- (apply 'vector (mapcar 'easy-menu-intern path))
+ (apply #'vector (mapcar #'easy-menu-intern path))
(if name (cons name newmap) newmap))
newmap))))
(or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 2aec819..7def9ff 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1731,7 +1731,7 @@ contains a circular object."
(defsubst edebug-match-body (cursor) (edebug-forms cursor))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &optional)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&optional)) cursor specs)
;; Keep matching until one spec fails.
(edebug-&optional-wrapper cursor specs #'edebug-&optional-wrapper))
@@ -1755,7 +1755,7 @@ contains a circular object."
"Handle &foo spec operators.
&foo spec operators operate on all the subsequent SPECS.")
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &rest)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&rest)) cursor specs)
;; Repeatedly use specs until failure.
(let (edebug-best-error
edebug-error-point)
@@ -1768,7 +1768,7 @@ contains a circular object."
(edebug-&optional-wrapper c (or s specs) rh)))))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &or)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&or)) cursor specs)
;; Keep matching until one spec succeeds, and return its results.
;; If none match, fail.
;; This needs to be optimized since most specs spend time here.
@@ -1792,7 +1792,7 @@ contains a circular object."
(apply #'edebug-no-match cursor "Expected one of" original-specs))
))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &interpose)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&interpose)) cursor specs)
"Compute the specs for `&interpose SPEC FUN ARGS...'.
Extracts the head of the data by matching it against SPEC,
and then matches the rest by calling (FUN HEAD PF ARGS...)
@@ -1817,7 +1817,7 @@ a sequence of elements."
(append instrumented-head (edebug-match cursor newspecs)))
,@args))))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql ¬)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '¬)) cursor specs)
;; If any specs match, then fail
(if (null (catch 'no-match
(let ((edebug-gate nil))
@@ -1829,7 +1829,7 @@ a sequence of elements."
;; This means nothing matched, so it is OK.
nil) ;; So, return nothing
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &key)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&key)) cursor specs)
;; Following specs must look like (<name> <spec>) ...
;; where <name> is the name of a keyword, and spec is its spec.
;; This really doesn't save much over the expanded form and takes time.
@@ -1842,7 +1842,7 @@ a sequence of elements."
(car (cdr pair))))
specs))))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &error)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&error)) cursor specs)
;; Signal an error, using the following string in the spec as argument.
(let ((error-string (car specs))
(edebug-error-point (edebug-before-offset cursor)))
@@ -1942,7 +1942,7 @@ a sequence of elements."
(defun edebug-match-function (_cursor)
(error "Use function-form instead of function in edebug spec"))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &define)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&define)) cursor specs)
;; Match a defining form.
;; Normally, &define is interpreted specially other places.
;; This should only be called inside of a spec list to match the remainder
@@ -1958,7 +1958,7 @@ a sequence of elements."
;; Stop backtracking here (Bug#41988).
(setq edebug-gate t)))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&name)) cursor specs)
"Compute the name for `&name SPEC FUN` spec operator.
The full syntax of that operator is:
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 08a6deb..9c842f4 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -323,7 +323,7 @@ current expansion depth."
(defun eieio-sb-expand (text class indent)
"For button TEXT, expand CLASS at the current location.
Argument INDENT is the depth of indentation."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -332,7 +332,7 @@ Argument INDENT is the depth of indentation."
(while subclasses
(eieio-class-button (car subclasses) (1+ indent))
(setq subclasses (cdr subclasses)))))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
diff --git a/lisp/emacs-lisp/eieio-speedbar.el
b/lisp/emacs-lisp/eieio-speedbar.el
index 3f2a653..86b22ca 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -344,14 +344,14 @@ The object is at indentation level INDENT."
(defun eieio-speedbar-object-expand (text token indent)
"Expand object represented by TEXT.
TOKEN is the object. INDENT is the current indentation level."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(oset token expanded t)
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
(eieio-speedbar-expand token (1+ indent)))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(oset token expanded nil)
(speedbar-delete-subblock indent))
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index 83da495..df14a5c 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -111,6 +111,8 @@
;;; Code:
+(require 'mail-parse)
+
;;; Variables:
(defgroup lisp-mnt nil
@@ -357,18 +359,11 @@ Return argument is of the form (\"HOLDER\" \"YEAR1\" ...
\"YEARN\")"
summary)))))
(defun lm-crack-address (x)
- "Split up an email address X into full name and real email address.
-The value is a cons of the form (FULLNAME . ADDRESS)."
- (cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x)
- (cons (string-trim-right (match-string 1 x))
- (match-string 2 x)))
- ((string-match "\\(\\S-+@\\S-+\\) [(<]\\(.*\\)[>)]" x)
- (cons (string-trim-right (match-string 2 x))
- (match-string 1 x)))
- ((string-match "\\S-+@\\S-+" x)
- (cons nil x))
- (t
- (cons x nil))))
+ "Split up email address(es) X into full name and real email address.
+The value is a list of elements of the form (FULLNAME . ADDRESS)."
+ (mapcar (lambda (elem)
+ (cons (cdr elem) (car elem)))
+ (mail-header-parse-addresses-lax x)))
(defun lm-authors (&optional file)
"Return the author list of file FILE, or current buffer if FILE is nil.
@@ -376,7 +371,7 @@ Each element of the list is a cons; the car is the full
name,
the cdr is an email address."
(lm-with-file file
(let ((authorlist (lm-header-multiline "author")))
- (mapcar #'lm-crack-address authorlist))))
+ (mapcan #'lm-crack-address authorlist))))
(defun lm-maintainers (&optional file)
"Return the maintainer list of file FILE, or current buffer if FILE is nil.
@@ -384,7 +379,7 @@ If the maintainers are unspecified, then return the authors.
Each element of the list is a cons; the car is the full name,
the cdr is an email address."
(lm-with-file file
- (mapcar #'lm-crack-address
+ (mapcan #'lm-crack-address
(or (lm-header-multiline "maintainer")
(lm-header-multiline "author")))))
@@ -458,7 +453,7 @@ each line."
"Return list of keywords given in file FILE."
(let ((keywords (lm-keywords file)))
(if keywords
- (if (string-match-p "," keywords)
+ (if (string-search "," keywords)
(split-string keywords ",[ \t\n]*" t "[ ]+")
(split-string keywords "[ \t\n]+" t "[ ]+")))))
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 2495277..9b38d86 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -186,12 +186,16 @@ report errors as appropriate for this kind of usage."
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 forward but still to
-a less deep spot. If ESCAPE-STRINGS is non-nil (as it is
-interactively), move out of enclosing strings as well. If
-NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to
-break out of any enclosing string instead of moving to the start
-of a list broken across multiple strings. On error, location of
-point is unspecified."
+a less deep spot.
+
+If ESCAPE-STRINGS is non-nil (as it is interactively), move out
+of enclosing strings as well.
+
+If NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer
+to break out of any enclosing string instead of moving to the
+start of a list broken across multiple strings.
+
+On error, location of point is unspecified."
(interactive "^p\nd\nd")
(up-list (- (or arg 1)) escape-strings no-syntax-crossing))
@@ -200,12 +204,16 @@ point is unspecified."
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 to
-a less deep spot. If ESCAPE-STRINGS is non-nil (as it is
-interactively), move out of enclosing strings as well. If
-NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to
-break out of any enclosing string instead of moving to the start
-of a list broken across multiple strings. On error, location of
-point is unspecified."
+a less deep spot.
+
+If ESCAPE-STRINGS is non-nil (as it is interactively), move out
+of enclosing strings as well.
+
+If NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer
+to break out of any enclosing string instead of moving to the
+end of a list broken across multiple strings.
+
+On error, location of point is unspecified."
(interactive "^p\nd\nd")
(or arg (setq arg 1))
(let ((inc (if (> arg 0) 1 -1))
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index 0522b31..b95f11e 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -79,7 +79,7 @@ of the alist has the form (KEY FUNCTION HELP), where KEY is a
character;
FUNCTION is a function of one argument (an object from LIST); and HELP
is a string. When the user presses KEY, FUNCTION is called; if it
returns non-nil, the object is considered to have been \"acted upon\",
-and `map-y-or-n-p' proceeeds to the next object from LIST. If
+and `map-y-or-n-p' proceeds to the next object from LIST. If
FUNCTION returns nil, the prompt is re-issued for the same object: this
comes in handy if FUNCTION produces some display that will allow the
user to make an intelligent decision whether the object in question
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 5c76fb9..77431f0 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -5,7 +5,7 @@
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions, lisp
-;; Version: 3.0
+;; Version: 3.1
;; Package-Requires: ((emacs "26"))
;; This file is part of GNU Emacs.
@@ -119,14 +119,16 @@ or array."
((key key) (default default) (testfn testfn))
(funcall do `(map-elt ,mgetter ,key ,default)
(lambda (v)
- `(condition-case nil
- ;; Silence warnings about the hidden 4th arg.
- (with-no-warnings (map-put! ,mgetter ,key ,v
,testfn))
- (map-not-inplace
- ,(funcall msetter
- `(map-insert ,mgetter ,key ,v))
- ;; Always return the value.
- ,v))))))))
+ (macroexp-let2 nil v v
+ `(condition-case nil
+ ;; Silence warnings about the hidden 4th arg.
+ (with-no-warnings
+ (map-put! ,mgetter ,key ,v ,testfn))
+ (map-not-inplace
+ ,(funcall msetter
+ `(map-insert ,mgetter ,key ,v))
+ ;; Always return the value.
+ ,v)))))))))
;; `testfn' is deprecated.
(advertised-calling-convention (map key &optional default) "27.1"))
;; Can't use `cl-defmethod' with `advertised-calling-convention'.
@@ -371,51 +373,65 @@ The default implementation delegates to `map-do'."
map)
t))
+(defun map--merge (merge type &rest maps)
+ "Merge into a map of TYPE all the key/value pairs in MAPS.
+MERGE is a function that takes the target MAP, a KEY, and a
+VALUE, merges KEY and VALUE into MAP, and returns the result.
+MAP may be of a type other than TYPE."
+ ;; Use a hash table internally if `type' is a list. This avoids
+ ;; both quadratic lookup behavior and the type ambiguity of nil.
+ (let* ((tolist (memq type '(list alist plist)))
+ (result (map-into (pop maps)
+ ;; Use same testfn as `map-elt' gv setter.
+ (cond ((eq type 'plist) '(hash-table :test eq))
+ (tolist '(hash-table :test equal))
+ (type)))))
+ (dolist (map maps)
+ (map-do (lambda (key value)
+ (setq result (funcall merge result key value)))
+ map))
+ ;; Convert internal representation to desired type.
+ (if tolist (map-into result type) result)))
+
(defun map-merge (type &rest maps)
"Merge into a map of TYPE all the key/value pairs in MAPS.
See `map-into' for all supported values of TYPE."
- (let ((result (map-into (pop maps) type)))
- (while maps
- ;; FIXME: When `type' is `list', we get an O(N^2) behavior.
- ;; For small tables, this is fine, but for large tables, we
- ;; should probably use a hash-table internally which we convert
- ;; to an alist in the end.
- (map-do (lambda (key value)
- (setf (map-elt result key) value))
- (pop maps)))
- result))
+ (apply #'map--merge
+ (lambda (result key value)
+ (setf (map-elt result key) value)
+ result)
+ type maps))
(defun map-merge-with (type function &rest maps)
"Merge into a map of TYPE all the key/value pairs in MAPS.
-When two maps contain the same (`eql') key, call FUNCTION on the two
+When two maps contain the same key, call FUNCTION on the two
values and use the value returned by it.
Each of MAPS can be an alist, plist, hash-table, or array.
See `map-into' for all supported values of TYPE."
- (let ((result (map-into (pop maps) type))
- (not-found (list nil)))
- (while maps
- (map-do (lambda (key value)
- (cl-callf (lambda (old)
- (if (eql old not-found)
- value
- (funcall function old value)))
- (map-elt result key not-found)))
- (pop maps)))
- result))
+ (let ((not-found (list nil)))
+ (apply #'map--merge
+ (lambda (result key value)
+ (cl-callf (lambda (old)
+ (if (eql old not-found)
+ value
+ (funcall function old value)))
+ (map-elt result key not-found))
+ result)
+ type maps)))
(cl-defgeneric map-into (map type)
"Convert MAP into a map of TYPE.")
;; FIXME: I wish there was a way to avoid this η-redex!
-(cl-defmethod map-into (map (_type (eql list)))
+(cl-defmethod map-into (map (_type (eql 'list)))
"Convert MAP into an alist."
(map-pairs map))
-(cl-defmethod map-into (map (_type (eql alist)))
+(cl-defmethod map-into (map (_type (eql 'alist)))
"Convert MAP into an alist."
(map-pairs map))
-(cl-defmethod map-into (map (_type (eql plist)))
+(cl-defmethod map-into (map (_type (eql 'plist)))
"Convert MAP into a plist."
(let (plist)
(map-do (lambda (k v) (setq plist `(,v ,k ,@plist))) map)
@@ -510,7 +526,7 @@ KEYWORD-ARGS are forwarded to `make-hash-table'."
map)
ht))
-(cl-defmethod map-into (map (_type (eql hash-table)))
+(cl-defmethod map-into (map (_type (eql 'hash-table)))
"Convert MAP into a hash-table with keys compared with `equal'."
(map--into-hash map (list :size (map-length map) :test #'equal)))
diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el
index 1125dde..3166d33 100644
--- a/lisp/emacs-lisp/memory-report.el
+++ b/lisp/emacs-lisp/memory-report.el
@@ -29,7 +29,7 @@
(require 'seq)
(require 'subr-x)
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
(defvar memory-report--type-size (make-hash-table))
@@ -230,8 +230,7 @@ by counted more than once."
(let ((total (+ (memory-report--size 'vector)
(* (memory-report--size 'object) (length value)))))
(cl-loop for elem across value
- do (setf (gethash elem counted) t)
- (cl-incf total (memory-report--object-size counted elem)))
+ do (cl-incf total (memory-report--object-size counted elem)))
total))
(cl-defmethod memory-report--object-size-1 (counted (value hash-table))
@@ -239,13 +238,24 @@ by counted more than once."
(* (memory-report--size 'object) (hash-table-size value)))))
(maphash
(lambda (key elem)
- (setf (gethash key counted) t)
- (setf (gethash elem counted) t)
(cl-incf total (memory-report--object-size counted key))
(cl-incf total (memory-report--object-size counted elem)))
value)
total))
+;; All cl-defstruct types.
+(cl-defmethod memory-report--object-size-1 (counted (value
cl-structure-object))
+ (let ((struct-type (type-of value)))
+ (apply #'+
+ (memory-report--size 'vector)
+ (mapcar (lambda (slot)
+ (if (eq (car slot) 'cl-tag-slot)
+ 0
+ (memory-report--object-size
+ counted
+ (cl-struct-slot-value struct-type (car slot) value))))
+ (cl-struct-slot-info struct-type)))))
+
(defun memory-report--format (bytes)
(setq bytes (/ bytes 1024.0))
(let ((units '("KiB" "MiB" "GiB" "TiB")))
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 4804e85..41a9c72 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -85,42 +85,50 @@ Each element has the form (WHERE BYTECODE STACK) where:
(if (eq bytecode (cadr elem)) (setq where (car elem))))
where))
+(defun advice--make-single-doc (flist function macrop)
+ (let ((where (advice--where flist)))
+ (concat
+ (format "This %s has %s advice: "
+ (if macrop "macro" "function")
+ where)
+ (let ((fun (advice--car flist)))
+ (if (symbolp fun) (format-message "`%S'." fun)
+ (let* ((name (cdr (assq 'name (advice--props flist))))
+ (doc (documentation fun t))
+ (usage (help-split-fundoc doc function)))
+ (if usage (setq doc (cdr usage)))
+ (if name
+ (if doc
+ (format "%s\n%s" name doc)
+ (format "%s" name))
+ (or doc "No documentation")))))
+ "\n")))
+
(defun advice--make-docstring (function)
"Build the raw docstring for FUNCTION, presumably advised."
(let* ((flist (indirect-function function))
(docfun nil)
(macrop (eq 'macro (car-safe flist)))
(docstring nil))
- (if macrop (setq flist (cdr flist)))
- (while (advice--p flist)
- (let ((doc (aref flist 4))
- (where (advice--where flist)))
+ (when macrop
+ (setq flist (cdr flist)))
+ (if (and (autoloadp flist)
+ (get function 'advice--pending))
+ (setq docstring
+ (advice--make-single-doc (get function 'advice--pending)
+ function macrop))
+ (while (advice--p flist)
;; Hack attack! For advices installed before calling
;; Snarf-documentation, the integer offset into the DOC file will not
;; be installed in the "core unadvised function" but in the advice
;; object instead! So here we try to undo the damage.
- (if (integerp doc) (setq docfun flist))
- (setq docstring
- (concat
- docstring
- (format "This %s has %s advice: "
- (if macrop "macro" "function")
- where)
- (let ((fun (advice--car flist)))
- (if (symbolp fun) (format-message "`%S'." fun)
- (let* ((name (cdr (assq 'name (advice--props flist))))
- (doc (documentation fun t))
- (usage (help-split-fundoc doc function)))
- (if usage (setq doc (cdr usage)))
- (if name
- (if doc
- (format "%s\n%s" name doc)
- (format "%s" name))
- (or doc "No documentation")))))
- "\n")))
- (setq flist (advice--cdr flist)))
- (if docstring (setq docstring (concat docstring "\n")))
- (unless docfun (setq docfun flist))
+ (when (integerp (aref flist 4))
+ (setq docfun flist))
+ (setq docstring (concat docstring (advice--make-single-doc
+ flist function macrop))
+ flist (advice--cdr flist))))
+ (unless docfun
+ (setq docfun flist))
(let* ((origdoc (unless (eq function docfun) ;Avoid inf-loops.
(documentation docfun t)))
(usage (help-split-fundoc origdoc function)))
@@ -131,7 +139,12 @@ Each element has the form (WHERE BYTECODE STACK) where:
(if (stringp arglist) t
(help--make-usage-docstring function arglist)))
(setq origdoc (cdr usage)) (car usage)))
- (help-add-fundoc-usage (concat docstring origdoc) usage))))
+ (help-add-fundoc-usage (concat origdoc
+ (if (string-suffix-p "\n" origdoc)
+ "\n"
+ "\n\n")
+ docstring)
+ usage))))
(defun advice-eval-interactive-spec (spec)
"Evaluate the interactive spec SPEC."
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index f1daa8d..617e941 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1120,7 +1120,7 @@ is wrapped around any parts requiring it."
(declare-function lm-header-multiline "lisp-mnt" (header))
(declare-function lm-homepage "lisp-mnt" (&optional file))
(declare-function lm-keywords-list "lisp-mnt" (&optional file))
-(declare-function lm-maintainer "lisp-mnt" (&optional file))
+(declare-function lm-maintainers "lisp-mnt" (&optional file))
(declare-function lm-authors "lisp-mnt" (&optional file))
(defun package-buffer-info ()
@@ -1166,7 +1166,10 @@ boundaries."
:kind 'single
:url homepage
:keywords keywords
- :maintainer (lm-maintainer)
+ :maintainer
+ ;; For backward compatibility, use a single string if there's only
+ ;; one maintainer (the most common case).
+ (let ((maints (lm-maintainers))) (if (cdr maints) maints (car maints)))
:authors (lm-authors)))))
(defun package--read-pkg-desc (kind)
@@ -1366,11 +1369,9 @@ errors signaled by ERROR-FORM or by BODY).
(kill-buffer buffer)
(goto-char (point-min))))))
(package--unless-error body
- (let ((url (expand-file-name file url)))
- (unless (file-name-absolute-p url)
- (error "Location %s is not a url nor an absolute file name"
- url))
- (insert-file-contents-literally url)))))
+ (unless (file-name-absolute-p url)
+ (error "Location %s is not a url nor an absolute file name" url))
+ (insert-file-contents-literally (expand-file-name file url)))))
(define-error 'bad-signature "Failed to verify signature")
@@ -4154,6 +4155,10 @@ activations need to be changed, such as when
`package-load-list' is modified."
(package-activated-list ())
;; Make sure we can load this file without load-source-file-function.
(coding-system-for-write 'emacs-internal)
+ ;; Ensure that `pp' and `prin1-to-string' calls further down
+ ;; aren't truncated.
+ (print-length nil)
+ (print-level nil)
(Info-directory-list '("")))
(dolist (elt package-alist)
(condition-case err
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 006517d..63b187b 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -317,6 +317,46 @@ of the elements of LIST is performed as if by `pcase-let'.
(pcase-let* ((,(car spec) ,tmpvar))
,@body)))))
+;;;###autoload
+(defmacro pcase-setq (pat val &rest args)
+ "Assign values to variables by destructuring with `pcase'.
+PATTERNS are normal `pcase' patterns, and VALUES are expression.
+
+Evaluation happens sequentially as in `setq' (not in parallel).
+
+An example: (pcase-setq `((,a) [(,b)]) '((1) [(2)]))
+
+VAL is presumed to match PAT. Failure to match may signal an error or go
+undetected, binding variables to arbitrary values, such as nil.
+
+\(fn PATTERNS VALUE PATTERN VALUES ...)"
+ (declare (debug (&rest [pcase-PAT form])))
+ (cond
+ (args
+ (let ((arg-length (length args)))
+ (unless (= 0 (mod arg-length 2))
+ (signal 'wrong-number-of-arguments
+ (list 'pcase-setq (+ 2 arg-length)))))
+ (let ((result))
+ (while args
+ (push `(pcase-setq ,(pop args) ,(pop args))
+ result))
+ `(progn
+ (pcase-setq ,pat ,val)
+ ,@(nreverse result))))
+ ((pcase--trivial-upat-p pat)
+ `(setq ,pat ,val))
+ (t
+ (pcase-compile-patterns
+ val
+ `((,pat
+ . ,(lambda (varvals &rest _)
+ `(setq ,@(mapcan (lambda (varval)
+ (let ((var (car varval))
+ (val (cadr varval)))
+ (list var val)))
+ varvals))))
+ (pcase--dontcare . ignore))))))
(defun pcase--trivial-upat-p (upat)
(and (symbolp upat) (not (memq upat pcase--dontcare-upats))))
diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el
index fb65975..a529ed0 100644
--- a/lisp/emacs-lisp/radix-tree.el
+++ b/lisp/emacs-lisp/radix-tree.el
@@ -240,7 +240,7 @@ PREFIX is only used internally."
(declare-function map-apply "map" (function map))
(defun radix-tree-from-map (map)
- ;; Aka (cl-defmethod map-into (map (type (eql radix-tree)))) ...)
+ ;; Aka (cl-defmethod map-into (map (type (eql 'radix-tree)))) ...)
(require 'map)
(let ((rt nil))
(map-apply (lambda (k v) (setq rt (radix-tree-insert rt k v))) map)
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 396949d..aec438e 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -436,7 +436,7 @@ provided in the Commentary section of this library."
(let ((re (with-output-to-string
(print (reb-target-binding reb-regexp)))))
(setq re (substring re 1 (1- (length re))))
- (setq re (replace-regexp-in-string "\n" "\\n" re nil t))
+ (setq re (string-replace "\n" "\\n" re))
(kill-new re)
(message "Copied regexp `%s' to kill-ring" re)))
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 071d390..c48052d 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1266,7 +1266,8 @@ Zero-width assertions: these all match the empty string
in specific places.
(literal EXPR) Match the literal string from evaluating EXPR at run time.
(regexp EXPR) Match the string regexp from evaluating EXPR at run time.
-(eval EXPR) Match the rx sexp from evaluating EXPR at compile time.
+(eval EXPR) Match the rx sexp from evaluating EXPR at macro-expansion
+ (compile) time.
Additional constructs can be defined using `rx-define' and `rx-let',
which see.
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 6c15463..f0dc283 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -93,6 +93,14 @@ name to be bound to the rest of SEQUENCE."
(declare (indent 2) (debug (sexp form body)))
`(pcase-let ((,(seq--make-pcase-patterns args) ,sequence))
,@body))
+
+(defmacro seq-setq (args sequence)
+ "Assign to the variables in ARGS the elements of SEQUENCE.
+
+ARGS can also include the `&rest' marker followed by a variable
+name to be bound to the rest of SEQUENCE."
+ (declare (debug (sexp form)))
+ `(pcase-setq ,(seq--make-pcase-patterns args) ,sequence))
;;; Basic seq functions that have to be implemented by new sequence types
@@ -394,14 +402,15 @@ found or not."
(setq count (+ 1 count))))
count))
-(cl-defgeneric seq-contains (sequence elt &optional testfn)
- "Return the first element in SEQUENCE that is equal to ELT.
+(with-suppressed-warnings ((obsolete seq-contains))
+ (cl-defgeneric seq-contains (sequence elt &optional testfn)
+ "Return the first element in SEQUENCE that is equal to ELT.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
- (declare (obsolete seq-contains-p "27.1"))
- (seq-some (lambda (e)
- (when (funcall (or testfn #'equal) elt e)
- e))
- sequence))
+ (declare (obsolete seq-contains-p "27.1"))
+ (seq-some (lambda (e)
+ (when (funcall (or testfn #'equal) elt e)
+ e))
+ sequence)))
(cl-defgeneric seq-contains-p (sequence elt &optional testfn)
"Return non-nil if SEQUENCE contains an element equal to ELT.
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 22439f4..7d4a69f 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -273,8 +273,16 @@ There can be any number of :example/:result elements."
:eval (file-relative-name "/tmp/foo" "/tmp"))
(make-temp-name
:eval (make-temp-name "/tmp/foo-"))
+ (file-name-concat
+ :eval (file-name-concat "/tmp/" "foo")
+ :eval (file-name-concat "/tmp" "foo")
+ :eval (file-name-concat "/tmp" "foo" "bar/" "zot")
+ :eval (file-name-concat "/tmp" "~"))
(expand-file-name
- :eval (expand-file-name "foo" "/tmp/"))
+ :eval (expand-file-name "foo" "/tmp/")
+ :eval (expand-file-name "foo" "/tmp///")
+ :eval (expand-file-name "foo" "/tmp/foo/.././")
+ :eval (expand-file-name "~" "/tmp/"))
(substitute-in-file-name
:eval (substitute-in-file-name "$HOME/foo"))
"Directory Functions"
@@ -692,6 +700,8 @@ There can be any number of :example/:result elements."
(match-substitute-replacement
:no-eval (match-substitute-replacement "new")
:eg-result "new")
+ (replace-regexp-in-region
+ :no-value (replace-regexp-in-region "[0-9]+" "Num \\&"))
"Utilities"
(regexp-quote
:eval (regexp-quote "foo.*bar"))
@@ -886,6 +896,10 @@ There can be any number of :example/:result elements."
:no-value (erase-buffer))
(insert
:no-value (insert "This string will be inserted in the buffer\n"))
+ (subst-char-in-region
+ :no-eval "(subst-char-in-region (point-min) (point-max) ?+ ?-)")
+ (replace-string-in-region
+ :no-value (replace-string-in-region "foo" "bar"))
"Locking"
(lock-buffer
:no-value (lock-buffer "/tmp/foo"))
@@ -1309,7 +1323,8 @@ Example:
"Keymap for `shortdoc-mode'.")
(define-derived-mode shortdoc-mode special-mode "shortdoc"
- "Mode for shortdoc.")
+ "Mode for shortdoc."
+ :interactive nil)
(defun shortdoc--goto-section (arg sym &optional reverse)
(unless (natnump arg)
@@ -1324,26 +1339,26 @@ Example:
(defun shortdoc-next (&optional arg)
"Move cursor to the next function.
With ARG, do it that many times."
- (interactive "p")
+ (interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-function))
(defun shortdoc-previous (&optional arg)
"Move cursor to the previous function.
With ARG, do it that many times."
- (interactive "p")
+ (interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-function t)
(backward-char 1))
(defun shortdoc-next-section (&optional arg)
"Move cursor to the next section.
With ARG, do it that many times."
- (interactive "p")
+ (interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-section))
(defun shortdoc-previous-section (&optional arg)
"Move cursor to the previous section.
With ARG, do it that many times."
- (interactive "p")
+ (interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-section t)
(forward-line -2))
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index ab3cb3c..d775f15 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -1407,7 +1407,9 @@ BASE-POS is the position relative to which offsets should
be applied."
(funcall smie-rules-function method token)))
(defun smie-indent-forward-token ()
- "Skip token forward and return it, along with its levels."
+ "Skip token forward and return it, along with its levels.
+Point should be between tokens when calling this function (i.e.,
+not in the middle of a string/comment)."
(let ((tok (funcall smie-forward-token-function)))
(cond
((< 0 (length tok)) (assoc tok smie-grammar))
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 468d124..4204d20 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -240,6 +240,7 @@ carriage return."
(substring string 0 (- (length string) (length suffix)))
string))
+;;;###autoload
(defun string-clean-whitespace (string)
"Clean up whitespace in STRING.
All sequences of whitespaces in STRING are collapsed into a
diff --git a/lisp/emacs-lisp/tabulated-list.el
b/lisp/emacs-lisp/tabulated-list.el
index 04f3b70..f148bc1 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -214,6 +214,8 @@ If ADVANCE is non-nil, move forward by one line afterwards."
special-mode-map))
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
+ (define-key map (kbd "M-<left>") 'tabulated-list-previous-column)
+ (define-key map (kbd "M-<right>") 'tabulated-list-next-column)
(define-key map "S" 'tabulated-list-sort)
(define-key map "}" 'tabulated-list-widen-current-column)
(define-key map "{" 'tabulated-list-narrow-current-column)
@@ -269,12 +271,15 @@ Populated by `tabulated-list-init-header'.")
(defun tabulated-list-init-header ()
"Set up header line for the Tabulated List buffer."
;; FIXME: Should share code with tabulated-list-print-col!
- (let ((x (max tabulated-list-padding 0))
- (button-props `(help-echo "Click to sort by column"
- mouse-face header-line-highlight
- keymap ,tabulated-list-sort-button-map))
- (len (length tabulated-list-format))
- (cols nil))
+ (let* ((x (max tabulated-list-padding 0))
+ (button-props `(help-echo "Click to sort by column"
+ mouse-face header-line-highlight
+ keymap ,tabulated-list-sort-button-map))
+ (len (length tabulated-list-format))
+ ;; Pre-compute width for available-space compution.
+ (hcols (mapcar #'car tabulated-list-format))
+ (tabulated-list--near-rows (list hcols hcols))
+ (cols nil))
(if display-line-numbers
(setq x (+ x (tabulated-list-line-number-width))))
(push (propertize " " 'display `(space :align-to ,x)) cols)
@@ -288,9 +293,17 @@ Populated by `tabulated-list-init-header'.")
(props (nthcdr 3 col))
(pad-right (or (plist-get props :pad-right) 1))
(right-align (plist-get props :right-align))
- (next-x (+ x pad-right width)))
- (when (and (>= lablen 3) (> lablen width) not-last-col)
- (setq label (truncate-string-to-width label (- lablen 1) nil nil t)))
+ (next-x (+ x pad-right width))
+ (available-space
+ (and not-last-col
+ (if right-align
+ width
+ (tabulated-list--available-space width n)))))
+ (when (and (>= lablen 3)
+ not-last-col
+ (> lablen available-space))
+ (setq label (truncate-string-to-width label available-space
+ nil nil t)))
(push
(cond
;; An unsortable column
@@ -479,6 +492,8 @@ changing `tabulated-list-sort-key'."
(forward-line 1)
(delete-region old (point))))))
(setq entries (cdr entries)))
+ (when update
+ (delete-region (point) (point-max)))
(set-buffer-modified-p nil)
;; If REMEMBER-POS was specified, move to the "old" location.
(if saved-pt
@@ -510,6 +525,17 @@ of column descriptors."
beg (point)
`(tabulated-list-id ,id tabulated-list-entry ,cols))))
+(defun tabulated-list--available-space (width n)
+ (let* ((next-col-format (aref tabulated-list-format (1+ n)))
+ (next-col-right-align (plist-get (nthcdr 3 next-col-format)
+ :right-align))
+ (next-col-width (nth 1 next-col-format)))
+ (if next-col-right-align
+ (- (+ width next-col-width)
+ (min next-col-width
+ (tabulated-list--col-local-max-widths (1+ n))))
+ width)))
+
(defun tabulated-list-print-col (n col-desc x)
"Insert a specified Tabulated List entry at point.
N is the column number, COL-DESC is a column descriptor (see
@@ -526,20 +552,10 @@ Return the column number after insertion."
(help-echo (concat (car format) ": " label))
(opoint (point))
(not-last-col (< (1+ n) (length tabulated-list-format)))
- available-space)
- (when not-last-col
- (let* ((next-col-format (aref tabulated-list-format (1+ n)))
- (next-col-right-align (plist-get (nthcdr 3 next-col-format)
- :right-align))
- (next-col-width (nth 1 next-col-format)))
- (setq available-space
- (if (and (not right-align)
- next-col-right-align)
- (-
- (+ width next-col-width)
- (min next-col-width
- (tabulated-list--col-local-max-widths (1+ n))))
- width))))
+ (available-space (and not-last-col
+ (if right-align
+ width
+ (tabulated-list--available-space width n)))))
;; Truncate labels if necessary (except last column).
;; Don't truncate to `width' if the next column is align-right
;; and has some space left, truncate to `available-space' instead.
@@ -740,6 +756,28 @@ Interactively, N is the prefix numeric argument, and
defaults to
(setq-local tabulated-list--current-lnum-width lnum-width)
(tabulated-list-init-header)))))
+(defun tabulated-list-next-column (&optional arg)
+ "Go to the start of the next column after point on the current line.
+If ARG is provided, move that many columns."
+ (interactive "p")
+ (dotimes (_ (or arg 1))
+ (let ((next (or (next-single-property-change
+ (point) 'tabulated-list-column-name)
+ (point-max))))
+ (when (<= next (line-end-position))
+ (goto-char next)))))
+
+(defun tabulated-list-previous-column (&optional arg)
+ "Go to the start of the column point is in on the current line.
+If ARG is provided, move that many columns."
+ (interactive "p")
+ (dotimes (_ (or arg 1))
+ (let ((prev (or (previous-single-property-change
+ (point) 'tabulated-list-column-name)
+ 1)))
+ (unless (< prev (line-beginning-position))
+ (goto-char prev)))))
+
;;; The mode definition:
(defvar tabulated-list--original-order nil)
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 36de29a..44d70cd 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -29,10 +29,12 @@
(eval-when-compile (require 'cl-lib))
+;; If you change this structure, you also have to change `timerp'
+;; (below) and decode_timer in keyboard.c.
(cl-defstruct (timer
(:constructor nil)
(:copier nil)
- (:constructor timer-create ())
+ (:constructor timer--create ())
(:type vector)
(:conc-name timer--))
;; nil if the timer is active (waiting to be triggered),
@@ -46,11 +48,25 @@
repeat-delay
function args ;What to do when triggered.
idle-delay ;If non-nil, this is an idle-timer.
- psecs)
+ psecs
+ ;; A timer may be created with `t' as the TIME, which means that we
+ ;; want to run at specific integral multiples of `repeat-delay'. We
+ ;; then have to recompute this (because the machine may have gone to
+ ;; sleep, etc).
+ integral-multiple)
+
+(defun timer-create ()
+ ;; BEWARE: This is not an eta-redex, because `timer--create' is inlinable
+ ;; whereas `timer-create' should not be because we don't want to
+ ;; hardcode the shape of timers in other .elc files.
+ (timer--create))
(defun timerp (object)
"Return t if OBJECT is a timer."
- (and (vectorp object) (= (length object) 9)))
+ (and (vectorp object)
+ ;; Timers are now ten elements, but old .elc code may have
+ ;; shorter versions of `timer-create'.
+ (<= 9 (length object) 10)))
(defsubst timer--check (timer)
(or (timerp timer) (signal 'wrong-type-argument (list #'timerp timer))))
@@ -284,6 +300,14 @@ This function is called, by name, directly by the C code."
(if (> repeats timer-max-repeats)
(timer-inc-time timer (* (timer--repeat-delay timer)
repeats)))))
+ ;; If we want integral multiples, we have to recompute
+ ;; the repetition.
+ (when (and (> (length timer) 9) ; Backwards compatible.
+ (timer--integral-multiple timer)
+ (not (timer--idle-delay timer)))
+ (setf (timer--time timer)
+ (timer-next-integral-multiple-of-time
+ (current-time) (timer--repeat-delay timer))))
;; Place it back on the timer-list before running
;; timer--function, so it can cancel-timer itself.
(timer-activate timer t cell)
@@ -340,45 +364,44 @@ This function returns a timer object which you can use in
`cancel-timer'."
(interactive "sRun at time: \nNRepeat interval: \naFunction: ")
- (or (null repeat)
- (and (numberp repeat) (< 0 repeat))
- (error "Invalid repetition interval"))
+ (when (and repeat
+ (numberp repeat)
+ (< repeat 0))
+ (error "Invalid repetition interval"))
- ;; Special case: nil means "now" and is useful when repeating.
- (if (null time)
+ (let ((timer (timer-create)))
+ ;; Special case: nil means "now" and is useful when repeating.
+ (unless time
(setq time (current-time)))
- ;; Special case: t means the next integral multiple of REPEAT.
- (if (and (eq time t) repeat)
- (setq time (timer-next-integral-multiple-of-time (current-time) repeat)))
+ ;; Special case: t means the next integral multiple of REPEAT.
+ (when (and (eq time t) repeat)
+ (setq time (timer-next-integral-multiple-of-time (current-time) repeat))
+ (setf (timer--integral-multiple timer) t))
- ;; Handle numbers as relative times in seconds.
- (if (numberp time)
+ ;; Handle numbers as relative times in seconds.
+ (when (numberp time)
(setq time (timer-relative-time nil time)))
- ;; Handle relative times like "2 hours 35 minutes"
- (if (stringp time)
- (let ((secs (timer-duration time)))
- (if secs
- (setq time (timer-relative-time nil secs)))))
-
- ;; Handle "11:23pm" and the like. Interpret it as meaning today
- ;; which admittedly is rather stupid if we have passed that time
- ;; already. (Though only Emacs hackers hack Emacs at that time.)
- (if (stringp time)
- (progn
- (require 'diary-lib)
- (let ((hhmm (diary-entry-time time))
- (now (decode-time)))
- (if (>= hhmm 0)
- (setq time
- (encode-time 0 (% hhmm 100) (/ hhmm 100)
- (decoded-time-day now)
- (decoded-time-month now)
- (decoded-time-year now)
- (decoded-time-zone now)))))))
+ ;; Handle relative times like "2 hours 35 minutes".
+ (when (stringp time)
+ (when-let ((secs (timer-duration time)))
+ (setq time (timer-relative-time nil secs))))
+
+ ;; Handle "11:23pm" and the like. Interpret it as meaning today
+ ;; which admittedly is rather stupid if we have passed that time
+ ;; already. (Though only Emacs hackers hack Emacs at that time.)
+ (when (stringp time)
+ (require 'diary-lib)
+ (let ((hhmm (diary-entry-time time))
+ (now (decode-time)))
+ (when (>= hhmm 0)
+ (setq time (encode-time 0 (% hhmm 100) (/ hhmm 100)
+ (decoded-time-day now)
+ (decoded-time-month now)
+ (decoded-time-year now)
+ (decoded-time-zone now))))))
- (let ((timer (timer-create)))
(timer-set-time timer time repeat)
(timer-set-function timer function args)
(timer-activate timer)
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 67de690..36b275e 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -307,7 +307,7 @@ entirely by setting `warning-suppress-types' or
'type 'warning-suppress-log-warning
'warning-type type))
(funcall newline)
- (when (and warning-fill-prefix (not (string-match "\n" message)))
+ (when (and warning-fill-prefix (not (string-search "\n" message)))
(let ((fill-prefix warning-fill-prefix)
(fill-column warning-fill-column))
(fill-region start (point))))
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 5b2fa04..55930e7 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -1100,7 +1100,7 @@ reversed."
(setq viper-keep-reading-filename nil
val (read-file-name (concat prompt str) nil default-directory))
(setq val (expand-file-name val))
- (if (and (string-match " " val)
+ (if (and (string-search " " val)
(ex-cmd-accepts-multiple-files-p ex-token))
(setq val (concat "\"" val "\"")))
(setq str (concat str (if (equal val "") "" " ")
@@ -2300,10 +2300,10 @@ Type `mak ' (including the space) to run make with no
args."
(defun ex-print-display-lines (lines)
(cond
;; String doesn't contain a newline.
- ((not (string-match "\n" lines))
+ ((not (string-search "\n" lines))
(message "%s" lines))
;; String contains only one newline at the end. Strip it off.
- ((= (string-match "\n" lines) (1- (length lines)))
+ ((= (string-search "\n" lines) (1- (length lines)))
(message "%s" (substring lines 0 -1)))
;; String spans more than one line. Use a temporary buffer.
(t
diff --git a/lisp/env.el b/lisp/env.el
index 51247f1..83f43d1 100644
--- a/lisp/env.el
+++ b/lisp/env.el
@@ -44,7 +44,7 @@ If it is also not t, RET does not exit if it does non-null
completion."
(completing-read prompt
(mapcar (lambda (enventry)
(let ((str (substring enventry 0
- (string-match "=" enventry))))
+ (string-search "=" enventry))))
(if (multibyte-string-p str)
(decode-coding-string
str locale-coding-system t)
@@ -184,7 +184,7 @@ a side-effect."
(setq variable (encode-coding-string variable locale-coding-system)))
(if (and value (multibyte-string-p value))
(setq value (encode-coding-string value locale-coding-system)))
- (if (string-match-p "=" variable)
+ (if (string-search "=" variable)
(error "Environment variable name `%s' contains `='" variable))
(if (string-equal "TZ" variable)
(set-time-zone-rule value))
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index bed0c06..b9dd437 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -219,7 +219,7 @@ If no one is selected, symmetric encryption will be
performed. "
(epa-mail--find-usable-key
(epg-list-keys
(epg-make-context epa-protocol)
- (if (string-match "@" recipient)
+ (if (string-search "@" recipient)
(concat "<" recipient ">")
recipient))
'encrypt)))
diff --git a/lisp/epg.el b/lisp/epg.el
index 36515ef..a461afa 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -25,6 +25,7 @@
;;; Prelude
(require 'epg-config)
+(require 'rfc6068)
(eval-when-compile (require 'cl-lib))
(define-error 'epg-error "GPG error")
@@ -432,7 +433,7 @@ callback data (if any)."
(and user-id
(concat " "
(if (stringp user-id)
- (epg--decode-percent-escape-as-utf-8 user-id)
+ (rfc6068-unhexify-string user-id)
(epg-decode-dn user-id))))
(and (epg-signature-validity signature)
(format " (trust %s)" (epg-signature-validity signature)))
@@ -573,7 +574,7 @@ callback data (if any)."
"--status-fd" "1"
"--yes")
(if (and (not (eq (epg-context-protocol context) 'CMS))
- (string-match ":" (or agent-info "")))
+ (string-search ":" (or agent-info "")))
'("--use-agent"))
(if (and (not (eq (epg-context-protocol context) 'CMS))
(epg-context-progress-callback context))
@@ -656,16 +657,17 @@ callback data (if any)."
:sentinel #'ignore
:noquery t))
(setf (epg-context-error-buffer context) (process-buffer error-process))
- (with-file-modes 448
- (setq process (make-process :name "epg"
- :buffer buffer
- :command (cons (epg-context-program context)
- args)
- :connection-type 'pipe
- :coding 'raw-text
- :filter #'epg--process-filter
- :stderr error-process
- :noquery t)))
+ (with-existing-directory
+ (with-file-modes 448
+ (setq process (make-process :name "epg"
+ :buffer buffer
+ :command (cons (epg-context-program context)
+ args)
+ :connection-type 'pipe
+ :coding 'raw-text
+ :filter #'epg--process-filter
+ :stderr error-process
+ :noquery t))))
(setf (epg-context-process context) process)))
(defun epg--process-filter (process input)
@@ -777,7 +779,7 @@ callback data (if any)."
(user-id (match-string 2 string))
(entry (assoc key-id epg-user-id-alist)))
(condition-case nil
- (setq user-id (epg--decode-percent-escape-as-utf-8 user-id))
+ (setq user-id (rfc6068-unhexify-string user-id))
(error))
(if entry
(setcdr entry user-id)
@@ -906,7 +908,7 @@ callback data (if any)."
(condition-case nil
(if (eq (epg-context-protocol context) 'CMS)
(setq user-id (epg-dn-from-string user-id))
- (setq user-id (epg--decode-percent-escape-as-utf-8 user-id)))
+ (setq user-id (rfc6068-unhexify-string user-id)))
(error))
(if entry
(setcdr entry user-id)
@@ -1182,7 +1184,7 @@ callback data (if any)."
(user-id (match-string 2 string))
(entry (assoc key-id epg-user-id-alist)))
(condition-case nil
- (setq user-id (epg--decode-percent-escape-as-utf-8 user-id))
+ (setq user-id (rfc6068-unhexify-string user-id))
(error))
(if entry
(setcdr entry user-id)
@@ -2061,9 +2063,11 @@ If you are unsure, use synchronous version of this
function
string))
(defun epg--decode-percent-escape-as-utf-8 (string)
+ (declare (obsolete rfc6068-unhexify-string "28.1"))
(decode-coding-string (epg--decode-percent-escape string) 'utf-8))
(defun epg--decode-hexstring (string)
+ (declare (obsolete rfc6068-unhexify-string "28.1"))
(let ((index 0))
(while (eq index (string-match "[[:xdigit:]][[:xdigit:]]" string index))
(setq string (replace-match (string (string-to-number
@@ -2114,7 +2118,7 @@ The return value is an alist mapping from types to
values."
value (epg--decode-quotedstring (match-string 0 string)))
(if (eq index (string-match "#\\([[:xdigit:]]+\\)" string index))
(setq index (match-end 0)
- value (epg--decode-hexstring (match-string 1 string)))
+ value (rfc6068-unhexify-string (match-string 1 string) t))
(if (eq index (string-match "\"\\([^\\\"]\\|\\\\.\\)*\""
string index))
(setq index (match-end 0)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 7a17ee2..6d84665 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -950,15 +950,15 @@ PROCs `process-buffer' is `current-buffer' when this
function is called."
(unless (string= string "") ;; Ignore empty strings
(save-match-data
(let* ((tag-list (when (eq (aref string 0) ?@)
- (substring string 1 (string-match " " string))))
+ (substring string 1 (string-search " " string))))
(msg (make-erc-response :unparsed string :tags (when tag-list
(erc-parse-tags
tag-list))))
(string (if tag-list
- (substring string (+ 1 (string-match " " string)))
+ (substring string (+ 1 (string-search " " string)))
string))
(posn (if (eq (aref string 0) ?:)
- (string-match " " string)
+ (string-search " " string)
0)))
(setf (erc-response.sender msg)
@@ -968,7 +968,7 @@ PROCs `process-buffer' is `current-buffer' when this
function is called."
(setf (erc-response.command msg)
(let* ((bposn (string-match "[^ \n]" string posn))
- (eposn (string-match " " string bposn)))
+ (eposn (string-search " " string bposn)))
(setq posn (and eposn
(string-match "[^ \n]" string eposn)))
(substring string bposn eposn)))
@@ -976,7 +976,7 @@ PROCs `process-buffer' is `current-buffer' when this
function is called."
(while (and posn
(not (eq (aref string posn) ?:)))
(push (let* ((bposn posn)
- (eposn (string-match " " string bposn)))
+ (eposn (string-search " " string bposn)))
(setq posn (and eposn
(string-match "[^ \n]" string eposn)))
(substring string bposn eposn))
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 219af37..de72624 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -187,7 +187,7 @@ compared with `erc-nick-equal-p' which is IRC
case-insensitive."
(plist-get elt prop)))
;; if the property exists and is equal, we continue, else, try the
;; next element of the list
- (or (and (eq prop :nick) (string-match "!" val)
+ (or (and (eq prop :nick) (string-search "!" val)
test (string-equal test val))
(and (eq prop :nick)
test val
@@ -630,8 +630,8 @@ that subcommand."
(define-inline erc-dcc-unquote-filename (filename)
(inline-quote
- (replace-regexp-in-string "\\\\\\\\" "\\"
- (replace-regexp-in-string "\\\\\"" "\"" ,filename
t t) t t)))
+ (string-replace "\\\\" "\\"
+ (string-replace "\\\"" "\"" ,filename))))
(defun erc-dcc-handle-ctcp-send (proc query nick login host to)
"This is called if a CTCP DCC SEND subcommand is sent to the client.
diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el
index 22336ed..31e59a6 100644
--- a/lisp/erc/erc-ibuffer.el
+++ b/lisp/erc/erc-ibuffer.el
@@ -73,7 +73,7 @@
erc-track-mode)
(let ((entry (assq (current-buffer) erc-modified-channels-alist)))
(if entry
- (if (> (length entry) 1)
+ (if (cdr entry)
(cond ((eq 'pal (nth 1 entry))
(string erc-ibuffer-pal-char))
((eq 'fool (nth 1 entry))
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index bb85844..e61e741 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -139,7 +139,7 @@ This will add a speedbar major display mode."
t))))
(defun erc-speedbar-expand-server (text server indent)
- (cond ((string-match "\\+" text)
+ (cond ((string-search "+" text)
(speedbar-change-expand-button-char ?-)
(if (speedbar-with-writable
(save-excursion
@@ -147,7 +147,7 @@ This will add a speedbar major display mode."
(erc-speedbar-channel-buttons nil (1+ indent) server)))
(speedbar-change-expand-button-char ?-)
(speedbar-change-expand-button-char ??)))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
@@ -184,7 +184,7 @@ This will add a speedbar major display mode."
"For the line matching TEXT, in CHANNEL, expand or contract a line.
INDENT is the current indentation level."
(cond
- ((string-match "\\+" text)
+ ((string-search "+" text)
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -233,7 +233,7 @@ INDENT is the current indentation level."
(speedbar-with-writable
(dolist (entry names)
(erc-speedbar-insert-user entry ?+ (1+ indent))))))))))
- ((string-match "-" text)
+ ((string-search "-" text)
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
@@ -284,7 +284,7 @@ The update is only done when the channel is actually
expanded already."
(erc-speedbar-expand-channel "+" buffer 1)))))
(defun erc-speedbar-expand-user (text token indent)
- (cond ((string-match "\\+" text)
+ (cond ((string-search "+" text)
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -307,7 +307,7 @@ The update is only done when the channel is actually
expanded already."
nil nil nil nil
info nil nil nil
(1+ indent)))))))
- ((string-match "-" text)
+ ((string-search "-" text)
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 31de9e8..dde2556 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -181,6 +181,11 @@ or `erc-send-modify-hook'."
(list (lambda (_window _before dir)
(erc-echo-timestamp dir ct))))))))
+(defvar-local erc-timestamp-last-window-width nil
+ "Stores the width of the last window that showed the current
+buffer. This is used by `erc-insert-timestamp-right' when the
+current buffer is not shown in any window.")
+
(defvar-local erc-timestamp-last-inserted nil
"Last timestamp inserted into the buffer.")
@@ -250,27 +255,32 @@ property to get to the POSth column."
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
-STRING is the timestamp to insert. The function is a possible value
-for `erc-insert-timestamp-function'.
-
-If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is always
-printed. If this variable is non-nil, a timestamp is only printed if
-it is different from the last.
-
-If `erc-timestamp-right-column' is set, its value will be used as the
-column at which the timestamp is to be printed. If it is nil, and
-`erc-fill-mode' is active, then the timestamp will be printed just
-before `erc-fill-column'. Otherwise, if the current buffer is
-shown in a window, that window's width is used. If the buffer is
-not shown, and `fill-column' is set, then the timestamp will be
-printed just `fill-column'. As a last resort, the timestamp will
-be printed just before the window-width."
+STRING is the timestamp to insert. This function is a possible
+value for `erc-insert-timestamp-function'.
+
+If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is
+always printed. If this variable is non-nil, a timestamp is only
+printed if it is different from the last.
+
+If `erc-timestamp-right-column' is set, its value will be used as
+the column at which the timestamp is to be printed. If it is
+nil, and `erc-fill-mode' is active, then the timestamp will be
+printed just before `erc-fill-column'. Otherwise, if the current
+buffer is shown in a window, that window's width is used as the
+right boundary. In case multiple windows show the buffer, the
+width of the most recently selected one is used. If the buffer
+is not shown, the timestamp will be printed just before the
+window width of the last window that showed it. If the buffer
+was never shown, and `fill-column' is set, it will be printed
+just before `fill-column'. As a last resort, timestamp will be
+printed just after each line's text (no alignment)."
(unless (and erc-timestamp-only-if-changed-flag
(string-equal string erc-timestamp-last-inserted))
(setq erc-timestamp-last-inserted string)
(goto-char (point-max))
- (forward-char -1);; before the last newline
+ (forward-char -1) ; before the last newline
(let* ((str-width (string-width string))
+ window ; used in computation of `pos' only
(pos (cond
(erc-timestamp-right-column erc-timestamp-right-column)
((and (boundp 'erc-fill-mode)
@@ -278,10 +288,15 @@ be printed just before the window-width."
(boundp 'erc-fill-column)
erc-fill-column)
(1+ (- erc-fill-column str-width)))
+ ((setq window (get-buffer-window nil t))
+ (setq erc-timestamp-last-window-width
+ (window-width window))
+ (- erc-timestamp-last-window-width str-width))
+ (erc-timestamp-last-window-width
+ (- erc-timestamp-last-window-width str-width))
(fill-column
(1+ (- fill-column str-width)))
- (t
- (- (window-width) str-width 1))))
+ (t (current-column))))
(from (point))
(col (current-column)))
;; The following is a kludge used to calculate whether to move
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 026c6f8..e0fda41 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2271,7 +2271,7 @@ first element is the certificate key file name, and the
second
element is the certificate file name itself, or t, which means
that `auth-source' will be queried for the key and the
certificate. Authenticating using a TLS client certificate is
-also refered to as \"CertFP\" (Certificate Fingerprint)
+also referred to as \"CertFP\" (Certificate Fingerprint)
authentication by various IRC networks.
Example usage:
@@ -3597,7 +3597,7 @@ If S is non-nil, it will be used as the quit reason."
If S is non-nil, it will be used as the quit reason."
(or s
(if (fboundp 'yow)
- (replace-regexp-in-string "\n" "" (yow))
+ (string-replace "\n" "" (yow))
(erc-quit/part-reason-default))))
(make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4")
@@ -3624,7 +3624,7 @@ If S is non-nil, it will be used as the part reason."
If S is non-nil, it will be used as the quit reason."
(or s
(if (fboundp 'yow)
- (replace-regexp-in-string "\n" "" (yow))
+ (string-replace "\n" "" (yow))
(erc-quit/part-reason-default))))
(make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4")
@@ -5587,7 +5587,7 @@ This returns non-nil only if we actually send anything."
(when (and (erc-input-sendp state)
erc-send-this)
(let ((string (erc-input-string state)))
- (if (or (string-match "\n" string)
+ (if (or (string-search "\n" string)
(not (string-match erc-command-regexp string)))
(mapc
(lambda (line)
@@ -6528,7 +6528,7 @@ if `erc-away' is non-nil."
(fill-region (point-min) (point-max))
(buffer-string))))
(setq header-line-format
- (replace-regexp-in-string
+ (string-replace
"%"
"%%"
(if face
@@ -6804,7 +6804,7 @@ functions."
nick user host channel
(if (not (string= reason ""))
(format ": %s"
- (replace-regexp-in-string "%" "%%" reason))
+ (string-replace "%" "%%" reason))
"")))))
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index cbfe0b8..4fd0afb 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -72,6 +72,7 @@
(require 'esh-mode)
(require 'esh-util)
+(require 'em-dirs)
(eval-when-compile
(require 'cl-lib)
@@ -377,8 +378,12 @@ to writing a completion function."
(cl-assert (eq (car result) 'quote))
(cadr result))
arg)))
- (if (numberp val)
- (setq val (number-to-string val)))
+ (cond ((numberp val)
+ (setq val (number-to-string val)))
+ ;; expand .../ etc that only eshell understands to
+ ;; standard ../../
+ ((string-match "\\.\\.\\.+/" val)
+ (setq val (eshell-expand-multiple-dots val))))
(or val "")))
args)
posns)))
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index 316094b..e36f2d0 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -291,7 +291,7 @@ the form:
(let ((index 1))
(setq incl glob)
(while (and (eq incl glob)
- (setq index (string-match "~" glob index)))
+ (setq index (string-search "~" glob index)))
(if (or (get-text-property index 'escaped glob)
(or (= (1+ index) len)))
(setq index (1+ index))
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index daca035..90a8f85 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -923,10 +923,10 @@ at the moment are:
(defun eshell-eval-command (command &optional input)
"Evaluate the given COMMAND iteratively."
(if eshell-current-command
- ;; we can just stick the new command at the end of the current
- ;; one, and everything will happen as it should
+ ;; We can just stick the new command at the end of the current
+ ;; one, and everything will happen as it should.
(setcdr (last (cdr eshell-current-command))
- (list `(let ((here (and (eobp) (point))))
+ (list `(let ((here (and (eobp) (point))))
,(and input
`(insert-and-inherit ,(concat input "\n")))
(if here
@@ -937,14 +937,20 @@ at the moment are:
(erase-buffer)
(insert "command: \"" input "\"\n")))
(setq eshell-current-command command)
- (let ((delim (catch 'eshell-incomplete
- (eshell-resume-eval))))
- ;; On systems that don't support async subprocesses, eshell-resume
- ;; can return t. Don't treat that as an error.
- (if (listp delim)
- (setq delim (car delim)))
- (if (and delim (not (eq delim t)))
- (error "Unmatched delimiter: %c" delim)))))
+ (let* ((delim (catch 'eshell-incomplete
+ (eshell-resume-eval)))
+ (val (car-safe delim)))
+ ;; If the return value of `eshell-resume-eval' is wrapped in a
+ ;; list, it indicates that the command was run asynchronously.
+ ;; In that case, unwrap the value before checking the delimiter
+ ;; value.
+ (if (and val
+ (not (processp val))
+ (not (eq val t)))
+ (error "Unmatched delimiter: %S" val)
+ ;; Eshell-command expect a list like (<process>) to know if the
+ ;; command should be async or not.
+ (or (and (processp val) delim) val)))))
(defun eshell-resume-command (proc status)
"Resume the current command when a process ends."
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 96c9a60..7a0b26a 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -266,7 +266,7 @@ See `eshell-needs-pipe'."
;; neither 'first nor 'last? See bug#1388 discussion.
(catch 'found
(dolist (exe eshell-needs-pipe)
- (if (string-equal exe (if (string-match "/" exe)
+ (if (string-equal exe (if (string-search "/" exe)
command
(file-name-nondirectory command)))
(throw 'found t))))))
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index 3010481..72de6b1 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -204,7 +204,7 @@ then quoting is done by a backslash, rather than a doubled
delimiter."
string
(if (eq (aref string (1- len)) ?\n)
(setq string (substring string 0 (1- len))))
- (if (string-match "\n" string)
+ (if (string-search "\n" string)
(split-string string "\n")
(if (and eshell-convert-numeric-arguments
(string-match
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 9fccc6b..5dc6a19 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -381,7 +381,7 @@ This function is explicit for adding to
`eshell-parse-argument-hook'."
(defun eshell-envvar-names (&optional environment)
"Return a list of currently visible environment variable names."
(mapcar (lambda (x)
- (substring x 0 (string-match "=" x)))
+ (substring x 0 (string-search "=" x)))
(or environment process-environment)))
(defun eshell-environment-variables ()
diff --git a/lisp/faces.el b/lisp/faces.el
index 4bb3a2b..a5aef75 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1795,18 +1795,21 @@ If FRAME is nil, that stands for the selected frame."
(mapcar 'car (tty-color-alist frame))))
(defalias 'x-defined-colors 'defined-colors)
-(defun defined-colors-with-face-attributes (&optional frame)
+(defun defined-colors-with-face-attributes (&optional frame foreground)
"Return a list of colors supported for a particular frame.
See `defined-colors' for arguments and return value. In contrast
to `defined-colors' the elements of the returned list are color
strings with text properties, that make the color names render
-with the color they represent as background color."
+with the color they represent as background color (if FOREGROUND
+is nil; otherwise use the foreground color)."
(mapcar
(lambda (color-name)
- (let ((foreground (readable-foreground-color color-name))
- (color (copy-sequence color-name)))
- (propertize color 'face (list :foreground foreground
- :background color))))
+ (let ((color (copy-sequence color-name)))
+ (propertize color 'face
+ (if foreground
+ (list :foreground color)
+ (list :foreground (readable-foreground-color color-name)
+ :background color)))))
(defined-colors frame)))
(defun readable-foreground-color (color)
@@ -1915,7 +1918,8 @@ If omitted or nil, that stands for the selected frame's
display."
(x-display-grayscale-p display)
(> (tty-color-gray-shades display) 2)))
-(defun read-color (&optional prompt convert-to-RGB allow-empty-name msg)
+(defun read-color (&optional prompt convert-to-RGB allow-empty-name msg
+ foreground)
"Read a color name or RGB triplet.
Completion is available for color names, but not for RGB triplets.
@@ -1942,13 +1946,18 @@ If optional arg ALLOW-EMPTY-NAME is non-nil, the user
is allowed
to enter an empty color name (the empty string).
Interactively, or with optional arg MSG non-nil, print the
-resulting color name in the echo area."
+resulting color name in the echo area.
+
+Interactively, displays a list of colored completions. If optional
+argument FOREGROUND is non-nil, shows them as foregrounds, otherwise
+as backgrounds."
(interactive "i\np\ni\np") ; Always convert to RGB interactively.
(let* ((completion-ignore-case t)
(colors (append '("foreground at point" "background at point")
(if allow-empty-name '(""))
(if (display-color-p)
- (defined-colors-with-face-attributes)
+ (defined-colors-with-face-attributes
+ nil foreground)
(defined-colors))))
(color (completing-read
(or prompt "Color (name or #RGB triplet): ")
@@ -3062,7 +3071,7 @@ also the same size as FACE on FRAME, or fail."
(let ((fonts (x-list-fonts pattern face frame 1)))
(or fonts
(if face
- (if (string-match-p "\\*" pattern)
+ (if (string-search "*" pattern)
(if (null (face-font face))
(error "No matching fonts are the same height as the
frame default font")
(error "No matching fonts are the same height as face
`%s'" face))
diff --git a/lisp/ffap.el b/lisp/ffap.el
index c31926e..84dcc04 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1418,7 +1418,7 @@ which may actually result in an URL rather than a
filename."
(string (ffap-string-at-point)) ; uses mode alist
(name
(or (condition-case nil
- (and (not (string-match "//" string)) ; foo.com://bar
+ (and (not (string-search "//" string)) ; foo.com://bar
(substitute-in-file-name string))
(error nil))
string))
@@ -1525,24 +1525,37 @@ which may actually result in an URL rather than a
filename."
;; The solution here is to forcefully activate url-handler-mode, which
;; takes care of it for us.
+(defun ffap--url-file-handler (operation &rest args)
+ (let ((inhibit-file-name-handlers
+ (cons 'ffap--url-file-handler inhibit-file-name-handlers))
+ (inhibit-file-name-operation operation))
+ (cl-case operation
+ ;; We mainly just want to disable these bits:
+ (substitute-in-file-name (car args))
+ (expand-file-name (car args))
+ (otherwise
+ (apply operation args)))))
+
(defun ffap-read-file-or-url (prompt guess)
"Read file or URL from minibuffer, with PROMPT and initial GUESS."
- (or guess (setq guess default-directory))
- ;; Tricky: guess may have or be a local directory, like "w3/w3.elc"
- ;; or "w3/" or "../el/ffap.el" or "../../../"
- (if (ffap-url-p guess)
- ;; FIXME: We earlier tried to make use of `url-file-handler' so
- ;; `read-file-name' could also be used for URLs, but it
- ;; introduced all kinds of subtle breakage such as:
- ;; - (file-name-directory "http://a";) returning "http://a/";
- ;; - Trying to contact remote hosts with no justification
- ;; These should be fixed in url-handler-mode before we can try
- ;; using it here again.
- (read-string prompt guess nil nil t)
- (unless (ffap-file-remote-p guess)
- (setq guess (abbreviate-file-name (expand-file-name guess))))
- (read-file-name prompt (file-name-directory guess) nil nil
- (file-name-nondirectory guess))))
+ (let ((elem (cons ffap-url-regexp #'ffap--url-file-handler)))
+ (unwind-protect
+ (progn
+ (push elem file-name-handler-alist)
+ (if (ffap-url-p guess)
+ (read-file-name prompt guess guess)
+ (unless guess
+ (setq guess default-directory))
+ (unless (ffap-file-remote-p guess)
+ (setq guess (abbreviate-file-name (expand-file-name guess))))
+ (read-file-name prompt
+ (file-name-directory guess) nil nil
+ (file-name-nondirectory guess))))
+ ;; Remove the special handler manually. We used to just let-bind
+ ;; file-name-handler-alist to preserve its value, but that caused
+ ;; other modifications to be lost (e.g. when Tramp gets loaded
+ ;; during the completing-read call).
+ (setq file-name-handler-alist (delq elem file-name-handler-alist)))))
;; The rest of this page is just to work with package complete.el.
;; This code assumes that you load ffap.el after complete.el.
@@ -1654,9 +1667,9 @@ See also the variables `ffap-dired-wildcards',
`ffap-newfile-prompt',
((or (not ffap-newfile-prompt)
(file-exists-p filename)
(y-or-n-p "File does not exist, create buffer? "))
- (funcall ffap-file-finder
- ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
- (expand-file-name filename)))
+ (find-file
+ ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
+ (expand-file-name filename)))
;; User does not want to find a non-existent file:
((signal 'file-missing (list "Opening file buffer"
"No such file or directory"
diff --git a/lisp/filecache.el b/lisp/filecache.el
index 62184e1..4223878 100644
--- a/lisp/filecache.el
+++ b/lisp/filecache.el
@@ -516,6 +516,16 @@ If called interactively, read the directory names one by
one."
(concat directory "/")
directory)))
+(defun file-cache-cycle (name)
+ "Cycle through the directories that NAME is available in."
+ (let ((file-name (file-cache-file-name name)))
+ (if (string= file-name (minibuffer-contents))
+ (minibuffer-message file-cache-sole-match-message)
+ (delete-minibuffer-contents)
+ (insert file-name)
+ (if file-cache-multiple-directory-message
+ (minibuffer-message file-cache-multiple-directory-message)))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Minibuffer functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -545,13 +555,7 @@ the name is considered already unique; only the second
substitution
(cond
;; If it's the only match, replace the original contents
((or arg (eq completion t))
- (let ((file-name (file-cache-file-name string)))
- (if (string= file-name (minibuffer-contents))
- (minibuffer-message file-cache-sole-match-message)
- (delete-minibuffer-contents)
- (insert file-name)
- (if file-cache-multiple-directory-message
- (minibuffer-message file-cache-multiple-directory-message)))))
+ (file-cache-cycle string))
;; If it's the longest match, insert it
((consp completion)
@@ -564,10 +568,7 @@ the name is considered already unique; only the second
substitution
file-cache-ignore-case))
(if (and (eq last-command this-command)
(string= file-cache-last-completion newstring))
- (progn
- (delete-minibuffer-contents)
- (insert (file-cache-file-name newstring))
- (setq file-cache-last-completion nil))
+ (file-cache-cycle newstring)
(minibuffer-message file-cache-non-unique-message)
(setq file-cache-last-completion string))
(setq file-cache-last-completion string)
@@ -579,20 +580,12 @@ the name is considered already unique; only the second
substitution
(if (> (length completion-list) 1)
(progn
(delete-region (- (point-max) (length string)) (point-max))
- (save-excursion (insert newstring))
- (forward-char newpoint)
+ (insert newstring)
(with-output-to-temp-buffer file-cache-completions-buffer
(display-completion-list completion-list)
;; Add our own setup function to the Completions Buffer
(file-cache-completion-setup-function)))
- (let ((file-name (file-cache-file-name newstring)))
- (if (string= file-name (minibuffer-contents))
- (minibuffer-message file-cache-sole-match-message)
- (delete-minibuffer-contents)
- (insert file-name)
- (if file-cache-multiple-directory-message
- (minibuffer-message
- file-cache-multiple-directory-message)))))))))
+ (file-cache-cycle newstring))))))
;; No match
((eq completion nil)
diff --git a/lisp/fileloop.el b/lisp/fileloop.el
index 8a2755d..45b9cea 100644
--- a/lisp/fileloop.el
+++ b/lisp/fileloop.el
@@ -120,7 +120,10 @@ operating on the next file and nil otherwise."
(kill-all-local-variables)
(erase-buffer)
(setq new next)
- (insert-file-contents new nil))
+ (condition-case nil
+ (insert-file-contents new nil)
+ (file-missing
+ (fileloop-next-file novisit))))
new)))
(defun fileloop-continue ()
diff --git a/lisp/files.el b/lisp/files.el
index d915c2a..7e4bdab 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -42,15 +42,6 @@
"Finding files."
:group 'files)
-
-(defcustom delete-auto-save-files t
- "Non-nil means delete auto-save file when a buffer is saved or killed.
-
-Note that the auto-save file will not be deleted if the buffer is killed
-when it has unsaved changes."
- :type 'boolean
- :group 'auto-save)
-
(defcustom directory-abbrev-alist
nil
"Alist of abbreviations for file directories.
@@ -257,7 +248,7 @@ This feature is advisory: for example, if the directory in
which the
file is being saved is not writable, Emacs may ignore a non-nil value
of `file-precious-flag' and write directly into the file.
-See also: `break-hardlink-on-save'."
+See also: `break-hardlink-on-save' and `file-preserve-symlinks-on-save'."
:type 'boolean
:group 'backup)
@@ -782,7 +773,7 @@ nil (meaning `default-directory') as the associated list
element."
(let ((spath (substitute-env-vars search-path)))
(mapcar (lambda (f)
(if (equal "" f) nil
- (let ((dir (expand-file-name (file-name-as-directory f))))
+ (let ((dir (file-name-as-directory f)))
;; Previous implementation used `substitute-in-file-name'
;; which collapse multiple "/" in front. Do the same for
;; backward compatibility.
@@ -2360,7 +2351,7 @@ the various files."
((not query-about-changed-file)
(message
(substitute-command-keys
- "File %s changed on disk. \\[revert-buffer] to
load new contents%s")
+ "File %s changed on disk. \\[revert-buffer-quick]
to load new contents%s")
(file-name-nondirectory filename)
(if (buffer-modified-p buf)
" and discard your edits"
@@ -3238,14 +3229,21 @@ extra checks should be done."
(setq mode (car mode)
name (substring name 0 (match-beginning 0)))
(setq name nil)))
- (when (and dir-local mode)
- (unless (string-suffix-p "-mode" (symbol-name mode))
- (message "Ignoring invalid mode `%s'" (symbol-name mode))
- (setq mode nil)))
+ (when (and dir-local mode
+ (not (set-auto-mode--dir-local-valid-p mode)))
+ (message "Ignoring invalid mode `%s'" mode)
+ (setq mode nil))
(when mode
(set-auto-mode-0 mode keep-mode-if-same)
t))))
+(defun set-auto-mode--dir-local-valid-p (mode)
+ "Say whether MODE can be used in a .dir-local.el `auto-mode-alist'."
+ (and (symbolp mode)
+ (string-suffix-p "-mode" (symbol-name mode))
+ (commandp mode)
+ (not (provided-mode-derived-p mode 'special-mode))))
+
(defun set-auto-mode (&optional keep-mode-if-same)
"Select major mode appropriate for current buffer.
@@ -3594,7 +3592,7 @@ This hook is called only if there is at least one
file-local
variable to set.")
(defvar permanently-enabled-local-variables '(lexical-binding)
- "A list of local variables that are always enabled.
+ "A list of file-local variables that are always enabled.
This overrides any `enable-local-variables' setting.")
(defun hack-local-variables-confirm (all-vars unsafe-vars risky-vars dir-name)
@@ -5026,7 +5024,7 @@ FILENAME has the format of a directory.
See also `file-name-sans-extension'."
(let ((extn (string-trim-left extension "[.]")))
(cond ((string-empty-p filename)
- (error "Empty filename: %s" filename))
+ (error "Empty filename"))
((string-empty-p extn)
(error "Malformed extension: %s" extension))
((directory-name-p filename)
@@ -5194,7 +5192,7 @@ The function `find-backup-file-name' also uses this."
(expand-file-name
(subst-char-in-string
?/ ?!
- (replace-regexp-in-string "!" "!!" file))
+ (string-replace "!" "!!" file))
backup-directory))
(expand-file-name (file-name-nondirectory file)
(file-name-as-directory abs-backup-directory))))))
@@ -5430,6 +5428,23 @@ Used only by `save-buffer'."
:type 'hook
:group 'files)
+(defcustom copy-directory-create-symlink nil
+ "This option influences the handling of symbolic links in `copy-directory'.
+If non-nil, `copy-directory' will create a symbolic link if the
+source directory is a symbolic link. If nil, it'll follow the
+symbolic link and copy the contents instead."
+ :type 'boolean
+ :version "28.1"
+ :group 'files)
+
+(defcustom file-preserve-symlinks-on-save nil
+ "If non-nil, saving a buffer visited via a symlink won't overwrite the
symlink.
+This is only relevant if `file-precious-flag' is non-nil -- if
+this is nil, Emacs will preserve the symlinks anyway."
+ :type 'boolean
+ :version "28.1"
+ :group 'files)
+
(defvar-local save-buffer-coding-system nil
"If non-nil, use this coding system for saving the buffer.
More precisely, use this coding system in place of the
@@ -5632,7 +5647,14 @@ Before and after saving the buffer, this function runs
buffer-file-name)))
;; We succeeded in writing the temp file,
;; so rename it.
- (rename-file tempname buffer-file-name t))
+ (rename-file tempname
+ (if (and file-preserve-symlinks-on-save
+ (file-symlink-p buffer-file-name))
+ ;; Write to the file that the symlink
+ ;; points to.
+ (file-chase-links buffer-file-name)
+ buffer-file-name)
+ t))
;; If file not writable, see if we can make it writable
;; temporarily while we write it.
;; But no need to do so if we have just backed it up
@@ -5720,9 +5742,23 @@ be saved."
:group 'auto-save
;; FIXME nil should not be a valid option, let alone the default,
;; eg so that add-function can be used.
- :type '(choice (const :tag "Default" nil) function)
+ :type '(choice (const :tag "Default" nil)
+ (function :tag "Only in subdirs of root"
+ save-some-buffers-root)
+ (function :tag "Custom function"))
:version "26.1")
+(defun save-some-buffers-root ()
+ "A predicate to check whether the buffer is under the root directory.
+Can be used as a value of `save-some-buffers-default-predicate'
+to save buffers only under the project root or in subdirectories
+of the directory that was default during command invocation."
+ (let ((root (or (and (featurep 'project) (project-current)
+ (fboundp 'project-root)
+ (project-root (project-current)))
+ default-directory)))
+ (lambda () (file-in-directory-p default-directory root))))
+
(defun save-some-buffers (&optional arg pred)
"Save some modified file-visiting buffers. Asks user about each one.
You can answer `y' or SPC to save, `n' or DEL not to save, `C-r'
@@ -5751,6 +5787,11 @@ change the additional actions you can take on files."
(interactive "P")
(unless pred
(setq pred save-some-buffers-default-predicate))
+ ;; Allow `pred' to be a function that returns a predicate
+ ;; with lexical bindings in its original environment (bug#46374).
+ (let ((pred-fun (and (functionp pred) (funcall pred))))
+ (when (functionp pred-fun)
+ (setq pred pred-fun)))
(let* ((switched-buffer nil)
(save-some-buffers--switch-window-callback
(lambda (buffer)
@@ -6139,6 +6180,9 @@ Noninteractively, the PARENTS argument says whether to
create
parent directories if they don't exist. Interactively, this
happens by default.
+If DIRECTORY is a symlink and `copy-directory-create-symlink' is
+non-nil, create a symlink with the same target as DIRECTORY.
+
If NEWNAME is a directory name, copy DIRECTORY as a subdirectory
there. However, if called from Lisp with a non-nil optional
argument COPY-CONTENTS, copy the contents of DIRECTORY directly
@@ -6167,42 +6211,53 @@ into NEWNAME instead."
(setq directory (directory-file-name (expand-file-name directory))
newname (expand-file-name newname))
- (cond ((not (directory-name-p newname))
- ;; If NEWNAME is not a directory name, create it;
- ;; that is where we will copy the files of DIRECTORY.
- (make-directory newname parents))
- ;; NEWNAME is a directory name. If COPY-CONTENTS is non-nil,
- ;; create NEWNAME if it is not already a directory;
- ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME].
- ((if copy-contents
- (or parents (not (file-directory-p newname)))
- (setq newname (concat newname
- (file-name-nondirectory directory))))
- (make-directory (directory-file-name newname) parents))
- (t (setq follow t)))
-
- ;; Copy recursively.
- (dolist (file
- ;; We do not want to copy "." and "..".
- (directory-files directory 'full
- directory-files-no-dot-files-regexp))
- (let ((target (concat (file-name-as-directory newname)
- (file-name-nondirectory file)))
- (filetype (car (file-attributes file))))
- (cond
- ((eq filetype t) ; Directory but not a symlink.
- (copy-directory file target keep-time parents t))
- ((stringp filetype) ; Symbolic link
- (make-symbolic-link filetype target t))
- ((copy-file file target t keep-time)))))
-
- ;; Set directory attributes.
- (let ((modes (file-modes directory))
- (times (and keep-time (file-attribute-modification-time
- (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))))))
+ ;; If DIRECTORY is a symlink, create a symlink with the same target.
+ (if (and (file-symlink-p directory)
+ copy-directory-create-symlink)
+ (let ((target (car (file-attributes directory))))
+ (if (directory-name-p newname)
+ (make-symbolic-link target
+ (concat newname
+ (file-name-nondirectory directory))
+ t)
+ (make-symbolic-link target newname t)))
+ ;; Else proceed to copy as a regular directory
+ (cond ((not (directory-name-p newname))
+ ;; If NEWNAME is not a directory name, create it;
+ ;; that is where we will copy the files of DIRECTORY.
+ (make-directory newname parents))
+ ;; NEWNAME is a directory name. If COPY-CONTENTS is non-nil,
+ ;; create NEWNAME if it is not already a directory;
+ ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME].
+ ((if copy-contents
+ (or parents (not (file-directory-p newname)))
+ (setq newname (concat newname
+ (file-name-nondirectory directory))))
+ (make-directory (directory-file-name newname) parents))
+ (t (setq follow t)))
+
+ ;; Copy recursively.
+ (dolist (file
+ ;; We do not want to copy "." and "..".
+ (directory-files directory 'full
+ directory-files-no-dot-files-regexp))
+ (let ((target (concat (file-name-as-directory newname)
+ (file-name-nondirectory file)))
+ (filetype (car (file-attributes file))))
+ (cond
+ ((eq filetype t) ; Directory but not a symlink.
+ (copy-directory file target keep-time parents t))
+ ((stringp filetype) ; Symbolic link
+ (make-symbolic-link filetype target t))
+ ((copy-file file target t keep-time)))))
+
+ ;; Set directory attributes.
+ (let ((modes (file-modes directory))
+ (times (and keep-time (file-attribute-modification-time
+ (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.
@@ -6357,9 +6412,7 @@ preserve markers and overlays, at the price of being
slower."
;; interface, but leaving the programmatic interface the same.
(interactive (list (not current-prefix-arg)))
(let ((revert-buffer-in-progress-p t)
- (revert-buffer-preserve-modes preserve-modes)
- ;; Preserve buffer-readedness.
- (buffer-read-only buffer-read-only))
+ (revert-buffer-preserve-modes preserve-modes))
(funcall (or revert-buffer-function #'revert-buffer--default)
ignore-auto noconfirm)))
@@ -6528,7 +6581,8 @@ see `replace-buffer-contents'."
;; See comments in revert-buffer-with-fine-grain for an explanation.
(defun revert-buffer-with-fine-grain-success-p ()
success))
- (set-buffer-modified-p nil))))
+ (set-buffer-modified-p nil)
+ (set-visited-file-modtime))))
(defun revert-buffer-with-fine-grain (&optional ignore-auto noconfirm)
"Revert buffer preserving markers, overlays, etc.
@@ -6555,6 +6609,38 @@ details on the arguments, see `revert-buffer'."
(revert-buffer-with-fine-grain-success-p)
(fmakunbound 'revert-buffer-with-fine-grain-success-p)))))
+(defcustom revert-buffer-quick-short-answers nil
+ "How much confirmation to be done by the `revert-buffer-quick' command.
+If non-nil, use `y-or-n-p' instead of `yes-or-no-p'."
+ :version "28.1"
+ :type 'boolean)
+
+(defun revert-buffer-quick (&optional auto-save)
+ "Like `revert-buffer', but asks for less confirmation.
+If the current buffer is visiting a file, and the buffer is not
+modified, no confirmation is required.
+
+This command heeds the `revert-buffer-quick-short-answers' user option.
+
+If AUTO-SAVE (the prefix argument), offer to revert from latest
+auto-save file, if that is more recent than the visited file."
+ (interactive "P")
+ (cond
+ ;; If we've visiting a file, and we have no changes, don't ask for
+ ;; confirmation.
+ ((and buffer-file-name
+ (not (buffer-modified-p)))
+ (revert-buffer (not auto-save) t)
+ (message "Reverted buffer"))
+ ;; Heed `revert-buffer-quick-short-answers'.
+ (revert-buffer-quick-short-answers
+ (let ((use-short-answers t))
+ (revert-buffer (not auto-save))))
+ ;; Call `revert-buffer' normally.
+ (t
+ (revert-buffer (not auto-save)))))
+
+
(defun recover-this-file ()
"Recover the visited file--get contents from its last auto-save file."
(interactive)
@@ -6610,7 +6696,8 @@ details on the arguments, see `revert-buffer'."
(coding-system-for-read 'auto-save-coding))
(erase-buffer)
(insert-file-contents file-name nil)
- (set-buffer-file-coding-system coding-system))
+ (set-buffer-file-coding-system coding-system)
+ (set-buffer-auto-saved))
(after-find-file nil nil t))
(t (user-error "Recover-file canceled")))))
@@ -6729,6 +6816,7 @@ This command is used in the special Dired buffer created
by
(message "No files can be recovered from this session now")))
(kill-buffer buffer))))
+
(defun kill-buffer-ask (buffer)
"Kill BUFFER if confirmed."
(when (yes-or-no-p (format "Buffer %s %s. Kill? "
@@ -6869,7 +6957,7 @@ the resulting file name, and SUFFIX is appended."
(file-name-directory result)
(subst-char-in-string
?/ ?!
- (replace-regexp-in-string
+ (string-replace
"!" "!!" filename))))
(t result))))
(setq result
@@ -6972,7 +7060,7 @@ by `sh' are supported."
(prog1 ; copy everything upto next `]'.
(substring wildcard
i
- (setq j (string-match
+ (setq j (string-search
"]" wildcard i)))
(setq i (if j (1- j) (1- len)))))))
((eq ch ?.) "\\.")
@@ -7098,7 +7186,7 @@ need to be passed verbatim to shell commands."
;; DOS/Windows don't allow `"' in file names. So if the
;; argument has quotes, we can safely assume it is already
;; quoted by the caller.
- (if (or (string-match "[\"]" pattern)
+ (if (or (string-search "\"" pattern)
;; We quote [&()#$`'] in case their shell is a port of a
;; Unixy shell. We quote [,=+] because stock DOS and
;; Windows shells require that in some cases, such as
@@ -7982,7 +8070,7 @@ based on existing mode bits, as in \"og+rX-w\"."
(default
(and (stringp modestr)
(string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
- (replace-regexp-in-string
+ (string-replace
"-" ""
(format "u=%s,g=%s,o=%s"
(match-string 1 modestr)
@@ -7998,6 +8086,7 @@ based on existing mode bits, as in \"og+rX-w\"."
(define-obsolete-variable-alias 'cache-long-line-scans
'cache-long-scans "24.4")
+
;; Trashcan handling.
(defcustom trash-directory nil
"Directory for `move-file-to-trash' to move files and directories to.
@@ -8120,16 +8209,16 @@ Otherwise, trash FILENAME using the freedesktop.org
conventions,
;; exists, but the file name may exist in the trash
;; directory even if there is no info file for it.
(when (file-exists-p
- (expand-file-name files-base trash-files-dir))
+ (file-name-concat trash-files-dir files-base))
(setq overwrite t
files-base (file-name-nondirectory
(make-temp-file
- (expand-file-name
- files-base trash-files-dir)
+ (file-name-concat
+ trash-files-dir files-base)
is-directory))))
- (setq info-fn (expand-file-name
- (concat files-base ".trashinfo")
- trash-info-dir))
+ (setq info-fn (file-name-concat
+ trash-info-dir
+ (concat files-base ".trashinfo")))
;; Re-check the existence (sort of).
(condition-case nil
(write-region nil nil info-fn nil 'quiet info-fn 'excl)
@@ -8138,16 +8227,17 @@ Otherwise, trash FILENAME using the freedesktop.org
conventions,
;; like Emacs-style backup file names. E.g.:
;; https://bugs.kde.org/170956
(setq info-fn (make-temp-file
- (expand-file-name files-base trash-info-dir)
+ (file-name-concat trash-info-dir files-base)
nil ".trashinfo"))
(setq files-base (substring (file-name-nondirectory info-fn)
0 (- (length ".trashinfo"))))
(write-region nil nil info-fn nil 'quiet info-fn)))
;; Finally, try to move the file to the trashcan.
(let ((delete-by-moving-to-trash nil)
- (new-fn (expand-file-name files-base trash-files-dir)))
+ (new-fn (file-name-concat trash-files-dir files-base)))
(rename-file fn new-fn overwrite)))))))))
+
(defsubst file-attribute-type (attributes)
"The type field in ATTRIBUTES returned by `file-attributes'.
The value is either t for directory, string (name linked to) for
diff --git a/lisp/finder.el b/lisp/finder.el
index c2d5806..555506d 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -247,7 +247,7 @@ from; the default is `load-path'."
;; The idea here is that eg calc.el gets to define
;; the description of the calc package.
;; This does not work for eg nxml-mode.el.
- ((or (eq base-name package) version)
+ ((eq base-name package)
(setq desc (cdr entry))
(aset desc 0 version)
(aset desc 2 summary)))
diff --git a/lisp/follow.el b/lisp/follow.el
index dde140d..b64f4cb 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -858,8 +858,11 @@ from the bottom."
(windows (follow-all-followers))
(win (nth (/ (- (length windows) 1) 2) windows)))
(select-window win)
- (goto-char dest)
- (recenter))))
+ (let ((win-s (window-start)))
+ (goto-char dest)
+ (recenter)
+ (when (< dest win-s)
+ (setq follow-internal-force-redisplay t))))))
(defun follow-redraw ()
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 4dc42d9..c00a62a 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -312,6 +312,9 @@ If a number, only buffers greater than this size have
fontification messages."
(defvar font-lock-doc-face 'font-lock-doc-face
"Face name to use for documentation.")
+(defvar font-lock-doc-markup-face 'font-lock-doc-markup-face
+ "Face name to use for documentation mark-up.")
+
(defvar font-lock-keyword-face 'font-lock-keyword-face
"Face name to use for keywords.")
@@ -2003,7 +2006,16 @@ Sets various variables using `font-lock-defaults' and
(defface font-lock-doc-face
'((t :inherit font-lock-string-face))
- "Font Lock mode face used to highlight documentation."
+ "Font Lock mode face used to highlight documentation embedded in program
code.
+It is typically used for special documentation comments or strings."
+ :group 'font-lock-faces)
+
+(defface font-lock-doc-markup-face
+ '((t :inherit font-lock-constant-face))
+ "Font Lock mode face used to highlight embedded documentation mark-up.
+It is meant for mark-up elements in text that uses `font-lock-doc-face', such
+as the constructs of Haddock, Javadoc and similar systems."
+ :version "28.1"
:group 'font-lock-faces)
(defface font-lock-keyword-face
diff --git a/lisp/format.el b/lisp/format.el
index 1e87d25..71cf885 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -1013,6 +1013,12 @@ either strings, or lists of the form (PARAMETER VALUE)."
prop-alist (car old) nil))
close)
old (cdr old)))
+ ;; If the font is on the format (:background "red"),
+ ;; then we have a single face. We're assuming a list of
+ ;; faces, so transform.
+ (when (and (listp new)
+ (keywordp (car new)))
+ (setq new (list new)))
(while new
(setq open
(append (cdr (format-annotate-atomic-property-change
diff --git a/lisp/forms.el b/lisp/forms.el
index 8696aea..46f4df9 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -1576,7 +1576,7 @@ As a side effect: sets `forms--the-record-list'."
(forms--trans the-record "\n" forms-multi-line))
;; A final sanity check before updating.
- (if (string-match-p "\n" the-record)
+ (if (string-search "\n" the-record)
(error "Multi-line fields in this record - update refused"))
(with-current-buffer forms--file-buffer
diff --git a/lisp/frame.el b/lisp/frame.el
index 9b3d120..60234fc 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -36,7 +36,7 @@ as its argument.")
(cl-generic-define-context-rewriter window-system (value)
;; If `value' is a `consp', it's probably an old-style specializer,
;; so just use it, and anyway `eql' isn't very useful on cons cells.
- `(window-system ,(if (consp value) value `(eql ,value))))
+ `(window-system ,(if (consp value) value `(eql ',value))))
(cl-defmethod frame-creation-function (params &context (window-system nil))
;; It's tempting to get rid of tty-create-frame-with-faces and turn it into
@@ -787,6 +787,26 @@ When called from Lisp, returns the new frame."
(make-frame)
(select-frame (make-frame))))
+(defun clone-frame (&optional frame use-default-parameters)
+ "Make a new frame with the same parameters as FRAME.
+With a prefix arg (USE-DEFAULT-PARAMETERS), use
+`default-frame-alist' instead.
+
+FRAME defaults to the selected frame. The frame is created on the
+same terminal as FRAME. If the terminal is a text-only terminal then
+also select the new frame."
+ (interactive "i\nP")
+ (if use-default-parameters
+ (make-frame-command)
+ (let* ((default-frame-alist (seq-filter
+ (lambda (elem)
+ (not (eq (car elem) 'name)))
+ (frame-parameters frame)))
+ (new-frame (make-frame)))
+ (unless (display-graphic-p)
+ (select-frame new-frame))
+ new-frame)))
+
(defvar before-make-frame-hook nil
"Functions to run before `make-frame' creates a new frame.")
@@ -1507,7 +1527,7 @@ To get the frame's current background color, use
`frame-parameters'."
"Set the foreground color of the selected frame to COLOR-NAME.
When called interactively, prompt for the name of the color to use.
To get the frame's current foreground color, use `frame-parameters'."
- (interactive (list (read-color "Foreground color: ")))
+ (interactive (list (read-color "Foreground color: " nil nil nil t)))
(modify-frame-parameters (selected-frame)
(list (cons 'foreground-color color-name)))
(or window-system
@@ -2807,6 +2827,7 @@ See also `toggle-frame-maximized'."
(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 ctl-x-5-map "c" #'clone-frame)
(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 e698d54..cdbac0a 100644
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -636,7 +636,7 @@ see `frameset-filter-alist'."
(not (frameset-switch-to-gui-p parameters))
(let* ((prefix:p (symbol-name (car current)))
(p (intern (substring prefix:p
- (1+ (string-match-p ":" prefix:p)))))
+ (1+ (string-search ":" prefix:p)))))
(val (cdr current))
(found (assq p filtered)))
(if (not found)
@@ -882,7 +882,7 @@ For the description of FORCE-ONSCREEN, see
`frameset-restore'.
When forced onscreen, frames wider than the monitor's workarea are converted
to fullwidth, and frames taller than the workarea are converted to fullheight.
NOTE: This only works for non-iconified frames."
- (pcase-let* ((`(,left ,top ,width ,height) (cl-cdadr
(frame-monitor-attributes frame)))
+ (pcase-let* ((`(,left ,top ,width ,height) (cdadr (frame-monitor-attributes
frame)))
(right (+ left width -1))
(bottom (+ top height -1))
(fr-left (frameset-compute-pos (frame-parameter frame 'left)
left right))
diff --git a/lisp/fringe.el b/lisp/fringe.el
index d73aae0..82cfacc 100644
--- a/lisp/fringe.el
+++ b/lisp/fringe.el
@@ -189,7 +189,7 @@ fringes."
:type `(choice
,@ (mapcar (lambda (style)
(let ((name
- (replace-regexp-in-string "-" " " (car style))))
+ (string-replace "-" " " (car style))))
`(const :tag
,(concat (capitalize (substring name 0 1))
(substring name 1))
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index b989446..3c1403e 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -2519,7 +2519,7 @@ If PROMPT (the prefix), prompt for a coding system to
use."
format (and ctl (mail-content-type-get ctl 'format)))
(when cte
(setq cte (mail-header-strip-cte cte)))
- (if (and ctl (not (string-match "/" (car ctl))))
+ (if (and ctl (not (string-search "/" (car ctl))))
(setq ctl nil))
(goto-char (point-max)))
(forward-line 1)
@@ -6238,8 +6238,9 @@ If nil, don't show those extra buttons."
(gnus-display-mime preferred)
(let ((mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
- (with-current-buffer gnus-summary-buffer
- gnus-newsgroup-ignored-charsets)))
+ (and (buffer-live-p gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
+ gnus-newsgroup-ignored-charsets))))
(gnus-bind-mm-vars (mm-display-part preferred))
;; Do highlighting.
(save-excursion
@@ -8287,7 +8288,7 @@ url is put as the `gnus-button-url' overlay property on
the button."
")" (gnus-url-unhex-string (match-string 2 url)))))
((string-match "([^)\"]+)[^\"]+" url)
(setq url
- (replace-regexp-in-string
+ (string-replace
"\"" "" (replace-regexp-in-string "[\n\t ]+" " " url)))
(gnus-info-find-node url))
(t (error "Can't parse %s" url))))
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index c8b95d9..c1b46d6 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -118,7 +118,9 @@ If nil, only list groups that have unread articles."
(defcustom gnus-group-default-list-level gnus-level-subscribed
"Default listing level.
-Ignored if `gnus-group-use-permanent-levels' is non-nil."
+When `gnus-group-use-permanent-levels' is non-nil, this level is
+used as the starting level until the user sets a different level,
+and is ignored afterwards."
:group 'gnus-group-listing
:type '(choice (integer :tag "Level")
(function :tag "Function returning level")))
@@ -589,8 +591,8 @@ simple manner."
"\M-p" gnus-group-prev-unread-group-same-level
"," gnus-group-best-unread-group
"." gnus-group-first-unread-group
- "u" gnus-group-unsubscribe-current-group
- "U" gnus-group-unsubscribe-group
+ "u" gnus-group-toggle-subscription-at-point
+ "U" gnus-group-toggle-subscription
"c" gnus-group-catchup-current
"C" gnus-group-catchup-current-all
"\M-c" gnus-group-clear-data
@@ -767,8 +769,8 @@ simple manner."
(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
"l" gnus-group-set-current-level
- "t" gnus-group-unsubscribe-current-group
- "s" gnus-group-unsubscribe-group
+ "t" gnus-group-toggle-subscription-at-point
+ "s" gnus-group-toggle-subscription
"k" gnus-group-kill-group
"y" gnus-group-yank-group
"w" gnus-group-kill-region
@@ -814,7 +816,7 @@ simple manner."
["Check for new articles " gnus-topic-get-new-news-this-topic
:included (gnus-topic-mode-p)
:help "Check for new messages in current group or topic"]
- ["Toggle subscription" gnus-group-unsubscribe-current-group
+ ["Toggle subscription" gnus-group-toggle-subscription-at-point
(gnus-group-group-name)]
["Kill" gnus-group-kill-group :active (gnus-group-group-name)
:help "Kill (remove) current group"]
@@ -907,7 +909,7 @@ simple manner."
["Execute command" gnus-group-universal-argument
(or gnus-group-marked (gnus-group-group-name))])
("Subscribe"
- ["Subscribe to a group..." gnus-group-unsubscribe-group t]
+ ["Toggle subscription..." gnus-group-toggle-subscription t]
["Kill all newsgroups in region" gnus-group-kill-region
:active mark-active]
["Kill all zombie groups" gnus-group-kill-all-zombies
@@ -1042,7 +1044,7 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome'
and
;; (gnus-group-find-new-groups "???" nil)
(gnus-group-save-newsrc "save")
(gnus-group-describe-group "describe")
- (gnus-group-unsubscribe-current-group "gnus/toggle-subscription")
+ (gnus-group-toggle-subscription-at-point "gnus/toggle-subscription")
(gnus-group-prev-unread-group "left-arrow")
(gnus-group-next-unread-group "right-arrow")
(gnus-group-exit "exit")
@@ -1119,7 +1121,7 @@ The group buffer lists (some of) the groups available.
For instance,
lists all zombie groups.
Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To
subscribe
-to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
+to a group not displayed, type `\\[gnus-group-toggle-subscription]'.
For more in-depth information on this mode, read the manual
(`\\[gnus-info-find-node]').
@@ -1176,11 +1178,11 @@ The following commands are available:
(defun gnus-group-default-level (&optional level number-or-nil)
(cond
(gnus-group-use-permanent-levels
- (or (setq gnus-group-use-permanent-levels
- (or level (if (numberp gnus-group-use-permanent-levels)
- gnus-group-use-permanent-levels
- (or (gnus-group-default-list-level)
- gnus-level-subscribed))))
+ (or level
+ (if (numberp gnus-group-use-permanent-levels)
+ gnus-group-use-permanent-levels
+ (or (gnus-group-default-list-level)
+ gnus-level-subscribed))
(gnus-group-default-list-level) gnus-level-subscribed))
(number-or-nil
level)
@@ -1228,20 +1230,23 @@ The following commands are available:
(let ((charset (gnus-group-name-charset nil string)))
(gnus-group-name-decode string charset)))
-(defun gnus-group-list-groups (&optional level unread lowest)
+(defun gnus-group-list-groups (&optional level unread lowest update-level)
"List newsgroups with level LEVEL or lower that have unread articles.
Default is all subscribed groups.
If argument UNREAD is non-nil, groups with no unread articles are also
listed.
-Also see the `gnus-group-use-permanent-levels' variable."
+Also see the `gnus-group-use-permanent-levels' variable. If this
+variable is non-nil, and UPDATE-LEVEL is non-nil (which is the
+case interactively), the level will be updated by this command."
(interactive
(list (if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
(or
(gnus-group-default-level nil t)
(gnus-group-default-list-level)
- gnus-level-subscribed)))
+ gnus-level-subscribed))
+ nil nil t)
gnus-group-mode)
(unless level
(setq level (car gnus-group-list-mode)
@@ -1288,7 +1293,9 @@ Also see the `gnus-group-use-permanent-levels' variable."
(goto-char (point-max))
(forward-line -1)))))))
;; Adjust cursor point.
- (gnus-group-position-point)))
+ (gnus-group-position-point)
+ (when (and update-level gnus-group-use-permanent-levels)
+ (setq gnus-group-use-permanent-levels level))))
(defun gnus-group-list-level (level &optional all)
"List groups on LEVEL.
@@ -2186,7 +2193,7 @@ handle COLLECTION as a list, hash table, or vector."
require-match initial-input
(or hist 'gnus-group-history)
def)))
- (replace-regexp-in-string "\n" "" group)))
+ (string-replace "\n" "" group)))
;;;###autoload
(defun gnus-fetch-group (group &optional articles)
@@ -3857,61 +3864,90 @@ Uses the process/prefix convention."
(defun gnus-group-unsubscribe (&optional n)
"Unsubscribe the current group."
(interactive "P" gnus-group-mode)
- (gnus-group-unsubscribe-current-group n 'unsubscribe))
+ (gnus-group-set-subscription-at-point n 'unsubscribe))
(defun gnus-group-subscribe (&optional n)
"Subscribe the current group."
(interactive "P" gnus-group-mode)
- (gnus-group-unsubscribe-current-group n 'subscribe))
+ (gnus-group-set-subscription-at-point n 'subscribe))
+
+(defsubst gnus-group-unsubscribe-current-group (&optional n do-sub)
+ (if do-sub
+ (gnus-group-set-subscription-at-point n do-sub)
+ (gnus-group-toggle-subscription-at-point n)))
+
+(defsubst gnus-group-unsubscribe-group (group &optional level silent)
+ (if level
+ (gnus-group-set-subscription group level silent)
+ (gnus-group-toggle-subscription group silent)))
+
+(make-obsolete 'gnus-group-unsubscribe-current-group
+ 'gnus-group-toggle-subscription-at-point "28.1")
+
+(make-obsolete 'gnus-group-unsubscribe-group
+ 'gnus-group-toggle-subscription "28.1")
-(defun gnus-group-unsubscribe-current-group (&optional n do-sub)
+(defun gnus-group-toggle-subscription-at-point (&optional n)
"Toggle subscription of the current group.
If given numerical prefix, toggle the N next groups."
(interactive "P" gnus-group-mode)
+ (gnus-group-set-subscription-at-point n 'toggle))
+
+(defun gnus-group-set-subscription-at-point (n do-sub)
+ "Set subscription of the current group for next N groups."
(dolist (group (gnus-group-process-prefix n))
(gnus-group-remove-mark group)
- (gnus-group-unsubscribe-group
+ (gnus-group-set-subscription
group
- (cond
- ((eq do-sub 'unsubscribe)
- gnus-level-default-unsubscribed)
- ((eq do-sub 'subscribe)
- gnus-level-default-subscribed)
- ((<= (gnus-group-group-level) gnus-level-subscribed)
- gnus-level-default-unsubscribed)
- (t
- gnus-level-default-subscribed))
+ (cl-case do-sub
+ (unsubscribe gnus-level-default-unsubscribed)
+ (subscribe gnus-level-default-subscribed)
+ (toggle (if (<= (gnus-group-group-level) gnus-level-subscribed)
+ gnus-level-default-unsubscribed
+ gnus-level-default-subscribed))
+ (t (error "Unknown subscription setting %s" do-sub)))
t)
(gnus-group-update-group-line))
(gnus-group-next-group 1))
-(defun gnus-group-unsubscribe-group (group &optional level silent)
- "Toggle subscription to GROUP.
-Killed newsgroups are subscribed. If SILENT, don't try to update the
-group line."
+(defun gnus-group-toggle-subscription (group &optional silent)
(interactive (list (gnus-group-completing-read
nil nil (gnus-read-active-file-p)))
gnus-group-mode)
+ (let* ((newsrc (gnus-group-entry group))
+ (level (cond
+ (newsrc
+ ;; Toggle subscription flag.
+ (if (<= (gnus-info-level (nth 1 newsrc))
+ gnus-level-subscribed)
+ (1+ gnus-level-subscribed)
+ gnus-level-default-subscribed))
+ ((and (stringp group)
+ (or (not (gnus-read-active-file-p))
+ (gnus-active group)))
+ ;; Add new newsgroup.
+ gnus-level-default-subscribed)
+ (t 'unsubscribe))))
+ (gnus-group-set-subscription group level silent)))
+
+(defun gnus-group-set-subscription (group level &optional silent)
+ "Set subscription of GROUP to LEVEL.
+Killed newsgroups are subscribed. If SILENT, don't try to update the
+group line."
(let ((newsrc (gnus-group-entry group)))
(cond
((string-match "\\`[ \t]*\\'" group)
(error "Empty group name"))
(newsrc
- ;; Toggle subscription flag.
- (gnus-group-change-level
- newsrc (or level (if (<= (gnus-info-level (nth 1 newsrc))
- gnus-level-subscribed)
- (1+ gnus-level-subscribed)
- gnus-level-default-subscribed)))
+ (gnus-group-change-level newsrc level)
(unless silent
(gnus-group-update-group group)))
((and (stringp group)
(or (not (gnus-read-active-file-p))
(gnus-active group)))
- ;; Add new newsgroup.
(gnus-group-change-level
group
- (or level gnus-level-default-subscribed)
+ level
(or (and (member group gnus-zombie-list)
gnus-level-zombie)
gnus-level-killed)
@@ -4176,8 +4212,9 @@ otherwise all levels below ARG will be scanned too."
(gnus-check-reasonable-setup)
(gnus-run-hooks 'gnus-after-getting-new-news-hook)
- (gnus-group-list-groups (and (numberp arg)
- (max (car gnus-group-list-mode) arg)))))
+ (gnus-group-list-groups (and (numberp arg) arg))
+ (when gnus-group-use-permanent-levels
+ (setq gnus-group-use-permanent-levels (gnus-group-default-level arg)))))
(defun gnus-group-get-new-news-this-group (&optional n dont-scan)
"Check for newly arrived news in the current group (and the N-1 next groups).
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index 1b2743c..5294b83 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -222,28 +222,32 @@
(uid . UID)))
(method (caddr (assoc 'METHOD (caddr (car (nreverse ical))))))
(attendee (when attendee-name-or-email
- (gnus-icalendar-event--find-attendee ical
attendee-name-or-email)))
+ (gnus-icalendar-event--find-attendee
+ ical attendee-name-or-email)))
(attendee-names (gnus-icalendar-event--get-attendee-names ical))
(role (plist-get (cadr attendee) 'ROLE))
(participation-type (pcase role
- ("REQ-PARTICIPANT" 'required)
- ("OPT-PARTICIPANT" 'optional)
- (_ 'non-participant)))
+ ("REQ-PARTICIPANT" 'required)
+ ("OPT-PARTICIPANT" 'optional)
+ (_ 'non-participant)))
(zone-map (icalendar--convert-all-timezones ical))
- (args (list :method method
- :organizer organizer
- :start-time (gnus-icalendar-event--decode-datefield event
'DTSTART zone-map)
- :end-time (gnus-icalendar-event--decode-datefield event
'DTEND zone-map)
- :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE")
- :participation-type participation-type
- :req-participants (car attendee-names)
- :opt-participants (cadr attendee-names)))
- (event-class (cond
- ((string= method "REQUEST")
'gnus-icalendar-event-request)
- ((string= method "CANCEL") 'gnus-icalendar-event-cancel)
- ((string= method "REPLY") 'gnus-icalendar-event-reply)
- (t 'gnus-icalendar-event))))
-
+ (args
+ (list :method method
+ :organizer organizer
+ :start-time (gnus-icalendar-event--decode-datefield
+ event 'DTSTART zone-map)
+ :end-time (gnus-icalendar-event--decode-datefield
+ event 'DTEND zone-map)
+ :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE")
+ :participation-type participation-type
+ :req-participants (car attendee-names)
+ :opt-participants (cadr attendee-names)))
+ (event-class
+ (cond
+ ((string= method "REQUEST") 'gnus-icalendar-event-request)
+ ((string= method "CANCEL") 'gnus-icalendar-event-cancel)
+ ((string= method "REPLY") 'gnus-icalendar-event-reply)
+ (t 'gnus-icalendar-event))))
(cl-labels
((map-property
(prop)
@@ -252,10 +256,10 @@
;; ugly, but cannot get
;;replace-regexp-in-string work with "\\" as
;;REP, plus we should also handle "\\;"
- (replace-regexp-in-string
- "\\\\," ","
- (replace-regexp-in-string
- "\\\\n" "\n" (substring-no-properties value))))))
+ (string-replace
+ "\\," ","
+ (string-replace
+ "\\n" "\n" (substring-no-properties value))))))
(accumulate-args
(mapping)
(cl-destructuring-bind (slot . ical-property) mapping
@@ -271,7 +275,11 @@
for keyword = (intern
(format ":%s" (eieio-slot-descriptor-name slot)))
when (plist-member args keyword)
- append (list keyword (plist-get args keyword)))))))
+ append (list keyword
+ (if (eq keyword :uid)
+ ;; The UID has to be a string.
+ (or (plist-get args keyword) "")
+ (plist-get args keyword))))))))
(defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-email)
"Parse RFC5545 iCalendar in buffer BUF and return an event object.
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index f73627a..525823e 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -435,7 +435,7 @@ Returns the number of articles marked as read."
;; The "f:+" command marks everything *but* the matches as read,
;; so we simply first match everything as read, and then unmark
;; PATTERN later.
- (when (string-match "\\+" commands)
+ (when (string-search "+" commands)
(gnus-kill "from" ".")
(setq commands "m"))
diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el
index d42f097..6adda2e 100644
--- a/lisp/gnus/gnus-mlspl.el
+++ b/lisp/gnus/gnus-mlspl.el
@@ -169,7 +169,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\")
returns:
(when (not (null params))
(let ((split-spec (assoc 'split-spec params)) group-clean)
;; Remove backend from group name
- (setq group-clean (string-match ":" group))
+ (setq group-clean (string-search ":" group))
(setq group-clean
(if group-clean
(substring group (1+ group-clean))
@@ -209,7 +209,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\")
returns:
"\\)"))
;; Now create the new SPLIT
(let ((split-regexp-with-list-ids
- (replace-regexp-in-string "@" "[@.]" split-regexp t t))
+ (string-replace "@" "[@.]" split-regexp))
(exclude
;; Generate RESTRICTs for SPLIT-EXCLUDEs.
(if (listp split-exclude)
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index db54237..ef89e6e 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1323,7 +1323,7 @@ For the \"inline\" alternatives, also see the variable
((stringp self)
(insert "Gcc: "
(encode-coding-string
- (if (string-match " " self)
+ (if (string-search " " self)
(concat "\"" self "\"")
self)
(gnus-group-name-charset (gnus-inews-group-method self)
@@ -1681,7 +1681,7 @@ this is a reply."
(gnus-group-find-parameter group 'gcc-self t)))
(gcc-self-get (lambda (gcc-self-val group)
(if (stringp gcc-self-val)
- (if (string-match " " gcc-self-val)
+ (if (string-search " " gcc-self-val)
(concat "\"" gcc-self-val "\"")
gcc-self-val)
;; In nndoc groups, we use the parent group name
@@ -1689,7 +1689,7 @@ this is a reply."
(let ((group (or (gnus-group-find-parameter
gnus-newsgroup-name 'parent-group)
group)))
- (if (string-match " " group)
+ (if (string-search " " group)
(concat "\"" group "\"")
group)))))
result
@@ -1752,11 +1752,11 @@ this is a reply."
(gnus-delete-line)))
;; Use the list of groups.
(while (setq name (pop groups))
- (let ((str (if (string-match ":" name)
+ (let ((str (if (string-search ":" name)
name
(gnus-group-prefixed-name
name gnus-message-archive-method))))
- (insert (if (string-match " " str)
+ (insert (if (string-search " " str)
(concat "\"" str "\"")
str)))
(when groups
diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el
index 5697c87..c135ece 100644
--- a/lisp/gnus/gnus-rfc1843.el
+++ b/lisp/gnus/gnus-rfc1843.el
@@ -44,7 +44,7 @@
(case-fold-search t)
(ct (message-fetch-field "Content-Type" t))
(ctl (and ct (mail-header-parse-content-type ct))))
- (if (and ctl (not (string-match "/" (car ctl))))
+ (if (and ctl (not (string-search "/" (car ctl))))
(setq ctl nil))
(goto-char (point-max))
(widen)
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 39bde83..2a8069d 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -572,7 +572,7 @@ nil.
If VALUE is a relative time, interpret it as relative to
REL-DATE, or (current-time) if REL-DATE is nil."
;; Time parsing doesn't seem to work with slashes.
- (let ((value (replace-regexp-in-string "/" "-" value))
+ (let ((value (string-replace "/" "-" value))
(now (append '(0 0 0)
(seq-subseq (decode-time (or rel-date
(current-time)))
@@ -980,7 +980,7 @@ Responsible for handling and, or, and parenthetical
expressions.")
;; Most search engines use implicit ANDs.
(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
- (_expr (eql and)))
+ (_expr (eql 'and)))
nil)
;; Most search engines use explicit infixed ORs.
@@ -1358,6 +1358,7 @@ Returns a list of [group article score] vectors."
server query &optional groups)
(let ((prefix (or (slot-value engine 'remove-prefix)
""))
+ (groups (mapcar #'gnus-group-short-name groups))
artlist article group)
(goto-char (point-min))
;; Prep prefix, we want to at least be removing the root
@@ -1384,7 +1385,6 @@ Returns a list of [group article score] vectors."
nil t)
nil t)
nil t))
- (setq group (gnus-group-full-name group server))
(setq article (file-name-nondirectory f-name)
article
;; TODO: Provide a cleaner way of producing final
@@ -1392,7 +1392,7 @@ Returns a list of [group article score] vectors."
(if (string-match-p "\\`[[:digit:]]+\\'" article)
(string-to-number article)
(nnmaildir-base-name-to-article-number
- (substring article 0 (string-match ":" article))
+ (substring article 0 (string-search ":" article))
group (string-remove-prefix "nnmaildir:" server))))
(when (and (numberp article)
(or (null groups)
@@ -1404,10 +1404,12 @@ Returns a list of [group article score] vectors."
(setq artlist (gnus-search-grep-search engine artlist grep-reg)))
;; Munge into the list of vectors expected by nnselect.
(mapcar (pcase-lambda (`(,_ ,article ,group ,score))
- (vector group article
- (if (numberp score)
- score
- (string-to-number score))))
+ (vector
+ (gnus-group-full-name group server)
+ article
+ (if (numberp score)
+ score
+ (string-to-number score))))
artlist)))
(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed))
@@ -1667,7 +1669,7 @@ cross our fingers for the rest of it."
Mairix negation requires a \"~\" preceding string search terms,
and \"-\" before marks."
(let ((next (gnus-search-transform-expression engine (cadr expr))))
- (replace-regexp-in-string
+ (string-replace
":"
(if (eql (caadr expr) 'mark)
":-"
@@ -1861,9 +1863,9 @@ Assume \"size\" key is equal to \"larger\"."
group
(if (file-directory-p
(setq group
- (replace-regexp-in-string
- "\\." "/"
- group nil t)))
+ (string-replace
+ "." "/"
+ group)))
group))))))
(unless group
(signal 'gnus-search-config-error
@@ -2134,7 +2136,7 @@ article came from is also searched."
;; If the value contains spaces, make sure it's
;; quoted.
(when (and (memql status '(exact finished))
- (or (string-match-p " " str)
+ (or (string-search " " str)
in-string))
(unless (looking-at-p "\\s\"")
(insert "\""))
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el
index cb60108..59c6956 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -582,7 +582,7 @@ or to characters when given a pad value."
((string= fstring "")
nil)
;; Not a format string.
- ((not (string-match "%" fstring))
+ ((not (string-search "%" fstring))
(list fstring))
;; A format string with just a single string spec.
((string= fstring "%s")
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index f66f842..1c75abb 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -716,7 +716,7 @@ claim them."
"\M-n" gnus-browse-next-group
"\M-p" gnus-browse-prev-group
"\r" gnus-browse-select-group
- "u" gnus-browse-unsubscribe-current-group
+ "u" gnus-browse-toggle-subscription-at-point
"l" gnus-browse-exit
"L" gnus-browse-exit
"q" gnus-browse-exit
@@ -735,7 +735,7 @@ claim them."
(easy-menu-define
gnus-browse-menu gnus-browse-mode-map ""
'("Browse"
- ["Subscribe" gnus-browse-unsubscribe-current-group t]
+ ["Toggle Subscribe" gnus-browse-toggle-subscription-at-point t]
["Read" gnus-browse-read-group t]
["Select" gnus-browse-select-group t]
["Describe" gnus-browse-describe-group t]
@@ -881,9 +881,9 @@ All normal editing commands are switched off.
\\<gnus-browse-mode-map>
The only things you can do in this buffer is
-1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group.
-The group will be inserted into the group buffer upon exit from this
-buffer.
+1) `\\[gnus-browse-toggle-subscription-at-point]' to subscribe or unsubscribe
to
+a group. The group will be inserted into the group buffer upon exit from
+this buffer.
2) `\\[gnus-browse-read-group]' to read a group ephemerally.
@@ -933,7 +933,12 @@ If NUMBER, fetch this number of articles."
(interactive "p" gnus-browse-mode)
(gnus-browse-next-group (- n)))
-(defun gnus-browse-unsubscribe-current-group (arg)
+(define-obsolete-function-alias 'gnus-browse-unsubscribe-current-group
+ 'gnus-browse-toggle-subscription-at-point "28.1")
+(define-obsolete-function-alias 'gnus-browse-unsubscribe-group
+ 'gnus-browse-toggle-subscription "28.1")
+
+(defun gnus-browse-toggle-subscription-at-point (arg)
"(Un)subscribe to the next ARG groups.
The variable `gnus-browse-subscribe-newsgroup-method' determines
how new groups will be entered into the group buffer."
@@ -944,7 +949,7 @@ how new groups will be entered into the group buffer."
(arg (abs arg)))
(while (and (> arg 0)
(not (eobp))
- (gnus-browse-unsubscribe-group)
+ (gnus-browse-toggle-subscription)
(zerop (gnus-browse-next-group ward)))
(cl-decf arg))
(gnus-group-position-point)
@@ -976,7 +981,7 @@ doing the deletion."
gnus-browse-mode)
(gnus-group-delete-group group force))
-(defun gnus-browse-unsubscribe-group ()
+(defun gnus-browse-toggle-subscription ()
"Toggle subscription of the current group in the browse buffer."
(let ((sub nil)
(buffer-read-only nil)
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 44e97d5..4bbeb24 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -715,6 +715,9 @@ the first newsgroup."
(kill-buffer (get-file-buffer gnus-current-startup-file)))
;; Clear the dribble buffer.
(gnus-dribble-clear)
+ ;; Reset the level when Gnus is restarted.
+ (when (numberp gnus-group-use-permanent-levels)
+ (setq gnus-group-use-permanent-levels t))
;; Kill global KILL file buffer.
(when (get-file-buffer (gnus-newsgroup-kill-file nil))
(kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
@@ -854,7 +857,7 @@ If REGEXP is given, lines that match it will be deleted."
(goto-char (point-max))
;; Make sure that each dribble entry is a single line, so that
;; the "remove" code above works.
- (insert (replace-regexp-in-string "\n" "\\\\n" string) "\n")
+ (insert (string-replace "\n" "\\n" string) "\n")
(bury-buffer gnus-dribble-buffer)
(with-current-buffer gnus-group-buffer
(gnus-group-set-mode-line)))))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 4bdc202..856e95c 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -9191,7 +9191,7 @@ specified by the `gnus-refer-thread-limit' variable."
(interactive "sMessage-ID: " gnus-summary-mode)
(when (and (stringp message-id)
(not (zerop (length message-id))))
- (setq message-id (replace-regexp-in-string " " "" message-id))
+ (setq message-id (string-replace " " "" message-id))
;; Construct the correct Message-ID if necessary.
;; Suggested by tale@pawl.rpi.edu.
(unless (string-match "^<" message-id)
@@ -9199,7 +9199,7 @@ specified by the `gnus-refer-thread-limit' variable."
(unless (string-match ">$" message-id)
(setq message-id (concat message-id ">")))
;; People often post MIDs from URLs, so unhex it:
- (unless (string-match "@" message-id)
+ (unless (string-search "@" message-id)
(setq message-id (gnus-url-unhex-string message-id)))
(let* ((header (gnus-id-to-header message-id))
(sparse (and header
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index 568fbbc..c8bcccd 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -71,6 +71,14 @@ See Info node `(gnus)Formatting Variables'."
"If non-nil, display the topic lines even of topics that have no unread
articles."
:type 'boolean)
+(defcustom gnus-topic-display-predicate nil
+ "If non-nil, this should be a function to control the display of the topic.
+The function is called with one parameter -- the topic name, and
+should return non-nil if the topic is to be displayed."
+ :version "28.1"
+ :type '(choice (const :tag "Display all topics" nil)
+ function))
+
;; Internal variables.
(defvar gnus-topic-active-topology nil)
@@ -487,18 +495,16 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST
or higher."
If SILENT, don't insert anything. Return the number of unread
articles in the topic and its subtopics."
(let* ((type (pop topicl))
+ (name (car type))
(entries-level (if gnus-group-listed-groups
gnus-level-killed
list-level))
(all (or predicate gnus-group-listed-groups
(cdr (assq 'visible
- (gnus-topic-hierarchical-parameters
- (car type))))))
+ (gnus-topic-hierarchical-parameters name)))))
(lowest (if gnus-group-listed-groups 0 lowest))
- (entries (gnus-topic-find-groups
- (car type) entries-level all lowest))
- (all-groups (gnus-topic-find-groups
- (car type) entries-level all lowest t))
+ (entries (gnus-topic-find-groups name entries-level all lowest))
+ (all-groups (gnus-topic-find-groups name entries-level all lowest t))
(visiblep (and (eq (nth 1 type) 'visible) (not silent)))
(gnus-group-indentation
(make-string (* gnus-topic-indent-level level) ? ))
@@ -508,80 +514,84 @@ articles in the topic and its subtopics."
(point-max (point-max))
(unread 0)
info entry end active tick)
- ;; Insert any sub-topics.
- (while topicl
- (cl-incf unread
- (gnus-topic-prepare-topic
- (pop topicl) (1+ level) list-level predicate
- (not visiblep) lowest regexp)))
- (setq end (point))
- (goto-char beg)
- ;; Insert all the groups that belong in this topic.
- (while (setq entry (pop entries))
- (when (if (stringp entry)
- (gnus-group-prepare-logic
- entry
- (and
- (or (not gnus-group-listed-groups)
- (if (< list-level gnus-level-zombie) nil
- (let ((entry-level
- (if (member entry gnus-zombie-list)
- gnus-level-zombie gnus-level-killed)))
- (and (<= entry-level list-level)
- (>= entry-level lowest)))))
- (cond
- ((stringp regexp)
- (string-match regexp entry))
- ((functionp regexp)
- (funcall regexp entry))
- ((null regexp) t)
- (t nil))))
- (setq info (nth 1 entry))
- (gnus-group-prepare-logic
- (gnus-info-group info)
- (and (or (not gnus-group-listed-groups)
- (let ((entry-level (gnus-info-level info)))
- (and (<= entry-level list-level)
- (>= entry-level lowest))))
- (or (not (functionp predicate))
- (funcall predicate info))
- (or (not (stringp regexp))
- (string-match regexp (gnus-info-group info))))))
- (when visiblep
- (if (stringp entry)
- ;; Dead groups.
- (gnus-group-insert-group-line
- entry (if (member entry gnus-zombie-list)
- gnus-level-zombie gnus-level-killed)
- nil (- (1+ (cdr (setq active (gnus-active entry))))
- (car active))
- nil)
- ;; Living groups.
- (when (setq info (nth 1 entry))
- (gnus-group-insert-group-line
- (gnus-info-group info)
- (gnus-info-level info) (gnus-info-marks info)
- (car entry) (gnus-info-method info)))))
- (when (and (listp entry)
- (numberp (car entry)))
- (cl-incf unread (car entry)))
- (when (listp entry)
- (setq tick t))))
- (goto-char beg)
- ;; Insert the topic line.
- (when (and (not silent)
- (or gnus-topic-display-empty-topics ;We want empty topics
- (not (zerop unread)) ;Non-empty
- tick ;Ticked articles
- (/= point-max (point-max)))) ;Inactive groups
- (gnus-topic-insert-topic-line
- (car type) visiblep
- (not (eq (nth 2 type) 'hidden))
- level all-entries unread all-groups))
- (gnus-topic-update-unreads (car type) unread)
- (gnus-group--setup-tool-bar-update beg end)
- (goto-char end)
- unread))
+ (if (and gnus-topic-display-predicate
+ (not (funcall gnus-topic-display-predicate name)))
+ ;; We're filtering out this topic.
+ 0
+ ;; Insert any sub-topics.
+ (while topicl
+ (cl-incf unread
+ (gnus-topic-prepare-topic
+ (pop topicl) (1+ level) list-level predicate
+ (not visiblep) lowest regexp)))
+ (setq end (point))
+ (goto-char beg)
+ ;; Insert all the groups that belong in this topic.
+ (while (setq entry (pop entries))
+ (when (if (stringp entry)
+ (gnus-group-prepare-logic
+ entry
+ (and
+ (or (not gnus-group-listed-groups)
+ (if (< list-level gnus-level-zombie) nil
+ (let ((entry-level
+ (if (member entry gnus-zombie-list)
+ gnus-level-zombie gnus-level-killed)))
+ (and (<= entry-level list-level)
+ (>= entry-level lowest)))))
+ (cond
+ ((stringp regexp)
+ (string-match regexp entry))
+ ((functionp regexp)
+ (funcall regexp entry))
+ ((null regexp) t)
+ (t nil))))
+ (setq info (nth 1 entry))
+ (gnus-group-prepare-logic
+ (gnus-info-group info)
+ (and (or (not gnus-group-listed-groups)
+ (let ((entry-level (gnus-info-level info)))
+ (and (<= entry-level list-level)
+ (>= entry-level lowest))))
+ (or (not (functionp predicate))
+ (funcall predicate info))
+ (or (not (stringp regexp))
+ (string-match regexp (gnus-info-group info))))))
+ (when visiblep
+ (if (stringp entry)
+ ;; Dead groups.
+ (gnus-group-insert-group-line
+ entry (if (member entry gnus-zombie-list)
+ gnus-level-zombie gnus-level-killed)
+ nil (- (1+ (cdr (setq active (gnus-active entry))))
+ (car active))
+ nil)
+ ;; Living groups.
+ (when (setq info (nth 1 entry))
+ (gnus-group-insert-group-line
+ (gnus-info-group info)
+ (gnus-info-level info) (gnus-info-marks info)
+ (car entry) (gnus-info-method info)))))
+ (when (and (listp entry)
+ (numberp (car entry)))
+ (cl-incf unread (car entry)))
+ (when (listp entry)
+ (setq tick t))))
+ (goto-char beg)
+ ;; Insert the topic line.
+ (when (and (not silent)
+ (or gnus-topic-display-empty-topics ;We want empty topics
+ (not (zerop unread)) ;Non-empty
+ tick ;Ticked articles
+ (/= point-max (point-max)))) ;Inactive groups
+ (gnus-topic-insert-topic-line
+ name visiblep
+ (not (eq (nth 2 type) 'hidden))
+ level all-entries unread all-groups))
+ (gnus-topic-update-unreads name unread)
+ (gnus-group--setup-tool-bar-update beg end)
+ (goto-char end)
+ unread)))
(defun gnus-topic-remove-topic (&optional insert total-remove _hide in-level)
"Remove the current topic."
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index be02845..70ae81d 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -154,7 +154,7 @@ is slower."
(and (string-match "(.+)" from)
(setq name (substring from (1+ (match-beginning 0))
(1- (match-end 0)))))
- (and (string-match "()" from)
+ (and (string-search "()" from)
(setq name address))
;; XOVER might not support folded From headers.
(and (string-match "(.*" from)
@@ -265,7 +265,7 @@ If END is non-nil, use the end of the span instead."
(defun gnus-newsgroup-directory-form (newsgroup)
"Make hierarchical directory name from NEWSGROUP name."
(let* ((newsgroup (gnus-newsgroup-savable-name newsgroup))
- (idx (string-match ":" newsgroup)))
+ (idx (string-search ":" newsgroup)))
(concat
(if idx (substring newsgroup 0 idx))
(if idx "/")
@@ -408,7 +408,7 @@ Cache the result as a text property stored in DATE."
(defun gnus-mode-string-quote (string)
"Quote all \"%\"'s in STRING."
- (replace-regexp-in-string "%" "%%" string))
+ (string-replace "%" "%%" string))
(defsubst gnus-make-hashtable (&optional size)
"Make a hash table of SIZE, testing on `equal'."
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index ceb2ebc..6c92638 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -1434,7 +1434,7 @@ When called interactively, prompt for REGEXP."
"View FILE using the gnus-uu methods."
(let ((action (gnus-uu-get-action file)))
(gnus-execute-command
- (if (string-match "%" action)
+ (if (string-search "%" action)
(format action file)
(concat action " " file))
(eq gnus-view-pseudos 'not-confirm))))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 7dde799..d52bd26 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -525,25 +525,26 @@ be set in `.emacs' instead."
;; Summary mode faces.
-(defface gnus-summary-selected '((t (:underline t)))
+(defface gnus-summary-selected '((t (:underline t :extend t)))
"Face used for selected articles."
:group 'gnus-summary)
(defface gnus-summary-cancelled
'((((class color))
- (:foreground "yellow" :background "black")))
+ (:foreground "yellow" :background "black" :extend t))
+ (t (:extend t)))
"Face used for canceled articles."
:group 'gnus-summary)
(defface gnus-summary-normal-ticked
'((((class color)
(background dark))
- (:foreground "pink"))
+ (:foreground "pink" :extend t))
(((class color)
(background light))
- (:foreground "firebrick"))
+ (:foreground "firebrick" :extend t))
(t
- ()))
+ (:extend t)))
"Face used for normal interest ticked articles."
:group 'gnus-summary)
@@ -560,12 +561,12 @@ be set in `.emacs' instead."
(defface gnus-summary-normal-ancient
'((((class color)
(background dark))
- (:foreground "SkyBlue"))
+ (:foreground "SkyBlue" :extend t))
(((class color)
(background light))
- (:foreground "RoyalBlue"))
+ (:foreground "RoyalBlue" :extend t))
(t
- ()))
+ (:extend t)))
"Face used for normal interest ancient articles."
:group 'gnus-summary)
@@ -582,10 +583,10 @@ be set in `.emacs' instead."
(defface gnus-summary-normal-undownloaded
'((((class color)
(background light))
- (:foreground "cyan4" :bold nil))
+ (:foreground "cyan4" :bold nil :extend t))
(((class color) (background dark))
- (:foreground "LightGray" :bold nil))
- (t (:inverse-video t)))
+ (:foreground "LightGray" :bold nil :extend t))
+ (t (:inverse-video t :extend t)))
"Face used for normal interest uncached articles."
:group 'gnus-summary)
@@ -601,7 +602,7 @@ be set in `.emacs' instead."
(defface gnus-summary-normal-unread
'((t
- ()))
+ (:extend t)))
"Face used for normal interest unread articles."
:group 'gnus-summary)
@@ -618,12 +619,12 @@ be set in `.emacs' instead."
(defface gnus-summary-normal-read
'((((class color)
(background dark))
- (:foreground "PaleGreen"))
+ (:foreground "PaleGreen" :extend t))
(((class color)
(background light))
- (:foreground "DarkGreen"))
+ (:foreground "DarkGreen" :extend t))
(t
- ()))
+ (:extend t)))
"Face used for normal interest read articles."
:group 'gnus-summary)
@@ -3525,7 +3526,7 @@ You should probably use `gnus-find-method-for-group'
instead."
(defun gnus-group-native-p (group)
"Say whether the group is native or not."
- (not (string-match ":" group)))
+ (not (string-search ":" group)))
(defun gnus-group-secondary-p (group)
"Say whether the group is secondary or not."
@@ -3741,13 +3742,13 @@ just the host name."
;; Separate foreign select method from group name and collapse.
;; If method contains a server, collapse to non-domain server name,
;; otherwise collapse to select method.
- (let* ((colon (string-match ":" group))
+ (let* ((colon (string-search ":" group))
(server (and colon (substring group 0 colon)))
- (plus (and server (string-match "\\+" server))))
+ (plus (and server (string-search "+" server))))
(when server
(if plus
(setq foreign (substring server (+ 1 plus)
- (string-match "\\." server))
+ (string-search "." server))
group (substring group (+ 1 colon)))
(setq foreign server
group (substring group (+ 1 colon))))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 9baf09b..bff1b2a 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -5340,7 +5340,7 @@ Otherwise, generate and save a value for
`canlock-password' first."
(followup-to (message-fetch-field "followup-to"))
to)
(when (and newsgroups
- (string-match "," newsgroups)
+ (string-search "," newsgroups)
(not followup-to)
(not
(zerop
@@ -5357,7 +5357,7 @@ Otherwise, generate and save a value for
`canlock-password' first."
;; Check "Shoot me".
(message-check 'shoot
(if (re-search-forward
- "Message-ID.*.i-did-not-set--mail-host-address--so-tickle-me" nil t)
+ "Message-ID.*.mail-host-address-is-not-set" nil t)
(y-or-n-p "You appear to have a misconfigured system. Really post? ")
t))
;; Check for Approved.
@@ -5371,11 +5371,11 @@ Otherwise, generate and save a value for
`canlock-password' first."
(message-id (message-fetch-field "message-id" t)))
(or (not message-id)
;; Is there an @ in the ID?
- (and (string-match "@" message-id)
+ (and (string-search "@" message-id)
;; Is there a dot in the ID?
(string-match "@[^.]*\\." message-id)
;; Does the ID end with a dot?
- (not (string-match "\\.>" message-id)))
+ (not (string-search ".>" message-id)))
(y-or-n-p
(format "The Message-ID looks strange: \"%s\". Really post? "
message-id)))))
@@ -5497,8 +5497,8 @@ Otherwise, generate and save a value for
`canlock-password' first."
"@[^\\.]*\\."
(setq ad (nth 1 (mail-extract-address-components
from))))) ;larsi@ifi
- (string-match "\\.\\." ad) ;larsi@ifi..uio
- (string-match "@\\." ad) ;larsi@.ifi.uio
+ (string-search ".." ad) ;larsi@ifi..uio
+ (string-search "@." ad) ;larsi@.ifi.uio
(string-match "\\.$" ad) ;larsi@ifi.uio.
(not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
(string-match "(.*).*(.*)" from)) ;(lars) (lars)
@@ -5523,7 +5523,7 @@ Otherwise, generate and save a value for
`canlock-password' first."
(cond
((not reply-to)
t)
- ((string-match "," reply-to)
+ ((string-search "," reply-to)
(y-or-n-p
(format "Multiple Reply-To addresses: \"%s\". Really post? "
reply-to)))
@@ -5531,8 +5531,8 @@ Otherwise, generate and save a value for
`canlock-password' first."
"@[^\\.]*\\."
(setq ad (nth 1 (mail-extract-address-components
reply-to))))) ;larsi@ifi
- (string-match "\\.\\." ad) ;larsi@ifi..uio
- (string-match "@\\." ad) ;larsi@.ifi.uio
+ (string-search ".." ad) ;larsi@ifi..uio
+ (string-search "@." ad) ;larsi@.ifi.uio
(string-match "\\.$" ad) ;larsi@ifi.uio.
(not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
(string-match "(.*).*(.*)" reply-to)) ;(lars) (lars)
@@ -5806,7 +5806,7 @@ In posting styles use `(\"Expires\" (make-expires-date
30))'."
(mail-header-subject message-reply-headers))
(message-strip-subject-re psubject))))
(and psupersedes
- (string-match "_-_@" psupersedes)))
+ (string-search "_-_@" psupersedes)))
"_-_" ""))
"@" (message-make-fqdn) ">"))
@@ -6022,7 +6022,7 @@ give as trustworthy answer as possible."
"Return the pertinent part of `user-mail-address'."
(when (and user-mail-address
(string-match "@.*\\." user-mail-address))
- (if (string-match " " user-mail-address)
+ (if (string-search " " user-mail-address)
(nth 1 (mail-extract-address-components user-mail-address))
user-mail-address)))
@@ -6053,7 +6053,7 @@ give as trustworthy answer as possible."
message-user-fqdn)
;; A system name without any dots is unlikely to be a good fully
;; qualified domain name.
- ((and (string-match "[.]" sysname)
+ ((and (string-search "." sysname)
(not (string-match message-bogus-system-names sysname)))
;; `system-name' returned the right result.
sysname)
@@ -6068,8 +6068,7 @@ give as trustworthy answer as possible."
user-domain)
;; Default to this bogus thing.
(t
- (concat sysname
- ".i-did-not-set--mail-host-address--so-tickle-me")))))
+ (concat sysname ".mail-host-address-is-not-set")))))
(defun message-make-domain ()
"Return the domain name."
@@ -7054,7 +7053,7 @@ article, it has the value of
" mft "
-which directs your response to " (if (string-match "," mft)
+which directs your response to " (if (string-search "," mft)
"the specified addresses"
"that address only") ".
@@ -7358,7 +7357,7 @@ want to get rid of this query permanently."))
You should normally obey the Followup-To: header.
`Followup-To: " followup-to "'
-directs your response to " (if (string-match "," followup-to)
+directs your response to " (if (string-search "," followup-to)
"the specified newsgroups"
"that newsgroup only") ".
@@ -8600,7 +8599,7 @@ From headers in the original article."
(let ((value (message-field-value header)))
(dolist (string (mail-header-parse-addresses value 'raw))
(setq string
- (replace-regexp-in-string
+ (string-replace
"\n" ""
(replace-regexp-in-string "^ +\\| +$" "" string)))
(ecomplete-add-item 'mail (car (mail-header-parse-address string))
@@ -8890,7 +8889,7 @@ used to take the screenshot."
(defun message-parse-mailto-url (url)
"Parse a mailto: url."
- (setq url (replace-regexp-in-string "\n" " " url))
+ (setq url (string-replace "\n" " " url))
(when (string-match "mailto:/*\\(.*\\)" url)
(setq url (substring url (match-beginning 1) nil)))
(setq url (if (string-match "^\\?" url)
@@ -8932,9 +8931,9 @@ will then start up Emacs ready to compose mail. For
emacsclient use
(dolist (arg args)
(unless (equal (car arg) "body")
(message-position-on-field (capitalize (car arg)))
- (insert (replace-regexp-in-string
+ (insert (string-replace
"\r\n" "\n"
- (mapconcat #'identity (reverse (cdr arg)) ", ") nil t))))
+ (mapconcat #'identity (reverse (cdr arg)) ", ")))))
(when (assoc "body" args)
(message-goto-body)
(dolist (body (cdr (assoc "body" args)))
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 02cd6af..82d1de2 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -649,7 +649,7 @@ MIME-Version header before proceeding."
(setq description (mail-decode-encoded-word-string
description)))))
(if (or (not ctl)
- (not (string-match "/" (car ctl))))
+ (not (string-search "/" (car ctl))))
(mm-dissect-singlepart
(list mm-dissect-default-type)
(and cte (intern (downcase (mail-header-strip-cte cte))))
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index 15157e6..b497935 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -1022,7 +1022,7 @@ Returns non-nil if the user has chosen to use SENDER."
(if (eq 'OpenPGP protocol)
(epg-sign-string context (buffer-string) mode)
(epg-sign-string context
- (replace-regexp-in-string
+ (string-replace
"\n" "\r\n" (buffer-string))
t))
mml-secure-secret-key-id-list nil)
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index 5c133e6..959de09 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -404,7 +404,7 @@ Content-Disposition: attachment; filename=smime.p7m
nil t)))))
(mm-sec-error 'gnus-info "Corrupted")
(throw 'error handle))
- (setq part (replace-regexp-in-string "\n" "\r\n" part)
+ (setq part (string-replace "\n" "\r\n" part)
context (epg-make-context 'CMS))
(condition-case error
;; (setq plain
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 1af7d10..8c40fc7 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -863,7 +863,7 @@ If set, it overrides the setting of
`mml2015-sign-with-sender'."
nil t))))
(mm-sec-error 'gnus-info "Corrupted")
(throw 'error handle))
- (setq part (replace-regexp-in-string "\n" "\r\n" part)
+ (setq part (string-replace "\n" "\r\n" part)
signature (mm-get-part signature)
context (epg-make-context))
(condition-case error
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 708887c..c35e892 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -803,7 +803,7 @@ If FORMAT isn't a format string, it and all ARGS will be
inserted
without formatting."
(with-current-buffer nntp-server-buffer
(erase-buffer)
- (if (string-match "%" format)
+ (if (string-search "%" format)
(insert (apply #'format format args))
(apply #'insert format args))
t))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 3e2a202..8a48cd8 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -599,6 +599,13 @@ during splitting, which may be slow."
(eq nnimap-authenticator 'anonymous)
(eq nnimap-authenticator 'login)))
(nnimap-command "LOGIN %S %S" user password))
+ ((and (nnimap-capability "AUTH=XOAUTH2")
+ (eq nnimap-authenticator 'xoauth2))
+ (nnimap-command "AUTHENTICATE XOAUTH2 %s"
+ (base64-encode-string
+ (format "user=%s\001auth=Bearer %s\001\001"
+ (nnimap-quote-specials user)
+ (nnimap-quote-specials password)))))
((and (nnimap-capability "AUTH=CRAM-MD5")
(or (null nnimap-authenticator)
(eq nnimap-authenticator 'cram-md5)))
@@ -1292,7 +1299,7 @@ If LIMIT, first try to limit the search to the N last
articles."
(when (and (nnimap-greeting nnimap-object)
(string-match greeting-match (nnimap-greeting nnimap-object))
(eq type 'append)
- (string-match "\000" data))
+ (string-search "\000" data))
(let ((choice (gnus-multiple-choice
"Message contains NUL characters. Delete, continue, abort? "
'((?d "Delete NUL characters")
@@ -1754,7 +1761,7 @@ If LIMIT, first try to limit the search to the N last
articles."
(let ((result nil))
(dolist (elem (split-string irange ","))
(push
- (if (string-match ":" elem)
+ (if (string-search ":" elem)
(let ((numbers (split-string elem ":")))
(cons (string-to-number (car numbers))
(string-to-number (cadr numbers))))
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 4867455..171f081 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -87,7 +87,7 @@ See `nnmaildir-flag-mark-mapping'."
(defun nnmaildir--ensure-suffix (filename)
"Ensure that FILENAME contains the suffix \":2,\"."
- (if (string-match-p ":2," filename)
+ (if (string-search ":2," filename)
filename
(concat filename ":2,")))
@@ -637,13 +637,11 @@ This variable is set by `nnmaildir-request-article'.")
(funcall func (cdr entry)))))))
(defun nnmaildir--system-name ()
- (replace-regexp-in-string
+ (string-replace
":" "\\072"
- (replace-regexp-in-string
+ (string-replace
"/" "\\057"
- (replace-regexp-in-string "\\\\" "\\134" (system-name) nil 'literal)
- nil 'literal)
- nil 'literal))
+ (string-replace "\\" "\\134" (system-name)))))
(defun nnmaildir-request-type (_group &optional _article)
'mail)
@@ -937,9 +935,9 @@ This variable is set by `nnmaildir-request-article'.")
(setq pgname (nnmaildir--pgname nnmaildir--cur-server gname)
ro (nnmaildir--param pgname 'read-only))
- (insert (replace-regexp-in-string
+ (insert (string-replace
" " "\\ "
- (nnmaildir--grp-name group) nil t)
+ (nnmaildir--grp-name group))
" ")
(princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
nntp-server-buffer)
@@ -968,7 +966,7 @@ This variable is set by `nnmaildir-request-article'.")
(princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
nntp-server-buffer)
(insert " "
- (replace-regexp-in-string " " "\\ " gname nil t)
+ (string-replace " " "\\ " gname)
"\n")))))
'group)
@@ -1098,7 +1096,7 @@ This variable is set by `nnmaildir-request-article'.")
(insert " ")
(princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
nntp-server-buffer)
- (insert " " (replace-regexp-in-string " " "\\ " gname nil t) "\n")
+ (insert " " (string-replace " " "\\ " gname) "\n")
t))))
(defun nnmaildir-request-create-group (gname &optional server _args)
@@ -1262,7 +1260,7 @@ This variable is set by `nnmaildir-request-article'.")
(insert "\t" (nnmaildir--nov-get-beg nov) "\t"
(nnmaildir--art-msgid article) "\t"
(nnmaildir--nov-get-mid nov) "\tXref: nnmaildir "
- (replace-regexp-in-string " " "\\ " gname nil t) ":")
+ (string-replace " " "\\ " gname) ":")
(princ num nntp-server-buffer)
(insert "\t" (nnmaildir--nov-get-end nov) "\n"))))
(catch 'return
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index c6aaf46..9294488 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -1629,7 +1629,7 @@ SERVER."
(while (string-match "[<>]" mid)
(setq mid (replace-match "" t t mid)))
;; mairix somehow does not like '$' in message-id
- (when (string-match "\\$" mid)
+ (when (string-search "$" mid)
(setq mid (concat mid "=")))
(while (string-match "\\$" mid)
(setq mid (replace-match "=," t t mid)))
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index a40fa88..97c9f18 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -785,7 +785,7 @@ It is useful when `(setq nnrss-use-local t)'."
(nnrss-node-just-text node)
node))
(cleaned-text (if text
- (replace-regexp-in-string
+ (string-replace
"\r\n" "\n"
(replace-regexp-in-string
"^[\000-\037\177]+\\|^ +\\| +$" ""
@@ -849,7 +849,7 @@ DATA should be the output of `xml-parse-region'."
(defmacro nnrss-match-macro (base-uri item onsite-list offsite-list)
`(cond ((or (string-match (concat "^" ,base-uri) ,item)
- (not (string-match "://" ,item)))
+ (not (string-search "://" ,item)))
(setq ,onsite-list (append ,onsite-list (list ,item))))
(t (setq ,offsite-list (append ,offsite-list (list ,item))))))
@@ -954,9 +954,10 @@ Simply ensures that the first element is rss or rdf."
"Given EL (containing a parsed element) and URI (containing a string
that gives the URI for which you want to retrieve the namespace
prefix), return the prefix."
- (let* ((prefix (car (rassoc uri (dom-attributes
- (dom-search
- el
+ (let* ((dom (car el))
+ (prefix (car (rassoc uri (dom-attributes
+ (dom-search
+ dom
(lambda (node)
(rassoc uri (dom-attributes node))))))))
(nslist (if prefix
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 1fd2ed0..615a3c9 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -1697,7 +1697,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
;; article comes from that group, I'd say.
((and (setq newsgroups
(mail-fetch-field "newsgroups"))
- (not (string-match "," newsgroups)))
+ (not (string-search "," newsgroups)))
newsgroups)
;; If there is more than one group in the
;; Newsgroups header, then the Xref header should
@@ -1725,7 +1725,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
number (string-to-number (match-string 2 xref))))
((and (setq newsgroups
(mail-fetch-field "newsgroups"))
- (not (string-match "," newsgroups)))
+ (not (string-search "," newsgroups)))
(setq group newsgroups))
(group)
(t (setq group ""))))
diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el
index a4234f8..5fa280e 100644
--- a/lisp/gnus/spam-report.el
+++ b/lisp/gnus/spam-report.el
@@ -159,7 +159,7 @@ submitted at once. Internal variable.")
rpt-host
(concat
"/"
- (replace-regexp-in-string
+ (string-replace
"/" ":"
(replace-regexp-in-string
"^.*article.gmane.org/" ""
@@ -224,7 +224,7 @@ the function specified by `spam-report-url-ping-function'."
(defcustom spam-report-user-mail-address
(and (stringp user-mail-address)
- (replace-regexp-in-string "@" "<at>" user-mail-address))
+ (string-replace "@" "<at>" user-mail-address))
"Mail address of this user used for spam reports to Gmane.
This is initialized based on `user-mail-address'."
:type '(choice string
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 76417746..2c7956d 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -154,7 +154,7 @@ with the current prefix. The files are chosen according to
(mapcar (lambda (c)
(let* ((s (intern c))
(doc (condition-case nil (documentation s) (error nil)))
- (doc (and doc (substring doc 0 (string-match "\n" doc)))))
+ (doc (and doc (substring doc 0 (string-search "\n" doc)))))
(list c (propertize
(format "%-4s" (help--symbol-class s))
'face 'completions-annotations)
@@ -1078,7 +1078,9 @@ it is displayed along with the global value."
(with-current-buffer standard-output
(setq help-mode--current-data
(list :symbol variable
- :type 'variable
+ :type (if (eq file-name 'C-source)
+ 'variable
+ 'defvar)
:file file-name))
(save-excursion
(re-search-backward (substitute-command-keys
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 3976a9a..08182b7 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -35,7 +35,6 @@
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (make-composed-keymap button-buffer-map
special-mode-map))
- (define-key map [mouse-2] 'help-follow-mouse)
(define-key map "l" 'help-go-back)
(define-key map "r" 'help-go-forward)
(define-key map "\C-c\C-b" 'help-go-back)
@@ -43,7 +42,6 @@
(define-key map [XF86Back] 'help-go-back)
(define-key map [XF86Forward] 'help-go-forward)
(define-key map "\C-c\C-c" 'help-follow-symbol)
- (define-key map "\r" 'help-follow)
(define-key map "s" 'help-view-source)
(define-key map "i" 'help-goto-info)
(define-key map "c" 'help-customize)
@@ -72,6 +70,35 @@
["Customize" help-customize
:help "Customize variable or face"]))
+(defun help-mode-context-menu (menu)
+ (define-key menu [help-mode-separator] menu-bar-separator)
+ (let ((easy-menu (make-sparse-keymap "Help-Mode")))
+ (easy-menu-define nil easy-menu nil
+ '("Help-Mode"
+ ["Previous Topic" help-go-back
+ :help "Go back to previous topic in this help buffer"
+ :active help-xref-stack]
+ ["Next Topic" help-go-forward
+ :help "Go back to next topic in this help buffer"
+ :active help-xref-forward-stack]))
+ (dolist (item (reverse (lookup-key easy-menu [menu-bar help-mode])))
+ (when (consp item)
+ (define-key menu (vector (car item)) (cdr item)))))
+
+ (when (and
+ ;; First check if `help-fns--list-local-commands'
+ ;; used `where-is-internal' to call this function
+ ;; with wrong `last-input-event'.
+ (eq (current-buffer) (window-buffer (posn-window (event-start
last-input-event))))
+ (mouse-posn-property (event-start last-input-event) 'mouse-face))
+ (define-key menu [help-mode-push-button]
+ '(menu-item "Follow Link" (lambda (event)
+ (interactive "e")
+ (push-button event))
+ :help "Follow the link at click")))
+
+ menu)
+
(defvar help-mode-tool-bar-map
(let ((map (make-sparse-keymap)))
(tool-bar-local-item "close" 'quit-window 'quit map
@@ -88,20 +115,20 @@
(defvar-local help-xref-stack nil
"A stack of ways by which to return to help buffers after following xrefs.
-Used by `help-follow' and `help-xref-go-back'.
+Used by `help-follow-symbol' and `help-xref-go-back'.
An element looks like (POSITION FUNCTION ARGS...).
To use the element, do (apply FUNCTION ARGS) then goto the point.")
(put 'help-xref-stack 'permanent-local t)
(defvar-local help-xref-forward-stack nil
"A stack used to navigate help forwards after using the back button.
-Used by `help-follow' and `help-xref-go-forward'.
+Used by `help-follow-symbol' and `help-xref-go-forward'.
An element looks like (POSITION FUNCTION ARGS...).
To use the element, do (apply FUNCTION ARGS) then goto the point.")
(put 'help-xref-forward-stack 'permanent-local t)
(defvar-local help-xref-stack-item nil
- "An item for `help-follow' in this buffer to push onto `help-xref-stack'.
+ "An item for `help-follow-symbol' to push onto `help-xref-stack'.
The format is (FUNCTION ARGS...).")
(put 'help-xref-stack-item 'permanent-local t)
@@ -113,6 +140,15 @@ The format is (FUNCTION ARGS...).")
(setq-default help-xref-stack nil help-xref-stack-item nil)
(setq-default help-xref-forward-stack nil help-xref-forward-stack-item nil)
+(defvar help-mode-syntax-table
+ (let ((table (make-syntax-table emacs-lisp-mode-syntax-table)))
+ ;; Treat single quotes as parens so that forward-sexp does not
+ ;; break when a quoted string contains punctuation.
+ (modify-syntax-entry ?‘ "(’ " table)
+ (modify-syntax-entry ?’ ")‘ " table)
+ table)
+ "Syntax table used in `help-mode'.")
+
(defcustom help-mode-hook nil
"Hook run by `help-mode'."
:type 'hook
@@ -192,6 +228,11 @@ The format is (FUNCTION ARGS...).")
'help-function #'info
'help-echo (purecopy "mouse-2, RET: read this Info node"))
+(define-button-type 'help-customization-group
+ :supertype 'help-xref
+ 'help-function #'customize-group
+ 'help-echo (purecopy "mouse-2, RET: display this customization group"))
+
(define-button-type 'help-url
:supertype 'help-xref
'help-function #'browse-url
@@ -342,6 +383,7 @@ Commands:
\\{help-mode-map}"
(setq-local revert-buffer-function
#'help-mode-revert-buffer)
+ (add-hook 'context-menu-functions 'help-mode-context-menu 5 t)
(setq-local tool-bar-map
help-mode-tool-bar-map)
(setq-local help-mode--current-data nil)
@@ -400,6 +442,10 @@ when help commands related to multilingual environment
(e.g.,
"\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+['`‘]\\([^'’]+\\)['’]")
"Regexp matching doc string references to an Info node.")
+(defconst help-xref-customization-group-regexp
+ (purecopy "\\<[Cc]ustomization[ \t\n]+[Gg]roup[ \t\n]+['`‘]\\([^'’]+\\)['’]")
+ "Regexp matching doc string references to a customization group.")
+
(defconst help-xref-url-regexp
(purecopy "\\<[Uu][Rr][Ll][ \t\n]+['`‘]\\([^'’]+\\)['’]")
"Regexp matching doc string references to a URL.")
@@ -466,7 +512,7 @@ Each element has the form (NAME TESTFUN DESCFUN) where:
"Parse and hyperlink documentation cross-references in the given BUFFER.
Find cross-reference information in a buffer and activate such cross
-references for selection with `help-follow'. Cross-references have
+references for selection with `help-follow-symbol'. Cross-references have
the canonical form `...' and the type of reference may be
disambiguated by the preceding word(s) used in
`help-xref-symbol-regexp'. Faces only get cross-referenced if
@@ -492,7 +538,7 @@ that."
(let ((stab (syntax-table))
(case-fold-search t)
(inhibit-read-only t))
- (set-syntax-table emacs-lisp-mode-syntax-table)
+ (set-syntax-table help-mode-syntax-table)
;; The following should probably be abstracted out.
(unwind-protect
(progn
@@ -506,6 +552,12 @@ that."
(setq data ;; possible newlines if para filled
(replace-regexp-in-string "[ \t\n]+" " " data t
t)))
(help-xref-button 2 'help-info data))))
+ ;; Customization groups.
+ (save-excursion
+ (while (re-search-forward
+ help-xref-customization-group-regexp nil t)
+ (help-xref-button 1 'help-customization-group
+ (intern (match-string 1)))))
;; URLs
(save-excursion
(while (re-search-forward help-xref-url-regexp nil t)
@@ -645,7 +697,7 @@ See `help-make-xrefs'."
(defun help-xref-on-pp (from to)
"Add xrefs for symbols in `pp's output between FROM and TO."
(if (> (- to from) 5000) nil
- (with-syntax-table emacs-lisp-mode-syntax-table
+ (with-syntax-table help-mode-syntax-table
(save-excursion
(save-restriction
(narrow-to-region from to)
@@ -774,6 +826,7 @@ a proper [back] button."
;; The doc string is meant to explain what buttons do.
(defun help-follow-mouse ()
"Follow the cross-reference that you click on."
+ (declare (obsolete nil "28.1"))
(interactive)
(error "No cross-reference here"))
@@ -782,6 +835,7 @@ a proper [back] button."
"Follow cross-reference at point.
For the cross-reference format, see `help-make-xrefs'."
+ (declare (obsolete nil "28.1"))
(interactive)
(user-error "No cross-reference here"))
diff --git a/lisp/help.el b/lisp/help.el
index ba27fc5..29ae340 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1912,7 +1912,7 @@ the same names as used in the original source code, when
possible."
(let ((name (symbol-name arg)))
(if (eq (aref name 0) ?&)
(memq arg '(&rest &optional))
- (not (string-match "\\." name)))))
+ (not (string-search "." name)))))
(setq valid nil)))
(when valid arglist)))
(let* ((arity (func-arity def))
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 37b88b3..4c924e9 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -344,9 +344,9 @@ which can be called interactively, are:
When hi-lock is started and if the mode is not excluded or patterns
rejected, the beginning of the buffer is searched for lines of the
form:
- Hi-lock: FOO
+ Hi-lock: (FOO ...)
-where FOO is a list of patterns. The patterns must start before
+where (FOO ...) is a list of patterns. The patterns must start before
position \(number of characters into buffer)
`hi-lock-file-patterns-range'. Patterns will be read until
Hi-lock: end is found. A mode is excluded if it's in the list
@@ -818,7 +818,7 @@ SPACES-REGEXP is a regexp to substitute spaces in font-lock
search."
(not (looking-at "\\s-*end")))
(condition-case nil
(setq all-patterns (append (read (current-buffer))
all-patterns))
- (error (message "Invalid pattern list expression at %d"
+ (error (message "Invalid pattern list expression at line %d"
(line-number-at-pos)))))))
(when (and all-patterns
hi-lock-mode
diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el
index cbb69b2..4fadbbe 100644
--- a/lisp/hippie-exp.el
+++ b/lisp/hippie-exp.el
@@ -507,8 +507,8 @@ otherwise."
"Try to slam together two parts of a file specification, system dependently."
(cond ((null dir-part) name-part)
((eq system-type 'ms-dos)
- (if (and (string-match "\\\\" dir-part)
- (not (string-match "/" dir-part))
+ (if (and (string-search "\\" dir-part)
+ (not (string-search "/" dir-part))
(= (aref name-part (1- (length name-part))) ?/))
(aset name-part (1- (length name-part)) ?\\))
(concat dir-part name-part))
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index b453061..e63910d 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -1238,7 +1238,7 @@ return a `defface' style list of face properties instead
of a face symbol."
(setq fprops (cdr fprops)))
;; ((prop val))
(setq p (caar fprops))
- (setq v (cl-cadar fprops))
+ (setq v (cadar fprops))
(setq fprops (cdr fprops)))
(if (listp (cdr fprops))
(progn
@@ -1358,8 +1358,8 @@ Returns a modified copy of FACE-MAP."
;;(push (car tmp-map) reduced-map)
;;(push (cadr tmp-map) reduced-map)
(while tmp-map
- (setq first-start (cl-cadddr tmp-map)
- first-stop (cl-caddr tmp-map)
+ (setq first-start (cadddr tmp-map)
+ first-stop (caddr tmp-map)
last-start (cadr tmp-map)
last-stop (car tmp-map)
map-buf tmp-map
@@ -1372,8 +1372,8 @@ Returns a modified copy of FACE-MAP."
(not (re-search-forward "[^ \t\n\r]" (car last-start) t))))
(setq map-buf (cddr map-buf)
span-start first-start
- first-start (cl-cadddr map-buf)
- first-stop (cl-caddr map-buf)
+ first-start (cadddr map-buf)
+ first-stop (caddr map-buf)
last-start (cadr map-buf)
last-stop (car map-buf)))
(push span-stop reduced-map)
@@ -1888,7 +1888,7 @@ property, with a value of \"tag.line-number\"."
(lambda (TLIST)
(if (string= file (car TLIST))
(let* ((line (cadr TLIST) )
- (chr (cl-caddr TLIST))
+ (chr (caddr TLIST))
(link (format "%s.%d" TAG line) ))
(put-text-property (+ 1 chr)
(+ 2 chr)
@@ -1902,7 +1902,7 @@ tree depth, as determined from FILE (a filename).
START is the offset at which to start looking for the / character in FILE."
;;(message "hfy-relstub");;DBUG
(let ((c ""))
- (while (setq start (string-match "/" file start))
+ (while (setq start (string-search "/" file start))
(setq start (1+ start)) (setq c (concat c "../")))
c))
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 1dc8acb..907ee8d 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -332,6 +332,17 @@ where NAME is a unique but arbitrary name and
FILTER-GROUP-LIST
is a list of filter groups with the same structure as
allowed for `ibuffer-filter-groups'.
+For instance:
+
+ (setq ibuffer-saved-filter-groups
+ \\='((\"Home\"
+ (\"Modified\" (predicate buffer-modified-p (current-buffer)))
+ (\"Helm\" (name . \"\\\\*helm.+\"))
+ (\"Dev\" (or (filename . \".+\\\\.css\\\\'\")
+ (filename . \".+\\\\.html?\\\\'\")
+ (mode . android-mode)
+ (mode . clojure-mode))))))
+
See also the functions `ibuffer-save-filter-groups' and
`ibuffer-switch-to-saved-filter-groups' for saving and switching
between sets of filter groups, and the variable
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 9088f31..6c01805 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -1719,7 +1719,7 @@ If point is on a group name, this function operates on
that group."
(ibuffer-buffer-name-face buffer mark))))
(if (not (seq-position string ?\n))
string
- (replace-regexp-in-string
+ (string-replace
"\n" (propertize "^J" 'font-lock-face 'escape-glyph) string))))
(define-ibuffer-column size
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index adea150..0fa5f36 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -109,7 +109,11 @@ Otherwise this should be a list of the completion tables
(e.g.,
(defface icomplete-selected-match '((t :inherit highlight))
"Face used by `icomplete-vertical-mode' for the selected candidate."
- :version "24.4")
+ :version "28.1")
+
+(defface icomplete-section '((t :inherit shadow :slant italic))
+ "Face used by `icomplete-vertical-mode' for the section title."
+ :version "28.1")
;;;_* User Customization variables
(defcustom icomplete-prospects-height 2
@@ -249,38 +253,53 @@ the default otherwise."
(defun icomplete-forward-completions ()
"Step forward completions by one entry.
Second entry becomes the first and can be selected with
-`icomplete-force-complete-and-exit'."
+`icomplete-force-complete-and-exit'.
+Return non-nil iff something was stepped."
(interactive)
(let* ((beg (icomplete--field-beg))
(end (icomplete--field-end))
- (comps (completion-all-sorted-completions beg end))
- (last (last comps)))
+ (comps (completion-all-sorted-completions beg end)))
(when (consp (cdr comps))
(cond (icomplete-scroll
(push (pop comps) icomplete--scrolled-past)
(setq icomplete--scrolled-completions comps))
(t
- (setcdr (last comps) (cons (pop comps) (cdr last)))))
+ (let ((last (last comps)))
+ (setcdr (last comps) (cons (pop comps) (cdr last))))))
(completion--cache-all-sorted-completions beg end comps))))
(defun icomplete-backward-completions ()
"Step backward completions by one entry.
Last entry becomes the first and can be selected with
-`icomplete-force-complete-and-exit'."
+`icomplete-force-complete-and-exit'.
+Return non-nil iff something was stepped."
(interactive)
(let* ((beg (icomplete--field-beg))
(end (icomplete--field-end))
(comps (completion-all-sorted-completions beg end))
- last-but-one)
- (cond ((and icomplete-scroll icomplete--scrolled-past)
- (push (pop icomplete--scrolled-past) comps)
- (setq icomplete--scrolled-completions comps))
- ((and (not icomplete-scroll)
- (consp (cdr (setq last-but-one (last comps 2)))))
- ;; At least two elements in comps
- (push (car (cdr last-but-one)) comps)
- (setcdr last-but-one (cdr (cdr last-but-one)))))
- (completion--cache-all-sorted-completions beg end comps)))
+ last-but-one)
+ (prog1
+ (cond ((and icomplete-scroll icomplete--scrolled-past)
+ (push (pop icomplete--scrolled-past) comps)
+ (setq icomplete--scrolled-completions comps))
+ ((and (not icomplete-scroll)
+ (consp (cdr (setq last-but-one (last comps 2)))))
+ ;; At least two elements in comps
+ (push (car (cdr last-but-one)) comps)
+ (setcdr last-but-one (cdr (cdr last-but-one)))))
+ (completion--cache-all-sorted-completions beg end comps))))
+
+(defun icomplete-vertical-goto-first ()
+ "Go to first completions entry when `icomplete-scroll' is non-nil."
+ (interactive)
+ (unless icomplete-scroll (error "Only works with `icomplete-scroll'"))
+ (while (icomplete-backward-completions)))
+
+(defun icomplete-vertical-goto-last ()
+ "Go to last completions entry when `icomplete-scroll' is non-nil."
+ (interactive)
+ (unless icomplete-scroll (error "Only works with `icomplete-scroll'"))
+ (while (icomplete-forward-completions)))
;;;_* Helpers for `fido-mode' (or `ido-mode' emulation)
@@ -298,18 +317,21 @@ require user confirmation."
(call-interactively 'kill-line)
(let* ((all (completion-all-sorted-completions))
(thing (car all))
+ (cat (icomplete--category))
(action
- (pcase (icomplete--category)
- (`buffer
+ (cl-case cat
+ (buffer
(lambda ()
(when (yes-or-no-p (concat "Kill buffer " thing "? "))
(kill-buffer thing))))
- (`file
+ ((project-file file)
(lambda ()
(let* ((dir (file-name-directory (icomplete--field-string)))
(path (expand-file-name thing dir)))
(when (yes-or-no-p (concat "Delete file " path "? "))
- (delete-file path) t)))))))
+ (delete-file path) t))))
+ (t
+ (error "Sorry, don't know how to kill things for `%s'"
cat)))))
(when (let (;; Allow `yes-or-no-p' to work and don't let it
;; `icomplete-exhibit' anything.
(enable-recursive-minibuffers t)
@@ -606,6 +628,10 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-n") 'icomplete-forward-completions)
(define-key map (kbd "C-p") 'icomplete-backward-completions)
+ (define-key map (kbd "<down>") 'icomplete-forward-completions)
+ (define-key map (kbd "<up>") 'icomplete-backward-completions)
+ (define-key map (kbd "M-<") 'icomplete-vertical-goto-first)
+ (define-key map (kbd "M->") 'icomplete-vertical-goto-last)
map)
"Keymap used by `icomplete-vertical-mode' in the minibuffer.")
@@ -613,8 +639,7 @@ Usually run by inclusion in `minibuffer-setup-hook'."
"Setup the minibuffer for vertical display of completion candidates."
(use-local-map (make-composed-keymap icomplete-vertical-mode-minibuffer-map
(current-local-map)))
- (setq-local icomplete-separator "\n"
- icomplete-hide-common-prefix nil
+ (setq-local icomplete-hide-common-prefix nil
;; Ask `icomplete-completions' to return enough completions
candidates.
icomplete-prospects-height 25
redisplay-adhoc-scroll-in-resize-mini-windows nil))
@@ -623,6 +648,8 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(define-minor-mode icomplete-vertical-mode
"Toggle vertical candidate display in `icomplete-mode' or `fido-mode'.
+If none of these modes are on, turn on `icomplete-mode'.
+
As many completion candidates as possible are displayed, depending on
the value of `max-mini-window-height', and the way the mini-window is
resized depends on `resize-mini-windows'."
@@ -630,10 +657,21 @@ resized depends on `resize-mini-windows'."
(remove-hook 'icomplete-minibuffer-setup-hook
#'icomplete--vertical-minibuffer-setup)
(when icomplete-vertical-mode
+ (unless icomplete-mode
+ (icomplete-mode 1))
(add-hook 'icomplete-minibuffer-setup-hook
#'icomplete--vertical-minibuffer-setup)))
-(defalias 'fido-vertical-mode 'icomplete-vertical-mode)
+;;;###autoload
+(define-minor-mode fido-vertical-mode
+ "Toggle vertical candidate display in `fido-mode'.
+When turning on, if non-vertical `fido-mode' is off, turn it on.
+If it's on, just add the vertical display."
+ :global t
+ (icomplete-vertical-mode -1)
+ (when fido-vertical-mode
+ (unless fido-mode (fido-mode 1))
+ (icomplete-vertical-mode 1)))
@@ -710,14 +748,22 @@ See `icomplete-mode' and `minibuffer-setup-hook'."
(format icomplete-matches-format current total))))
(overlay-put icomplete-overlay 'after-string text))))))))
-(defun icomplete--affixate (md prospects)
- "Affixate PROSPECTS given completion metadata MD.
-Return a list of (COMP PREFIX SUFFIX)."
- (let ((aff-fun (or (completion-metadata-get md 'affixation-function)
- (plist-get completion-extra-properties
:affixation-function)))
- (ann-fun (or (completion-metadata-get md 'annotation-function)
- (plist-get completion-extra-properties
:annotation-function))))
- (cond (aff-fun
+(defun icomplete--augment (md prospects)
+ "Augment completion strings in PROSPECTS with completion metadata MD.
+Return a list of strings (COMP PREFIX SUFFIX SECTION). PREFIX
+and SUFFIX, if non-nil, are obtained from `affixation-function' or
+`annotation-function' metadata. SECTION is obtained from
+`group-function'. Consecutive `equal' sections are avoided.
+COMP is the element in PROSPECTS or a transformation also given
+by `group-function''s second \"transformation\" protocol."
+ (let* ((aff-fun (or (completion-metadata-get md 'affixation-function)
+ (plist-get completion-extra-properties
:affixation-function)))
+ (ann-fun (or (completion-metadata-get md 'annotation-function)
+ (plist-get completion-extra-properties
:annotation-function)))
+ (grp-fun (and completions-group
+ (completion-metadata-get md 'group-function)))
+ (annotated
+ (cond (aff-fun
(funcall aff-fun prospects))
(ann-fun
(mapcar
@@ -731,9 +777,24 @@ Return a list of (COMP PREFIX SUFFIX)."
suffix
(propertize suffix 'face 'completions-annotations)))))
prospects))
- (prospects))))
-
-(cl-defun icomplete--render-vertical (comps md &aux scroll-above scroll-below)
+ (t (mapcar #'list prospects)))))
+ (if grp-fun
+ (cl-loop with section = nil
+ for (c prefix suffix) in annotated
+ for selectedp = (get-text-property 0 'icomplete-selected c)
+ for tr = (propertize (or (funcall grp-fun c t) c)
+ 'icomplete-selected selectedp)
+ if (not (equal section (setq section (funcall grp-fun c
nil))))
+ collect (list tr prefix suffix section)
+ else collect (list tr prefix suffix ))
+ annotated)))
+
+(cl-defun icomplete--render-vertical
+ (comps md &aux scroll-above scroll-below
+ (total-space ; number of mini-window lines available
+ (1- (min
+ icomplete-prospects-height
+ (truncate (max-mini-window-lines) 1)))))
;; Welcome to loopapalooza!
;;
;; First, be mindful of `icomplete-scroll' and manual scrolls. If
@@ -741,11 +802,11 @@ Return a list of (COMP PREFIX SUFFIX)."
;; are:
;;
;; - both nil, there is no manual scroll;
- ;; - both non-nil, there is a healthy manual scroll the doesn't need
+ ;; - both non-nil, there is a healthy manual scroll that doesn't need
;; to be readjusted (user just moved around the minibuffer, for
;; example)l
;; - non-nil and nil, respectively, a refiltering took place and we
- ;; need attempt to readjust them to the new filtered `comps'.
+ ;; may need to readjust them to the new filtered `comps'.
(when (and icomplete-scroll
icomplete--scrolled-completions
(null icomplete--scrolled-past))
@@ -767,52 +828,67 @@ Return a list of (COMP PREFIX SUFFIX)."
;; positions.
(cl-loop with preds = icomplete--scrolled-past
with succs = (cdr comps)
- with max-lines = (1- (min
- icomplete-prospects-height
- (truncate (max-mini-window-lines) 1)))
- with max-above = (- max-lines
- 1
- (cl-loop for (_ . r) on comps
- repeat (truncate max-lines 2)
- while (listp r)
- count 1))
- repeat max-lines
+ with space-above = (- total-space
+ 1
+ (cl-loop for (_ . r) on comps
+ repeat (truncate total-space 2)
+ while (listp r)
+ count 1))
+ repeat total-space
for neighbour = nil
- if (and preds (> max-above 0)) do
+ if (and preds (> space-above 0)) do
(push (setq neighbour (pop preds)) scroll-above)
- (cl-decf max-above)
+ (cl-decf space-above)
else if (consp succs) collect
(setq neighbour (pop succs)) into scroll-below-aux
while neighbour
finally (setq scroll-below scroll-below-aux))
- ;; Now figure out spacing and layout
- ;;
- (cl-loop
- with selected = (substring (car comps))
- initially (add-face-text-property 0 (length selected)
- 'icomplete-selected-match 'append
selected)
- with torender = (nconc scroll-above (list selected) scroll-below)
- with triplets = (icomplete--affixate md torender)
- initially (when (eq triplets torender)
- (cl-return-from icomplete--render-vertical
- (concat
- " \n"
- (mapconcat #'identity torender icomplete-separator))))
- for (comp prefix) in triplets
- maximizing (length prefix) into max-prefix-len
- maximizing (length comp) into max-comp-len
- finally return
- ;; Finally, render
- ;;
- (concat
- " \n"
- (cl-loop for (comp prefix suffix) in triplets
- concat prefix
- concat (make-string (- max-prefix-len (length prefix)) ? )
- concat comp
- concat (make-string (- max-comp-len (length comp)) ? )
- concat suffix
- concat icomplete-separator))))
+ ;; Halfway there...
+ (let* ((selected (propertize (car comps) 'icomplete-selected t))
+ (chosen (append scroll-above (list selected) scroll-below))
+ (tuples (icomplete--augment md chosen))
+ max-prefix-len max-comp-len lines nsections)
+ (add-face-text-property 0 (length selected)
+ 'icomplete-selected-match 'append selected)
+ ;; Figure out parameters for horizontal spacing
+ (cl-loop
+ for (comp prefix) in tuples
+ maximizing (length prefix) into max-prefix-len-aux
+ maximizing (length comp) into max-comp-len-aux
+ finally (setq max-prefix-len max-prefix-len-aux
+ max-comp-len max-comp-len-aux))
+ ;; Serialize completions and section titles into a list
+ ;; of lines to render
+ (cl-loop
+ for (comp prefix suffix section) in tuples
+ when section
+ collect (propertize section 'face 'icomplete-section) into lines-aux
+ and count 1 into nsections-aux
+ when (get-text-property 0 'icomplete-selected comp)
+ do (add-face-text-property 0 (length comp)
+ 'icomplete-selected-match 'append comp)
+ collect (concat prefix
+ (make-string (- max-prefix-len (length prefix)) ? )
+ comp
+ (make-string (- max-comp-len (length comp)) ? )
+ suffix)
+ into lines-aux
+ finally (setq lines lines-aux
+ nsections nsections-aux))
+ ;; Kick out some lines from the beginning due to extra sections.
+ ;; This hopes to keep the selected entry more or less in the
+ ;; middle of the dropdown-like widget when `icomplete-scroll' is
+ ;; t. Funky, but at least I didn't use `cl-loop'
+ (setq lines
+ (nthcdr
+ (cond ((<= (length lines) total-space) 0)
+ ((> (length scroll-above) (length scroll-below)) nsections)
+ (t (min (ceiling nsections 2) (length scroll-above))))
+ lines))
+ ;; At long last, render final string return value. This may still
+ ;; kick out lines at the end.
+ (concat " \n"
+ (cl-loop for l in lines repeat total-space concat l concat "\n"))))
;;;_ > icomplete-completions (name candidates predicate require-match)
(defun icomplete-completions (name candidates predicate require-match)
diff --git a/lisp/ido.el b/lisp/ido.el
index ea5ff32..b81a9db 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1770,7 +1770,7 @@ is enabled then some keybindings are changed in the
keymap."
(let ((l (length dirname)))
(if (and max-width (> max-width 0) (> l max-width))
(let* ((s (substring dirname (- max-width)))
- (i (string-match "/" s)))
+ (i (string-search "/" s)))
(concat "..." (if i (substring s i) s)))
dirname)))))
(t prompt)))
@@ -2516,7 +2516,7 @@ If cursor is not at the end of the user input, move to
end of input."
;; Do nothing
)
((and (memq ido-cur-item '(file dir))
- (string-match "[$]" ido-text))
+ (string-search "$" ido-text))
(let ((evar (substitute-in-file-name (concat ido-current-directory
ido-text))))
(if (not (file-exists-p (file-name-directory evar)))
(message "Expansion generates non-existing directory name")
@@ -3089,7 +3089,7 @@ If repeated, insert text from buffer instead."
(setq ido-text-init word
ido-try-merged-list nil
ido-exit 'chdir))
- ((string-match "/" word)
+ ((string-search "/" word)
(setq ido-text-init (concat ido-current-directory word)
ido-try-merged-list nil
ido-exit 'chdir))
@@ -4559,7 +4559,7 @@ For details of keybindings, see `ido-find-file'."
(setq try-single-dir-match t))))
((and (string-equal (substring contents -2 -1) "/")
- (not (string-match "[$]" contents)))
+ (not (string-search "$" contents)))
(ido-set-current-directory
(cond
((= (length contents) 2)
@@ -4656,7 +4656,7 @@ For details of keybindings, see `ido-find-file'."
(memq ido-cur-item '(file dir))
(not (ido-is-root-directory))
(> (length contents) 1)
- (not (string-match "[$]" contents))
+ (not (string-search "$" contents))
(not ido-directory-nonreadable)
(not ido-directory-too-big))
(ido-trace "merge?")
diff --git a/lisp/ielm.el b/lisp/ielm.el
index fd8dac7..39820a8 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -440,8 +440,7 @@ nonempty, then flushes the buffer."
(concat (buffer-string) aux))))))
(error
(setq error-type "IELM Error")
- (setq result (format "Error during pretty-printing (bug in pp): %S"
- err)))
+ (setq result (format "Error during pretty-printing: %S" err)))
(quit (setq error-type "IELM Error")
(setq result "Quit during pretty-printing"))))
(if error-type
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index 2509ecf..b92a937 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -164,8 +164,7 @@
(defcustom image-dired-dir (locate-user-emacs-file "image-dired/")
"Directory where thumbnail images are stored."
- :type 'directory
- :group 'image-dired)
+ :type 'directory)
(defcustom image-dired-thumbnail-storage 'use-image-dired-dir
"How to store image-dired's thumbnail files.
@@ -181,51 +180,44 @@ that allows sharing of thumbnails across different
programs."
(const :tag "Use image-dired-dir" use-image-dired-dir)
(const :tag "Thumbnail Managing Standard (normal 128x128)"
standard)
(const :tag "Thumbnail Managing Standard (large 256x256)"
standard-large)
- (const :tag "Per-directory" per-directory))
- :group 'image-dired)
+ (const :tag "Per-directory" per-directory)))
(defcustom image-dired-db-file
(expand-file-name ".image-dired_db" image-dired-dir)
"Database file where file names and their associated tags are stored."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-temp-image-file
(expand-file-name ".image-dired_temp" image-dired-dir)
"Name of temporary image file used by various commands."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-gallery-dir
(expand-file-name ".image-dired_gallery" image-dired-dir)
"Directory to store generated gallery html pages.
This path needs to be \"shared\" to the public so that it can access
the index.html page that image-dired creates."
- :type 'directory
- :group 'image-dired)
+ :type 'directory)
(defcustom image-dired-gallery-image-root-url
"https://your.own.server/image-diredpics";
"URL where the full size images are to be found.
Note that this path has to be configured in your web server. Image-Dired
expects to find pictures in this directory."
- :type 'string
- :group 'image-dired)
+ :type 'string)
(defcustom image-dired-gallery-thumb-image-root-url
"https://your.own.server/image-diredthumbs";
"URL where the thumbnail images are to be found.
Note that this path has to be configured in your web server. Image-Dired
expects to find pictures in this directory."
- :type 'string
- :group 'image-dired)
+ :type 'string)
(defcustom image-dired-cmd-create-thumbnail-program
"convert"
"Executable used to create thumbnail.
Used together with `image-dired-cmd-create-thumbnail-options'."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-cmd-create-thumbnail-options
'("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t")
@@ -236,14 +228,12 @@ Available format specifiers are: %w which is replaced by
%f which is replaced by the file name of the original image and %t
which is replaced by the file name of the thumbnail file."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-create-temp-image-program "convert"
"Executable used to create temporary image.
Used together with `image-dired-cmd-create-temp-image-options'."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-cmd-create-temp-image-options
'("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t")
@@ -254,8 +244,7 @@ the calculated max size for width and height in the image
display window,
%f which is replaced by the file name of the original image and %t which
is replaced by the file name of the temporary file."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-pngnq-program
(or (executable-find "pngnq")
@@ -264,8 +253,7 @@ is replaced by the file name of the temporary file."
It quantizes colors of PNG images down to 256 colors or fewer
using the NeuQuant algorithm."
:version "26.1"
- :type '(choice (const :tag "Not Set" nil) file)
- :group 'image-dired)
+ :type '(choice (const :tag "Not Set" nil) file))
(defcustom image-dired-cmd-pngnq-options
'("-f" "%t")
@@ -273,15 +261,13 @@ using the NeuQuant algorithm."
Available format specifiers are the same as in
`image-dired-cmd-create-thumbnail-options'."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-pngcrush-program (executable-find "pngcrush")
"The file name of the `pngcrush' program.
It optimizes the compression of PNG images. Also it adds PNG textual chunks
with the information required by the Thumbnail Managing Standard."
- :type '(choice (const :tag "Not Set" nil) file)
- :group 'image-dired)
+ :type '(choice (const :tag "Not Set" nil) file))
(defcustom image-dired-cmd-pngcrush-options
`("-q"
@@ -299,14 +285,12 @@ Available format specifiers are the same as in
`image-dired-cmd-create-thumbnail-options', with %q for a
temporary file name (typically generated by pnqnq)."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-optipng-program (executable-find "optipng")
"The file name of the `optipng' program."
:version "26.1"
- :type '(choice (const :tag "Not Set" nil) file)
- :group 'image-dired)
+ :type '(choice (const :tag "Not Set" nil) file))
(defcustom image-dired-cmd-optipng-options '("-o5" "%t")
"Arguments passed to `image-dired-cmd-optipng-program'.
@@ -314,8 +298,7 @@ Available format specifiers are described in
`image-dired-cmd-create-thumbnail-options'."
:version "26.1"
:type '(repeat (string :tag "Argument"))
- :link '(url-link "man:optipng(1)")
- :group 'image-dired)
+ :link '(url-link "man:optipng(1)"))
(defcustom image-dired-cmd-create-standard-thumbnail-options
(append '("-size" "%wx%h" "%f[0]")
@@ -331,15 +314,13 @@ Available format specifiers are described in
Available format specifiers are the same as in
`image-dired-cmd-create-thumbnail-options', with %m for file modification
time."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-rotate-thumbnail-program
"mogrify"
"Executable used to rotate thumbnail.
Used together with `image-dired-cmd-rotate-thumbnail-options'."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-cmd-rotate-thumbnail-options
'("-rotate" "%d" "%t")
@@ -350,15 +331,13 @@ number of (positive) degrees to rotate the image,
normally 90 or 270
\(for 90 degrees right and left), %t which is replaced by the file name
of the thumbnail file."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-rotate-original-program
"jpegtran"
"Executable used to rotate original image.
Used together with `image-dired-cmd-rotate-original-options'."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-cmd-rotate-original-options
'("-rotate" "%d" "-copy" "all" "-outfile" "%t" "%o")
@@ -370,28 +349,24 @@ number of (positive) degrees to rotate the image,
normally 90 or
original image file name and %t which is replaced by
`image-dired-temp-image-file'."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-temp-rotate-image-file
(expand-file-name ".image-dired_rotate_temp" image-dired-dir)
"Temporary file for rotate operations."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-rotate-original-ask-before-overwrite t
"Confirm overwrite of original file after rotate operation.
If non-nil, ask user for confirmation before overwriting the
original file with `image-dired-temp-rotate-image-file'."
- :type 'boolean
- :group 'image-dired)
+ :type 'boolean)
(defcustom image-dired-cmd-write-exif-data-program
"exiftool"
"Program used to write EXIF data to image.
Used together with `image-dired-cmd-write-exif-data-options'."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-cmd-write-exif-data-options
'("-%t=%v" "%f")
@@ -401,15 +376,13 @@ Available format specifiers are: %f which is replaced by
the image file name, %t which is replaced by the tag name and %v
which is replaced by the tag value."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-read-exif-data-program
"exiftool"
"Program used to read EXIF data to image.
Used together with `image-dired-cmd-read-exif-data-options'."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-cmd-read-exif-data-options
'("-s" "-s" "-s" "-%t" "%f")
@@ -418,15 +391,13 @@ Used with `image-dired-cmd-read-exif-data-program'.
Available format specifiers are: %f which is replaced
by the image file name and %t which is replaced by the tag name."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-gallery-hidden-tags
(list "private" "hidden" "pending")
"List of \"hidden\" tags.
Used by `image-dired-gallery-generate' to leave out \"hidden\" images."
- :type '(repeat string)
- :group 'image-dired)
+ :type '(repeat string))
(defcustom image-dired-thumb-size
(cond
@@ -436,29 +407,37 @@ Used by `image-dired-gallery-generate' to leave out
\"hidden\" images."
"Size of thumbnails, in pixels.
This is the default size for both `image-dired-thumb-width'
and `image-dired-thumb-height'."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defcustom image-dired-thumb-width image-dired-thumb-size
"Width of thumbnails, in pixels."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defcustom image-dired-thumb-height image-dired-thumb-size
"Height of thumbnails, in pixels."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defcustom image-dired-thumb-relief 2
"Size of button-like border around thumbnails."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defcustom image-dired-thumb-margin 2
"Size of the margin around thumbnails.
This is where you see the cursor."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
+
+(defcustom image-dired-thumb-visible-marks t
+ "Make marks visible in thumbnail buffer.
+If non-nil, apply the `image-dired-thumb-mark' face to marked
+images."
+ :type 'boolean
+ :version "28.1")
+
+(defface image-dired-thumb-mark
+ '((t (:background "orange")))
+ "Background-color for marked images in thumbnail buffer."
+ :group 'image-dired
+ :version "28.1")
(defcustom image-dired-line-up-method 'dynamic
"Default method for line-up of thumbnails in thumbnail buffer.
@@ -471,34 +450,29 @@ and No line-up means that no automatic line-up will be
done."
(const :tag "Dynamic" dynamic)
(const :tag "Fixed" fixed)
(const :tag "Interactive" interactive)
- (const :tag "No line-up" none))
- :group 'image-dired)
+ (const :tag "No line-up" none)))
(defcustom image-dired-thumbs-per-row 3
"Number of thumbnails to display per row in thumb buffer."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defcustom image-dired-display-window-width-correction 1
"Number to be used to correct image display window width.
Change if the default (1) does not work (i.e. if the image does not
completely fit)."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defcustom image-dired-display-window-height-correction 0
"Number to be used to correct image display window height.
Change if the default (0) does not work (i.e. if the image does not
completely fit)."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defcustom image-dired-track-movement t
"The current state of the tracking and mirroring.
For more information, see the documentation for
`image-dired-toggle-movement-tracking'."
- :type 'boolean
- :group 'image-dired)
+ :type 'boolean)
(defcustom image-dired-append-when-browsing nil
"Append thumbnails in thumbnail buffer when browsing.
@@ -508,8 +482,7 @@ images in the thumbnail buffer. If you enable this and
want to clean
the thumbnail buffer because it is filled with too many thumbnails,
just call `image-dired-display-thumb' to display only the image at point.
This value can be toggled using `image-dired-toggle-append-browsing'."
- :type 'boolean
- :group 'image-dired)
+ :type 'boolean)
(defcustom image-dired-dired-disp-props t
"If non-nil, display properties for dired file when browsing.
@@ -517,16 +490,14 @@ Used by `image-dired-next-line-and-display',
`image-dired-previous-line-and-display' and
`image-dired-mark-and-display-next'.
If the database file is large, this can slow down image browsing in
dired and you might want to turn it off."
- :type 'boolean
- :group 'image-dired)
+ :type 'boolean)
(defcustom image-dired-display-properties-format "%b: %f (%t): %c"
"Display format for thumbnail properties.
%b is replaced with associated dired buffer name, %f with file name
\(without path) of original image file, %t with the list of tags and %c
with the comment."
- :type 'string
- :group 'image-dired)
+ :type 'string)
(defcustom image-dired-external-viewer
;; TODO: Use mailcap, dired-guess-shell-alist-default,
@@ -539,20 +510,17 @@ Including parameters. Used when displaying original
image from
`image-dired-thumbnail-mode'."
:version "27.1"
:type '(choice string
- (const :tag "Not Set" nil))
- :group 'image-dired)
+ (const :tag "Not Set" nil)))
(defcustom image-dired-main-image-directory "~/pics/"
"Name of main image directory, if any.
Used by `image-dired-copy-with-exif-file-name'."
- :type 'string
- :group 'image-dired)
+ :type 'string)
(defcustom image-dired-show-all-from-dir-max-files 50
"Maximum number of files to show using `image-dired-show-all-from-dir'
before warning the user."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defmacro image-dired--with-db-file (&rest body)
"Run BODY in a temp buffer containing `image-dired-db-file'.
@@ -684,6 +652,8 @@ Each item has the form (ORIGINAL-FILE TARGET-FILE).")
"Maximum number of concurrent jobs permitted for generating images.
Increase at own risk.")
+(defvar image-dired-tag-history nil "Variable holding the tag history.")
+
(defun image-dired-pngnq-thumb (spec)
"Quantize thumbnail described by format SPEC with pngnq(1)."
(let ((process
@@ -704,7 +674,7 @@ Increase at own risk.")
(thumb (cdr (assq ?t spec))))
(rename-file nq8 thumb t)))
(message "command %S %s" (process-command process)
- (replace-regexp-in-string "\n" "" status)))))
+ (string-replace "\n" "" status)))))
process))
(defun image-dired-pngcrush-thumb (spec)
@@ -726,7 +696,7 @@ Increase at own risk.")
(unless (and (eq (process-status process) 'exit)
(zerop (process-exit-status process)))
(message "command %S %s" (process-command process)
- (replace-regexp-in-string "\n" "" status)))
+ (string-replace "\n" "" status)))
(when (memq (process-status process) '(exit signal))
(let ((temp (cdr (assq ?q spec))))
(delete-file temp)))))
@@ -744,7 +714,7 @@ Increase at own risk.")
(unless (and (eq (process-status process) 'exit)
(zerop (process-exit-status process)))
(message "command %S %s" (process-command process)
- (replace-regexp-in-string "\n" "" status)))))
+ (string-replace "\n" "" status)))))
process))
(defun image-dired-create-thumb-1 (original-file thumbnail-file)
@@ -794,7 +764,7 @@ Increase at own risk.")
(zerop (process-exit-status process))))
(message "Thumb could not be created for %s: %s"
(abbreviate-file-name original-file)
- (replace-regexp-in-string "\n" "" status))
+ (string-replace "\n" "" status))
(set-file-modes thumbnail-file #o600)
(clear-image-cache thumbnail-file)
;; PNG thumbnail has been created since we are
@@ -829,6 +799,22 @@ Queued items live in `image-dired-queue'."
(list (list original-file thumbnail-file))))
(run-at-time 0 nil #'image-dired-thumb-queue-run))
+(defmacro image-dired--with-marked (&rest body)
+ "Eval BODY with point on each marked thumbnail.
+If no marked file could be found, execute BODY on the current
+thumbnail."
+ `(with-current-buffer image-dired-thumbnail-buffer
+ (let (found)
+ (save-mark-and-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (image-dired-thumb-file-marked-p)
+ (setq found t)
+ ,@body)
+ (forward-char)))
+ (unless found
+ ,@body))))
+
;;;###autoload
(defun image-dired-dired-toggle-marked-thumbs (&optional arg)
"Toggle thumbnails in front of file names in the dired buffer.
@@ -992,6 +978,19 @@ Restore any changes to the window configuration made by
calling
(set-window-configuration image-dired-saved-window-configuration)
(message "No saved window configuration")))
+(defun image-dired--line-up-with-method ()
+ "Line up thumbnails according to `image-dired-line-up-method'."
+ (cond ((eq 'dynamic image-dired-line-up-method)
+ (image-dired-line-up-dynamic))
+ ((eq 'fixed image-dired-line-up-method)
+ (image-dired-line-up))
+ ((eq 'interactive image-dired-line-up-method)
+ (image-dired-line-up-interactive))
+ ((eq 'none image-dired-line-up-method)
+ nil)
+ (t
+ (image-dired-line-up-dynamic))))
+
;;;###autoload
(defun image-dired-display-thumbs (&optional arg append do-not-pop)
"Display thumbnails of all marked files, in `image-dired-thumbnail-buffer'.
@@ -1033,16 +1032,7 @@ thumbnail buffer to be selected."
(if do-not-pop
(display-buffer buf)
(pop-to-buffer buf))
- (cond ((eq 'dynamic image-dired-line-up-method)
- (image-dired-line-up-dynamic))
- ((eq 'fixed image-dired-line-up-method)
- (image-dired-line-up))
- ((eq 'interactive image-dired-line-up-method)
- (image-dired-line-up-interactive))
- ((eq 'none image-dired-line-up-method)
- nil)
- (t
- (image-dired-line-up-dynamic))))))
+ (image-dired--line-up-with-method))))
;;;###autoload
(defun image-dired-show-all-from-dir (dir)
@@ -1108,7 +1098,7 @@ FILE-TAGS is an alist in the following form:
(end-of-line)
(insert (format ";%s" tag))))
(goto-char (point-max))
- (insert (format "\n%s;%s" file tag))))
+ (insert (format "%s;%s\n" file tag))))
(save-buffer))))
(defun image-dired-remove-tag (files tag)
@@ -1123,11 +1113,12 @@ FILE-TAGS is an alist in the following form:
(error "Files must be a string or a list of strings!")))
(dolist (file files)
(goto-char (point-min))
- (when (search-forward-regexp (format "^%s" file) nil t)
+ (when (search-forward-regexp (format "^%s;" file) nil t)
(end-of-line)
(setq end (point))
(beginning-of-line)
- (when (search-forward-regexp (format "\\(;%s\\)" tag) end t)
+ (when (search-forward-regexp
+ (format "\\(;%s\\)\\($\\|;\\)" tag) end t)
(delete-region (match-beginning 1) (match-end 1))
;; Check if file should still be in the database. If
;; it has no tags or comments, it will be removed.
@@ -1135,11 +1126,7 @@ FILE-TAGS is an alist in the following form:
(setq end (point))
(beginning-of-line)
(when (not (search-forward ";" end t))
- (kill-line 1)
- ;; If on empty line at end of buffer
- (and (eobp)
- (looking-at "^$")
- (delete-char -1)))))))
+ (kill-line 1))))))
(save-buffer)))
(defun image-dired-list-tags (file)
@@ -1162,7 +1149,9 @@ FILE-TAGS is an alist in the following form:
(defun image-dired-tag-files (arg)
"Tag marked file(s) in dired. With prefix ARG, tag file at point."
(interactive "P")
- (let ((tag (read-string "Tags to add (separate tags with a semicolon): "))
+ (let ((tag (completing-read
+ "Tags to add (separate tags with a semicolon): "
+ image-dired-tag-history nil nil nil 'image-dired-tag-history))
files)
(if arg
(setq files (list (dired-get-filename)))
@@ -1174,19 +1163,24 @@ FILE-TAGS is an alist in the following form:
files))))
(defun image-dired-tag-thumbnail ()
- "Tag current thumbnail."
+ "Tag current or marked thumbnails."
(interactive)
- (let ((tag (read-string "Tags to add (separate tags with a semicolon): ")))
- (image-dired-write-tags (list (cons (image-dired-original-file-name)
tag))))
- (image-dired-update-property
- 'tags (image-dired-list-tags (image-dired-original-file-name))))
+ (let ((tag (completing-read
+ "Tags to add (separate tags with a semicolon): "
+ image-dired-tag-history nil nil nil 'image-dired-tag-history)))
+ (image-dired--with-marked
+ (image-dired-write-tags
+ (list (cons (image-dired-original-file-name) tag)))
+ (image-dired-update-property
+ 'tags (image-dired-list-tags (image-dired-original-file-name))))))
;;;###autoload
(defun image-dired-delete-tag (arg)
"Remove tag for selected file(s).
With prefix argument ARG, remove tag from file at point."
(interactive "P")
- (let ((tag (read-string "Tag to remove: "))
+ (let ((tag (completing-read "Tag to remove: " image-dired-tag-history
+ nil nil nil 'image-dired-tag-history))
files)
(if arg
(setq files (list (dired-get-filename)))
@@ -1194,12 +1188,14 @@ With prefix argument ARG, remove tag from file at
point."
(image-dired-remove-tag files tag)))
(defun image-dired-tag-thumbnail-remove ()
- "Remove tag from thumbnail."
+ "Remove tag from current or marked thumbnails."
(interactive)
- (let ((tag (read-string "Tag to remove: ")))
- (image-dired-remove-tag (image-dired-original-file-name) tag))
- (image-dired-update-property
- 'tags (image-dired-list-tags (image-dired-original-file-name))))
+ (let ((tag (completing-read "Tag to remove: " image-dired-tag-history
+ nil nil nil 'image-dired-tag-history)))
+ (image-dired--with-marked
+ (image-dired-remove-tag (image-dired-original-file-name) tag)
+ (image-dired-update-property
+ 'tags (image-dired-list-tags (image-dired-original-file-name))))))
(defun image-dired-original-file-name ()
"Get original file name for thumbnail or display image at point."
@@ -1391,7 +1387,7 @@ comment."
"Check whether file on current line is marked or not."
(save-excursion
(beginning-of-line)
- (not (looking-at "^ .*$"))))
+ (looking-at-p dired-re-mark)))
(defun image-dired-modify-mark-on-thumb-original-file (command)
"Modify mark in dired buffer.
@@ -1404,14 +1400,15 @@ dired."
(message "No image, or image with correct properties, at point.")
(with-current-buffer dired-buf
(message "%s" file-name)
- (if (dired-goto-file file-name)
- (cond ((eq command 'mark) (dired-mark 1))
- ((eq command 'unmark) (dired-unmark 1))
- ((eq command 'toggle)
- (if (image-dired-dired-file-marked-p)
- (dired-unmark 1)
- (dired-mark 1)))
- ((eq command 'flag) (dired-flag-file-deletion 1))))))))
+ (when (dired-goto-file file-name)
+ (cond ((eq command 'mark) (dired-mark 1))
+ ((eq command 'unmark) (dired-unmark 1))
+ ((eq command 'toggle)
+ (if (image-dired-dired-file-marked-p)
+ (dired-unmark 1)
+ (dired-mark 1)))
+ ((eq command 'flag) (dired-flag-file-deletion 1)))
+ (image-dired-thumb-update-marks))))))
(defun image-dired-mark-thumb-original-file ()
"Mark original image file in associated dired buffer."
@@ -1538,8 +1535,10 @@ You probably want to use this together with
'("Image-Dired"
["Quit" quit-window]
["Delete thumbnail from buffer" image-dired-delete-char]
- ["Remove tag from thumbnail" image-dired-tag-thumbnail-remove]
- ["Tag thumbnail" image-dired-tag-thumbnail]
+ ["Delete marked images" image-dired-delete-marked]
+ ["Remove tag from current or marked thumbnails"
+ image-dired-tag-thumbnail-remove]
+ ["Tag current or marked thumbnails" image-dired-tag-thumbnail]
["Comment thumbnail" image-dired-comment-thumbnail]
["Refresh thumb" image-dired-refresh-thumb]
["Dynamic line up" image-dired-line-up-dynamic]
@@ -1623,7 +1622,6 @@ You probably want to use this together with
special-mode "image-dired-thumbnail"
"Browse and manipulate thumbnail images using dired.
Use `image-dired-minor-mode' to get a nice setup."
- :group 'image-dired
(buffer-disable-undo)
(add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil
t))
@@ -1631,7 +1629,6 @@ Use `image-dired-minor-mode' to get a nice setup."
special-mode "image-dired-image-display"
"Mode for displaying and manipulating original image.
Resized or in full-size."
- :group 'image-dired
(buffer-disable-undo)
(image-mode-setup-winprops)
(setq cursor-type nil)
@@ -2193,7 +2190,7 @@ FILE-COMMENTS is an alist on the following form:
(insert (format "comment:%s;" comment)))
;; File does not exist in database - add it.
(goto-char (point-max))
- (insert (format "\n%s;comment:%s" file comment))))
+ (insert (format "%s;comment:%s\n" file comment))))
(save-buffer))))
(defun image-dired-update-property (prop value)
@@ -2311,16 +2308,67 @@ non-nil."
(image-dired-track-original-file))
(image-dired-display-thumb-properties))
+(defun image-dired-thumb-file-marked-p ()
+ "Check if file is marked in associated dired buffer."
+ (let ((file-name (image-dired-original-file-name))
+ (dired-buf (image-dired-associated-dired-buffer)))
+ (when (and dired-buf file-name)
+ (with-current-buffer dired-buf
+ (when (dired-goto-file file-name)
+ (image-dired-dired-file-marked-p))))))
+
+(defun image-dired-delete-marked ()
+ "Delete current or marked thumbnails and associated images."
+ (interactive)
+ (with-current-buffer (image-dired-associated-dired-buffer)
+ (dired-do-delete))
+ (image-dired--with-marked
+ (image-dired-delete-char)
+ (backward-char))
+ (image-dired--line-up-with-method))
+
+(defun image-dired-thumb-update-marks ()
+ "Update the marks in the thumbnail buffer."
+ (when image-dired-thumb-visible-marks
+ (with-current-buffer image-dired-thumbnail-buffer
+ (save-mark-and-excursion
+ (goto-char (point-min))
+ (let ((inhibit-read-only t))
+ (while (not (eobp))
+ (with-silent-modifications
+ (if (image-dired-thumb-file-marked-p)
+ (add-face-text-property (point) (1+ (point))
+ 'image-dired-thumb-mark)
+ (remove-text-properties (point) (1+ (point))
+ '(face image-dired-thumb-mark))))
+ (forward-char)))))))
+
+(defun image-dired-mouse-toggle-mark-1 ()
+ "Toggle dired mark for current thumbnail.
+Track this in associated dired buffer if `image-dired-track-movement' is
+non-nil."
+ (when image-dired-track-movement
+ (image-dired-track-original-file))
+ (image-dired-toggle-mark-thumb-original-file))
+
(defun image-dired-mouse-toggle-mark (event)
"Use mouse EVENT to toggle dired mark for thumbnail.
+Toggle marks of all thumbnails in region, if it's active.
Track this in associated dired buffer if `image-dired-track-movement' is
non-nil."
(interactive "e")
- (mouse-set-point event)
- (goto-char (posn-point (event-end event)))
- (if image-dired-track-movement
- (image-dired-track-original-file))
- (image-dired-toggle-mark-thumb-original-file))
+ (if (use-region-p)
+ (let ((end (region-end)))
+ (save-excursion
+ (goto-char (region-beginning))
+ (while (<= (point) end)
+ (when (image-dired-image-at-point-p)
+ (image-dired-mouse-toggle-mark-1))
+ (forward-char))))
+ (mouse-set-point event)
+ (goto-char (posn-point (event-end event)))
+ (image-dired-mouse-toggle-mark-1))
+ (image-dired-thumb-update-marks))
(defun image-dired-dired-display-properties ()
"Display properties for dired file in the echo area."
diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el
index e47f1f7..75d2e66 100644
--- a/lisp/image/image-converter.el
+++ b/lisp/image/image-converter.el
@@ -78,7 +78,7 @@ is a string, it should be a MIME format string like
(string-match image-converter-regexp source))
(and data-p
(symbolp data-p)
- (string-match "/" (symbol-name data-p))
+ (string-search "/" (symbol-name data-p))
(string-match
image-converter-regexp
(concat "foo." (image-converter--mime-type data-p)))))
@@ -133,7 +133,7 @@ data is returned as a string."
(list value)
value)))
-(cl-defmethod image-converter--probe ((type (eql graphicsmagick)))
+(cl-defmethod image-converter--probe ((type (eql 'graphicsmagick)))
"Check whether the system has GraphicsMagick installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -151,7 +151,7 @@ data is returned as a string."
(push (downcase (match-string 1)) formats)))
(nreverse formats)))))
-(cl-defmethod image-converter--probe ((type (eql imagemagick)))
+(cl-defmethod image-converter--probe ((type (eql 'imagemagick)))
"Check whether the system has ImageMagick installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -171,7 +171,7 @@ data is returned as a string."
(push (downcase (match-string 1)) formats)))
(nreverse formats))))
-(cl-defmethod image-converter--probe ((type (eql ffmpeg)))
+(cl-defmethod image-converter--probe ((type (eql 'ffmpeg)))
"Check whether the system has ffmpeg installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -212,12 +212,12 @@ Only suffixes that map to `image-mode' are returned."
'image-mode)
collect suffix))
-(cl-defmethod image-converter--convert ((type (eql graphicsmagick)) source
+(cl-defmethod image-converter--convert ((type (eql 'graphicsmagick)) source
image-format)
"Convert using GraphicsMagick."
(image-converter--convert-magick type source image-format))
-(cl-defmethod image-converter--convert ((type (eql imagemagick)) source
+(cl-defmethod image-converter--convert ((type (eql 'imagemagick)) source
image-format)
"Convert using ImageMagick."
(image-converter--convert-magick type source image-format))
@@ -249,7 +249,7 @@ Only suffixes that map to `image-mode' are returned."
;; error message.
(buffer-string))))
-(cl-defmethod image-converter--convert ((type (eql ffmpeg)) source
+(cl-defmethod image-converter--convert ((type (eql 'ffmpeg)) source
image-format)
"Convert using ffmpeg."
(let ((command (image-converter--value type :command)))
diff --git a/lisp/indent.el b/lisp/indent.el
index a33d962..aa2bfbc 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -81,7 +81,7 @@ This variable has no effect unless `tab-always-indent' is
`complete'."
(const :tag "Unless looking at a word" 'word)
(const :tag "Unless at a word or parenthesis" 'word-or-paren)
(const :tag "Unless at a word, parenthesis, or punctuation."
'word-or-paren-or-punct))
- :version "27.1")
+ :version "28.1")
(defvar indent-line-ignored-functions '(indent-relative
indent-relative-maybe
diff --git a/lisp/info-look.el b/lisp/info-look.el
index fd6f8f1..33f15a3 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -43,6 +43,7 @@
(require 'info)
(eval-when-compile (require 'subr-x))
+(eval-when-compile (require 'cl-lib))
(defgroup info-lookup nil
"Major mode sensitive help agent."
@@ -901,6 +902,16 @@ Return nil if there is nothing appropriate in the buffer
near point."
:parse-rule "[$@%]?\\([_a-zA-Z0-9]+\\|[^a-zA-Z]\\)")
(info-lookup-maybe-add-help
+ :mode 'python-mode
+ ;; Debian includes Python info files, but they're version-named
+ ;; instead of having a symlink.
+ :doc-spec `((,(cl-loop for version from 20 downto 7
+ for name = (format "python3.%d" version)
+ if (Info-find-file name t)
+ return (format "(%s)Index" name)
+ finally return "(python)Index"))))
+
+(info-lookup-maybe-add-help
:mode 'cperl-mode
:regexp "[$@%][^a-zA-Z]\\|\\$\\^[A-Z]\\|[$@%]?[a-zA-Z][_a-zA-Z0-9]*"
:other-modes '(perl-mode))
diff --git a/lisp/info-xref.el b/lisp/info-xref.el
index 538a017..e2e3e30 100644
--- a/lisp/info-xref.el
+++ b/lisp/info-xref.el
@@ -547,7 +547,7 @@ the sources handy."
;; skip nodes with "%" as probably `format' strings such as in
;; info-look.el
- (unless (string-match "%" node)
+ (unless (string-search "%" node)
;; "(emacs)" is the default manual for docstring hyperlinks,
;; per `help-make-xrefs'
diff --git a/lisp/info.el b/lisp/info.el
index b65728b..5589321 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1731,22 +1731,24 @@ escaped (\\\",\\\\)."
(list
(concat
" ("
- (if (stringp Info-current-file)
- (replace-regexp-in-string
- "%" "%%"
- (file-name-sans-extension
- (file-name-nondirectory Info-current-file)))
- (format "*%S*" Info-current-file))
- ") "
- (if Info-current-node
- (propertize (replace-regexp-in-string
- "%" "%%" Info-current-node)
- 'face 'mode-line-buffer-id
- 'help-echo
- "mouse-1: scroll forward, mouse-3: scroll back"
- 'mouse-face 'mode-line-highlight
- 'local-map Info-mode-line-node-keymap)
- ""))))))
+ (propertize
+ (if (stringp Info-current-file)
+ (string-replace
+ "%" "%%"
+ (file-name-sans-extension
+ (file-name-nondirectory Info-current-file)))
+ (format "*%S*" Info-current-file))
+ 'help-echo "Info file name")
+ ") ")
+ (if Info-current-node
+ (propertize (string-replace
+ "%" "%%" Info-current-node)
+ 'face 'mode-line-buffer-id
+ 'help-echo
+ "mouse-1: scroll forward, mouse-3: scroll back"
+ 'mouse-face 'mode-line-highlight
+ 'local-map Info-mode-line-node-keymap)
+ "")))))
;; Go to an Info node specified with a filename-and-nodename string
;; of the sort that is found in pointers in nodes.
@@ -2483,7 +2485,7 @@ Table of contents is created from the tree structure of
menus."
(match-string-no-properties 1)))
(section "Top")
menu-items)
- (when (and upnode (string-match "(" upnode)) (setq upnode nil))
+ (when (and upnode (string-search "(" upnode)) (setq upnode nil))
(when (and (not (Info-index-node nodename file))
(re-search-forward "^\\* Menu:" bound t))
(forward-line 1)
@@ -2616,7 +2618,7 @@ new buffer."
(let (target i (str (concat "\\*note " (regexp-quote footnotename)))
(case-fold-search t))
- (while (setq i (string-match " " str i))
+ (while (setq i (string-search " " str i))
(setq str (concat (substring str 0 i) "[ \t\n]+" (substring str (1+ i))))
(setq i (+ i 6)))
(save-excursion
@@ -2933,7 +2935,7 @@ last sub-node, if any; otherwise go \"up\" to the parent
node."
(let ((prevnode (Info-extract-pointer "prev[ious]*" t))
(upnode (Info-extract-pointer "up" t))
(case-fold-search t))
- (cond ((and upnode (string-match "(" upnode))
+ (cond ((and upnode (string-search "(" upnode))
(user-error "First node in file"))
((and upnode (or (null prevnode)
;; Use string-equal, not equal,
@@ -3778,7 +3780,7 @@ Build a menu of the possible matches."
"The following packages match the keyword ‘" nodename "’:\n\n")
(insert "* Menu:\n\n")
(let ((keywords
- (mapcar #'intern (if (string-match-p "," nodename)
+ (mapcar #'intern (if (string-search "," nodename)
(split-string nodename ",[ \t\n]*" t)
(list nodename))))
hits desc)
@@ -4117,9 +4119,9 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
:help "Search for another occurrence of regular expression"]
"---"
("History"
- ["Back in history" Info-history-back :active Info-history
+ ["Back in History" Info-history-back :active Info-history
:help "Go back in history to the last node you were at"]
- ["Forward in history" Info-history-forward :active Info-history-forward
+ ["Forward in History" Info-history-forward :active Info-history-forward
:help "Go forward in history"]
["Show History" Info-history :active Info-history-list
:help "Go to menu of visited nodes"])
@@ -4146,6 +4148,25 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
"---"
["Exit" quit-window :help "Stop reading Info"]))
+(defun Info-context-menu (menu)
+ (define-key menu [Info-separator] menu-bar-separator)
+ (let ((easy-menu (make-sparse-keymap "Info")))
+ (easy-menu-define nil easy-menu nil
+ '("Info"
+ ["Back in History" Info-history-back :visible Info-history
+ :help "Go back in history to the last node you were at"]
+ ["Forward in History" Info-history-forward :visible
Info-history-forward
+ :help "Go forward in history"]))
+ (dolist (item (reverse (lookup-key easy-menu [menu-bar info])))
+ (when (consp item)
+ (define-key menu (vector (car item)) (cdr item)))))
+
+ (when (mouse-posn-property (event-start last-input-event) 'mouse-face)
+ (define-key menu [Info-mouse-follow-nearest-node]
+ '(menu-item "Follow Link" Info-mouse-follow-nearest-node
+ :help "Follow a link where you click")))
+
+ menu)
(defvar info-tool-bar-map
(let ((map (make-sparse-keymap)))
@@ -4446,6 +4467,7 @@ Advanced commands:
(add-hook 'clone-buffer-hook 'Info-clone-buffer nil t)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(add-hook 'isearch-mode-hook 'Info-isearch-start nil t)
+ (add-hook 'context-menu-functions 'Info-context-menu 5 t)
(when Info-standalone
(add-hook 'quit-window-hook 'save-buffers-kill-emacs nil t))
(setq-local isearch-search-fun-function #'Info-isearch-search)
@@ -5244,7 +5266,7 @@ The INDENT level is ignored."
TEXT is the text of the button we clicked on, a + or - item.
TOKEN is data related to this node (NAME . FILE).
INDENT is the current indentation depth."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(if (speedbar-with-writable
(save-excursion
@@ -5252,7 +5274,7 @@ INDENT is the current indentation depth."
(Info-speedbar-hierarchy-buttons nil (1+ indent) token)))
(speedbar-change-expand-button-char ?-)
(speedbar-change-expand-button-char ??)))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 55accf5..abccc4f 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -662,6 +662,26 @@ overrides that argument.")
(delq 'no-conversion (copy-sequence codings))))
codings))
+(defun select-safe-coding-system--format-list (list)
+ (let ((spec1 " %-20s %6s %-10s %s\n")
+ (spec2 " %-20s %6s #x%-8X %c\n")
+ (nmax 5))
+ (insert (format spec1 "Coding System" "Pos" "Codepoint" "Char"))
+ (cl-loop for (coding . pairs) in list
+ do (cl-loop for pair in pairs
+ ;; If there's a lot, only do the first five.
+ for i from 1 upto nmax
+ do (insert
+ (format spec2
+ (if (= i 1) coding "")
+ (car pair)
+ (cdr pair)
+ (cdr pair))))
+ (if (> (length pairs) nmax)
+ (insert (format spec1 "" "..." "" "")))))
+
+ (insert "\n"))
+
(defun select-safe-coding-system-interactively (from to codings unsafe
&optional rejected default)
"Select interactively a coding system for the region FROM ... TO.
@@ -720,21 +740,18 @@ DEFAULT is the coding system to use by default in the
query."
(concat " \"" (if (> (length from) 10)
(concat (substring from 0 10) "...\"")
(concat from "\"")))
- (format-message " text\nin the buffer `%s'" bufname))
+ (format-message
+ " the following\nproblematic characters in the buffer `%s'"
+ bufname))
":\n")
- (let ((pos (point))
- (fill-prefix " "))
- (dolist (x (append rejected unsafe))
- (princ " ") (princ x))
- (insert "\n")
- (fill-region-as-paragraph pos (point)))
+ (select-safe-coding-system--format-list unsafe)
(when rejected
(insert "These safely encode the text in the buffer,
but are not recommended for encoding text in this context,
e.g., for sending an email message.\n ")
- (dolist (x rejected)
- (princ " ") (princ x))
- (insert "\n"))
+ (dolist (x rejected)
+ (princ " ") (princ x))
+ (insert "\n"))
(when unsafe
(insert (if rejected "The other coding systems"
"However, each of them")
@@ -2166,7 +2183,7 @@ See `set-language-info-alist' for use in programs."
(let ((str (eval (get-language-info language-name 'sample-text))))
(if (stringp str)
(insert "Sample text:\n "
- (replace-regexp-in-string "\n" "\n " str)
+ (string-replace "\n" "\n " str)
"\n\n")))
(error nil))
(let ((input-method (get-language-info language-name 'input-method))
@@ -2610,6 +2627,31 @@ is returned. Thus, for instance, if charset
\"ISO8859-2\",
(declare-function w32-get-console-codepage "w32proc.c" ())
(declare-function w32-get-console-output-codepage "w32proc.c" ())
+(defun get-locale-names ()
+ "Return a list of locale names."
+ (cond
+ ;; On Windows we have a built-in method to get the names.
+ ((and (fboundp 'w32-get-locale-info)
+ (fboundp 'w32-get-valid-locale-ids))
+ (delete-dups (mapcar #'w32-get-locale-info (w32-get-valid-locale-ids))))
+ ;; Unix-ey hosts should have a command to output locales currently
+ ;; defined by the OS.
+ ((executable-find "locale")
+ (split-string (shell-command-to-string "locale -a")))
+ ;; Fall back on the list of all defined locales.
+ ((and locale-translation-file-name
+ (file-exists-p locale-translation-file-name))
+ (with-temp-buffer
+ (insert-file-contents locale-translation-file-name)
+ (let ((locales nil))
+ (while (not (eobp))
+ (unless (looking-at-p "#")
+ (push (cadr (split-string (buffer-substring
+ (point) (line-end-position))))
+ locales))
+ (forward-line 1))
+ (nreverse locales))))))
+
(defun locale-translate (locale)
"Expand LOCALE according to `locale-translation-file-name', if possible.
For example, translate \"swedish\" into \"sv_SE.ISO8859-1\"."
@@ -2650,8 +2692,8 @@ touch session-global parameters like the language
environment.
See also `locale-charset-language-names', `locale-language-names',
`locale-preferred-coding-systems' and `locale-coding-system'."
- (interactive "sSet environment for locale: ")
-
+ (interactive (list (completing-read "Set environment for locale: "
+ (get-locale-names))))
;; Do this at runtime for the sake of binaries possibly transported
;; to a system without X.
(setq locale-translation-file-name
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 2d3cd25b..864cd3c 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -862,15 +862,28 @@ The IGNORED argument is ignored."
(defvar mule--print-opened)
+(defun mule--kbd-at (point)
+ (save-excursion
+ (goto-char point)
+ (elt
+ (kbd (buffer-substring
+ (point)
+ (progn
+ ;; Might be a space, in which case we want it.
+ (if (zerop (skip-chars-forward "^ "))
+ (1+ (point))
+ (point)))))
+ 0)))
+
(defun print-fontset-element (val)
;; VAL has this format:
;; ((REQUESTED-FONT-NAME OPENED-FONT-NAME ...) ...)
;; CHAR RANGE is already inserted. Get character codes from
;; the current line.
(beginning-of-line)
- (let ((from (following-char))
+ (let ((from (mule--kbd-at (point)))
(to (if (looking-at "[^.]*[.]* ")
- (char-after (match-end 0)))))
+ (mule--kbd-at (match-end 0)))))
(if (re-search-forward "[ \t]*$" nil t)
(delete-region (match-beginning 0) (match-end 0)))
@@ -905,13 +918,13 @@ The IGNORED argument is ignored."
(setq family "*-*")
(if (symbolp family)
(setq family (symbol-name family)))
- (or (string-match "-" family)
+ (or (string-search "-" family)
(setq family (concat "*-" family))))
(if (not registry)
(setq registry "*-*")
(if (symbolp registry)
(setq registry (symbol-name registry)))
- (or (string-match "-" registry)
+ (or (string-search "-" registry)
(= (aref registry (1- (length registry))) ?*)
(setq registry (concat registry "*"))))
(insert (format"\n -%s-%s-%s-%s-%s-*-*-*-*-*-*-%s"
diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el
index 5544959..38d29cb 100644
--- a/lisp/international/mule-util.el
+++ b/lisp/international/mule-util.el
@@ -333,13 +333,20 @@ QUALITY can be:
`approximate', in which case we may cut some corners to avoid
excessive work.
`exact', in which case we may end up re-(en/de)coding a large
- part of the file/buffer, this can be expensive and slow.
+ part of the file/buffer, this can be expensive and slow. (It
+ is an error to request the `exact' method when the buffer's
+ EOL format is not yet decided.)
nil, in which case we may return nil rather than an approximation."
(unless coding-system (setq coding-system buffer-file-coding-system))
(let ((eol (coding-system-eol-type coding-system))
(type (coding-system-type coding-system))
(base (coding-system-base coding-system))
(pm (save-restriction (widen) (point-min))))
+ ;; Handle EOL edge cases.
+ (unless (numberp eol)
+ (if (eq quality 'exact)
+ (error "Unknown EOL format in coding system: %s" coding-system)
+ (setq eol 0)))
(and (eq type 'utf-8)
;; Any post-read/pre-write conversions mean it's not really UTF-8.
(not (null (coding-system-get coding-system :post-read-conversion)))
@@ -409,14 +416,24 @@ QUALITY can be:
`approximate', in which case we may cut some corners to avoid
excessive work.
`exact', in which case we may end up re-(en/de)coding a large
- part of the file/buffer, this can be expensive and slow.
+ part of the file/buffer, this can be expensive and slow. (It
+ is an error to request the `exact' method when the buffer's
+ EOL format is not yet decided.)
nil, in which case we may return nil rather than an approximation."
(unless coding-system (setq coding-system buffer-file-coding-system))
(let* ((eol (coding-system-eol-type coding-system))
- (lineno (if (= eol 1) (1- (line-number-at-pos position)) 0))
(type (coding-system-type coding-system))
(base (coding-system-base coding-system))
- (point-min 1)) ;Clarify what the `1' means.
+ (point-min 1) ;Clarify what the `1' means.
+ lineno)
+ ;; Handle EOL edge cases.
+ (unless (numberp eol)
+ (if (eq quality 'exact)
+ (error "Unknown EOL format in coding system: %s" coding-system)
+ (setq eol 0)))
+ (setq lineno (if (= eol 1)
+ (1- (line-number-at-pos position))
+ 0))
(and (eq type 'utf-8)
;; Any post-read/pre-write conversions mean it's not really UTF-8.
(not (null (coding-system-get coding-system :post-read-conversion)))
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 9cd38af..1a53237 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -1380,8 +1380,11 @@ If CODING-SYSTEM is nil or the coding-type of
CODING-SYSTEM is
`raw-text', the decoding of keyboard input is disabled.
TERMINAL may be a terminal object, a frame, or nil for the
-selected frame's terminal. The setting has no effect on
-graphical terminals."
+selected frame's terminal.
+
+The setting has no effect on graphical terminals. It also
+has no effect on MS-Windows text-mode terminals, except on
+Windows 9X systems. For Windows 9X, see also `w32-set-console-codepage'."
(interactive
(list (let* ((coding (keyboard-coding-system nil))
(default (if (eq (coding-system-type coding) 'raw-text)
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 922ab0f..1c776a0 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -869,7 +869,8 @@ When you enter a space or spaces in ordinary incremental
search, it
will match any sequence matched by the regexp defined by the variable
`search-whitespace-regexp'. If the value is nil, each space you type
matches literally, against one space. You can toggle the value of this
-variable by the command `isearch-toggle-lax-whitespace'.")
+variable by the command `isearch-toggle-lax-whitespace', usually bound to
+`M-s SPC' during isearch.")
(defvar isearch-regexp-lax-whitespace nil
"If non-nil, a space will match a sequence of whitespace chars.
@@ -877,7 +878,8 @@ When you enter a space or spaces in regexp incremental
search, it
will match any sequence matched by the regexp defined by the variable
`search-whitespace-regexp'. If the value is nil, each space you type
matches literally, against one space. You can toggle the value of this
-variable by the command `isearch-toggle-lax-whitespace'.")
+variable by the command `isearch-toggle-lax-whitespace', usually bound to
+`M-s SPC' during isearch.")
(defvar isearch-cmds nil
"Stack of search status elements.
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index a128792..a905936 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -150,7 +150,10 @@ If 0, then fontification is only deferred while there is
input pending."
(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.")
+the START and END of the region to fontify.
+Each function can return a list of the form (jit-lock-bounds BEG . END),
+to indicate the bounds of the region it actually fontified;
+JIT font-lock will use this information to optimize redisplay cycles.")
(defvar-local jit-lock-context-unfontify-pos nil
"Consider text after this position as contextually unfontified.
@@ -332,7 +335,10 @@ like `debug-on-error' and Edebug can be used."
"Register FUN as a fontification function to be called in this buffer.
FUN will be called with two arguments START and END indicating the region
that needs to be (re)fontified.
-If non-nil, CONTEXTUAL means that a contextual fontification would be useful."
+If non-nil, CONTEXTUAL means that a contextual fontification would be useful.
+FUN can return a list of the form (jit-lock-bounds BEG . END),
+to indicate the bounds of the region it actually fontified; JIT
+font-lock will use this information to optimize redisplay cycles."
(add-hook 'jit-lock-functions fun nil t)
(when (and contextual jit-lock-contextually)
(setq-local jit-lock-contextually t))
diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el
index f3e3590..feb75a1 100644
--- a/lisp/language/japan-util.el
+++ b/lisp/language/japan-util.el
@@ -145,7 +145,7 @@ and HANKAKU belongs to `japanese-jisx0201-kana'.")
(?ｐ . ?p) (?ｑ . ?q) (?ｒ . ?r) (?ｓ . ?s) (?ｔ . ?t)
(?ｕ . ?u) (?ｖ . ?v) (?ｗ . ?w) (?ｘ . ?x) (?ｙ . ?y) (?ｚ . ?z))
"Japanese JISX0208 alpha numeric character table.
-Each element is of the form (ALPHA-NUMERIC . ASCII), where ALPHA-NUMERIC
+Each element is of the form (ALPHANUMERIC . ASCII), where ALPHANUMERIC
belongs to `japanese-jisx0208', ASCII belongs to `ascii'.")
;; Put properties 'jisx0208 and 'ascii to each Japanese alpha numeric
diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el
index b999eff..121a4c5 100644
--- a/lisp/language/korea-util.el
+++ b/lisp/language/korea-util.el
@@ -29,7 +29,7 @@
;;;###autoload
(defvar default-korean-keyboard
- (purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") ""))
+ (purecopy (if (string-search "3" (or (getenv "HANGUL_KEYBOARD_TYPE") ""))
"3"
""))
"The kind of Korean keyboard for Korean (Hangul) input method.
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index efaf061..542cbef 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -952,6 +952,11 @@ This is a good function to put in
`comint-output-filter-functions'.
\(fn IGNORED)" nil nil)
+(autoload 'ansi-color-compilation-filter "ansi-color" "\
+Maybe translate SGR control sequences into text properties.
+This function depends on the `ansi-color-for-compilation-mode'
+variable, and is meant to be used in `compilation-filter-hook'." nil nil)
+
(register-definition-prefixes "ansi-color" '("ansi-color-"))
;;;***
@@ -1548,7 +1553,7 @@ ENTRY is the name of a password-store entry.
The key used to retrieve the password is the symbol `secret'.
The convention used as the format for a password-store file is
-the following (see https://www.passwordstore.org/#organization):
+the following (see URL `https://www.passwordstore.org/#organization'):
secret
key1: value1
@@ -1788,6 +1793,10 @@ disk changes.
When a buffer is reverted, a message is generated. This can be
suppressed by setting `auto-revert-verbose' to nil.
+Reverting can sometimes fail to preserve all the markers in the buffer.
+To avoid that, set `revert-buffer-insert-file-contents-function' to
+the slower function `revert-buffer-insert-file-contents-delicately'.
+
Use `global-auto-revert-mode' to automatically revert all buffers.
Use `auto-revert-tail-mode' if you know that the file will only grow
without being changed in the part that is already in the buffer.
@@ -2929,6 +2938,13 @@ from `browse-url-elinks-wrapper'.
\(fn URL &optional NEW-WINDOW)" t nil)
+(autoload 'browse-url-button-open "browse-url" "\
+Follow the link under point using `browse-url'.
+If EXTERNAL (the prefix if used interactively), open with the
+external browser instead of the default one.
+
+\(fn &optional EXTERNAL MOUSE-EVENT)" t nil)
+
(autoload 'browse-url-button-open-url "browse-url" "\
Open URL using `browse-url'.
If `current-prefix-arg' is non-nil, use
@@ -3385,6 +3401,16 @@ Parse a rectangle as a matrix of numbers and push it on
the Calculator stack.
\(fn TOP BOT ARG)" t nil)
+(autoload 'calc-grab-sum-down "calc" "\
+Parse a rectangle as a matrix of numbers and sum its columns.
+
+\(fn TOP BOT ARG)" t nil)
+
+(autoload 'calc-grab-sum-across "calc" "\
+Parse a rectangle as a matrix of numbers and sum its rows.
+
+\(fn TOP BOT ARG)" t nil)
+
(autoload 'calc-embedded "calc" "\
Start Calc Embedded mode on the formula surrounding point.
@@ -5215,7 +5241,7 @@ Normally display output in temp buffer, but
prefix arg means replace the region with it.
`c-macro-preprocessor' specifies the preprocessor to use.
-Tf the user option `c-macro-prompt-flag' is non-nil
+If the user option `c-macro-prompt-flag' is non-nil
prompt for arguments to the preprocessor (e.g. `-DDEBUG -I ./include'),
otherwise use `c-macro-cppflags'.
@@ -6843,8 +6869,11 @@ or call the function `global-cwarn-mode'.")
(autoload 'global-cwarn-mode "cwarn" "\
Toggle Cwarn mode in all buffers.
With prefix ARG, enable Global Cwarn mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if ARG is
-omitted or nil.
+otherwise, disable it.
+
+If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
Cwarn mode is enabled in all buffers where
`turn-on-cwarn-mode-if-enabled' would do it.
@@ -8112,11 +8141,17 @@ Keybindings:
(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 a buffer visiting a file, Dired that file's directory and
+move to that file's line in the directory listing.
+
+If the current buffer isn't visiting a file, Dired `default-directory'.
+
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.
@@ -8356,8 +8391,11 @@ or call the function
`global-display-fill-column-indicator-mode'.")
(autoload 'global-display-fill-column-indicator-mode
"display-fill-column-indicator" "\
Toggle Display-Fill-Column-Indicator mode in all buffers.
With prefix ARG, enable Global Display-Fill-Column-Indicator mode if
-ARG is positive; otherwise, disable it. If called from Lisp, enable
-the mode if ARG is omitted or nil.
+ARG is positive; otherwise, disable it.
+
+If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
Display-Fill-Column-Indicator mode is enabled in all buffers where
`display-fill-column-indicator--turn-on' would do it.
@@ -8433,8 +8471,11 @@ or call the function
`global-display-line-numbers-mode'.")
(autoload 'global-display-line-numbers-mode "display-line-numbers" "\
Toggle Display-Line-Numbers mode in all buffers.
With prefix ARG, enable Global Display-Line-Numbers mode if ARG is
-positive; otherwise, disable it. If called from Lisp, enable the mode
-if ARG is omitted or nil.
+positive; otherwise, disable it.
+
+If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
Display-Line-Numbers mode is enabled in all buffers where
`display-line-numbers--turn-on' would do it.
@@ -8724,9 +8765,9 @@ BODY contains code to execute each time the mode is
enabled or disabled.
named variable, or a generalized variable.
PLACE can also be of the form (GET . SET), where GET is
an expression that returns the current state, and SET is
- a function that takes one argument, the new state, and
- sets it. If you specify a :variable, this function does
- not define a MODE variable (nor any of the terms used
+ a function that takes one argument, the new state, which should
+ be assigned to PLACE. If you specify a :variable, this
function
+ does not define a MODE variable (nor any of the terms used
in :variable).
:after-hook A single lisp form which is evaluated after the mode hooks
have been run. It should not be quoted.
@@ -11216,6 +11257,8 @@ Any other value means use the setting of
`case-fold-search'.")
(custom-autoload 'tags-case-fold-search "etags" t)
+(put 'tags-case-fold-search 'safe-local-variable 'symbolp)
+
(defvar tags-table-list nil "\
List of file names of tags tables to search.
An element that is a directory means the file \"TAGS\" in that directory.
@@ -12269,6 +12312,9 @@ Besides the choice of face, it is the same as
`buffer-face-mode'.
;;;### (autoloads nil "facemenu" "facemenu.el" (0 0 0 0))
;;; Generated autoloads from facemenu.el
+ (autoload 'facemenu-menu "facemenu" nil nil 'keymap)
+
+(define-key global-map [C-down-mouse-2] 'facemenu-menu)
(autoload 'list-colors-display "facemenu" "\
Display names of defined colors, and show what they look like.
@@ -12387,6 +12433,11 @@ reminders, you can set `feedmail-queue-reminder-alist'
to nil.
;;;### (autoloads nil "ffap" "ffap.el" (0 0 0 0))
;;; Generated autoloads from ffap.el
+(defvar ffap-file-finder 'find-file "\
+The command called by `find-file-at-point' to find a file.")
+
+(custom-autoload 'ffap-file-finder "ffap" t)
+
(autoload 'ffap-next "ffap" "\
Search buffer for next file or URL, and run ffap.
Optional argument BACK says to search backwards.
@@ -15255,8 +15306,11 @@ or call the function `global-goto-address-mode'.")
(autoload 'global-goto-address-mode "goto-addr" "\
Toggle Goto-Address mode in all buffers.
With prefix ARG, enable Global Goto-Address mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if ARG
-is omitted or nil.
+otherwise, disable it.
+
+If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
Goto-Address mode is enabled in all buffers where
`goto-addr-mode--turn-on' would do it.
@@ -15348,7 +15402,7 @@ List of hook functions run by `grep-process-setup' (see
`run-hooks').")
(custom-autoload 'grep-setup-hook "grep" t)
-(defconst grep-regexp-alist `((,(concat "^\\(?:"
"\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:"
"\\(?:[a-zA-Z]:\\)?" "[^\n:]+?[^\n/:]\\):[\11 ]*\\(?2:[1-9][0-9]*\\)[\11 ]*:"
"\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end
0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg
(text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (-
mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg
(match-end [...]
+(defconst grep-regexp-alist `((,(concat "^\\(?:"
"\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:"
"\\(?:[a-zA-Z]:\\)?" "[^\n:]+?[^\n/:]\\):[\11 ]*\\(?2:[1-9][0-9]*\\)[\11 ]*:"
"\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end
0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg
(text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (-
mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg
(match-end [...]
Regexp used to match grep hits.
See `compilation-error-regexp-alist' for format details.")
@@ -15551,9 +15605,14 @@ directories if your program contains sources from more
than one directory.
\(fn COMMAND-LINE)" t nil)
(autoload 'perldb "gud" "\
-Run perldb on program FILE in buffer *gud-FILE*.
-The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger.
+Debug a perl program with gud.
+Interactively, this will prompt you for a command line.
+
+Noninteractively, COMMAND-LINE should be on the form
+\"perl -d perl-file.pl\".
+
+The directory containing the perl program becomes the initial
+working directory and source-file directory for your debugger.
\(fn COMMAND-LINE)" t nil)
@@ -16169,7 +16228,7 @@ it does not already exist." nil nil)
Parse and hyperlink documentation cross-references in the given BUFFER.
Find cross-reference information in a buffer and activate such cross
-references for selection with `help-follow'. Cross-references have
+references for selection with `help-follow-symbol'. Cross-references have
the canonical form `...' and the type of reference may be
disambiguated by the preceding word(s) used in
`help-xref-symbol-regexp'. Faces only get cross-referenced if
@@ -16443,8 +16502,11 @@ or call the function `global-hi-lock-mode'.")
(autoload 'global-hi-lock-mode "hi-lock" "\
Toggle Hi-Lock mode in all buffers.
With prefix ARG, enable Global Hi-Lock mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if ARG is
-omitted or nil.
+otherwise, disable it.
+
+If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
Hi-Lock mode is enabled in all buffers where
`turn-on-hi-lock-if-enabled' would do it.
@@ -16841,8 +16903,11 @@ or call the function `global-highlight-changes-mode'.")
(autoload 'global-highlight-changes-mode "hilit-chg" "\
Toggle Highlight-Changes mode in all buffers.
With prefix ARG, enable Global Highlight-Changes mode if ARG is
-positive; otherwise, disable it. If called from Lisp, enable the mode if
-ARG is omitted or nil.
+positive; otherwise, disable it.
+
+If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
Highlight-Changes mode is enabled in all buffers where
`highlight-changes-mode-turn-on' would do it.
@@ -17443,17 +17508,50 @@ evaluate `(default-value 'icomplete-vertical-mode)'.
The mode's hook is called both when the mode is enabled and when it is
disabled.
+If none of these modes are on, turn on `icomplete-mode'.
+
As many completion candidates as possible are displayed, depending on
the value of `max-mini-window-height', and the way the mini-window is
resized depends on `resize-mini-windows'.
\(fn &optional ARG)" t nil)
+
+(defvar fido-vertical-mode nil "\
+Non-nil if Fido-Vertical mode is enabled.
+See the `fido-vertical-mode' command
+for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `fido-vertical-mode'.")
+
+(custom-autoload 'fido-vertical-mode "icomplete" nil)
+
+(autoload 'fido-vertical-mode "icomplete" "\
+Toggle vertical candidate display in `fido-mode'.
+When turning on, if non-vertical `fido-mode' is off, turn it on.
+If it's on, just add the vertical display.
+
+This is a minor mode. If called interactively, toggle the
+`Fido-Vertical mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'fido-vertical-mode)'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+\(fn &optional ARG)" t nil)
(when (locate-library "obsolete/iswitchb")
(autoload 'iswitchb-mode "iswitchb" "Toggle Iswitchb mode." t)
(make-obsolete 'iswitchb-mode
"use `icomplete-mode' or `ido-mode' instead." "24.4"))
-(register-definition-prefixes "icomplete" '("fido-vertical-mode" "icomplete-"))
+(register-definition-prefixes "icomplete" '("icomplete-"))
;;;***
@@ -18657,9 +18755,14 @@ Convert old Emacs Devanagari characters to UCS.
Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'.
If there is a process already running in `*inferior-lisp*', just switch
to that buffer.
+
With argument, allows you to edit the command line (default is value
of `inferior-lisp-program'). Runs the hooks from
`inferior-lisp-mode-hook' (after the `comint-mode-hook' is run).
+
+If any parts of the command name contains spaces, they should be
+quoted using shell quote syntax.
+
\(Type \\[describe-mode] in the process buffer for a list of commands.)
\(fn CMD)" t nil)
@@ -19836,7 +19939,7 @@ Create lambda form for macro bound to symbol or key.
;;;;;; 0 0))
;;; Generated autoloads from language/korea-util.el
-(defvar default-korean-keyboard (purecopy (if (string-match "3" (or (getenv
"HANGUL_KEYBOARD_TYPE") "")) "3" "")) "\
+(defvar default-korean-keyboard (purecopy (if (string-search "3" (or (getenv
"HANGUL_KEYBOARD_TYPE") "")) "3" "")) "\
The kind of Korean keyboard for Korean (Hangul) input method.
\"\" for 2, \"3\" for 3, and \"3f\" for 3f.")
@@ -20115,8 +20218,11 @@ or call the function `global-linum-mode'.")
(autoload 'global-linum-mode "linum" "\
Toggle Linum mode in all buffers.
With prefix ARG, enable Global Linum mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if ARG is
-omitted or nil.
+otherwise, disable it.
+
+If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
Linum mode is enabled in all buffers where `linum-on' would do it.
@@ -20510,7 +20616,10 @@ This function is primarily meant for when you're
displaying the
result to the user: Many prettifications are applied to the
result returned. If you want to decode an address for further
non-display use, you should probably use
-`mail-header-parse-address' instead.
+`mail-header-parse-address' instead. Also see
+`mail-header-parse-address-lax' for a function that's less strict
+than `mail-header-parse-address', but does less post-processing
+to the results.
\(fn ADDRESS &optional ALL)" nil nil)
@@ -21033,7 +21142,7 @@ Default bookmark handler for Man buffers.
;;;### (autoloads nil "map" "emacs-lisp/map.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/map.el
-(push (purecopy '(map 3 0)) package--builtin-versions)
+(push (purecopy '(map 3 1)) package--builtin-versions)
(register-definition-prefixes "map" '("map-"))
@@ -22455,7 +22564,7 @@ The default is 20. If LIMIT is negative, do not limit
the listing.
\(fn &optional LIMIT)" t nil)
-(register-definition-prefixes "mule-diag" '("charset-history"
"describe-font-internal" "insert-section" "list-" "print-"
"sort-listed-character-sets"))
+(register-definition-prefixes "mule-diag" '("charset-history"
"describe-font-internal" "insert-section" "list-" "mule--kbd-at" "print-"
"sort-listed-character-sets"))
;;;***
@@ -22579,7 +22688,9 @@ QUALITY can be:
`approximate', in which case we may cut some corners to avoid
excessive work.
`exact', in which case we may end up re-(en/de)coding a large
- part of the file/buffer, this can be expensive and slow.
+ part of the file/buffer, this can be expensive and slow. (It
+ is an error to request the `exact' method when the buffer's
+ EOL format is not yet decided.)
nil, in which case we may return nil rather than an approximation.
\(fn BYTE &optional QUALITY CODING-SYSTEM)" nil nil)
@@ -22593,7 +22704,9 @@ QUALITY can be:
`approximate', in which case we may cut some corners to avoid
excessive work.
`exact', in which case we may end up re-(en/de)coding a large
- part of the file/buffer, this can be expensive and slow.
+ part of the file/buffer, this can be expensive and slow. (It
+ is an error to request the `exact' method when the buffer's
+ EOL format is not yet decided.)
nil, in which case we may return nil rather than an approximation.
\(fn POSITION &optional QUALITY CODING-SYSTEM)" nil nil)
@@ -22605,13 +22718,13 @@ QUALITY can be:
;;;### (autoloads nil "mwheel" "mwheel.el" (0 0 0 0))
;;; Generated autoloads from mwheel.el
-(defcustom mouse-wheel-mode t "\
+(defvar mouse-wheel-mode t "\
Non-nil if Mouse-Wheel mode is enabled.
See the `mouse-wheel-mode' command
for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
-or call the function `mouse-wheel-mode'." :set #'custom-set-minor-mode
:initialize 'custom-initialize-delay :type 'boolean :group 'mouse)
+or call the function `mouse-wheel-mode'.")
(custom-autoload 'mouse-wheel-mode "mwheel" nil)
@@ -25075,6 +25188,19 @@ of the elements of LIST is performed as if by
`pcase-let'.
(function-put 'pcase-dolist 'lisp-indent-function '1)
+(autoload 'pcase-setq "pcase" "\
+Assign values to variables by destructuring with `pcase'.
+PATTERNS are normal `pcase' patterns, and VALUES are expression.
+
+Evaluation happens sequentially as in `setq' (not in parallel).
+
+An example: (pcase-setq `((,a) [(,b)]) '((1) [(2)]))
+
+VAL is presumed to match PAT. Failure to match may signal an error or go
+undetected, binding variables to arbitrary values, such as nil.
+
+\(fn PATTERNS VALUE PATTERN VALUES ...)" nil t)
+
(autoload 'pcase-defmacro "pcase" "\
Define a new kind of pcase PATTERN, by macro expansion.
Patterns of the form (NAME ...) will be expanded according
@@ -26279,7 +26405,7 @@ Open profile FILENAME.
;;;### (autoloads nil "project" "progmodes/project.el" (0 0 0 0))
;;; Generated autoloads from progmodes/project.el
-(push (purecopy '(project 0 6 0)) package--builtin-versions)
+(push (purecopy '(project 0 6 1)) package--builtin-versions)
(autoload 'project-current "project" "\
Return the project instance in DIRECTORY, defaulting to `default-directory'.
@@ -27308,7 +27434,11 @@ If ARG is non-nil, instead prompt for connection
parameters.
(defalias 'irc 'rcirc)
(autoload 'rcirc-connect "rcirc" "\
-
+Connect to SERVER.
+The arguments PORT, NICK, USER-NAME, FULL-NAME, PASSWORD,
+ENCRYPTION, SERVER-ALIAS are interpreted as in
+`rcirc-server-alist'. STARTUP-CHANNELS is a list of channels
+that are joined after authentication.
\(fn SERVER &optional PORT NICK USER-NAME FULL-NAME STARTUP-CHANNELS PASSWORD
ENCRYPTION SERVER-ALIAS)" nil nil)
@@ -27341,7 +27471,7 @@ disabled.
\(fn &optional ARG)" t nil)
-(register-definition-prefixes "rcirc" '("defun-rcirc-command" "rcirc-"
"set-rcirc-" "with-rcirc-"))
+(register-definition-prefixes "rcirc" '("rcirc-" "with-rcirc-"))
;;;***
@@ -27782,8 +27912,8 @@ This means the number of non-shy regexp grouping
constructs
(autoload 'remember "remember" "\
Remember an arbitrary piece of data.
-INITIAL is the text to initially place in the *Remember* buffer,
-or nil to bring up a blank *Remember* buffer.
+INITIAL is the text to initially place in the `remember-buffer',
+or nil to bring up a blank `remember-buffer'.
With a prefix or a visible region, use the region as INITIAL.
@@ -27884,7 +28014,7 @@ disabled.
\(fn &optional ARG)" t nil)
-(register-definition-prefixes "repeat" '("describe-repeat" "repeat-"))
+(register-definition-prefixes "repeat" '("describe-repeat-maps" "repeat-"))
;;;***
@@ -28048,10 +28178,10 @@ disabled.
;;;***
-;;;### (autoloads nil "rfc2368" "mail/rfc2368.el" (0 0 0 0))
-;;; Generated autoloads from mail/rfc2368.el
+;;;### (autoloads nil "rfc6068" "mail/rfc6068.el" (0 0 0 0))
+;;; Generated autoloads from mail/rfc6068.el
-(register-definition-prefixes "rfc2368" '("rfc2368-"))
+(register-definition-prefixes "rfc6068" '("rfc6068-"))
;;;***
@@ -28891,7 +29021,8 @@ Zero-width assertions: these all match the empty string
in specific places.
\(literal EXPR) Match the literal string from evaluating EXPR at run time.
\(regexp EXPR) Match the string regexp from evaluating EXPR at run time.
-\(eval EXPR) Match the rx sexp from evaluating EXPR at compile time.
+\(eval EXPR) Match the rx sexp from evaluating EXPR at macro-expansion
+ (compile) time.
Additional constructs can be defined using `rx-define' and `rx-let',
which see.
@@ -30312,6 +30443,13 @@ arguments.")
(custom-autoload 'shell-dumb-shell-regexp "shell" t)
+(autoload 'split-string-shell-command "shell" "\
+Split STRING (a shell command) into a list of strings.
+General shell syntax, like single and double quoting, as well as
+backslash quoting, is respected.
+
+\(fn STRING)" nil nil)
+
(autoload 'shell "shell" "\
Run an inferior shell, with I/O through BUFFER (which defaults to `*shell*').
Interactively, a prefix arg means to prompt for BUFFER.
@@ -30358,8 +30496,9 @@ Make the shell buffer the current buffer, and return it.
(autoload 'shortdoc-display-group "shortdoc" "\
Pop to a buffer with short documentation summary for functions in GROUP.
+If FUNCTION is non-nil, place point on the entry for FUNCTION (if any).
-\(fn GROUP)" t nil)
+\(fn GROUP &optional FUNCTION)" t nil)
(register-definition-prefixes "shortdoc" '("alist" "buffer"
"define-short-documentation-group" "file" "hash-table" "list" "number"
"overlay" "process" "regexp" "sequence" "shortdoc-" "string" "vector"))
@@ -30763,7 +30902,7 @@ then `snmpv2-mode-hook'." t nil)
;;;### (autoloads nil "so-long" "so-long.el" (0 0 0 0))
;;; Generated autoloads from so-long.el
-(push (purecopy '(so-long 1 0)) package--builtin-versions)
+(push (purecopy '(so-long 1 1 1)) package--builtin-versions)
(autoload 'so-long-commentary "so-long" "\
View the so-long documentation in `outline-mode'." t nil)
@@ -32081,6 +32220,14 @@ Truncate STRING to LENGTH, replacing initial surplus
with \"...\".
\(fn STRING LENGTH)" nil nil)
+(autoload 'string-clean-whitespace "subr-x" "\
+Clean up whitespace in STRING.
+All sequences of whitespaces in STRING are collapsed into a
+single space character, and leading/trailing whitespace is
+removed.
+
+\(fn STRING)" nil nil)
+
(autoload 'string-lines "subr-x" "\
Split STRING into a list of lines.
If OMIT-NULLS, empty lines will be removed from the results.
@@ -32148,8 +32295,11 @@ or call the function `global-subword-mode'.")
(autoload 'global-subword-mode "subword" "\
Toggle Subword mode in all buffers.
With prefix ARG, enable Global Subword mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if ARG is
-omitted or nil.
+otherwise, disable it.
+
+If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
Subword mode is enabled in all buffers where `(lambda nil
\(subword-mode 1))' would do it.
@@ -32199,8 +32349,11 @@ or call the function `global-superword-mode'.")
(autoload 'global-superword-mode "subword" "\
Toggle Superword mode in all buffers.
With prefix ARG, enable Global Superword mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if ARG is
-omitted or nil.
+otherwise, disable it.
+
+If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
Superword mode is enabled in all buffers where `(lambda nil
\(superword-mode 1))' would do it.
@@ -32336,8 +32489,11 @@ or call the function `global-tab-line-mode'.")
(autoload 'global-tab-line-mode "tab-line" "\
Toggle Tab-Line mode in all buffers.
With prefix ARG, enable Global Tab-Line mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if ARG is
-omitted or nil.
+otherwise, disable it.
+
+If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
Tab-Line mode is enabled in all buffers where
`tab-line-mode--turn-on' would do it.
@@ -33691,12 +33847,16 @@ positions of the thing found.
Return the THING at point.
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun',
-`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
-`line', `number', and `page'.
+`filename', `existing-filename', `url', `email', `uuid', `word',
+`sentence', `whitespace', `line', `number', and `page'.
When the optional argument NO-PROPERTIES is non-nil,
strip text properties from the return value.
+If the current buffer uses fields (see Info node `(elisp)Fields'),
+this function will narrow to the field before identifying the
+thing at point.
+
See the file `thingatpt.el' for documentation on how to define
a symbol as a valid THING.
@@ -34129,25 +34289,37 @@ Valid ZONE values are described in the documentation
of `format-time-string'.
(put 'time-stamp-pattern 'safe-local-variable 'stringp)
(autoload 'time-stamp "time-stamp" "\
-Update the time stamp string(s) in the buffer.
-A template in a file can be automatically updated with a new time stamp
-every time you save the file. Add this line to your init file:
- (add-hook \\='before-save-hook \\='time-stamp)
-or customize option `before-save-hook'.
-Normally the template must appear in the first 8 lines of a file and
-look like one of the following:
+Update any time stamp string(s) in the buffer.
+This function looks for a time stamp template and updates it with
+the current date, time, and/or other info.
+
+The template, which you manually create on one of the first 8 lines
+of the file before running this function, by default can look like
+one of the following (your choice):
Time-stamp: <>
Time-stamp: \" \"
-The time stamp is written between the brackets or quotes:
+This function writes the current time between the brackets or quotes,
+by default formatted like this:
Time-stamp: <2020-08-07 17:10:21 gildea>
-The time stamp is updated only if the variable
-`time-stamp-active' is non-nil.
-The format of the time stamp is set by the variable
-`time-stamp-pattern' or `time-stamp-format'.
-The variables `time-stamp-pattern', `time-stamp-line-limit',
-`time-stamp-start', `time-stamp-end', `time-stamp-count', and
-`time-stamp-inserts-lines' control finding the template." t nil)
+Although you can run this function manually to update a time stamp
+once, usually you want automatic time stamp updating.
+
+A time stamp can be automatically updated with current information
+every time you save a file. To enable time-stamping for all files,
+customize option `before-save-hook' or add this line to your init file:
+ (add-hook \\='before-save-hook \\='time-stamp)
+
+To enable automatic time-stamping for only a specific file, add
+this line to a local variables list near the end of the file:
+ eval: (add-hook \\='before-save-hook \\='time-stamp nil t)
+
+If the file has no time-stamp template, this function does nothing.
+
+You can set `time-stamp-pattern' in a files's local variables list
+to customize the information in the time stamp and where it is written.
+
+The time stamp is updated only if `time-stamp-active' is non-nil." t nil)
(autoload 'time-stamp-toggle-active "time-stamp" "\
Toggle `time-stamp-active', setting whether \\[time-stamp] updates a buffer.
@@ -34183,6 +34355,9 @@ updating. With prefix ARG, turn mode line display on
if and only
if ARG is positive. Returns the new status of timeclock mode line
display (non-nil means on).
+If using a customized `timeclock-workday' value, this should be
+set before switching this mode on.
+
\(fn &optional ARG)" t nil)
(autoload 'timeclock-in "timeclock" "\
@@ -34761,7 +34936,7 @@ Add archive file name handler to
`file-name-handler-alist'." (when tramp-archive
;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0))
;;; Generated autoloads from net/trampver.el
-(push (purecopy '(tramp 2 5 1)) package--builtin-versions)
+(push (purecopy '(tramp 2 5 2 -1)) package--builtin-versions)
(register-definition-prefixes "trampver" '("tramp-"))
@@ -35472,7 +35647,9 @@ or call the function `url-handler-mode'.")
(custom-autoload 'url-handler-mode "url-handlers" nil)
(autoload 'url-handler-mode "url-handlers" "\
-Toggle using `url' library for URL filenames (URL Handler mode).
+Handle URLs as if they were file names throughout Emacs.
+After switching on this minor mode, Emacs file primitives handle
+URLs. For instance:
This is a minor mode. If called interactively, toggle the
`Url-Handler mode' mode. If the prefix argument is positive, enable
@@ -35488,6 +35665,12 @@ evaluate `(default-value 'url-handler-mode)'.
The mode's hook is called both when the mode is enabled and when it is
disabled.
+ (file-exists-p \"https://www.gnu.org/\";)
+ => t
+
+and `C-x C-f https://www.gnu.org/ RET' will give you the HTML at
+that URL in a buffer.
+
\(fn &optional ARG)" t nil)
(autoload 'url-file-handler "url-handlers" "\
@@ -35885,11 +36068,14 @@ instead of just \"key\" as in the example above.
\(fn QUERY &optional SEMICOLONS KEEP-EMPTY)" nil nil)
(autoload 'url-unhex-string "url-util" "\
-Remove %XX embedded spaces, etc in a URL.
+Decode %XX sequences in a percent-encoded URL.
If optional second argument ALLOW-NEWLINES is non-nil, then allow the
decoding of carriage returns and line feeds in the string, which is normally
forbidden in URL encoding.
+The resulting string in general requires decoding using an
+appropriate coding-system; see `decode-coding-string'.
+
\(fn STR &optional ALLOW-NEWLINES)" nil nil)
(autoload 'url-hexify-string "url-util" "\
@@ -36444,11 +36630,6 @@ log entries should be gathered.
\(fn &rest ARGS)" t nil)
-(autoload 'vc-branch-part "vc" "\
-Return the branch part of a revision number REV.
-
-\(fn REV)" nil nil)
-
(register-definition-prefixes "vc" '("vc-" "with-vc-properties"))
;;;***
@@ -38945,6 +39126,8 @@ definition for IDENTIFIER, display it in the selected
window.
Otherwise, display the list of the possible definitions in a
buffer where the user can select from the list.
+Use \\[xref-pop-marker-stack] to return back to where you invoked this command.
+
\(fn IDENTIFIER)" t nil)
(autoload 'xref-find-definitions-other-window "xref" "\
@@ -38973,6 +39156,12 @@ This command is intended to be bound to a mouse event.
\(fn EVENT)" t nil)
+(autoload 'xref-find-references-at-mouse "xref" "\
+Find references to the identifier at or around mouse click.
+This command is intended to be bound to a mouse event.
+
+\(fn EVENT)" t nil)
+
(autoload 'xref-find-apropos "xref" "\
Find all meaningful symbols that match PATTERN.
The argument has the same meaning as in `apropos'.
diff --git a/lisp/linum.el b/lisp/linum.el
index b0281d3..c78f596 100644
--- a/lisp/linum.el
+++ b/lisp/linum.el
@@ -219,7 +219,7 @@ Linum mode is a buffer-local minor mode."
;; update overlays on deletions, and after newlines are inserted
(when (or (= beg end)
(= end (point-max))
- (string-match-p "\n" (buffer-substring-no-properties beg end)))
+ (string-search "\n" (buffer-substring-no-properties beg end)))
(linum-update-current)))
(defun linum-after-scroll (win _start)
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 24d49ea..9041b9a 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -276,7 +276,9 @@ supports ordinary shell wildcards if
`ls-lisp-support-shell-wildcards'
is non-nil; otherwise, it interprets wildcards as regular expressions
to match file names. It does not support all `ls' switches -- those
that work are: A a B C c F G g h i n R r S s t U u v X. The l switch
-is assumed to be always present and cannot be turned off."
+is assumed to be always present and cannot be turned off.
+Long variants of the above switches, as documented for GNU `ls',
+are also supported; unsupported long options are silently ignored."
(if ls-lisp-use-insert-directory-program
(funcall orig-fun
file switches wildcard full-directory-p)
@@ -284,13 +286,21 @@ is assumed to be always present and cannot be turned off."
(let ((handler (find-file-name-handler (expand-file-name file)
'insert-directory))
(orig-file file)
- wildcard-regexp)
+ wildcard-regexp
+ (ls-lisp-dirs-first
+ (or ls-lisp-dirs-first
+ (string-match "--group-directories-first" switches))))
(if handler
(funcall handler 'insert-directory file switches
wildcard full-directory-p)
- ;; Remove --dired switch
- (if (string-match "--dired " switches)
- (setq switches (replace-match "" nil nil switches)))
+ (when (string-match "--group-directories-first" switches)
+ ;; if ls-lisp-dirs-first is nil, dirs are grouped but come out in
+ ;; reverse order:
+ (setq ls-lisp-dirs-first t)
+ (setq switches (replace-match "" nil nil switches)))
+ ;; Remove unrecognized long options, and convert the
+ ;; recognized ones to their short variants.
+ (setq switches (ls-lisp--sanitize-switches switches))
;; Convert SWITCHES to a list of characters.
(setq switches (delete ?\ (delete ?- (append switches nil))))
;; Sometimes we get ".../foo*/" as FILE. While the shell and
@@ -890,6 +900,60 @@ All ls time options, namely c, t and u, are handled."
;; Continue standard unloading.
nil)
+(defun ls-lisp--sanitize-switches (switches)
+ "Convert long options of GNU 'ls' to their short form.
+Conversion is done only for flags supported by ls-lisp.
+Long options not supported by ls-lisp are removed.
+Supported options are: A a B C c F G g h i n R r S s t U u v X.
+The l switch is assumed to be always present and cannot be turned off."
+ (let ((lsflags '(("-a" . "--all")
+ ("-A" . "--almost-all")
+ ("-B" . "--ignore-backups")
+ ("-C" . "--color")
+ ("-F" . "--classify")
+ ("-G" . "--no-group")
+ ("-h" . "--human-readable")
+ ("-H" . "--dereference-command-line")
+ ("-i" . "--inode")
+ ("-n" . "--numeric-uid-gid")
+ ("-r" . "--reverse")
+ ("-R" . "--recursive")
+ ("-s" . "--size")
+ ("-S" . "--sort.*[ \\\t]")
+ ("" . "--group-directories-first")
+ ("" . "--author")
+ ("" . "--escape")
+ ("" . "--directory")
+ ("" . "--dired")
+ ("" . "--file-type")
+ ("" . "--format")
+ ("" . "--full-time")
+ ("" . "--si")
+ ("" . "--dereference-command-line-symlink-to-dir")
+ ("" . "--hide")
+ ("" . "--hyperlink")
+ ("" . "--ignore")
+ ("" . "--kibibytes")
+ ("" . "--dereference")
+ ("" . "--literal")
+ ("" . "--hide-control-chars")
+ ("" . "--show-control-chars")
+ ("" . "--quote-name")
+ ("" . "--context")
+ ("" . "--help")
+ ;; ("" . "--indicator-style.*[ \\\t]")
+ ;; ("" . "--quoting-style.*[ \t\\]")
+ ;; ("" . "--time.*[ \\\t]")
+ ;; ("" . "--time-style.*[ \\\t]")
+ ;; ("" . "--tabsize.*[ \\\t]")
+ ;; ("" . "--width.*[ \\\t]")
+ ("" . "--.*=.*[ \\\t\n]?") ;; catch all with '=' sign in
+ ("" . "--version"))))
+ (dolist (f lsflags)
+ (if (string-match (cdr f) switches)
+ (setq switches (replace-match (car f) nil nil switches))))
+ (string-trim switches)))
+
(provide 'ls-lisp)
;;; ls-lisp.el ends here
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index 995ae5f..b765602 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -713,7 +713,7 @@ Return the footnote number to use."
(save-excursion
(let (rc)
(dolist (alist-elem footnote--markers-alist)
- (when (<= (point) (cl-caddr alist-elem))
+ (when (<= (point) (caddr alist-elem))
(unless rc
(setq rc (car alist-elem)))
(save-excursion
@@ -835,7 +835,7 @@ being set it is automatically widened."
(when note
(when footnote-narrow-to-footnotes-when-editing
(widen))
- (goto-char (cl-caddr (assq note footnote--markers-alist)))
+ (goto-char (caddr (assq note footnote--markers-alist)))
(when (looking-at (footnote--current-regexp))
(goto-char (match-end 0))))))
diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el
index 2d68357..b1682cf 100644
--- a/lisp/mail/ietf-drums.el
+++ b/lisp/mail/ietf-drums.el
@@ -236,7 +236,7 @@ If DECODE, the DISPLAY-NAME will have RFC2047 decoding
performed
(setq display-string (ietf-drums-get-comment string)))
(if (not mailbox)
(when (and display-string
- (string-match "@" display-string))
+ (string-search "@" display-string))
(cons
(mapconcat #'identity (nreverse display-name) "")
(ietf-drums-get-comment string)))
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 88fb086..24d8311 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -707,7 +707,10 @@ This function is primarily meant for when you're
displaying the
result to the user: Many prettifications are applied to the
result returned. If you want to decode an address for further
non-display use, you should probably use
-`mail-header-parse-address' instead."
+`mail-header-parse-address' instead. Also see
+`mail-header-parse-address-lax' for a function that's less strict
+than `mail-header-parse-address', but does less post-processing
+to the results."
(let ((canonicalization-buffer (get-buffer-create " *canonical address*"))
(extraction-buffer (get-buffer-create " *extract address components*"))
value-list)
diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el
index e72ed82..212fadf 100644
--- a/lisp/mail/mail-parse.el
+++ b/lisp/mail/mail-parse.el
@@ -71,6 +71,45 @@
(defalias 'mail-decode-encoded-address-region 'rfc2047-decode-address-region)
(defalias 'mail-decode-encoded-address-string 'rfc2047-decode-address-string)
+(defun mail-header-parse-addresses-lax (string)
+ "Parse STRING as a comma-separated list of mail addresses.
+The return value is a list with mail/name pairs."
+ (delq nil
+ (mapcar (lambda (elem)
+ (or (mail-header-parse-address elem)
+ (mail-header-parse-address-lax elem)))
+ (mail-header-parse-addresses string t))))
+
+(defun mail-header-parse-address-lax (string)
+ "Parse STRING as a mail address.
+Returns a mail/name pair.
+
+This function will first try to parse STRING as a
+standards-compliant address string, and if that fails, try to use
+heuristics to determine the email address and the name in the
+string."
+ (with-temp-buffer
+ (insert (string-clean-whitespace string))
+ ;; Find the bit with the @ and guess that that's the mail.
+ (goto-char (point-max))
+ (when (search-backward "@" nil t)
+ (if (re-search-backward " " nil t)
+ (forward-char 1)
+ (goto-char (point-min)))
+ (let* ((start (point))
+ (mail (buffer-substring
+ start (or (re-search-forward " " nil t)
+ (goto-char (point-max))))))
+ (delete-region start (point))
+ ;; We've now removed the email bit, so the rest of the stuff
+ ;; has to be the name.
+ (cons (string-trim mail "[<]+" "[>]+")
+ (let ((name (string-trim (buffer-string)
+ "[ \t\n\r(]+" "[ \t\n\r)]+")))
+ (if (length= name 0)
+ nil
+ name)))))))
+
(provide 'mail-parse)
;;; mail-parse.el ends here
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
index bb1f8f1..3eb3ccb 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -252,7 +252,7 @@ comma-separated list, and return the pruned list."
(setq cur-pos (string-match "[,\"]" destinations cur-pos))
(if (and cur-pos (equal (match-string 0 destinations) "\""))
;; Search for matching quote.
- (let ((next-pos (string-match "\"" destinations (1+ cur-pos))))
+ (let ((next-pos (string-search "\"" destinations (1+ cur-pos))))
(if next-pos
(setq cur-pos (1+ next-pos))
;; If the open-quote has no close-quote,
diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el
index 5b08713..c442913 100644
--- a/lisp/mail/rfc2047.el
+++ b/lisp/mail/rfc2047.el
@@ -612,7 +612,7 @@ should not change this value.")
(setq next prev
prev nil)
(if (or (< index limit)
- (<= (+ len (or (string-match "\n" tail)
+ (<= (+ len (or (string-search "\n" tail)
(length tail)))
rfc2047-encode-max-chars))
(setq prev next
@@ -1111,7 +1111,7 @@ strings are stripped."
"Decode MIME-encoded STRING and return the result.
If ADDRESS-MIME is non-nil, strip backslashes which precede characters
other than `\"' and `\\' in quoted strings."
- (if (string-match "=\\?" string)
+ (if (string-search "=?" string)
(with-temp-buffer
;; We used to only call mm-enable-multibyte if `m' is non-nil,
;; but this can't be the right criterion. Don't just revert this
diff --git a/lisp/mail/rfc2231.el b/lisp/mail/rfc2231.el
index 6fb4502..a398ce0 100644
--- a/lisp/mail/rfc2231.el
+++ b/lisp/mail/rfc2231.el
@@ -61,12 +61,12 @@ must never cause a Lisp error."
;; make it parsable. Let's try...
(error
(let (mod)
- (when (and (string-match "\\\\\"" string)
+ (when (and (string-search "\\\"" string)
(not (string-match "\\`\"\\|[^\\]\"" string)))
- (setq string (replace-regexp-in-string "\\\\\"" "\"" string)
+ (setq string (string-replace "\\\"" "\"" string)
mod t))
- (when (and (string-match "\\\\(" string)
- (string-match "\\\\)" string)
+ (when (and (string-search "\\(" string)
+ (string-search "\\)" string)
(not (string-match "\\`(\\|[^\\][()]" string)))
(setq string (replace-regexp-in-string
"\\\\\\([()]\\)" "\\1" string)
diff --git a/lisp/mail/rfc6068.el b/lisp/mail/rfc6068.el
new file mode 100644
index 0000000..34fd7b5
--- /dev/null
+++ b/lisp/mail/rfc6068.el
@@ -0,0 +1,83 @@
+;;; rfc6068.el --- support for rfc6068 -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Keywords: 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:
+;;; Code:
+
+(defun rfc6068-unhexify-string (string &optional inhibit-decode)
+ "Unhexify STRING -- e.g. `hello%20there' -> `hello there'.
+STRING is assumed to be a percentage-encoded utf-8 string.
+
+If INHIBIT-DECODE is non-nil, return the resulting raw byte
+string instead of decoding as utf-8."
+ (let ((string
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert string)
+ (goto-char (point-min))
+ (while (re-search-forward "%\\([[:xdigit:]]\\{2\\}\\)" nil t)
+ (replace-match (string (string-to-number (match-string 1) 16))
+ t t))
+ (buffer-string))))
+ (if inhibit-decode
+ string
+ (decode-coding-string string 'utf-8))))
+
+(defun rfc6068-parse-mailto-url (mailto-url)
+ "Parse MAILTO-URL, and return an alist of header-name, header-value pairs.
+MAILTO-URL should be a RFC 6068 (mailto) compliant url. A cons cell w/ a
+key of `Body' is a special case and is considered a header for this purpose.
+The returned alist is intended for use w/ the `compose-mail' interface.
+Note: make sure MAILTO-URL has been \"unhtmlized\" (e.g., & -> &), before
+calling this function."
+ (let ((case-fold-search t)
+ headers-alist)
+ (setq mailto-url (string-replace "\n" " " mailto-url))
+ (when (string-match "^\\(mailto:\\)\\([^?]+\\)?\\(\\?\\(.*\\)\\)*"
+ mailto-url)
+ (let ((address (match-string 2 mailto-url))
+ (query (match-string 4 mailto-url)))
+ ;; Build alist of header name-value pairs.
+ (when query
+ (setq headers-alist
+ (mapcar
+ (lambda (x)
+ (let* ((pair (split-string x "="))
+ (name (car pair))
+ (value (cadr pair)))
+ ;; Return ("Header-Name" . "header-value").
+ (cons
+ (capitalize (rfc6068-unhexify-string name))
+ (rfc6068-unhexify-string value))))
+ (split-string query "&"))))
+
+ (when address
+ (setq address (rfc6068-unhexify-string address))
+ ;; Deal with multiple 'To' recipients.
+ (if-let ((elem (assoc "To" headers-alist)))
+ (setcdr elem (concat address ", " (cdr elem)))
+ (push (cons "To" address) headers-alist)))
+
+ headers-alist))))
+
+(provide 'rfc6068)
+
+;;; rfc6068.el ends here
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index e479a8e..8a38337 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -1960,7 +1960,7 @@ Value is the size of the newly read mail after
conversion."
(file-name-nondirectory
(if (memq system-type '(windows-nt cygwin ms-dos))
;; cannot have colons in file name
- (replace-regexp-in-string ":" "-" file)
+ (string-replace ":" "-" file)
file)))
;; Use the directory of this rmail file
;; because it's a nuisance to use the homedir
@@ -3374,7 +3374,7 @@ The idea is to match it against simplified subjects of
other messages."
;; Hide commas so it will work ok if parsed as a comma-separated list
;; of regexps.
(setq subject
- (replace-regexp-in-string "," "\054" subject t t))
+ (string-replace "," "\054" subject))
(concat "\\`" subject "\\'")))
(defun rmail-next-same-subject (n)
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
index acbb588..58a8eb7 100644
--- a/lisp/mail/rmailkwd.el
+++ b/lisp/mail/rmailkwd.el
@@ -93,7 +93,7 @@ according to the choice made, and returns a symbol."
"Set LABEL as present or absent according to STATE in message MSG.
LABEL may be a symbol or string."
(or (stringp label) (setq label (symbol-name label)))
- (if (string-match "," label)
+ (if (string-search "," label)
(error "More than one label specified"))
(with-current-buffer rmail-buffer
(rmail-maybe-set-message-counters)
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index eb8590f..4c23686 100644
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -678,9 +678,9 @@ than appending to it. Deletes the message after writing if
(or (mail-fetch-field "Subject")
rmail-default-body-file)))
(setq default-file
- (replace-regexp-in-string ":" "-" default-file))
+ (string-replace ":" "-" default-file))
(setq default-file
- (replace-regexp-in-string " " "-" default-file))
+ (string-replace " " "-" default-file))
(list (setq rmail-default-body-file
(read-file-name
"Output message body to file: "
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 44cff21..9dd9573 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -758,7 +758,8 @@ the message being processed."
len mch lo newline)
;; If there are multiple lines in FROM,
;; discard up to the last newline in it.
- (while (setq newline (string-match "\n" from))
+ (while (and (stringp from)
+ (setq newline (string-search "\n" from)))
(setq from (substring from (1+ newline))))
(if (or (null from)
(string-match
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 133a2e1..ec9f340 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -516,7 +516,7 @@ for `smtpmail-try-auth-method'.")
(defun smtpmail-maybe-append-domain (recipient)
(if (or (not smtpmail-sendto-domain)
- (string-match "@" recipient))
+ (string-search "@" recipient))
recipient
(concat recipient "@" smtpmail-sendto-domain)))
@@ -596,7 +596,7 @@ USER and PASSWORD should be non-nil."
(error "Mechanism %S not implemented" mech))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql cram-md5)) user password)
+ (process (_mech (eql 'cram-md5)) user password)
(let ((ret (smtpmail-command-or-throw process "AUTH CRAM-MD5")))
(when (eq (car ret) 334)
(let* ((challenge (substring (cadr ret) 4))
@@ -618,13 +618,13 @@ USER and PASSWORD should be non-nil."
(smtpmail-command-or-throw process encoded)))))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql login)) user password)
+ (process (_mech (eql 'login)) user password)
(smtpmail-command-or-throw process "AUTH LOGIN")
(smtpmail-command-or-throw process (base64-encode-string user t))
(smtpmail-command-or-throw process (base64-encode-string password t)))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql plain)) user password)
+ (process (_mech (eql 'plain)) user password)
;; We used to send an empty initial request, and wait for an
;; empty response, and then send the password, but this
;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
@@ -636,6 +636,14 @@ USER and PASSWORD should be non-nil."
(base64-encode-string (concat "\0" user "\0" password) t))
235))
+(cl-defmethod smtpmail-try-auth-method
+ (process (_mech (eql xoauth2)) user password)
+ (smtpmail-command-or-throw
+ process
+ (concat "AUTH XOAUTH2 "
+ (base64-encode-string
+ (concat "user=" user "\1auth=Bearer " password "\1\1") t))))
+
(defun smtpmail-response-code (string)
(when string
(with-temp-buffer
@@ -692,7 +700,7 @@ Returns an error if the server cannot be contacted."
(let ((parts (split-string user-mail-address "@")))
(and (= (length parts) 2)
;; There's a dot in the domain name.
- (string-match "\\." (cadr parts))
+ (string-search "." (cadr parts))
user-mail-address))))
(defun smtpmail-via-smtp (recipient smtpmail-text-buffer
diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el
index 9ebffef..b07004d 100644
--- a/lisp/mail/uce.el
+++ b/lisp/mail/uce.el
@@ -246,10 +246,10 @@ You might need to set `uce-mail-reader' before using
this."
(if reply-to
(setq to (format "%s, %s" to (mail-strip-quoted-names reply-to))))
(let (first-at-sign end-of-hostname sender-host)
- (setq first-at-sign (string-match "@" to)
+ (setq first-at-sign (string-search "@" to)
end-of-hostname (string-match "[ ,>]" to first-at-sign)
sender-host (substring to first-at-sign end-of-hostname))
- (if (string-match "\\." sender-host)
+ (if (string-search "." sender-host)
(setq to (format "%s, postmaster%s, abuse%s"
to sender-host sender-host))))
(setq mail-send-actions nil)
@@ -291,7 +291,7 @@ You might need to set `uce-mail-reader' before using this."
(search-forward " ")
(forward-char -1)
;; And add its postmaster to the list of addresses.
- (if (string-match "\\." (buffer-substring temp (point)))
+ (if (string-search "." (buffer-substring temp (point)))
(setq to (format "%s, postmaster@%s"
to (buffer-substring temp (point)))))
;; Also look at the message-id, it helps *very* often.
@@ -302,7 +302,7 @@ You might need to set `uce-mail-reader' before using this."
(setq temp (point))
(search-forward ">")
(forward-char -1)
- (if (string-match "\\." (buffer-substring temp (point)))
+ (if (string-search "." (buffer-substring temp (point)))
(setq to (format "%s, postmaster@%s"
to (buffer-substring temp (point)))))))
(when (eq uce-mail-reader 'gnus)
diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
index bf57ed6..0760a47 100644
--- a/lisp/mail/undigest.el
+++ b/lisp/mail/undigest.el
@@ -125,7 +125,7 @@ See rmail-digest-methods."
;; Undo masking of separators inside digestified messages
(goto-char (point-min))
(while (search-forward
- (replace-regexp-in-string "\n-" "\n " separator) nil t)
+ (string-replace "\n-" "\n " separator) nil t)
(replace-match separator))
;; Return the list of marker pairs
(nreverse result))))))
diff --git a/lisp/man.el b/lisp/man.el
index 9b941a2..6009a31 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -801,8 +801,8 @@ POS defaults to `point'."
;; doesn't include a hyphen, we consider the hyphen to be
;; added by troff, and remove it.
(or (not (eq (string-to-char (substring 1st-part -1)) ?-))
- (string-match-p "-" (substring 1st-part 0 -1))
- (setq word (replace-regexp-in-string "-" "" word))))
+ (string-search "-" (substring 1st-part 0 -1))
+ (setq word (string-replace "-" "" word))))
;; Make sure the section number gets included by the code below.
(goto-char (match-end 1)))
(when (string-match "[-._‐]+$" word)
diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1
index f1aeca6..b0fdd02 100644
--- a/lisp/mh-e/ChangeLog.1
+++ b/lisp/mh-e/ChangeLog.1
@@ -11196,7 +11196,7 @@
instead of "0 msgs". Do not try to print a range when there are
no messages.
* mh-e.el (mh-regenerate-headers): Bug fix. Catch and remove the
- "scan: band message list" message.
+ "scan: bad message list" message.
2001-11-13 Jeffrey C Honig <jch@honig.net>
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index 415e984..37fdb16 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -111,10 +111,10 @@ COMMA-SEPARATOR is non-nil."
(string-match "^\\([^,]+\\)," res))
(setq res (match-string 1 res)))
;; Replace "&" with capitalized username
- (if (string-match "&" res)
+ (if (string-search "&" res)
(setq res (mh-replace-regexp-in-string "&" (capitalize username) res)))
;; Remove " character
- (if (string-match "\"" res)
+ (if (string-search "\"" res)
(setq res (mh-replace-regexp-in-string "\"" "" res)))
;; If empty string, use username instead
(if (string-equal "" res)
@@ -285,7 +285,7 @@ Blind aliases or users from /etc/passwd are not expanded."
(message "%s -> %s" the-name (mh-alias-expand the-name))
;; Check if it was a single word likely to be an alias
(if (and (equal mh-alias-flash-on-comma 1)
- (not (string-match " " the-name)))
+ (not (string-search " " the-name)))
(message "No alias for %s" the-name))))))
(self-insert-command 1))
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index b64bbfb..404b6b3 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -38,6 +38,7 @@
(require 'sendmail)
(autoload 'easy-menu-add "easymenu")
+(autoload 'mail-header-parse-address "mail-parse")
(autoload 'mml-insert-tag "mml")
@@ -452,7 +453,7 @@ See also `mh-send'."
;; Header field exists and we have a value
(let (address mailbox (alias (mh-alias-expand value)))
(and alias
- (setq address (ietf-drums-parse-address alias))
+ (setq address (mail-header-parse-address alias))
(setq mailbox (car address)))
;; XXX - Need to parse all addresses out of field
(if (and
@@ -637,8 +638,8 @@ See also `mh-compose-forward-as-mime-flag',
(defun mh-forwarded-letter-subject (from subject)
"Return a Subject suitable for a forwarded message.
Original message has headers FROM and SUBJECT."
- (let ((addr-start (string-match "<" from))
- (comment (string-match "(" from)))
+ (let ((addr-start (string-search "<" from))
+ (comment (string-search "(" from)))
(cond ((and addr-start (> addr-start 0))
;; Full Name <luser@host>
(setq from (substring from 0 (1- addr-start))))
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index e935cfd..375072b 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -33,7 +33,7 @@
;; recommended.
;; MH (Message Handler) is a powerful mail reader. See
-;; http://rand-mh.sourceforge.net/.
+;; https://rand-mh.sourceforge.io/.
;; N.B. MH must have been compiled with the MHE compiler flag or several
;; features necessary for MH-E will be missing from MH commands, specifically
@@ -82,7 +82,8 @@
;; Rewritten for GNU Emacs, James Larus, 1985.
;; Modified by Stephen Gildea, 1988.
;; Maintenance picked up by Bill Wohler and the
-;; SourceForge Crew <http://mh-e.sourceforge.net/>, 2001.
+;; SourceForge Crew <https://mh-e.sourceforge.io/>, 2001.
+;; Since 2016, MH-E development occurs within the Emacs repository.
;;; Code:
@@ -229,7 +230,7 @@ User's mail folder directory.")
(defvar mh-arrow-marker nil
"Marker for arrow display in fringe.")
-(defvar mh-blacklist nil
+(defvar mh-blocklist nil
"List of messages to use to train the junk filter.
This variable can be used by
`mh-before-commands-processed-hook'.")
@@ -295,7 +296,7 @@ Elements have the form (SEQUENCE . MESSAGES).")
"Stack of operations that change the folder view.
These operations include narrowing or threading.")
-(defvar mh-whitelist nil
+(defvar mh-allowlist nil
"List of messages to use to train the junk filter.
This variable can be used by
`mh-before-commands-processed-hook'.")
@@ -1687,13 +1688,13 @@ fashion."
;; Available spam filter interfaces
(defvar mh-junk-function-alist
- '((spamassassin mh-spamassassin-blacklist mh-spamassassin-whitelist)
- (bogofilter mh-bogofilter-blacklist mh-bogofilter-whitelist)
- (spamprobe mh-spamprobe-blacklist mh-spamprobe-whitelist))
+ '((spamassassin mh-spamassassin-blocklist mh-spamassassin-allowlist)
+ (bogofilter mh-bogofilter-blocklist mh-bogofilter-allowlist)
+ (spamprobe mh-spamprobe-blocklist mh-spamprobe-allowlist))
"Available choices of spam programs to use.
This is an alist. For each element there are functions that
-blacklist a message as spam and whitelist a message incorrectly
+blocklist a message as spam and allowlist a message incorrectly
classified as spam.")
(defun mh-junk-choose (symbol value)
@@ -1718,8 +1719,8 @@ be slow when junking large numbers of messages. If you
have
enough memory or don't junk that many messages at the same time,
you might try turning on this option.
-Note that this option is used as the \"display\" argument in the
-call to `call-process'. Therefore, turning on this option means
+Note that this option is used as the \"destination\" argument in
+the call to `call-process'. Therefore, turning on this option means
setting its value to \"0\". You can also set its value to t to
direct the programs' output to the \"*MH-E Log*\" buffer; this
may be useful for debugging."
@@ -2236,11 +2237,11 @@ commands."
:group 'mh-sequences
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-whitelist-preserves-sequences-flag t
- "Non-nil means that sequences are preserved when messages are whitelisted.
+(defcustom-mh mh-allowlist-preserves-sequences-flag t
+ "Non-nil means that sequences are preserved when messages are allowlisted.
If a message is in any sequence (except \"Previous-Sequence:\"
-and \"cur\") when it is whitelisted, then it will still be in
+and \"cur\") when it is allowlisted, then it will still be in
those sequences in the destination folder. If this behavior is
not desired, then turn off this option."
:type 'boolean
@@ -3195,7 +3196,7 @@ annotated messages with `mh-annotate-list'."
"Hook run by \\<mh-folder-mode-map>\\[mh-execute-commands] before performing
outstanding refile and delete requests.
Variables that are useful in this hook include `mh-delete-list',
-`mh-refile-list', `mh-blacklist', and `mh-whitelist' which can be
+`mh-refile-list', `mh-blocklist', and `mh-allowlist' which can be
used to see which changes will be made to the current folder,
`mh-current-folder'."
:type 'hook
@@ -3227,8 +3228,8 @@ before sending, add the `ispell-message' function."
:group 'mh-letter
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-blacklist-msg-hook nil
- "Hook run by \\<mh-letter-mode-map>\\[mh-junk-blacklist] after marking each
message for blacklisting."
+(defcustom-mh mh-blocklist-msg-hook nil
+ "Hook run by \\<mh-letter-mode-map>\\[mh-junk-blocklist] after marking each
message for blocklisting."
:type 'hook
:group 'mh-hooks
:group 'mh-show
@@ -3400,8 +3401,8 @@ sequence."
:group 'mh-sequences
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-whitelist-msg-hook nil
- "Hook run by \\<mh-letter-mode-map>\\[mh-junk-whitelist] after marking each
message for whitelisting."
+(defcustom-mh mh-allowlist-msg-hook nil
+ "Hook run by \\<mh-letter-mode-map>\\[mh-junk-allowlist] after marking each
message for allowlisting."
:type 'hook
:group 'mh-hooks
:group 'mh-show
@@ -3627,9 +3628,9 @@ specified colors."
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-blacklisted
+(defface-mh mh-folder-blocklisted
(mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number))))
- "Blacklisted message face."
+ "Blocklisted message face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.4"))
@@ -3723,9 +3724,9 @@ format `mh-scan-format-nmh' and the regular expression
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-whitelisted
+(defface-mh mh-folder-allowlisted
(mh-face-data 'mh-folder-refiled '((t (:inherit mh-folder-refiled))))
- "Whitelisted message face."
+ "Allowlisted message face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.4"))
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index ce77f9c..35277ae 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -278,7 +278,8 @@ annotation.")
(gnus-define-keys (mh-junk-map "J" mh-folder-mode-map)
"?" mh-prefix-help
- "b" mh-junk-blacklist
+ "a" mh-junk-allowlist
+ "b" mh-junk-blocklist
"w" mh-junk-whitelist)
(gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map)
@@ -386,7 +387,7 @@ annotation.")
(?K "[v]iew, [i]nline, with [e]xternal viewer; \n"
"[o]utput/save MIME part; save [a]ll parts; \n"
"[t]oggle buttons; [TAB] next; [SHIFT-TAB] previous")
- (?J "[b]lacklist, [w]hitelist message"))
+ (?J "[b]locklist, [a]llowlist message"))
"Key binding cheat sheet.
See `mh-set-help'.")
@@ -405,12 +406,12 @@ See `mh-set-help'.")
;; Marked for deletion
(list (concat mh-scan-deleted-msg-regexp ".*")
'(0 'mh-folder-deleted))
- ;; Marked for blacklisting
- (list (concat mh-scan-blacklisted-msg-regexp ".*")
- '(0 'mh-folder-blacklisted))
- ;; Marked for whitelisting
- (list (concat mh-scan-whitelisted-msg-regexp ".*")
- '(0 'mh-folder-whitelisted))
+ ;; Marked for blocklisting
+ (list (concat mh-scan-blocklisted-msg-regexp ".*")
+ '(0 'mh-folder-blocklisted))
+ ;; Marked for allowlisting
+ (list (concat mh-scan-allowlisted-msg-regexp ".*")
+ '(0 'mh-folder-allowlisted))
;; After subject
(list mh-scan-body-regexp
'(1 'mh-folder-body nil t))
@@ -616,8 +617,8 @@ perform the operation on all messages in that region.
'mh-showing-mode nil ; Show message also?
'mh-refile-list nil ; List of folder names in mh-seq-list
'mh-delete-list nil ; List of msgs nums to delete
- 'mh-blacklist nil ; List of messages to process as spam
- 'mh-whitelist nil ; List of messages to process as ham
+ 'mh-blocklist nil ; List of messages to process as spam
+ 'mh-allowlist nil ; List of messages to process as ham
'mh-seq-list nil ; Alist of (seq . msgs) nums
'mh-seen-list nil ; List of displayed messages
'mh-next-direction 'forward ; Direction to move to next message
@@ -714,8 +715,8 @@ RANGE is read in interactive use."
(defun mh-execute-commands ()
"Perform outstanding operations\\<mh-folder-mode-map>.
-If you've marked messages to be refiled, deleted, blacklisted, or
-whitelisted and you want to go ahead and perform these operations
+If you've marked messages to be refiled, deleted, blocklisted, or
+allowlisted and you want to go ahead and perform these operations
on these messages, use this command. Many MH-E commands that may
affect the numbering of the messages (such as
\\[mh-rescan-folder] or \\[mh-pack-folder]) will ask if you want
@@ -1188,16 +1189,16 @@ RANGE is read in interactive use."
(beginning-of-line)
(while (not (or (looking-at mh-scan-refiled-msg-regexp)
(looking-at mh-scan-deleted-msg-regexp)
- (looking-at mh-scan-blacklisted-msg-regexp)
- (looking-at mh-scan-whitelisted-msg-regexp)
+ (looking-at mh-scan-blocklisted-msg-regexp)
+ (looking-at mh-scan-allowlisted-msg-regexp)
(and (eq mh-next-direction 'forward) (bobp))
(and (eq mh-next-direction 'backward)
(save-excursion (forward-line) (eobp)))))
(forward-line (if (eq mh-next-direction 'forward) -1 1)))
(if (or (looking-at mh-scan-refiled-msg-regexp)
(looking-at mh-scan-deleted-msg-regexp)
- (looking-at mh-scan-blacklisted-msg-regexp)
- (looking-at mh-scan-whitelisted-msg-regexp))
+ (looking-at mh-scan-blocklisted-msg-regexp)
+ (looking-at mh-scan-allowlisted-msg-regexp))
(progn
(mh-undo-msg (mh-get-msg-num t))
(mh-maybe-show))
@@ -1529,7 +1530,7 @@ is updated."
(save-excursion
(when (eq major-mode 'mh-show-mode)
(set-buffer mh-show-folder-buffer))
- (or mh-delete-list mh-refile-list mh-blacklist mh-whitelist)))
+ (or mh-delete-list mh-refile-list mh-blocklist mh-allowlist)))
;;;###mh-autoload
(defun mh-set-folder-modified-p (flag)
@@ -1555,12 +1556,12 @@ after the commands are processed."
(folders-changed (list mh-current-folder))
(seq-map (and
(or (and mh-refile-list mh-refile-preserves-sequences-flag)
- (and mh-whitelist
- mh-whitelist-preserves-sequences-flag))
+ (and mh-allowlist
+ mh-allowlist-preserves-sequences-flag))
(mh-create-sequence-map mh-seq-list)))
(dest-map (and mh-refile-list mh-refile-preserves-sequences-flag
(make-hash-table)))
- (white-map (and mh-whitelist mh-whitelist-preserves-sequences-flag
+ (allow-map (and mh-allowlist mh-allowlist-preserves-sequences-flag
(make-hash-table))))
;; Remove invalid scan lines if we are in an index folder and then remove
;; the real messages
@@ -1609,11 +1610,11 @@ after the commands are processed."
(mh-delete-scan-msgs mh-delete-list)
(setq mh-delete-list nil)))
- ;; Blacklist messages.
- (when mh-blacklist
- (let ((msg-list (mh-coalesce-msg-list mh-blacklist))
- (dest (mh-junk-blacklist-disposition)))
- (mh-junk-process-blacklist mh-blacklist)
+ ;; Blocklist messages.
+ (when mh-blocklist
+ (let ((msg-list (mh-coalesce-msg-list mh-blocklist))
+ (dest (mh-junk-blocklist-disposition)))
+ (mh-junk-process-blocklist mh-blocklist)
;; TODO I wonder why mh-exec-cmd is used instead of the following:
;; (mh-refile-a-msg nil (intern dest))
;; (mh-delete-a-msg nil)))
@@ -1622,35 +1623,35 @@ after the commands are processed."
(apply #'mh-exec-cmd "refile" "-src" folder dest msg-list)
(push dest folders-changed))
(setq redraw-needed-flag t)
- (mh-delete-scan-msgs mh-blacklist)
- (setq mh-blacklist nil)))
+ (mh-delete-scan-msgs mh-blocklist)
+ (setq mh-blocklist nil)))
- ;; Whitelist messages.
- (when mh-whitelist
- (let ((msg-list (mh-coalesce-msg-list mh-whitelist))
+ ;; Allowlist messages.
+ (when mh-allowlist
+ (let ((msg-list (mh-coalesce-msg-list mh-allowlist))
(last (car (mh-translate-range mh-inbox "last"))))
- (mh-junk-process-whitelist mh-whitelist)
+ (mh-junk-process-allowlist mh-allowlist)
(apply #'mh-exec-cmd "refile" "-src" folder mh-inbox msg-list)
(push mh-inbox folders-changed)
(setq redraw-needed-flag t)
- (mh-delete-scan-msgs mh-whitelist)
- (when mh-whitelist-preserves-sequences-flag
- (clrhash white-map)
+ (mh-delete-scan-msgs mh-allowlist)
+ (when mh-allowlist-preserves-sequences-flag
+ (clrhash allow-map)
(cl-loop for i from (1+ (or last 0))
- for msg in (sort (copy-sequence mh-whitelist) #'<)
+ for msg in (sort (copy-sequence mh-allowlist) #'<)
do (cl-loop for seq-name in (gethash msg seq-map)
- do (push i (gethash seq-name white-map))))
+ do (push i (gethash seq-name allow-map))))
(maphash
#'(lambda (seq msgs)
;; Can't be run in background, since the current
;; folder is changed by mark this could lead to a
- ;; race condition with the next refile/whitelist.
+ ;; race condition with the next refile/allowlist.
(apply #'mh-exec-cmd "mark"
"-sequence" (symbol-name seq) mh-inbox
"-add" (mapcar #'(lambda(x) (format "%s" x))
(mh-coalesce-msg-list msgs))))
- white-map))
- (setq mh-whitelist nil)))
+ allow-map))
+ (setq mh-allowlist nil)))
;; Don't need to remove sequences since delete and refile do so.
;; Mark cur message
@@ -1961,10 +1962,10 @@ once when he kept statistics on his mail usage."
(setq message (mh-get-msg-num t)))
(if (looking-at mh-scan-refiled-msg-regexp)
(error "Message %d is refiled; undo refile before deleting" message))
- (if (looking-at mh-scan-blacklisted-msg-regexp)
- (error "Message %d is blacklisted; undo before deleting" message))
- (if (looking-at mh-scan-whitelisted-msg-regexp)
- (error "Message %d is whitelisted; undo before deleting" message))
+ (if (looking-at mh-scan-blocklisted-msg-regexp)
+ (error "Message %d is blocklisted; undo before deleting" message))
+ (if (looking-at mh-scan-allowlisted-msg-regexp)
+ (error "Message %d is allowlisted; undo before deleting" message))
(if (looking-at mh-scan-deleted-msg-regexp)
nil
(mh-set-folder-modified-p t)
@@ -1986,10 +1987,10 @@ be refiled."
(setq message (mh-get-msg-num t)))
(cond ((looking-at mh-scan-deleted-msg-regexp)
(error "Message %d is deleted; undo delete before moving" message))
- ((looking-at mh-scan-blacklisted-msg-regexp)
- (error "Message %d is blacklisted; undo before moving" message))
- ((looking-at mh-scan-whitelisted-msg-regexp)
- (error "Message %d is whitelisted; undo before moving" message))
+ ((looking-at mh-scan-blocklisted-msg-regexp)
+ (error "Message %d is blocklisted; undo before moving" message))
+ ((looking-at mh-scan-allowlisted-msg-regexp)
+ (error "Message %d is allowlisted; undo before moving" message))
((looking-at mh-scan-refiled-msg-regexp)
(if (y-or-n-p
(format "Message %d already refiled; copy to %s as well? "
@@ -2008,7 +2009,7 @@ be refiled."
(run-hooks 'mh-refile-msg-hook)))))
(defun mh-undo-msg (msg)
- "Undo the deletion, refile, black- or whitelisting of one MSG.
+ "Undo the deletion, refile, block- or allowlisting of one MSG.
If MSG is nil then act on the message at point"
(save-excursion
(if (numberp msg)
@@ -2017,10 +2018,10 @@ If MSG is nil then act on the message at point"
(setq msg (mh-get-msg-num t)))
(cond ((memq msg mh-delete-list)
(setq mh-delete-list (delq msg mh-delete-list)))
- ((memq msg mh-blacklist)
- (setq mh-blacklist (delq msg mh-blacklist)))
- ((memq msg mh-whitelist)
- (setq mh-whitelist (delq msg mh-whitelist)))
+ ((memq msg mh-blocklist)
+ (setq mh-blocklist (delq msg mh-blocklist)))
+ ((memq msg mh-allowlist)
+ (setq mh-allowlist (delq msg mh-allowlist)))
(t
(dolist (folder-msg-list mh-refile-list)
(setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index 0e5ffc9..4a5e670 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -354,8 +354,8 @@ Arguments are IGNORED (for `revert-buffer')."
(yes-or-no-p "Undo all commands in folder? "))
(setq mh-delete-list nil
mh-refile-list nil
- mh-blacklist nil
- mh-whitelist nil
+ mh-blocklist nil
+ mh-allowlist nil
mh-seq-list nil
mh-next-direction 'forward)
(with-mh-folder-updating (nil)
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index 95a9bb4..467667f 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -31,9 +31,11 @@
(require 'mh-e)
(require 'mh-scan)
+(autoload 'mail-header-parse-address "mail-parse")
+
;;;###mh-autoload
-(defun mh-junk-blacklist (range)
- "Blacklist RANGE as spam.
+(defun mh-junk-blocklist (range)
+ "Blocklist RANGE as spam.
This command trains the spam program in use (see the option
`mh-junk-program') with the content of RANGE and then handles the
@@ -45,44 +47,44 @@ read in interactive use.
For more information about using your particular spam fighting
program, see:
- - `mh-spamassassin-blacklist'
- - `mh-bogofilter-blacklist'
- - `mh-spamprobe-blacklist'"
- (interactive (list (mh-interactive-range "Blacklist")))
- (mh-iterate-on-range () range (mh-blacklist-a-msg nil))
- (if (looking-at mh-scan-blacklisted-msg-regexp)
+ - `mh-spamassassin-blocklist'
+ - `mh-bogofilter-blocklist'
+ - `mh-spamprobe-blocklist'"
+ (interactive (list (mh-interactive-range "Blocklist")))
+ (mh-iterate-on-range () range (mh-junk-blocklist-a-msg nil))
+ (if (looking-at mh-scan-blocklisted-msg-regexp)
(mh-next-msg)))
-(defun mh-blacklist-a-msg (message)
- "Blacklist MESSAGE.
-If MESSAGE is nil then the message at point is blacklisted.
-The hook `mh-blacklist-msg-hook' is called after you mark a message
-for blacklisting."
+(defun mh-junk-blocklist-a-msg (message)
+ "Blocklist MESSAGE.
+If MESSAGE is nil then the message at point is blocklisted.
+The hook `mh-blocklist-msg-hook' is called after you mark a message
+for blocklisting."
(save-excursion
(if (numberp message)
(mh-goto-msg message nil t)
(beginning-of-line)
(setq message (mh-get-msg-num t)))
(cond ((looking-at mh-scan-refiled-msg-regexp)
- (error "Message %d is refiled; undo refile before blacklisting"
+ (error "Message %d is refiled; undo refile before blocklisting"
message))
((looking-at mh-scan-deleted-msg-regexp)
- (error "Message %d is deleted; undo delete before blacklisting"
+ (error "Message %d is deleted; undo delete before blocklisting"
message))
- ((looking-at mh-scan-whitelisted-msg-regexp)
- (error "Message %d is whitelisted; undo before blacklisting"
+ ((looking-at mh-scan-allowlisted-msg-regexp)
+ (error "Message %d is allowlisted; undo before blocklisting"
message))
- ((looking-at mh-scan-blacklisted-msg-regexp) nil)
+ ((looking-at mh-scan-blocklisted-msg-regexp) nil)
(t
(mh-set-folder-modified-p t)
- (setq mh-blacklist (cons message mh-blacklist))
+ (setq mh-blocklist (cons message mh-blocklist))
(if (not (memq message mh-seen-list))
(setq mh-seen-list (cons message mh-seen-list)))
- (mh-notate nil mh-note-blacklisted mh-cmd-note)
- (run-hooks 'mh-blacklist-msg-hook)))))
+ (mh-notate nil mh-note-blocklisted mh-cmd-note)
+ (run-hooks 'mh-blocklist-msg-hook)))))
;;;###mh-autoload
-(defun mh-junk-blacklist-disposition ()
+(defun mh-junk-blocklist-disposition ()
"Determines the fate of the selected spam."
(cond ((null mh-junk-disposition) nil)
((equal mh-junk-disposition "") "+")
@@ -94,73 +96,76 @@ for blacklisting."
(t (concat "+" mh-junk-disposition))))
;;;###mh-autoload
-(defun mh-junk-process-blacklist (range)
- "Blacklist RANGE as spam.
+(defun mh-junk-process-blocklist (range)
+ "Blocklist RANGE as spam.
This command trains the spam program in use (see the option
`mh-junk-program') with the content of RANGE and then handles the
message(s) as specified by the option `mh-junk-disposition'."
- (let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist))))
- (unless blacklist-func
+ (let ((blocklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist))))
+ (unless blocklist-func
(error "Customize `mh-junk-program' appropriately"))
(mh-iterate-on-range msg range
- (message "Blacklisting message %d..." msg)
- (funcall (symbol-function blacklist-func) msg)
- (message "Blacklisting message %d...done" msg))))
+ (funcall (symbol-function blocklist-func) msg))))
;;;###mh-autoload
(defun mh-junk-whitelist (range)
- "Whitelist RANGE as ham.
+ "Old name for `mh-junk-allowlist'; use \\[mh-junk-allowlist] instead."
+ (declare (obsolete mh-junk-allowlist "28.1"))
+ (interactive (list (mh-interactive-range "Allowlist")))
+ (mh-junk-allowlist range))
-This command reclassifies the RANGE as ham if it were incorrectly
+;;;###mh-autoload
+(defun mh-junk-allowlist (range)
+ "Allowlist RANGE as ham.
+
+This command reclassifies the RANGE as ham if it has been incorrectly
classified as spam (see the option `mh-junk-program'). It then
refiles the message into the \"+inbox\" folder.
Check the documentation of `mh-interactive-range' to see how
RANGE is read in interactive use."
- (interactive (list (mh-interactive-range "Whitelist")))
- (mh-iterate-on-range () range (mh-junk-whitelist-a-msg nil))
- (if (looking-at mh-scan-whitelisted-msg-regexp)
+ (interactive (list (mh-interactive-range "Allowlist")))
+ (mh-iterate-on-range () range (mh-junk-allowlist-a-msg nil))
+ (if (looking-at mh-scan-allowlisted-msg-regexp)
(mh-next-msg)))
-(defun mh-junk-whitelist-a-msg (message)
- "Whitelist MESSAGE.
-If MESSAGE is nil then the message at point is whitelisted. The
-hook `mh-whitelist-msg-hook' is called after you mark a message
-for whitelisting."
+(defun mh-junk-allowlist-a-msg (message)
+ "Allowlist MESSAGE.
+If MESSAGE is nil then the message at point is allowlisted. The
+hook `mh-allowlist-msg-hook' is called after you mark a message
+for allowlisting."
(save-excursion
(if (numberp message)
(mh-goto-msg message nil t)
(beginning-of-line)
(setq message (mh-get-msg-num t)))
(cond ((looking-at mh-scan-refiled-msg-regexp)
- (error "Message %d is refiled; undo refile before whitelisting"
+ (error "Message %d is refiled; undo refile before allowlisting"
message))
((looking-at mh-scan-deleted-msg-regexp)
- (error "Message %d is deleted; undo delete before whitelisting"
+ (error "Message %d is deleted; undo delete before allowlisting"
message))
- ((looking-at mh-scan-blacklisted-msg-regexp)
- (error "Message %d is blacklisted; undo before whitelisting"
+ ((looking-at mh-scan-blocklisted-msg-regexp)
+ (error "Message %d is blocklisted; undo before allowlisting"
message))
- ((looking-at mh-scan-whitelisted-msg-regexp) nil)
+ ((looking-at mh-scan-allowlisted-msg-regexp) nil)
(t
(mh-set-folder-modified-p t)
- (setq mh-whitelist (cons message mh-whitelist))
- (mh-notate nil mh-note-whitelisted mh-cmd-note)
- (run-hooks 'mh-whitelist-msg-hook)))))
+ (setq mh-allowlist (cons message mh-allowlist))
+ (mh-notate nil mh-note-allowlisted mh-cmd-note)
+ (run-hooks 'mh-allowlist-msg-hook)))))
;;;###mh-autoload
-(defun mh-junk-process-whitelist (range)
- "Whitelist RANGE as ham.
+(defun mh-junk-process-allowlist (range)
+ "Allowlist RANGE as ham.
This command reclassifies the RANGE as ham if it were incorrectly
classified as spam (see the option `mh-junk-program')."
- (let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist))))
- (unless whitelist-func
+ (let ((allowlist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist))))
+ (unless allowlist-func
(error "Customize `mh-junk-program' appropriately"))
(mh-iterate-on-range msg range
- (message "Whitelisting message %d..." msg)
- (funcall (symbol-function whitelist-func) msg)
- (message "Whitelisting message %d...done" msg))))
+ (funcall (symbol-function allowlist-func) msg))))
@@ -170,8 +175,8 @@ classified as spam (see the option `mh-junk-program')."
(defvar mh-sa-learn-executable (executable-find "sa-learn"))
;;;###mh-autoload
-(defun mh-spamassassin-blacklist (msg)
- "Blacklist MSG with SpamAssassin.
+(defun mh-spamassassin-blocklist (msg)
+ "Blocklist MSG with SpamAssassin.
SpamAssassin is one of the more popular spam filtering programs.
Get it from your local distribution or from the SpamAssassin web
@@ -219,22 +224,22 @@ rules-based filters is a plethora of false positives so
it is
worthwhile to check.
If SpamAssassin classifies a message incorrectly, or is unsure,
-you can use the MH-E commands \\[mh-junk-blacklist] and
-\\[mh-junk-whitelist].
+you can use the MH-E commands \\[mh-junk-blocklist] and
+\\[mh-junk-allowlist].
-The command \\[mh-junk-blacklist] adds a \"blacklist_from\" entry
+The command \\[mh-junk-blocklist] adds a \"blacklist_from\" entry
to \"~/spamassassin/user_prefs\", deletes the message, and sends
the message to the Razor, so that others might not see this spam.
If the \"sa-learn\" command is available, the message is also
recategorized as spam.
-The command \\[mh-junk-whitelist] adds a \"whitelist_from\" rule
+The command \\[mh-junk-allowlist] adds a \"whitelist_from\" rule
to the \"~/.spamassassin/user_prefs\" file. If the \"sa-learn\"
command is available, the message is also recategorized as ham.
Over time, you'll observe that the same host or domain occurs
repeatedly in the \"blacklist_from\" entries, so you might think
-that you could avoid future spam by blacklisting all mail from a
+that you could avoid future spam by blocklisting all mail from a
particular domain. The utility function
`mh-spamassassin-identify-spammers' helps you do precisely that.
This function displays a frequency count of the hosts and domains
@@ -249,20 +254,20 @@ information can be used so that you can replace multiple
(let ((current-folder mh-current-folder)
(msg-file (mh-msg-filename msg mh-current-folder))
(sender))
- (message "Reporting message %d..." msg)
+ (message "Reporting message %d as spam with spamassassin..." msg)
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-spamassassin-executable msg-file mh-junk-background nil
- ;; -R removes from allow-list
+ ;; -R removes from allowlist
"--report" "-R")
(when mh-sa-learn-executable
- (message "Recategorizing message %d as spam..." msg)
+ (message "Recategorizing message %d as spam with sa-learn..." msg)
(mh-truncate-log-buffer)
(call-process mh-sa-learn-executable msg-file mh-junk-background nil
"--spam" "--local" "--no-sync")))
- (message "Blacklisting sender of message %d..." msg)
+ (message "Blocklisting sender of message %d..." msg)
(with-current-buffer (get-buffer-create mh-temp-buffer)
(erase-buffer)
(call-process (expand-file-name mh-scan-prog mh-progs)
@@ -274,18 +279,18 @@ information can be used so that you can replace multiple
(progn
(setq sender (match-string 0))
(mh-spamassassin-add-rule "blacklist_from" sender)
- (message "Blacklisting sender of message %d...done" msg))
- (message "Blacklisting sender of message %d...not done (from my
address)" msg)))))
+ (message "Blocklisting sender of message %d...done" msg))
+ (message "Blocklisting sender of message %d...not done (from my
address)" msg)))))
;;;###mh-autoload
-(defun mh-spamassassin-whitelist (msg)
- "Whitelist MSG with SpamAssassin.
+(defun mh-spamassassin-allowlist (msg)
+ "Allowlist MSG with SpamAssassin.
-The \\[mh-junk-whitelist] command adds a \"whitelist_from\" rule to
+The \\[mh-junk-allowlist] command adds a \"whitelist_from\" rule to
the \"~/.spamassassin/user_prefs\" file. If the \"sa-learn\" command
is available, the message is also recategorized as ham.
-See `mh-spamassassin-blacklist' for more information."
+See `mh-spamassassin-blocklist' for more information."
(unless mh-spamassassin-executable
(error "Unable to find the spamassassin executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder))
@@ -300,21 +305,22 @@ See `mh-spamassassin-blacklist' for more information."
(kill-buffer show-buffer))
(write-file msg-file)
(when mh-sa-learn-executable
- (message "Recategorizing message %d as ham..." msg)
+ (message "Recategorizing message %d as ham with sa-learn..." msg)
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-sa-learn-executable msg-file mh-junk-background nil
"--ham" "--local" "--no-sync")))
- (message "Whitelisting sender of message %d..." msg)
+ (message "Allowlisting sender of message %d..." msg)
(setq from
- (car (mh-funcall-if-exists
- ietf-drums-parse-address (mh-get-header-field "From:"))))
+ (car (mail-header-parse-address (mh-get-header-field "From:"))))
(kill-buffer nil)
- (unless (or (null from) (equal from ""))
- (mh-spamassassin-add-rule "whitelist_from" from))
- (message "Whitelisting sender of message %d...done" msg))))
+ (if (or (null from) (equal from ""))
+ (message "Allowlisting sender of message %d...%s"
+ msg "not done (cannot identify sender)")
+ (mh-spamassassin-add-rule "whitelist_from" from)
+ (message "Allowlisting sender of message %d...done" msg)))))
(defun mh-spamassassin-add-rule (rule body)
"Add a new rule to \"~/.spamassassin/user_prefs\".
@@ -384,8 +390,8 @@ information can be used so that you can replace multiple
(defvar mh-bogofilter-executable (executable-find "bogofilter"))
;;;###mh-autoload
-(defun mh-bogofilter-blacklist (msg)
- "Blacklist MSG with bogofilter.
+(defun mh-bogofilter-blocklist (msg)
+ "Blocklist MSG with bogofilter.
Bogofilter is a Bayesian spam filtering program. Get it from your
local distribution or from the bogofilter web site at URL
@@ -422,7 +428,7 @@ To use bogofilter, add the following recipes to
\".procmailrc\":
spam/unsure/.
If bogofilter classifies a message incorrectly, or is unsure, you can
-use the MH-E commands \\[mh-junk-blacklist] and \\[mh-junk-whitelist]
+use the MH-E commands \\[mh-junk-blocklist] and \\[mh-junk-allowlist]
to update bogofilter's training.
The \"Bogofilter FAQ\" suggests that you run the following
@@ -435,28 +441,32 @@ occasionally to shrink the database:
The \"Bogofilter tuning HOWTO\" describes how you can fine-tune Bogofilter."
(unless mh-bogofilter-executable
(error "Unable to find the bogofilter executable"))
+ (message "Blocklisting message %d with bogofilter..." msg)
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-bogofilter-executable msg-file mh-junk-background
- nil "-s"))))
+ nil "-s")
+ (message "Blocklisting message %d with bogofilter...done" msg))))
;;;###mh-autoload
-(defun mh-bogofilter-whitelist (msg)
- "Whitelist MSG with bogofilter.
+(defun mh-bogofilter-allowlist (msg)
+ "Allowlist MSG with bogofilter.
-See `mh-bogofilter-blacklist' for more information."
+See `mh-bogofilter-blocklist' for more information."
(unless mh-bogofilter-executable
(error "Unable to find the bogofilter executable"))
+ (message "Allowlisting message %d with bogofilter..." msg)
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-bogofilter-executable msg-file mh-junk-background
- nil "-n"))))
+ nil "-n")
+ (message "Allowlisting message %d with bogofilter...done" msg))))
@@ -465,8 +475,8 @@ See `mh-bogofilter-blacklist' for more information."
(defvar mh-spamprobe-executable (executable-find "spamprobe"))
;;;###mh-autoload
-(defun mh-spamprobe-blacklist (msg)
- "Blacklist MSG with SpamProbe.
+(defun mh-spamprobe-blocklist (msg)
+ "Blocklist MSG with SpamProbe.
SpamProbe is a Bayesian spam filtering program. Get it from your
local distribution or from the SpamProbe web site at URL
@@ -489,32 +499,36 @@ To use SpamProbe, add the following recipes to
\".procmailrc\":
spam/.
If SpamProbe classifies a message incorrectly, you can use the
-MH-E commands \\[mh-junk-blacklist] and \\[mh-junk-whitelist] to
+MH-E commands \\[mh-junk-blocklist] and \\[mh-junk-allowlist] to
update SpamProbe's training."
(unless mh-spamprobe-executable
(error "Unable to find the spamprobe executable"))
+ (message "Blocklisting message %d with spamprobe..." msg)
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-spamprobe-executable msg-file mh-junk-background
- nil "spam"))))
+ nil "spam")
+ (message "Blocklisting message %d with spamprobe...done" msg))))
;;;###mh-autoload
-(defun mh-spamprobe-whitelist (msg)
- "Whitelist MSG with SpamProbe.
+(defun mh-spamprobe-allowlist (msg)
+ "Allowlist MSG with SpamProbe.
-See `mh-spamprobe-blacklist' for more information."
+See `mh-spamprobe-blocklist' for more information."
(unless mh-spamprobe-executable
(error "Unable to find the spamprobe executable"))
+ (message "Allowlisting message %d with spamprobe..." msg)
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-spamprobe-executable msg-file mh-junk-background
- nil "good"))))
+ nil "good")
+ (message "Allowlisting message %d with spamprobe...done" msg))))
(provide 'mh-junk)
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index ef70252..ad594ae 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -51,6 +51,7 @@
(autoload 'article-emphasize "gnus-art")
(autoload 'gnus-eval-format "gnus-spec")
(autoload 'mail-content-type-get "mail-parse")
+(autoload 'mail-decode-encoded-word-region "mail-parse")
(autoload 'mail-decode-encoded-word-string "mail-parse")
(autoload 'mail-header-parse-content-type "mail-parse")
(autoload 'mail-header-strip-cte "mail-parse")
@@ -61,7 +62,6 @@
(autoload 'mm-decode-body "mm-bodies")
(autoload 'mm-uu-dissect "mm-uu")
(autoload 'mml-unsecure-message "mml-sec")
-(autoload 'rfc2047-decode-region "rfc2047")
(autoload 'widget-convert-button "wid-edit")
@@ -496,7 +496,7 @@ decoding the same message multiple times."
"Decode RFC2047 encoded message header fields."
(when mh-decode-mime-flag
(let ((buffer-read-only nil))
- (rfc2047-decode-region (point-min) (mh-mail-header-end)))))
+ (mail-decode-encoded-word-region (point-min) (mh-mail-header-end)))))
;;;###mh-autoload
(defun mh-decode-message-subject ()
@@ -504,8 +504,9 @@ decoding the same message multiple times."
(when mh-decode-mime-flag
(save-excursion
(let ((buffer-read-only nil))
- (rfc2047-decode-region (progn (mh-goto-header-field "Subject:")
(point))
- (progn (mh-header-field-end) (point)))))))
+ (mail-decode-encoded-word-region
+ (progn (mh-goto-header-field "Subject:") (point))
+ (progn (mh-header-field-end) (point)))))))
;;;###mh-autoload
(defun mh-mime-display (&optional pre-dissected-handles)
diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el
index 1504979..1023520 100644
--- a/lisp/mh-e/mh-scan.el
+++ b/lisp/mh-e/mh-scan.el
@@ -113,8 +113,8 @@ expression which matches the body text as in the default of
not correct, the body fragment will not be highlighted with the
face `mh-folder-body'.")
-(defvar mh-scan-blacklisted-msg-regexp "^\\( *[0-9]+\\)B"
- "This regular expression matches blacklisted (spam) messages.
+(defvar mh-scan-blocklisted-msg-regexp "^\\( *[0-9]+\\)B"
+ "This regular expression matches blocklisted (spam) messages.
It must match from the beginning of the line. Note that the
default setting of `mh-folder-font-lock-keywords' expects this
@@ -125,9 +125,9 @@ matches the message number as in the default of
This expression includes the leading space within parenthesis
since it looks better to highlight it as well. The highlighting
-is done with the face `mh-folder-blacklisted'. This regular
+is done with the face `mh-folder-blocklisted'. This regular
expression should be correct as it is needed by non-fontification
-functions. See also `mh-note-blacklisted'.")
+functions. See also `mh-note-blocklisted'.")
(defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*"
"This regular expression matches the current message.
@@ -295,21 +295,21 @@ non-fontification functions.")
This is used to eliminate error messages that are occasionally
produced by \"inc\".")
-(defvar mh-scan-whitelisted-msg-regexp "^\\( *[0-9]+\\)W"
- "This regular expression matches whitelisted (non-spam) messages.
+(defvar mh-scan-allowlisted-msg-regexp "^\\( *[0-9]+\\)A"
+ "This regular expression matches allowlisted (non-spam) messages.
It must match from the beginning of the line. Note that the
default setting of `mh-folder-font-lock-keywords' expects this
expression to contain at least one parenthesized expression which
matches the message number as in the default of
- \"^\\\\( *[0-9]+\\\\)W\".
+ \"^\\\\( *[0-9]+\\\\)A\".
This expression includes the leading space within parenthesis
since it looks better to highlight it as well. The highlighting
-is done with the face `mh-folder-whitelisted'. This regular
+is done with the face `mh-folder-allowlisted'. This regular
expression should be correct as it is needed by non-fontification
-functions. See also `mh-note-whitelisted'.")
+functions. See also `mh-note-allowlisted'.")
@@ -333,8 +333,8 @@ This column will have one of the values: \" \", \"^\",
\"D\", \"B\", \"W\", \"+\
\" \" is the default value,
\"^\" is the `mh-note-refiled' character,
\"D\" is the `mh-note-deleted' character,
- \"B\" is the `mh-note-blacklisted' character,
- \"W\" is the `mh-note-whitelisted' character, and
+ \"B\" is the `mh-note-blocklisted' character,
+ \"A\" is the `mh-note-allowlisted' character, and
\"+\" is the `mh-note-cur' character.")
(defvar mh-scan-destination-width 1
@@ -399,9 +399,9 @@ This column will only ever have spaces in it.")
;; Alphabetical.
-(defvar mh-note-blacklisted ?B
- "Messages that have been blacklisted are marked by this character.
-See also `mh-scan-blacklisted-msg-regexp'.")
+(defvar mh-note-blocklisted ?B
+ "Messages that have been blocklisted are marked by this character.
+See also `mh-scan-blocklisted-msg-regexp'.")
(defvar mh-note-cur ?+
"The current message (in MH, not in MH-E) is marked by this character.
@@ -436,9 +436,9 @@ See also `mh-scan-refiled-msg-regexp'.")
Messages in the \"search\" sequence are marked by this character as
well.")
-(defvar mh-note-whitelisted ?W
- "Messages that have been whitelisted are marked by this character.
-See also `mh-scan-whitelisted-msg-regexp'.")
+(defvar mh-note-allowlisted ?A
+ "Messages that have been allowlisted are marked by this character.
+See also `mh-scan-allowlisted-msg-regexp'.")
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index b3a250b..e03c9dc 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -1448,7 +1448,7 @@ being the list of messages originally from that folder."
(defun mh-index-execute-commands ()
"Perform the outstanding operations on the actual messages.
The copies in the searched folder are then deleted, refiled,
-blacklisted and whitelisted to get the desired result. Before
+blocklisted and allowlisted to get the desired result. Before
processing the messages we make sure that the message is
identical to the one that the user has marked in the index
buffer."
@@ -1465,12 +1465,12 @@ buffer."
(with-current-buffer folder
(let ((old-refile-list mh-refile-list)
(old-delete-list mh-delete-list)
- (old-blacklist mh-blacklist)
- (old-whitelist mh-whitelist))
+ (old-blocklist mh-blocklist)
+ (old-allowlist mh-allowlist))
(setq mh-refile-list nil
mh-delete-list msgs
- mh-blacklist nil
- mh-whitelist nil)
+ mh-blocklist nil
+ mh-allowlist nil)
(unwind-protect (mh-execute-commands)
(setq mh-refile-list
(mapcar (lambda (x)
@@ -1482,11 +1482,11 @@ buffer."
mh-delete-list
(cl-loop for x in old-delete-list
unless (memq x msgs) collect x)
- mh-blacklist
- (cl-loop for x in old-blacklist
+ mh-blocklist
+ (cl-loop for x in old-blocklist
unless (memq x msgs) collect x)
- mh-whitelist
- (cl-loop for x in old-whitelist
+ mh-allowlist
+ (cl-loop for x in old-allowlist
unless (memq x msgs) collect x))
(mh-set-folder-modified-p (mh-outstanding-commands-p))
(when (mh-outstanding-commands-p)
@@ -1494,8 +1494,8 @@ buffer."
(mh-index-matching-source-msgs (append (cl-loop for x in mh-refile-list
append (cdr x))
mh-delete-list
- mh-blacklist
- mh-whitelist)
+ mh-blocklist
+ mh-allowlist)
t))
folders)))
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index aa97f5c..803f07e 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -463,8 +463,10 @@ still visible.\n")
(mh-defun-show-buffer mh-show-index-visit-folder mh-index-visit-folder t)
(mh-defun-show-buffer mh-show-toggle-tick mh-toggle-tick)
(mh-defun-show-buffer mh-show-narrow-to-tick mh-narrow-to-tick)
-(mh-defun-show-buffer mh-show-junk-blacklist mh-junk-blacklist)
-(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist)
+(mh-defun-show-buffer mh-show-junk-allowlist mh-junk-allowlist)
+(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-allowlist)
+(make-obsolete 'mh-show-junk-whitelist 'mh-show-junk-allowlist "28.1")
+(mh-defun-show-buffer mh-show-junk-blocklist mh-junk-blocklist)
(mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages)
(mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages)
(mh-defun-show-buffer mh-show-index-sequenced-messages
@@ -633,7 +635,8 @@ still visible.\n")
(gnus-define-keys (mh-show-junk-map "J" mh-show-mode-map)
"?" mh-prefix-help
- "b" mh-show-junk-blacklist
+ "a" mh-show-junk-allowlist
+ "b" mh-show-junk-blocklist
"w" mh-show-junk-whitelist)
(gnus-define-keys (mh-show-ps-print-map "P" mh-show-mode-map)
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index 3af840c..76ef990 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -441,7 +441,7 @@ be handled next."
(position 0)
line-end line folder unseen total)
(unwind-protect
- (while (setq line-end (string-match "\n" output position))
+ (while (setq line-end (string-search "\n" output position))
(setq line (format "%s%s"
mh-speed-partial-line
(substring output position line-end))
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 8e900dc..bbce170 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -378,7 +378,7 @@ names and the function is called when OUTPUT is available."
(prevailing-match-data (match-data))
line-end folder)
(unwind-protect
- (while (setq line-end (string-match "\n" output position))
+ (while (setq line-end (string-search "\n" output position))
(setq folder (format "+%s%s"
mh-flists-partial-line
(substring output position line-end)))
@@ -702,7 +702,7 @@ See Info node `(elisp) Programmed Completion' for details."
(let ((slash (mh-search-from-end ?/ orig-name)))
(if slash (1+ slash)
(if (string-match "\\`\\+" orig-name) 1 0)))
- (if (cdr flag) (string-match "/" (cdr flag)))))
+ (if (cdr flag) (string-search "/" (cdr flag)))))
((eq flag nil)
(let ((try-res
(try-completion
diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el
index d4d5c5c..58177c1 100644
--- a/lisp/mh-e/mh-xface.el
+++ b/lisp/mh-e/mh-xface.el
@@ -27,6 +27,7 @@
(require 'mh-e)
+(autoload 'mail-header-parse-address "mail-parse")
(autoload 'message-fetch-field "message")
(defvar mh-show-xface-function
@@ -190,11 +191,7 @@ The directories are searched for in the order they appear
in the list.")
(let* ((from-field (ignore-errors (car (message-tokenize-header
(mh-get-header-field "from:")))))
(from (car (ignore-errors
- ;; Don't use mh-funcall-if-exists because
- ;; ietf-drums-parse-address might exist at run-time but
- ;; not at compile-time.
- (when (fboundp 'ietf-drums-parse-address)
- (ietf-drums-parse-address from-field)))))
+ (mail-header-parse-address from-field))))
(host (and from
(string-match "\\([^+]*\\)\\(\\+.*\\)?@\\(.*\\)" from)
(downcase (match-string 3 from))))
@@ -391,10 +388,12 @@ filenames. In addition, replaces * with %2a. See URL
(defun mh-x-image-url-sane-p (url)
"Check if URL is something sensible."
(let ((len (length url)))
- (cond ((< len 5) nil)
- ((not (equal (substring url 0 5) "http:")) nil)
- ((> len 100) nil)
- (t t))))
+ (cond ((> len 100) nil)
+ ((and (>= len 5)
+ (equal (substring url 0 5) "http:") t))
+ ((and (>= len 6)
+ (equal (substring url 0 6) "https:") t))
+ (t nil))))
(defun mh-x-image-display (image marker)
"Display IMAGE at MARKER."
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 1578ab8..68e4fa1 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1496,7 +1496,8 @@ Remove completion BASE prefix string from history
elements."
base-size md
minibuffer-completion-table
minibuffer-completion-predicate))
- (sort-fun (completion-metadata-get all-md 'cycle-sort-function)))
+ (sort-fun (completion-metadata-get all-md 'cycle-sort-function))
+ (group-fun (completion-metadata-get all-md 'group-function)))
(when last
(setcdr last nil)
@@ -1506,17 +1507,25 @@ Remove completion BASE prefix string from history
elements."
(setq all (delete-dups all))
(setq last (last all))
- (if sort-fun
- (setq all (funcall sort-fun all))
- ;; Sort first by length and alphabetically.
+ (cond
+ (sort-fun (setq all (funcall sort-fun all)))
+ ((and completions-group group-fun)
+ ;; TODO: experiment with re-grouping here. Might be slow
+ ;; if the group-fun (given by the table and out of our
+ ;; control) is slow and/or allocates too much.
+ )
+ (t
+ ;; If the table doesn't stipulate a sorting function or a
+ ;; group function, sort first by length and
+ ;; alphabetically.
(setq all (minibuffer--sort-by-length-alpha all))
- ;; Sort by history position, put the default, if it
+ ;; Then sort by history position, and put the default, if it
;; exists, on top.
(when (minibufferp)
(setq all (minibuffer--sort-by-position
(minibuffer--sort-preprocess-history
(substring string 0 base-size))
- all))))
+ all)))))
;; Cache the result. This is not just for speed, but also so that
;; repeated calls to minibuffer-force-complete can cycle through
@@ -2328,6 +2337,16 @@ variables.")
(setq deactivate-mark nil)
(throw 'exit nil))
+(defun minibuffer-restore-windows ()
+ "Restore some windows on exit from minibuffer.
+When `read-minibuffer-restore-windows' is nil, then this function
+added to `minibuffer-exit-hook' will remove at least the window
+that displays the \"*Completions*\" buffer."
+ (unless read-minibuffer-restore-windows
+ (minibuffer-hide-completions)))
+
+(add-hook 'minibuffer-exit-hook 'minibuffer-restore-windows)
+
(defun minibuffer-quit-recursive-edit ()
"Quit the command that requested this recursive edit without error.
Like `abort-recursive-edit' without aborting keyboard macro
@@ -2696,7 +2715,15 @@ not active.")
:abbrev-table nil ;abbrev.el is not loaded yet during dump.
;; Note: this major mode is called from minibuf.c.
"Major mode to use in the minibuffer when it is not active.
-This is only used when the minibuffer area has no active minibuffer.")
+This is only used when the minibuffer area has no active minibuffer.
+
+Note that the minibuffer may change to this mode more often than
+you might expect. For instance, typing `M-x' may change the
+buffer to this mode, then to a different mode, and then back
+again to this mode upon exit. Code running from
+`minibuffer-inactive-mode-hook' has to be prepared to run
+multiple times per minibuffer invocation. Also see
+`minibuffer-exit-hook'.")
(defvaralias 'minibuffer-mode-map 'minibuffer-local-map)
@@ -2731,7 +2758,7 @@ Useful to give the user default values that won't be
substituted."
(defun completion--make-envvar-table ()
(mapcar (lambda (enventry)
- (substring enventry 0 (string-match-p "=" enventry)))
+ (substring enventry 0 (string-search "=" enventry)))
process-environment))
(defconst completion--embedded-envvar-re
@@ -2800,7 +2827,7 @@ same as `substitute-in-file-name'."
pred action))
((eq (car-safe action) 'boundaries)
(let ((start (length (file-name-directory string)))
- (end (string-match-p "/" (cdr action))))
+ (end (string-search "/" (cdr action))))
`(boundaries
;; if `string' is "C:" in w32, (file-name-directory string)
;; returns "C:/", so `start' is 3 rather than 2.
@@ -3087,7 +3114,7 @@ See `read-file-name' for the meaning of the arguments."
(minibuffer-maybe-quote-filename dir)))
(initial (cons (minibuffer-maybe-quote-filename initial)
0)))))
- (let ((completion-ignore-case read-file-name-completion-ignore-case)
+ (let ((ignore-case read-file-name-completion-ignore-case)
(minibuffer-completing-file-name t)
(pred (or predicate 'file-exists-p))
(add-to-history nil))
@@ -3115,6 +3142,7 @@ See `read-file-name' for the meaning of the arguments."
minibuffer-default))
(setq minibuffer-default
(cdr-safe minibuffer-default)))
+ (setq-local completion-ignore-case ignore-case)
;; On the first request on `M-n' fill
;; `minibuffer-default' with a list of defaults
;; relevant for file-name reading.
@@ -3501,7 +3529,8 @@ string in COMPLETIONS. Return a deep copy of COMPLETIONS
where
each string is propertized with `completion-score', a number
between 0 and 1, and with faces `completions-common-part',
`completions-first-difference' in the relevant segments."
- (when completions
+ (cond
+ ((and completions (cl-loop for e in pattern thereis (stringp e)))
(let* ((re (completion-pcm--pattern->regex pattern 'group))
(point-idx (completion-pcm--pattern-point-idx pattern))
(case-fold-search completion-ignore-case)
@@ -3592,7 +3621,8 @@ between 0 and 1, and with faces `completions-common-part',
0 1 'completion-score
(/ score-numerator (* end (1+ score-denominator)) 1.0) str)))
str)
- completions))))
+ completions)))
+ (t completions)))
(defun completion-pcm--find-all-completions (string table pred point
&optional filter)
@@ -3924,39 +3954,38 @@ that is non-nil."
(put 'flex 'completion--adjust-metadata 'completion--flex-adjust-metadata)
(defun completion--flex-adjust-metadata (metadata)
- (cl-flet
- ((compose-flex-sort-fn
- (existing-sort-fn) ; wish `cl-flet' had proper indentation...
- (lambda (completions)
- (let ((pre-sorted
- (if existing-sort-fn
- (funcall existing-sort-fn completions)
- completions)))
- (cond
- ((or (not (window-minibuffer-p))
- ;; JT@2019-12-23: FIXME: this is still wrong. What
- ;; we need to test here is "some input that actually
- ;; leads to flex filtering", not "something after
- ;; the minibuffer prompt". Among other
- ;; inconsistencies, the latter is always true for
- ;; file searches, meaning the next clauses will be
- ;; ignored.
- (> (point-max) (minibuffer-prompt-end)))
- (sort
- pre-sorted
- (lambda (c1 c2)
- (let ((s1 (get-text-property 0 'completion-score c1))
- (s2 (get-text-property 0 'completion-score c2)))
- (> (or s1 0) (or s2 0))))))
- (t pre-sorted))))))
- `(metadata
- (display-sort-function
- . ,(compose-flex-sort-fn
- (completion-metadata-get metadata 'display-sort-function)))
- (cycle-sort-function
- . ,(compose-flex-sort-fn
- (completion-metadata-get metadata 'cycle-sort-function)))
- ,@(cdr metadata))))
+ "If `flex' is actually doing filtering, adjust sorting."
+ (let ((flex-is-filtering-p
+ ;; JT@2019-12-23: FIXME: this is kinda wrong. What we need
+ ;; to test here is "some input that actually leads/led to
+ ;; flex filtering", not "something after the minibuffer
+ ;; prompt". E.g. The latter is always true for file
+ ;; searches, meaning we'll be doing extra work when we
+ ;; needn't.
+ (or (not (window-minibuffer-p))
+ (> (point-max) (minibuffer-prompt-end))))
+ (existing-dsf
+ (completion-metadata-get metadata 'display-sort-function))
+ (existing-csf
+ (completion-metadata-get metadata 'cycle-sort-function)))
+ (cl-flet
+ ((compose-flex-sort-fn
+ (existing-sort-fn) ; wish `cl-flet' had proper indentation...
+ (lambda (completions)
+ (sort
+ (funcall existing-sort-fn completions)
+ (lambda (c1 c2)
+ (let ((s1 (get-text-property 0 'completion-score c1))
+ (s2 (get-text-property 0 'completion-score c2)))
+ (> (or s1 0) (or s2 0))))))))
+ `(metadata
+ ,@(and flex-is-filtering-p
+ `((display-sort-function
+ . ,(compose-flex-sort-fn (or existing-dsf #'identity)))))
+ ,@(and flex-is-filtering-p
+ `((cycle-sort-function
+ . ,(compose-flex-sort-fn (or existing-csf #'identity)))))
+ ,@(cdr metadata)))))
(defun completion-flex--make-flex-pattern (pattern)
"Convert PCM-style PATTERN into PCM-style flex pattern.
@@ -3977,7 +4006,7 @@ which is at the core of flex logic. The extra
(defun completion-flex-try-completion (string table pred point)
"Try to flex-complete STRING in TABLE given PRED and POINT."
- (unless (and completion-flex-nospace (string-match-p " " string))
+ (unless (and completion-flex-nospace (string-search " " string))
(pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds)
(completion-substring--all-completions
string table pred point
@@ -3994,7 +4023,7 @@ which is at the core of flex logic. The extra
(defun completion-flex-all-completions (string table pred point)
"Get flex-completions of STRING in TABLE, given PRED and POINT."
- (unless (and completion-flex-nospace (string-match-p " " string))
+ (unless (and completion-flex-nospace (string-search " " string))
(pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
(completion-substring--all-completions
string table pred point
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 89e5d7c..7d3ed9a 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -180,7 +180,7 @@ items `Turn Off' and `Help'."
`(keymap
,(format "%s - %s" indicator
(capitalize
- (replace-regexp-in-string
+ (string-replace
"-" " " (format "%S" minor-mode))))
(turn-off menu-item "Turn off minor mode" ,mm-fun)
(help menu-item "Help for minor mode"
@@ -277,6 +277,228 @@ not it is actually displayed."
minor-mode-menus)))
+;; Context menus.
+
+(defcustom context-menu-functions '(context-menu-undo
+ context-menu-region
+ context-menu-local
+ context-menu-minor)
+ "List of functions that produce the contents of the context menu.
+Each function receives the menu as its argument and should return
+the same menu with changes such as added new menu items."
+ :type '(repeat
+ (choice (function-item context-menu-undo)
+ (function-item context-menu-region)
+ (function-item context-menu-toolbar)
+ (function-item context-menu-global)
+ (function-item context-menu-local)
+ (function-item context-menu-minor)
+ (function-item context-menu-buffers)
+ (function-item context-menu-vc)
+ (function-item context-menu-ffap)
+ (function :tag "Custom function")))
+ :version "28.1")
+
+(defcustom context-menu-filter-function nil
+ "Function that can filter the list produced by `context-menu-functions'."
+ :type '(choice (const nil) function)
+ :version "28.1")
+
+(defun context-menu-map ()
+ "Return composite menu map."
+ (let ((menu (make-sparse-keymap (propertize "Context Menu" 'hide t))))
+ (let ((fun (mouse-posn-property (event-start last-input-event)
+ 'context-menu-function)))
+ (if (functionp fun)
+ (setq menu (funcall fun menu))
+ (run-hook-wrapped 'context-menu-functions
+ (lambda (fun)
+ (setq menu (funcall fun menu))
+ nil))))
+ ;; TODO: remove double separators
+ (when (functionp context-menu-filter-function)
+ (setq menu (funcall context-menu-filter-function menu)))
+ menu))
+
+(defun context-menu-toolbar (menu)
+ "Tool bar menu items."
+ (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
+ (define-key-after menu [separator-toolbar] menu-bar-separator)
+ (map-keymap (lambda (key binding)
+ (when (consp binding)
+ (define-key-after menu (vector key)
+ (copy-sequence binding))))
+ (lookup-key global-map [tool-bar]))
+ menu)
+
+(defun context-menu-global (menu)
+ "Global submenus."
+ (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
+ (define-key-after menu [separator-global] menu-bar-separator)
+ (map-keymap (lambda (key binding)
+ (when (consp binding)
+ (define-key-after menu (vector key)
+ (copy-sequence binding))))
+ (lookup-key global-map [menu-bar]))
+ menu)
+
+(defun context-menu-local (menu)
+ "Major mode submenus."
+ (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
+ (define-key-after menu [separator-local] menu-bar-separator)
+ (let ((keymap (local-key-binding [menu-bar])))
+ (when keymap
+ (map-keymap (lambda (key binding)
+ (when (consp binding)
+ (define-key-after menu (vector key)
+ (copy-sequence binding))))
+ keymap)))
+ menu)
+
+(defun context-menu-minor (menu)
+ "Minor modes submenus."
+ (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
+ (define-key-after menu [separator-minor] menu-bar-separator)
+ (dolist (mode (reverse (minor-mode-key-binding [menu-bar])))
+ (when (and (consp mode) (symbol-value (car mode)))
+ (map-keymap (lambda (key binding)
+ (when (consp binding)
+ (define-key-after menu (vector key)
+ (copy-sequence binding))))
+ (cdr mode))))
+ menu)
+
+(defun context-menu-buffers (menu)
+ "Submenus with buffers."
+ (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
+ (define-key-after menu [separator-buffers] menu-bar-separator)
+ (map-keymap (lambda (key binding)
+ (when (consp binding)
+ (define-key-after menu (vector key)
+ (copy-sequence binding))))
+ (mouse-buffer-menu-keymap))
+ menu)
+
+(defun context-menu-vc (menu)
+ "Version Control menu."
+ (define-key-after menu [separator-vc] menu-bar-separator)
+ (define-key-after menu [vc-menu] vc-menu-entry)
+ menu)
+
+(defun context-menu-undo (menu)
+ "Undo menu."
+ (when (cddr menu)
+ (define-key-after menu [separator-undo] menu-bar-separator))
+ (define-key-after menu [undo]
+ '(menu-item "Undo" undo
+ :visible (and (not buffer-read-only)
+ (not (eq t buffer-undo-list))
+ (if (eq last-command 'undo)
+ (listp pending-undo-list)
+ (consp buffer-undo-list)))
+ :help "Undo last edits"))
+ (define-key-after menu [undo-redo]
+ '(menu-item "Redo" undo-redo
+ :visible (and (not buffer-read-only)
+ (undo--last-change-was-undo-p buffer-undo-list))
+ :help "Redo last undone edits"))
+ menu)
+
+(defun context-menu-region (menu)
+ "Region commands menu."
+ (when (cddr menu)
+ (define-key-after menu [separator-region] menu-bar-separator))
+ (define-key-after menu [cut]
+ '(menu-item "Cut" kill-region
+ :visible (and mark-active (not buffer-read-only))
+ :help
+ "Cut (kill) text in region between mark and current position"))
+ (define-key-after menu [copy]
+ ;; ns-win.el said: Substitute a Copy function that works better
+ ;; under X (for GNUstep).
+ `(menu-item "Copy" ,(if (featurep 'ns)
+ 'ns-copy-including-secondary
+ 'kill-ring-save)
+ :visible mark-active
+ :help "Copy text in region between mark and current position"
+ :keys ,(if (featurep 'ns)
+ "\\[ns-copy-including-secondary]"
+ "\\[kill-ring-save]")))
+ (define-key-after menu [paste]
+ `(menu-item "Paste" mouse-yank-at-click
+ :visible (funcall
+ ',(lambda ()
+ (and (or
+ (gui-backend-selection-exists-p 'CLIPBOARD)
+ (if (featurep 'ns) ; like paste-from-menu
+ (cdr yank-menu)
+ kill-ring))
+ (not buffer-read-only))))
+ :help "Paste (yank) text most recently cut/copied"))
+ (define-key-after menu (if (featurep 'ns) [select-paste]
+ [paste-from-menu])
+ ;; ns-win.el said: Change text to be more consistent with
+ ;; surrounding menu items `paste', etc."
+ `(menu-item ,(if (featurep 'ns) "Select and Paste" "Paste from Kill Menu")
+ yank-menu
+ :visible (and (cdr yank-menu) (not buffer-read-only))
+ :help "Choose a string from the kill ring and paste it"))
+ (define-key-after menu [clear]
+ '(menu-item "Clear" delete-active-region
+ :visible (and mark-active
+ (not buffer-read-only))
+ :help
+ "Delete the text in region between mark and current position"))
+ (define-key-after menu [mark-whole-buffer]
+ '(menu-item "Select All" mark-whole-buffer
+ :help "Mark the whole buffer for a subsequent cut/copy"))
+ menu)
+
+(defun context-menu-ffap (menu)
+ "File at point menu."
+ (save-excursion
+ (mouse-set-point last-input-event)
+ (when (ffap-guess-file-name-at-point)
+ (define-key menu [ffap-separator] menu-bar-separator)
+ (define-key menu [ffap-at-mouse]
+ '(menu-item "Find File or URL" ffap-at-mouse
+ :help "Find file or URL guessed from text around mouse
click"))))
+ menu)
+
+(defvar context-menu-entry
+ `(menu-item ,(purecopy "Context Menu") ignore
+ :filter (lambda (_) (context-menu-map))))
+
+(defvar context-menu-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-3] nil)
+ (define-key map [down-mouse-3] context-menu-entry)
+ (define-key map [menu] #'context-menu-open)
+ (if (featurep 'w32)
+ (define-key map [apps] #'context-menu-open))
+ (when (featurep 'ns)
+ (define-key map [C-mouse-1] nil)
+ (define-key map [C-down-mouse-1] context-menu-entry))
+ map)
+ "Context Menu mode map.")
+
+(define-minor-mode context-menu-mode
+ "Toggle Context Menu mode.
+
+When Context Menu mode is enabled, clicking the mouse button down-mouse-3
+activates the menu whose contents depends on its surrounding context."
+ :global t :group 'mouse)
+
+(defun context-menu-open ()
+ "Start key navigation of the context menu.
+This is the keyboard interface to \\[context-menu-map]."
+ (interactive)
+ (let ((inhibit-mouse-event-check t))
+ (popup-menu (context-menu-map) (point))))
+
+(global-set-key [S-f10] 'context-menu-open)
+
+
;; Commands that operate on windows.
(defun mouse-minibuffer-check (event)
diff --git a/lisp/mpc.el b/lisp/mpc.el
index ab572aa..029f0ca 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -214,8 +214,8 @@ defaults to 6600 and HOST defaults to localhost."
(with-current-buffer "*MPC-debug*"
(goto-char (point-max))
(insert-before-markers ;So it scrolls.
- (replace-regexp-in-string "\n" "\n "
- (apply #'format-message format args))
+ (string-replace "\n" "\n "
+ (apply #'format-message format args))
"\n"))))
(defun mpc--proc-filter (proc string)
@@ -305,7 +305,7 @@ defaults to 6600 and HOST defaults to localhost."
(defun mpc--proc-quote-string (s)
(if (numberp s) (number-to-string s)
(setq s (replace-regexp-in-string "[\"\\]" "\\\\\\&" s))
- (if (string-match " " s) (concat "\"" s "\"") s)))
+ (if (string-search " " s) (concat "\"" s "\"") s)))
(defconst mpc--proc-alist-to-alists-starters '(file directory))
@@ -611,7 +611,7 @@ Any call to `mpc-status-refresh' may cause it to be
restarted."
(defun mpc-cmd-special-tag-p (tag)
(or (memq tag '(Playlist Search Directory))
- (string-match "|" (symbol-name tag))))
+ (string-search "|" (symbol-name tag))))
(defun mpc-cmd-find (tag value)
"Return a list of all songs whose tag TAG has value VALUE.
@@ -1438,7 +1438,7 @@ when constructing the set of constraints."
(let (res)
(dolist (constraint constraints)
(when (or (eq (car constraint) buffer-tag)
- (and (string-match "|" (symbol-name buffer-tag))
+ (and (string-search "|" (symbol-name buffer-tag))
(member (symbol-name (car constraint))
(split-string (symbol-name buffer-tag) "|"))))
(setq res (cdr constraint))))
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index b31805a..def7758 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -40,6 +40,8 @@
(require 'timer)
(defvar mouse-wheel-mode)
+(defvar mouse-wheel--installed-bindings-alist nil
+ "Alist of all installed mouse wheel key bindings.")
;; Setter function for mouse-button user-options. Switch Mouse Wheel
;; mode off and on again so that the old button is unbound and
@@ -47,8 +49,10 @@
(defun mouse-wheel-change-button (var button)
(set-default var button)
- ;; Sync the bindings.
- (when (bound-and-true-p mouse-wheel-mode) (mouse-wheel-mode 1)))
+ ;; Sync the bindings if they're already setup.
+ (when (and mouse-wheel--installed-bindings-alist
+ (bound-and-true-p mouse-wheel-mode))
+ (mouse-wheel-mode 1)))
(defcustom mouse-wheel-down-event
(if (or (featurep 'w32-win) (featurep 'ns-win))
@@ -380,9 +384,6 @@ value of ARG, and the command uses it in subsequent
scrolls."
(text-scale-decrease 1)))
(select-window selected-window))))
-(defvar mouse-wheel--installed-bindings-alist nil
- "Alist of all installed mouse wheel key bindings.")
-
(defun mouse-wheel--add-binding (key fun)
"Bind mouse wheel button KEY to function FUN.
Save it for later removal by `mouse-wheel--remove-bindings'."
@@ -418,30 +419,31 @@ an event used for scrolling, such as
`mouse-wheel-down-event'."
(define-minor-mode mouse-wheel-mode
"Toggle mouse wheel support (Mouse Wheel mode)."
:init-value t
- ;; We'd like to use custom-initialize-set here so the setup is done
- ;; before dumping, but at the point where the defcustom is evaluated,
- ;; the corresponding function isn't defined yet, so
- ;; custom-initialize-set signals an error.
- :initialize 'custom-initialize-delay
:global t
:group 'mouse
;; Remove previous bindings, if any.
(mouse-wheel--remove-bindings)
;; Setup bindings as needed.
(when mouse-wheel-mode
- (dolist (binding mouse-wheel-scroll-amount)
- (cond
- ;; Bindings for changing font size.
- ((and (consp binding) (eq (cdr binding) 'text-scale))
- (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event))
- (mouse-wheel--add-binding `[,(list (caar binding) event)]
- 'mouse-wheel-text-scale)))
- ;; Bindings for scrolling.
- (t
- (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
- mouse-wheel-left-event mouse-wheel-right-event))
- (dolist (key (mouse-wheel--create-scroll-keys binding event))
- (mouse-wheel--add-binding key 'mwheel-scroll))))))))
+ (mouse-wheel--setup-bindings)))
+
+(defun mouse-wheel--setup-bindings ()
+ (dolist (binding mouse-wheel-scroll-amount)
+ (cond
+ ;; Bindings for changing font size.
+ ((and (consp binding) (eq (cdr binding) 'text-scale))
+ (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event))
+ (mouse-wheel--add-binding `[,(list (caar binding) event)]
+ 'mouse-wheel-text-scale)))
+ ;; Bindings for scrolling.
+ (t
+ (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
+ mouse-wheel-left-event mouse-wheel-right-event))
+ (dolist (key (mouse-wheel--create-scroll-keys binding event))
+ (mouse-wheel--add-binding key 'mwheel-scroll)))))))
+
+(when mouse-wheel-mode
+ (mouse-wheel--setup-bindings))
;;; Obsolete.
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 3f3a3df..c51766d 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -2296,7 +2296,7 @@ and NOWAIT."
;; If the dir name contains a space, some ftp servers will
;; refuse to list it. We instead change directory to the
;; directory in question and ls ".".
- (when (string-match " " cmd1)
+ (when (string-search " " cmd1)
;; Keep the result. In case of failure, we will (see below)
;; short-circuit CMD and return this result directly.
(setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror))
@@ -2881,13 +2881,13 @@ NO-ERROR, if a listing for DIRECTORY cannot be
obtained."
(or
;; No dots in dir names in vms.
(and (eq host-type 'vms)
- (string-match "\\." efile))
+ (string-search "." efile))
;; No subdirs in mts of cms.
(and (memq host-type '(mts cms))
(not (string-equal "/" (nth 2 parsed))))
;; No dots in pseudo-dir names in bs2000.
(and (eq host-type 'bs2000)
- (string-match "\\." efile))))))
+ (string-search "." efile))))))
(defun ange-ftp-file-entry-p (name)
"Given NAME, return whether there is a file entry for it."
@@ -4704,8 +4704,7 @@ NEWNAME should be the name to give the new compressed or
uncompressed file.")
;; Can't use ange-ftp-dired-host-type here because the current
;; buffer is *dired-check-process output*
(condition-case oops
- (cond ((equal (or (bound-and-true-p dired-chmod-program) "chmod")
- program)
+ (cond ((equal "chmod" program)
(ange-ftp-call-chmod arguments))
;; ((equal "chgrp" program))
;; ((equal dired-chown-program program))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 6d64100..73b8c43 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -1603,7 +1603,7 @@ used instead of `browse-url-new-window-flag'."
;; --- mailto ---
-(autoload 'rfc2368-parse-mailto-url "rfc2368")
+(autoload 'rfc6068-parse-mailto-url "rfc2368")
;;;###autoload
(defun browse-url-mail (url &optional new-window)
@@ -1622,7 +1622,7 @@ When called non-interactively, optional second argument
NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "Mailto URL: "))
(save-excursion
- (let* ((alist (rfc2368-parse-mailto-url url))
+ (let* ((alist (rfc6068-parse-mailto-url url))
(to (assoc "To" alist))
(subject (assoc "Subject" alist))
(body (assoc "Body" alist))
@@ -1644,7 +1644,7 @@ used instead of `browse-url-new-window-flag'."
(insert "\n"))
(goto-char (prog1
(point)
- (insert (replace-regexp-in-string "\r\n" "\n" body))
+ (insert (string-replace "\r\n" "\n" body))
(unless (bolp)
(insert "\n"))))))))
@@ -1780,6 +1780,7 @@ clickable and will use `browse-url' to open the URLs in
question."
category browse-url
browse-url-data ,(match-string
0)))))))
+;;;###autoload
(defun browse-url-button-open (&optional external mouse-event)
"Follow the link under point using `browse-url'.
If EXTERNAL (the prefix if used interactively), open with the
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index f33cbaf..0f42af0 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -86,7 +86,7 @@ You can specify here:
(defcustom dictionary-port
2628
"The port of the dictionary server.
-This port is propably always 2628 so there should be no need to modify it."
+This port is probably always 2628 so there should be no need to modify it."
:group 'dictionary
:set #'dictionary-set-server-var
:type 'number
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 6459c52..517913f 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -664,7 +664,7 @@ If ERROR is non-nil, report an error if there is none."
(let ((result (eudc-query (list (cons 'name name)) '(email)))
email)
(if (null (cdr result))
- (setq email (cl-cdaar result))
+ (setq email (cdaar result))
(error "Multiple match--use the query form"))
(if error
(if email
@@ -682,7 +682,7 @@ If ERROR is non-nil, report an error if there is none."
(let ((result (eudc-query (list (cons 'name name)) '(phone)))
phone)
(if (null (cdr result))
- (setq phone (cl-cdaar result))
+ (setq phone (cdaar result))
(error "Multiple match--use the query form"))
(if error
(if phone
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index eec3ec7..90301e9 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -779,7 +779,7 @@ Currently this means either text/html or
application/xhtml+xml."
(propertize "...: " 'face
'variable-pitch))))
(propertize "..." 'face 'variable-pitch)))))))
- (replace-regexp-in-string
+ (string-replace
"%" "%%"
(format-spec
eww-header-line-format
@@ -1021,6 +1021,35 @@ the like."
["Toggle Paragraph Direction" eww-toggle-paragraph-direction]))
map))
+(defun eww-context-menu (menu)
+ (define-key menu [eww-separator] menu-bar-separator)
+ (let ((easy-menu (make-sparse-keymap "Eww")))
+ (easy-menu-define nil easy-menu nil
+ '("Eww"
+ ["Back to previous page" eww-back-url
+ :visible (not (zerop (length eww-history)))]
+ ["Forward to next page" eww-forward-url
+ :visible (not (zerop eww-history-position))]
+ ["Reload" eww-reload t]))
+ (dolist (item (reverse (lookup-key easy-menu [menu-bar eww])))
+ (when (consp item)
+ (define-key menu (vector (car item)) (cdr item)))))
+
+ (when (or (mouse-posn-property (event-start last-input-event) 'shr-url)
+ (mouse-posn-property (event-start last-input-event) 'image-url))
+ (define-key menu [shr-mouse-browse-url-new-window]
+ `(menu-item "Follow URL in new window" ,(if browse-url-new-window-flag
+ 'shr-mouse-browse-url
+
'shr-mouse-browse-url-new-window)
+ :help "Browse the URL under the mouse cursor in a new
window"))
+ (define-key menu [shr-mouse-browse-url]
+ `(menu-item "Follow URL" ,(if browse-url-new-window-flag
+ 'shr-mouse-browse-url-new-window
+ 'shr-mouse-browse-url)
+ :help "Browse the URL under the mouse cursor")))
+
+ menu)
+
(defvar eww-tool-bar-map
(let ((map (make-sparse-keymap)))
(dolist (tool-bar-item
@@ -1044,6 +1073,7 @@ the like."
(setq-local eww-data (list :title ""))
(setq-local browse-url-browser-function #'eww-browse-url)
(add-hook 'after-change-functions #'eww-process-text-input nil t)
+ (add-hook 'context-menu-functions 'eww-context-menu 5 t)
(setq-local eww-history nil)
(setq-local eww-history-position 0)
(when (boundp 'tool-bar-map)
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index 8992ef7..2c43d0f 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -124,6 +124,14 @@ will have no effect.")
m)
"Keymap to hold goto-addr's mouse key defs under highlighted URLs.")
+(defun goto-address-context-menu (menu)
+ (when (mouse-posn-property (event-start last-input-event) 'goto-address)
+ (define-key menu [goto-address-separator] menu-bar-separator)
+ (define-key menu [goto-address-at-mouse]
+ '(menu-item "Follow Link" goto-address-at-mouse
+ :help "Follow a link where you click")))
+ menu)
+
(defcustom goto-address-url-face 'link
"Face to use for URLs."
:type 'face)
@@ -245,6 +253,11 @@ address. If no e-mail address found, return nil."
(goto-char (match-beginning 0))))
(match-string-no-properties 0)))
+(defun goto-address-at-mouse (click)
+ "Send to the e-mail address or load the URL at mouse click."
+ (interactive "e")
+ (goto-address-at-point click))
+
;;;###autoload
(defun goto-address ()
"Sets up goto-address functionality in the current buffer.
@@ -264,12 +277,16 @@ Also fontifies the buffer appropriately (see
`goto-address-fontify-p' and
(define-minor-mode goto-address-mode
"Minor mode to buttonize URLs and e-mail addresses in the current buffer."
:lighter ""
- (if goto-address-mode
- (jit-lock-register #'goto-address-fontify-region)
+ (cond
+ (goto-address-mode
+ (jit-lock-register #'goto-address-fontify-region)
+ (add-hook 'context-menu-functions 'goto-address-context-menu 10 t))
+ (t
(jit-lock-unregister #'goto-address-fontify-region)
(save-restriction
(widen)
- (goto-address-unfontify (point-min) (point-max)))))
+ (goto-address-unfontify (point-min) (point-max)))
+ (remove-hook 'context-menu-functions 'goto-address-context-menu t))))
(defun goto-addr-mode--turn-on ()
(when (not goto-address-mode)
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 54f7f41..5473ba7 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -1075,7 +1075,7 @@ For instance, \"foo.png\" will result in \"image/png\"."
(dolist (data mailcap--computed-mime-data)
(dolist (info (cdr data))
(setq type (cdr (assq 'type (cdr info))))
- (unless (string-match-p "\\*" type)
+ (unless (string-search "*" type)
(push type res))))
(nreverse res)))))
@@ -1177,7 +1177,24 @@ See \"~/.mailcap\", `mailcap-mime-data' and related
files and variables."
(shell-quote-argument (convert-standard-filename file))
command
nil t))
- (start-process-shell-command command nil command)))
+ ;; Handlers such as "gio open" and kde-open5 start viewer in background
+ ;; and exit immediately. Avoid `start-process' since it assumes
+ ;; :connection-type `pty' and kills children processes with SIGHUP
+ ;; when temporary terminal session is finished (Bug#44824).
+ ;; An alternative is `process-connection-type' let-bound to nil for
+ ;; `start-process-shell-command' call (with no chance to report failure).
+ (make-process
+ :name "mailcap-view-file"
+ :connection-type 'pipe
+ :buffer nil ; "*Messages*" may be suitable for debugging
+ :sentinel (lambda (proc event)
+ (when (and (memq (process-status proc) '(exit signal))
+ (/= (process-exit-status proc) 0))
+ (message
+ "Command %s: %s."
+ (mapconcat #'identity (process-command proc) " ")
+ (substring event 0 -1))))
+ :command (list shell-file-name shell-command-switch command))))
(provide 'mailcap)
diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el
index e1d35c2..727aa55 100644
--- a/lisp/net/mairix.el
+++ b/lisp/net/mairix.el
@@ -422,7 +422,7 @@ with m:msgid of the current article and enabled threads."
(while (string-match "[<>]" mid)
(setq mid (replace-match "" t t mid)))
;; mairix somehow does not like '$' in message-id
- (when (string-match "\\$" mid)
+ (when (string-search "$" mid)
(setq mid (concat mid "=")))
(while (string-match "\\$" mid)
(setq mid (replace-match "=," t t mid)))
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index e623dab..dc54194 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -610,7 +610,7 @@ This does NOT start the retrieval timers."
(interactive)
(let ((filename (read-string "Filename: "
(concat feed ":_"
- (replace-regexp-in-string
+ (string-replace
" " "_" (newsticker--title item))
".html"))))
(with-temp-buffer
diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el
index cb49f75..a267ac3 100644
--- a/lisp/net/pop3.el
+++ b/lisp/net/pop3.el
@@ -551,8 +551,8 @@ Returns the process associated with the connection."
(when result
(let ((response (plist-get (cdr result) :greeting)))
(setq pop3-timestamp
- (substring response (or (string-match "<" response) 0)
- (+ 1 (or (string-match ">" response) -1)))))
+ (substring response (or (string-search "<" response) 0)
+ (+ 1 (or (string-search ">" response) -1)))))
(set-process-query-on-exit-flag (car result) nil)
(erase-buffer)
(car result)))))
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index eb6703a..8129be3 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -794,7 +794,7 @@ When 0, do not auto-reconnect."
(defun rcirc-sentinel (process sentinel)
"Called when PROCESS receives SENTINEL."
- (let ((sentinel (replace-regexp-in-string "\n" "" sentinel)))
+ (let ((sentinel (string-replace "\n" "" sentinel)))
(rcirc-debug process (format "SENTINEL: %S %S\n" process sentinel))
(with-rcirc-process-buffer process
(if (string= sentinel "open")
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index 821ef4a..de1cd9d 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -659,7 +659,7 @@ representing leap seconds."
(if second
(if second-fraction
(let* ((second-fraction-significand
- (replace-regexp-in-string "\\." ""
second-fraction))
+ (string-replace "." "" second-fraction))
(hertz
(expt 10 (length second-fraction-significand)))
(ticks (+ (* hertz (string-to-number second))
@@ -1938,7 +1938,7 @@ This is a specialization of `soap-decode-type' for
(e-name (soap-xs-element-name element))
;; Heuristic: guess if we need to decode using local
;; namespaces.
- (use-fq-names (string-match ":" (symbol-name (car node))))
+ (use-fq-names (string-search ":" (symbol-name (car node))))
(children (if e-name
(if use-fq-names
;; Find relevant children
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 1da1d31..78a261f 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -277,7 +277,7 @@
(setq version (process-get proc 'socks-server-protocol))
(cond
((equal version 'http)
- (if (not (string-match "\r\n\r\n" string))
+ (if (not (string-search "\r\n\r\n" string))
nil ; Need to spin some more
(process-put proc 'socks-state socks-state-connected)
(process-put proc 'socks-reply 0)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index b081e59..70dbfdb 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -327,9 +327,9 @@ arguments to pass to the OPERATION."
v (format "%s -d -a -l %s %s"
(tramp-adb-get-ls-command v)
(tramp-shell-quote-argument
- (concat (file-name-as-directory localname) "."))
+ (tramp-compat-file-name-concat localname "."))
(tramp-shell-quote-argument
- (concat (file-name-as-directory localname) ".."))))
+ (tramp-compat-file-name-concat localname ".."))))
(widen)))
(tramp-adb-sh-fix-ls-output)
(let ((result (tramp-do-parse-file-attributes-with-ls
@@ -924,7 +924,8 @@ implementation will be used."
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
+ (connection-type
+ (or (plist-get args :connection-type) process-connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
@@ -940,7 +941,9 @@ implementation will be used."
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
- (unless (or (null connection-type) (memq connection-type '(pipe pty)))
+ (when (eq connection-type t)
+ (setq connection-type 'pty))
+ (unless (memq connection-type '(nil pipe pty))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -1065,7 +1068,7 @@ implementation will be used."
p))))
;; Save exit.
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 579234f..5a00915 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -72,8 +72,8 @@
;; process key retrieved by `tramp-get-process' (the main connection
;; process). Other processes could reuse these properties, avoiding
;; recomputation when a new asynchronous process is created by
-;; `make-process'. Examples are "remote-path",
-;; "unsafe-temporary-file" or "device" (tramp-adb.el).
+;; `make-process'. Examples are "unsafe-temporary-file",
+;; "remote-path", "device" (tramp-adb.el) or "share" (tramp-gvfs.el).
;;; Code:
@@ -125,7 +125,7 @@ If KEY is `tramp-cache-undefined', don't create anything,
and return nil."
(puthash key (make-hash-table :test #'equal) tramp-cache-data)))
(when (tramp-file-name-p key)
(dolist (elt tramp-connection-properties)
- (when (string-match-p
+ (when (tramp-compat-string-search
(or (nth 0 elt) "")
(tramp-make-tramp-file-name key 'noloc 'nohop))
(tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
@@ -268,8 +268,8 @@ Remove also properties of all files in subdirectories."
(dolist (key (hash-table-keys tramp-cache-data))
(when (and (tramp-file-name-p key)
(stringp (tramp-file-name-localname key))
- (string-match-p (regexp-quote directory)
- (tramp-file-name-localname key)))
+ (tramp-compat-string-search
+ directory (tramp-file-name-localname key)))
(remhash key tramp-cache-data)))
;; Remove file properties of symlinks.
(when (and (stringp truename)
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index d30d220..6278fd3 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -672,7 +672,7 @@ buffer in your bug report.
(insert "\nload-path shadows:\n==================\n")
(ignore-errors
(mapc
- (lambda (x) (when (string-match-p "tramp" x) (insert x "\n")))
+ (lambda (x) (when (tramp-compat-string-search "tramp" x) (insert x "\n")))
(split-string (list-load-path-shadows t) "\n")))
;; Append buffers only when we are in message mode.
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 9d5e5f7..125f825 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -295,6 +295,15 @@ A nil value for either argument stands for the current
time."
(lambda (reporter &optional value _suffix)
(progress-reporter-update reporter value))))
+;; `ignore-error' is new in Emacs Emacs 27.1.
+(defmacro tramp-compat-ignore-error (condition &rest body)
+ "Execute BODY; if the error CONDITION occurs, return nil.
+Otherwise, return result of last form in BODY.
+
+CONDITION can also be a list of error conditions."
+ (declare (debug t) (indent 1))
+ `(condition-case nil (progn ,@body) (,condition nil)))
+
;; `file-modes', `set-file-modes' and `set-file-times' got argument
;; FLAG in Emacs 28.1.
(defalias 'tramp-compat-file-modes
@@ -351,7 +360,17 @@ A nil value for either argument stands for the current
time."
(if (fboundp 'string-replace)
#'string-replace
(lambda (fromstring tostring instring)
- (replace-regexp-in-string (regexp-quote fromstring) tostring instring))))
+ (let ((case-fold-search nil))
+ (replace-regexp-in-string
+ (regexp-quote fromstring) tostring instring t t)))))
+
+;; Function `string-search' is new in Emacs 28.1.
+(defalias 'tramp-compat-string-search
+ (if (fboundp 'string-search)
+ #'string-search
+ (lambda (needle haystack &optional start-pos)
+ (let ((case-fold-search nil))
+ (string-match-p (regexp-quote needle) haystack start-pos)))))
;; Function `make-lock-file-name' is new in Emacs 28.1.
(defalias 'tramp-compat-make-lock-file-name
@@ -363,6 +382,20 @@ A nil value for either argument stands for the current
time."
".#" (file-name-nondirectory filename))
(file-name-directory filename)))))
+;; Function `file-name-concat' is new in Emacs 28.1.
+(defalias 'tramp-compat-file-name-concat
+ (if (fboundp 'file-name-concat)
+ #'file-name-concat
+ (lambda (directory &rest components)
+ (unless (null directory)
+ (let ((components (delq nil components))
+ file-name-handler-alist)
+ (if (null components)
+ directory
+ (tramp-compat-file-name-concat
+ (concat (file-name-as-directory directory) (car components))
+ (cdr components))))))))
+
(dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
(put (intern elt) 'tramp-suppress-trace t))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 022fdee..e4f54cf 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1142,7 +1142,7 @@ file names."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
+ (setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
(tramp-run-real-handler #'expand-file-name (list name nil))
@@ -1401,7 +1401,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (unless (string-match-p "/" filename)
+ (unless (tramp-compat-string-search "/" filename)
(all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
@@ -1633,8 +1633,10 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
ID-FORMAT valid values are `string' and `integer'."
(if (equal id-format 'string)
(tramp-file-name-user vec)
- (when-let
- ((localname (tramp-get-connection-property vec "default-location" nil)))
+ (when-let ((localname
+ (tramp-get-connection-property
+ (tramp-get-process vec) "share"
+ (tramp-get-connection-property vec "default-location" nil))))
(tramp-compat-file-attribute-user-id
(file-attributes
(tramp-make-tramp-file-name vec localname) id-format)))))
@@ -1642,8 +1644,10 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-gvfs-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
- (when-let
- ((localname (tramp-get-connection-property vec "default-location" nil)))
+ (when-let ((localname
+ (tramp-get-connection-property
+ (tramp-get-process vec) "share"
+ (tramp-get-connection-property vec "default-location" nil))))
(tramp-compat-file-attribute-group-id
(file-attributes
(tramp-make-tramp-file-name vec localname) id-format))))
@@ -1997,6 +2001,9 @@ a downcased host name only."
(tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint)
(tramp-set-connection-property
vec "default-location" default-location)
+ (when share
+ (tramp-set-connection-property
+ (tramp-get-process vec) "share" (concat "/" share)))
(throw 'mounted t)))))))
(defun tramp-gvfs-unmount (vec)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index f945083..a2bf0af 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -519,6 +519,7 @@ shell from reading its init file."
(tramp-yn-prompt-regexp tramp-action-yn)
(tramp-terminal-prompt-regexp tramp-action-terminal)
(tramp-antispoof-regexp tramp-action-confirm-message)
+ (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message)
(tramp-process-alive-regexp tramp-action-process-alive))
"List of pattern/action pairs.
Whenever a pattern matches, the corresponding action is performed.
@@ -536,6 +537,7 @@ corresponding PATTERN matches, the ACTION function is
called.")
'((tramp-password-prompt-regexp tramp-action-password)
(tramp-wrong-passwd-regexp tramp-action-permission-denied)
(tramp-copy-failed-regexp tramp-action-permission-denied)
+ (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message)
(tramp-process-alive-regexp tramp-action-out-of-band))
"List of pattern/action pairs.
This list is used for copying/renaming with out-of-band methods.
@@ -1738,7 +1740,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; files.
(defun tramp-sh-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (unless (string-match-p "/" filename)
+ (unless (tramp-compat-string-search "/" filename)
(all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
@@ -1855,41 +1857,53 @@ ID-FORMAT valid values are `string' and `integer'."
(dirname newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
(let ((t1 (tramp-tramp-file-p dirname))
- (t2 (tramp-tramp-file-p newname)))
+ (t2 (tramp-tramp-file-p newname))
+ target)
(with-parsed-tramp-file-name (if t1 dirname newname) nil
(unless (file-exists-p dirname)
(tramp-compat-file-missing v dirname))
- (if (and (not copy-contents)
- (tramp-get-method-parameter v 'tramp-copy-recursive)
- ;; When DIRNAME and NEWNAME are remote, they must have
- ;; the same method.
- (or (null t1) (null t2)
- (string-equal
- (tramp-file-name-method (tramp-dissect-file-name dirname))
- (tramp-file-name-method
- (tramp-dissect-file-name newname)))))
- ;; scp or rsync DTRT.
- (progn
- (when (and (file-directory-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)))
- (when (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname)))
- (unless (file-directory-p (file-name-directory newname))
+
+ ;; `copy-directory-create-symlink' exists since Emacs 28.1.
+ (if (and (bound-and-true-p copy-directory-create-symlink)
+ (setq target (file-symlink-p dirname))
+ (tramp-equal-remote dirname newname))
+ (make-symbolic-link
+ target
+ (if (directory-name-p newname)
+ (concat newname (file-name-nondirectory dirname)) newname)
+ t)
+
+ (if (and (not copy-contents)
+ (tramp-get-method-parameter v 'tramp-copy-recursive)
+ ;; When DIRNAME and NEWNAME are remote, they must
+ ;; have the same method.
+ (or (null t1) (null t2)
+ (string-equal
+ (tramp-file-name-method (tramp-dissect-file-name dirname))
+ (tramp-file-name-method
+ (tramp-dissect-file-name newname)))))
+ ;; scp or rsync DTRT.
+ (progn
+ (when (and (file-directory-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)))
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname)))
+ (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 'ok-if-already-exists keep-date))
+ (tramp-do-copy-or-rename-file-out-of-band
+ 'copy dirname newname 'ok-if-already-exists keep-date))
- ;; We must do it file-wise.
- (tramp-run-real-handler
- #'copy-directory
- (list dirname newname keep-date parents copy-contents)))
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ #'copy-directory
+ (list dirname newname keep-date parents copy-contents))))
;; When newname did exist, we have wrong cached values.
(when t2
@@ -1944,7 +1958,7 @@ file names."
(length (tramp-compat-file-attribute-size
(file-attributes (file-truename filename))))
(attributes (and preserve-extended-attributes
- (apply #'file-extended-attributes (list filename))))
+ (file-extended-attributes filename)))
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
@@ -2020,7 +2034,7 @@ file names."
;; errors, because ACL strings could be incompatible.
(when attributes
(ignore-errors
- (apply #'set-file-extended-attributes (list newname attributes))))
+ (set-file-extended-attributes newname attributes)))
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
@@ -2307,7 +2321,8 @@ The method used must be an out-of-band method."
copy-args
(tramp-compat-flatten-tree
(mapcar
- (lambda (x) (if (string-match-p " " x) (split-string x) x))
+ (lambda (x) (if (tramp-compat-string-search " " x)
+ (split-string x) x))
copy-args))
copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec)
remote-copy-program
@@ -2600,8 +2615,8 @@ The method used must be an out-of-band method."
(save-restriction
(narrow-to-region beg-marker end-marker)
;; Some busyboxes are reluctant to discard colors.
- (unless
- (string-match-p "color" (tramp-get-connection-property v "ls" ""))
+ (unless (tramp-compat-string-search
+ "color" (tramp-get-connection-property v "ls" ""))
(goto-char (point-min))
(while (re-search-forward tramp-display-escape-sequence-regexp nil
t)
(replace-match "")))
@@ -2679,7 +2694,7 @@ the result will be a local, non-Tramp, file name."
(tramp-run-real-handler #'expand-file-name (list name dir))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
+ (setq name (tramp-compat-file-name-concat dir name)))
;; If connection is not established yet, run the real handler.
(if (not (tramp-connectable-p name))
(tramp-run-real-handler #'expand-file-name (list name nil))
@@ -2749,7 +2764,8 @@ implementation will be used."
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
+ (connection-type
+ (or (plist-get args :connection-type) process-connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
@@ -2765,7 +2781,9 @@ implementation will be used."
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
- (unless (or (null connection-type) (memq connection-type '(pipe pty)))
+ (when (eq connection-type t)
+ (setq connection-type 'pty))
+ (unless (memq connection-type '(nil pipe pty))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -2826,7 +2844,7 @@ implementation will be used."
(env (dolist (elt (cons prompt process-environment) env)
(or (member
elt (default-toplevel-value 'process-environment))
- (if (string-match-p "=" elt)
+ (if (tramp-compat-string-search "=" elt)
(setq env (append env `(,elt)))
(setq uenv (cons elt uenv))))))
(env (setenv-internal
@@ -2913,6 +2931,9 @@ implementation will be used."
(setq p (tramp-get-connection-process v))
(process-put p 'remote-pid pid)
(tramp-set-connection-property p "remote-pid" pid))
+ ;; Disable carriage return to newline translation.
+ (when (memq connection-type '(nil pipe))
+ (tramp-send-command v "stty -icrnl"))
;; `tramp-maybe-open-connection' and
;; `tramp-send-command-and-read' could have
;; trashed the connection buffer. Remove this.
@@ -2955,7 +2976,7 @@ implementation will be used."
p)))
;; Save exit.
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer p nil)
(kill-buffer (current-buffer)))
@@ -3037,7 +3058,7 @@ implementation will be used."
;; We use as environment the difference to toplevel
`process-environment'.
(dolist (elt process-environment)
(or (member elt (default-toplevel-value 'process-environment))
- (if (string-match-p "=" elt)
+ (if (tramp-compat-string-search "=" elt)
(setq env (append env `(,elt)))
(setq uenv (cons elt uenv)))))
(setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)
@@ -4306,7 +4327,7 @@ process to set up. VEC specifies the connection."
;; Use MULE to select the right EOL convention for communicating
;; with the process.
(let ((cs (or (and (memq 'utf-8-hfs (coding-system-list))
- (string-match-p "^Darwin" uname)
+ (string-prefix-p "Darwin" uname)
(cons 'utf-8-hfs 'utf-8-hfs))
(and (memq 'utf-8 (coding-system-list))
(string-match-p "utf-?8" (tramp-get-remote-locale vec))
@@ -4319,7 +4340,7 @@ process to set up. VEC specifies the connection."
cs-encode (or (cdr cs) 'undecided)
cs-encode
(coding-system-change-eol-conversion
- cs-encode (if (string-match-p "^Darwin" uname) 'mac 'unix)))
+ cs-encode (if (string-prefix-p "Darwin" uname) 'mac 'unix)))
(tramp-send-command vec "(echo foo ; echo bar)" t)
(goto-char (point-min))
(when (search-forward "\r" nil t)
@@ -4369,7 +4390,7 @@ process to set up. VEC specifies the connection."
;; IRIX64 bash expands "!" even when in single quotes. This
;; destroys our shell functions, we must disable it. See
;;
<https://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
- (when (string-match-p "^IRIX64" uname)
+ (when (string-prefix-p "IRIX64" uname)
(tramp-send-command vec "set +H" t))
;; Disable tab expansion.
@@ -4625,12 +4646,12 @@ means standard output and thus the current buffer), or
nil (which
means discard it)."
(tramp-call-process
nil tramp-encoding-shell
- (when (and input (not (string-match-p "%s" cmd))) input)
+ (when (and input (not (tramp-compat-string-search "%s" cmd))) input)
(if (eq output t) t nil)
nil
tramp-encoding-command-switch
(concat
- (if (string-match-p "%s" cmd) (format cmd input) cmd)
+ (if (tramp-compat-string-search "%s" cmd) (format cmd input) cmd)
(if (stringp output) (concat " >" output) ""))))
(defconst tramp-inline-compress-commands
@@ -5220,7 +5241,7 @@ Return ATTR."
(when (stringp (car attr))
(aset (nth 8 attr) 0 ?l)))
;; Convert directory indication bit.
- (when (string-match-p "^d" (nth 8 attr))
+ (when (string-prefix-p "d" (nth 8 attr))
(setcar attr t))
;; Convert symlink from `tramp-do-file-attributes-with-stat'.
;; Decode also multibyte string.
@@ -5800,12 +5821,13 @@ function cell is returned to be applied on a buffer."
(with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-encoding vec)
(tramp-get-connection-property (tramp-get-process vec) prop nil)))
- (prop1 (if (string-match-p "encoding" prop)
+ (prop1 (if (tramp-compat-string-search "encoding" prop)
"inline-compress" "inline-decompress"))
compress)
;; The connection property might have been cached. So we must
;; send the script to the remote side - maybe.
- (when (and coding (symbolp coding) (string-match-p "remote" prop))
+ (when (and coding (symbolp coding)
+ (tramp-compat-string-search "remote" prop))
(let ((name (symbol-name coding)))
(while (string-match "-" name)
(setq name (replace-match "_" nil t name)))
@@ -5817,7 +5839,7 @@ function cell is returned to be applied on a buffer."
;; Return the value.
(cond
((and compress (symbolp coding))
- (if (string-match-p "decompress" prop1)
+ (if (tramp-compat-string-search "decompress" prop1)
`(lambda (beg end)
(,coding beg end)
(let ((coding-system-for-write 'binary)
@@ -5836,16 +5858,16 @@ function cell is returned to be applied on a buffer."
(,coding (point-min) (point-max)))))
((symbolp coding)
coding)
- ((and compress (string-match-p "decoding" prop))
+ ((and compress (tramp-compat-string-search "decoding" prop))
(format
;; Windows shells need the program file name after
;; the pipe symbol be quoted if they use forward
;; slashes as directory separators.
(cond
- ((and (string-match-p "local" prop)
+ ((and (tramp-compat-string-search "local" prop)
(eq system-type 'windows-nt))
"(%s | \"%s\")")
- ((string-match-p "local" prop) "(%s | %s)")
+ ((tramp-compat-string-search "local" prop) "(%s | %s)")
(t "(%s | %s >%%s)"))
coding compress))
(compress
@@ -5853,14 +5875,14 @@ function cell is returned to be applied on a buffer."
;; Windows shells need the program file name after
;; the pipe symbol be quoted if they use forward
;; slashes as directory separators.
- (if (and (string-match-p "local" prop)
+ (if (and (tramp-compat-string-search "local" prop)
(eq system-type 'windows-nt))
"(%s <%%s | \"%s\")"
"(%s <%%s | %s)")
compress coding))
- ((string-match-p "decoding" prop)
+ ((tramp-compat-string-search "decoding" prop)
(cond
- ((string-match-p "local" prop) (format "%s" coding))
+ ((tramp-compat-string-search "local" prop) (format "%s" coding))
(t (format "%s >%%s" coding))))
(t
(format "%s <%%s" coding)))))))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 4e4f554..5cfe874 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -414,157 +414,176 @@ arguments to pass to the OPERATION."
(defun tramp-smb-handle-copy-directory
(dirname newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
- (if copy-contents
- ;; We must do it file-wise.
- (tramp-run-real-handler
- #'copy-directory (list dirname newname keep-date parents copy-contents))
-
- (setq dirname (expand-file-name dirname)
- newname (expand-file-name newname))
- (let ((t1 (tramp-tramp-file-p dirname))
- (t2 (tramp-tramp-file-p newname)))
- (with-parsed-tramp-file-name (if t1 dirname newname) nil
- (with-tramp-progress-reporter
- v 0 (format "Copying %s to %s" dirname newname)
- (unless (file-exists-p dirname)
- (tramp-compat-file-missing v dirname))
- (when (and (file-directory-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 (tramp-compat-make-temp-name)))
- (unwind-protect
- (progn
- (make-directory tmpdir)
- (copy-directory
- dirname (file-name-as-directory tmpdir) keep-date 'parents)
- (copy-directory
- (expand-file-name (file-name-nondirectory dirname) tmpdir)
- newname keep-date parents))
- (delete-directory tmpdir 'recursive))))
-
- ;; We can copy recursively.
- ;; TODO: Does not work reliably.
- (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
+ (let ((t1 (tramp-tramp-file-p dirname))
+ (t2 (tramp-tramp-file-p newname))
+ target)
+ (with-parsed-tramp-file-name (if t1 dirname newname) nil
+ (unless (file-exists-p dirname)
+ (tramp-compat-file-missing v dirname))
+
+ ;; `copy-directory-create-symlink' exists since Emacs 28.1.
+ (if (and (bound-and-true-p copy-directory-create-symlink)
+ (setq target (file-symlink-p dirname))
+ (tramp-equal-remote dirname newname))
+ (make-symbolic-link
+ target
+ (if (directory-name-p newname)
+ (concat newname (file-name-nondirectory dirname)) newname)
+ t)
+
+ (if copy-contents
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ #'copy-directory
+ (list dirname newname keep-date parents copy-contents))
+
+ (setq dirname (expand-file-name dirname)
+ newname (expand-file-name newname))
+ (with-tramp-progress-reporter
+ v 0 (format "Copying %s to %s" dirname newname)
+ (unless (file-exists-p dirname)
+ (tramp-compat-file-missing v dirname))
(when (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname))
- (if t2 (setq v (tramp-dissect-file-name newname))))
- (if (not (file-directory-p newname))
- (make-directory newname parents))
-
- (let* ((share (tramp-smb-get-share v))
- (localname (file-name-as-directory
- (tramp-compat-string-replace
- "\\" "/" (tramp-smb-get-localname v))))
- (tmpdir (tramp-compat-make-temp-name))
- (args (list (concat "//" host "/" share) "-E"))
- (options tramp-smb-options))
-
- (if (not (zerop (length user)))
- (setq args (append args (list "-U" user)))
- (setq args (append args (list "-N"))))
-
- (when domain (setq args (append args (list "-W" domain))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (while options
+ (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 (tramp-compat-make-temp-name)))
+ (unwind-protect
+ (progn
+ (make-directory tmpdir)
+ (copy-directory
+ dirname (file-name-as-directory tmpdir)
+ keep-date 'parents)
+ (copy-directory
+ (expand-file-name (file-name-nondirectory dirname)
tmpdir)
+ newname keep-date parents))
+ (delete-directory tmpdir 'recursive))))
+
+ ;; We can copy recursively.
+ ;; TODO: Does not work reliably.
+ (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname))
+ (if t2 (setq v (tramp-dissect-file-name newname))))
+ (if (not (file-directory-p newname))
+ (make-directory newname parents))
+
+ (let* ((share (tramp-smb-get-share v))
+ (localname (file-name-as-directory
+ (tramp-compat-string-replace
+ "\\" "/" (tramp-smb-get-localname v))))
+ (tmpdir (tramp-compat-make-temp-name))
+ (args (list (concat "//" host "/" share) "-E"))
+ (options tramp-smb-options))
+
+ (if (not (zerop (length user)))
+ (setq args (append args (list "-U" user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (while options
+ (setq args
+ (append args `("--option" ,(format "%s" (car options))))
+ options (cdr options)))
(setq args
- (append args `("--option" ,(format "%s" (car options))))
- options (cdr options)))
- (setq args
- (if t1
- ;; Source is remote.
- (append args
+ (if t1
+ ;; Source is remote.
+ (append args
+ (list "-D" (tramp-unquote-shell-quote-argument
+ localname)
+ "-c" (tramp-unquote-shell-quote-argument
+ "tar qc - *")
+ "|" "tar" "xfC" "-"
+ (tramp-unquote-shell-quote-argument
+ tmpdir)))
+ ;; Target is remote.
+ (append (list
+ "tar" "cfC" "-"
+ (tramp-unquote-shell-quote-argument dirname)
+ "." "|")
+ args
(list "-D" (tramp-unquote-shell-quote-argument
localname)
"-c" (tramp-unquote-shell-quote-argument
- "tar qc - *")
- "|" "tar" "xfC" "-"
- (tramp-unquote-shell-quote-argument
- tmpdir)))
- ;; Target is remote.
- (append (list "tar" "cfC" "-"
- (tramp-unquote-shell-quote-argument dirname)
- "." "|")
- args
- (list "-D" (tramp-unquote-shell-quote-argument
- localname)
- "-c" (tramp-unquote-shell-quote-argument
- "tar qx -")))))
-
- (unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- (when t1
- ;; The smbclient tar command creates always
- ;; complete paths. We must emulate the
- ;; directory structure, and symlink to the real
- ;; target.
- (make-directory
- (expand-file-name
- ".." (concat tmpdir localname))
- 'parents)
- (make-symbolic-link
- newname (directory-file-name (concat tmpdir localname))))
-
- ;; Use an asynchronous processes. By this,
- ;; password can be handled.
- (let* ((default-directory tmpdir)
- (p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-program args)))
-
- (tramp-message
- v 6 "%s" (string-join (process-command p) " "))
- (process-put p 'vector v)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-with-tar)
-
- (while (process-live-p p)
- (sleep-for 0.1))
- (tramp-message v 6 "\n%s" (buffer-string))))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- (when t1 (delete-directory tmpdir 'recursive))))
-
- ;; Handle KEEP-DATE argument.
- (when keep-date
- (tramp-compat-set-file-times
- newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes dirname))
- (unless ok-if-already-exists 'nofollow)))
-
- ;; Set the mode.
- (unless keep-date
- (set-file-modes newname (tramp-default-file-modes dirname)))
-
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-properties v localname))))
-
- ;; We must do it file-wise.
- (t
- (tramp-run-real-handler
- #'copy-directory (list dirname newname keep-date parents)))))))))
+ "tar qx -")))))
+
+ (unwind-protect
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ (when t1
+ ;; The smbclient tar command creates always
+ ;; complete paths. We must emulate the
+ ;; directory structure, and symlink to the
+ ;; real target.
+ (make-directory
+ (expand-file-name
+ ".." (concat tmpdir localname))
+ 'parents)
+ (make-symbolic-link
+ newname
+ (directory-file-name (concat tmpdir localname))))
+
+ ;; Use an asynchronous processes. By this,
+ ;; password can be handled.
+ (let* ((default-directory tmpdir)
+ (p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-program args)))
+
+ (tramp-message
+ v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions
+ p v nil tramp-smb-actions-with-tar)
+
+ (while (process-live-p p)
+ (sleep-for 0.1))
+ (tramp-message v 6 "\n%s" (buffer-string))))
+
+ ;; Reset the transfer process properties.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")
+ (when t1 (delete-directory tmpdir 'recursive))))
+
+ ;; Handle KEEP-DATE argument.
+ (when keep-date
+ (tramp-compat-set-file-times
+ newname
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes dirname))
+ (unless ok-if-already-exists 'nofollow)))
+
+ ;; Set the mode.
+ (unless keep-date
+ (set-file-modes newname (tramp-default-file-modes dirname)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v localname))))
+
+ ;; We must do it file-wise.
+ (t
+ (tramp-run-real-handler
+ #'copy-directory (list dirname newname keep-date
parents))))))))))
(defun tramp-smb-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -722,7 +741,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
+ (setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
(tramp-run-real-handler #'expand-file-name (list name nil))
@@ -849,7 +868,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Check result.
(when entry
- (list (and (string-match-p "d" (nth 1 entry))
+ (list (and (tramp-compat-string-search "d" (nth 1 entry))
t) ;0 file type
-1 ;1 link count
uid ;2 uid
@@ -982,7 +1001,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(mapcar
(lambda (x)
(list
- (if (string-match-p "d" (nth 1 x))
+ (if (tramp-compat-string-search "d" (nth 1 x))
(file-name-as-directory (nth 0 x))
(nth 0 x))))
(tramp-smb-get-file-entries directory)))))))
@@ -1021,7 +1040,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(defun tramp-smb-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
(if (file-exists-p filename)
- (string-match-p
+ (tramp-compat-string-search
"w"
(or (tramp-compat-file-attribute-modes (file-attributes filename)) ""))
(let ((dir (file-name-directory filename)))
@@ -1076,9 +1095,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Check for matching entries.
(mapcar
(lambda (x)
- (when (string-match-p
- (format "^%s" base) (nth 0 x))
- x))
+ (when (string-match-p (format "^%s" base) (nth 0 x)) x))
entries)
;; We just need the only and only entry FILENAME.
(list (assoc base entries)))))
@@ -1088,14 +1105,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(sort
entries
(lambda (x y)
- (if (string-match-p "t" switches)
+ (if (tramp-compat-string-search "t" switches)
;; Sort by date.
(time-less-p (nth 3 y) (nth 3 x))
;; Sort by name.
(string-lessp (nth 0 x) (nth 0 y))))))
;; Handle "-F" switch.
- (when (string-match-p "F" switches)
+ (when (tramp-compat-string-search "F" switches)
(mapc
(lambda (x)
(unless (zerop (length (car x)))
@@ -1124,7 +1141,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(expand-file-name
(nth 0 x) (file-name-directory filename))
'string)))))
- (when (string-match-p "l" switches)
+ (when (tramp-compat-string-search "l" switches)
(insert
(format
"%10s %3d %-8s %-8s %8s %s "
@@ -1153,7 +1170,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(put-text-property start (point) 'dired-filename t))
;; Insert symlink.
- (when (and (string-match-p "l" switches)
+ (when (and (tramp-compat-string-search "l" switches)
(stringp (tramp-compat-file-attribute-type attr)))
(insert " -> " (tramp-compat-file-attribute-type attr))))
@@ -1551,7 +1568,7 @@ component is used as the target of the symlink."
;; Save exit.
(with-current-buffer (tramp-get-connection-buffer v)
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (if (tramp-compat-string-search tramp-temp-buffer-name (buffer-name))
(progn
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
@@ -1857,10 +1874,12 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
mode (or (match-string 1 line) "")
mode (format
"%s%s"
- (if (string-match-p "D" mode) "d" "-")
+ (if (tramp-compat-string-search "D" mode) "d" "-")
(mapconcat
(lambda (_x) "") " "
- (concat "r" (if (string-match-p "R" mode) "-" "w") "x")))
+ (format
+ "r%sx"
+ (if (tramp-compat-string-search "R" mode) "-" "w"))))
line (substring line 0 -6))
(cl-return))
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 45d9fab..5895f1d 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -237,7 +237,7 @@ absolute file names."
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename))
(attributes (and preserve-extended-attributes
- (apply #'file-extended-attributes (list filename))))
+ (file-extended-attributes filename)))
(sudoedit-operation
(cond
((and (eq op 'copy) preserve-uid-gid) '("cp" "-f" "-p"))
@@ -293,7 +293,7 @@ absolute file names."
;; errors, because ACL strings could be incompatible.
(when attributes
(ignore-errors
- (apply #'set-file-extended-attributes (list newname attributes))))
+ (set-file-extended-attributes newname attributes)))
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
@@ -353,7 +353,7 @@ the result will be a local, non-Tramp, file name."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
+ (setq name (tramp-compat-file-name-concat dir name)))
(with-parsed-tramp-file-name name nil
;; Tilde expansion if necessary. We cannot accept "~/", because
;; under sudo "~/" is expanded to the local user home directory
@@ -726,13 +726,14 @@ ID-FORMAT valid values are `string' and `integer'."
(file-attributes filename 'integer))
(tramp-get-remote-gid v 'integer)))
(flag (and (eq mustbenew 'excl) 'nofollow))
- (modes (tramp-default-file-modes filename flag)))
+ (modes (tramp-default-file-modes filename flag))
+ (attributes (file-extended-attributes filename)))
(prog1
(tramp-handle-write-region
start end filename append visit lockname mustbenew)
- ;; Set the ownership and modes. This is not performed in
- ;; `tramp-handle-write-region'.
+ ;; Set the ownership, modes and extended attributes. This is
+ ;; not performed in `tramp-handle-write-region'.
(unless (and (= (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
uid)
@@ -740,7 +741,12 @@ ID-FORMAT valid values are `string' and `integer'."
(file-attributes filename 'integer))
gid))
(tramp-set-file-uid-gid filename uid gid))
- (tramp-compat-set-file-modes filename modes flag)))))
+ (tramp-compat-set-file-modes filename modes flag)
+ ;; We ignore possible errors, because ACL strings could be
+ ;; incompatible.
+ (when attributes
+ (ignore-errors
+ (set-file-extended-attributes filename attributes)))))))
;; Internal functions.
@@ -811,6 +817,9 @@ in case of error, t otherwise."
(tramp-compat-flatten-tree args))))
;; We suppress the messages `Waiting for prompts from remote shell'.
(tramp-verbose (if (= tramp-verbose 3) 2 tramp-verbose))
+ ;; The password shall be cached also in case of "emacs -Q".
+ ;; See `tramp-process-actions'.
+ (tramp-cache-read-persistent-data t)
;; We do not want to save the password.
auth-source-save-behavior)
(tramp-message vec 6 "%s" (string-join (process-command p) " "))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 093335a..9ed9da9 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -586,8 +586,7 @@ Sometimes the prompt is reported to look like \"login
as:\"."
(defcustom tramp-shell-prompt-pattern
;; Allow a prompt to start right after a ^M since it indeed would be
- ;; displayed at the beginning of the line (and Zsh uses it). This
- ;; regexp works only for GNU Emacs.
+ ;; displayed at the beginning of the line (and Zsh uses it).
;; Allow also [] style prompts. They can appear only during
;; connection initialization; Tramp redefines the prompt afterwards.
(concat "\\(?:^\\|\r\\)"
@@ -698,6 +697,30 @@ The regexp should match at end of buffer."
:version "27.1"
:type 'regexp)
+;; A security key requires the user physically to touch the device
+;; with their finger. We must tell it to the user.
+;; Added in OpenSSH 8.2. I've tested it with yubikey.
+(defcustom tramp-security-key-confirm-regexp
+ "^\r*Confirm user presence for key .*[\r\n]*"
+ "Regular expression matching security key confirmation message.
+The regexp should match at end of buffer."
+ :version "28.1"
+ :type 'regexp)
+
+(defcustom tramp-security-key-confirmed-regexp
+ "^\r*User presence confirmed[\r\n]*"
+ "Regular expression matching security key confirmation message.
+The regexp should match at end of buffer."
+ :version "28.1"
+ :type 'regexp)
+
+(defcustom tramp-security-key-timeout-regexp
+ "^\r*sign_and_send_pubkey: signing failed for .*[\r\n]*"
+ "Regular expression matching security key timeout message.
+The regexp should match at end of buffer."
+ :version "28.1"
+ :type 'regexp)
+
(defcustom tramp-operation-not-permitted-regexp
(concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
(regexp-opt '("Operation not permitted") t))
@@ -1248,14 +1271,14 @@ this variable to be set as well."
:type '(choice (const nil) integer))
;; Logging in to a remote host normally requires obtaining a pty. But
-;; Emacs on macOS has process-connection-type set to nil by default,
+;; Emacs on macOS has `process-connection-type' set to nil by default,
;; so on those systems Tramp doesn't obtain a pty. Here, we allow
;; for an override of the system default.
(defcustom tramp-process-connection-type t
"Overrides `process-connection-type' for connections from Tramp.
Tramp binds `process-connection-type' to the value given here before
opening a connection to a remote host."
- :type '(choice (const nil) (const t) (const pty)))
+ :type '(choice (const nil) (const t) (const pipe) (const pty)))
(defcustom tramp-connection-timeout 60
"Defines the max time to wait for establishing a connection (in seconds).
@@ -1609,7 +1632,8 @@ default values are used."
(setq v (tramp-dissect-hop-name hop)
hop (and hop (tramp-make-tramp-hop-name v))))
(let ((tramp-default-host
- (or (and v (not (string-match-p "%h" (tramp-file-name-host v)))
+ (or (and v (not (tramp-compat-string-search
+ "%h" (tramp-file-name-host v)))
(tramp-file-name-host v))
tramp-default-host)))
(setq method (tramp-find-method method user host)
@@ -1905,7 +1929,7 @@ The outline level is equal to the verbosity of the Tramp
message."
(put #'tramp-trace-buffer-name 'tramp-suppress-trace t)
(defvar tramp-trace-functions nil
- "A list of non-Tramp functions to be trace with tramp-verbose > 10.")
+ "A list of non-Tramp functions to be traced with tramp-verbose > 10.")
(defun tramp-debug-message (vec fmt-string &rest arguments)
"Append message to debug buffer of VEC.
@@ -1957,7 +1981,7 @@ ARGUMENTS to actually emit the message (if applicable)."
(if (not btf)
(setq fn "")
(and (symbolp btf) (setq fn (symbol-name btf))
- (or (not (string-match-p "^tramp" fn))
+ (or (not (string-prefix-p "tramp" fn))
(get btf 'tramp-suppress-trace))
(setq fn nil))
(setq btn (1+ btn))))
@@ -2209,7 +2233,7 @@ If VAR is nil, then we bind `v' to the structure and
`method', `user',
"Report progress of an operation for Tramp."
(let* ((parameters (cdr reporter))
(message (aref parameters 3)))
- (when (string-match-p message (or (current-message) ""))
+ (when (tramp-compat-string-search message (or (current-message) ""))
(tramp-compat-progress-reporter-update reporter value suffix))))
(defmacro with-tramp-progress-reporter (vec level message &rest body)
@@ -2323,7 +2347,7 @@ Example:
(unless (and (functionp (nth 0 (car v)))
(cond
;; Windows registry.
- ((string-match-p "^HKEY_CURRENT_USER" (nth 1 (car v)))
+ ((string-prefix-p "HKEY_CURRENT_USER" (nth 1 (car v)))
(and (memq system-type '(cygwin windows-nt))
(zerop
(tramp-call-process
@@ -2982,8 +3006,7 @@ remote host and localname (filename on remote host)."
"Return all method completions for PARTIAL-METHOD."
(mapcar
(lambda (method)
- (and method
- (string-match-p (concat "^" (regexp-quote partial-method)) method)
+ (and method (string-prefix-p partial-method method)
(tramp-completion-make-tramp-file-name method nil nil nil)))
(mapcar #'car tramp-methods)))
@@ -2995,8 +3018,7 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match
HOST."
(cond
((and partial-user partial-host)
- (if (and host
- (string-match-p (concat "^" (regexp-quote partial-host)) host)
+ (if (and host (string-prefix-p partial-host host)
(string-equal partial-user (or user partial-user)))
(setq user partial-user)
(setq user nil
@@ -3004,16 +3026,12 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match
HOST."
(partial-user
(setq host nil)
- (unless
- (and user
- (string-match-p (concat "^" (regexp-quote partial-user)) user))
+ (unless (and user (string-prefix-p partial-user user))
(setq user nil)))
(partial-host
(setq user nil)
- (unless
- (and host
- (string-match-p (concat "^" (regexp-quote partial-host)) host))
+ (unless (and host (string-prefix-p partial-host host))
(setq host nil)))
(t (setq user nil
@@ -3337,7 +3355,7 @@ User is always nil."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
+ (setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
(tramp-run-real-handler #'expand-file-name (list name nil))
@@ -3657,6 +3675,7 @@ User is always nil."
#'find-backup-file-name (list filename)))
;; Protect against security hole.
(when (and (not tramp-allow-unsafe-temporary-files)
+ (not backup-inhibited)
(file-in-directory-p (car result) temporary-file-directory)
(zerop (or (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
@@ -3690,7 +3709,7 @@ User is always nil."
(list filename switches wildcard full-directory-p))
;; `ls-lisp' always returns full listings. We must remove
;; superfluous parts.
- (unless (string-match-p "l" switches)
+ (unless (tramp-compat-string-search "l" switches)
(save-excursion
(goto-char (point-min))
(while (setq start
@@ -3877,6 +3896,7 @@ Return nil when there is no lockfile."
;; Protect against security hole.
(with-parsed-tramp-file-name file nil
(when (and (not tramp-allow-unsafe-temporary-files)
+ create-lockfiles
(file-in-directory-p lockname temporary-file-directory)
(zerop (or (tramp-compat-file-attribute-user-id
(file-attributes file 'integer))
@@ -4080,7 +4100,8 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
+ (connection-type
+ (or (plist-get args :connection-type) process-connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
@@ -4096,7 +4117,9 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(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)))
+ (when (eq connection-type t)
+ (setq connection-type 'pty))
+ (unless (memq connection-type '(nil pipe pty))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -4112,14 +4135,14 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(generate-new-buffer tramp-temp-buffer-name)))
(env (mapcar
(lambda (elt)
- (when (string-match-p "=" elt) elt))
+ (when (tramp-compat-string-search "=" elt) elt))
tramp-remote-process-environment))
;; We use as environment the difference to toplevel
;; `process-environment'.
(env (dolist (elt process-environment env)
(when
(and
- (string-match-p "=" elt)
+ (tramp-compat-string-search "=" elt)
(not
(member
elt (default-toplevel-value
'process-environment))))
@@ -4579,6 +4602,9 @@ of."
;; prompts from the remote host. See the variable
;; `tramp-actions-before-shell' for usage of these functions.
+(defvar tramp-process-action-regexp nil
+ "The regexp used to invoke an action in `tramp-process-one-action'.")
+
(defun tramp-action-login (_proc vec)
"Send the login name."
(let ((user (or (tramp-file-name-user vec)
@@ -4604,7 +4630,7 @@ of."
(unless (tramp-get-connection-property vec "first-password-request" nil)
(tramp-clear-passwd vec))
(goto-char (point-min))
- (tramp-check-for-regexp proc tramp-password-prompt-regexp)
+ (tramp-check-for-regexp proc tramp-process-action-regexp)
(tramp-message vec 3 "Sending %s" (match-string 1))
;; We don't call `tramp-send-string' in order to hide the
;; password from the debug buffer and the traces.
@@ -4669,6 +4695,31 @@ The terminal type can be configured with
`tramp-terminal-type'."
(tramp-send-string vec tramp-local-end-of-line)
t)
+(defun tramp-action-show-and-confirm-message (proc vec)
+ "Show the user a message for confirmation.
+Wait, until the connection buffer changes."
+ (with-current-buffer (process-buffer proc)
+ (let ((stimers (with-timeout-suspend))
+ (cursor-in-echo-area t)
+ set-message-function clear-message-function)
+ ;; Silence byte compiler.
+ (ignore set-message-function clear-message-function)
+ (tramp-message vec 6 "\n%s" (buffer-string))
+ (tramp-check-for-regexp proc tramp-process-action-regexp)
+ (with-temp-message (replace-regexp-in-string "[\r\n]" "" (match-string
0))
+ ;; Hide message in buffer.
+ (narrow-to-region (point-max) (point-max))
+ ;; Wait for new output.
+ (while (not (tramp-compat-ignore-error 'file-error
+ (tramp-wait-for-regexp
+ proc 0.1 tramp-security-key-confirmed-regexp)))
+ (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp)
+ (throw 'tramp-action 'timeout))
+ (redisplay 'force)))
+ ;; Reenable the timers.
+ (with-timeout-unsuspend stimers)))
+ t)
+
(defun tramp-action-process-alive (proc _vec)
"Check, whether a process has finished."
(unless (process-live-p proc)
@@ -4706,6 +4757,7 @@ The terminal type can be configured with
`tramp-terminal-type'."
"Wait for output from the shell and perform one action.
See `tramp-process-actions' for the format of ACTIONS."
(let ((case-fold-search t)
+ tramp-process-action-regexp
found todo item pattern action)
(while (not found)
;; Reread output once all actions have been performed.
@@ -4714,7 +4766,8 @@ See `tramp-process-actions' for the format of ACTIONS."
(setq todo actions)
(while todo
(setq item (pop todo)
- pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item)))
+ tramp-process-action-regexp (symbol-value (nth 0 item))
+ pattern (format "\\(%s\\)\\'" tramp-process-action-regexp)
action (nth 1 item))
(tramp-message
vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
@@ -5366,7 +5419,8 @@ this file, if that variable is non-nil."
;; Create directory.
(unless (or (null tramp-auto-save-directory)
(file-exists-p tramp-auto-save-directory))
- (make-directory tramp-auto-save-directory t))
+ (make-directory tramp-auto-save-directory t)
+ (set-file-modes tramp-auto-save-directory #o0700))
(let ((system-type
(if (and (stringp tramp-auto-save-directory)
@@ -5395,6 +5449,7 @@ this file, if that variable is non-nil."
(setq result (tramp-run-real-handler #'make-auto-save-file-name nil))
;; Protect against security hole.
(when (and (not tramp-allow-unsafe-temporary-files)
+ auto-save-default
(file-in-directory-p result temporary-file-directory)
(zerop (or (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
@@ -5536,6 +5591,9 @@ verbosity of 6."
(string-prefix-p comm process-name)
(throw 'result t)))))))
+;; When calling "emacs -Q", `auth-source-search' won't be called. If
+;; you want to debug exactly this case, call "emacs -Q --eval '(setq
+;; tramp-cache-read-persistent-data t)'" instead.
(defun tramp-read-passwd (proc &optional prompt)
"Read a password from user (compat function).
Consults the auth-source package.
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index e6cf4c6..8ad641e 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.5.1
+;; Version: 2.5.2-pre
;; Package-Requires: ((emacs "25.1"))
;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/
@@ -40,7 +40,7 @@
;; ./configure" to change them.
;;;###tramp-autoload
-(defconst tramp-version "2.5.1"
+(defconst tramp-version "2.5.2-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -76,7 +76,7 @@
;; Check for Emacs version.
(let ((x (if (not (string-lessp emacs-version "25.1"))
"ok"
- (format "Tramp 2.5.1 is not fit for %s"
+ (format "Tramp 2.5.2-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index 57a52ef..b458f03 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -932,7 +932,8 @@ This function is the default value of
`uncomment-region-function'."
(setq end (copy-marker end))
(let* ((numarg (prefix-numeric-value arg))
(ccs comment-continue)
- (srei (comment-padright ccs 're))
+ (srei (or (comment-padright ccs 're)
+ (and (stringp comment-continue) comment-continue)))
(csre (comment-padright comment-start 're))
(sre (and srei (concat "^\\s-*?\\(" srei "\\)")))
spt)
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index 1bc905c..405f803 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -540,6 +540,8 @@ Many aspects this mode can be customized using
(nxml-scan-prolog)))))
(setq-local syntax-ppss-table sgml-tag-syntax-table)
(setq-local syntax-propertize-function #'nxml-syntax-propertize)
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'nxml--buffer-substring-filter)
(add-hook 'change-major-mode-hook #'nxml-cleanup nil t)
(when (not (and (buffer-file-name) (file-exists-p (buffer-file-name))))
@@ -564,6 +566,15 @@ Many aspects this mode can be customized using
(with-demoted-errors (rng-nxml-mode-init)))
+(defun nxml--buffer-substring-filter (string)
+ ;; The `rng-state' property is huge, so don't copy it to the kill ring.
+ ;; This avoids problems when saving the kill ring with savehist.
+ (when (seq-find (lambda (elem)
+ (plist-get (nth 2 elem) 'rng-state))
+ (object-intervals string))
+ (remove-text-properties 0 (length string) '(rng-state nil) string))
+ string)
+
(defun nxml-cleanup ()
"Clean up after nxml-mode."
;; Disable associated minor modes.
diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el
index 6dca34a..c265b19 100644
--- a/lisp/nxml/nxml-outln.el
+++ b/lisp/nxml/nxml-outln.el
@@ -633,7 +633,7 @@ non-transparent child section."
tag-qnames))))
(defun nxml-highlighted-qname (qname)
- (let ((colon (string-match ":" qname)))
+ (let ((colon (string-search ":" qname)))
(if colon
(concat (propertize (substring qname 0 colon)
'face
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el
index 1314ade..dd30007 100644
--- a/lisp/nxml/rng-cmpct.el
+++ b/lisp/nxml/rng-cmpct.el
@@ -100,7 +100,7 @@ Return a pattern."
"Regular expression to match a single-quoted literal.")
(defconst rng-c-literal-2-re
- (replace-regexp-in-string "'" "\"" rng-c-literal-1-re)
+ (string-replace "'" "\"" rng-c-literal-1-re)
"Regular expression to match a double-quoted literal.")
(defconst rng-c-ncname-re "\\w+")
@@ -179,7 +179,7 @@ Return a pattern."
(setq rng-c-default-namespace rng-c-inherit-namespace)))
(defun rng-c-expand-name (prefixed-name)
- (let ((i (string-match ":" prefixed-name)))
+ (let ((i (string-search ":" prefixed-name)))
(rng-make-name (rng-c-lookup-prefix (substring prefixed-name
0
i))
@@ -222,7 +222,7 @@ and URI is a symbol.")
(cdr binding)))
(defun rng-c-expand-datatype (prefixed-name)
- (let ((i (string-match ":" prefixed-name)))
+ (let ((i (string-search ":" prefixed-name)))
(rng-make-datatype
(rng-c-lookup-datatype-prefix (substring prefixed-name 0 i))
(substring prefixed-name (+ i 1)))))
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index fda481f..24f4d2e 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -93,7 +93,7 @@ Signal an error if URI is not a valid file URL."
(rng-uri-error "`?' not escaped in file URI `%s'" uri))
(when fragment-id
(rng-uri-error "URI `%s' has a fragment identifier" uri))
- (when (string-match ";" path)
+ (when (string-search ";" path)
(rng-uri-error "`;' not escaped in URI `%s'" uri))
(when (string-match "%2[fF]" path) ;; 2f is hex code of slash
(rng-uri-error "Escaped slash in URI `%s'" uri))
@@ -110,7 +110,7 @@ Signal an error if URI is not a valid file URL."
(rng-uri-unescape-unibyte-replace path 2))
(t
(rng-uri-unescape-unibyte path))))
- (when (string-match "\000" path)
+ (when (string-search "\000" path)
(rng-uri-error "URI `%s' has NUL character in path" uri))
(when (eq pattern 'match)
(setq path
diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el
index 9824eeb..38bc2e1 100644
--- a/lisp/nxml/xmltok.el
+++ b/lisp/nxml/xmltok.el
@@ -479,7 +479,7 @@ and VALUE-END, otherwise a STRING giving the value."
"[^<'&\r\n\t]*"
(xmltok-g complex1 "[&\r\n\t][^<']*") opt
"'"))
- (lit2 (cons (replace-regexp-in-string "'" "\"" (car lit1))
+ (lit2 (cons (string-replace "'" "\"" (car lit1))
'(complex2)))
(literal (xmltok-g literal lit1 or lit2))
(name (xmltok+ open (xmltok-g xmlns "xmlns") or ncname close
diff --git a/lisp/obsolete/cl.el b/lisp/obsolete/cl.el
index 09f9ab7..9df6231 100644
--- a/lisp/obsolete/cl.el
+++ b/lisp/obsolete/cl.el
@@ -431,8 +431,7 @@ definitions, or lack thereof).
(obsolete "use either `cl-flet' or `cl-letf'." "24.3"))
`(letf ,(mapcar
(lambda (x)
- (if (or (and (fboundp (car x))
- (eq (car-safe (symbol-function (car x))) 'macro))
+ (if (or (eq (car-safe (symbol-function (car x))) 'macro)
(cdr (assq (car x) macroexpand-all-environment)))
(error "Use `labels', not `flet', to rebind macro names"))
(let ((func `(cl-function
@@ -466,10 +465,10 @@ rather than relying on `lexical-binding'."
(push `(cl-function (lambda . ,(cdr binding))) sets)
(push var sets)
(push (cons (car binding)
- `(lambda (&rest cl-labels-args)
- (if (eq (car cl-labels-args) cl--labels-magic)
- (list cl--labels-magic ',var)
- (cl-list* 'funcall ',var cl-labels-args))))
+ (lambda (&rest cl-labels-args)
+ (if (eq (car cl-labels-args) cl--labels-magic)
+ (list cl--labels-magic var)
+ (cl-list* 'funcall var cl-labels-args))))
newenv)))
;; `lexical-let' adds `cl--function-convert' (which calls
;; `cl--labels-convert') as a macroexpander for `function'.
diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el
index 1c1167d..2d3be2d 100644
--- a/lisp/obsolete/complete.el
+++ b/lisp/obsolete/complete.el
@@ -243,7 +243,7 @@ second TAB brings up the `*Completions*' buffer."
(when (and partial-completion-mode (null PC-env-vars-alist))
(setq PC-env-vars-alist
(mapcar (lambda (string)
- (let ((d (string-match "=" string)))
+ (let ((d (string-search "=" string)))
(cons (concat "$" (substring string 0 d))
(and d (substring string (1+ d))))))
process-environment))))
@@ -575,7 +575,7 @@ GOTO-END is non-nil, however, it instead replaces up to
END."
p (+ p (length PC-ndelims-regex) 1)))))
(setq p 0)
(if filename
- (while (setq p (string-match "\\\\\\*" regex p))
+ (while (setq p (string-search "\\*" regex p))
(setq regex (concat (substring regex 0 p)
"[^/]*"
(substring regex (+ p 2))))))
diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el
index 9676d6b..9bf6845 100644
--- a/lisp/obsolete/longlines.el
+++ b/lisp/obsolete/longlines.el
@@ -393,11 +393,11 @@ compatibility with `format-alist', and is ignored."
"Return a copy of STRING with each soft newline replaced by a space.
Hard newlines are left intact."
(let* ((str (copy-sequence string))
- (pos (string-match "\n" str)))
+ (pos (string-search "\n" str)))
(while pos
(if (null (get-text-property pos 'hard str))
(aset str pos ? ))
- (setq pos (string-match "\n" str (1+ pos))))
+ (setq pos (string-search "\n" str (1+ pos))))
str))
;;; Auto wrap
diff --git a/lisp/obsolete/nnir.el b/lisp/obsolete/nnir.el
index 40a8ec5..9aab1e7 100644
--- a/lisp/obsolete/nnir.el
+++ b/lisp/obsolete/nnir.el
@@ -509,7 +509,7 @@ construct the vector entries."
(vector (gnus-group-full-name group server)
(if (string-match "\\`nnmaildir:" (gnus-group-server server))
(nnmaildir-base-name-to-article-number
- (substring article 0 (string-match ":" article))
+ (substring article 0 (string-search ":" article))
group nil)
(string-to-number article))
(string-to-number score)))))
@@ -920,10 +920,10 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
;; eliminate all ".", "/", "\" from beginning. Always matches.
(string-match "^[./\\]*\\(.*\\)$" dirnam)
;; "/" -> "."
- (setq group (replace-regexp-in-string
+ (setq group (string-replace
"/" "." (match-string 1 dirnam)))
;; Windows "\\" -> "."
- (setq group (replace-regexp-in-string "\\\\" "." group))
+ (setq group (string-replace "\\" "." group))
(push (vector (gnus-group-full-name group server)
(string-to-number artno)
@@ -996,7 +996,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
(when (string-match prefix dirnam)
(setq dirnam (replace-match "" t t dirnam)))
(push (vector (gnus-group-full-name
- (replace-regexp-in-string "/" "." dirnam) server)
+ (string-replace "/" "." dirnam) server)
(string-to-number artno)
(string-to-number score))
artlist))
@@ -1205,9 +1205,9 @@ construct path: search terms (see the variable
group
(if (file-directory-p
(setq group
- (replace-regexp-in-string
- "\\." "/"
- group nil t)))
+ (string-replace
+ "." "/"
+ group)))
group))))))
(unless group
(error "Cannot locate directory for group"))
diff --git a/lisp/mail/rfc2368.el b/lisp/obsolete/rfc2368.el
similarity index 98%
rename from lisp/mail/rfc2368.el
rename to lisp/obsolete/rfc2368.el
index 553f3cc..8a842b0 100644
--- a/lisp/mail/rfc2368.el
+++ b/lisp/obsolete/rfc2368.el
@@ -4,6 +4,7 @@
;; Author: Sen Nagata <sen@eccosys.com>
;; Keywords: mail
+;; Obsolete-since: 28.1
;; This file is part of GNU Emacs.
@@ -91,7 +92,7 @@ Note: make sure MAILTO-URL has been \"unhtmlized\" (e.g.,
& -> &), before
calling this function."
(let ((case-fold-search t)
prequery query headers-alist)
- (setq mailto-url (replace-regexp-in-string "\n" " " mailto-url))
+ (setq mailto-url (string-replace "\n" " " mailto-url))
(if (string-match rfc2368-mailto-regexp mailto-url)
(progn
(setq prequery
diff --git a/lisp/obsolete/terminal.el b/lisp/obsolete/terminal.el
index dbfc79b..fa89b58 100644
--- a/lisp/obsolete/terminal.el
+++ b/lisp/obsolete/terminal.el
@@ -112,10 +112,9 @@ performance."
nil
(let ((map (make-sparse-keymap)))
(define-key map [t] #'undefined)
- (let ((s "0"))
- (while (<= (aref s 0) ?9)
- (define-key map s #'digit-argument)
- (aset s 0 (1+ (aref s 0)))))
+ (dotimes (i 10)
+ (let ((s (make-string 1 (+ ?0 i))))
+ (define-key map s #'digit-argument)))
(define-key map "b" #'switch-to-buffer)
(define-key map "o" #'other-window)
(define-key map "e" #'te-set-escape-char)
@@ -1222,7 +1221,7 @@ of the terminal-emulator"
(cond ((string-match "\\`[-a-zA-Z0-9+=_.@/:]+\\'"
string)
string)
- ((not (string-match "[$]" string))
+ ((not (string-search "$" string))
;; "[\"\\]" are special to sh and the lisp reader in the same way
(prin1-to-string string))
(t
diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el
index 1340618..e0e89c3 100644
--- a/lisp/obsolete/tpu-edt.el
+++ b/lisp/obsolete/tpu-edt.el
@@ -1415,9 +1415,9 @@ If an argument is specified, don't set the search
direction."
;; if using regexp, eliminate upper case forms (\B \W \S.)
(if tpu-regexp-p
(let ((pat (copy-sequence string)) (case-fold-search nil) (pos 0))
- (while (setq pos (string-match "\\\\\\\\" pat)) (aset pat (+ 1 pos) ?.))
- (while (setq pos (string-match "\\\\B" pat)) (aset pat (+ 1 pos) ?.))
- (while (setq pos (string-match "\\\\W" pat)) (aset pat (+ 1 pos) ?.))
+ (while (setq pos (string-search "\\\\" pat)) (aset pat (+ 1 pos) ?.))
+ (while (setq pos (string-search "\\B" pat)) (aset pat (+ 1 pos) ?.))
+ (while (setq pos (string-search "\\W" pat)) (aset pat (+ 1 pos) ?.))
(while (setq pos (string-match "\\\\S." pat))
(aset pat (+ 1 pos) ?.) (aset pat (+ 2 pos) ?.))
(string-equal pat (downcase pat)))
diff --git a/lisp/obsolete/url-ns.el b/lisp/obsolete/url-ns.el
index b62ad82..6cd6693 100644
--- a/lisp/obsolete/url-ns.el
+++ b/lisp/obsolete/url-ns.el
@@ -31,7 +31,7 @@
;;;###autoload
(defun isPlainHostName (host)
- (not (string-match "\\." host)))
+ (not (string-search "." host)))
;;;###autoload
(defun dnsDomainIs (host dom)
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 8a4aa2b..3acc187 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -3205,7 +3205,7 @@ s Search for keywords M Like m, but
only TODO entries
(delete-window)
(org-agenda-get-restriction-and-command prefix-descriptions))
- ((equal c ?q) (error "Abort"))
+ ((equal c ?q) (user-error "Abort"))
(t (user-error "Invalid key %c" c))))))))
(defun org-agenda-fit-window-to-buffer ()
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index e1d104f..49dc2d2 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -214,7 +214,7 @@ Includes files as well as host names followed by a colon."
(list string)
(completion-table-subvert (pcomplete-all-entries)
"" "/ssh:")))
- ((string-match "/" string) ; Local file name.
+ ((string-search "/" string) ; Local file name.
(pcomplete-all-entries))
(t ;Host name or local file name.
(append (all-completions string (pcomplete-all-entries))
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 3630c19..64d43c3 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -315,7 +315,7 @@ Quit current game \\[5x5-quit-game]"
(save-excursion
(goto-char grid-org)
(beginning-of-line (+ 1 (/ 5x5-y-scale 2)))
- (let ((solution-grid (cl-cdadr 5x5-solver-output)))
+ (let ((solution-grid (cdadr 5x5-solver-output)))
(dotimes (y 5x5-grid-size)
(save-excursion
(forward-char (+ 1 (/ (1+ 5x5-x-scale) 2)))
@@ -746,9 +746,9 @@ Solutions are sorted from least to greatest Hamming weight."
;; The Hamming Weight is computed by matrix reduction
;; with an ad-hoc operator.
(math-reduce-vec
- ;; (cl-cadadr '(vec (mod x 2))) => x
- (lambda (r x) (+ (if (integerp r) r (cl-cadadr r))
- (cl-cadadr x)))
+ ;; (cadadr '(vec (mod x 2))) => x
+ (lambda (r x) (+ (if (integerp r) r (cadadr r))
+ (cadadr x)))
solution); car
(5x5-vec-to-grid
(calcFunc-arrange solution 5x5-grid-size));cdr
diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el
index 47ed6e2..a80cb21 100644
--- a/lisp/play/decipher.el
+++ b/lisp/play/decipher.el
@@ -769,8 +769,8 @@ TOTAL is the total number of letters in the ciphertext."
(while temp-list
(insert (caar temp-list)
(format "%4d%3d%% "
- (cl-cadar temp-list)
- (floor (* 100.0 (cl-cadar temp-list)) total)))
+ (cadar temp-list)
+ (floor (* 100.0 (cadar temp-list)) total)))
(setq temp-list (nthcdr 4 temp-list)))
(insert ?\n)
(setq freq-list (cdr freq-list)
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
index c3be029..9d5ee26 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -2170,7 +2170,7 @@ other words."
(let (pos ret-list end-pos)
(setq pos 0)
(setq ret-list nil)
- (while (setq end-pos (string-match " " (substring strin pos)))
+ (while (setq end-pos (string-search " " (substring strin pos)))
(setq end-pos (+ end-pos pos))
(if (not (= end-pos pos))
(setq ret-list (append ret-list (list
@@ -2269,7 +2269,7 @@ except for the verb."
startlist
(if (string= (substring dirstring 0 1) "/")
(dun-get-path (substring dirstring 1) (append startlist (list "/")))
- (if (not (setq slash (string-match "/" dirstring)))
+ (if (not (setq slash (string-search "/" dirstring)))
(append startlist (list dirstring))
(dun-get-path (substring dirstring (1+ slash))
(append startlist
@@ -2348,7 +2348,7 @@ Also prints current score to let user know he has scored."
(princ dun-line)
(if (eq (dun-parse2 nil dun-unix-verbs dun-line) -1)
(progn
- (if (setq esign (string-match "=" dun-line))
+ (if (setq esign (string-search "=" dun-line))
(dun-doassign dun-line esign)
(dun-mprinc (car dun-line-list))
(dun-mprincl ": not found.")))))
@@ -2373,28 +2373,28 @@ Also prints current score to let user know he has
scored."
(dun-mprincl "Incorrect.")))
(let (varname epoint afterq i value)
- (setq varname (replace-regexp-in-string " " "" (substring line 0 esign)))
+ (setq varname (string-replace " " "" (substring line 0 esign)))
(if (or (= (length varname) 0) (< (- (length line) esign) 2))
(progn
(dun-mprinc line)
(dun-mprincl " : not found."))
- (if (not (setq epoint (string-match ")" line)))
+ (if (not (setq epoint (string-search ")" line)))
(if (string= (substring line (1+ esign) (+ esign 2))
"\"")
(progn
(setq afterq (substring line (+ esign 2)))
(setq epoint (+
- (string-match "\"" afterq)
+ (string-search "\"" afterq)
(+ esign 3))))
- (if (not (setq epoint (string-match " " line)))
+ (if (not (setq epoint (string-search " " line)))
(setq epoint (length line))))
(setq epoint (1+ epoint))
(while (and
(not (= epoint (length line)))
- (setq i (string-match ")" (substring line epoint))))
+ (setq i (string-search ")" (substring line epoint))))
(setq epoint (+ epoint i 1))))
(setq value (substring line (1+ esign) epoint))
(dun-eval varname value)))))
@@ -2788,7 +2788,7 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
(cond
((null (setq args (car args)))
(dun-mprincl "Usage: cat <ascii-file-name>"))
- ((string-match-p "/" args)
+ ((string-search "/" args)
(dun-mprincl "cat: only files in current directory allowed."))
((and (> dun-cdroom 0) (string= args "description"))
(dun-mprincl (car (nth dun-cdroom dun-rooms))))
@@ -3110,7 +3110,7 @@ File not found")))
(setq dun-line (downcase (dun-read-line)))
(if (eq (dun-parse2 nil dun-unix-verbs dun-line) -1)
(let (esign)
- (if (setq esign (string-match "=" dun-line))
+ (if (setq esign (string-search "=" dun-line))
(dun-doassign dun-line esign)
(dun-mprinc (car dun-line-list))
(dun-mprincl ": not found.")))))
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index cc05823..2aec408 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -200,7 +200,7 @@ Variables: `handwrite-linespace' (default 12)
(concat "\\\\" (cdr trans))
line)))
(switch-to-buffer ps-buf-name)
- (insert (replace-regexp-in-string "\n" "" line))
+ (insert (string-replace "\n" "" line))
(message "write write write...")
(setq ps-ypos (+ ps-ypos handwrite-linespace))
(end-of-line)
diff --git a/lisp/proced.el b/lisp/proced.el
index d1a243d..2fafdcc 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -1389,7 +1389,7 @@ The return string is always 6 characters wide."
(defun proced-format-args (args)
"Format attribute ARGS.
Replace newline characters by \"^J\" (two characters)."
- (replace-regexp-in-string "\n" "^J" args))
+ (string-replace "\n" "^J" args))
(defun proced-format (process-alist format)
"Display PROCESS-ALIST using FORMAT."
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 8145e51..4c42769 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -499,7 +499,7 @@ RET: expand or collapse"))
(defun profiler-report-header-line-format (fmt &rest args)
(let* ((header (apply #'profiler-format fmt args))
- (escaped (replace-regexp-in-string "%" "%%" header)))
+ (escaped (string-replace "%" "%%" header)))
(concat
(propertize " "
'display '(space :align-to 0)
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 9b9c58e..c0c9d5e 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -153,95 +153,144 @@ The second subexpression should match the bug reference
(usually a number)."
(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))))))
- ;;
- ;; Codeberg projects.
- ;;
- ;; The systematics is exactly as for Github projects.
- ("[/@]codeberg.org[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
- "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
- ,(lambda (groups)
- (let ((ns-project (nth 1 groups)))
- (lambda ()
- (concat "https://codeberg.org/";
- (or
- ;; Explicit user/proj#18 link.
- (match-string 1)
- ns-project)
- "/issues/"
- (match-string 2))))))
- ;;
- ;; GitLab projects.
- ;;
- ;; Here #18 is an issue and !17 is a merge request. Explicit
- ;; 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))))))
- ;;
- ;; Sourcehut projects.
- ;;
- ;; #19 is an issue. Other project's issues can be referenced as
- ;; #~user/project#19.
- ;;
- ;; Caveat: The code assumes that a project on git.sr.ht or
- ;; hg.sr.ht has a tracker of the same name on todo.sh.ht. That's
- ;; a very common setup but all sr.ht services are loosely coupled,
- ;; so you can have a repo without tracker, or a repo with a
- ;; tracker using a different name, etc. So we can only try to
- ;; make a good guess.
- ("[/@]\\(?:git\\|hg\\).sr.ht[/:]\\(~[.A-Za-z0-9_/-]+\\)"
- "\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
- ,(lambda (groups)
- (let ((ns-project (nth 1 groups)))
- (lambda ()
- (concat "https://todo.sr.ht/";
- (or
- ;; Explicit user/proj#18 link.
- (match-string 1)
- ns-project)
- "/"
- (match-string 2)))))))
+(defvar bug-reference-gitea-instances '("gitea.com"
+ "codeberg.org")
+ "List of Gitea forge instances.
+When the value is changed after bug-reference has already been
+loaded, and performed an auto-setup, evaluate
+`(bug-reference--setup-from-vc-alist t)' for rebuilding the value
+of `bug-reference--setup-from-vc-alist'.")
+
+(defvar bug-reference-gitlab-instances '("gitlab.com"
+ "salsa.debian.org"
+ "framagit.org")
+ "List of GitLab forge instances.
+When the value is changed after bug-reference has already been
+loaded, and performed an auto-setup, evaluate
+`(bug-reference--setup-from-vc-alist t)' for rebuilding the value
+of `bug-reference--setup-from-vc-alist'.")
+
+(defvar bug-reference-sourcehut-instances '("sr.ht")
+ "List of SourceHut forge instances.
+When the value is changed after bug-reference has already been
+loaded, and performed an auto-setup, evaluate
+`(bug-reference--setup-from-vc-alist t)' for rebuilding the value
+of `bug-reference--setup-from-vc-alist'.")
+
+(defvar bug-reference--setup-from-vc-alist nil
+ "An alist for setting up ‘bug-reference-mode’ based on VC URL.
+This is like `bug-reference-setup-from-vc-alist' but generated
+for the known free software forges from the variables
+`bug-reference-gitea-instances',
+`bug-reference-gitlab-instances', and
+`bug-reference-sourcehut-instances'.")
+
+(defun bug-reference--setup-from-vc-alist (&optional rebuild)
+ (if (and bug-reference--setup-from-vc-alist
+ (null rebuild))
+ bug-reference--setup-from-vc-alist
+ (setq 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))))))
+ ;;
+ ;; Gitea instances.
+ ;;
+ ;; The systematics is exactly as for Github projects.
+ (,(concat "[/@]"
+ (regexp-opt bug-reference-gitea-instances t)
+ "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git")
+ "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
+ ,(lambda (groups)
+ (let ((host (nth 1 groups))
+ (ns-project (nth 2 groups)))
+ (lambda ()
+ (concat "https://"; host "/"
+ (or
+ ;; Explicit user/proj#18 link.
+ (match-string 1)
+ ns-project)
+ "/issues/"
+ (match-string 2))))))
+ ;;
+ ;; GitLab instances.
+ ;;
+ ;; 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.
+ (,(concat "[/@]"
+ (regexp-opt bug-reference-gitlab-instances t)
+ "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git")
+ "\\(?1:[.A-Za-z0-9_/-]+\\)?\\(?3:[#!]\\)\\(?2:[0-9]+\\)\\>"
+ ,(lambda (groups)
+ (let ((host (nth 1 groups))
+ (ns-project (nth 2 groups)))
+ (lambda ()
+ (concat "https://"; host "/"
+ (or (match-string 1)
+ ns-project)
+ "/-/"
+ (if (string= (match-string 3) "#")
+ "issues/"
+ "merge_requests/")
+ (match-string 2))))))
+ ;;
+ ;; Sourcehut instances.
+ ;;
+ ;; #19 is an issue. Other project's issues can be
+ ;; #referenced as ~user/project#19.
+ ;;
+ ;; Caveat: The code assumes that a project on git.sr.ht or
+ ;; hg.sr.ht has a tracker of the same name on todo.sh.ht.
+ ;; That's a very common setup but all sr.ht services are
+ ;; loosely coupled, so you can have a repo without
+ ;; tracker, or a repo with a tracker using a different
+ ;; name, etc. So we can only try to make a good guess.
+ (,(concat "[/@]\\(?:git\\|hg\\)."
+ (regexp-opt bug-reference-sourcehut-instances t)
+ "[/:]\\(~[.A-Za-z0-9_/-]+\\)")
+ "\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
+ ,(lambda (groups)
+ (let ((host (nth 1 groups))
+ (ns-project (nth 2 groups)))
+ (lambda ()
+ (concat "https://todo."; host "/"
+ (or
+ ;; Explicit user/proj#18 link.
+ (match-string 1)
+ ns-project)
+ "/"
+ (match-string 2))))))))))
+
+(defvar bug-reference-setup-from-vc-alist nil
"An alist for setting up `bug-reference-mode' based on VC URL.
Each element has the form (URL-REGEXP BUG-REGEXP URL-FORMAT-FN).
@@ -256,7 +305,8 @@ URL-REGEXP against the VCS URL and returns the value to be
set as
(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."
+and `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)))
@@ -269,7 +319,9 @@ and apply it if applicable."
(vc-call-backend backend 'repository-url)))))
(when url
(catch 'found
- (dolist (config bug-reference-setup-from-vc-alist)
+ (dolist (config (append
+ bug-reference-setup-from-vc-alist
+ (bug-reference--setup-from-vc-alist)))
(when (apply #'bug-reference-maybe-setup-from-vc
url config)
(throw 'found t)))))))))
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index 334e821..f1bc25d 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -658,7 +658,7 @@
;; prevent a repeat invocation. See elisp/lispref page "Search-based
;; Fontification".
;;
- ;; This function gives invalid GAWK namepace separators (::)
+ ;; This function gives invalid GAWK namespace separators (::)
;; font-lock-warning-face. "Invalid" here means there are spaces, etc.,
;; around a separator, or there are more than one of them in an identifier.
;; Invalid separators inside function declaration parentheses are handled
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 5d93435..fe6ff22 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -174,6 +174,10 @@ This variant works around bugs in `eval-when-compile' in
various
;;; Macros.
+(or (fboundp 'cadar) (defsubst cadar (elt) (car (cdar elt))))
+(or (fboundp 'caddr) (defsubst caddr (elt) (car (cddr elt))))
+(or (fboundp 'cdddr) (defsubst cdddr (elt) (cdr (cddr elt))))
+
(defmacro c--mapcan (fun liszt)
;; CC Mode equivalent of `mapcan' which bridges the difference
;; between the host [X]Emacsen."
@@ -230,12 +234,21 @@ On XEmacs and older Emacsen, this refontifies that region
immediately."
`(font-lock-flush ,beg ,end)
`(font-lock-fontify-region ,beg ,end)))
+(defmacro c-benign-error (format &rest args)
+ ;; Formats an error message for the echo area and dings, i.e. like
+ ;; `error' but doesn't abort.
+ (declare (debug t))
+ `(progn
+ (message ,format ,@args)
+ (ding)))
+
(defmacro c-point (position &optional point)
"Return the value of certain commonly referenced POSITIONs relative to POINT.
The current point is used if POINT isn't specified. POSITION can be
one of the following symbols:
`bol' -- beginning of line
+`boll' -- beginning of logical line (i.e. without preceding escaped NL)
`eol' -- end of line
`eoll' -- end of logical line (i.e. without escaped NL)
`bod' -- beginning of defun
@@ -266,6 +279,15 @@ to it is returned. This function does not modify the
point or the mark."
(beginning-of-line)
(point))))
+ ((eq position 'boll)
+ `(save-excursion
+ ,@(if point `((goto-char ,point)))
+ (while (progn (beginning-of-line)
+ (when (not (bobp))
+ (eq (char-before (1- (point))) ?\\)))
+ (backward-char))
+ (point)))
+
((eq position 'eol)
(if (and (cc-bytecomp-fboundp 'line-end-position) (not point))
'(line-end-position)
@@ -646,19 +668,27 @@ even when the buffer is read-only, and without
interference from
various buffer change hooks."
(declare (indent 0) (debug t))
`(let (-tnt-chng-keep
- -tnt-chng-state)
+ -tnt-chng-state
+ (old-undo-list buffer-undo-list))
(unwind-protect
;; Insert an undo boundary for use with `undo-more'. We
;; don't use `undo-boundary' since it doesn't insert one
;; unconditionally.
- (setq buffer-undo-list (cons nil buffer-undo-list)
- -tnt-chng-state (c-tnt-chng-record-state)
+ (setq buffer-undo-list
+ (if (eq old-undo-list t)
+ nil
+ (cons nil buffer-undo-list))
+ old-undo-list (if (eq old-undo-list t)
+ t
+ buffer-undo-list)
+ -tnt-chng-state (c-tnt-chng-record-state
+ old-undo-list)
-tnt-chng-keep (progn ,@body))
(c-tnt-chng-cleanup -tnt-chng-keep -tnt-chng-state))))
-(defun c-tnt-chng-record-state ()
+(defun c-tnt-chng-record-state (old-undo-list)
;; Used internally in `c-tentative-buffer-changes'.
- (vector buffer-undo-list ; 0
+ (vector old-undo-list ; 0
(current-buffer) ; 1
;; No need to use markers for the point and mark; if the
;; undo got out of synch we're hosed anyway.
@@ -676,18 +706,26 @@ various buffer change hooks."
(setq buffer-undo-list (cdr saved-undo-list))
(if keep
- ;; Find and remove the undo boundary.
- (let ((p buffer-undo-list))
- (while (not (eq (cdr p) saved-undo-list))
- (setq p (cdr p)))
- (setcdr p (cdr saved-undo-list)))
-
- ;; `primitive-undo' will remove the boundary.
- (setq saved-undo-list (cdr saved-undo-list))
- (let ((undo-in-progress t))
- (while (not (eq (setq buffer-undo-list
- (primitive-undo 1 buffer-undo-list))
- saved-undo-list))))
+ (if (eq saved-undo-list t)
+ (progn
+ (c-benign-error
+ "Can't save additional undo list in c-tnt-chng-cleanup")
+ (setq buffer-undo-list t))
+ ;; Find and remove the undo boundary.
+ (let ((p buffer-undo-list))
+ (while (not (eq (cdr p) saved-undo-list))
+ (setq p (cdr p)))
+ (setcdr p (cdr saved-undo-list))))
+
+ (let ((undo-in-progress t)
+ (end-undo-list (if (eq saved-undo-list t)
+ nil
+ ;; `primitive-undo' will remove the boundary.
+ (cdr saved-undo-list))))
+ (while (not (eq buffer-undo-list end-undo-list))
+ (setq buffer-undo-list (primitive-undo 1 buffer-undo-list))))
+ (if (eq saved-undo-list t)
+ (setq buffer-undo-list t))
(when (buffer-live-p (elt saved-state 1))
(set-buffer (elt saved-state 1))
@@ -1013,14 +1051,6 @@ be after it."
'(if c-vsemi-status-unknown-p-fn (funcall c-vsemi-status-unknown-p-fn)))
-(defmacro c-benign-error (format &rest args)
- ;; Formats an error message for the echo area and dings, i.e. like
- ;; `error' but doesn't abort.
- (declare (debug t))
- `(progn
- (message ,format ,@args)
- (ding)))
-
(defmacro c-with-syntax-table (table &rest code)
;; Temporarily switches to the specified syntax table in a failsafe
;; way to execute code.
@@ -1254,6 +1284,9 @@ MODE is either a mode symbol or a list of mode symbols."
;; region that has been put with `c-put-char-property'. PROPERTY is
;; assumed to be constant.
;;
+ ;; The returned value is the buffer position of the lowest character
+ ;; whose PROPERTY was removed, or nil if there was none.
+ ;;
;; Note that this function does not clean up the property from the
;; lists of the `rear-nonsticky' properties in the region, if such
;; are used. Thus it should not be used for common properties like
@@ -1262,20 +1295,28 @@ MODE is either a mode symbol or a list of mode symbols."
;; This macro does hidden buffer changes.
(declare (debug t))
(setq property (eval property))
- (if c-use-extents
- ;; XEmacs.
- `(map-extents (lambda (ext ignored)
- (delete-extent ext))
- nil ,from ,to nil nil ',property)
- ;; Emacs.
- (if (and (fboundp 'syntax-ppss)
- (eq `,property 'syntax-table))
- `(let ((-from- ,from) (-to- ,to))
- (setq c-syntax-table-hwm
- (min c-syntax-table-hwm
- (c-min-property-position -from- -to- ',property)))
- (remove-text-properties -from- -to- '(,property nil)))
- `(remove-text-properties ,from ,to '(,property nil)))))
+ `(let* ((-to- ,to)
+ (ret (c-min-property-position ,from -to- ',property)))
+ (if (< ret -to-)
+ (progn
+ ,(cond
+ (c-use-extents
+ ;; XEmacs
+ `(map-extents (lambda (ext ignored)
+ (delete-extent ext))
+ nil ret -to- nil nil ',property))
+ ((and (fboundp 'syntax-ppss)
+ (eq property 'syntax-table))
+ ;; Emacs 'syntax-table
+ `(progn
+ (setq c-syntax-table-hwm
+ (min c-syntax-table-hwm ret))
+ (remove-text-properties ret -to- '(,property nil))))
+ (t
+ ;; Emacs other property.
+ `(remove-text-properties ret -to- '(,property nil))))
+ ret)
+ nil)))
(defmacro c-clear-syn-tab-properties (from to)
;; Remove all occurrences of the `syntax-table' and `c-fl-syn-tab' text
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 984a75c..77da98f 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -170,6 +170,7 @@
(cc-bytecomp-defun c-clear-syn-tab)
(cc-bytecomp-defun c-clear-string-fences)
(cc-bytecomp-defun c-restore-string-fences)
+(cc-bytecomp-defun c-remove-string-fences)
;; Make declarations for all the `c-lang-defvar' variables in cc-langs.
@@ -3140,21 +3141,21 @@ comment at the start of cc-engine.el for more info."
(setq base far-base
s far-s
end nil))))
- (when
- (or
- (and (> here base) (null end))
- (null (nth 8 s))
- (and end (>= here end))
- (not
- (or
- (and (nth 3 s) ; string
- (not (eq (char-before here) ?\\)))
- (and (nth 4 s) (not (nth 7 s)) ; Block comment
- (not (memq (char-before here)
- c-block-comment-awkward-chars)))
- (and (nth 4 s) (nth 7 s) ; Line comment
- (not (memq (char-before here) '(?\\ ?\n)))))))
+ (cond
+ ((or (and (> here base) (null end))
+ (null (nth 8 s))
+ (and end (>= here end)))
(setq s (parse-partial-sexp base here nil nil s)))
+ ((or (and (nth 3 s) ; string
+ (eq (char-before here) ?\\))
+ (and (nth 4 s) (not (nth 7 s)) ; block comment
+ (memq (char-before here) c-block-comment-awkward-chars))
+ (and (nth 4 s) (nth 7 s) ; line comment
+ (memq (char-before here) '(?\\ ?\n))))
+ (setq s
+ (if (>= here base)
+ (parse-partial-sexp base here nil nil s)
+ (parse-partial-sexp (nth 8 s) here)))))
(cond
((or (nth 3 s)
(and (nth 4 s)
@@ -7167,554 +7168,954 @@ comment at the start of cc-engine.el for more info."
(goto-char c-new-END)))))
-;; Functions to handle C++ raw strings.
+;; Handling of CC Mode multi-line strings.
;;
-;; A valid C++ raw string looks like
-;; R"<id>(<contents>)<id>"
-;; , where <id> is an identifier from 0 to 16 characters long, not containing
-;; spaces, control characters, or left/right paren. <contents> can include
-;; anything which isn't the terminating )<id>", including new lines, "s,
-;; parentheses, etc.
+;; By a "multi-line string" is meant a string opened by a "decorated"
+;; double-quote mark, and which can continue over several lines without the
+;; need to escape the newlines, terminating at a closer, a possibly
+;; "decorated" double-quote mark. The string can usually contain double
+;; quotes without them being quoted, whether or not backslashes quote the
+;; following character being a matter of configuration.
;;
-;; CC Mode handles C++ raw strings by the use of `syntax-table' text
+;; CC Mode handles multi-line strings by the use of `syntax-table' text
;; properties as follows:
;;
-;; (i) On a validly terminated raw string, no `syntax-table' text properties
-;; are applied to the opening and closing delimiters, but any " in the
-;; contents is given the property value "punctuation" (`(1)') to prevent it
-;; interacting with the "s in the delimiters.
+;; (i) On a validly terminated ml string, syntax-table text-properties are
+;; applied as needed to the opener, so that the " character in the opener
+;; (or (usually) the first of them if there are several) retains its normal
+;; syntax, and any other characters with obtrusive syntax are given
+;; "punctuation" '(1) properties. Similarly, the " character in the closer
+;; retains its normal syntax, and characters with obtrusive syntax are
+;; "punctuated out" as before.
;;
-;; The font locking routine `c-font-lock-raw-strings' (in cc-fonts.el)
-;; recognizes valid raw strings, and fontifies the delimiters (apart from
-;; the parentheses) with the default face and the parentheses and the
-;; <contents> with font-lock-string-face.
+;; The font locking routine `c-font-lock-ml-strings' (in cc-fonts.el)
+;; recognizes validly terminated ml strings and fontifies (typically) the
+;; innermost character of each delimiter in font-lock-string-face and the
+;; rest of those delimiters in the default face. The contents, of course,
+;; are in font-lock-string-face.
;;
-;; (ii) A valid, but unterminated, raw string opening delimiter gets the
-;; "punctuation" value (`(1)') of the `syntax-table' text property, and the
-;; open parenthesis gets the "string fence" value (`(15)'). When such a
-;; delimiter is found, no attempt is made in any way to "correct" any text
-;; properties after the delimiter.
+;; (ii) A valid, but unterminated, ml string's opening delimiter gets the
+;; "punctuation" value (`(1)') of the `syntax-table' text property on its ",
+;; and the last char of the opener gets the "string fence" value '(15).
+;; (The latter takes precedence over the former.) When such a delimiter is
+;; found, no attempt is made in any way to "correct" any text properties
+;; after the delimiter.
;;
-;; `c-font-lock-raw-strings' puts c-font-lock-warning-face on the entire
-;; unmatched opening delimiter (from the R up to the open paren), and allows
-;; the rest of the buffer to get font-lock-string-face, caused by the
-;; unmatched "string fence" `syntax-table' text property value.
+;; `c-font-lock-ml-strings' puts c-font-lock-warning-face on the entire
+;; unmatched opening delimiter, and allows the tail of the buffer to get
+;; font-lock-string-face, caused by the unmatched "string fence"
+;; `syntax-table' text property value.
;;
-;; (iii) Inside a macro, a valid raw string is handled as in (i). An
-;; unmatched opening delimiter is handled slightly differently. In addition
-;; to the "punctuation" and "string fence" properties on the delimiter,
-;; another "string fence" `syntax-table' property is applied to the last
-;; possible character of the macro before the terminating linefeed (if there
-;; is such a character after the "("). This "last possible" character is
+;; (iii) Inside a macro, a valid ml string is handled as in (i). An unmatched
+;; opening delimiter is handled slightly differently. In addition to the
+;; "punctuation" and "string fence" properties on the delimiter, another
+;; "string fence" `syntax-table' property is applied to the last possible
+;; character of the macro before the terminating linefeed (if there is such
+;; a character after the delimiter). This "last possible" character is
;; never a backslash escaping the end of line. If the character preceding
;; this "last possible" character is itself a backslash, this preceding
-;; character gets a "punctuation" `syntax-table' value. If the "(" is
-;; already at the end of the macro, it gets the "punctuation" value, and no
-;; "string fence"s are used.
+;; character gets a "punctuation" `syntax-table' value. If the last
+;; character of the closing delimiter is already at the end of the macro, it
+;; gets the "punctuation" value, and no "string fence"s are used.
;;
;; The effect on the fontification of either of these tactics is that the
;; rest of the macro (if any) after the "(" gets font-lock-string-face, but
;; the rest of the file is fontified normally.
-;; The values of the function `c-raw-string-pos' at before-change-functions'
-;; BEG and END.
-(defvar c-old-beg-rs nil)
-(defvar c-old-end-rs nil)
-;; Whether a buffer change has disrupted or will disrupt the terminating id of
-;; a raw string.
-(defvar c-raw-string-end-delim-disrupted nil)
-
-(defun c-raw-string-pos ()
- ;; Get POINT's relationship to any containing raw string.
- ;; If point isn't in a raw string, return nil.
- ;; Otherwise, return the following list:
- ;;
- ;; (POS B\" B\( E\) E\")
- ;;
- ;; , where POS is the symbol `open-delim' if point is in the opening
- ;; delimiter, the symbol `close-delim' if it's in the closing delimiter, and
- ;; nil if it's in the string body. B\", B\(, E\), E\" are the positions of
- ;; the opening and closing quotes and parentheses of a correctly terminated
- ;; raw string. (N.B.: E\) and E\" are NOT on the "outside" of these
- ;; characters.) If the raw string is not terminated, E\) and E\" are set to
+(defun c-ml-string-make-closer-re (_opener)
+ "Return c-ml-string-any-closer-re.
+
+This is a suitable language specific value of
+`c-make-ml-string-closer-re-function' for most languages with
+multi-line strings (but not C++, for example)."
+ c-ml-string-any-closer-re)
+
+(defun c-ml-string-make-opener-re (_closer)
+ "Return c-ml-string-opener-re.
+
+This is a suitable language specific value of
+`c-make-ml-string-opener-re-function' for most languages with
+multi-line strings (but not C++, for example)."
+ c-ml-string-opener-re)
+
+(defun c-c++-make-ml-string-closer-re (opener)
+ "Construct a regexp for a C++ raw string closer matching OPENER."
+ (concat "\\()" (regexp-quote (substring opener 2 -1)) "\\(\"\\)\\)"))
+
+(defun c-c++-make-ml-string-opener-re (closer)
+ "Construct a regexp for a C++ raw string opener matching CLOSER."
+ (concat "\\(R\\(\"\\)" (regexp-quote (substring closer 1 -1)) "(\\)"))
+
+;; The positions of various components of mult-line strings surrounding BEG,
+;; END and (1- BEG) (of before-change-functions) as returned by
+;; `c-ml-string-delims-around-point'.
+(defvar c-old-beg-ml nil)
+(defvar c-old-1-beg-ml nil) ; only non-nil when `c-old-beg-ml' is nil.
+(defvar c-old-end-ml nil)
+;; The values of the function `c-position-wrt-ml-delims' at
+;; before-change-function's BEG and END.
+(defvar c-beg-pos nil)
+(defvar c-end-pos nil)
+;; Whether a buffer change has disrupted or will disrupt the terminator of an
+;; multi-line string.
+(defvar c-ml-string-end-delim-disrupted nil)
+
+(defun c-depropertize-ml-string-delims (string-delims)
+ ;; Remove any syntax-table text properties from the multi-line string
+ ;; delimiters specified by STRING-DELIMS, the output of
+ ;; `c-ml-string-delims-around-point'.
+ (let (found)
+ (if (setq found (c-clear-char-properties (caar string-delims)
+ (cadar string-delims)
+ 'syntax-table))
+ (c-truncate-lit-pos-cache found))
+ (when (cdr string-delims)
+ (if (setq found (c-clear-char-properties (cadr string-delims)
+ (caddr string-delims)
+ 'syntax-table))
+ (c-truncate-lit-pos-cache found)))))
+
+(defun c-get-ml-closer (open-delim)
+ ;; Return the closer, a three element dotted list of the closer's start, its
+ ;; end and the position of the double quote, matching the given multi-line
+ ;; string OPENER, also such a three element dotted list. Otherwise return
+ ;; nil. All pertinent syntax-table text properties must be in place.
+ (save-excursion
+ (goto-char (cadr open-delim))
+ (and (not (equal (c-get-char-property (1- (point)) 'syntax-table)
+ '(15)))
+ (re-search-forward (funcall c-make-ml-string-closer-re-function
+ (buffer-substring-no-properties
+ (car open-delim) (cadr open-delim)))
+ nil t)
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))))
+
+(defun c-ml-string-opener-around-point ()
+ ;; If point is inside an ml string opener, return a dotted list of the start
+ ;; and end of that opener, and the position of its double-quote. That list
+ ;; will not include any "context characters" before or after the opener. If
+ ;; an opener is found, the match-data will indicate it, with (match-string
+ ;; 1) being the entire delimiter, and (match-string 2) the "main" double
+ ;; quote. Otherwise the match-data is undefined.
+ (let ((here (point)) found)
+ (goto-char (max (- here (1- c-ml-string-max-opener-len)) (point-min)))
+ (while
+ (and
+ (setq found
+ (search-forward-regexp
+ c-ml-string-opener-re
+ (min (+ here (1- c-ml-string-max-opener-len)) (point-max))
+ 'bound))
+ (<= (match-end 1) here)))
+ (prog1
+ (and found
+ (< (match-beginning 1) here)
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))
+ (goto-char here))))
+
+(defun c-ml-string-opener-intersects-region (&optional start finish)
+ ;; If any part of the region [START FINISH] is inside an ml-string opener,
+ ;; return a dotted list of the start, end and double-quote position of that
+ ;; opener. That list wlll not include any "context characters" before or
+ ;; after the opener. If an opener is found, the match-data will indicate
+ ;; it, with (match-string 1) being the entire delimiter, and (match-string
+ ;; 2) the "main" double-quote. Otherwise, the match-data is undefined.
+ ;; Both START and FINISH default to point. FINISH may not be at an earlier
+ ;; buffer position than START.
+ (let ((here (point)) found)
+ (or finish (setq finish (point)))
+ (or start (setq start (point)))
+ (goto-char (max (- start (1- c-ml-string-max-opener-len)) (point-min)))
+ (while
+ (and
+ (setq found
+ (search-forward-regexp
+ c-ml-string-opener-re
+ (min (+ finish (1- c-ml-string-max-opener-len)) (point-max))
+ 'bound))
+ (<= (match-end 1) start)))
+ (prog1
+ (and found
+ (< (match-beginning 1) finish)
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))
+ (goto-char here))))
+
+(defun c-ml-string-opener-at-or-around-point (&optional position)
+ ;; If POSITION (default point) is at or inside an ml string opener, return a
+ ;; dotted list of the start and end of that opener, and the position of the
+ ;; double-quote in it. That list will not include any "context characters"
+ ;; before or after the opener.
+ (let ((here (point))
+ found)
+ (or position (setq position (point)))
+ (goto-char (max (- position (1- c-ml-string-max-opener-len)) (point-min)))
+ (while
+ (and
+ (setq found
+ (search-forward-regexp
+ c-ml-string-opener-re
+ (min (+ position c-ml-string-max-opener-len) (point-max))
+ 'bound))
+ (<= (match-end 1) position)))
+ (prog1
+ (and found
+ (<= (match-beginning 1) position)
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))
+ (goto-char here))))
+
+(defun c-ml-string-back-to-neutral (opening-point)
+ ;; Given OPENING-POINT, the position of the start of a multiline string
+ ;; opening delimiter, move point back to a neutral position within the ml
+ ;; string. It is assumed that point is within the innards of or the closing
+ ;; delimiter of string opened by OPEN-DELIM.
+ (let ((opener-end (save-excursion
+ (goto-char opening-point)
+ (looking-at c-ml-string-opener-re)
+ (match-end 1))))
+ (if (not c-ml-string-back-closer-re)
+ (goto-char (max (c-point 'boll) opener-end))
+ (re-search-backward c-ml-string-back-closer-re
+ (max opener-end
+ (c-point 'eopl))
+ 'bound))))
+
+(defun c-ml-string-in-end-delim (beg end open-delim)
+ ;; If the region (BEG END) intersects or touches a possible multiline string
+ ;; terminator, return a cons of the position of the start and end of the
+ ;; first such terminator. The syntax-table text properties must be in a
+ ;; consistent state when using this function. OPEN-DELIM is the three
+ ;; element dotted list of the start, end, and double quote position of the
+ ;; multiline string opener that BEG is in, or nil if it isn't in one.
+ (save-excursion
+ (goto-char beg)
+ (when open-delim
+ ;; If BEG is in an opener, move back to a position we know to be "safe".
+ (if (<= beg (cadr open-delim))
+ (goto-char (cadr open-delim))
+ (c-ml-string-back-to-neutral (car open-delim))))
+
+ (let (saved-match-data)
+ (or
+ ;; If we might be in the middle of "context" bytes at the start of a
+ ;; closer, move to after the closer.
+ (and c-ml-string-back-closer-re
+ (looking-at c-ml-string-any-closer-re)
+ (eq (c-in-literal) 'string)
+ (setq saved-match-data (match-data))
+ (goto-char (match-end 0)))
+
+ ;; Otherwise, move forward over closers while we haven't yet reached
END,
+ ;; until we're after BEG.
+ (progn
+ (while
+ (let (found)
+ (while ; Go over a single real closer.
+ (and
+ (search-forward-regexp
+ c-ml-string-any-closer-re
+ (min (+ end c-ml-string-max-closer-len-no-leader)
+ (point-max))
+ t)
+ (save-excursion
+ (goto-char (match-end 1))
+ (if (c-in-literal) ; a pseudo closer.
+ t
+ (setq saved-match-data (match-data))
+ (setq found t)
+ nil))))
+ (and found
+ (<= (point) beg))
+ ;; (not (save-excursion
+ ;; (goto-char (match-beginning 2))
+ ;; (c-literal-start)))
+ ))))
+ (set-match-data saved-match-data))
+
+ ;; Test whether we've found the sought closing delimiter.
+ (unless (or (null (match-data))
+ (and (not (eobp))
+ (<= (point) beg))
+ (> (match-beginning 0) beg)
+ (progn (goto-char (match-beginning 2))
+ (not (c-literal-start))))
+ (cons (match-beginning 1) (match-end 1)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun c-ml-string-delims-around-point ()
+ ;; Get POINT's relationship to any containing multi-line string or such a
+ ;; multi-line string which point is at the end of.
+ ;;
+ ;; If point isn't thus situated, return nil.
+ ;; Otherwise return the following cons:
+ ;;
+ ;; (OPENER . CLOSER)
+ ;;
+ ;; , where each of OPENER and CLOSER is a dotted list of the form
+ ;;
+ ;; (START-DELIM END-DELIM . QUOTE-POSITION)
+ ;;
+ ;; , the bounds of the delimiters and the buffer position of the ?" in the
+ ;; delimiter. If the ml-string is not validly terminated, CLOSER is instead
;; nil.
;;
;; Note: this function is dependent upon the correct syntax-table text
;; properties being set.
- (let ((state (c-semi-pp-to-literal (point)))
- open-quote-pos open-paren-pos close-paren-pos close-quote-pos id)
- (save-excursion
- (when
- (and
- (cond
- ((null (cadr state))
- (or (eq (char-after) ?\")
- (search-backward "\"" (max (- (point) 17) (point-min)) t)))
- ((and (eq (cadr state) 'string)
- (goto-char (nth 2 state))
- (cond
- ((eq (char-after) ?\"))
- ((eq (char-after) ?\()
- (let ((here (point)))
- (goto-char (max (- (point) 18) (point-min)))
- (while
- (and
- (search-forward-regexp
- c-c++-raw-string-opener-re
- (1+ here) 'limit)
- (< (point) here)))
- (and (eq (point) (1+ here))
- (match-beginning 1)
- (goto-char (1- (match-beginning 1)))))))
- (not (bobp)))))
- (c-at-c++-raw-string-opener))
- (setq open-quote-pos (point)
- open-paren-pos (match-end 1)
- id (match-string-no-properties 1))
- (goto-char (1+ open-paren-pos))
- (when (and (not (c-get-char-property open-paren-pos 'syntax-table))
- (search-forward (concat ")" id "\"") nil t))
- (setq close-paren-pos (match-beginning 0)
- close-quote-pos (1- (point))))))
- (and open-quote-pos
- (list
- (cond
- ((<= (point) open-paren-pos)
- 'open-delim)
- ((and close-paren-pos
- (> (point) close-paren-pos))
- 'close-delim)
- (t nil))
- open-quote-pos open-paren-pos close-paren-pos close-quote-pos))))
-
-(defun c-raw-string-in-end-delim (beg end)
- ;; If the region (BEG END) intersects a possible raw string terminator,
- ;; return a cons of the position of the ) and the position of the " in the
- ;; first one found.
- (save-excursion
- (goto-char (max (- beg 17) (point-min)))
- (while
- (and
- (search-forward-regexp ")\\([^ ()\\\n\r\t]\\{0,16\\}\\)\""
- (min (+ end 17) (point-max)) t)
- (<= (point) beg)))
- (unless (or (<= (point) beg)
- (>= (match-beginning 0) end))
- (cons (match-beginning 0) (match-end 1)))))
-
-(defun c-depropertize-raw-string (id open-quote open-paren bound)
- ;; Point is immediately after a raw string opening delimiter. Remove any
- ;; `syntax-table' text properties associated with the delimiter (if it's
- ;; unmatched) or the raw string.
- ;;
- ;; ID, a string, is the delimiter's identifier. OPEN-QUOTE and OPEN-PAREN
- ;; are the buffer positions of the delimiter's components. BOUND is the
- ;; bound for searching for a matching closing delimiter; it is usually nil,
- ;; but if we're inside a macro, it's the end of the macro (i.e. just before
- ;; the terminating \n).
- ;;
- ;; Point is moved to after the (terminated) raw string, or left after the
- ;; unmatched opening delimiter, as the case may be. The return value is of
- ;; no significance.
- (let ((open-paren-prop (c-get-char-property open-paren 'syntax-table))
- first)
- ;; If the delimiter is "unclosed", or sombody's used " in their id, clear
- ;; the 'syntax-table property from all of them.
- (setq first (c-clear-char-property-with-value-on-char
- open-quote open-paren 'syntax-table '(1) ?\"))
- (if first (c-truncate-lit-pos-cache first))
+ (let ((here (point))
+ (state (c-semi-pp-to-literal (point)))
+ open-dlist close-dlist ret found opener)
(cond
- ((null open-paren-prop)
- ;; Should be a terminated raw string...
- (when (search-forward (concat ")" id "\"") nil t)
- ;; Yes, it is. :-)
- ;; Clear any '(1)s from "s in the identifier.
- (setq first (c-clear-char-property-with-value-on-char
- (1+ (match-beginning 0)) (1- (match-end 0))
- 'syntax-table '(1) ?\"))
- (if first (c-truncate-lit-pos-cache first))
- ;; Clear any random `syntax-table' text properties from the contents.
- (let* ((closing-paren (match-beginning 0))
- (first-st
- (and
- (< (1+ open-paren) closing-paren)
- (or
- (and (c-get-char-property (1+ open-paren) 'syntax-table)
- (1+ open-paren))
- (and
- (setq first
- (c-next-single-property-change
- (1+ open-paren) 'syntax-table nil closing-paren))
- (< first closing-paren)
- first)))))
- (when first-st
- (c-clear-char-properties first-st (match-beginning 0)
- 'syntax-table)
- (c-truncate-lit-pos-cache first-st))
- (when (c-get-char-property (1- (match-end 0)) 'syntax-table)
- ;; Was previously an unterminated (ordinary) string
- (save-excursion
- (goto-char (1- (match-end 0)))
- (when (c-safe (c-forward-sexp)) ; to '(1) at EOL.
- (c-clear-char-property (1- (point)) 'syntax-table))
- (c-clear-char-property (1- (match-end 0)) 'syntax-table)
- (c-truncate-lit-pos-cache (1- (match-end 0))))))))
- ((or (and (equal open-paren-prop '(15)) (null bound))
- (equal open-paren-prop '(1)))
- ;; An unterminated raw string either not in a macro, or in a macro with
- ;; the open parenthesis right up against the end of macro
- (c-clear-char-property open-quote 'syntax-table)
- (c-truncate-lit-pos-cache open-quote)
- (c-clear-char-property open-paren 'syntax-table))
- (t
- ;; An unterminated string in a macro, with at least one char after the
- ;; open paren
- (c-clear-char-property open-quote 'syntax-table)
- (c-truncate-lit-pos-cache open-quote)
- (c-clear-char-property open-paren 'syntax-table)
- (c-clear-char-property-with-value (1+ open-paren) bound 'syntax-table
- '(15))))))
-
-(defun c-depropertize-raw-strings-in-region (start finish)
- ;; Remove any `syntax-table' text properties associated with C++ raw strings
- ;; contained in the region (START FINISH). Point is undefined at entry and
- ;; exit, and the return value has no significance.
- (goto-char start)
- (while (and (< (point) finish)
- (re-search-forward
- (concat "\\(" ; 1
- c-anchored-cpp-prefix ; 2
- "\\)\\|\\(" ; 3
- c-c++-raw-string-opener-re ; 4
- "\\)")
- finish t))
- (when (save-excursion
- (goto-char (match-beginning 0)) (not (c-in-literal)))
- (if (match-beginning 4) ; the id
- ;; We've found a raw string
- (c-depropertize-raw-string
- (match-string-no-properties 4) ; id
- (1+ (match-beginning 3)) ; open quote
- (match-end 4) ; open paren
- nil) ; bound
- ;; We've found a CPP construct. Search for raw strings within it.
- (goto-char (match-beginning 2)) ; the "#"
- (c-end-of-macro)
- (let ((eom (point)))
- (goto-char (match-end 2)) ; after the "#".
- (while (and (< (point) eom)
- (c-syntactic-re-search-forward
- c-c++-raw-string-opener-re eom t))
- (c-depropertize-raw-string
- (match-string-no-properties 1) ; id
- (1+ (match-beginning 0)) ; open quote
- (match-end 1) ; open paren
- eom))))))) ; bound.
-
-(defun c-before-change-check-raw-strings (beg end)
- ;; This function clears `syntax-table' text properties from C++ raw strings
- ;; whose delimiters are about to change in the region (c-new-BEG c-new-END).
- ;; BEG and END are the standard arguments supplied to any before-change
- ;; function.
+ ((or
+ ;; Is HERE between the start of an opener and the "?
+ (and (null (cadr state))
+ (progn
+ ;; Search for the start of the opener.
+ (goto-char (max (- (point) (1- c-ml-string-max-opener-len))
+ (point-min)))
+ (setq found nil)
+ ;; In the next loop, skip over any complete ml strings, or an ml
+ ;; string opener which is in a macro not containing HERE, or an
+ ;; apparent "opener" which is in a comment or string.
+ (while
+ (and (re-search-forward c-ml-string-opener-re
+ (+ here (1-
c-ml-string-max-opener-len))
+ t)
+ (< (match-beginning 1) here)
+ (or
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (or (c-in-literal)
+ (and (c-beginning-of-macro)
+ (< (progn (c-end-of-macro) (point))
+ here))))
+ (and
+ (setq found (match-beginning 1))
+ (<= (point) here)
+ (save-match-data
+ (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties 1))
+ here t))
+ (<= (point) here))))
+ (setq found nil))
+ found))
+ ;; Is HERE after the "?
+ (and (eq (cadr state) 'string)
+ (goto-char (nth 2 state))
+ (c-ml-string-opener-at-or-around-point)))
+ (setq open-dlist (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))
+ (goto-char (cadr open-dlist))
+ (setq ret
+ (cons open-dlist
+ (if (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties 1))
+ nil t)
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2)))
+ nil)))
+ (goto-char here)
+ ret)
+ ;; Is HERE between the " and the end of the closer?
+ ((and (null (cadr state))
+ (progn
+ (if (null c-ml-string-back-closer-re)
+ (goto-char (max (- here (1- c-ml-string-max-closer-len))
+ (point-min)))
+ (goto-char here)
+ (re-search-backward c-ml-string-back-closer-re nil t))
+ (re-search-forward c-ml-string-any-closer-re
+ (+ here -1 c-ml-string-max-closer-len-no-leader)
+ t))
+ (>= (match-end 1) here)
+ (<= (match-end 2) here)
+ (setq close-dlist (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))
+ (goto-char (car close-dlist))
+ (setq state (c-semi-pp-to-literal (point)))
+ (eq (cadr state) 'string)
+ (goto-char (nth 2 state))
+ (setq opener (c-ml-string-opener-around-point))
+ (goto-char (cadr opener))
+ (setq open-dlist (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))
+ (re-search-forward (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties 1))
+ nil t))
+ (goto-char here)
+ (cons open-dlist close-dlist))
+
+ (t (goto-char here)
+ nil))))
+
+(defun c-position-wrt-ml-delims (ml-string-delims)
+ ;; Given ML-STRING-DELIMS, a structure produced by
+ ;; `c-ml-string-delims-around-point' called at point, return one of the
+ ;; following indicating where POINT is with respect to the multi-line
+ ;; string:
+ ;; o - nil; not in the string.
+ ;; o - open-delim: in the open-delimiter.
+ ;; o - close-delim: in the close-delimiter.
+ ;; o - after-close: just after the close-delimiter
+ ;; o - string: inside the delimited string.
+ (cond
+ ((null ml-string-delims)
+ nil)
+ ((< (point) (cadar ml-string-delims))
+ 'open-delim)
+ ((or (null (cdr ml-string-delims))
+ (<= (point) (cadr ml-string-delims)))
+ 'string)
+ ((eq (point) (caddr ml-string-delims))
+ 'after-close)
+ (t 'close-delim)))
+
+(defun c-before-change-check-ml-strings (beg end)
+ ;; This function clears `syntax-table' text properties from multi-line
+ ;; strings whose delimiters are about to change in the region (c-new-BEG
+ ;; c-new-END). BEG and END are the standard arguments supplied to any
+ ;; before-change function.
;;
;; Point is undefined on both entry and exit, and the return value has no
;; significance.
;;
;; This function is called as a before-change function solely due to its
- ;; membership of the C++ value of `c-get-state-before-change-functions'.
+ ;; membership of mode-specific value of
+ ;; `c-get-state-before-change-functions'.
(goto-char end)
- (setq c-raw-string-end-delim-disrupted nil)
+ (setq c-ml-string-end-delim-disrupted nil)
;; We use the following to detect a R"<id>( being swallowed into a string by
;; the pending change.
(setq c-old-END-literality (c-in-literal))
+ (goto-char beg)
+ (setq c-old-beg-ml (c-ml-string-delims-around-point))
+ (setq c-beg-pos (c-position-wrt-ml-delims c-old-beg-ml))
+ (setq c-old-1-beg-ml
+ (and (not (or c-old-beg-ml (bobp)))
+ (goto-char (1- beg))
+ (c-ml-string-delims-around-point)))
+ (goto-char end)
+ (setq c-old-end-ml
+ (if (or (eq end beg)
+ (and c-old-beg-ml
+ (>= end (caar c-old-beg-ml))
+ (or (null (cdr c-old-beg-ml))
+ (< end (caddr c-old-beg-ml)))))
+ c-old-beg-ml
+ (c-ml-string-delims-around-point)))
+ (setq c-end-pos (c-position-wrt-ml-delims c-old-end-ml))
+
(c-save-buffer-state
- ((term-del (c-raw-string-in-end-delim beg end))
+ ((term-del (c-ml-string-in-end-delim beg end (car c-old-beg-ml)))
Rquote close-quote)
- (setq c-old-beg-rs (progn (goto-char beg) (c-raw-string-pos))
- c-old-end-rs (progn (goto-char end) (c-raw-string-pos)))
(cond
- ;; We're not changing, or we're obliterating raw strings.
- ((and (null c-old-beg-rs) (null c-old-end-rs)))
- ;; We're changing the putative terminating delimiter of a raw string
+ ;; We're not changing, or we're obliterating ml strings.
+ ((and (null c-beg-pos) (null c-end-pos)))
+ ;; We're changing the putative terminating delimiter of an ml string
;; containing BEG.
- ((and c-old-beg-rs term-del
- (or (null (nth 3 c-old-beg-rs))
- (<= (car term-del) (nth 3 c-old-beg-rs))))
- (setq Rquote (1- (cadr c-old-beg-rs))
- close-quote (1+ (cdr term-del)))
- (setq c-raw-string-end-delim-disrupted t)
- (c-depropertize-raw-strings-in-region Rquote close-quote)
+ ((and c-beg-pos term-del
+ (or (null (cdr c-old-beg-ml))
+ (<= (car term-del) (cadr c-old-beg-ml))))
+ (setq Rquote (caar c-old-beg-ml)
+ close-quote (cdr term-del))
+ (setq c-ml-string-end-delim-disrupted t)
+ (c-depropertize-ml-strings-in-region Rquote close-quote)
(setq c-new-BEG (min c-new-BEG Rquote)
c-new-END (max c-new-END close-quote)))
;; We're breaking an escaped NL in a raw string in a macro.
- ((and c-old-end-rs
+ ((and c-old-end-ml
(< beg end)
(goto-char end) (eq (char-before) ?\\)
(c-beginning-of-macro))
(let ((bom (point))
(eom (progn (c-end-of-macro) (point))))
- (c-depropertize-raw-strings-in-region bom eom)
+ (c-depropertize-ml-strings-in-region bom eom)
(setq c-new-BEG (min c-new-BEG bom)
c-new-END (max c-new-END eom))))
;; We're changing only the contents of a raw string.
- ((and (equal (cdr c-old-beg-rs) (cdr c-old-end-rs))
- (null (car c-old-beg-rs)) (null (car c-old-end-rs))))
+ ;; Any critical deletion of "s will be handled in
+ ;; `c-after-change-unmark-ml-strings'.
+ ((and (equal c-old-beg-ml c-old-end-ml)
+ (eq c-beg-pos 'string) (eq c-end-pos 'string)))
((or
;; We're removing (at least part of) the R" of the starting delim of a
;; raw string:
- (null c-old-beg-rs)
- (and (eq beg (cadr c-old-beg-rs))
+ (null c-old-beg-ml)
+ (and (eq beg (caar c-old-beg-ml))
(< beg end))
;; Or we're removing the ( of the starting delim of a raw string.
- (and (eq (car c-old-beg-rs) 'open-delim)
- (or (null c-old-end-rs)
- (not (eq (car c-old-end-rs) 'open-delim))
- (not (equal (cdr c-old-beg-rs) (cdr c-old-end-rs))))))
- (let ((close (nth 4 (or c-old-end-rs c-old-beg-rs))))
- (setq Rquote (1- (cadr (or c-old-end-rs c-old-beg-rs)))
- close-quote (if close (1+ close) (point-max))))
- (c-depropertize-raw-strings-in-region Rquote close-quote)
+ (and (eq c-beg-pos 'open-delim)
+ (or (null c-old-end-ml)
+ (not (eq c-end-pos 'open-delim))
+ (not (equal c-old-beg-ml c-old-end-ml))))
+ ;; Or we're disrupting a starting delim by typing into it, or removing
+ ;; characters from it.
+ (and (eq c-beg-pos 'open-delim)
+ (eq c-end-pos 'open-delim)
+ (equal c-old-beg-ml c-old-end-ml)))
+ (let ((close (caddr (or c-old-end-ml c-old-beg-ml))))
+ (setq Rquote (caar (or c-old-end-ml c-old-beg-ml))
+ close-quote (or close (point-max))))
+ (c-depropertize-ml-strings-in-region Rquote close-quote)
(setq c-new-BEG (min c-new-BEG Rquote)
- c-new-END (max c-new-END close-quote)))
- ;; We're changing only the text of the identifier of the opening
- ;; delimiter of a raw string.
- ((and (eq (car c-old-beg-rs) 'open-delim)
- (equal c-old-beg-rs c-old-end-rs))))))
-
-(defun c-propertize-raw-string-id (start end)
- ;; If the raw string identifier between buffer positions START and END
- ;; contains any double quote characters, put a punctuation syntax-table text
- ;; property on them. The return value is of no significance.
- (save-excursion
- (goto-char start)
- (while (and (skip-chars-forward "^\"" end)
- (< (point) end))
- (c-put-char-property (point) 'syntax-table '(1))
- (c-truncate-lit-pos-cache (point))
- (forward-char))))
-
-(defun c-propertize-raw-string-opener (id open-quote open-paren bound)
- ;; Point is immediately after a raw string opening delimiter. Apply any
- ;; pertinent `syntax-table' text properties to the delimiter and also the
- ;; raw string, should there be a valid matching closing delimiter.
- ;;
- ;; ID, a string, is the delimiter's identifier. OPEN-QUOTE and OPEN-PAREN
- ;; are the buffer positions of the delimiter's components. BOUND is the
- ;; bound for searching for a matching closing delimiter; it is usually nil,
- ;; but if we're inside a macro, it's the end of the macro (i.e. the position
- ;; of the closing newline).
- ;;
- ;; Point is moved to after the (terminated) raw string and t is returned, or
- ;; it is left after the unmatched opening delimiter and nil is returned.
- (c-propertize-raw-string-id (1+ open-quote) open-paren)
- (prog1
- (if (search-forward (concat ")" id "\"") bound t)
- (let ((end-string (match-beginning 0))
- (after-quote (match-end 0)))
- (c-propertize-raw-string-id
- (1+ (match-beginning 0)) (1- (match-end 0)))
- (goto-char open-paren)
- (while (progn (skip-syntax-forward "^\"" end-string)
- (< (point) end-string))
- (c-put-char-property (point) 'syntax-table '(1)) ; punctuation
- (c-truncate-lit-pos-cache (point))
- (forward-char))
- (goto-char after-quote)
- t)
- (c-put-char-property open-quote 'syntax-table '(1)) ; punctuation
- (c-truncate-lit-pos-cache open-quote)
- (c-put-char-property open-paren 'syntax-table '(15)) ; generic string
- (when bound
- ;; In a CPP construct, we try to apply a generic-string
- ;; `syntax-table' text property to the last possible character in
- ;; the string, so that only characters within the macro get
- ;; "stringed out".
- (goto-char bound)
- (if (save-restriction
- (narrow-to-region (1+ open-paren) (point-max))
- (re-search-backward
- (eval-when-compile
- ;; This regular expression matches either an escape pair
- ;; (which isn't an escaped NL) (submatch 5) or a
- ;; non-escaped character (which isn't itself a backslash)
- ;; (submatch 10). The long preambles to these
- ;; (respectively submatches 2-4 and 6-9) ensure that we
- ;; have the correct parity for sequences of backslashes,
- ;; etc..
- (concat "\\(" ; 1
-
"\\(\\`[^\\]?\\|[^\\][^\\]\\)\\(\\\\\\(.\\|\n\\)\\)*" ; 2-4
- "\\(\\\\.\\)" ; 5
- "\\|"
-
"\\(\\`\\|[^\\]\\|\\(\\`[^\\]?\\|[^\\][^\\]\\)\\(\\\\\\(.\\|\n\\)\\)+\\)" ; 6-9
- "\\([^\\]\\)" ; 10
- "\\)"
- "\\(\\\\\n\\)*\\=")) ; 11
- (1+ open-paren) t))
- (if (match-beginning 10)
- (progn
- (c-put-char-property (match-beginning 10) 'syntax-table
'(15))
- (c-truncate-lit-pos-cache (match-beginning 10)))
- (c-put-char-property (match-beginning 5) 'syntax-table '(1))
- (c-put-char-property (1+ (match-beginning 5)) 'syntax-table
'(15))
- (c-truncate-lit-pos-cache (1+ (match-beginning 5))))
- ;; (c-put-char-property open-paren 'syntax-table '(1))
- )
- (goto-char bound))
- nil)))
+ c-new-END (max c-new-END close-quote))))))
-(defun c-after-change-unmark-raw-strings (beg end _old-len)
- ;; This function removes `syntax-table' text properties from any raw strings
+(defun c-after-change-unmark-ml-strings (beg end old-len)
+ ;; This function removes `syntax-table' text properties from any ml strings
;; which have been affected by the current change. These are those which
- ;; have been "stringed out" and from newly formed raw strings, or any
- ;; existing raw string which the new text terminates. BEG, END, and
- ;; _OLD-LEN are the standard arguments supplied to any
+ ;; have been "stringed out" and from newly formed ml strings, or any
+ ;; existing ml string which the new text terminates. BEG, END, and
+ ;; OLD-LEN are the standard arguments supplied to any
;; after-change-function.
;;
;; Point is undefined on both entry and exit, and the return value has no
;; significance.
;;
;; This functions is called as an after-change function by virtue of its
- ;; membership of the C++ value of `c-before-font-lock-functions'.
+ ;; membership of the mode's value of `c-before-font-lock-functions'.
;; (when (< beg end)
- (c-save-buffer-state (found eoll state id found-beg)
- ;; Has an inserted " swallowed up a R"(, turning it into "...R"(?
+ ;;
+ ;; Maintainers' note: Be careful with the use of `c-old-beg-ml' and
+ ;; `c-old-end-ml'; since text has been inserted or removed, most of the
+ ;; components in these variables will no longer be valid. (caar
+ ;; c-old-beg-ml) is normally OK, (cadar c-old-beg-ml) often is, any others
+ ;; will need adjstments.
+ (c-save-buffer-state (found eoll state opener)
+ ;; Has an inserted " swallowed up a R"(, turning it into "...R"(?
+ (goto-char end)
+ (setq eoll (c-point 'eoll))
+ (when (and (null c-old-END-literality)
+ (search-forward-regexp c-ml-string-opener-re eoll t))
+ (setq state (c-semi-pp-to-literal end))
+ (when (eq (cadr state) 'string)
+ (unwind-protect
+ ;; Temporarily insert a closing string delimiter....
+ (progn
+ (goto-char end)
+ (cond
+ ((c-characterp (nth 3 (car state)))
+ (insert (nth 3 (car state))))
+ ((eq (nth 3 (car state)) t)
+ (insert ?\")
+ (c-put-char-property end 'syntax-table '(15))))
+ (c-truncate-lit-pos-cache end)
+ ;; ....ensure c-new-END extends right to the end of the about
+ ;; to be un-stringed raw string....
+ (save-excursion
+ (goto-char (1+ (match-end 1))) ; Count inserted " too.
+ (setq c-new-END
+ (max c-new-END
+ (if (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties 1))
+ nil t)
+ (1- (match-end 1)) ; 1- For the inserted ".
+ eoll))))
+
+ ;; ...and clear `syntax-table' text propertes from the
+ ;; following raw strings.
+ (c-depropertize-ml-strings-in-region (point) (1+ eoll)))
+ ;; Remove the temporary string delimiter.
+ (goto-char end)
+ (delete-char 1)
+ (c-truncate-lit-pos-cache end))))
+
+ ;; Have we just created a new starting id?
+ (goto-char beg)
+ (setq opener
+ (if (eq beg end)
+ (c-ml-string-opener-at-or-around-point end)
+ (c-ml-string-opener-intersects-region beg end)))
+ (when
+ (and opener (<= (car opener) end)
+ (setq state (c-semi-pp-to-literal (car opener)))
+ (not (cadr state)))
+ (setq c-new-BEG (min c-new-BEG (car opener)))
+ (goto-char (cadr opener))
+ (when (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (buffer-substring-no-properties
+ (car opener) (cadr opener)))
+ nil t) ; No bound
+ (setq c-new-END (max c-new-END (match-end 1))))
+ (goto-char c-new-BEG)
+ (while (c-search-forward-char-property-with-value-on-char
+ 'syntax-table '(15) ?\" c-new-END)
+ (c-remove-string-fences (1- (point))))
+ (c-depropertize-ml-strings-in-region c-new-BEG c-new-END))
+
+ ;; Have we matched up with an existing terminator by typing into or
+ ;; deleting from an opening delimiter? ... or by messing up a raw string's
+ ;; terminator so that it now matches a later terminator?
+ (when
+ (cond
+ ((or c-ml-string-end-delim-disrupted
+ (and c-old-beg-ml
+ (eq c-beg-pos 'open-delim)))
+ (goto-char (caar c-old-beg-ml)))
+ ((and (< beg end)
+ (not c-old-beg-ml)
+ c-old-1-beg-ml
+ (save-excursion
+ (goto-char (1- beg))
+ (c-ml-string-back-to-neutral (caar c-old-1-beg-ml))
+ (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (buffer-substring-no-properties
+ (caar c-old-1-beg-ml)
+ (cadar c-old-1-beg-ml)))
+ nil 'bound)
+ (> (point) beg)))
+ (goto-char (caar c-old-1-beg-ml))
+ (setq c-new-BEG (min c-new-BEG (point)))
+ (c-truncate-lit-pos-cache (point))))
+
+ (when (looking-at c-ml-string-opener-re)
+ (goto-char (match-end 1))
+ (when (re-search-forward (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties 1))
+ nil t) ; No bound
+ ;; If what is to be the new delimiter was previously an unterminated
+ ;; ordinary string, clear the c-fl-syn-tab properties from this old
+ ;; string.
+ (when (c-get-char-property (match-beginning 2) 'c-fl-syn-tab)
+ (c-remove-string-fences (match-beginning 2)))
+ (setq c-new-END (point-max))
+ (c-clear-char-properties (caar (or c-old-beg-ml c-old-1-beg-ml))
+ c-new-END
+ 'syntax-table)
+ (c-truncate-lit-pos-cache
+ (caar (or c-old-beg-ml c-old-1-beg-ml))))))
+
+ ;; Have we disturbed the innards of an ml string, possibly by deleting "s?
+ (when (and
+ c-old-beg-ml
+ (eq c-beg-pos 'string)
+ (eq beg end))
+ (goto-char beg)
+ (c-ml-string-back-to-neutral (caar c-old-beg-ml))
+ (let ((bound (if (cdr c-old-end-ml)
+ (min (+ (- (caddr c-old-end-ml) old-len)
+ c-ml-string-max-closer-len-no-leader)
+ (point-max))
+ (point-max)))
+ (new-END-end-ml-string
+ (if (cdr c-old-end-ml)
+ (- (caddr c-old-end-ml) old-len)
+ (point-max))))
+ (when (and
+ (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (buffer-substring-no-properties
+ (caar c-old-beg-ml) (cadar c-old-beg-ml)))
+ bound 'bound)
+ (< (match-end 1) new-END-end-ml-string))
+ (setq c-new-END (max new-END-end-ml-string c-new-END))
+ (c-clear-char-properties (caar c-old-beg-ml) c-new-END
+ 'syntax-table)
+ (setq c-new-BEG (min (caar c-old-beg-ml) c-new-BEG))
+ (c-truncate-lit-pos-cache (caar c-old-beg-ml)))))
+
+ ;; Have we terminated an existing raw string by inserting or removing
+ ;; text?
+ (when
+ (and
+ (< beg end)
+ (eq c-old-END-literality 'string)
+ c-old-beg-ml)
+ ;; Have we just made or modified a closing delimiter?
(goto-char end)
- (setq eoll (c-point 'eoll))
- (when (and (null c-old-END-literality)
- (search-forward-regexp c-c++-raw-string-opener-re eoll t))
- (setq state (c-semi-pp-to-literal end))
- (when (eq (cadr state) 'string)
- (unwind-protect
- ;; Temporarily insert a closing string delimiter....
- (progn
- (goto-char end)
- (cond
- ((c-characterp (nth 3 (car state)))
- (insert (nth 3 (car state))))
- ((eq (nth 3 (car state)) t)
- (insert ?\")
- (c-put-char-property end 'syntax-table '(15))))
- (c-truncate-lit-pos-cache end)
- ;; ....ensure c-new-END extends right to the end of the about
- ;; to be un-stringed raw string....
- (save-excursion
- (goto-char (match-beginning 1))
- (let ((end-bs (c-raw-string-pos)))
- (setq c-new-END
- (max c-new-END
- (if (nth 4 end-bs)
- (1+ (nth 4 end-bs))
- eoll)))))
-
- ;; ...and clear `syntax-table' text propertes from the
- ;; following raw strings.
- (c-depropertize-raw-strings-in-region (point) (1+ eoll)))
- ;; Remove the temporary string delimiter.
- (goto-char end)
- (delete-char 1))))
-
- ;; Have we just created a new starting id?
- (goto-char (max (- beg 18) (point-min)))
+ (c-ml-string-back-to-neutral (caar c-old-beg-ml))
(while
(and
(setq found
- (search-forward-regexp c-c++-raw-string-opener-re
- c-new-END 'bound))
- (<= (match-end 0) beg)))
+ (search-forward-regexp
+ c-ml-string-any-closer-re
+ (+ (c-point 'eol end)
+ (1- c-ml-string-max-closer-len-no-leader))
+ t))
+ (< (match-end 1) beg))
+ (goto-char (match-end 1)))
(when (and found (<= (match-beginning 0) end))
- (setq c-new-BEG (min c-new-BEG (match-beginning 0)))
- (c-depropertize-raw-strings-in-region c-new-BEG c-new-END))
-
- ;; Have we invalidated an opening delimiter by typing into it?
- (when (and c-old-beg-rs
- (eq (car c-old-beg-rs) 'open-delim)
- (equal (c-get-char-property (cadr c-old-beg-rs)
- 'syntax-table)
- '(1)))
- (goto-char (1- (cadr c-old-beg-rs)))
- (unless (looking-at c-c++-raw-string-opener-re)
- (c-clear-char-property (1+ (point)) 'syntax-table)
- (c-truncate-lit-pos-cache (1+ (point)))
- (if (c-search-forward-char-property 'syntax-table '(15)
- (c-point 'eol))
- (c-clear-char-property (1- (point)) 'syntax-table))))
-
- ;; Have we matched up with an existing terminator by typing into an
- ;; opening delimiter? ... or by messing up a raw string's terminator so
- ;; that it now matches a later terminator?
- (when
- (or c-raw-string-end-delim-disrupted
- (and c-old-beg-rs
- (eq (car c-old-beg-rs) 'open-delim)))
- (goto-char (cadr c-old-beg-rs))
- (when (looking-at c-c++-raw-string-opener-1-re)
- (setq id (match-string-no-properties 1))
- (when (search-forward (concat ")" id "\"") nil t) ; No bound.
- (setq c-new-END (point-max))
- (c-clear-char-properties (cadr c-old-beg-rs) c-new-END
- 'syntax-table)
- (c-truncate-lit-pos-cache (cadr c-old-beg-rs)))))
- ;; Have we terminated an existing raw string by inserting or removing
- ;; text?
- (when (eq c-old-END-literality 'string)
- ;; Have we just made or modified a closing delimiter?
- (goto-char (max (- beg 18) (point-min)))
- (while
- (and
- (setq found
- (search-forward-regexp ")\\([^ ()\\\n\r\t]\\{0,16\\}\\)\""
- (+ end 17) t))
- (< (match-end 0) beg)))
- (when (and found (<= (match-beginning 0) end))
- (setq id (match-string-no-properties 1))
- (goto-char (match-beginning 0))
+ (let ((opener-re (funcall c-make-ml-string-opener-re-function
+ (match-string 1))))
(while
(and
- (setq found (search-backward (concat "R\"" id "(") nil t))
+ (setq found (re-search-backward opener-re nil t))
(setq state (c-semi-pp-to-literal (point)))
- (memq (nth 3 (car state)) '(t ?\"))))
- (when found
- (setq c-new-BEG (min (point) c-new-BEG)
- c-new-END (point-max))
- (c-clear-syn-tab-properties (point) c-new-END)
- (c-truncate-lit-pos-cache (point)))))
-
- ;; Are there any raw strings in a newly created macro?
- (when (< beg end)
- (goto-char beg)
- (setq found-beg (point))
- (when (search-forward-regexp c-anchored-cpp-prefix end t)
+ (memq (nth 3 (car state)) '(t ?\")))))
+ (when found
+ (setq c-new-BEG (min (point) c-new-BEG)
+ c-new-END (point-max))
+ (c-clear-syn-tab-properties (point) c-new-END)
+ (c-truncate-lit-pos-cache (point)))))
+
+ ;; Are there any raw strings in a newly created macro?
+ (goto-char (c-point 'bol beg))
+ (while (and (< (point) (c-point 'eol end))
+ (re-search-forward c-anchored-cpp-prefix (c-point 'eol end)
+ 'boundt))
+ (when (and (<= beg (match-end 1))
+ (>= end (match-beginning 1)))
+ (goto-char (match-beginning 1))
(c-end-of-macro)
- (c-depropertize-raw-strings-in-region found-beg (point))))))
+ (c-depropertize-ml-strings-in-region
+ (match-beginning 1) (point))))))
-(defun c-maybe-re-mark-raw-string ()
+(defun c-maybe-re-mark-ml-string ()
;; When this function is called, point is immediately after a " which opens
- ;; a string. If this " is the characteristic " of a raw string
- ;; opener, apply the pertinent `syntax-table' text properties to the
- ;; entire raw string (when properly terminated) or just the delimiter
- ;; (otherwise). In either of these cases, return t, otherwise return nil.
- ;;
- (let (in-macro macro-end)
+ ;; a string. If this " is the characteristic " of a multi-line string
+ ;; opener, apply the pertinent `syntax-table' text properties to the entire
+ ;; ml string (when properly terminated) or just the delimiter (otherwise).
+ ;; In either of these cases, return t, otherwise return nil. Point is moved
+ ;; to after the terminated raw string, or to the end of the containing
+ ;; macro, or to point-max.
+ ;;
+ (let (delim in-macro macro-end)
(when
(and
- (eq (char-before (1- (point))) ?R)
- (looking-at "\\([^ ()\\\n\r\t]\\{0,16\\}\\)("))
+ (setq delim (c-ml-string-opener-at-or-around-point (1- (point))))
+ (save-excursion
+ (goto-char (car delim))
+ (not (c-in-literal))))
(save-excursion
(setq in-macro (c-beginning-of-macro))
(setq macro-end (when in-macro
(c-end-of-macro)
- (point) ;; (min (1+ (point)) (point-max))
+ (point)
)))
(when
(not
- (c-propertize-raw-string-opener
- (match-string-no-properties 1) ; id
- (1- (point)) ; open quote
- (match-end 1) ; open paren
- macro-end)) ; bound (end of macro) or nil.
+ (c-propertize-ml-string-opener
+ delim
+ macro-end)) ; bound (end of macro) or nil.
(goto-char (or macro-end (point-max))))
t)))
+(defun c-propertize-ml-string-id (delim)
+ ;; Apply punctuation ('(1)) syntax-table text properties to the opening or
+ ;; closing delimiter given by the three element dotted list DELIM, such that
+ ;; its "total syntactic effect" is that of a single ".
+ (save-excursion
+ (goto-char (car delim))
+ (while (and (skip-chars-forward c-ml-string-non-punc-skip-chars
+ (cadr delim))
+ (< (point) (cadr delim)))
+ (when (not (eq (point) (cddr delim)))
+ (c-put-char-property (point) 'syntax-table '(1))
+ (c-truncate-lit-pos-cache (point)))
+ (forward-char))))
+
+(defun c-propertize-ml-string-opener (delim bound)
+ ;; DELIM defines the opening delimiter of a multi-line string in the
+ ;; way returned by `c-ml-string-opener-around-point'. Apply any
+ ;; pertinent `syntax-table' text properties to this opening delimiter and in
+ ;; the case of a terminated ml string, also to the innards of the string and
+ ;; the terminating delimiter.
+ ;;
+ ;; BOUND is the end of the macro we're inside (i.e. the position of the
+ ;; closing newline), if any, otherwise nil.
+ ;;
+ ;; Point is undefined at the function start. For a terminated ml string,
+ ;; point is left after the terminating delimiter and t is returned. For an
+ ;; unterminated string, point is left at the end of the macro, if any, or
+ ;; after the unmatched opening delimiter, and nil is returned.
+ (c-propertize-ml-string-id delim)
+ (goto-char (cadr delim))
+ (if (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (buffer-substring-no-properties
+ (car delim) (cadr delim)))
+ bound t)
+
+ (let ((end-delim
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2)))))
+ (c-propertize-ml-string-id end-delim)
+ (goto-char (cadr delim))
+ (while (progn (skip-syntax-forward c-ml-string-non-punc-skip-chars
+ (car end-delim))
+ (< (point) (car end-delim)))
+ (c-put-char-property (point) 'syntax-table '(1)) ; punctuation
+ (c-truncate-lit-pos-cache (point))
+ (forward-char))
+ (goto-char (cadr end-delim))
+ t)
+ (c-put-char-property (cddr delim) 'syntax-table '(1))
+ (c-put-char-property (1- (cadr delim)) 'syntax-table '(15))
+ (c-truncate-lit-pos-cache (1- (cddr delim)))
+ (when bound
+ ;; In a CPP construct, we try to apply a generic-string
+ ;; `syntax-table' text property to the last possible character in
+ ;; the string, so that only characters within the macro get
+ ;; "stringed out".
+ (goto-char bound)
+ (if (save-restriction
+ (narrow-to-region (cadr delim) (point-max))
+ (re-search-backward
+ (eval-when-compile
+ ;; This regular expression matches either an escape pair
+ ;; (which isn't an escaped NL) (submatch 5) or a
+ ;; non-escaped character (which isn't itself a backslash)
+ ;; (submatch 10). The long preambles to these
+ ;; (respectively submatches 2-4 and 6-9) ensure that we
+ ;; have the correct parity for sequences of backslashes,
+ ;; etc..
+ (concat "\\(" ; 1
+ "\\(\\`[^\\]?\\|[^\\][^\\]\\)\\(\\\\\\(.\\|\n\\)\\)*" ;
2-4
+ "\\(\\\\.\\)" ; 5
+ "\\|"
+
"\\(\\`\\|[^\\]\\|\\(\\`[^\\]?\\|[^\\][^\\]\\)\\(\\\\\\(.\\|\n\\)\\)+\\)" ; 6-9
+ "\\([^\\]\\)" ; 10
+ "\\)"
+ "\\(\\\\\n\\)*\\=")) ; 11
+ (cadr delim) t))
+ (if (match-beginning 10)
+ (progn
+ (c-put-char-property (match-beginning 10) 'syntax-table '(15))
+ (c-truncate-lit-pos-cache (match-beginning 10)))
+ (c-put-char-property (match-beginning 5) 'syntax-table '(1))
+ (c-put-char-property (1+ (match-beginning 5)) 'syntax-table '(15))
+ (c-truncate-lit-pos-cache (match-beginning 5))))
+ (goto-char bound))
+ nil))
+
+(defvar c-neutralize-pos nil)
+ ;; Buffer position of character neutralized by punctuation syntax-table
+ ;; text property ('(1)), or nil if there's no such character.
+(defvar c-neutralized-prop nil)
+ ;; syntax-table text property that was on the character at
+ ;; `c-neutralize-pos' before it was replaced with '(1), or nil if none.
+
+(defun c-depropertize-ml-string (string-delims bound)
+ ;; Remove any `syntax-table' text properties associated with the opening
+ ;; delimiter of a multi-line string (if it's unmatched) or with the entire
+ ;; string. Exception: A single punctuation ('(1)) property will be left on
+ ;; a string character to make the entire set of multi-line strings
+ ;; syntactically neutral. This is done using the global variable
+ ;; `c-neutralize-pos', the position of this property (or nil if there is
+ ;; none).
+ ;;
+ ;; STRING-DELIMS, of the form of the output from
+ ;; `c-ml-string-delims-around-point' defines the current ml string. BOUND
+ ;; is the bound for searching for a matching closing delimiter; it is
+ ;; usually nil, but if we're inside a macro, it's the end of the macro
+ ;; (i.e. just before the terminating \n).
+ ;;
+ ;; Point is undefined on input, and is moved to after the (terminated) raw
+ ;; string, or left after the unmatched opening delimiter, as the case may
+ ;; be. The return value is of no significance.
+
+ ;; Handle the special case of a closing " previously having been an
+ ;; unterminated ordinary string.
+ (when
+ (and
+ (cdr string-delims)
+ (equal (c-get-char-property (cdddr string-delims) ; pos of closing ".
+ 'syntax-table)
+ '(15)))
+ (goto-char (cdddr string-delims))
+ (when (c-safe (c-forward-sexp)) ; To '(15) at EOL.
+ (c-clear-char-property (1- (point)) 'syntax-table)
+ (c-truncate-lit-pos-cache (1- (point)))))
+ ;; The '(15) in the closing delimiter will be cleared by the following.
+
+ (c-depropertize-ml-string-delims string-delims)
+ (let ((bound1 (if (cdr string-delims)
+ (caddr string-delims) ; end of closing delimiter.
+ bound))
+ first s)
+ (if (and
+ bound1
+ (setq first (c-clear-char-properties (cadar string-delims) bound1
+ 'syntax-table)))
+ (c-truncate-lit-pos-cache first))
+ (setq s (parse-partial-sexp (or c-neutralize-pos (caar string-delims))
+ (or bound1 (point-max))))
+ (cond
+ ((not (nth 3 s))) ; Nothing changed by this ml-string.
+ ((not c-neutralize-pos) ; "New" unbalanced quote in this ml-s.
+ (setq c-neutralize-pos (nth 8 s))
+ (setq c-neutralized-prop (c-get-char-property c-neutralize-pos
+ 'syntax-table))
+ (c-put-char-property c-neutralize-pos 'syntax-table '(1))
+ (c-truncate-lit-pos-cache c-neutralize-pos))
+ ((eq (nth 3 s) (char-after c-neutralize-pos))
+ ;; New unbalanced quote balances old one.
+ (if c-neutralized-prop
+ (c-put-char-property c-neutralize-pos 'syntax-table
+ c-neutralized-prop)
+ (c-clear-char-property c-neutralize-pos 'syntax-table))
+ (c-truncate-lit-pos-cache c-neutralize-pos)
+ (setq c-neutralize-pos nil))
+ ;; New unbalanced quote doesn't balance old one. Nothing to do.
+ )))
+
+(defun c-depropertize-ml-strings-in-region (start finish)
+ ;; Remove any `syntax-table' text properties associated with multi-line
+ ;; strings contained in the region (START FINISH). Point is undefined at
+ ;; entry and exit, and the return value has no significance.
+ (setq c-neutralize-pos nil)
+ (goto-char start)
+ (while (and (< (point) finish)
+ (re-search-forward
+ c-ml-string-cpp-or-opener-re
+ finish t))
+ (if (match-beginning (+ c-cpp-or-ml-match-offset 1)) ; opening delimiter
+ ;; We've found a raw string
+ (let ((open-delim
+ (cons (match-beginning (+ c-cpp-or-ml-match-offset 1))
+ (cons (match-end (+ c-cpp-or-ml-match-offset 1))
+ (match-beginning (+ c-cpp-or-ml-match-offset 2))))))
+ (c-depropertize-ml-string
+ (cons open-delim
+ (when
+ (and
+ (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties
+ (+ c-cpp-or-ml-match-offset 1)))
+ (min (+ finish c-ml-string-max-closer-len-no-leader)
+ (point-max))
+ t)
+ (<= (match-end 1) finish))
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2)))))
+ nil)) ; bound
+ ;; We've found a CPP construct. Search for raw strings within it.
+ (goto-char (match-beginning 2)) ; the "#"
+ (c-end-of-macro)
+ (let ((eom (point)))
+ (goto-char (match-end 2)) ; after the "#".
+ (while (and (< (point) eom)
+ (c-syntactic-re-search-forward
+ c-ml-string-opener-re eom t))
+ (save-excursion
+ (let ((open-delim (cons (match-beginning 1)
+ (cons (match-end 1)
+ (match-beginning 2)))))
+ (c-depropertize-ml-string
+ (cons open-delim
+ (when (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties 1))
+ eom t)
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2)))))
+ eom))))))) ; bound.
+ (when c-neutralize-pos
+ (if c-neutralized-prop
+ (c-put-char-property c-neutralize-pos 'syntax-table
+ c-neutralized-prop)
+ (c-clear-char-property c-neutralize-pos 'syntax-table))
+ (c-truncate-lit-pos-cache c-neutralize-pos)))
+
;; Handling of small scale constructs like types and names.
@@ -11887,12 +12288,15 @@ comment at the start of cc-engine.el for more info."
pos2 in-paren parens-before-brace
paren-state paren-pos)
- (setq res (c-backward-token-2 1 t lim))
+ (setq res
+ (or (progn (c-backward-syntactic-ws)
+ (c-back-over-compound-identifier))
+ (c-backward-token-2 1 t lim)))
;; Checks to do only on the first sexp before the brace.
;; Have we a C++ initialization, without an "="?
(if (and (c-major-mode-is 'c++-mode)
(cond
- ((and (or (not (eq res 0))
+ ((and (or (not (memq res '(t 0)))
(eq (char-after) ?,))
(setq paren-state (c-parse-state))
(setq paren-pos (c-pull-open-brace paren-state))
@@ -11916,7 +12320,7 @@ comment at the start of cc-engine.el for more info."
(t nil))
(save-excursion
(cond
- ((or (not (eq res 0))
+ ((or (not (memq res '(t 0)))
(eq (char-after) ?,))
(and (setq paren-state (c-parse-state))
(setq paren-pos (c-pull-open-brace paren-state))
@@ -12274,7 +12678,7 @@ comment at the start of cc-engine.el for more info."
(save-excursion
(while
(progn
- (c-syntactic-skip-backward "^;=}>" closest-lim t)
+ (c-syntactic-skip-backward "^;=,}>" closest-lim
t)
(and (eq (char-before) ?>)
(c-backward-token-2)
(not (looking-at c-haskell-op-re)))))
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index a7c8712..7e7053b 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -781,9 +781,9 @@ casts and declarations are fontified. Used on level 2 and
higher."
;; Invalid single quotes.
c-font-lock-invalid-single-quotes
- ;; Fontify C++ raw strings.
- ,@(when (c-major-mode-is 'c++-mode)
- '(c-font-lock-raw-strings))
+ ;; Fontify multiline strings.
+ ,@(when (c-lang-const c-ml-string-opener-re)
+ '(c-font-lock-ml-strings))
;; Fontify keyword constants.
,@(when (c-lang-const c-constant-kwds)
@@ -1737,8 +1737,8 @@ casts and declarations are fontified. Used on level 2
and higher."
(c-font-lock-declarators limit t in-typedef
(not (c-bs-at-toplevel-p
(point)))))))))))
-(defun c-font-lock-raw-strings (limit)
- ;; Fontify C++ raw strings.
+(defun c-font-lock-ml-strings (limit)
+ ;; Fontify multi-line strings.
;;
;; This function will be called from font-lock for a region bounded by POINT
;; and LIMIT, as though it were to identify a keyword for
@@ -1748,52 +1748,75 @@ casts and declarations are fontified. Used on level 2
and higher."
(let* ((state (c-semi-pp-to-literal (point)))
(string-start (and (eq (cadr state) 'string)
(car (cddr state))))
- (raw-id (and string-start
- (c-at-c++-raw-string-opener string-start)
- (match-string-no-properties 1)))
- (content-start (and raw-id (point))))
+ (open-delim (and string-start
+ (save-excursion
+ (goto-char (1+ string-start))
+ (c-ml-string-opener-around-point))))
+ (string-delims (and open-delim
+ (cons open-delim (c-get-ml-closer open-delim))))
+ found)
;; We go round the next loop twice per raw string, once for each "end".
(while (< (point) limit)
- (if raw-id
- ;; Search for the raw string end delimiter
- (progn
- (when (search-forward-regexp (concat ")\\(" (regexp-quote raw-id)
"\\)\"")
- limit 'limit)
- (c-put-font-lock-face content-start (match-beginning 1)
- 'font-lock-string-face)
- (c-remove-font-lock-face (match-beginning 1) (point)))
- (setq raw-id nil))
- ;; Search for the start of a raw string.
- (when (search-forward-regexp
- "R\\(\"\\)\\([^ ()\\\n\r\t]\\{0,16\\}\\)(" limit 'limit)
- (when
- ;; Make sure we're not in a comment or string.
- (and
- (not (memq (c-get-char-property (match-beginning 0) 'face)
- '(font-lock-comment-face
font-lock-comment-delimiter-face
- font-lock-string-face)))
- (or (and (eobp)
- (eq (c-get-char-property (1- (point)) 'face)
- 'font-lock-warning-face))
- (not (eq (c-get-char-property (point) 'face)
'font-lock-comment-face))
- ;; (eq (c-get-char-property (point) 'face)
'font-lock-string-face)
- (and (equal (c-get-char-property (match-end 2)
'syntax-table) '(1))
- (equal (c-get-char-property (match-beginning 1)
'syntax-table)
- '(1)))))
- (let ((paren-prop (c-get-char-property (1- (point)) 'syntax-table)))
- (if paren-prop
- (progn
- (c-put-font-lock-face (match-beginning 0) (match-end 0)
- 'font-lock-warning-face)
- (when
- (and
- (equal paren-prop '(15))
- (not (c-search-forward-char-property 'syntax-table
'(15) limit)))
- (goto-char limit)))
- (c-remove-font-lock-face (match-beginning 0) (match-end 2))
- (setq raw-id (match-string-no-properties 2))
- (setq content-start (match-end 0)))))))))
- nil)
+ (cond
+ ;; Point is not in an ml string
+ ((not string-delims)
+ (while (and (setq found (re-search-forward c-ml-string-opener-re
+ limit 'limit))
+ (> (match-beginning 0) (point-min))
+ (memq (c-get-char-property (1- (match-beginning 0)) 'face)
+ '(font-lock-comment-face font-lock-string-face
+ font-lock-comment-delimiter-face))))
+ (when found
+ (setq open-delim (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2)))
+ string-delims (cons open-delim (c-get-ml-closer open-delim)))
+ (goto-char (caar string-delims))))
+
+ ;; Point is in the body of an ml string.
+ ((and string-delims
+ (>= (point) (cadar string-delims))
+ (or (not (cdr string-delims))
+ (< (point) (cadr string-delims))))
+ (if (cdr string-delims)
+ (goto-char (cadr string-delims))
+ (if (equal (c-get-char-property (1- (cadar string-delims))
+ 'syntax-table)
+ '(15)) ; "Always" the case.
+ ;; The next search should be successful for an unterminated ml
+ ;; string inside a macro, but not for any other unterminated
+ ;; string.
+ (progn
+ (or (c-search-forward-char-property 'syntax-table '(15) limit)
+ (goto-char limit))
+ (setq string-delims nil))
+ (c-benign-error "Missing '(15) syntax-table property at %d"
+ (1- (cadar string-delims)))
+ (setq string-delims nil))))
+
+ ;; Point is at or in a closing delimiter
+ ((and string-delims
+ (cdr string-delims)
+ (>= (point) (cadr string-delims)))
+ (c-put-font-lock-face (cadr string-delims) (1+ (cadr string-delims))
+ 'font-lock-string-face)
+ (c-remove-font-lock-face (1+ (cadr string-delims))
+ (caddr string-delims))
+ (goto-char (caddr string-delims))
+ (setq string-delims nil))
+
+ ;; point is at or in an opening delimiter.
+ (t
+ (if (cdr string-delims)
+ (progn
+ (c-remove-font-lock-face (caar string-delims)
+ (1- (cadar string-delims)))
+ (c-put-font-lock-face (1- (cadar string-delims))
+ (cadar string-delims)
+ 'font-lock-string-face))
+ (c-put-font-lock-face (caar string-delims) (cadar string-delims)
+ 'font-lock-warning-face))
+ (goto-char (cadar string-delims)))))
+ nil))
(defun c-font-lock-c++-lambda-captures (limit)
;; Fontify the lambda capture component of C++ lambda declarations.
@@ -2774,13 +2797,14 @@ need for `pike-font-lock-extra-types'.")
;;
;; This function might do hidden buffer changes.
(declare (indent 2))
- (let (comment-beg region-beg)
+ (let (comment-beg region-beg comment-mid)
(if (memq (get-text-property (point) 'face)
'(font-lock-comment-face font-lock-comment-delimiter-face))
;; Handle the case when the fontified region starts inside a
;; comment.
(let ((start (c-literal-start)))
- (setq region-beg (point))
+ (setq region-beg (point)
+ comment-mid (point))
(when start
(goto-char start))
(when (looking-at prefix)
@@ -2806,7 +2830,8 @@ need for `pike-font-lock-extra-types'.")
(goto-char comment-beg)
(c-in-literal)))))
(setq comment-beg nil))
- (setq region-beg comment-beg))
+ (setq region-beg comment-beg
+ comment-mid comment-beg))
(if (elt (parse-partial-sexp comment-beg (+ comment-beg 2)) 7)
;; Collect a sequence of doc style line comments.
@@ -2814,15 +2839,16 @@ need for `pike-font-lock-extra-types'.")
(goto-char comment-beg)
(while (and (progn
(c-forward-single-comment)
- (c-put-font-lock-face comment-beg (point)
+ (c-put-font-lock-face comment-mid (point)
c-doc-face-name)
(skip-syntax-forward " ")
- (setq comment-beg (point))
+ (setq comment-beg (point)
+ comment-mid (point))
(< (point) limit))
(looking-at prefix))))
(goto-char comment-beg)
(c-forward-single-comment)
- (c-put-font-lock-face comment-beg (point) c-doc-face-name))
+ (c-put-font-lock-face region-beg (point) c-doc-face-name))
(if (> (point) limit) (goto-char limit))
(setq comment-beg nil)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 35efadf..0b125bc 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -453,9 +453,9 @@ so that all identifiers are recognized as words.")
;; The value here may be a list of functions or a single function.
t 'c-before-change-check-unbalanced-strings
c++ '(c-extend-region-for-CPP
- c-before-change-check-raw-strings
- c-before-change-check-<>-operators
c-depropertize-CPP
+ c-before-change-check-ml-strings
+ c-before-change-check-<>-operators
c-truncate-bs-cache
c-before-change-check-unbalanced-strings
c-parse-quotes-before-change)
@@ -467,6 +467,8 @@ so that all identifiers are recognized as words.")
java '(c-parse-quotes-before-change
c-before-change-check-unbalanced-strings
c-before-change-check-<>-operators)
+ pike '(c-before-change-check-ml-strings
+ c-before-change-check-unbalanced-strings)
awk 'c-awk-record-region-clear-NL)
(c-lang-defvar c-get-state-before-change-functions
(let ((fs (c-lang-const c-get-state-before-change-functions)))
@@ -506,7 +508,7 @@ parameters \(point-min) and \(point-max).")
c-change-expand-fl-region)
c++ '(c-depropertize-new-text
c-after-change-escape-NL-in-string
- c-after-change-unmark-raw-strings
+ c-after-change-unmark-ml-strings
c-parse-quotes-after-change
c-after-change-mark-abnormal-strings
c-extend-font-lock-region-for-macros
@@ -519,6 +521,11 @@ parameters \(point-min) and \(point-max).")
c-after-change-mark-abnormal-strings
c-restore-<>-properties
c-change-expand-fl-region)
+ pike '(c-depropertize-new-text
+ c-after-change-escape-NL-in-string
+ c-after-change-unmark-ml-strings
+ c-after-change-mark-abnormal-strings
+ c-change-expand-fl-region)
awk '(c-depropertize-new-text
c-awk-extend-and-syntax-tablify-region))
(c-lang-defvar c-before-font-lock-functions
@@ -620,6 +627,176 @@ Note that to set up a language to use this, additionally:
'(?\")))
(c-lang-defvar c-string-delims (c-lang-const c-string-delims))
+
+;; The next section of the code defines multi-line ("ml") strings for each
+;; language. By default, there are no ml strings in a language. To configure
+;; them, set each needed lang const in the section. See further details in
+;; cc-engine.el (search for "Handling of CC Mode multi-line strings.").
+(c-lang-defconst c-ml-string-backslash-escapes
+ ;; N.B. if `c-ml-string-backslash-escapes' is non-nil, you probably need a
+ ;; `c-ml-string-any-closer-re' that scans backslashed characters, etc.
+ "If non-nil, a \\ character escapes the next character in a ml string.
+Otherwise such a \\ will be marked to be handled as any other character."
+ t nil
+ pike t
+ )
+
+(c-lang-defconst c-ml-string-non-punc-skip-chars
+ ;; A `skip-chars-forward' argument which skips over all ml string characters
+ ;; which don't need to be marked with punctuation ('(1)) syntax.
+ t (if (c-lang-const c-ml-string-backslash-escapes)
+ "^\""
+ "^\"\\"))
+(c-lang-defvar c-ml-string-non-punc-skip-chars
+ (c-lang-const c-ml-string-non-punc-skip-chars))
+
+(c-lang-defconst c-ml-string-opener-re
+ "If non-nil, a regexp that matches a multi-line string opener.
+It may also match context.
+
+Such an opener must be at least 2 characters long, and must
+contain a \" character. (match-string 1) matches the actual
+delimiter and (match-string 2) matches the actual \". If a
+delimiter contains several \"s, it is recommended to configure
+the first of them as \"the\" \"."
+ t nil
+ pike "\\(#\\(\"\\)\\)"
+ c++ "\\(R\\(\"\\)[^ ()\\\n\r\t]\\{0,16\\}(\\)")
+(c-lang-defvar c-ml-string-opener-re (c-lang-const c-ml-string-opener-re))
+
+(c-lang-defconst c-ml-string-max-opener-len
+ "If non-nil, the maximum length of a multi-line string opener."
+ t nil
+ pike 2
+ c++ 19)
+(c-lang-defvar c-ml-string-max-opener-len
+ (c-lang-const c-ml-string-max-opener-len))
+
+(c-lang-defconst c-ml-string-any-closer-re
+ "If non-nil, a regexp that matches any multi-line string closer.
+It may also match context.
+
+A search for this regexp starting at the end of the corresponding
+opener must find the first closer as the first match.
+
+Such a closer must include a \" character. (match-string 1)
+matches the actual delimiter and and (match-string 2) matches the
+actual \". If a delimiter contains several \"s, it is
+recommended to regard the last of them as \"the\" \"."
+ t nil
+ pike "\\(?:\\=\\|[^\\\"]\\)\\(?:\\\\.\\)*\\(\\(\"\\)\\)"
+ c++ "\\()[^ ()\\n\r\t]\\{0,16\\}\\(\"\\)\\)")
+;; csharp "\\(?:\\=\\|[^\"]\\)\\(?:\"\"\\)*\\(\\(\"\\)\\)\\(?:[^\"]\\|\\'\\)"
+(c-lang-defvar c-ml-string-any-closer-re
+ (c-lang-const c-ml-string-any-closer-re))
+
+(c-lang-defconst c-ml-string-max-closer-len
+ "If non-nil, the maximum length of a multi-line string closer.
+This must include the length of any \"context trailer\" following
+the actual closer and any \"context leader\" preceding it. This
+variable is ignored when `c-ml-string-back-closer-re' is non-nil."
+ t nil
+ c++ 18)
+(c-lang-defvar c-ml-string-max-closer-len
+ (c-lang-const c-ml-string-max-closer-len))
+
+(c-lang-defconst c-ml-string-max-closer-len-no-leader
+ "If non-nil, the maximum length of a ml string closer without its leader.
+By \"leader\" is meant the context bytes preceding the actual
+multi-line string closer, that part of
+`c-ml-string-any-closer-re''s match preceding (match-beginning 1)."
+ t nil
+ pike 1
+ ;; 2
+ ;; 3
+ c++ 18)
+(c-lang-defvar c-ml-string-max-closer-len-no-leader
+ (c-lang-const c-ml-string-max-closer-len-no-leader))
+
+(c-lang-defconst c-ml-string-back-closer-re
+ "A regexp to move back out of a putative ml closer point is in.
+
+This variable need only be non-nil for languages with multi-line
+string closers that can contain an indefinite length \"leader\"
+preceding the actual closer. It was designed for formats where
+an unbounded number of \\s or \"s might precede the closer
+proper, for example in Pike Mode or csharp-mode.
+
+If point is in a putative multi-line string closer, a backward
+regexp search with `c-ml-string-back-closer-re' will leave point
+in a \"safe place\", from where a forward regexp search with
+`c-ml-string-any-closer-re' can test whether the original
+position was inside an actual closer.
+
+When non-nil, this variable should end in \"\\\\\\==\". Note that
+such a backward search will match a minimal string, so a
+\"context character\" is probably needed at the start of the
+regexp. The value for csharp-mode would be something like
+\"\\\\(:?\\\\`\\\\|[^\\\"]\\\\)\\\"*\\\\\\==\"."
+ t nil
+ pike "\\(:?\\`\\|[^\\\"]\\)\\(:?\\\\.\\)*\\="
+ ;;pike ;; 2
+ ;; "\\(:?\\`\\|[^\"]\\)\"*\\="
+ )
+(c-lang-defvar c-ml-string-back-closer-re
+ (c-lang-const c-ml-string-back-closer-re))
+
+(c-lang-defconst c-make-ml-string-closer-re-function
+ "If non-nil, a function which creates a closer regexp matching an opener.
+
+Such a function is given one argument, a multi-line opener (a
+string), and returns a regexp which will match the corresponding
+closer. When this regexp matches, (match-string 1) should be the
+actual closing delimiter, and (match-string 2) the \"active\" \"
+it contains.
+
+A forward regexp search for this regexp starting at the end of
+the opener must find the closer as its first match."
+ t (if (c-lang-const c-ml-string-any-closer-re)
+ 'c-ml-string-make-closer-re)
+ c++ 'c-c++-make-ml-string-closer-re)
+(c-lang-defvar c-make-ml-string-closer-re-function
+ (c-lang-const c-make-ml-string-closer-re-function))
+
+(c-lang-defconst c-make-ml-string-opener-re-function
+ "If non-nil, a function which creates an opener regexp matching a closer.
+
+Such a function is given one argument, a multi-line closer (a
+string), and returns a regexp which will match the corresponding
+opener. When this regexp matches, (match-string 1) should be the
+actual opening delimiter, and (match-string 2) the \"active\" \"
+it contains.
+
+A backward regexp search for this regexp starting at the start of
+the closer might not find the opener as its first match, should
+there be copies of the opener contained in the multi-line string."
+ t (if (c-lang-const c-ml-string-opener-re)
+ 'c-ml-string-make-opener-re)
+ c++ 'c-c++-make-ml-string-opener-re)
+(c-lang-defvar c-make-ml-string-opener-re-function
+ (c-lang-const c-make-ml-string-opener-re-function))
+
+(c-lang-defconst c-ml-string-cpp-or-opener-re
+ ;; A regexp which matches either a macro or a multi-line string opener.
+ t (concat "\\("
+ (or (c-lang-const c-anchored-cpp-prefix) "\\`a\\`")
+ "\\)\\|\\("
+ (or (c-lang-const c-ml-string-opener-re) "\\`a\\`")
+ "\\)"))
+(c-lang-defvar c-ml-string-cpp-or-opener-re
+ (c-lang-const c-ml-string-cpp-or-opener-re))
+
+(c-lang-defconst c-cpp-or-ml-match-offset
+ ;; The offset to be added onto match numbers for a multi-line string in
+ ;; matches for `c-cpp-or-ml-string-opener-re'.
+ t (if (c-lang-const c-anchored-cpp-prefix)
+ (+ 2 (regexp-opt-depth (c-lang-const c-anchored-cpp-prefix)))
+ 2))
+(c-lang-defvar c-cpp-or-ml-match-offset
+ (c-lang-const c-cpp-or-ml-match-offset))
+;; End of ml string section.
+
+
(c-lang-defconst c-has-quoted-numbers
"Whether the language has numbers quoted like 4'294'967'295."
t nil
@@ -860,9 +1037,15 @@ literals."
"Set if the language supports multiline string literals without escaped
newlines. If t, all string literals are multiline. If a character,
only literals where the open quote is immediately preceded by that
-literal are multiline."
- t nil
- pike ?#)
+literal are multiline.
+
+Note that from CC Mode 5.36, this character use is obsolete,
+having been superseded by the \"multi-line string\" mechanism.
+If both mechanisms are set for a language, the newer one prevails
+over the old `c-multiline-string-start-char'. See the variables
+in the page containing `c-ml-string-opener-re' in cc-langs.el for
+further directions."
+ t nil)
(c-lang-defvar c-multiline-string-start-char
(c-lang-const c-multiline-string-start-char))
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 5108549..057d292 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1003,8 +1003,8 @@ Note that the style variables are always made local to
the buffer."
(goto-char (match-beginning 1))
(setq m-beg (point))
(c-end-of-macro)
- (when (c-major-mode-is 'c++-mode)
- (save-excursion (c-depropertize-raw-strings-in-region m-beg (point))))
+ (when c-ml-string-opener-re
+ (save-excursion (c-depropertize-ml-strings-in-region m-beg (point))))
(c-clear-char-property-with-value m-beg (point) 'syntax-table '(1)))
(while (and (< (point) end)
@@ -1014,8 +1014,8 @@ Note that the style variables are always made local to
the buffer."
(setq m-beg (point))
(c-end-of-macro))
(when (and ss-found (> (point) end))
- (when (c-major-mode-is 'c++-mode)
- (save-excursion (c-depropertize-raw-strings-in-region m-beg (point))))
+ (when c-ml-string-opener-re
+ (save-excursion (c-depropertize-ml-strings-in-region m-beg (point))))
(c-clear-char-property-with-value m-beg (point) 'syntax-table '(1)))
(while (and (< (point) c-new-END)
@@ -1023,8 +1023,8 @@ Note that the style variables are always made local to
the buffer."
(goto-char (match-beginning 1))
(setq m-beg (point))
(c-end-of-macro)
- (when (c-major-mode-is 'c++-mode)
- (save-excursion (c-depropertize-raw-strings-in-region m-beg (point))))
+ (when c-ml-string-opener-re
+ (save-excursion (c-depropertize-ml-strings-in-region m-beg (point))))
(c-clear-char-property-with-value
m-beg (point) 'syntax-table '(1)))))
@@ -1174,12 +1174,15 @@ Note that the style variables are always made local to
the buffer."
)))))
(defun c-unescaped-nls-in-string-p (&optional quote-pos)
- ;; Return whether unescaped newlines can be inside strings.
+ ;; Return whether unescaped newlines can be inside strings. If the current
+ ;; language handles multi-line strings, the value of this function is always
+ ;; nil.
;;
;; QUOTE-POS, if present, is the position of the opening quote of a string.
;; Depending on the language, there might be a special character before it
;; signifying the validity of such NLs.
(cond
+ (c-ml-string-opener-re nil)
((null c-multiline-string-start-char) nil)
((c-characterp c-multiline-string-start-char)
(and quote-pos
@@ -1323,13 +1326,13 @@ Note that the style variables are always made local to
the buffer."
(setq pos (c-min-property-position pos c-max-syn-tab-mkr
'c-fl-syn-tab))
(when (< pos c-max-syn-tab-mkr)
- (goto-char pos))
- (when (and (save-match-data
- (c-search-backward-char-property-with-value-on-char
- 'c-fl-syn-tab '(15) ?\"
- (max (- (point) 500) (point-min))))
- (not (equal (c-get-char-property (point) 'syntax-table)
'(1))))
- (setq pos (1+ pos)))
+ (goto-char pos)
+ (when (and (save-match-data
+ (c-search-backward-char-property-with-value-on-char
+ 'c-fl-syn-tab '(15) ?\"
+ (max (- (point) 500) (point-min))))
+ (not (equal (c-get-char-property (point) 'syntax-table)
'(1))))
+ (setq pos (1+ pos))))
(while (< pos c-max-syn-tab-mkr)
(setq pos
(c-min-property-position pos c-max-syn-tab-mkr 'c-fl-syn-tab))
@@ -1435,7 +1438,8 @@ Note that the style variables are always made local to
the buffer."
;; quotes up until the next unescaped EOL. Also guard against the change
;; being the insertion of \ before an EOL, escaping it.
(cond
- ((c-characterp c-multiline-string-start-char)
+ ((and (not c-ml-string-opener-re)
+ (c-characterp c-multiline-string-start-char))
;; The text about to be inserted might contain a multiline string
;; opener. Set c-new-END after anything which might be affected.
;; Go to the end of the putative multiline string.
@@ -1461,7 +1465,8 @@ Note that the style variables are always made local to
the buffer."
(< (point) (point-max))))))
(setq c-new-END (max (point) c-new-END)))
- (c-multiline-string-start-char
+ ((and (not c-ml-string-opener-re)
+ c-multiline-string-start-char)
(setq c-bc-changed-stringiness
(not (eq (eq end-literal-type 'string)
(eq beg-literal-type 'string))))
@@ -1506,7 +1511,7 @@ Note that the style variables are always made local to
the buffer."
;; Opening " at EOB.
(c-clear-syn-tab (1- (point))))
(when (and (c-search-backward-char-property 'syntax-table '(15)
c-new-BEG)
- (memq (char-after) c-string-delims)) ; Ignore an
unterminated raw string's (.
+ (memq (char-after) c-string-delims)) ; Ignore an
unterminated ml string's (.
;; Opening " on last line of text (without EOL).
(c-remove-string-fences)
(setq c-new-BEG (min c-new-BEG (point))))))
@@ -1520,13 +1525,16 @@ Note that the style variables are always made local to
the buffer."
(unless
(or (and
- ;; Don't set c-new-BEG/END if we're in a raw string.
+ ;; Don't set c-new-BEG/END if we're in an ml string.
+ c-ml-string-opener-re
(eq beg-literal-type 'string)
- (c-at-c++-raw-string-opener (car beg-limits)))
+ (c-ml-string-opener-at-or-around-point (car beg-limits)))
(and c-multiline-string-start-char
+ (not c-ml-string-opener-re)
(not (c-characterp c-multiline-string-start-char))))
(when (and (eq end-literal-type 'string)
- (not (eq (char-before (cdr end-limits)) ?\())
+ (or (memq (char-before (cdr end-limits)) c-string-delims)
+ (memq (char-before (cdr end-limits)) '(?\n ?\r)))
(memq (char-after (car end-limits)) c-string-delims))
(setq c-new-END (max c-new-END (cdr end-limits)))
(when (equal (c-get-char-property (car end-limits) 'syntax-table)
@@ -1549,6 +1557,7 @@ Note that the style variables are always made local to
the buffer."
;; This function is called exclusively as an after-change function via
;; `c-before-font-lock-functions'.
(if (and c-multiline-string-start-char
+ (not c-ml-string-opener-re)
(not (c-characterp c-multiline-string-start-char)))
;; Only the last " might need to be marked.
(c-save-buffer-state
@@ -1591,6 +1600,7 @@ Note that the style variables are always made local to
the buffer."
((and (null beg-literal-type)
(goto-char beg)
(and (not (bobp))
+ (not c-ml-string-opener-re)
(eq (char-before) c-multiline-string-start-char))
(memq (char-after) c-string-delims))
(cons (point)
@@ -1615,6 +1625,7 @@ Note that the style variables are always made local to
the buffer."
(point))
c-new-END))
s)
+
(goto-char
(cond ((null beg-literal-type)
c-new-BEG)
@@ -1638,8 +1649,9 @@ Note that the style variables are always made local to
the buffer."
(and (memq (char-before) c-string-delims)
(not (nth 4 s))))) ; Check we're actually out of the
; comment. not stuck at EOB
- (unless (and (c-major-mode-is 'c++-mode)
- (c-maybe-re-mark-raw-string))
+ (unless
+ (and c-ml-string-opener-re
+ (c-maybe-re-mark-ml-string))
(if (c-unescaped-nls-in-string-p (1- (point)))
(looking-at "\\(\\\\\\(.\\|\n\\)\\|[^\"]\\)*")
(looking-at (cdr (assq (char-before) c-string-innards-re-alist))))
@@ -1678,21 +1690,15 @@ Note that the style variables are always made local to
the buffer."
(progn (goto-char end)
(setq lit-start (c-literal-start)))
(memq (char-after lit-start) c-string-delims)
- (or (not (c-major-mode-is 'c++-mode))
+ (or (not c-ml-string-opener-re)
(progn
(goto-char lit-start)
- (and (not (and (eq (char-before) ?R)
- (looking-at c-c++-raw-string-opener-1-re)))
- (not (and (eq (char-after) ?\()
- (equal (c-get-char-property
- (point) 'syntax-table)
- '(15))))))
+ (not (c-ml-string-opener-at-or-around-point)))
(save-excursion
(c-beginning-of-macro))))
(goto-char (1+ end)) ; After the \
- ;; Search forward for EOLL
- (setq lim (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*"
- nil t))
+ ;; Search forward for EOLL.
+ (setq lim (c-point 'eoll))
(goto-char (1+ end))
(when (c-search-forward-char-property-with-value-on-char
'syntax-table '(15) ?\" lim)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 02d1c58..af7b829 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -173,6 +173,7 @@ and a string describing how the process finished.")
;; emacs -batch -l compile-tests.el -f ert-run-tests-batch-and-exit
(defvar compilation-error-regexp-alist-alist
+ (eval-when-compile
`((absoft
"^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[
\t]+\
of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
@@ -615,7 +616,7 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column =
\\([0-9]+\\)\\)?"
;; we do not know what lines will follow.
(guile-file "^In \\(.+\\..+\\):\n" 1 nil nil 0)
(guile-line "^ *\\([0-9]+\\): *\\([0-9]+\\)" nil 1 2)
- )
+ ))
"Alist of values for `compilation-error-regexp-alist'.")
(defcustom compilation-error-regexp-alist
@@ -2950,7 +2951,8 @@ attempts to find a file whose name is produced by (format
FMT FILENAME)."
fmts formats)
;; For each directory, try each format string.
(while (and fmts (null buffer))
- (setq name (expand-file-name (format (car fmts) filename) thisdir)
+ (setq name (file-truename
+ (file-name-concat thisdir (format (car fmts) filename)))
buffer (and (file-exists-p name)
(find-file-noselect name))
fmts (cdr fmts)))
@@ -2972,7 +2974,8 @@ attempts to find a file whose name is produced by (format
FMT FILENAME)."
(setq thisdir (car dirs)
fmts formats)
(while (and fmts (null buffer))
- (setq name (expand-file-name (format (car fmts) filename) thisdir)
+ (setq name (file-truename
+ (file-name-concat thisdir (format (car fmts) filename)))
buffer (and (file-exists-p name)
(find-file-noselect name))
fmts (cdr fmts)))
@@ -3015,7 +3018,8 @@ attempts to find a file whose name is produced by (format
FMT FILENAME)."
(ding) (sit-for 2))
((and (file-directory-p name)
(not (file-exists-p
- (setq name (expand-file-name filename name)))))
+ (setq name (file-truename
+ (file-name-concat name filename))))))
(message "No `%s' in directory %s" filename origname)
(ding) (sit-for 2))
(t
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 3370df6..f518501 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1741,7 +1741,9 @@ or as help on variables `cperl-tips', `cperl-problems',
'((cperl-load-font-lock-keywords
cperl-load-font-lock-keywords-1
cperl-load-font-lock-keywords-2)
- nil nil ((?_ . "w"))))
+ nil nil ((?_ . "w")) nil
+ (font-lock-syntactic-face-function
+ . cperl-font-lock-syntactic-face-function)))
;; Reset syntaxification cache.
(setq-local cperl-syntax-state nil)
(when cperl-use-syntax-table-text-property
@@ -3147,26 +3149,29 @@ Returns true if comment is found. In POD will not move
the point."
(while (re-search-forward "^\\s(" e 'to-end)
(put-text-property (1- (point)) (point) 'syntax-table cperl-st-punct))))
-(defun cperl-commentify (bb e string &optional noface)
- (if cperl-use-syntax-table-text-property
- (if (eq noface 'n) ; Only immediate
- nil
- ;; We suppose that e is _after_ the end of construction, as after eol.
- (setq string (if string cperl-st-sfence cperl-st-cfence))
- (if (> bb (- e 2))
+(defun cperl-commentify (begin end string)
+ "Mark text from BEGIN to END as generic string or comment.
+Mark as generic string if STRING, as generic comment otherwise.
+A single character is marked as punctuation and directly
+fontified. Do nothing if BEGIN and END are equal. If
+`cperl-use-syntax-text-property' is nil, just fontify."
+ (if (and cperl-use-syntax-table-text-property
+ (> end begin))
+ (progn
+ (setq string (if string cperl-st-sfence cperl-st-cfence))
+ (if (> begin (- end 2))
;; one-char string/comment?!
- (cperl-modify-syntax-type bb cperl-st-punct)
- (cperl-modify-syntax-type bb string)
- (cperl-modify-syntax-type (1- e) string))
- (if (and (eq string cperl-st-sfence) (> (- e 2) bb))
- (put-text-property (1+ bb) (1- e)
+ (cperl-modify-syntax-type begin cperl-st-punct)
+ (cperl-modify-syntax-type begin string)
+ (cperl-modify-syntax-type (1- end) string))
+ (if (and (eq string cperl-st-sfence) (> (- end 2) begin))
+ (put-text-property (1+ begin) (1- end)
'syntax-table cperl-string-syntax-table))
- (cperl-protect-defun-start bb e))
+ (cperl-protect-defun-start begin end))
;; Fontify
- (or noface
- (not cperl-pod-here-fontify)
- (put-text-property bb e 'face (if string 'font-lock-string-face
- 'font-lock-comment-face)))))
+ (when cperl-pod-here-fontify
+ (put-text-property begin end 'face (if string 'font-lock-string-face
+ 'font-lock-comment-face)))))
(defvar cperl-starters '(( ?\( . ?\) )
( ?\[ . ?\] )
@@ -3333,8 +3338,10 @@ Works before syntax recognition is done."
;; Each non-literal part is marked `syntax-type' ==> `pod'
;; Each literal part is marked `syntax-type' ==> `in-pod'
;; b) HEREs:
+;; The point before start is marked `here-doc-start'
;; Start-to-end is marked `here-doc-group' ==> t
;; The body is marked `syntax-type' ==> `here-doc'
+;; and is also marked as style 2 comment
;; The delimiter is marked `syntax-type' ==> `here-doc-delim'
;; c) FORMATs:
;; First line (to =) marked `first-format-line' ==> t
@@ -3351,8 +3358,36 @@ Works before syntax recognition is done."
;; (value: 0 in //o, 1 if "interpolated variable" is whole-REx, t otherwise).
(defun cperl-unwind-to-safe (before &optional end)
- ;; if BEFORE, go to the previous start-of-line on each step of unwinding
- (let ((pos (point)))
+ "Move point back to a safe place, back up one extra line if BEFORE.
+A place is \"safe\" if it is not within POD, a here-document, a
+format, a quote-like expression, a subroutine attribute list or a
+multiline declaration. These places all have special syntactical
+rules and need to be parsed as a whole. If END, return the
+position of the end of the unsafe construct."
+ (let ((pos (point))
+ (state (syntax-ppss)))
+ ;; Check edge cases for here-documents first
+ (when before ; we need a safe start for parsing
+ (cond
+ ((or (equal (get-text-property (cperl-1- (point)) 'syntax-type)
+ 'here-doc-start)
+ (equal (syntax-after (cperl-1- (point)))
+ (string-to-syntax "> c")))
+ ;; point is either immediately after the start of a here-doc
+ ;; (which may consist of nothing but one newline) or
+ ;; immediately after the now-outdated end marker of the
+ ;; here-doc. In both cases we need to back up to the line
+ ;; where the here-doc delimiters are defined.
+ (forward-char -1)
+ (cperl-backward-to-noncomment (point-min))
+ (beginning-of-line))
+ ((eq 2 (nth 7 state))
+ ;; point is somewhere in a here-document. Back up to the line
+ ;; where the here-doc delimiters are defined.
+ (goto-char (nth 8 state)) ; beginning of this here-doc
+ (cperl-backward-to-noncomment ; skip back over more
+ (point-min)) ; here-documents (if any)
+ (beginning-of-line)))) ; skip back over here-doc starters
(while (and pos (progn
(beginning-of-line)
(get-text-property (setq pos (point)) 'syntax-type)))
@@ -3510,19 +3545,194 @@ Should be called with the point before leading colon
of an attribute."
(goto-char endbracket) ; just in case something misbehaves???
t))
+(defvar cperl-here-doc-functions
+ (regexp-opt '("print" "printf" "say" ; print $handle <<EOF
+ "system" "exec" ; system $progname <<EOF
+ "sort") ; sort $subname <<EOF
+ 'symbols) ; avoid false positives
+ "List of keywords after which `$var <<bareword' is a here-document.
+After any other token `$var <<bareword' is treated as the variable `$var'
+left-shifted by the return value of the function `bareword'.")
+
+(defun cperl-is-here-doc-p (start)
+ "Find out whether a \"<<\" construct starting at START is a here-document.
+The point is expected to be after the end of the delimiter.
+Quoted delimiters after \"<<\" are unambiguously starting
+here-documents and are not handled here. This function does not
+move point but does change match data."
+ ;; not a here-doc | here-doc
+ ;; $foo << b; | $f .= <<B;
+ ;; ($f+1) << b; | a($f) . <<B;
+ ;; foo 1, <<B; | $x{a} <<b;
+ ;; Limitations:
+ ;; foo <<bar is statically undecidable. It could be either
+ ;; foo() << bar # left shifting the return value or
+ ;; foo(<<bar) # passing a here-doc to foo().
+ ;; We treat it as here-document and kindly ask programmers to
+ ;; disambiguate by adding parens.
+ (null
+ (or (looking-at "[ \t]*(") ; << function_call()
+ (looking-at ">>") ; <<>> operator
+ (save-excursion ; 1 << func_name, or $foo << 10
+ (condition-case nil
+ (progn
+ (goto-char start)
+ (forward-sexp -1) ;; examine the part before "<<"
+ (save-match-data
+ (cond
+ ((looking-at "[0-9$({]")
+ (forward-sexp 1)
+ (and
+ (looking-at "[ \t]*<<")
+ (condition-case nil
+ ;; print $foo <<EOF
+ (progn
+ (forward-sexp -2)
+ (not
+ (looking-at cperl-here-doc-functions)))
+ (error t)))))))
+ (error nil)))))) ; func(<<EOF)
+
+(defun cperl-process-here-doc (min max end overshoot stop-point
+ end-of-here-doc err-l
+ indented-here-doc-p
+ matched-pos todo-pos
+ delim-begin delim-end)
+ "Process a here-document's delimiters and body.
+The parameters MIN, MAX, END, OVERSHOOT, STOP-POINT, ERR-L are
+used for recursive calls to `cperl-find-pods-here' to handle the
+rest of the line which contains the delimiter. MATCHED-POS and
+TODO-POS are initial values for this function's result.
+END-OF-HERE-DOC is the end of a previous here-doc in the same
+line, or nil if this is the first. DELIM-BEGIN and DELIM-END are
+the positions where the here-document's delimiter has been found.
+This is part of `cperl-find-pods-heres' (below)."
+ (let* ((my-cperl-delimiters-face font-lock-constant-face)
+ (delimiter (buffer-substring-no-properties delim-begin delim-end))
+ (qtag (regexp-quote delimiter))
+ (use-syntax-state (and cperl-syntax-state
+ (>= min (car cperl-syntax-state))))
+ (state-point (if use-syntax-state
+ (car cperl-syntax-state)
+ (point-min)))
+ (state (if use-syntax-state
+ (cdr cperl-syntax-state)))
+ here-doc-start here-doc-end defs-eol
+ warning-message)
+ (when cperl-pod-here-fontify
+ ;; Highlight the starting delimiter
+ (cperl-postpone-fontification delim-begin delim-end
+ 'face my-cperl-delimiters-face)
+ (cperl-put-do-not-fontify delim-begin delim-end t))
+ (forward-line)
+ (setq here-doc-start (point) ; first char of (first) here-doc
+ defs-eol (1- here-doc-start)) ; end of definitions line
+ (if end-of-here-doc
+ ;; skip to the end of the previous here-doc
+ (goto-char end-of-here-doc)
+ ;; otherwise treat the first (or only) here-doc: Check for
+ ;; special cases if the line containing the delimiter(s)
+ ;; ends in a regular comment or a solitary ?#
+ (let* ((eol-state (save-excursion (syntax-ppss defs-eol))))
+ (when (nth 4 eol-state) ; EOL is in a comment
+ (if (= (1- defs-eol) (nth 8 eol-state))
+ ;; line ends with a naked comment starter.
+ ;; We let it start the here-doc.
+ (progn
+ (put-text-property (1- defs-eol) defs-eol
+ 'font-lock-face
+ 'font-lock-comment-face)
+ (put-text-property (1- defs-eol) defs-eol
+ 'syntax-type 'here-doc)
+ (put-text-property (1- defs-eol) defs-eol
+ 'syntax-type 'here-doc)
+ (put-text-property (1- defs-eol) defs-eol
+ 'syntax-table
+ (string-to-syntax "< c"))
+ )
+ ;; line ends with a "regular" comment: make
+ ;; the last character of the comment closing
+ ;; it so that we can use the line feed to
+ ;; start the here-doc
+ (put-text-property (1- defs-eol) defs-eol
+ 'syntax-table
+ (string-to-syntax ">"))))))
+ (setq here-doc-start (point)) ; now points to current here-doc
+ ;; Find the terminating delimiter.
+ ;; We do not search to max, since we may be called from
+ ;; some hook of fontification, and max is random
+ (or (re-search-forward
+ (concat "^" (when indented-here-doc-p "[ \t]*")
+ qtag "$")
+ stop-point 'toend)
+ (progn ; Pretend we matched at the end
+ (goto-char (point-max))
+ (re-search-forward "\\'")
+ (setq warning-message
+ (format "End of here-document `%s' not found." delimiter))
+ (or (car err-l) (setcar err-l here-doc-start))))
+ (when cperl-pod-here-fontify
+ ;; Highlight the ending delimiter
+ (cperl-postpone-fontification
+ (match-beginning 0) (match-end 0)
+ 'face my-cperl-delimiters-face)
+ (cperl-put-do-not-fontify here-doc-start (match-end 0) t))
+ (setq here-doc-end (cperl-1+ (match-end 0))) ; eol after delim
+ (put-text-property here-doc-start (match-beginning 0)
+ 'syntax-type 'here-doc)
+ (put-text-property (match-beginning 0) here-doc-end
+ 'syntax-type 'here-doc-delim)
+ (put-text-property here-doc-start here-doc-end 'here-doc-group t)
+ ;; This makes insertion at the start of HERE-DOC update
+ ;; the whole construct:
+ (put-text-property here-doc-start (cperl-1+ here-doc-start) 'front-sticky
'(syntax-type))
+ (cperl-commentify (match-beginning 0) (1- here-doc-end) nil)
+ (put-text-property (1- here-doc-start) here-doc-start
+ 'syntax-type 'here-doc-start)
+ (when (> (match-beginning 0) here-doc-start)
+ ;; here-document has non-zero length
+ (cperl-modify-syntax-type (1- here-doc-start) (string-to-syntax "< c"))
+ (cperl-modify-syntax-type (1- (match-beginning 0))
+ (string-to-syntax "> c")))
+ (cperl-put-do-not-fontify here-doc-start (match-end 0) t)
+ ;; Cache the syntax info...
+ (setq cperl-syntax-state (cons state-point state))
+ ;; ... and process the rest of the line...
+ (setq overshoot
+ (elt ; non-inter ignore-max
+ (cperl-find-pods-heres todo-pos defs-eol
+ t end t here-doc-end)
+ 1))
+ (if (and overshoot (> overshoot (point)))
+ (goto-char overshoot)
+ (setq overshoot here-doc-end))
+ (list (if (> here-doc-end max) matched-pos nil)
+ overshoot
+ warning-message)))
+
;; Debugging this may require (setq max-specpdl-size 2000)...
(defun cperl-find-pods-heres (&optional min max non-inter end ignore-max
end-of-here-doc)
- "Scans the buffer for hard-to-parse Perl constructions.
-If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify
-the sections using `cperl-pod-head-face', `cperl-pod-face',
-`cperl-here-face'."
+ "Scan the buffer for hard-to-parse Perl constructions.
+If `cperl-pod-here-fontify' is non-nil after evaluation,
+fontify the sections using `cperl-pod-head-face',
+`cperl-pod-face', `cperl-here-face'. The optional parameters are
+for internal use: scan from MIN to MAX, or the whole buffer if
+these are nil. If NON-INTER, don't write progress messages. If
+IGNORE-MAX, scan to end of buffer. If END, we are after a
+\"__END__\" or \"__DATA__\" token, so ignore unbalanced
+constructs. END-OF-HERE-DOC points to the end of a here-document
+which has already been processed.
+Value is a two-element list of the position where an error
+occurred (if any) and the \"overshoot\", which is used for
+recursive calls in starting lines of here-documents."
(interactive)
(or min (setq min (point-min)
cperl-syntax-state nil
cperl-syntax-done-to min))
(or max (setq max (point-max)))
- (let* ((cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend
- face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb
+ (font-lock-flush min max)
+ (let* (go tmpend
+ face head-face b e bb tag qtag b1 e1 argument i c tail tb
is-REx is-x-REx REx-subgr-start REx-subgr-end was-subgr i2 hairy-RE
(case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)
(modified (buffer-modified-p)) overshoot is-o-REx name
@@ -3619,20 +3829,20 @@ the sections using `cperl-pod-head-face',
`cperl-pod-face',
(and cperl-pod-here-fontify
;; We had evals here, do not know why...
(setq face cperl-pod-face
- head-face cperl-pod-head-face
- here-face cperl-here-face))
- (remove-text-properties min max
- '(syntax-type t in-pod t syntax-table t
- attrib-group t
- REx-interpolated t
- cperl-postpone t
- syntax-subtype t
- rear-nonsticky t
- front-sticky t
- here-doc-group t
- first-format-line t
- REx-part2 t
- indentable t))
+ head-face cperl-pod-head-face))
+ (unless end-of-here-doc
+ (remove-text-properties min max
+ '(syntax-type t in-pod t syntax-table t
+ attrib-group t
+ REx-interpolated t
+ cperl-postpone t
+ syntax-subtype t
+ rear-nonsticky t
+ front-sticky t
+ here-doc-group t
+ first-format-line t
+ REx-part2 t
+ indentable t)))
;; Need to remove face as well...
(goto-char min)
(while (and
@@ -3751,120 +3961,36 @@ the sections using `cperl-pod-head-face',
`cperl-pod-face',
;; but multiline quote on the same line as <<HERE confuses us...
;; ;; One extra () before this:
;;"<<"
- ;; "\\(" ; 1 + 1
+ ;; "<<\\(~?\\)" ; HERE-DOC, indented-p = capture 2
;; ;; First variant "BLAH" or just ``.
;; "[ \t]*" ; Yes, whitespace is allowed!
- ;; "\\([\"'`]\\)" ; 2 + 1
- ;; "\\([^\"'`\n]*\\)" ; 3 + 1
- ;; "\\3"
+ ;; "\\([\"'`]\\)" ; 3 + 1
+ ;; "\\([^\"'`\n]*\\)" ; 4 + 1
+ ;; "\\4"
;; "\\|"
;; ;; Second variant: Identifier or \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
;; "\\)"
- ((match-beginning 3) ; 2 + 1: found "<<", detect its type
- (setq b (point)
- tb (match-beginning 0)
- c (and ; not HERE-DOC
- (match-beginning 6)
- (save-match-data
- (or (looking-at "[ \t]*(") ; << function_call()
- (looking-at ">>") ; <<>> operator
- (save-excursion ; 1 << func_name, or $foo << 10
- (condition-case nil
- (progn
- (goto-char tb)
- ;;; XXX What to do: foo <<bar ???
- ;;; XXX Need to support print {a} <<B ???
- (forward-sexp -1)
- (save-match-data
- ; $foo << b; $f .= <<B;
- ; ($f+1) << b; a($f) . <<B;
- ; foo 1, <<B; $x{a} <<b;
- (cond
- ((looking-at "[0-9$({]")
- (forward-sexp 1)
- (and
- (looking-at "[ \t]*<<")
- (condition-case nil
- ;; print $foo <<EOF
- (progn
- (forward-sexp -2)
- (not
- (looking-at
"\\(printf?\\|say\\|system\\|exec\\|sort\\)\\>")))
- (error t)))))))
- (error nil))) ; func(<<EOF)
- (and (not (match-beginning 7)) ; Empty
- (looking-at
- "[ \t]*[=0-9$@%&(]"))))))
- (if c ; Not here-doc
- nil ; Skip it.
- (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
- ;; Highlight the starting delimiter
- (cperl-postpone-fontification
- b1 e1 'face my-cperl-delimiters-face)
- (cperl-put-do-not-fontify b1 e1 t)))
- (forward-line)
- (setq i (point))
- (if end-of-here-doc
- (goto-char end-of-here-doc))
- (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 "^" (when (equal (match-string 2) "~") "[
\t]*")
- qtag "$")
- stop-point 'toend)
- ;;;(eq (following-char) ?\n) ; XXXX WHY???
- )
- (progn ; Pretend we matched at the end
- (goto-char (point-max))
- (re-search-forward "\\'")
- (setq warning-message
- (format "End of here-document `%s' not found."
tag))
- (or (car err-l) (setcar err-l b))))
- (if cperl-pod-here-fontify
- (progn
- ;; Highlight the ending delimiter
- (cperl-postpone-fontification
- (match-beginning 0) (match-end 0)
- 'face my-cperl-delimiters-face)
- (cperl-put-do-not-fontify b (match-end 0) t)
- ;; Highlight the HERE-DOC
- (cperl-postpone-fontification b (match-beginning 0)
- 'face here-face)))
- (setq e1 (cperl-1+ (match-end 0)))
- (put-text-property b (match-beginning 0)
- 'syntax-type 'here-doc)
- (put-text-property (match-beginning 0) e1
- 'syntax-type 'here-doc-delim)
- (put-text-property b e1 'here-doc-group t)
- ;; This makes insertion at the start of HERE-DOC update
- ;; the whole construct:
- (put-text-property b (cperl-1+ b) 'front-sticky
'(syntax-type))
- (cperl-commentify b e1 nil)
- (cperl-put-do-not-fontify b (match-end 0) t)
- ;; Cache the syntax info...
- (setq cperl-syntax-state (cons state-point state))
- ;; ... and process the rest of the line...
- (setq overshoot
- (elt ; non-inter ignore-max
- (cperl-find-pods-heres c i t end t e1) 1))
- (if (and overshoot (> overshoot (point)))
- (goto-char overshoot)
- (setq overshoot e1))
- (if (> e1 max)
- (setq tmpend tb))))
+ ((match-beginning 3) ; 2 + 1: found "<<", detect its type
+ (let* ((matched-pos (match-beginning 0))
+ (quoted-delim-p (if (match-beginning 6) nil t))
+ (delim-capture (if quoted-delim-p 5 6)))
+ (when (cperl-is-here-doc-p matched-pos)
+ (let ((here-doc-results
+ (cperl-process-here-doc
+ min max end overshoot stop-point ; for recursion
+ end-of-here-doc err-l ; for recursion
+ (equal (match-string 2) "~") ; indented
here-doc?
+ matched-pos ; for recovery (?)
+ (match-end 3) ; todo from here
+ (match-beginning delim-capture) ; starting
delimiter
+ (match-end delim-capture)))) ; boundaries
+ (setq tmpend (nth 0 here-doc-results)
+ overshoot (nth 1 here-doc-results))
+ (and (nth 2 here-doc-results)
+ (setq warning-message (nth 2 here-doc-results)))))))
;; format
((match-beginning 8)
;; 1+6=7 extra () before this:
@@ -5458,6 +5584,18 @@ comment, or POD."
(or cperl-faces-init (cperl-init-faces))
cperl-font-lock-keywords-2)
+(defun cperl-font-lock-syntactic-face-function (state)
+ "Apply faces according to their syntax type. In CPerl mode, this
+is used for here-documents which have been marked as c-style
+comments. For everything else, delegate to the default
+function."
+ (cond
+ ;; A c-style comment is a HERE-document. Fontify if requested.
+ ((and (eq 2 (nth 7 state))
+ cperl-pod-here-fontify)
+ cperl-here-face)
+ (t (funcall (default-value 'font-lock-syntactic-face-function) state))))
+
(defun cperl-init-faces ()
(condition-case errs
(progn
diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el
index 2a37110..c3b240a 100644
--- a/lisp/progmodes/ebnf-abn.el
+++ b/lisp/progmodes/ebnf-abn.el
@@ -530,13 +530,14 @@ See documentation for variable `ebnf-abn-lex'."
(let ((prose-p (= (following-char) ?<)))
(when prose-p
(forward-char)
- (or (looking-at ebnf-abn-non-terminal-letter-chars)
+ (or (looking-at (concat "[" ebnf-abn-non-terminal-letter-chars "]"))
(error "Invalid prose value")))
(setq ebnf-abn-lex
(ebnf-buffer-substring ebnf-abn-non-terminal-chars))
(when prose-p
(or (= (following-char) ?>)
(error "Invalid prose value"))
+ (forward-char)
(setq ebnf-abn-lex (concat "<" ebnf-abn-lex ">"))))
'non-terminal)
;; equal: =, =/
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index a00440d..6ad55fc 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -2244,8 +2244,12 @@ the PostScript image in a file with that name. If
FILENAME is a
number, prompt the user for the name of the file to save in."
(interactive (list (ps-print-preprint current-prefix-arg)))
(ebnf-log-header "(ebnf-print-buffer %S)" filename)
- (ebnf-print-region (point-min) (point-max) filename))
-
+ (cl-letf (((symbol-function 'ps-output-string)
+ ;; Make non-ASCII work (sort of).
+ (lambda (string)
+ (ps-output t (and string
+ (encode-coding-string string 'iso-8859-1))))))
+ (ebnf-print-region (point-min) (point-max) filename)))
;;;###autoload
(defun ebnf-print-region (from to &optional filename)
@@ -4337,7 +4341,7 @@ end
(let ((len (1- (length str)))
(index 0)
new start fmt)
- (while (setq start (string-match "%" str index))
+ (while (setq start (string-search "%" str index))
(setq fmt (if (< start len) (aref str (1+ start)) ?\?)
new (concat new
(substring str index start)
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 7ed2d3d..ef36c1f 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -696,7 +696,7 @@ Each function should return a list of xrefs, or nil; the
first
non-nil result supersedes the xrefs produced by
`elisp--xref-find-definitions'.")
-(cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier)
+(cl-defmethod xref-backend-definitions ((_backend (eql 'elisp)) identifier)
(require 'find-func)
;; FIXME: use information in source near point to filter results:
;; (dvc-log-edit ...) - exclude 'feature
@@ -875,7 +875,7 @@ non-nil result supersedes the xrefs produced by
(declare-function xref-apropos-regexp "xref" (pattern))
-(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) pattern)
+(cl-defmethod xref-backend-apropos ((_backend (eql 'elisp)) pattern)
(apply #'nconc
(let ((regexp (xref-apropos-regexp pattern))
lst)
@@ -893,7 +893,8 @@ non-nil result supersedes the xrefs produced by
(facep sym)))
'strict))
-(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql elisp)))
+(cl-defmethod xref-backend-identifier-completion-table ((_backend
+ (eql 'elisp)))
elisp--xref-identifier-completion-table)
(cl-defstruct (xref-elisp-location
@@ -1451,7 +1452,7 @@ Elisp eldoc behaviour. Consider variable docstrings and
function
signatures only, in this order. If none applies, returns nil.
Changes to `eldoc-documentation-functions' and
`eldoc-documentation-strategy' are _not_ reflected here. As such
-it is preferrable to use ElDoc's interfaces directly.")
+it is preferable to use ElDoc's interfaces directly.")
(make-obsolete 'elisp-eldoc-documentation-function
"use ElDoc's interfaces instead." "28.1")
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index f0180ce..a1f806a 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2059,22 +2059,43 @@ for \\[find-tag] (which see)."
If you want `xref-find-definitions' to find the tagged files by their
file name, add `tag-partial-file-name-match-p' to the list value.")
+(defcustom etags-xref-prefer-current-file nil
+ "Non-nil means show the matches in the current file first."
+ :type 'boolean
+ :version "28.1")
+
;;;###autoload
(defun etags--xref-backend () 'etags)
-(cl-defmethod xref-backend-identifier-at-point ((_backend (eql etags)))
+(cl-defmethod xref-backend-identifier-at-point ((_backend (eql 'etags)))
(find-tag--default))
-(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql etags)))
+(cl-defmethod xref-backend-identifier-completion-table ((_backend
+ (eql 'etags)))
(tags-lazy-completion-table))
-(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend (eql
etags)))
+(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend
+ (eql 'etags)))
(find-tag--completion-ignore-case))
-(cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol)
- (etags--xref-find-definitions symbol))
-
-(cl-defmethod xref-backend-apropos ((_backend (eql etags)) pattern)
+(cl-defmethod xref-backend-definitions ((_backend (eql 'etags)) symbol)
+ (let ((file (and buffer-file-name (expand-file-name buffer-file-name)))
+ (definitions (etags--xref-find-definitions symbol))
+ same-file-definitions)
+ (when (and etags-xref-prefer-current-file file)
+ (cl-delete-if
+ (lambda (definition)
+ (when (equal file
+ (xref-location-group
+ (xref-item-location definition)))
+ (push definition same-file-definitions)
+ t))
+ definitions)
+ (setq definitions (nconc (nreverse same-file-definitions)
+ definitions)))
+ definitions))
+
+(cl-defmethod xref-backend-apropos ((_backend (eql 'etags)) pattern)
(etags--xref-find-definitions (xref-apropos-regexp pattern) t))
(defun etags--xref-find-definitions (pattern &optional regexp?)
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index e10602a..cc12fce 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -1245,17 +1245,19 @@ correctly.")
"Flymake"
mouse-face mode-line-highlight
help-echo
- (lambda (&rest whatever)
- (concat
- (format "%s known backends\n" (hash-table-count flymake--backend-state))
- (format "%s running\n" (length (flymake-running-backends)))
- (format "%s disabled\n" (length (flymake-disabled-backends)))
- "mouse-1: Display minor mode menu\n"
- "mouse-2: Show help for minor mode"))
+ ,(lambda (&rest _)
+ (concat
+ (format "%s known backends\n" (hash-table-count
flymake--backend-state))
+ (format "%s running\n" (length (flymake-running-backends)))
+ (format "%s disabled\n" (length (flymake-disabled-backends)))
+ "mouse-1: Display minor mode menu\n"
+ "mouse-2: Show help for minor mode"))
keymap
,(let ((map (make-sparse-keymap)))
(define-key map [mode-line down-mouse-1]
flymake-menu)
+ (define-key map [mode-line down-mouse-3]
+ flymake-menu)
(define-key map [mode-line mouse-2]
(lambda ()
(interactive)
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index aa33652..67ad39b 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -581,6 +581,23 @@ stopped thread is already selected."
:group 'gdb-buffers
:version "23.2")
+(defcustom gdb-registers-enable-filter nil
+ "If non-nil, enable register name filter in register buffer.
+Use `gdb-registers-filter-pattern-list' to control what register to
+filter."
+ :type 'boolean
+ :group 'gdb-buffers
+ :version "28.1")
+
+(defcustom gdb-registers-filter-pattern-list nil
+ "Patterns for names that are displayed in register buffer.
+Each pattern is a regular expression. GDB displays registers
+whose name matches any pattern in the list. Refresh the register
+buffer for the change to take effect."
+ :type '(repeat regexp)
+ :group 'gdb-buffers
+ :version "28.1")
+
(defvar gdb-debug-log nil
"List of commands sent to and replies received from GDB.
Most recent commands are listed first. This list stores only the last
@@ -979,6 +996,8 @@ detailed description of this mode.
(define-key gud-minor-mode-map [left-margin C-mouse-3]
'gdb-mouse-jump)
+ (gud-set-repeat-map-property 'gud-gdb-repeat-map)
+
(setq-local gud-gdb-completion-function 'gud-gdbmi-completions)
(add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
@@ -1363,7 +1382,7 @@ With arg, enter name of variable to be watched in the
minibuffer."
(string-match "\\(\\S-+\\)" text)
(let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
(varnum (car var)))
- (if (string-match "\\." (car var))
+ (if (string-search "." (car var))
(message-box "Can only delete a root expression")
(gdb-var-delete-1 var varnum)))))
@@ -1460,14 +1479,14 @@ With arg, enter name of variable to be watched in the
minibuffer."
TEXT is the text of the button we clicked on, a + or - item.
TOKEN is data related to this node.
INDENT is the current indentation depth."
- (cond ((string-match "\\+" text) ;expand this node
+ (cond ((string-search "+" text) ;expand this node
(let* ((var (assoc token gdb-var-list))
(expr (nth 1 var)) (children (nth 2 var)))
(if (or (<= (string-to-number children) gdb-max-children)
(y-or-n-p
(format "%s has %s children. Continue? " expr children)))
(gdb-var-list-children token))))
- ((string-match "-" text) ;contract this node
+ ((string-search "-" text) ;contract this node
(dolist (var gdb-var-list)
(if (string-match (concat token "\\.") (car var))
(setq gdb-var-list (delq var gdb-var-list))))
@@ -1944,7 +1963,7 @@ commands to be prefixed by \"-interpreter-exec
console\".")
The string is enclosed in double quotes.
All embedded quotes, newlines, and backslashes are preceded with a backslash."
(setq string (replace-regexp-in-string "\\([\"\\]\\)" "\\\\\\&" string))
- (setq string (replace-regexp-in-string "\n" "\\n" string t t))
+ (setq string (string-replace "\n" "\\n" string))
(concat "\"" string "\""))
(defun gdb-input (command handler-function &optional trigger-name)
@@ -2397,7 +2416,7 @@ rule from an incomplete data stream. The parser will
stay in this state until
the end of the current result or async record is reached."
(when (< gdbmi-bnf-offset (length gud-marker-acc))
;; Search the data stream for the end of the current record:
- (let* ((newline-pos (string-match "\n" gud-marker-acc gdbmi-bnf-offset))
+ (let* ((newline-pos (string-search "\n" gud-marker-acc gdbmi-bnf-offset))
(is-progressive (equal (cdr class-command) 'progressive))
(is-complete (not (null newline-pos)))
result-str)
@@ -4393,6 +4412,26 @@ member."
'gdb-registers-mode
'gdb-invalidate-registers)
+(defun gdb-header-click-event-handler (function)
+ "Return a function that handles clicking event on gdb header buttons.
+
+This function switches to the window where the header locates and
+executes FUNCTION."
+ (lambda (event)
+ (interactive "e")
+ (save-selected-window
+ ;; Make sure we are in the right buffer.
+ (select-window (posn-window (event-start event)))
+ (funcall function))))
+
+(defun gdb-registers-toggle-filter ()
+ "Toggle register filter."
+ (interactive)
+ (setq gdb-registers-enable-filter
+ (not gdb-registers-enable-filter))
+ ;; Update the register buffer.
+ (gdb-invalidate-registers 'update))
+
(defun gdb-registers-handler-custom ()
(when gdb-register-names
(let ((register-values
@@ -4403,17 +4442,27 @@ member."
(value (gdb-mi--field register 'value))
(register-name (nth (string-to-number register-number)
gdb-register-names)))
- (gdb-table-add-row
- table
- (list
- (propertize register-name
- 'font-lock-face font-lock-variable-name-face)
- (if (member register-number gdb-changed-registers)
- (propertize value 'font-lock-face font-lock-warning-face)
- value))
- `(mouse-face highlight
- help-echo "mouse-2: edit value"
- gdb-register-name ,register-name))))
+ ;; Add register if `gdb-registers-filter-pattern-list' is nil;
+ ;; or any pattern that `gdb-registers-filter-pattern-list'
+ ;; matches.
+ (when (or (null gdb-registers-enable-filter)
+ ;; Return t if any register name matches a pattern.
+ (cl-loop for pattern
+ in gdb-registers-filter-pattern-list
+ if (string-match pattern register-name)
+ return t
+ finally return nil))
+ (gdb-table-add-row
+ table
+ (list
+ (propertize register-name
+ 'font-lock-face font-lock-variable-name-face)
+ (if (member register-number gdb-changed-registers)
+ (propertize value 'font-lock-face font-lock-warning-face)
+ value))
+ `(mouse-face highlight
+ help-echo "mouse-2: edit value"
+ gdb-register-name ,register-name)))))
(insert (gdb-table-string table " ")))
(setq mode-name
(gdb-current-context-mode-name "Registers"))))
@@ -4441,6 +4490,7 @@ member."
(gdb-get-buffer-create
'gdb-locals-buffer
gdb-thread-number) t)))
+ (define-key map "f" #'gdb-registers-toggle-filter)
map))
(defvar gdb-registers-header
@@ -4450,7 +4500,31 @@ member."
mode-line-inactive)
" "
(gdb-propertize-header "Registers" gdb-registers-buffer
- nil nil mode-line)))
+ nil nil mode-line)
+ " "
+ '(:eval
+ (format
+ "[filter %s %s]"
+ (propertize
+ (if gdb-registers-enable-filter "[on]" "[off]")
+ 'face (if gdb-registers-enable-filter
+ '(:weight bold :inherit success)
+ 'shadow)
+ 'help-echo "mouse-1: toggle filter"
+ 'mouse-face 'mode-line-highlight
+ 'local-map (gdb-make-header-line-mouse-map
+ 'mouse-1 (gdb-header-click-event-handler
+ #'gdb-registers-toggle-filter)))
+ (propertize
+ "[set]"
+ 'face 'mode-line
+ 'help-echo "mouse-1: Customize filter patterns"
+ 'mouse-face 'mode-line-highlight
+ 'local-map (gdb-make-header-line-mouse-map
+ 'mouse-1 (lambda ()
+ (interactive)
+ (customize-variable-other-window
+ 'gdb-registers-filter-pattern-list))))))))
(define-derived-mode gdb-registers-mode gdb-parent-mode "Registers"
"Major mode for gdb registers."
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 91c72a9..b2a9b3e 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -389,7 +389,7 @@ Notice that using \\[next-error] or \\[compile-goto-error]
modifies
(and mbeg (next-single-property-change
mbeg 'font-lock-face nil end))))
(when mend
- (- mend beg))))))
+ (- mend beg 1))))))
nil nil
(3 '(face nil display ":")))
("^Binary file \\(.+\\) matches" 1 nil nil 0 1))
@@ -696,11 +696,12 @@ The value depends on `grep-command', `grep-template',
(when (eq grep-highlight-matches 'auto-detect)
(setq grep-highlight-matches
(with-temp-buffer
- (and (grep-probe grep-program '(nil t nil "--help"))
- (progn
- (goto-char (point-min))
- (search-forward "--color" nil t))
- ;; Windows and DOS pipes fail `isatty' detection in Grep.
+ ;; The "grep --help" exit status varies; pay no attention to it.
+ (grep-probe grep-program '(nil t nil "--help"))
+ (goto-char (point-min))
+ (and (let ((case-fold-search nil))
+ (re-search-forward (rx "--color" (not (in "a-z"))) nil t))
+ ;; Windows and DOS pipes fail `isatty' detection in Grep.
(if (memq system-type '(windows-nt ms-dos))
'always 'auto)))))
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 740a6e2..d8c77f7 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -320,10 +320,32 @@ Used to gray out relevant toolbar icons.")
(tool-bar-local-item-from-menu
(car x) (cdr x) map gud-minor-mode-map))))
-(defvar gud-repeat-map (make-sparse-keymap)
- "Keymap to repeat gud stepping instructions `C-x C-a C-n n n'.
+(defvar gud-gdb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `gud-gdb' stepping instructions `C-x C-a C-n n n'.
Used in `repeat-mode'.")
+(defun gud-set-repeat-map-property (keymap-symbol)
+ "Set the `repeat-map' property of relevant gud commands to KEYMAP-SYMBOL.
+
+KEYMAP-SYMBOL is a symbol corresponding to some
+`<FOO>-repeat-map', a keymap containing gud commands that may be
+repeated when `repeat-mode' is on."
+ (map-keymap-internal (lambda (_ cmd)
+ (put cmd 'repeat-map keymap-symbol))
+ (symbol-value keymap-symbol)))
+
+
(defun gud-file-name (f)
"Transform a relative file name to an absolute file name.
Uses `gud-<MINOR-MODE>-directories' to find the source files."
@@ -814,16 +836,7 @@ the buffer in which this command was invoked."
(gud-def gud-until "until %l" "\C-u" "Continue to current line.")
(gud-def gud-run "run" nil "Run the program.")
- (dolist (cmd '(("n" . gud-next)
- ("s" . gud-step)
- ("i" . gud-stepi)
- ("c" . gud-cont)
- ("l" . gud-refresh)
- ("f" . gud-finish)
- ("<" . gud-up)
- (">" . gud-down)))
- (define-key gud-repeat-map (car cmd) (cdr cmd))
- (put (cdr cmd) 'repeat-map 'gud-repeat-map))
+ (gud-set-repeat-map-property 'gud-gdb-repeat-map)
(add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
nil 'local)
@@ -1024,6 +1037,18 @@ SKIP is the number of chars to skip on each line, it
defaults to 0."
(defvar gud-sdb-lastfile nil)
+(defvar gud-sdb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `sdb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defun gud-sdb-marker-filter (string)
(setq gud-marker-acc
(if gud-marker-acc (concat gud-marker-acc string) string))
@@ -1094,6 +1119,8 @@ and source-file directory for your debugger."
(gud-def gud-cont "c" "\C-r" "Continue with display.")
(gud-def gud-print "%e/" "\C-p" "Evaluate C expression at point.")
+ (gud-set-repeat-map-property 'gud-sdb-repeat-map)
+
(setq comint-prompt-regexp "\\(^\\|\n\\)\\*")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'sdb-mode-hook)
@@ -1252,6 +1279,23 @@ whereby $stopformat=1 produces an output format
compatible with
;; whereby `set $stopformat=1' reportedly produces output compatible
;; with `gud-dbx-marker-filter', which we prefer.
+(defvar gud-dbx-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key map key cmd))
+ (when (or gud-mips-p
+ gud-irix-p)
+ (define-key map "f" 'gud-finish))
+ map)
+ "Keymap to repeat `dbx' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
;; The process filter is also somewhat
;; unreliable, sometimes not spotting the markers; I don't know
;; whether there's anything that can be done about that.]
@@ -1399,6 +1443,8 @@ and source-file directory for your debugger."
(gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.")
(gud-def gud-run "run" nil "Run the program.")
+ (gud-set-repeat-map-property 'gud-dbx-repeat-map)
+
(setq comint-prompt-regexp "^[^)\n]*dbx) *")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'dbx-mode-hook)
@@ -1410,6 +1456,21 @@ and source-file directory for your debugger."
;; History of argument lists passed to xdb.
(defvar gud-xdb-history nil)
+(defvar gud-xdb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `xdb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defcustom gud-xdb-directories nil
"A list of directories that xdb should search for source code.
If nil, only source files in the program directory
@@ -1475,6 +1536,8 @@ directories if your program contains sources from more
than one directory."
(gud-def gud-finish "bu\\t" "\C-f" "Finish executing current function.")
(gud-def gud-print "p %e" "\C-p" "Evaluate C expression at point.")
+ (gud-set-repeat-map-property 'gud-xdb-repeat-map)
+
(setq comint-prompt-regexp "^>")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'xdb-mode-hook))
@@ -1485,6 +1548,17 @@ directories if your program contains sources from more
than one directory."
;; History of argument lists passed to perldb.
(defvar gud-perldb-history nil)
+(defvar gud-perldb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `perldb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defun gud-perldb-massage-args (_file args)
"Convert a command line as would be typed normally to run perldb
into one that invokes an Emacs-enabled debugging session.
@@ -1605,9 +1679,14 @@ into one that invokes an Emacs-enabled debugging session.
;;;###autoload
(defun perldb (command-line)
- "Run perldb on program FILE in buffer *gud-FILE*.
-The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger."
+ "Debug a perl program with gud.
+Interactively, this will prompt you for a command line.
+
+Noninteractively, COMMAND-LINE should be on the form
+\"perl -d perl-file.pl\".
+
+The directory containing the perl program becomes the initial
+working directory and source-file directory for your debugger."
(interactive
(list (gud-query-cmdline 'perldb
(concat (or (buffer-file-name) "-e 0") " "))))
@@ -1627,6 +1706,7 @@ and source-file directory for your debugger."
(gud-def gud-print "p %e" "\C-p" "Evaluate perl expression at
point.")
(gud-def gud-until "c %l" "\C-u" "Continue to current line.")
+ (gud-set-repeat-map-property 'gud-perldb-repeat-map)
(setq comint-prompt-regexp "^ DB<+[0-9]+>+ ")
(setq paragraph-start comint-prompt-regexp)
@@ -1655,6 +1735,20 @@ and source-file directory for your debugger."
(defvar gud-pdb-marker-regexp-start "^> ")
+(defvar gud-pdb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `pdb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
;; There's no guarantee that Emacs will hand the filter the entire
;; marker at once; it could be broken up across several strings. We
;; might even receive a big chunk with several markers in it. If we
@@ -1744,6 +1838,8 @@ directory and source-file directory for your debugger."
(gud-def gud-print "p %e" "\C-p" "Evaluate Python expression at
point.")
(gud-def gud-statement "!%e" "\C-e" "Execute Python statement at
point.")
+ (gud-set-repeat-map-property 'gud-pdb-repeat-map)
+
;; (setq comint-prompt-regexp "^(.*pdb[+]?) *")
(setq comint-prompt-regexp "^(Pdb) *")
(setq paragraph-start comint-prompt-regexp)
@@ -1757,6 +1853,19 @@ directory and source-file directory for your debugger."
(defvar gud-guiler-lastfile nil)
+(defvar gud-guiler-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("l" . gud-refresh)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `guiler' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defun gud-guiler-marker-filter (string)
(setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string)
string))
@@ -1822,6 +1931,8 @@ and source-file directory for your debugger."
(gud-def gud-down ",down" ">" "Down one stack frame.")
(gud-def gud-print "%e" "\C-p" "Evaluate Guile expression at
point.")
+ (gud-set-repeat-map-property 'gud-guiler-repeat-map)
+
(setq comint-prompt-regexp "^scheme@([^>]+> ")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'guiler-mode-hook))
@@ -2267,6 +2378,21 @@ extension EXTN. Normally EXTN is given as the regular
expression
;; Note: Reset to this value every time a prompt is seen
(defvar gud-jdb-lowest-stack-level 999)
+(defvar gud-jdb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)
+ ("l" . gud-refresh)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `jdb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defun gud-jdb-find-source-using-classpath (p)
"Find source file corresponding to fully qualified class P.
Convert P from jdb's output, converted to a pathname
@@ -2475,6 +2601,8 @@ gud, see `gud-mode'."
(gud-def gud-print "print %e" "\C-p" "Print value of expression at point.")
(gud-def gud-pstar "dump %e" nil "Print all object information at point.")
+ (gud-set-repeat-map-property 'gud-jdb-repeat-map)
+
(setq comint-prompt-regexp "^> \\|^[^ ]+\\[[0-9]+\\] ")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'jdb-mode-hook)
@@ -2652,14 +2780,24 @@ Commands:
(expand-file-name file-subst)
file-subst)))
(filepart (and file-word (concat "-" (file-name-nondirectory file))))
- (existing-buffer (get-buffer (concat "*gud" filepart "*"))))
+ (buffer-name (concat "*gud" filepart "*"))
+ (existing-buffer (get-buffer buffer-name))
+ error)
+ (when (and existing-buffer
+ (get-buffer-process existing-buffer))
+ (if (equal (buffer-local-value 'default-directory existing-buffer)
+ default-directory)
+ ;; We're already debugging this executable.
+ (setq error t)
+ ;; Open a new window to debug an executable with the same name.
+ (setq buffer-name (generate-new-buffer-name buffer-name))))
(select-window
(display-buffer
- (get-buffer-create (concat "*gud" filepart "*"))
+ (get-buffer-create buffer-name)
'((display-buffer-reuse-window
display-buffer-in-previous-window
display-buffer-same-window display-buffer-pop-up-window))))
- (when (and existing-buffer (get-buffer-process existing-buffer))
+ (when error
(error "This program is already being debugged"))
;; Set the dir, in case the buffer already existed with a different dir.
(setq default-directory dir)
@@ -2681,8 +2819,12 @@ Commands:
(setq w (cdr w)))
;; Tramp has already been loaded if we are here.
(if w (setcar w (setq file (file-local-name file)))))
- (apply #'make-comint (concat "gud" filepart) program nil
- (if massage-args (funcall massage-args file args) args))
+ (apply #'make-comint-in-buffer
+ (concat "gud" filepart) (current-buffer)
+ program nil
+ (if massage-args
+ (funcall massage-args file args)
+ args))
;; Since comint clobbered the mode, we don't set it until now.
(gud-mode)
(setq-local gud-target-name
@@ -3027,7 +3169,7 @@ Obeying it means displaying in another window the
specified file and line."
(buffer-substring (region-beginning) (region-end))
(apply gud-find-expr-function args))))
(save-match-data
- (if (string-match "\n" expr)
+ (if (string-search "\n" expr)
(error "Expression must not include a newline"))
(with-current-buffer gud-comint-buffer
(save-excursion
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 4a1da62..a2f5d72 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -682,7 +682,7 @@ that form should be displayed.")
(defconst hif-valid-token-list (mapcar 'cdr hif-token-alist))
(defconst hif-token-regexp
- ;; The ordering of regexp grouping is crutial to `hif-strtok'
+ ;; The ordering of regexp grouping is crucial to `hif-strtok'
(concat
;; hex/binary:
"\\([+-]?0[xXbB]\\([[:xdigit:]']+\\)?\\.?\\([[:xdigit:]']+\\)?\\([pP]\\([+-]?[0-9]+\\)\\)?"
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index db76df9..c53b9a4 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -495,7 +495,7 @@ It collects and prints the diagnostics messages."
((and (memq cw '(function-keyword procedure-keyword))
(stringp this-word)
(string-match "\\S-" this-word)
- (not (string-match "!" this-word)))
+ (not (string-search "!" this-word)))
(cond ((or (= (char-before beg) ?/)
(save-excursion (goto-char end)
(looking-at "[ \t]*=")))
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index ad8feb9..eb88f25 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -967,7 +967,7 @@ IDL has currently stepped.")
;; Strip those pesky ctrl-m's.
(add-hook 'comint-output-filter-functions
(lambda (string)
- (when (string-match "\r" string)
+ (when (string-search "\r" string)
(let ((pmark (process-mark (get-buffer-process
(current-buffer)))))
(save-excursion
@@ -1409,7 +1409,7 @@ Remove everything to the first newline, and all lines
with % in front
of them, with optional follow-on lines starting with two spaces. This
works well enough, since any print output typically arrives before
error messages, etc."
- (setq output (substring output (string-match "\n" output)))
+ (setq output (substring output (string-search "\n" output)))
(while (string-match "\\(\n\\|\\`\\)%.*\\(\n .*\\)*" output)
(setq output (replace-match "" nil t output)))
(unless
@@ -1431,12 +1431,12 @@ and then calls `idlwave-shell-send-command' for any
pending commands."
(unwind-protect
(progn
;; Ring the bell if necessary
- (while (setq p (string-match "\C-G" string))
+ (while (setq p (string-search "\C-G" string))
(ding)
(aset string p ?\C-j ))
(if idlwave-shell-hide-output
(save-excursion
- (while (setq p (string-match "\C-M" string))
+ (while (setq p (string-search "\C-M" string))
(aset string p ?\ ))
(set-buffer
(get-buffer-create idlwave-shell-hidden-output-buffer))
@@ -1445,7 +1445,7 @@ and then calls `idlwave-shell-send-command' for any
pending commands."
(comint-output-filter proc string))
;; Watch for magic - need to accumulate the current line
;; since it may not be sent all at once.
- (if (string-match "\n" string)
+ (if (string-search "\n" string)
(progn
(if idlwave-shell-use-input-mode-magic
(idlwave-shell-input-mode-magic
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index b55a98a..55e712d 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -2547,7 +2547,7 @@ If there is no label point is not moved and nil is
returned."
(end (idlwave-find-key ":" 1 'nomark eos)))
(if (and end
(= (nth 0 (parse-partial-sexp start end)) 0)
- (not (string-match "\\?" (buffer-substring start end)))
+ (not (string-search "?" (buffer-substring start end)))
(not (string-match "^::" (buffer-substring end eos))))
(progn
(forward-char)
@@ -7677,9 +7677,9 @@ arg, the class property is cleared out."
(interactive "P")
(idlwave-routines)
- (if (string-match "->" (buffer-substring
- (max (point-min) (1- (point)))
- (min (+ 2 (point)) (point-max))))
+ (if (string-search "->" (buffer-substring
+ (max (point-min) (1- (point)))
+ (min (+ 2 (point)) (point-max))))
;; Cursor is on an arrow
(if (get-text-property (point) 'idlwave-class)
;; arrow has class property
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 4d27775..df17b87 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -257,7 +257,7 @@ not be enclosed in { } or ( )."
"Regex used to highlight makepp rule action lines in font lock mode.")
(defconst makefile-bsdmake-rule-action-regex
- (replace-regexp-in-string "-@" "-+@" makefile-rule-action-regex)
+ (string-replace "-@" "-+@" makefile-rule-action-regex)
"Regex used to highlight BSD rule action lines in font lock mode.")
;; Note that the first and second subexpression is used by font lock. Note
@@ -358,11 +358,10 @@ not be enclosed in { } or ( )."
,@(if keywords
;; Fontify conditionals and includes.
`((,(concat "^\\(?: [ \t]*\\)?"
- (replace-regexp-in-string
+ (string-replace
" " "[ \t]+"
(if (eq (car keywords) t)
- (replace-regexp-in-string "-" "[_-]"
- (regexp-opt (cdr keywords) t))
+ (string-replace "-" "[_-]" (regexp-opt (cdr keywords) t))
(regexp-opt keywords t)))
"\\>[ \t]*\\([^: \t\n#]*\\)")
(1 font-lock-keyword-face) (2 font-lock-variable-name-face))))
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index aff3066..b1a5f30 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -895,7 +895,7 @@ startup file, `~/.emacs-octave'."
(defun inferior-octave-completion-at-point ()
"Return the data to complete the Octave symbol at point."
;; https://debbugs.gnu.org/14300
- (unless (string-match-p "/" (or (comint--match-partial-filename) ""))
+ (unless (string-search "/" (or (comint--match-partial-filename) ""))
(let ((beg (save-excursion
(skip-syntax-backward "w_" (comint-line-beginning-position))
(point)))
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index f49ee4c..4e14c30 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -178,6 +178,14 @@
(defconst perl-font-lock-keywords-2
(append
+ '(;; Fontify function, variable and file name references. They have to be
+ ;; handled first because they might conflict with keywords.
+ ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
+ ;; Additionally fontify non-scalar variables. `perl-non-scalar-variable'
+ ;; will underline them by default.
+ ("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face)
+ ("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)"
+ (2 'perl-non-scalar-variable)))
perl-font-lock-keywords-1
`( ;; Fontify keywords, except those fontified otherwise.
,(concat "\\<"
@@ -188,15 +196,6 @@
;;
;; Fontify declarators and prefixes as types.
("\\<\\(has\\|local\\|my\\|our\\|state\\)\\>" . font-lock-keyword-face) ;
declarators
- ;;
- ;; Fontify function, variable and file name references.
- ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
- ;; Additionally fontify non-scalar variables. `perl-non-scalar-variable'
- ;; will underline them by default.
- ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face)
- ("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face)
- ("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)"
- (2 'perl-non-scalar-variable))
("<\\(\\sw+\\)>" 1 font-lock-constant-face)
;;
;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'.
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index 19de754..f75a303 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -43,6 +43,33 @@
display-line-numbers-mode
prettify-symbols-mode))
+(defun prog-context-menu (menu)
+ (require 'xref)
+ (define-key-after menu [prog-separator] menu-bar-separator
+ 'mark-whole-buffer)
+ (define-key-after menu [xref-find-def]
+ '(menu-item "Find Definition" xref-find-definitions-at-mouse
+ :visible (save-excursion
+ (mouse-set-point last-input-event)
+ (xref-backend-identifier-at-point
+ (xref-find-backend)))
+ :help "Find definition of identifier")
+ 'prog-separator)
+ (define-key-after menu [xref-find-ref]
+ '(menu-item "Find References" xref-find-references-at-mouse
+ :visible (save-excursion
+ (mouse-set-point last-input-event)
+ (xref-backend-identifier-at-point
+ (xref-find-backend)))
+ :help "Find references to identifier")
+ 'xref-find-def)
+ (define-key-after menu [xref-pop]
+ '(menu-item "Back Definition" xref-pop-marker-stack
+ :visible (not (xref-marker-stack-empty-p))
+ :help "Back to the position of the last search")
+ 'xref-find-ref)
+ menu)
+
(defvar prog-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [?\C-\M-q] 'prog-indent-sexp)
@@ -249,6 +276,7 @@ support it."
"Major mode for editing programming language source code."
(setq-local require-final-newline mode-require-final-newline)
(setq-local parse-sexp-ignore-comments t)
+ (add-hook 'context-menu-functions 'prog-context-menu 10 t)
;; Any programming language is always written left to right.
(setq bidi-paragraph-direction 'left-to-right))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index eab6075..b6eea7e 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,7 +1,7 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t;
-*-
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
-;; Version: 0.6.0
+;; Version: 0.6.1
;; Package-Requires: ((emacs "26.1") (xref "1.0.2"))
;; This is a GNU ELPA :core package. Avoid using functionality that
@@ -51,6 +51,11 @@
;; files and its relations to external directories. `project-files'
;; should be consistent with `project-ignores'.
;;
+;; `project-buffers' can be overridden if the project has some unusual
+;; shape (e.g. it contains files residing outside of its root, or some
+;; files inside the root must not be considered a part of it). It
+;; should be consistent with `project-files'.
+;;
;; This list can change in future versions.
;;
;; VC project:
@@ -297,11 +302,10 @@ to find the list of ignores for each directory."
;; expanded and not left for the shell command
;; to interpret.
(localdir (file-name-unquote (file-local-name (expand-file-name
dir))))
- (command (format "%s -H %s %s -type f %s -print0"
+ (dfn (directory-file-name localdir))
+ (command (format "%s -H . %s -type f %s -print0"
find-program
- (shell-quote-argument
- (directory-file-name localdir)) ; Bug#48471
- (xref--find-ignores-arguments ignores localdir)
+ (xref--find-ignores-arguments ignores "./")
(if files
(concat (shell-quote-argument "(")
" " find-name-arg " "
@@ -319,8 +323,9 @@ to find the list of ignores for each directory."
(unless (zerop status)
(error "File listing failed: %s"
(buffer-string))))))))
(project--remote-file-names
- (sort (split-string output "\0" t)
- #'string<))))
+ (mapcar (lambda (s) (concat dfn (substring s 1)))
+ (sort (split-string output "\0" t)
+ #'string<)))))
(defun project--remote-file-names (local-files)
"Return LOCAL-FILES as if they were on the system of `default-directory'.
@@ -334,6 +339,16 @@ Also quote LOCAL-FILES if `default-directory' is quoted."
(concat remote-id file))
local-files))))
+(cl-defgeneric project-buffers (project)
+ "Return the list of all live buffers that belong to PROJECT."
+ (let ((root (expand-file-name (file-name-as-directory (project-root
project))))
+ bufs)
+ (dolist (buf (buffer-list))
+ (when (string-prefix-p root (expand-file-name
+ (buffer-local-value 'default-directory
buf)))
+ (push buf bufs)))
+ (nreverse bufs)))
+
(defgroup project-vc nil
"Project implementation based on the VC package."
:version "25.1"
@@ -589,7 +604,9 @@ backend implementation of `project-external-roots'.")
(replace-match "./" t t entry 1)
(concat "./" entry)))
(t entry)))
- (vc-call-backend backend 'ignore-completion-table root))))
+ (condition-case nil
+ (vc-call-backend backend 'ignore-completion-table root)
+ (vc-not-supported () nil)))))
(project--value-in-dir 'project-vc-ignores root)
(mapcar
(lambda (dir)
@@ -628,6 +645,23 @@ DIRS must contain directory names."
(hack-dir-local-variables-non-file-buffer))
(symbol-value var)))
+(cl-defmethod project-buffers ((project (head vc)))
+ (let* ((root (expand-file-name (file-name-as-directory (project-root
project))))
+ (modules (unless (or (project--vc-merge-submodules-p root)
+ (project--submodule-p root))
+ (mapcar
+ (lambda (m) (format "%s%s/" root m))
+ (project--git-submodules))))
+ dd
+ bufs)
+ (dolist (buf (buffer-list))
+ (setq dd (expand-file-name (buffer-local-value 'default-directory buf)))
+ (when (and (string-prefix-p root dd)
+ (not (cl-find-if (lambda (module) (string-prefix-p module dd))
+ modules)))
+ (push buf bufs)))
+ (nreverse bufs)))
+
;;; Project commands
@@ -879,23 +913,16 @@ PREDICATE, HIST, and DEFAULT have the same meaning as in
(defun project--completing-read-strict (prompt
collection &optional predicate
hist default)
- ;; Tried both expanding the default before showing the prompt, and
- ;; removing it when it has no matches. Neither seems natural
- ;; enough. Removal is confusing; early expansion makes the prompt
- ;; too long.
- (let* ((new-prompt (if (and default (not (string-equal default "")))
- (format "%s (default %s): " prompt default)
- (format "%s: " prompt)))
- (res (completing-read new-prompt
- collection predicate t
- nil ;; initial-input
- hist default)))
- (when (and (equal res default)
- (not (test-completion res collection predicate)))
- (setq res
- (completing-read (format "%s: " prompt)
- collection predicate t res hist nil)))
- res))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq-local minibuffer-default-add-function
+ (lambda ()
+ (let ((minibuffer-default default))
+ (minibuffer-default-add-completions)))))
+ (completing-read (format "%s: " prompt)
+ collection predicate 'confirm
+ nil
+ hist)))
;;;###autoload
(defun project-dired ()
@@ -1021,13 +1048,11 @@ If non-nil, it overrides
`compilation-buffer-name-function' for
(current-buffer (current-buffer))
(other-buffer (other-buffer current-buffer))
(other-name (buffer-name other-buffer))
+ (buffers (project-buffers pr))
(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)))))))
+ (memq (cdr buffer) buffers))))
(read-buffer
"Switch to buffer: "
(when (funcall predicate (cons other-name other-buffer))
@@ -1167,7 +1192,7 @@ of CONDITIONS."
What buffers should or should not be killed is described
in `project-kill-buffer-conditions'."
(let (bufs)
- (dolist (buf (project--buffer-list pr))
+ (dolist (buf (project-buffers pr))
(when (project--kill-buffer-check buf project-kill-buffer-conditions)
(push buf bufs)))
bufs))
@@ -1386,8 +1411,8 @@ to directory DIR."
(define-key temp-map (vector keychar) cmd)))))
command)
(while (not command)
- (let ((overriding-local-map commands-map)
- (choice (read-key-sequence (project--keymap-prompt))))
+ (let* ((overriding-local-map commands-map)
+ (choice (read-key-sequence (project--keymap-prompt))))
(when (setq command (lookup-key commands-map choice))
(unless (or project-switch-use-entire-map
(assq command commands-menu))
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 29cce51..2e23c2e 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -1315,6 +1315,7 @@ With prefix argument ARG, restart the Prolog process if
running before."
(progn
(process-send-string "prolog" "halt.\n")
(while (get-process "prolog") (sit-for 0.1))))
+ (prolog-ensure-process)
(let ((buff (buffer-name)))
(if (not (string= buff "*prolog*"))
(prolog-goto-prolog-process-buffer))
@@ -1324,7 +1325,6 @@ With prefix argument ARG, restart the Prolog process if
running before."
prolog-use-sicstus-sd)
(prolog-enable-sicstus-sd))
(prolog-mode-variables)
- (prolog-ensure-process)
))
(defun prolog-inferior-guess-flavor (&optional ignored)
@@ -1349,56 +1349,57 @@ With prefix argument ARG, restart the Prolog process if
running before."
"If Prolog process is not running, run it.
If the optional argument WAIT is non-nil, wait for Prolog prompt specified by
the variable `prolog-prompt-regexp'."
- (if (null (prolog-program-name))
- (error "This Prolog system has defined no interpreter."))
- (if (comint-check-proc "*prolog*")
- ()
- (with-current-buffer (get-buffer-create "*prolog*")
- (prolog-inferior-mode)
-
- ;; The "INFERIOR=yes" hack is for SWI-Prolog 7.2.3 and earlier,
- ;; which assumes it is running under Emacs if either INFERIOR=yes or
- ;; if EMACS is set to a nonempty value. The EMACS setting is
- ;; obsolescent, so set INFERIOR. Newer versions of SWI-Prolog should
- ;; know about INSIDE_EMACS (which replaced EMACS) and should not need
- ;; this hack.
- (let ((process-environment
- (if (getenv "INFERIOR")
- process-environment
- (cons "INFERIOR=yes" process-environment))))
- (apply 'make-comint-in-buffer "prolog" (current-buffer)
- (prolog-program-name) nil (prolog-program-switches)))
-
- (unless prolog-system
- ;; Setup auto-detection.
- (setq-local
- prolog-system
- ;; Force re-detection.
- (let* ((proc (get-buffer-process (current-buffer)))
- (pmark (and proc (marker-position (process-mark proc)))))
- (cond
- ((null pmark) (1- (point-min)))
- ;; The use of insert-before-markers in comint.el together with
- ;; the potential use of comint-truncate-buffer in the output
- ;; filter, means that it's difficult to reliably keep track of
- ;; the buffer position where the process's output started.
- ;; If possible we use a marker at "start - 1", so that
- ;; insert-before-marker at `start' won't shift it. And if not,
- ;; we fall back on using a plain integer.
- ((> pmark (point-min)) (copy-marker (1- pmark)))
- (t (1- pmark)))))
- (add-hook 'comint-output-filter-functions
- 'prolog-inferior-guess-flavor nil t))
- (if wait
- (progn
- (goto-char (point-max))
- (while
- (save-excursion
- (not
- (re-search-backward
- (concat "\\(" (prolog-prompt-regexp) "\\)" "\\=")
- nil t)))
- (sit-for 0.1)))))))
+ (let ((pname (prolog-program-name))
+ (pswitches (prolog-program-switches)))
+ (if (null pname)
+ (error "This Prolog system has defined no interpreter."))
+ (unless (comint-check-proc "*prolog*")
+ (with-current-buffer (get-buffer-create "*prolog*")
+ (prolog-inferior-mode)
+
+ ;; The "INFERIOR=yes" hack is for SWI-Prolog 7.2.3 and earlier,
+ ;; which assumes it is running under Emacs if either INFERIOR=yes or
+ ;; if EMACS is set to a nonempty value. The EMACS setting is
+ ;; obsolescent, so set INFERIOR. Newer versions of SWI-Prolog should
+ ;; know about INSIDE_EMACS (which replaced EMACS) and should not need
+ ;; this hack.
+ (let ((process-environment
+ (if (getenv "INFERIOR")
+ process-environment
+ (cons "INFERIOR=yes" process-environment))))
+ (apply 'make-comint-in-buffer "prolog" (current-buffer)
+ pname nil pswitches))
+
+ (unless prolog-system
+ ;; Setup auto-detection.
+ (setq-local
+ prolog-system
+ ;; Force re-detection.
+ (let* ((proc (get-buffer-process (current-buffer)))
+ (pmark (and proc (marker-position (process-mark proc)))))
+ (cond
+ ((null pmark) (1- (point-min)))
+ ;; The use of insert-before-markers in comint.el together with
+ ;; the potential use of comint-truncate-buffer in the output
+ ;; filter, means that it's difficult to reliably keep track of
+ ;; the buffer position where the process's output started.
+ ;; If possible we use a marker at "start - 1", so that
+ ;; insert-before-marker at `start' won't shift it. And if not,
+ ;; we fall back on using a plain integer.
+ ((> pmark (point-min)) (copy-marker (1- pmark)))
+ (t (1- pmark)))))
+ (add-hook 'comint-output-filter-functions
+ 'prolog-inferior-guess-flavor nil t))
+ (if wait
+ (progn
+ (goto-char (point-max))
+ (while
+ (save-excursion
+ (not
+ (re-search-backward
+ (concat "\\(" (prolog-prompt-regexp) "\\)" "\\=")
+ nil t)))
+ (sit-for 0.1))))))))
(defun prolog-inferior-buffer (&optional dont-run)
(or (get-buffer "*prolog*")
@@ -2276,7 +2277,7 @@ between them)."
;(goto-char beg)
(if (search-forward-regexp "^[ \t]*\\(%+\\|\\*+\\|/\\*+\\)[ \t]*"
end t)
- (replace-regexp-in-string "/" " " (buffer-substring beg (point)))
+ (string-replace "/" " " (buffer-substring beg (point)))
(beginning-of-line)
(when (search-forward-regexp "^[ \t]+" end t)
(buffer-substring beg (point)))))))))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index f7267bd..d8ec032 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -54,14 +54,7 @@
;; `python-nav-backward-statement',
;; `python-nav-beginning-of-statement', `python-nav-end-of-statement',
;; `python-nav-beginning-of-block', `python-nav-end-of-block' and
-;; `python-nav-if-name-main' are included but no bound to any key. At
-;; last but not least the specialized `python-nav-forward-sexp' allows
-;; easy navigation between code blocks. If you prefer `cc-mode'-like
-;; `forward-sexp' movement, setting `forward-sexp-function' to nil is
-;; enough, You can do that using the `python-mode-hook':
-
-;; (add-hook 'python-mode-hook
-;; (lambda () (setq forward-sexp-function nil)))
+;; `python-nav-if-name-main' are included but no bound to any key.
;; Shell interaction: is provided and allows opening Python shells
;; inside Emacs and executing any block of code of your current buffer
@@ -2029,7 +2022,12 @@ position, else returns nil."
(cond ((executable-find "python3") "python3")
((executable-find "python") "python")
(t "python3"))
- "Default Python interpreter for shell."
+ "Default Python interpreter for shell.
+
+Some Python interpreters also require changes to
+`python-shell-interpreter-args'. In particular, setting
+`python-shell-interpreter' to \"ipython3\" requires setting
+`python-shell-interpreter-args' to \"--simple-prompt\"."
:version "28.1"
:type 'string
:group 'python)
@@ -3083,6 +3081,45 @@ there for compatibility with CEDET.")
(delete-trailing-whitespace))
temp-file-name))
+(defconst python-shell-eval-setup-code
+ "\
+def __PYTHON_EL_eval(source, filename):
+ import ast, sys
+ if sys.version_info[0] == 2:
+ from __builtin__ import compile, eval, globals
+ else:
+ from builtins import compile, eval, globals
+ sys.stdout.write('\\n')
+ try:
+ p, e = ast.parse(source, filename), None
+ except SyntaxError:
+ t, v, tb = sys.exc_info()
+ sys.excepthook(t, v, tb.tb_next)
+ return
+ if p.body and isinstance(p.body[-1], ast.Expr):
+ e = p.body.pop()
+ try:
+ g = globals()
+ exec(compile(p, filename, 'exec'), g, g)
+ if e:
+ return eval(compile(ast.Expression(e.value), filename, 'eval'), g,
g)
+ except Exception:
+ t, v, tb = sys.exc_info()
+ sys.excepthook(t, v, tb.tb_next)"
+ "Code used to evaluate statements in inferior Python processes.")
+
+(defalias 'python-shell--encode-string
+ (let ((fun (if (and (fboundp 'json-serialize)
+ (>= emacs-major-version 28))
+ 'json-serialize
+ (require 'json)
+ 'json-encode-string)))
+ (lambda (text)
+ (if (stringp text)
+ (funcall fun text)
+ (signal 'wrong-type-argument (list 'stringp text)))))
+ "Encode TEXT as a valid Python string.")
+
(defun python-shell-send-string (string &optional process msg)
"Send STRING to inferior Python PROCESS.
When optional argument MSG is non-nil, forces display of a
@@ -3090,15 +3127,18 @@ user-friendly message if there's no process running;
defaults to
t when called interactively."
(interactive
(list (read-string "Python command: ") nil t))
- (let ((process (or process (python-shell-get-process-or-error msg))))
- (if (string-match ".\n+." string) ;Multiline.
- (let* ((temp-file-name (python-shell--save-temp-file string))
- (file-name (or (buffer-file-name) temp-file-name)))
- (python-shell-send-file file-name process temp-file-name t))
- (comint-send-string process string)
- (when (or (not (string-match "\n\\'" string))
- (string-match "\n[ \t].*\n?\\'" string))
- (comint-send-string process "\n")))))
+ (let ((process (or process (python-shell-get-process-or-error msg)))
+ (code (format "exec(%s);__PYTHON_EL_eval(%s, %s)\n"
+ (python-shell--encode-string
python-shell-eval-setup-code)
+ (python-shell--encode-string string)
+ (python-shell--encode-string (or (buffer-file-name)
+ "<string>")))))
+ (if (<= (string-bytes code) 4096)
+ (comint-send-string process code)
+ (let* ((temp-file-name (with-current-buffer (process-buffer process)
+ (python-shell--save-temp-file string)))
+ (file-name (or (buffer-file-name) temp-file-name)))
+ (python-shell-send-file file-name process temp-file-name t)))))
(defvar python-shell-output-filter-in-progress nil)
(defvar python-shell-output-filter-buffer nil)
@@ -3140,7 +3180,8 @@ Return the output."
(inhibit-quit t))
(or
(with-local-quit
- (python-shell-send-string string process)
+ (comint-send-string
+ process (format "exec(%s)\n" (python-shell--encode-string string)))
(while python-shell-output-filter-in-progress
;; `python-shell-output-filter' takes care of setting
;; `python-shell-output-filter-in-progress' to NIL after it
@@ -3337,6 +3378,18 @@ t when called interactively."
nil ;; noop
msg))))
+
+(defconst python-shell-eval-file-setup-code
+ "\
+def __PYTHON_EL_eval_file(filename, tempname, encoding, delete):
+ import codecs, os
+ with codecs.open(tempname or filename, encoding=encoding) as file:
+ source = file.read().encode(encoding)
+ if delete and tempname:
+ os.remove(tempname)
+ return __PYTHON_EL_eval(source, filename)"
+ "Code used to evaluate files in inferior Python processes.")
+
(defun python-shell-send-file (file-name &optional process temp-file-name
delete msg)
"Send FILE-NAME to inferior Python PROCESS.
@@ -3363,18 +3416,16 @@ t when called interactively."
(temp-file-name (when temp-file-name
(file-local-name (expand-file-name
temp-file-name)))))
- (python-shell-send-string
+ (comint-send-string
+ process
(format
- (concat
- "import codecs, os;"
- "__pyfile = codecs.open('''%s''', encoding='''%s''');"
- "__code = __pyfile.read().encode('''%s''');"
- "__pyfile.close();"
- (when (and delete temp-file-name)
- (format "os.remove('''%s''');" temp-file-name))
- "exec(compile(__code, '''%s''', 'exec'));")
- (or temp-file-name file-name) encoding encoding file-name)
- process)))
+ "exec(%s);exec(%s);__PYTHON_EL_eval_file(%s, %s, %s, %s)\n"
+ (python-shell--encode-string python-shell-eval-setup-code)
+ (python-shell--encode-string python-shell-eval-file-setup-code)
+ (python-shell--encode-string file-name)
+ (python-shell--encode-string (or temp-file-name ""))
+ (python-shell--encode-string (symbol-name encoding))
+ (if delete "True" "False")))))
(defun python-shell-switch-to-shell (&optional msg)
"Switch to inferior Python process buffer.
@@ -5505,6 +5556,13 @@ By default messages are considered errors."
:type '(alist :key-type (regexp)
:value-type (symbol)))
+(defcustom python-forward-sexp-function #'python-nav-forward-sexp
+ "Function to use when navigating between expressions."
+ :version "28.1"
+ :type '(choice (const :tag "Python blocks" python-nav-forward-sexp)
+ (const :tag "CC-mode like" nil)
+ function))
+
(defvar-local python--flymake-proc nil)
(defun python--flymake-parse-output (source proc report-fn)
@@ -5602,7 +5660,7 @@ REPORT-FN is Flymake's callback function."
(setq-local parse-sexp-lookup-properties t)
(setq-local parse-sexp-ignore-comments t)
- (setq-local forward-sexp-function #'python-nav-forward-sexp)
+ (setq-local forward-sexp-function python-forward-sexp-function)
(setq-local font-lock-defaults
`(,python-font-lock-keywords
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 01fb044..c09f007 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -679,7 +679,7 @@ It is used when `ruby-encoding-magic-comment-style' is set
to `custom'."
(let ((index-alist '()) (case-fold-search nil)
name next pos decl sing)
(goto-char beg)
- (while (re-search-forward "^\\s *\\(\\(class\\s +\\|\\(class\\s *<<\\s
*\\)\\|module\\s +\\)\\([^(<\n ]+\\)\\|\\(def\\|alias\\)\\s +\\([^(\n ]+\\)\\)"
end t)
+ (while (re-search-forward "^\\s *\\(\\(class\\s +\\|\\(class\\s *<<\\s
*\\)\\|module\\s +\\)\\([^(<\n
]+\\)\\|\\(\\(?:\\(?:private\\|protected\\|public\\) +\\)?def\\|alias\\)\\s
+\\([^(\n ]+\\)\\)" end t)
(setq sing (match-beginning 3))
(setq decl (match-string 5))
(setq next (match-end 0))
@@ -689,7 +689,7 @@ It is used when `ruby-encoding-magic-comment-style' is set
to `custom'."
((string= "alias" decl)
(if prefix (setq name (concat prefix name)))
(push (cons name pos) index-alist))
- ((string= "def" decl)
+ ((not (null decl))
(if prefix
(setq name
(cond
@@ -1788,8 +1788,8 @@ If the result is do-end block, it will always be
multiline."
(buffer-substring-no-properties (1+ min) (1- max))))
(setq content
(if (equal string-quote "'")
- (replace-regexp-in-string "\\\\\"" "\""
(replace-regexp-in-string "\\(\\`\\|[^\\]\\)'" "\\1\\\\'" content))
- (replace-regexp-in-string "\\\\'" "'" (replace-regexp-in-string
"\\(\\`\\|[^\\]\\)\"" "\\1\\\\\"" content))))
+ (string-replace "\\\"" "\"" (replace-regexp-in-string
"\\(\\`\\|[^\\]\\)'" "\\1\\\\'" content))
+ (string-replace "\\'" "'" (replace-regexp-in-string
"\\(\\`\\|[^\\]\\)\"" "\\1\\\\\"" content))))
(let ((orig-point (point)))
(delete-region min max)
(insert
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 91db4ae..201d1fd 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -1532,6 +1532,7 @@ with your script for an edit-interpret-debug cycle."
(setq-local add-log-current-defun-function #'sh-current-defun-name)
(add-hook 'completion-at-point-functions
#'sh-completion-at-point-function nil t)
+ (setq-local outline-regexp "###")
;; Parse or insert magic number for exec, and set all variables depending
;; on the shell thus determined.
(sh-set-shell
@@ -1774,7 +1775,7 @@ Does not preserve point."
(goto-char p)
nil))))
(while
- (progn (skip-syntax-backward "w_'")
+ (progn (skip-syntax-backward ".w_'")
(or (not (zerop (skip-syntax-backward "\\")))
(when (eq ?\\ (char-before (1- (point))))
(let ((p (point)))
@@ -2672,7 +2673,7 @@ t means to return a list of all possible completions of
STRING.
(or sh-shell-variables-initialized
(sh-shell-initialize-variables))
(nconc (mapcar (lambda (var)
- (substring var 0 (string-match "=" var)))
+ (substring var 0 (string-search "=" var)))
process-environment)
sh-shell-variables))))
(complete-with-action code vars string predicate)))
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index f144549..d144d68 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -1573,7 +1573,7 @@ statement. The format of variable should be a valid
face)))
(defun sql-regexp-abbrev (keyword)
- (let ((brk (string-match "[~]" keyword))
+ (let ((brk (string-search "~" keyword))
(len (length keyword))
(sep "\\(?:")
re i)
@@ -3843,7 +3843,7 @@ to avoid deleting non-prompt output."
(defun sql-remove-tabs-filter (str)
"Replace tab characters with spaces."
- (replace-regexp-in-string "\t" " " str nil t))
+ (string-replace "\t" " " str))
(defun sql-toggle-pop-to-buffer-after-send-region (&optional value)
"Toggle `sql-pop-to-buffer-after-send-region'.
@@ -3864,7 +3864,7 @@ If given the optional parameter VALUE, sets
"If non-nil, display messages related to the use of redirection.")
(defun sql-str-literal (s)
- (concat "'" (replace-regexp-in-string "[']" "''" s) "'"))
+ (concat "'" (string-replace "[']" "''" s) "'"))
(defun sql-redirect (sqlbuf command &optional outbuf save-prior)
"Execute the SQL command and send output to OUTBUF.
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 2b88120..7c8ccea 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -5112,7 +5112,6 @@ primitive or interface named NAME."
(;- task/function/initial et cetera
t
- (match-end 0)
(goto-char (match-end 0))
(setq there (point))
(setq err nil)
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 5eeac8a..3fe67fa 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -4700,7 +4700,7 @@ Usage:
`vhdl-project-alist'.
- SPECIAL MENUES:
+ SPECIAL MENUS:
As an alternative to the speedbar, an index menu can be added (set
option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu
(e.g. add \"(global-set-key [S-down-mouse-3] \\='imenu)\" to your start-up
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 02a8d72..eb170ba 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -175,7 +175,7 @@ and you want to simplify them for the mode line
(defvar which-func-table (make-hash-table :test 'eq :weakness 'key))
(defconst which-func-current
- '(:eval (replace-regexp-in-string
+ '(:eval (string-replace
"%" "%%"
(or (gethash (selected-window) which-func-table)
which-func-unknown))))
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index e2cd904..d022baaf 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1,7 +1,7 @@
;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
-;; Version: 1.1.0
+;; Version: 1.2.2
;; Package-Requires: ((emacs "26.1"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -233,7 +233,7 @@ LOCATION is an `xref-location'."
((summary :type string :initarg :summary
:reader xref-item-summary)
(location :initarg :location
- :type xref-file-location
+ :type xref-location
:reader xref-item-location)
(length :initarg :length :reader xref-match-length))
:comment "A match xref item describes a search result.")
@@ -290,7 +290,11 @@ find a search tool; by default, this uses \"find | grep\"
in the
current project's main and external roots."
(mapcan
(lambda (dir)
- (xref-references-in-directory identifier dir))
+ (message "Searching %s..." dir)
+ (redisplay)
+ (prog1
+ (xref-references-in-directory identifier dir)
+ (message "Searching %s... done" dir)))
(let ((pr (project-current t)))
(cons
(xref--project-root pr)
@@ -412,6 +416,33 @@ elements is negated: these commands will NOT prompt."
:version "28.1"
:package-version '(xref . "1.0.4"))
+(defcustom xref-auto-jump-to-first-definition nil
+ "If t, `xref-find-definitions' always jumps to the first result.
+`show' means to show the first result's location, but keep the
+focus on the Xref buffer's window.
+`move' means to only move point to the first result."
+ :type '(choice (const :tag "Jump" t)
+ (const :tag "Show" show)
+ (const :tag "Move point only" move)
+ (const :tag "No auto-jump" nil))
+ :version "28.1"
+ :package-version '(xref . "1.2.0"))
+
+(defcustom xref-auto-jump-to-first-xref nil
+ "If t, xref commands always jump to the first result.
+`show' means to show the first result's location, but keep the
+focus on the Xref buffer's window.
+`move' means to only move point to the first result.
+
+Please be careful changing this value if you are using Emacs 27
+or earlier: it can break dired-do-find-regexp-and-replace."
+ :type '(choice (const :tag "Jump" t)
+ (const :tag "Show" show)
+ (const :tag "Move point only" move)
+ (const :tag "No auto-jump" nil))
+ :version "28.1"
+ :package-version '(xref . "1.2.0"))
+
(defvar xref--marker-ring (make-ring xref-marker-ring-length)
"Ring of markers to implement the marker stack.")
@@ -596,12 +627,19 @@ SELECT is `quit', also quit the *xref* window."
(xref--show-pos-in-buf marker buf))))))
(user-error (message (error-message-string err)))))
+(defun xref--set-arrow ()
+ "Set the overlay arrow at the line at point."
+ (setq overlay-arrow-position
+ (set-marker (or overlay-arrow-position (make-marker))
+ (line-beginning-position))))
+
(defun xref-show-location-at-point ()
"Display the source of xref at point in the appropriate window, if any."
(interactive)
(let* ((xref (xref--item-at-point))
(xref--current-item xref))
(when xref
+ (xref--set-arrow)
(xref--show-location (xref-item-location xref)))))
(defun xref-next-line-no-show ()
@@ -657,8 +695,9 @@ quit the *xref* buffer."
(interactive "P")
(let* ((buffer (current-buffer))
(xref (or (xref--item-at-point)
- (user-error "No reference at point")))
+ (user-error "Choose a reference to visit")))
(xref--current-item xref))
+ (xref--set-arrow)
(xref--show-location (xref-item-location xref) (if quit 'quit t))
(if (fboundp 'next-error-found)
(next-error-found buffer (current-buffer))
@@ -877,18 +916,21 @@ beginning of the line."
;; it gets reset to that window's point from time to time).
(let ((win (get-buffer-window (current-buffer))))
(and win (set-window-point win (point))))
- (xref--show-location (xref-item-location xref) t))
+ (xref--set-arrow)
+ (let ((xref--current-item xref))
+ (xref--show-location (xref-item-location xref) t)))
(t
(error "No %s xref" (if backward "previous" "next"))))))
(defvar xref--button-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-1] #'xref-goto-xref)
- (define-key map [mouse-2] #'xref--mouse-2)
+ (define-key map [mouse-2] #'xref-select-and-show-xref)
map))
-(defun xref--mouse-2 (event)
- "Move point to the button and show the xref definition."
+(defun xref-select-and-show-xref (event)
+ "Move point to the button and show the xref definition.
+The window showing the xref buffer will be selected."
(interactive "e")
(mouse-set-point event)
(forward-line 0)
@@ -896,6 +938,9 @@ beginning of the line."
(xref--search-property 'xref-item))
(xref-show-location-at-point))
+(define-obsolete-function-alias
+ 'xref--mouse-2 #'xref-select-and-show-xref "28.1")
+
(defcustom xref-truncation-width 400
"The column to visually \"truncate\" each Xref buffer line to."
:type '(choice
@@ -966,7 +1011,8 @@ GROUP is a string for decoration purposes and XREF is an
'face 'xref-line-number)))))
;; Render multiple matches on the same line, together.
(when (and (equal prev-group group)
- (not (equal prev-line line)))
+ (or (null line)
+ (not (equal prev-line line))))
(insert "\n"))
(xref--insert-propertized
(list 'xref-item xref
@@ -1001,13 +1047,16 @@ Return an alist of the form ((FILENAME . (XREF ...))
...)."
(assoc-default 'fetched-xrefs alist)
(funcall fetcher)))
(xref-alist (xref--analyze xrefs))
- (dd default-directory))
+ (dd default-directory)
+ buf)
(with-current-buffer (get-buffer-create xref-buffer-name)
(setq default-directory dd)
(xref--xref-buffer-mode)
(xref--show-common-initialize xref-alist fetcher alist)
(pop-to-buffer (current-buffer))
- (current-buffer))))
+ (setq buf (current-buffer)))
+ (xref--auto-jump-first buf (assoc-default 'auto-jump alist))
+ buf))
(defun xref--project-root (project)
(if (fboundp 'project-root)
@@ -1020,6 +1069,7 @@ Return an alist of the form ((FILENAME . (XREF ...))
...)."
(let ((inhibit-read-only t)
(buffer-undo-list t))
(erase-buffer)
+ (setq overlay-arrow-position nil)
(xref--insert-xrefs xref-alist)
(add-hook 'post-command-hook 'xref--apply-truncation nil t)
(goto-char (point-min))
@@ -1044,19 +1094,36 @@ Return an alist of the form ((FILENAME . (XREF ...))
...)."
(error-message-string err)
'face 'error)))))))
+(defun xref--auto-jump-first (buf value)
+ (when value
+ (select-window (get-buffer-window buf))
+ (goto-char (point-min)))
+ (cond
+ ((eq value t)
+ (xref-next-line-no-show)
+ (xref-goto-xref))
+ ((eq value 'show)
+ (xref-next-line))
+ ((eq value 'move)
+ (forward-line 1))))
+
(defun xref-show-definitions-buffer (fetcher alist)
"Show the definitions list in a regular window.
When only one definition found, jump to it right away instead."
- (let ((xrefs (funcall fetcher)))
+ (let ((xrefs (funcall fetcher))
+ buf)
(cond
((not (cdr xrefs))
(xref-pop-to-location (car xrefs)
(assoc-default 'display-action alist)))
(t
- (xref--show-xref-buffer fetcher
- (cons (cons 'fetched-xrefs xrefs)
- alist))))))
+ (setq buf
+ (xref--show-xref-buffer fetcher
+ (cons (cons 'fetched-xrefs xrefs)
+ alist)))
+ (xref--auto-jump-first buf (assoc-default 'auto-jump alist))
+ buf))))
(define-obsolete-function-alias
'xref--show-defs-buffer #'xref-show-definitions-buffer "28.1")
@@ -1072,7 +1139,8 @@ local keymap that binds `RET' to
`xref-quit-and-goto-xref'."
;; XXX: Make percentage customizable maybe?
(max-height (/ (window-height) 2))
(size-fun (lambda (window)
- (fit-window-to-buffer window max-height))))
+ (fit-window-to-buffer window max-height)))
+ buf)
(cond
((not (cdr xrefs))
(xref-pop-to-location (car xrefs)
@@ -1085,7 +1153,9 @@ local keymap that binds `RET' to
`xref-quit-and-goto-xref'."
(pop-to-buffer (current-buffer)
`(display-buffer-in-direction . ((direction . below)
(window-height .
,size-fun))))
- (current-buffer))))))
+ (setq buf (current-buffer)))
+ (xref--auto-jump-first buf (assoc-default 'auto-jump alist))
+ buf))))
(define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom
#'xref-show-definitions-buffer-at-bottom "28.1")
@@ -1214,13 +1284,15 @@ definitions."
(setq xrefs 'called-already)))))))
(funcall xref-show-xrefs-function fetcher
`((window . ,(selected-window))
- (display-action . ,display-action))))
+ (display-action . ,display-action)
+ (auto-jump . ,xref-auto-jump-to-first-xref))))
(defun xref--show-defs (xrefs display-action)
(xref--push-markers)
(funcall xref-show-definitions-function xrefs
`((window . ,(selected-window))
- (display-action . ,display-action))))
+ (display-action . ,display-action)
+ (auto-jump . ,xref-auto-jump-to-first-definition))))
(defun xref--push-markers ()
(unless (region-active-p) (push-mark nil t))
@@ -1307,7 +1379,9 @@ prompt for it.
If sufficient information is available to determine a unique
definition for IDENTIFIER, display it in the selected window.
Otherwise, display the list of the possible definitions in a
-buffer where the user can select from the list."
+buffer where the user can select from the list.
+
+Use \\[xref-pop-marker-stack] to return back to where you invoked this
command."
(interactive (list (xref--read-identifier "Find definitions of: ")))
(xref--find-definitions identifier nil))
@@ -1347,6 +1421,20 @@ This command is intended to be bound to a mouse event."
(xref-find-definitions identifier)
(user-error "No identifier here"))))
+;;;###autoload
+(defun xref-find-references-at-mouse (event)
+ "Find references to the identifier at or around mouse click.
+This command is intended to be bound to a mouse event."
+ (interactive "e")
+ (let ((identifier
+ (save-excursion
+ (mouse-set-point event)
+ (xref-backend-identifier-at-point (xref-find-backend)))))
+ (if identifier
+ (let ((xref-prompt-for-identifier nil))
+ (xref-find-references identifier))
+ (user-error "No identifier here"))))
+
(declare-function apropos-parse-pattern "apropos" (pattern))
;;;###autoload
@@ -1355,7 +1443,9 @@ This command is intended to be bound to a mouse event."
The argument has the same meaning as in `apropos'."
(interactive (list (read-string
"Search for pattern (word list or regexp): "
- nil 'xref--read-pattern-history)))
+ nil 'xref--read-pattern-history
+ (xref-backend-identifier-at-point
+ (xref-find-backend)))))
(require 'apropos)
(let* ((newpat
(if (and (version< emacs-version "28.0.50")
@@ -1466,18 +1556,18 @@ IGNORES is a list of glob patterns for files to ignore."
;; do that reliably enough, without creating false negatives?
(command (xref--rgrep-command (xref--regexp-to-extended regexp)
files
- (directory-file-name
- (file-name-unquote
- (file-local-name (expand-file-name
dir))))
+ "."
ignores))
- (def default-directory)
+ (local-dir (directory-file-name
+ (file-name-unquote
+ (file-local-name (expand-file-name dir)))))
(buf (get-buffer-create " *xref-grep*"))
(`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))
(status nil)
(hits nil))
(with-current-buffer buf
(erase-buffer)
- (setq default-directory def)
+ (setq default-directory dir)
(setq status
(process-file-shell-command command nil t))
(goto-char (point-min))
@@ -1490,7 +1580,7 @@ IGNORES is a list of glob patterns for files to ignore."
(user-error "Search failed with status %d: %s" status (buffer-string)))
(while (re-search-forward grep-re nil t)
(push (list (string-to-number (match-string line-group))
- (match-string file-group)
+ (concat local-dir (substring (match-string file-group) 1))
(buffer-substring-no-properties (point)
(line-end-position)))
hits)))
(xref--convert-hits (nreverse hits) regexp)))
@@ -1543,7 +1633,7 @@ The template should have the following fields:
"The program to use for regexp search inside files.
This must reference a corresponding entry in `xref-search-program-alist'."
- :type `(choice
+ :type '(choice
(const :tag "Use Grep" grep)
(const :tag "Use ripgrep" ripgrep)
(symbol :tag "User defined"))
@@ -1659,6 +1749,11 @@ directory, used as the root of the ignore globs."
(cl-assert (not (string-match-p "\\`~" dir)))
(if (not ignores)
""
+ ;; TODO: All in-tree callers are passing in just "." or "./".
+ ;; We can simplify.
+ ;; And, if we ever end up deleting xref-matches-in-directory, move
+ ;; this function to the project package.
+ (setq dir (file-name-as-directory dir))
(concat
(shell-quote-argument "(")
" -path "
@@ -1726,12 +1821,14 @@ Such as the current syntax table and the applied syntax
properties."
(if buf
(with-current-buffer buf
(save-excursion
- (goto-char (point-min))
- (forward-line (1- line))
- (xref--collect-matches-1 regexp file line
- (line-beginning-position)
- (line-end-position)
- syntax-needed)))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (xref--collect-matches-1 regexp file line
+ (line-beginning-position)
+ (line-end-position)
+ syntax-needed))))
;; Using the temporary buffer is both a performance and a buffer
;; management optimization.
(with-current-buffer tmp-buffer
diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index 613863d..7076331 100644
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -936,7 +936,7 @@ the remaining input.")
(setq call-noexcursion nil)
(with-current-buffer (process-buffer proc)
(cond ((eq xscheme-process-filter-state 'idle)
- (let ((start (string-match "\e" xscheme-filter-input)))
+ (let ((start (string-search "\e" xscheme-filter-input)))
(if start
(progn
(xscheme-process-filter-output
@@ -960,7 +960,7 @@ the remaining input.")
(xscheme-process-filter-output ?\e char)
(setq xscheme-process-filter-state 'idle)))))))
((eq xscheme-process-filter-state 'reading-string)
- (let ((start (string-match "\e" xscheme-filter-input)))
+ (let ((start (string-search "\e" xscheme-filter-input)))
(if start
(let ((string
(concat xscheme-string-accumulator
diff --git a/lisp/repeat.el b/lisp/repeat.el
index cec3cb6..6c3ffec 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -474,8 +474,9 @@ When Repeat mode is enabled, and the command symbol has the
property named
(if (current-message)
(message "%s [%s]" (current-message) mess)
(message mess)))
- (when (string-prefix-p "Repeat with " (current-message))
- (message nil))))
+ (and (current-message)
+ (string-search "Repeat with " (current-message))
+ (message nil))))
(defvar repeat-echo-mode-line-string
(propertize "[Repeating...] " 'face 'mode-line-emphasis)
diff --git a/lisp/replace.el b/lisp/replace.el
index 7e30f1f..69bdfe1 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -213,7 +213,7 @@ wants to replace FROM with TO."
(when query-replace-from-to-separator
;; Check if the first non-whitespace char is displayable
(if (char-displayable-p
- (string-to-char (replace-regexp-in-string
+ (string-to-char (string-replace
" " "" query-replace-from-to-separator)))
query-replace-from-to-separator
" -> ")))
@@ -310,7 +310,7 @@ the original string if not."
;; but not after (quote foo).
(and (eq (car-safe (car pos)) 'quote)
(not (= ?\( (aref to 0)))))
- (eq (string-match " " to (cdr pos))
+ (eq (string-search " " to (cdr pos))
(cdr pos)))
(1+ (cdr pos))
(cdr pos))))
@@ -633,13 +633,13 @@ Arguments REGEXP, START, END, and REGION-NONCONTIGUOUS-P
are passed to
(if (listp to-strings)
(setq replacements to-strings)
(while (/= (length to-strings) 0)
- (if (string-match " " to-strings)
+ (if (string-search " " to-strings)
(setq replacements
(append replacements
(list (substring to-strings 0
- (string-match " " to-strings))))
+ (string-search " " to-strings))))
to-strings (substring to-strings
- (1+ (string-match " " to-strings))))
+ (1+ (string-search " " to-strings))))
(setq replacements (append replacements (list to-strings))
to-strings ""))))
(perform-replace regexp replacements t t nil n nil start end nil
region-noncontiguous-p)))
@@ -792,12 +792,8 @@ which will run faster and will not set the mark or print
anything."
Maximum length of the history list is determined by the value
of `history-length', which see.")
-(defvar occur-highlight-regexp t
- "Regexp matching part of visited source lines to highlight temporarily.
-Highlight entire line if t; don't highlight source lines if nil.")
-
-(defvar occur-highlight-overlay nil
- "Overlay used to temporarily highlight occur matches.")
+(defvar occur-highlight-overlays nil
+ "Overlays used to temporarily highlight occur matches.")
(defvar occur-collect-regexp-history '("\\1")
"History of regexp for occur's collect operation")
@@ -1357,18 +1353,27 @@ To return to ordinary Occur mode, use
\\[occur-cease-edit]."
(occur-mode)
(message "Switching to Occur mode.")))
+(defun occur--targets-start (targets)
+ "First marker of the `occur-target' property value TARGETS."
+ (if (consp targets)
+ (caar targets)
+ ;; Tolerate an `occur-target' value that is a single marker for
+ ;; compatibility.
+ targets))
+
(defun occur-after-change-function (beg end length)
(save-excursion
(goto-char beg)
(let* ((line-beg (line-beginning-position))
- (m (get-text-property line-beg 'occur-target))
+ (targets (get-text-property line-beg 'occur-target))
+ (m (occur--targets-start targets))
(buf (marker-buffer m))
col)
(when (and (get-text-property line-beg 'occur-prefix)
(not (get-text-property end 'occur-prefix)))
(when (= length 0)
;; Apply occur-target property to inserted (e.g. yanked) text.
- (put-text-property beg end 'occur-target m)
+ (put-text-property beg end 'occur-target targets)
;; Did we insert a newline? Occur Edit mode can't create new
;; Occur entries; just discard everything after the newline.
(save-excursion
@@ -1393,8 +1398,27 @@ To return to ordinary Occur mode, use
\\[occur-cease-edit]."
(recenter line)
(if readonly
(message "Buffer `%s' is read only." buf)
- (delete-region (line-beginning-position) (line-end-position))
- (insert text))
+ ;; Replace the line, but make the change as small as
+ ;; possible by shrink-wrapping. That way, we avoid
+ ;; disturbing markers unnecessarily.
+ (let* ((beg-pos (line-beginning-position))
+ (end-pos (line-end-position))
+ (buf-str (buffer-substring-no-properties beg-pos end-pos))
+ (common-prefix
+ (lambda (s1 s2)
+ (let ((c (compare-strings s1 nil nil s2 nil nil)))
+ (if (numberp c)
+ (1- (abs c))
+ (length s1)))))
+ (prefix-len (funcall common-prefix buf-str text))
+ (suffix-len (funcall common-prefix
+ (reverse buf-str) (reverse text))))
+ (setq beg-pos (+ beg-pos prefix-len))
+ (setq end-pos (- end-pos suffix-len))
+ (setq text (substring text prefix-len (- suffix-len)))
+ (delete-region beg-pos end-pos)
+ (goto-char beg-pos)
+ (insert text)))
(move-to-column col)))))))
@@ -1402,35 +1426,56 @@ To return to ordinary Occur mode, use
\\[occur-cease-edit]."
"Handle `revert-buffer' for Occur mode buffers."
(apply #'occur-1 (append occur-revert-arguments (list (buffer-name)))))
+;; Retained for compatibility.
(defun occur-mode-find-occurrence ()
- (let ((pos (get-text-property (point) 'occur-target)))
- (unless pos
+ "Return a marker to the first match of the line at point."
+ (occur--targets-start (occur-mode--find-occurrences)))
+
+(defun occur-mode--find-occurrences ()
+ ;; The `occur-target' property value is a list of (BEG . END) for each
+ ;; match on the line, or (for compatibility) a single marker to the start
+ ;; of the first match.
+ (let* ((targets (get-text-property (point) 'occur-target))
+ (start (occur--targets-start targets)))
+ (unless targets
(error "No occurrence on this line"))
- (unless (buffer-live-p (marker-buffer pos))
+ (unless (buffer-live-p (marker-buffer start))
(error "Buffer for this occurrence was killed"))
- pos))
+ targets))
+
+(defun occur--set-arrow ()
+ "Set the overlay arrow at the first line of the occur match at point."
+ (save-excursion
+ (let ((target (get-text-property (point) 'occur-target))
+ ;; Find the start of the occur match, in case it's multi-line.
+ (prev (previous-single-property-change (point) 'occur-target)))
+ (when (and prev (eq (get-text-property prev 'occur-target) target))
+ (goto-char prev))
+ (setq overlay-arrow-position
+ (set-marker (or overlay-arrow-position (make-marker))
+ (line-beginning-position))))))
(defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence)
(defun occur-mode-goto-occurrence (&optional event)
"Go to the occurrence specified by EVENT, a mouse click.
If not invoked by a mouse click, go to occurrence on the current line."
(interactive (list last-nonmenu-event))
- (let ((buffer (when event (current-buffer)))
- (pos
- (if (null event)
- ;; Actually `event-end' works correctly with a nil argument as
- ;; well, so we could dispense with this test, but let's not
- ;; rely on this undocumented behavior.
- (occur-mode-find-occurrence)
- (with-current-buffer (window-buffer (posn-window (event-end event)))
- (save-excursion
- (goto-char (posn-point (event-end event)))
- (occur-mode-find-occurrence)))))
- (regexp occur-highlight-regexp))
+ (let* ((buffer (when event (current-buffer)))
+ (targets
+ (if (null event)
+ ;; Actually `event-end' works correctly with a nil argument as
+ ;; well, so we could dispense with this test, but let's not
+ ;; rely on this undocumented behavior.
+ (occur-mode--find-occurrences)
+ (with-current-buffer (window-buffer (posn-window (event-end
event)))
+ (save-excursion
+ (goto-char (posn-point (event-end event)))
+ (occur-mode--find-occurrences)))))
+ (pos (occur--targets-start targets)))
+ (occur--set-arrow)
(pop-to-buffer (marker-buffer pos))
(goto-char pos)
- (let ((end-mk (save-excursion (re-search-forward regexp nil t))))
- (occur--highlight-occurrence pos end-mk))
+ (occur--highlight-occurrences targets)
(when buffer (next-error-found buffer (current-buffer)))
(run-hooks 'occur-mode-find-occurrence-hook)))
@@ -1438,15 +1483,16 @@ If not invoked by a mouse click, go to occurrence on
the current line."
"Go to the occurrence the current line describes, in another window."
(interactive)
(let ((buffer (current-buffer))
- (pos (occur-mode-find-occurrence)))
+ (pos (occur--targets-start (occur-mode--find-occurrences))))
+ (occur--set-arrow)
(switch-to-buffer-other-window (marker-buffer pos))
(goto-char pos)
(next-error-found buffer (current-buffer))
(run-hooks 'occur-mode-find-occurrence-hook)))
-;; Stolen from compile.el
(defun occur-goto-locus-delete-o ()
- (delete-overlay occur-highlight-overlay)
+ (mapc #'delete-overlay occur-highlight-overlays)
+ (setq occur-highlight-overlays nil)
;; Get rid of timer and hook that would try to do this again.
(if (timerp next-error-highlight-timer)
(cancel-timer next-error-highlight-timer))
@@ -1454,64 +1500,56 @@ If not invoked by a mouse click, go to occurrence on
the current line."
#'occur-goto-locus-delete-o))
;; Highlight the current visited occurrence.
-;; Adapted from `compilation-goto-locus'.
-(defun occur--highlight-occurrence (mk end-mk)
- (let ((highlight-regexp occur-highlight-regexp))
- (if (timerp next-error-highlight-timer)
- (cancel-timer next-error-highlight-timer))
- (unless occur-highlight-overlay
- (setq occur-highlight-overlay
- (make-overlay (point-min) (point-min)))
- (overlay-put occur-highlight-overlay 'face 'next-error))
- (with-current-buffer (marker-buffer mk)
- (save-excursion
- (if end-mk (goto-char end-mk) (end-of-line))
- (let ((end (point)))
- (if mk (goto-char mk) (beginning-of-line))
- (if (and (stringp highlight-regexp)
- (re-search-forward highlight-regexp end t))
- (progn
- (goto-char (match-beginning 0))
- (move-overlay occur-highlight-overlay
- (match-beginning 0) (match-end 0)
- (current-buffer)))
- (move-overlay occur-highlight-overlay
- (point) end (current-buffer)))
- (if (or (eq next-error-highlight t)
- (numberp next-error-highlight))
- ;; We want highlighting: delete overlay on next input.
- (add-hook 'pre-command-hook
- #'occur-goto-locus-delete-o)
- ;; We don't want highlighting: delete overlay now.
- (delete-overlay occur-highlight-overlay))
- ;; We want highlighting for a limited time:
- ;; set up a timer to delete it.
- (when (numberp next-error-highlight)
- (setq next-error-highlight-timer
- (run-at-time next-error-highlight nil
- 'occur-goto-locus-delete-o))))))
- (when (eq next-error-highlight 'fringe-arrow)
- ;; We want a fringe arrow (instead of highlighting).
- (setq next-error-overlay-arrow-position
- (copy-marker (line-beginning-position))))))
+(defun occur--highlight-occurrences (targets)
+ (let ((start-marker (occur--targets-start targets)))
+ (occur-goto-locus-delete-o)
+ (with-current-buffer (marker-buffer start-marker)
+ (when (or (eq next-error-highlight t)
+ (numberp next-error-highlight))
+ (setq occur-highlight-overlays
+ (mapcar (lambda (target)
+ (let ((o (make-overlay (car target) (cdr target))))
+ (overlay-put o 'face 'next-error)
+ o))
+ (if (listp targets)
+ targets
+ ;; `occur-target' compatibility: when we only
+ ;; have a single starting point, highlight the
+ ;; rest of the line.
+ (let ((end-pos (save-excursion
+ (goto-char start-marker)
+ (line-end-position))))
+ (list (cons start-marker end-pos))))))
+ (add-hook 'pre-command-hook #'occur-goto-locus-delete-o)
+ (when (numberp next-error-highlight)
+ ;; We want highlighting for a limited time:
+ ;; set up a timer to delete it.
+ (setq next-error-highlight-timer
+ (run-at-time next-error-highlight nil
+ 'occur-goto-locus-delete-o))))
+
+ (when (eq next-error-highlight 'fringe-arrow)
+ ;; We want a fringe arrow (instead of highlighting).
+ (setq next-error-overlay-arrow-position
+ (copy-marker (line-beginning-position)))))))
(defun occur-mode-display-occurrence ()
"Display in another window the occurrence the current line describes."
(interactive)
- (let ((buffer (current-buffer))
- (pos (occur-mode-find-occurrence))
- (regexp occur-highlight-regexp)
- (next-error-highlight next-error-highlight-no-select)
- (display-buffer-overriding-action
- '(nil (inhibit-same-window . t)))
- window)
+ (let* ((buffer (current-buffer))
+ (targets (occur-mode--find-occurrences))
+ (pos (occur--targets-start targets))
+ (next-error-highlight next-error-highlight-no-select)
+ (display-buffer-overriding-action
+ '(nil (inhibit-same-window . t)))
+ window)
(setq window (display-buffer (marker-buffer pos) t))
+ (occur--set-arrow)
;; This is the way to set point in the proper window.
(save-selected-window
(select-window window)
(goto-char pos)
- (let ((end-mk (save-excursion (re-search-forward regexp nil t))))
- (occur--highlight-occurrence pos end-mk))
+ (occur--highlight-occurrences targets)
(next-error-found buffer (current-buffer))
(run-hooks 'occur-mode-find-occurrence-hook))))
@@ -1860,6 +1898,7 @@ See also `multi-occur'."
;; Make the default-directory of the *Occur* buffer match that of
;; the buffer where the occurrences come from
(setq default-directory source-buffer-default-directory)
+ (setq overlay-arrow-position nil)
(if (stringp nlines)
(fundamental-mode) ;; This is for collect operation.
(occur-mode))
@@ -1868,7 +1907,6 @@ See also `multi-occur'."
(buffer-undo-list t)
(occur--final-pos nil))
(erase-buffer)
- (setq-local occur-highlight-regexp regexp)
(let ((count
(if (stringp nlines)
;; Treat nlines as a regexp to collect.
@@ -1968,7 +2006,7 @@ See also `multi-occur'."
(origpt nil)
(begpt nil)
(endpt nil)
- (marker nil)
+ markers ; list of (BEG-MARKER . END-MARKER)
(curstring "")
(ret nil)
;; The following binding is for when case-fold-search
@@ -1994,8 +2032,7 @@ See also `multi-occur'."
(setq endpt (line-end-position)))
;; Sum line numbers up to the first match line.
(setq curr-line (+ curr-line (count-lines origpt begpt)))
- (setq marker (make-marker))
- (set-marker marker matchbeg)
+ (setq markers nil)
(setq curstring (occur-engine-line begpt endpt
keep-props))
;; Highlight the matches
(let ((len (length curstring))
@@ -2017,6 +2054,11 @@ See also `multi-occur'."
(setq orig-line-shown-p t)))
(while (and (< start len)
(string-match regexp curstring start))
+ (push (cons (set-marker (make-marker)
+ (+ begpt (match-beginning
0)))
+ (set-marker (make-marker)
+ (+ begpt (match-end 0))))
+ markers)
(setq matches (1+ matches))
(add-text-properties
(match-beginning 0) (match-end 0)
@@ -2029,6 +2071,7 @@ See also `multi-occur'."
;; Avoid infloop (Bug#7593).
(let ((end (match-end 0)))
(setq start (if (= start end) (1+ start) end)))))
+ (setq markers (nreverse markers))
;; Generate the string to insert for this match
(let* ((match-prefix
;; Using 7 digits aligns tabs properly.
@@ -2042,7 +2085,7 @@ See also `multi-occur'."
;; (for Occur Edit mode).
front-sticky t
rear-nonsticky t
- occur-target ,marker
+ occur-target ,markers
follow-link t
help-echo "mouse-2: go to
this occurrence"))))
(match-str
@@ -2050,7 +2093,7 @@ See also `multi-occur'."
;; because that loses. And don't put it
;; on context lines to reduce flicker.
(propertize curstring
- 'occur-target marker
+ 'occur-target markers
'follow-link t
'help-echo
"mouse-2: go to this occurrence"))
@@ -2058,19 +2101,21 @@ See also `multi-occur'."
;; Add non-numeric prefix to all non-first lines
;; of multi-line matches.
(concat
- (replace-regexp-in-string
+ (string-replace
"\n"
(if prefix-face
(propertize
- "\n :" 'font-lock-face prefix-face)
- "\n :")
+ "\n :" 'font-lock-face prefix-face
+ 'occur-target markers)
+ (propertize
+ "\n :" 'occur-target markers))
;; Add mouse face in one section to
;; ensure the prefix and the string
;; get a contiguous highlight.
(propertize (concat match-prefix match-str)
'mouse-face 'highlight))
- ;; Add marker at eol, but no mouse props.
- (propertize "\n" 'occur-target marker)))
+ ;; Add markers at eol, but no mouse props.
+ (propertize "\n" 'occur-target markers)))
(data
(if (= nlines 0)
;; The simple display style
@@ -2461,12 +2506,10 @@ a string, it is first passed through `prin1-to-string'
with the `noescape' argument set.
`match-data' is preserved across the call."
- (save-match-data
- (replace-regexp-in-string "\\\\" "\\\\"
- (if (stringp replacement)
- replacement
- (prin1-to-string replacement t))
- t t)))
+ (string-replace "\\" "\\\\"
+ (if (stringp replacement)
+ replacement
+ (prin1-to-string replacement t))))
(defun replace-loop-through-replacements (data count)
;; DATA is a vector containing the following values:
@@ -2722,9 +2765,7 @@ characters."
;; If non-nil, it is marker saying where in the buffer to stop.
(limit nil)
- ;; Use local binding in add-function below.
- (isearch-filter-predicate isearch-filter-predicate)
- (region-bounds nil)
+ (region-filter nil)
;; Data for the next match. If a cons, it has the same format as
;; (match-data); otherwise it is t if a match is possible at point.
@@ -2748,21 +2789,22 @@ characters."
;; Unless a single contiguous chunk is selected, operate on multiple
chunks.
(when region-noncontiguous-p
- (setq region-bounds
- (mapcar (lambda (position)
- (cons (copy-marker (car position))
- (copy-marker (cdr position))))
- (funcall region-extract-function 'bounds)))
- (add-function :after-while isearch-filter-predicate
- (lambda (start end)
- (delq nil (mapcar
- (lambda (bounds)
- (and
- (>= start (car bounds))
- (<= start (cdr bounds))
- (>= end (car bounds))
- (<= end (cdr bounds))))
- region-bounds)))))
+ (let ((region-bounds
+ (mapcar (lambda (position)
+ (cons (copy-marker (car position))
+ (copy-marker (cdr position))))
+ (funcall region-extract-function 'bounds))))
+ (setq region-filter
+ (lambda (start end)
+ (delq nil (mapcar
+ (lambda (bounds)
+ (and
+ (>= start (car bounds))
+ (<= start (cdr bounds))
+ (>= end (car bounds))
+ (<= end (cdr bounds))))
+ region-bounds))))
+ (add-function :after-while isearch-filter-predicate region-filter)))
;; If region is active, in Transient Mark mode, operate on region.
(if backward
@@ -3195,7 +3237,9 @@ characters."
(setq next-replacement-replaced nil
search-string-replaced nil
last-was-act-and-show nil))))))
- (replace-dehighlight))
+ (replace-dehighlight)
+ (when region-filter
+ (remove-function isearch-filter-predicate region-filter)))
(or unread-command-events
(message (ngettext "Replaced %d occurrence%s"
"Replaced %d occurrences%s"
diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index 2a95b39..8225588 100644
--- a/lisp/saveplace.el
+++ b/lisp/saveplace.el
@@ -88,7 +88,9 @@ this happens automatically before saving `save-place-alist' to
:type 'boolean)
(defcustom save-place-abbreviate-file-names nil
- "If non-nil, abbreviate file names before saving them."
+ "If non-nil, abbreviate file names before saving them.
+This can simplify sharing the `save-place-file' file across
+different hosts."
:type 'boolean
:version "28.1")
diff --git a/lisp/select.el b/lisp/select.el
index eaa74ce..15e171c 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -496,7 +496,7 @@ two markers or an overlay. Otherwise, it is nil."
(error "Unknown selection type: %S" type)))))
;; Most programs are unable to handle NUL bytes in strings.
- (setq str (replace-regexp-in-string "\0" "\\0" str t t))
+ (setq str (string-replace "\0" "\\0" str))
(setq next-selection-coding-system nil)
(cons type str))))
diff --git a/lisp/ses.el b/lisp/ses.el
index ca515f8..cc8c35d 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -1677,7 +1677,7 @@ if the range was altered."
(funcall field (ses-sym-rowcol min))))
;; This range has changed size.
(setq ses-relocate-return 'range))
- `(ses-range ,min ,max ,@(cl-cdddr range)))))
+ `(ses-range ,min ,max ,@(cdddr range)))))
(defun ses-relocate-all (minrow mincol rowincr colincr)
"Alter all cell values, symbols, formulas, and reference-lists to relocate
@@ -3357,7 +3357,7 @@ is non-nil. Newlines and tabs in the export text are
escaped."
(push "'" result)
(setq item (cadr item)))
(setq item (ses-prin1 item))
- (setq item (replace-regexp-in-string "\t" "\\\\t" item))
+ (setq item (string-replace "\t" "\\t" item))
(push item result)
(cond
((< col maxcol)
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index f67b0b9..63e9bd6 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -213,6 +213,14 @@ information defining the cluster. For interactive use,
call
;;; SITES
+;; This simplifies it a little bit. "system-name" is also accepted.
+;; But we don't want to make the help echo too long.
+(defconst shadow-site-help "\
+A cluster identification \"/name:\", a remote identification
+\"/method:user@host:\", or \"/system-name:\" (the value of
+`shadow-system-name')"
+ "The help string describing a valid site.")
+
(defun shadow-site-name (site)
"Return name if SITE has the form \"/name:\", otherwise SITE."
(if (string-match "\\`/\\([-.[:word:]]+\\):\\'" site)
@@ -239,9 +247,10 @@ information defining the cluster. For interactive use,
call
shadow-clusters)))
(defun shadow-read-site ()
- "Read a cluster name or host identification from the minibuffer."
- (let ((ans (completing-read "Host identification or cluster name: "
- shadow-clusters)))
+ "Read a site name from the minibuffer."
+ (let ((ans (completing-read
+ (propertize "Site name: " 'help-echo shadow-site-help)
+ shadow-clusters)))
(when (or (shadow-get-cluster (shadow-site-name ans))
(string-equal ans shadow-system-name)
(string-equal ans (shadow-site-name shadow-system-name))
@@ -285,7 +294,7 @@ Argument can be a simple name, remote file name, or already
a
(defsubst shadow-make-fullname (hup &optional host name)
"Make a Tramp style fullname out of HUP, a `tramp-file-name' structure.
Replace HOST, and NAME when non-nil. HOST can also be a remote file name."
- (let ((hup (copy-tramp-file-name hup)))
+ (when-let ((hup (copy-tramp-file-name hup)))
(when host
(if (file-remote-p host)
(setq name (or name (and hup (tramp-file-name-localname hup)))
@@ -355,23 +364,23 @@ Will return the name bare if it is a local file."
Do so by replacing (when possible) home directory with ~/, and
hostname with cluster name that includes it. Filename should be
absolute and true."
- (let* ((hup (shadow-parse-name file))
- (homedir (if (shadow-local-file hup)
- shadow-homedir
- (file-name-as-directory
- (file-local-name
- (expand-file-name
- (shadow-make-fullname hup nil shadow-homedir))))))
- (suffix (shadow-suffix homedir (tramp-file-name-localname hup)))
- (cluster (shadow-site-cluster (shadow-make-fullname hup nil ""))))
- (when cluster
- (setf (tramp-file-name-method hup) nil
- (tramp-file-name-host hup) (shadow-cluster-name cluster)))
- (shadow-make-fullname
- hup nil
- (if suffix
- (concat shadow-homedir suffix)
- (tramp-file-name-localname hup)))))
+ (when-let ((hup (shadow-parse-name file)))
+ (let* ((homedir (if (shadow-local-file hup)
+ shadow-homedir
+ (file-name-as-directory
+ (file-local-name
+ (expand-file-name
+ (shadow-make-fullname hup nil shadow-homedir))))))
+ (suffix (shadow-suffix homedir (tramp-file-name-localname hup)))
+ (cluster (shadow-site-cluster (shadow-make-fullname hup nil ""))))
+ (when cluster
+ (setf (tramp-file-name-method hup) nil
+ (tramp-file-name-host hup) (shadow-cluster-name cluster)))
+ (shadow-make-fullname
+ hup nil
+ (if suffix
+ (concat shadow-homedir suffix)
+ (tramp-file-name-localname hup))))))
(defun shadow-same-site (pattern file)
"True if the site of PATTERN and of FILE are on the same site.
@@ -455,16 +464,17 @@ It may have different filenames on each site. When this
file is edited, the
new version will be copied to each of the other locations. Sites can be
specific hostnames, or names of clusters (see `shadow-define-cluster')."
(interactive)
- (let* ((hup (shadow-parse-name
- (shadow-contract-file-name (buffer-file-name))))
- (name (tramp-file-name-localname hup))
- site group)
- (while (setq site (shadow-read-site))
- (setq name (read-string "Filename: " name)
- hup (shadow-parse-name (shadow-contract-file-name name))
- group (cons (shadow-make-fullname hup site) group)))
- (setq shadow-literal-groups (cons group shadow-literal-groups)))
- (shadow-write-info-file))
+ (when-let ((hup (shadow-parse-name
+ (shadow-contract-file-name (buffer-file-name)))))
+ (let* ((name (tramp-file-name-localname hup))
+ site group)
+ (while (setq site (shadow-read-site))
+ (setq name (read-string "Filename: " name)
+ hup (shadow-parse-name (shadow-contract-file-name name))
+ group (cons (shadow-make-fullname hup site) group)))
+ (when group
+ (setq shadow-literal-groups (cons group shadow-literal-groups))))
+ (shadow-write-info-file)))
;;;###autoload
(defun shadow-define-regexp-group ()
diff --git a/lisp/shell.el b/lisp/shell.el
index 5aab80d..5cdc038 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -1199,7 +1199,7 @@ Returns t if successful."
(if data
(prog2 (unless (window-minibuffer-p)
(message "Completing command name..."))
- (apply #'completion-in-region data)))))
+ (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data))))))
(defun shell-command-completion ()
"Return the completion data for the command at point, if any."
@@ -1252,7 +1252,7 @@ Returns t if successful."
(list
start end
(lambda (string pred action)
- (if (string-match "/" string)
+ (if (string-search "/" string)
(completion-file-name-table string pred action)
(complete-with-action action completions string pred)))
:exit-function
@@ -1314,7 +1314,7 @@ Returns non-nil if successful."
(if data
(prog2 (unless (window-minibuffer-p)
(message "Completing variable name..."))
- (apply #'completion-in-region data)))))
+ (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data))))))
(defun shell-environment-variable-completion ()
@@ -1328,7 +1328,7 @@ Returns non-nil if successful."
(looking-at "\\$?[({]*")
(match-end 0)))
(variables (mapcar (lambda (x)
- (substring x 0 (string-match "=" x)))
+ (substring x 0 (string-search "=" x)))
process-environment))
(suffix (pcase (char-before start) (?\{ "}") (?\( ")") (_ ""))))
(list start end variables
diff --git a/lisp/simple.el b/lisp/simple.el
index 1a49fe2..800a927 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2070,7 +2070,7 @@ This function uses the `read-extended-command-predicate'
user option."
"Say whether SYMBOL has been marked as a mode-specific command in BUFFER."
;; Check the modes.
(let ((modes (command-modes symbol)))
- ;; Common case: Just a single mode.
+ ;; Common fast case: Just a single mode.
(if (null (cdr modes))
(or (provided-mode-derived-p
(buffer-local-value 'major-mode buffer) (car modes))
@@ -2078,13 +2078,7 @@ This function uses the `read-extended-command-predicate'
user option."
(buffer-local-value 'local-minor-modes buffer))
(memq (car modes) global-minor-modes))
;; Uncommon case: Multiple modes.
- (apply #'provided-mode-derived-p
- (buffer-local-value 'major-mode buffer)
- modes)
- (seq-intersection modes
- (buffer-local-value 'local-minor-modes buffer)
- #'eq)
- (seq-intersection modes global-minor-modes #'eq))))
+ (command-completion-with-modes-p modes buffer))))
(defun command-completion-default-include-p (symbol buffer)
"Say whether SYMBOL should be offered as a completion.
@@ -2194,6 +2188,8 @@ Also see `suggest-key-bindings'."
(setq binding candidate))))
binding))
+(defvar execute-extended-command--binding-timer nil)
+
(defun execute-extended-command (prefixarg &optional command-name typed)
;; Based on Fexecute_extended_command in keyboard.c of Emacs.
;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
@@ -2217,7 +2213,9 @@ invoking, give a prefix argument to
`execute-extended-command'."
(let* ((function (and (stringp command-name) (intern-soft command-name)))
(binding (and suggest-key-bindings
(not executing-kbd-macro)
- (where-is-internal function overriding-local-map t))))
+ (where-is-internal function overriding-local-map t)))
+ (delay-before-suggest 0)
+ (find-shorter nil))
(unless (commandp function)
(error "`%s' is not a valid command name" command-name))
;; Some features, such as novice.el, rely on this-command-keys
@@ -2232,41 +2230,52 @@ invoking, give a prefix argument to
`execute-extended-command'."
(setq real-this-command function)
(let ((prefix-arg prefixarg))
(command-execute function 'record))
- ;; If enabled, show which key runs this command.
- ;; But first wait, and skip the message if there is input.
- (let* ((waited
- ;; If this command displayed something in the echo area;
- ;; wait a few seconds, then display our suggestion message.
- ;; FIXME: Wait *after* running post-command-hook!
- ;; FIXME: If execute-extended-command--shorter were
- ;; faster, we could compute the result here first too.
- (when (and suggest-key-bindings
- (or binding
- (and extended-command-suggest-shorter typed)))
- (sit-for (cond
- ((zerop (length (current-message))) 0)
- ((numberp suggest-key-bindings) suggest-key-bindings)
- (t 2))))))
- (when (and waited (not (consp unread-command-events)))
- (unless (or (not extended-command-suggest-shorter)
- binding executing-kbd-macro (not (symbolp function))
- (<= (length (symbol-name function)) 2))
- ;; There's no binding for CMD. Let's try and find the shortest
- ;; string to use in M-x.
- ;; FIXME: Can be slow. Cache it maybe?
- (while-no-input
- (setq binding (execute-extended-command--shorter
- (symbol-name function) typed))))
- (when binding
- (with-temp-message
- (format-message "You can run the command `%s' with %s"
- function
- (if (stringp binding)
- (concat "M-x " binding " RET")
- (key-description binding)))
- (sit-for (if (numberp suggest-key-bindings)
- suggest-key-bindings
- 2))))))))
+ ;; Ensure that we never have two of the suggest-binding timers in
+ ;; flight.
+ (when execute-extended-command--binding-timer
+ (cancel-timer execute-extended-command--binding-timer))
+ ;; If this command displayed something in the echo area, then
+ ;; postpone the display of our suggestion message a bit.
+ (when (and suggest-key-bindings
+ (or binding
+ (and extended-command-suggest-shorter typed)))
+ (setq delay-before-suggest
+ (cond
+ ((zerop (length (current-message))) 0)
+ ((numberp suggest-key-bindings) suggest-key-bindings)
+ (t 2)))
+ (when (and extended-command-suggest-shorter
+ (not binding)
+ (not executing-kbd-macro)
+ (symbolp function)
+ (> (length (symbol-name function)) 2))
+ ;; There's no binding for CMD. Let's try and find the shortest
+ ;; string to use in M-x.
+ (setq find-shorter t))
+ (when (or binding find-shorter)
+ (setq execute-extended-command--binding-timer
+ (run-at-time
+ delay-before-suggest nil
+ (lambda ()
+ ;; If the user has typed any other commands in the
+ ;; meantime, then don't display anything.
+ (when (eq function real-last-command)
+ ;; Find shorter string.
+ (when find-shorter
+ (while-no-input
+ ;; FIXME: Can be slow. Cache it maybe?
+ (setq binding (execute-extended-command--shorter
+ (symbol-name function) typed))))
+ (when binding
+ (with-temp-message
+ (format-message "You can run the command `%s' with %s"
+ function
+ (if (stringp binding)
+ (concat "M-x " binding " RET")
+ (key-description binding)))
+ (sit-for (if (numberp suggest-key-bindings)
+ suggest-key-bindings
+ 2))))))))))))
(defun execute-extended-command-for-buffer (prefixarg &optional
command-name typed)
@@ -4272,11 +4281,11 @@ the contents are inserted into the buffer anyway.
Optional arguments ACTION and FRAME are as for `display-buffer',
and are used only if a pop-up buffer is displayed."
- (cond ((and (stringp message) (not (string-match "\n" message)))
+ (cond ((and (stringp message) (not (string-search "\n" message)))
;; Trivial case where we can use the echo area
(message "%s" message))
((and (stringp message)
- (= (string-match "\n" message) (1- (length message))))
+ (= (string-search "\n" message) (1- (length message))))
;; Trivial case where we can just remove single trailing newline
(message "%s" (substring message 0 (1- (length message)))))
(t
@@ -6649,9 +6658,16 @@ is temporarily turned on. Furthermore, the mark will be
deactivated
by any subsequent point motion key that was not shift-translated, or
by any action that normally deactivates the mark in Transient Mark mode.
+When the value is `permanent', the mark will be deactivated by any
+action which normally does that, but not by motion keys that were
+not shift-translated.
+
See `this-command-keys-shift-translated' for the meaning of
shift-translation."
- :type 'boolean
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "Permanent" permanent)
+ (other :tag "On" t))
+ :version "28.1"
:group 'editing-basics)
(defun handle-shift-selection ()
@@ -6669,7 +6685,12 @@ translation.
Otherwise, if the region has been activated temporarily,
deactivate it, and restore the variable `transient-mark-mode' to
its earlier value."
- (cond ((and shift-select-mode this-command-keys-shift-translated)
+ (cond ((and (eq shift-select-mode 'permanent)
+ this-command-keys-shift-translated)
+ (unless mark-active
+ (push-mark nil nil t)))
+ ((and shift-select-mode
+ this-command-keys-shift-translated)
(unless (and mark-active
(eq (car-safe transient-mark-mode) 'only))
(setq-local transient-mark-mode
@@ -7756,7 +7777,9 @@ other purposes."
When Visual Line mode is enabled, `word-wrap' is turned on in
this buffer, and simple editing commands are redefined to act on
visual lines, not logical lines. See Info node `Visual Line
-Mode' for details."
+Mode' for details.
+Turning on this mode disables line truncation set up by
+variables `truncate-lines' and `truncate-partial-width-windows'."
:keymap visual-line-mode-map
:group 'visual-line
:lighter " Wrap"
@@ -8143,15 +8166,19 @@ is defined.
The function should take a single optional argument, which is a flag
indicating whether it should use soft newlines.")
-(defun default-indent-new-line (&optional soft)
+(defun default-indent-new-line (&optional soft force)
"Break line at point and indent.
If a comment syntax is defined, call `comment-line-break-function'.
The inserted newline is marked hard if variable `use-hard-newlines' is true,
unless optional argument SOFT is non-nil."
- (interactive)
+ (interactive (list nil t))
(if comment-start
- (funcall comment-line-break-function soft)
+ ;; Force breaking the line when called interactively.
+ (if force
+ (let ((comment-auto-fill-only-comments nil))
+ (funcall comment-line-break-function soft))
+ (funcall comment-line-break-function soft))
;; Insert the newline before removing empty space so that markers
;; get preserved better.
(if soft (insert-and-inherit ?\n) (newline 1))
@@ -8281,8 +8308,13 @@ non-nil."
(if (eq buffer (window-buffer window))
(set-window-hscroll window 0)))
nil t)))
- (message "Truncate long lines %s"
- (if truncate-lines "enabled" "disabled")))
+ (message "Truncate long lines %s%s"
+ (if truncate-lines "enabled" "disabled")
+ (if (and truncate-lines visual-line-mode)
+ (progn
+ (visual-line-mode -1)
+ (format-message " and `visual-line-mode' disabled"))
+ "")))
(defun toggle-word-wrap (&optional arg)
"Toggle whether to use word-wrapping for continuation lines.
@@ -9535,9 +9567,9 @@ call `normal-erase-is-backspace-mode' (which see)
instead."
:set (lambda (symbol value)
;; The fboundp is because of a problem with :set when
;; dumping Emacs. It doesn't really matter.
- (if (fboundp 'normal-erase-is-backspace-mode)
- (normal-erase-is-backspace-mode (or value 0))
- (set-default symbol value))))
+ (when (fboundp 'normal-erase-is-backspace-mode)
+ (normal-erase-is-backspace-mode (or value 0)))
+ (set-default symbol value)))
(defun normal-erase-is-backspace-setup-frame (&optional frame)
"Set up `normal-erase-is-backspace-mode' on FRAME, if necessary."
diff --git a/lisp/so-long.el b/lisp/so-long.el
index d765d34..7bf15e8 100644
--- a/lisp/so-long.el
+++ b/lisp/so-long.el
@@ -8,7 +8,7 @@
;; Keywords: convenience
;; Created: 23 Dec 2015
;; Package-Requires: ((emacs "24.4"))
-;; Version: 1.0
+;; Version: 1.1.1
;; This file is part of GNU Emacs.
@@ -50,16 +50,17 @@
;; performance further, as well as making the so-long activity more obvious to
;; the user. These kinds of minified files are typically not intended to be
;; edited, so not providing the usual editing mode in such cases will rarely be
-;; an issue. However, you can reinstate the original state of the buffer by
-;; calling `so-long-revert' (the key binding of which is advertised when the
major
-;; mode change occurs). If you prefer that the major mode not be changed, you
-;; can customize the `so-long-minor-mode' action.
+;; an issue; however you can restore the buffer to its original state by
calling
+;; `so-long-revert' (the key binding of which is advertised when the major mode
+;; change occurs). If you prefer that the major mode not be changed in the
+;; first place, there is a `so-long-minor-mode' action available, which you can
+;; select by customizing the `so-long-action' user option.
;;
;; The user options `so-long-action' and `so-long-action-alist' determine what
-;; actions `so-long' and `so-long-revert' will take. This allows you to
configure
-;; alternative actions (including custom actions). As well as
-;; the major and minor mode actions provided by this library, `longlines-mode'
-;; is also supported by default as an alternative action.
+;; `so-long' and `so-long-revert' will do, enabling you to configure
alternative
+;; actions (including custom actions). As well as the major and minor mode
+;; actions provided by this library, `longlines-mode' is also supported by
+;; default as an alternative action.
;;
;; Note that while the measures taken can improve performance dramatically when
;; dealing with such files, this library does not have any effect on the
@@ -127,9 +128,9 @@
;; Use M-x customize-group RET so-long RET
;; (or M-x so-long-customize RET)
;;
-;; The user options `so-long-target-modes', `so-long-threshold', and
-;; `so-long-max-lines' determine whether action will be taken automatically
when
-;; visiting a file, and `so-long-action' determines what will be done.
+;; The user options `so-long-target-modes' and `so-long-threshold' determine
+;; whether action will be taken automatically when visiting a file, and
+;; `so-long-action' determines what will be done.
;; * Actions and menus
;; -------------------
@@ -152,7 +153,7 @@
;; * Files with a file-local 'mode'
;; --------------------------------
;; A file-local major mode is likely to be safe even if long lines are detected
-;; (as the author of the file would otherwise be unlikely to have set that
mode),
+;; (the author of the file would otherwise be unlikely to have set that mode),
;; and so these files are treated as special cases. When a file-local 'mode'
is
;; present, the function defined by the `so-long-file-local-mode-function' user
;; option is called. The default value will cause the `so-long-minor-mode'
@@ -213,6 +214,24 @@
;; performance or otherwise avoid undesirable behaviours. If `so-long-revert'
;; is called, then the original values are restored.
+;; * Retaining minor modes and settings when switching to `so-long-mode'
+;; ---------------------------------------------------------------------
+;; A consequence of switching to a new major mode is that many buffer-local
+;; minor modes and variables from the original major mode will be disabled.
+;; For performance purposes this is a desirable trait of `so-long-mode', but
+;; specified modes and variables can also be preserved across the major mode
+;; transition by customizing the `so-long-mode-preserved-minor-modes' and
+;; `so-long-mode-preserved-variables' user options.
+;;
+;; When `so-long-mode' is called, the states of any modes and variables
+;; configured by these options are remembered in the original major mode, and
+;; reinstated after switching to `so-long-mode'. Likewise, if `so-long-revert'
+;; is used to switch back to the original major mode, these modes and variables
+;; are again set to the same states.
+;;
+;; The default values for these options ensure that if `view-mode' was active
+;; in the original mode, then it will also be active in `so-long-mode'.
+
;; * Hooks
;; -------
;; `so-long-hook' runs at the end of the `so-long' command, after the
configured
@@ -287,8 +306,9 @@
;; the criteria for calling `so-long' in any given mode (plus its derivatives)
;; by setting buffer-local values for the variables in question. This includes
;; `so-long-predicate' itself, as well as any variables used by the predicate
-;; when determining the result. By default this means `so-long-max-lines',
-;; `so-long-skip-leading-comments', and `so-long-threshold'. E.g.:
+;; when determining the result. By default this means `so-long-threshold' and
+;; possibly also `so-long-max-lines' and `so-long-skip-leading-comments' (these
+;; latter two are not used by default starting from Emacs 28.1). E.g.:
;;
;; (add-hook 'js-mode-hook 'my-js-mode-hook)
;;
@@ -390,6 +410,14 @@
;; * Change Log:
;;
+;; 1.1.1 - Identical to 1.1, but fixing an incorrect GNU ELPA release.
+;; 1.1 - Utilise `buffer-line-statistics' in Emacs 28+, with the new
+;; `so-long-predicate' function `so-long-statistics-excessive-p'.
+;; - Increase `so-long-threshold' from 250 to 10,000.
+;; - Increase `so-long-max-lines' from 5 to 500.
+;; - Include `fundamental-mode' in `so-long-target-modes'.
+;; - New user option `so-long-mode-preserved-minor-modes'.
+;; - New user option `so-long-mode-preserved-variables'.
;; 1.0 - Included in Emacs 27.1, and in GNU ELPA for prior versions of Emacs.
;; - New global mode `global-so-long-mode' to enable/disable the library.
;; - New user option `so-long-action'.
@@ -442,13 +470,19 @@
(require 'cl-lib)
+;; Map each :package-version to the associated Emacs version.
+;; (This eliminates the need for explicit :version keywords on the
+;; custom definitions.)
(add-to-list 'customize-package-emacs-version-alist
- '(so-long ("1.0" . "27.1")))
+ '(so-long ("1.0" . "27.1")
+ ("1.1" . "28.1")))
-(defconst so-long--latest-version "1.0")
+(defconst so-long--latest-version "1.1")
+(declare-function buffer-line-statistics "fns.c" t t) ;; Emacs 28+
(declare-function longlines-mode "longlines")
(defvar longlines-mode)
+
(defvar so-long-enabled nil
;; This was initially a renaming of the old `so-long-mode-enabled' and
;; documented as "Set to nil to prevent `so-long' from being triggered
@@ -488,16 +522,24 @@
:prefix "so-long"
:group 'convenience)
-(defcustom so-long-threshold 250
+(defcustom so-long-threshold 10000
"Maximum line length permitted before invoking `so-long-function'.
-See `so-long-detected-long-line-p' for details."
+Line length is counted in either bytes or characters, depending on
+`so-long-predicate'.
+
+This is the only variable used to determine the presence of long lines if
+the `so-long-predicate' function is `so-long-statistics-excessive-p'."
:type 'integer
- :package-version '(so-long . "1.0"))
+ :package-version '(so-long . "1.1"))
-(defcustom so-long-max-lines 5
+(defcustom so-long-max-lines 500
"Number of non-blank, non-comment lines to test for excessive length.
+This option normally has no effect in Emacs versions >= 28.1, as the default
+`so-long-predicate' sees the entire buffer. Older versions of Emacs still make
+use of this option.
+
If nil then all lines will be tested, until either a long line is detected,
or the end of the buffer is reached.
@@ -507,11 +549,15 @@ be counted.
See `so-long-detected-long-line-p' for details."
:type '(choice (integer :tag "Limit")
(const :tag "Unlimited" nil))
- :package-version '(so-long . "1.0"))
+ :package-version '(so-long . "1.1"))
(defcustom so-long-skip-leading-comments t
"Non-nil to ignore all leading comments and whitespace.
+This option normally has no effect in Emacs versions >= 28.1, as the default
+`so-long-predicate' sees the entire buffer. Older versions of Emacs still make
+use of this option.
+
If the file begins with a shebang (#!), this option also causes that line to be
ignored even if it doesn't match the buffer's comment syntax, to ensure that
comments following the shebang will be ignored.
@@ -521,7 +567,7 @@ See `so-long-detected-long-line-p' for details."
:package-version '(so-long . "1.0"))
(defcustom so-long-target-modes
- '(prog-mode css-mode sgml-mode nxml-mode)
+ '(prog-mode css-mode sgml-mode nxml-mode fundamental-mode)
"`so-long' affects only these modes and their derivatives.
Our primary use-case is minified programming code, so `prog-mode' covers
@@ -534,7 +580,7 @@ files would prevent Emacs from handling them correctly."
;; Use 'symbol', as 'function' may be unknown => mismatch.
:type '(choice (repeat :tag "Specified modes" symbol)
(const :tag "All modes" t))
- :package-version '(so-long . "1.0"))
+ :package-version '(so-long . "1.1"))
(defcustom so-long-invisible-buffer-function #'so-long-deferred
"Function called in place of `so-long' when the buffer is not displayed.
@@ -566,7 +612,9 @@ the mentioned options might interfere with some intended
processing."
(function :tag "Custom function"))
:package-version '(so-long . "1.0"))
-(defcustom so-long-predicate 'so-long-detected-long-line-p
+(defcustom so-long-predicate (if (fboundp 'buffer-line-statistics)
+ 'so-long-statistics-excessive-p
+ 'so-long-detected-long-line-p)
"Function, called after `set-auto-mode' to decide whether action is needed.
Only called if the major mode is a member of `so-long-target-modes'.
@@ -574,10 +622,14 @@ Only called if the major mode is a member of
`so-long-target-modes'.
The specified function will be called with no arguments. If it returns non-nil
then `so-long' will be invoked.
-Defaults to `so-long-detected-long-line-p'."
- :type '(radio (const so-long-detected-long-line-p)
+Defaults to `so-long-statistics-excessive-p' starting from Emacs 28.1, or
+`so-long-detected-long-line-p' in earlier versions.
+
+Note that `so-long-statistics-excessive-p' requires Emacs 28.1 or later."
+ :type '(radio (const so-long-statistics-excessive-p)
+ (const so-long-detected-long-line-p)
(function :tag "Custom function"))
- :package-version '(so-long . "1.0"))
+ :package-version '(so-long . "1.1"))
;; Silence byte-compiler warning. `so-long-action-alist' is defined below
;; as a user option; but the definition sequence required for its setter
@@ -757,6 +809,7 @@ was established."
display-line-numbers-mode
flymake-mode
flyspell-mode
+ glasses-mode
goto-address-mode
goto-address-prog-mode
hi-lock-mode
@@ -776,6 +829,8 @@ was established."
hl-sexp-mode
idle-highlight-mode
rainbow-delimiters-mode
+ smartparens-mode
+ smartparens-strict-mode
)
;; It's not clear to me whether all of these would be problematic, but they
;; seemed like reasonable targets. Some are certainly excessive in smaller
@@ -800,7 +855,7 @@ disabled modes are re-enabled by calling them with the
numeric argument 1.
Please submit bug reports to recommend additional modes for this list, whether
they are in Emacs core, GNU ELPA, or elsewhere."
:type '(repeat symbol) ;; not function, as may be unknown => mismatch.
- :package-version '(so-long . "1.0"))
+ :package-version '(so-long . "1.1"))
(defcustom so-long-variable-overrides
'((bidi-inhibit-bpa . t)
@@ -848,6 +903,44 @@ intended to be edited manually."
(which-func-mode boolean))
:package-version '(so-long . "1.0"))
+(defcustom so-long-mode-preserved-minor-modes
+ '(view-mode)
+ "List of buffer-local minor modes to preserve in `so-long-mode'.
+
+These will be enabled or disabled after switching to `so-long-mode' (by calling
+them with the numeric argument 1 or 0) in accordance with their state in the
+buffer's original major mode. Unknown modes, and modes which are already in
the
+desired state, are ignored.
+
+This happens before `so-long-variable-overrides' and `so-long-minor-modes'
+have been processed.
+
+By default this happens only if `so-long-action' is set to `so-long-mode'.
+If `so-long-revert' is subsequently invoked, then the modes are again set
+to their original state after the original major mode has been called.
+
+See also `so-long-mode-preserved-variables' (processed after this)."
+ :type '(repeat symbol) ;; not function, as may be unknown => mismatch.
+ :package-version '(so-long . "1.1"))
+
+(defcustom so-long-mode-preserved-variables
+ '(view-old-buffer-read-only)
+ "List of buffer-local variables to preserve in `so-long-mode'.
+
+The original value of each variable will be maintained after switching to
+`so-long-mode'. Unknown variables are ignored.
+
+This happens before `so-long-variable-overrides' and `so-long-minor-modes'
+have been processed.
+
+By default this happens only if `so-long-action' is set to `so-long-mode'.
+If `so-long-revert' is subsequently invoked, then the variables are again
+set to their original values after the original major mode has been called.
+
+See also `so-long-mode-preserved-minor-modes' (processed before this)."
+ :type '(repeat variable)
+ :package-version '(so-long . "1.1"))
+
(defcustom so-long-hook nil
"List of functions to call after `so-long' is called.
@@ -934,10 +1027,17 @@ If RESET is non-nil, remove any existing values before
storing the new ones."
(setq so-long-original-values nil))
(so-long-remember 'so-long-variable-overrides)
(so-long-remember 'so-long-minor-modes)
+ (so-long-remember 'so-long-mode-preserved-variables)
+ (so-long-remember 'so-long-mode-preserved-minor-modes)
(dolist (ovar so-long-variable-overrides)
(so-long-remember (car ovar)))
(dolist (mode so-long-minor-modes)
(when (and (boundp mode) mode)
+ (so-long-remember mode)))
+ (dolist (var so-long-mode-preserved-variables)
+ (so-long-remember var))
+ (dolist (mode so-long-mode-preserved-minor-modes)
+ (when (and (boundp mode) mode)
(so-long-remember mode))))
(defun so-long-menu ()
@@ -1077,12 +1177,23 @@ serves the same purpose.")
;; We change automatically to faster code
;; And then I won't feel so mad
+(defun so-long-statistics-excessive-p ()
+ "Non-nil if the buffer contains a line longer than `so-long-threshold' bytes.
+
+This uses `buffer-line-statistics' (available from Emacs 28.1) to establish the
+longest line in the buffer (counted in bytes rather than characters).
+
+This is the default value of `so-long-predicate' in Emacs versions >= 28.1.
+\(In earlier versions `so-long-detected-long-line-p' is used by default.)"
+ (> (cadr (buffer-line-statistics))
+ so-long-threshold))
+
(defun so-long-detected-long-line-p ()
"Determine whether the current buffer contains long lines.
Following any initial comments and blank lines, the next N lines of the buffer
-will be tested for excessive length (where \"excessive\" means above
-`so-long-threshold', and N is `so-long-max-lines').
+will be tested for excessive length (where \"excessive\" means greater than
+`so-long-threshold' characters, and N is `so-long-max-lines').
Returns non-nil if any such excessive-length line is detected.
@@ -1090,7 +1201,9 @@ If `so-long-skip-leading-comments' is nil then the N
lines will be counted
starting from the first line of the buffer. In this instance you will likely
want to increase `so-long-max-lines' to allow for possible comments.
-This is the default value of `so-long-predicate'."
+This is the default `so-long-predicate' function in Emacs versions < 28.1.
+\(Starting from 28.1, the default and recommended predicate function is
+`so-long-statistics-excessive-p', which is faster and sees the entire buffer.)"
(let ((count 0) start)
(save-excursion
(goto-char (point-min))
@@ -1191,7 +1304,8 @@ This minor mode is a standard `so-long-action' option."
;; Housekeeping. `so-long-minor-mode' might be invoked directly rather
;; than via `so-long', so replicate the necessary behaviours. The
minor
;; mode also cares about whether `so-long' was already active, as we do
- ;; not want to remember values which were potentially overridden
already.
+ ;; not want to remember values which were (potentially) overridden
+ ;; already.
(unless (or so-long--calling so-long--active)
(so-long--ensure-enabled)
(setq so-long--active t
@@ -1321,6 +1435,16 @@ This advice acts before `so-long-mode', with the
previous mode still active."
"Run by `so-long-mode' in `after-change-major-mode-hook'.
Calls `so-long-disable-minor-modes' and `so-long-override-variables'."
+ ;; Check/set the state of 'preserved' variables and minor modes.
+ ;; (See also `so-long-mode-revert'.)
+ ;; The "modes before variables" sequence is important for the default
+ ;; preserved mode `view-mode' which remembers the `buffer-read-only' state
+ ;; (which is also permanent-local). That causes problems unless we restore
+ ;; the original value of `view-old-buffer-read-only' after; otherwise the
+ ;; sequence `view-mode' -> `so-long' -> `so-long-revert' -> `view-mode'
+ ;; results in `view-mode' being disabled but the buffer still read-only.
+ (so-long-mode-maintain-preserved-minor-modes)
+ (so-long-mode-maintain-preserved-variables)
;; Disable minor modes.
(so-long-disable-minor-modes)
;; Override variables (again). We already did this in `so-long-mode' in
@@ -1334,14 +1458,15 @@ Calls `so-long-disable-minor-modes' and
`so-long-override-variables'."
(defun so-long-disable-minor-modes ()
"Disable any active minor modes listed in `so-long-minor-modes'."
(dolist (mode (so-long-original 'so-long-minor-modes))
- (when (and (boundp mode) mode)
+ (when (and (boundp mode)
+ (symbol-value mode))
(funcall mode 0))))
(defun so-long-restore-minor-modes ()
"Restore the minor modes which were disabled.
The modes are enabled in accordance with what was remembered in `so-long'."
- (dolist (mode so-long-minor-modes)
+ (dolist (mode (so-long-original 'so-long-minor-modes))
(when (and (so-long-original mode)
(boundp mode)
(not (symbol-value mode)))
@@ -1356,7 +1481,7 @@ The modes are enabled in accordance with what was
remembered in `so-long'."
"Restore the remembered values for the overridden variables.
The variables are set in accordance with what was remembered in `so-long'."
- (dolist (ovar so-long-variable-overrides)
+ (dolist (ovar (so-long-original 'so-long-variable-overrides))
(so-long-restore-variable (car ovar))))
(defun so-long-restore-variable (variable)
@@ -1364,7 +1489,7 @@ The variables are set in accordance with what was
remembered in `so-long'."
;; In the instance where `so-long-mode-revert' has just reverted the major
;; mode, note that `kill-all-local-variables' was already called by the
;; original mode function, and so these 'overridden' variables may now have
- ;; global rather than buffer-local values.
+ ;; global rather than buffer-local values (if they are not permanent-local).
(let* ((remembered (so-long-original variable :exists))
(originally-local (nth 2 remembered)))
(if originally-local
@@ -1380,6 +1505,24 @@ The variables are set in accordance with what was
remembered in `so-long'."
;; the old value as a buffer-local value, so we keep it simple.
(kill-local-variable variable))))
+(defun so-long-mode-maintain-preserved-variables ()
+ "Set any 'preserved' variables.
+
+The variables are set in accordance with what was remembered in `so-long'."
+ (dolist (var (so-long-original 'so-long-mode-preserved-variables))
+ (so-long-restore-variable var)))
+
+(defun so-long-mode-maintain-preserved-minor-modes ()
+ "Enable or disable 'preserved' minor modes.
+
+The modes are set in accordance with what was remembered in `so-long'."
+ (dolist (mode (so-long-original 'so-long-mode-preserved-minor-modes))
+ (when (boundp mode)
+ (let ((original (so-long-original mode))
+ (current (symbol-value mode)))
+ (unless (equal current original)
+ (funcall mode (if original 1 0)))))))
+
(defun so-long-mode-revert ()
"Call the `major-mode' which was selected before `so-long-mode' replaced it.
@@ -1407,6 +1550,10 @@ This is the `so-long-revert-function' for
`so-long-mode'."
;; `kill-all-local-variables' was already called by the original mode
;; function, so we may be seeing global values.
(so-long-restore-variables)
+ ;; Check/set the state of 'preserved' variables and minor modes.
+ ;; (Refer to `so-long-after-change-major-mode' regarding the sequence.)
+ (so-long-mode-maintain-preserved-minor-modes)
+ (so-long-mode-maintain-preserved-variables)
;; Restore the mode line construct.
(unless (derived-mode-p 'so-long-mode)
(setq so-long-mode-line-info (so-long-mode-line-info)))))
@@ -1648,8 +1795,7 @@ invoking the new action."
(when so-long--active
(so-long-revert))
;; Invoke the new action.
- (let ((so-long--calling t)
- (view-mode-active view-mode))
+ (let ((so-long--calling t))
(so-long--ensure-enabled)
;; ACTION takes precedence if supplied.
(when action
@@ -1678,10 +1824,7 @@ invoking the new action."
;; functions need to modify the buffer. We use `inhibit-read-only' to
;; side-step the issue (and likewise in `so-long-revert').
(let ((inhibit-read-only t))
- (run-hooks 'so-long-hook))
- ;; Restore `view-mode'.
- (when view-mode-active
- (view-mode)))))
+ (run-hooks 'so-long-hook)))))
(defun so-long-revert ()
"Revert the active `so-long-action' and run `so-long-revert-hook'.
@@ -1896,7 +2039,7 @@ If it appears in `%s', you should remove it."
(unless global-so-long-mode
(global-so-long-mode 1)))
(makunbound 'so-long-mode-enabled))
- ;; Update to version 1.N:
+ ;; Update to version 1.N from earlier versions:
;; (when (version< so-long-version "1.N") ...)
;;
;; All updates completed.
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 4666026..3cc3e27 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -1822,9 +1822,9 @@ matches the user directory ~, then it is replaced with a
~.
INDEX is not used, but is required by the caller."
(let* ((tilde (expand-file-name "~/"))
(dd (expand-file-name directory))
- (junk (string-prefix-p "~/" dd))
+ (junk (string-match (regexp-quote tilde) dd))
(displayme (if junk
- (concat "~/" (substring dd 2 nil))
+ (concat "~/" (substring dd (match-end 0)))
dd))
(p (point)))
(if (string-match "^~[/\\]?\\'" displayme) (setq displayme tilde))
@@ -3270,7 +3270,7 @@ Handles end-of-sublist smartly."
Clicking this button expands or contracts a directory. TEXT is the
button clicked which has either a + or -. TOKEN is the directory to be
expanded. INDENT is the current indentation level."
- (cond ((string-match "\\+" text) ;we have to expand this dir
+ (cond ((string-search "+" text) ;we have to expand this dir
(setq speedbar-shown-directories
(cons (expand-file-name
(concat (speedbar-line-directory indent) token "/"))
@@ -3283,7 +3283,7 @@ expanded. INDENT is the current indentation level."
(speedbar-default-directory-list
(concat (speedbar-line-directory indent) token "/")
(1+ indent)))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-reset-scanners)
(let ((oldl speedbar-shown-directories)
(newl nil)
@@ -3317,7 +3317,7 @@ INDENT is the current indentation level and is unused."
The parameter TEXT and TOKEN are required, where TEXT is the button
clicked, and TOKEN is the file to expand. INDENT is the current
indentation level."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(let* ((fn (expand-file-name (concat (speedbar-line-directory indent)
token)))
(lst (speedbar-fetch-dynamic-tags fn)))
@@ -3329,7 +3329,7 @@ indentation level."
(save-excursion
(end-of-line) (forward-char 1)
(funcall (car lst) indent (cdr lst)))))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
@@ -3358,14 +3358,14 @@ INDENT is the current indentation level."
"Expand a tag sublist. Imenu will return sub-lists of specialized tag types.
Etags does not support this feature. TEXT will be the button string.
TOKEN will be the list, and INDENT is the current indentation level."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
(speedbar-insert-generic-list indent token 'speedbar-tag-expand
'speedbar-tag-find))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
diff --git a/lisp/startup.el b/lisp/startup.el
index f337f7c..58030ca 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -549,7 +549,11 @@ It is the default value of the variable `top-level'."
;; When $HOME is set to '/nonexistent' means we are running the
;; testsuite, add a temporary folder in front to produce there
;; new compilations.
- (when (equal (getenv "HOME") "/nonexistent")
+ (when (and (equal (getenv "HOME") "/nonexistent")
+ ;; We may be running in a chroot environment where we
+ ;; can't write anything.
+ (file-writable-p (expand-file-name
+ (or temporary-file-directory ""))))
(let ((tmp-dir (make-temp-file "emacs-testsuite-" t)))
(add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t)))
(push tmp-dir native-comp-eln-load-path))))
diff --git a/lisp/subr.el b/lisp/subr.el
index 59a1af0..6ae6d24 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2001,10 +2001,10 @@ all symbols are bound before any of the VALUEFORMs are
evalled."
(t `(let* ,(nreverse seqbinds) ,nbody))))))
(defmacro dlet (binders &rest body)
- "Like `let*' but using dynamic scoping."
+ "Like `let' but using dynamic scoping."
(declare (indent 1) (debug let))
;; (defvar FOO) only affects the current scope, but in order for
- ;; this not to affect code after the `let*' we need to create a new scope,
+ ;; this not to affect code after the main `let' we need to create a new
scope,
;; which is what the surrounding `let' is for.
;; FIXME: (let () ...) currently doesn't actually create a new scope,
;; which is why we use (let (_) ...).
@@ -2012,7 +2012,7 @@ all symbols are bound before any of the VALUEFORMs are
evalled."
,@(mapcar (lambda (binder)
`(defvar ,(if (consp binder) (car binder) binder)))
binders)
- (let* ,binders ,@body)))
+ (let ,binders ,@body)))
(defmacro with-wrapper-hook (hook args &rest body)
@@ -2872,9 +2872,23 @@ This function is used by the `interactive' code letter
`n'."
(defvar read-char-choice-use-read-key nil
"Prefer `read-key' when reading a character by `read-char-choice'.
-Otherwise, use the minibuffer.")
+Otherwise, use the minibuffer.
+
+When using the minibuffer, the user is less constrained, and can
+use the normal commands available in the minibuffer, and can, for
+instance, switch to another buffer, do things there, and then
+switch back again to the minibuffer before entering the
+character. This is not possible when using `read-key', but using
+`read-key' may be less confusing to some users.")
(defun read-char-choice (prompt chars &optional inhibit-keyboard-quit)
+ "Read and return one of CHARS, prompting for PROMPT.
+Any input that is not one of CHARS is ignored.
+
+By default, the minibuffer is used to read the key
+non-modally (see `read-char-from-minibuffer'). If
+`read-char-choice-use-read-key' is non-nil, the modal `read-key'
+function is used instead (see `read-char-choice-with-read-key')."
(if (not read-char-choice-use-read-key)
(read-char-from-minibuffer prompt chars)
(read-char-choice-with-read-key prompt chars inhibit-keyboard-quit)))
@@ -3174,7 +3188,14 @@ Also discard all previous input in the minibuffer."
(defvar y-or-n-p-use-read-key nil
"Prefer `read-key' when answering a \"y or n\" question by `y-or-n-p'.
-Otherwise, use the minibuffer.")
+Otherwise, use the minibuffer.
+
+When using the minibuffer, the user is less constrained, and can
+use the normal commands available in the minibuffer, and can, for
+instance, switch to another buffer, do things there, and then
+switch back again to the minibuffer before entering the
+character. This is not possible when using `read-key', but using
+`read-key' may be less confusing to some users.")
(defun y-or-n-p (prompt)
"Ask user a \"y or n\" question.
@@ -3203,7 +3224,12 @@ responses, perform the requested window recentering or
scrolling
and ask again.
Under a windowing system a dialog box will be used if `last-nonmenu-event'
-is nil and `use-dialog-box' is non-nil."
+is nil and `use-dialog-box' is non-nil.
+
+By default, this function uses the minibuffer to read the key.
+If `y-or-n-p-use-read-key' is non-nil, `read-key' is used
+instead (which means that the user can't change buffers (and the
+like) while `y-or-n-p' is running)."
(let ((answer 'recenter)
(padded (lambda (prompt &optional dialog)
(let ((l (length prompt)))
@@ -3681,7 +3707,7 @@ See Info node `(elisp)Security Considerations'."
"''"
;; Quote everything except POSIX filename characters.
;; This should be safe enough even for really weird shells.
- (replace-regexp-in-string
+ (string-replace
"\n" "'\n'"
(replace-regexp-in-string "[^-0-9a-zA-Z_./\n]" "\\\\\\&" argument))))
))
@@ -3859,6 +3885,67 @@ Point in BUFFER will be placed after the inserted text."
(with-current-buffer buffer
(insert-buffer-substring current start end))))
+(defun replace-string-in-region (string replacement &optional start end)
+ "Replace STRING with REPLACEMENT in the region from START to END.
+The number of replaced occurrences are returned, or nil if STRING
+doesn't exist in the region.
+
+If START is nil, use the current point. If END is nil, use `point-max'.
+
+Comparisons and replacements are done with fixed case."
+ (if start
+ (when (< start (point-min))
+ (error "Start before start of buffer"))
+ (setq start (point)))
+ (if end
+ (when (> end (point-max))
+ (error "End after end of buffer"))
+ (setq end (point-max)))
+ (save-excursion
+ (let ((matches 0)
+ (case-fold-search nil))
+ (goto-char start)
+ (while (search-forward string end t)
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert replacement)
+ (setq matches (1+ matches)))
+ (and (not (zerop matches))
+ matches))))
+
+(defun replace-regexp-in-region (regexp replacement &optional start end)
+ "Replace REGEXP with REPLACEMENT in the region from START to END.
+The number of replaced occurrences are returned, or nil if REGEXP
+doesn't exist in the region.
+
+If START is nil, use the current point. If END is nil, use `point-max'.
+
+Comparisons and replacements are done with fixed case.
+
+REPLACEMENT can use the following special elements:
+
+ `\\&' in NEWTEXT means substitute original matched text.
+ `\\N' means substitute what matched the Nth `\\(...\\)'.
+ If Nth parens didn't match, substitute nothing.
+ `\\\\' means insert one `\\'.
+ `\\?' is treated literally."
+ (if start
+ (when (< start (point-min))
+ (error "Start before start of buffer"))
+ (setq start (point)))
+ (if end
+ (when (> end (point-max))
+ (error "End after end of buffer"))
+ (setq end (point-max)))
+ (save-excursion
+ (let ((matches 0)
+ (case-fold-search nil))
+ (goto-char start)
+ (while (re-search-forward regexp end t)
+ (replace-match replacement t)
+ (setq matches (1+ matches)))
+ (and (not (zerop matches))
+ matches))))
+
(defun yank-handle-font-lock-face-property (face start end)
"If `font-lock-defaults' is nil, apply FACE as a `face' property.
START and END denote the start and end of the text to act on.
@@ -4532,6 +4619,19 @@ MODES is as for `set-default-file-modes'."
,@body)
(set-default-file-modes ,umask)))))
+(defmacro with-existing-directory (&rest body)
+ "Execute BODY with `default-directory' bound to an existing directory.
+If `default-directory' is already an existing directory, it's not changed."
+ (declare (indent 0) (debug t))
+ `(let ((default-directory (seq-find (lambda (dir)
+ (and dir
+ (file-exists-p dir)))
+ (list default-directory
+ (expand-file-name "~/")
+ (getenv "TMPDIR")
+ "/tmp/")
+ "/")))
+ ,@body))
;;; Matching and match data.
@@ -4808,7 +4908,7 @@ It understands Emacs Lisp quoting within STRING, such that
(split-string-and-unquote (combine-and-quote-strings strs)) == strs
The SEPARATOR regexp defaults to \"\\s-+\"."
(let ((sep (or separator "\\s-+"))
- (i (string-match "\"" string)))
+ (i (string-search "\"" string)))
(if (null i)
(split-string string sep t) ; no quoting: easy
(append (unless (eq i 0) (split-string (substring string 0 i) sep t))
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 41d565a..7f6afd7 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -136,14 +136,13 @@ Possible modifier keys are `control', `meta', `shift',
`hyper', `super' and
;; Replace default value with a condition that supports displaying
;; global-mode-string in the tab bar instead of the mode line.
(when (and (memq 'tab-bar-format-global tab-bar-format)
- (member '(global-mode-string ("" global-mode-string " "))
+ (member '(global-mode-string ("" global-mode-string))
mode-line-misc-info))
(setf (alist-get 'global-mode-string mode-line-misc-info)
'(("" (:eval (if (and tab-bar-mode
(memq 'tab-bar-format-global
tab-bar-format))
- "" global-mode-string))
- " ")))))
+ "" global-mode-string)))))))
(defun tab-bar--undefine-keys ()
"Uninstall key bindings previously bound by `tab-bar--define-keys'."
@@ -261,7 +260,9 @@ See `tab-bar-mode' for more information."
(tab-bar-mode arg)))
(defun toggle-frame-tab-bar (&optional frame)
- "Toggle tab bar of FRAME.
+ "Toggle tab bar of the selected frame.
+When calling from Lisp, use the optional argument FRAME to toggle
+the tab bar on that frame.
This is useful when you want to enable the tab bar individually
on each new frame when the global `tab-bar-mode' is disabled,
or when you want to disable the tab bar individually on each
@@ -366,6 +367,7 @@ When this is nil, you can create new tabs with \\[tab-new]."
(force-mode-line-update))
:group 'tab-bar
:version "27.1")
+(make-obsolete-variable 'tab-bar-new-button-show 'tab-bar-format "28.1")
(defvar tab-bar-new-button " + "
"Button for creating a new tab.")
@@ -399,16 +401,6 @@ If nil, don't show it at all."
(defvar tab-bar-forward-button " > "
"Button for going forward in tab history.")
-(defcustom tab-bar-history-buttons-show t
- "Show back and forward buttons when `tab-bar-history-mode' is enabled."
- :type 'boolean
- :initialize 'custom-initialize-default
- :set (lambda (sym val)
- (set-default sym val)
- (force-mode-line-update))
- :group 'tab-bar
- :version "28.1")
-
(defcustom tab-bar-tab-hints nil
"Show absolute numbers on tabs in the tab bar before the tab name.
This helps to select the tab by its number using `tab-bar-select-tab'
@@ -591,7 +583,10 @@ the mode line. Replacing `tab-bar-format-tabs' with
:version "28.1")
(defun tab-bar-format-history ()
- (when (and tab-bar-history-mode tab-bar-history-buttons-show)
+ "Show back and forward buttons when `tab-bar-history-mode' is enabled.
+You can hide these buttons by customizing `tab-bar-format' and removing
+`tab-bar-format-history' from it."
+ (when tab-bar-history-mode
`((sep-history-back menu-item ,(tab-bar-separator) ignore)
(history-back
menu-item ,tab-bar-back-button tab-bar-history-back
@@ -748,7 +743,7 @@ When `tab-bar-format-global' is added to `tab-bar-format'
then modes that display information on the mode line
using `global-mode-string' will display the same text
on the tab bar instead."
- `((global menu-item ,(format-mode-line global-mode-string) ignore)))
+ `((global menu-item ,(string-trim-right (format-mode-line
global-mode-string)) ignore)))
(defun tab-bar-format-list (format-list)
(let ((i 0))
@@ -1081,7 +1076,8 @@ to the tab argument will be applied after all functions
are called."
"Add a new tab at the absolute position TO-INDEX.
TO-INDEX counts from 1. If no TO-INDEX is specified, then add
a new tab at the position specified by `tab-bar-new-tab-to'.
-Negative TO-INDEX counts tabs from the end of the tab bar.
+Negative TO-INDEX counts tabs from the end of the tab bar,
+and -1 means the new tab will become the last one.
Argument addressing is absolute in contrast to `tab-bar-new-tab'
where argument addressing is relative.
After the tab is created, the hooks in
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 3f0cca0..411c71c 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -962,7 +962,7 @@ return nil. Otherwise point is returned."
(new-buffer-file-name (expand-file-name
;; `:' is not allowed on Windows
(concat tarname "!"
- (if (string-match "/" name)
+ (if (string-search "/" name)
name
;; Make sure `name' contains a /
;; so set-auto-mode doesn't try
diff --git a/lisp/term.el b/lisp/term.el
index 27f0bb1..0bcd095 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -1429,10 +1429,10 @@ The buffer is in Term mode; see `term-mode' for the
commands to use in that buffer.
\\<term-raw-map>Type \\[switch-to-buffer] to switch to another buffer."
- (interactive (list (read-from-minibuffer "Run program: "
- (or explicit-shell-file-name
- (getenv "ESHELL")
- shell-file-name))))
+ (interactive (list (read-shell-command "Run program: "
+ (or explicit-shell-file-name
+ (getenv "ESHELL")
+ shell-file-name))))
(set-buffer (make-term "terminal" program))
(term-mode)
(term-char-mode)
@@ -3488,9 +3488,9 @@ The top-most line is line 0."
((= (aref string 0) ?\032)
;; gdb (when invoked with -fullname) prints:
;; \032\032FULLFILENAME:LINENUMBER:CHARPOS:BEG_OR_MIDDLE:PC\n
- (let* ((first-colon (string-match ":" string 1))
+ (let* ((first-colon (string-search ":" string 1))
(second-colon
- (string-match ":" string (1+ first-colon)))
+ (string-search ":" string (1+ first-colon)))
(filename (substring string 1 first-colon))
(fileline (string-to-number
(substring string (1+ first-colon) second-colon))))
@@ -4307,7 +4307,7 @@ well as the newer ports COM10 and higher."
(when (or (null x) (and (stringp x) (zerop (length x))))
(error "No serial port selected"))
(when (not (or (serial-port-is-file-p)
- (string-match "\\\\" x)))
+ (string-search "\\" x)))
(setq x (concat "\\\\.\\" x)))
x))
diff --git a/lisp/term/linux.el b/lisp/term/linux.el
index c6d84ab..6d43e47 100644
--- a/lisp/term/linux.el
+++ b/lisp/term/linux.el
@@ -12,6 +12,9 @@
;; It can't really display underlines.
(tty-no-underline)
+ ;; Compositions confuse cursor movement.
+ (setq-default auto-composition-mode "linux")
+
(ignore-errors (when gpm-mouse-mode (require 't-mouse) (gpm-mouse-enable)))
;; Make Latin-1 input characters work, too.
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index 8cff2ce..9e7b360 100644
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -290,7 +290,7 @@ This is used by `msdos-show-help'.")
(not cursor-in-echo-area)) ;Don't overwrite a prompt.
(cond
((stringp help)
- (setq help (replace-regexp-in-string "\n" ", " help))
+ (setq help (string-replace "\n" ", " help))
(unless (or msdos-previous-message
(string-equal help (current-message))
(and (stringp msdos-last-help-message)
diff --git a/lisp/term/st.el b/lisp/term/st.el
index 9a1c064..26478ca 100644
--- a/lisp/term/st.el
+++ b/lisp/term/st.el
@@ -11,9 +11,17 @@
(require 'term/xterm)
+(defcustom xterm-st-extra-capabilities '(modifyOtherKeys)
+ "Extra capabilities supported under \"stterm\"."
+ :version "28.1"
+ :type xterm--extra-capabilities-type
+ :group 'xterm)
+
(defun terminal-init-st ()
"Terminal initialization function for st."
- (tty-run-terminal-initialization (selected-frame) "xterm"))
+ ;; Using `check' leads to a two-second timeout.
+ (let ((xterm-extra-capabilities xterm-st-extra-capabilities))
+ (tty-run-terminal-initialization (selected-frame) "xterm")))
(provide 'term/st)
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index 6b84916..80afcb3 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -410,7 +410,7 @@ See the documentation of `create-fontset-from-fontset-spec'
for the format.")
;;; Fix interface to (X-specific) mouse.el
(defun w32--set-selection (type value)
(if (eq type 'CLIPBOARD)
- (w32-set-clipboard-data (replace-regexp-in-string "\0" "\\0" value t t))
+ (w32-set-clipboard-data (string-replace "\0" "\\0" value))
(put 'x-selections (or type 'PRIMARY) value)))
(defun w32--get-selection (&optional type data-type)
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index 8bcae37..de5f000 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -73,6 +73,13 @@ string bytes that can be copied is 3/4 of this value."
:version "27.1"
:type 'boolean)
+(defcustom xterm-store-paste-on-kill-ring t
+ "If non-nil, pasting text into Emacs will put the text onto the kill ring.
+This user option is only heeded when using a terminal using xterm
+capabilities, and only when that terminal understands bracketed paste."
+ :version "28.1"
+ :type 'boolean)
+
(defconst xterm-paste-ending-sequence "\e[201~"
"Characters sent by the terminal to end a bracketed paste.")
@@ -100,9 +107,15 @@ Return the pasted text as a string."
(interactive "e")
(unless (eq (car-safe event) 'xterm-paste)
(error "xterm-paste must be found to xterm-paste event"))
- (let* ((pasted-text (nth 1 event))
- (interprogram-paste-function (lambda () pasted-text)))
- (yank)))
+ (let ((pasted-text (nth 1 event)))
+ (if xterm-store-paste-on-kill-ring
+ ;; Put the text onto the kill ring and then insert it into the
+ ;; buffer.
+ (let ((interprogram-paste-function (lambda () pasted-text)))
+ (yank))
+ ;; Insert the text without putting it onto the kill ring.
+ (push-mark)
+ (insert-for-yank pasted-text))))
;; Put xterm-paste itself in global-map because, after translation,
;; it's just a normal input event.
@@ -350,7 +363,20 @@ Return the pasted text as a string."
(define-key map "\e[5;3~" [M-prior])
(define-key map "\e[6;3~" [M-next])
- (define-key map "\e[29~" [print])
+ ;; This escape sequence has a controversial story.
+ ;; It was initially mapped to [print] (initial commit by Karl Heuer),
+ ;; but we can't find any justification for it.
+ ;; Xterm uses this escape sequence for both `F16' and `Menu' keys,
+ ;; and the reason for it is that in the VT220 keyboard the key
+ ;; placed logically at position where `F16' would be (and sending
+ ;; the escape sequence that naturally belongs to `F16') was
+ ;; labeled `Menu'. [ The story gets even more interesting if you
+ ;; want to dig deeper, e.g. some terminals would send that same
+ ;; escape sequence in response to `S-F4' (because they (ab)used
+ ;; the escape sequence of `F<n+12>' for `S-F<n>'). ]
+ ;; The current binding was chosen because current keyboards almost never
+ ;; have an `F16' key, whereas many do have a `Menu' key.
+ (define-key map "\e[29~" [menu])
(define-key map "\eOj" [kp-multiply])
(define-key map "\eOk" [kp-add])
@@ -944,9 +970,10 @@ See `xterm--init-frame-title'"
(defun xterm-set-window-title (&optional terminal)
"Set the window title of the Xterm TERMINAL.
The title is constructed from `frame-title-format'."
- (send-string-to-terminal
- (format "\e]2;%s\a" (format-mode-line frame-title-format))
- terminal))
+ (unless (display-graphic-p terminal)
+ (send-string-to-terminal
+ (format "\e]2;%s\a" (format-mode-line frame-title-format))
+ terminal)))
(defun xterm--selection-char (type)
(pcase type
@@ -1015,10 +1042,9 @@ hitting screen's max DCS length."
'terminal-init-screen))
(bytes (encode-coding-string data 'utf-8-unix))
(base-64 (if screen
- (replace-regexp-in-string
+ (string-replace
"\n" "\e\\\eP"
- (base64-encode-string bytes)
- :fixedcase :literal)
+ (base64-encode-string bytes))
(base64-encode-string bytes :no-line-break)))
(length (length base-64)))
(if (> length xterm-max-cut-length)
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 31186fb..d5671ce 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -113,7 +113,7 @@ page-dashes Change double dashes in page field to
single dash
whitespace Delete whitespace at the beginning and end of fields.
inherit-booktitle If entry contains a crossref field and the booktitle
field is empty, set the booktitle field to the content
- of the title field of the crossreferenced entry.
+ of the title field of the cross-referenced entry.
realign Realign entries, so that field texts and perhaps equal
signs (depending on the value of
`bibtex-align-at-equal-sign') begin in the same column.
@@ -1228,9 +1228,9 @@ See `bibtex-generate-autokey' for details."
:type 'integer)
(defcustom bibtex-autokey-use-crossref t
- "If non-nil use fields from crossreferenced entry if necessary.
+ "If non-nil use fields from cross-referenced entry if necessary.
If this variable is non-nil and some field has no entry, but a
-valid crossref entry, the field from the crossreferenced entry is used.
+valid crossref entry, the field from the cross-referenced entry is used.
See `bibtex-generate-autokey' for details."
:group 'bibtex-autokey
:type 'boolean)
@@ -2975,7 +2975,7 @@ The year part:
`bibtex-autokey-year-length' digits (useful values are 2 and 4).
2. If both the year and date fields are absent, but the entry has a
valid crossref field and `bibtex-autokey-use-crossref' is
- non-nil, use the date or year field of the crossreferenced entry
+ non-nil, use the date or year field of the cross-referenced entry
instead.
The title part
@@ -3962,7 +3962,7 @@ Optional arg COMMA is as in `bibtex-enclosing-field'. It
is t for
interactive calls."
(interactive (list nil t))
(unless field (setq field (car (bibtex-find-text-internal nil nil comma))))
- (if (string-match "@" field)
+ (if (string-search "@" field)
(cond ((bibtex-string= field "@string")
(message "String definition"))
((bibtex-string= field "@preamble")
diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el
index 5f34ae1..57ec8a0 100644
--- a/lisp/textmodes/conf-mode.el
+++ b/lisp/textmodes/conf-mode.el
@@ -417,12 +417,18 @@ See also `conf-space-mode', `conf-colon-mode',
`conf-javaprop-mode',
;; To tell the difference between those two cases where the function
;; might be called, we check `delay-mode-hooks'.
;; (inspired from tex-mode.el)
+(defvar conf-mode--recursing nil)
(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)))))
-
-
+ ;; The file may have "mode: conf" in the local variable
+ ;; block, in which case we'll be called recursively
+ ;; infinitely. Inhibit that.
+ (let ((conf-mode--recursing conf-mode--recursing))
+ (funcall (if (or delay-mode-hooks conf-mode--recursing)
+ orig-fun
+ (setq conf-mode--recursing t)
+ (conf--guess-mode))))))
(defun conf-mode-initialize (comment &optional font-lock)
"Initializations for sub-modes of `conf-mode'.
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 61a2f6b..d57f2d5 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -57,7 +57,7 @@
"Identifiers for pseudo-classes.")
(defconst css-pseudo-element-ids
- '("after" "before" "first-letter" "first-line")
+ '("after" "before" "first-letter" "first-line" "selection")
"Identifiers for pseudo-elements.")
(defconst css-at-ids
@@ -274,12 +274,13 @@
("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 Containment Module Level 2
+ ;; (https://www.w3.org/TR/css-contain-2/#property-index)
+ ("contain" "none" "strict" "content" "size" "layout" "style" "paint")
+ ("content-visibility" "visible" "auto" "hidden")
- ;; CSS Grid Layout Module Level 1
- ;; (https://www.w3.org/TR/css-grid-1/#property-index)
+ ;; CSS Grid Layout Module Level 2
+ ;; (https://www.w3.org/TR/css-grid-2/#property-index)
("grid" grid-template grid-template-rows "auto-flow" "dense"
grid-auto-columns grid-auto-rows grid-template-columns)
("grid-area" grid-line)
@@ -298,17 +299,32 @@
("grid-template" "none" grid-template-rows grid-template-columns
line-names string track-size line-names explicit-track-list)
("grid-template-areas" "none" string)
- ("grid-template-columns" "none" track-list auto-track-list)
- ("grid-template-rows" "none" track-list auto-track-list)
-
- ;; CSS Flexible Box Layout Module Level 1
- ;; (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"
- "stretch")
- ("align-self" "auto" "flex-start" "flex-end" "center" "baseline"
- "stretch")
+ ("grid-template-columns" "none" track-list auto-track-list "subgrid")
+ ("grid-template-rows" "none" track-list auto-track-list "subgrid")
+
+ ;; CSS Box Alignment Module Level 3
+ ;; (https://www.w3.org/TR/css-align-3/#property-index)
+ ("align-content"
+ baseline-position content-distibution overflow-position content-position)
+ ("align-items"
+ "normal" "stretch" baseline-position overflow-position self-position)
+ ("align-self"
+ "auto" "normal" "stretch"
+ baseline-position overflow-position self-position)
+ ("justify-content" "normal"
+ content-distibution overflow-position content-position "left" "right")
+ ("justify-items"
+ "normal" "stretch" baseline-position overflow-position self-position
+ "left" "right" "legacy")
+ ("justify-self"
+ "auto" "normal" "stretch" baseline-position overflow-position
self-position
+ "left" "right")
+ ("place-content" align-content justify-content)
+ ("place-items" align-items justify-items)
+ ("place-self" justify-self align-self)
+
+ ;; CSS Flexible Box Layout Module Level 2
+ ;; (https://www.w3.org/TR/css-flexbox-2/#property-index)
("flex" "none" flex-grow flex-shrink flex-basis)
("flex-basis" "auto" "content" width)
("flex-direction" "row" "row-reverse" "column" "column-reverse")
@@ -316,8 +332,6 @@
("flex-grow" number)
("flex-shrink" number)
("flex-wrap" "nowrap" "wrap" "wrap-reverse")
- ("justify-content" "flex-start" "flex-end" "center"
- "space-between" "space-around")
("order" integer)
;; CSS Fonts Module Level 3
@@ -757,6 +771,13 @@ further value candidates, since that list would be
infinite.")
(padding-width length percentage)
(position
"left" "center" "right" "top" "bottom" percentage length)
+ (baseline-position "left" "right" "baseline")
+ (content-distribution
+ "space-between" "space-around" "space-evenly" "stretch")
+ (overflow-position "unsafe" "safe")
+ (content-position "center" "start" "end" "flex-start" "flex-end")
+ (self-position
+ "center" "start" "end" "self-start" "self-end" "flex-start" "flex-end")
(radial-gradient "radial-gradient()")
(relative-size "larger" "smaller")
(repeat-style
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 836d889..975f540 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -442,22 +442,6 @@ 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-local flyspell-consider-dash-as-word-delimiter-flag nil
"Non-nil means that the `-' char is considered as a word delimiter.")
@@ -486,6 +470,13 @@ See also `flyspell-duplicate-distance'."
(defvar flyspell-overlay nil)
+(defun flyspell-context-menu (_menu)
+ "Context menu for `context-menu-mode'."
+ ;; TODO: refactor `flyspell-correct-word' and related functions to return
+ ;; a keymap menu where every menu item is bound to a lambda that calls
+ ;; `flyspell-do-correct' with an argument that is a correct word.
+ 'flyspell-correct-word)
+
;;*---------------------------------------------------------------------*/
;;* flyspell-mode ... */
;;*---------------------------------------------------------------------*/
@@ -537,10 +528,7 @@ in your init file.
:group 'flyspell
(if flyspell-mode
(condition-case err
- (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)))
+ (flyspell-mode-on (called-interactively-p 'interactive))
(error (message "Error enabling Flyspell mode:\n%s" (cdr err))
(flyspell-mode -1)))
(flyspell-mode-off)))
@@ -656,8 +644,7 @@ are both non-nil."
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")))
+ (mouse-button (if context-menu-mode "Mouse-3" "Mouse-2")))
(message (format-message
"Welcome to Flyspell. Use %s to correct words."
(if binding
@@ -1820,13 +1807,15 @@ 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 (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))
- (overlay-put overlay 'keymap flyspell-mouse-map)
+ (overlay-put overlay 'help-echo
+ (concat (if context-menu-mode "mouse-3" "mouse-2")
+ ": correct word at point"))
+ (if context-menu-mode
+ (overlay-put overlay 'context-menu-function 'flyspell-context-menu)
+ ;; 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))
+ (overlay-put overlay 'keymap flyspell-mouse-map))
(when (eq face 'flyspell-incorrect)
(and (stringp flyspell-before-incorrect-word-string)
(overlay-put overlay 'before-string
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 0a82bf5..3b9f1d3 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -649,11 +649,7 @@ Otherwise returns the library directory name, if that is
defined."
result libvar status ispell-program-version)
(with-temp-buffer
- (setq status (ispell-call-process
- ispell-program-name nil t nil
- (let ((case-fold-search
- (memq system-type '(ms-dos windows-nt))))
- "-vv")))
+ (setq status (ispell-call-process ispell-program-name nil t nil "-vv"))
(goto-char (point-min))
(if interactivep
;; Report version information of ispell
@@ -1043,7 +1039,11 @@ did."
Invoke this command before you want to start Hunspell for the first time
with a particular combination of dictionaries. The first dictionary
-in the list must have an affix file where Hunspell affix files are kept."
+in the list must have an affix file where Hunspell affix files are kept.
+
+If you invoke this from Lisp, make sure to precede it with
+a call to `ispell-set-spellchecker-params', as `ispell-change-dictionary'
+calls it only when invoked interactively."
(interactive "sMulti-dictionary combination: ")
;; Make sure the first dictionary in the list is known to us.
(let ((first-dict (car (split-string dict "," t))))
@@ -2501,7 +2501,7 @@ if defined."
"Customize `ispell-alternate-dictionary' to set yours.")))
(let* ((process-connection-type ispell-use-ptys-p)
- (wild-p (string-match "\\*" word))
+ (wild-p (string-search "*" word))
(look-p (and ispell-look-p ; Only use look for an exact match.
(or ispell-have-new-look (not wild-p))))
(prog (if look-p ispell-look-command ispell-grep-command))
@@ -2564,7 +2564,7 @@ if defined."
(continue t)
end)
(while continue
- (setq end (string-match "\n" output start)) ; get text up to the newline.
+ (setq end (string-search "\n" output start)) ; get text up to the
newline.
;; If we get out of sync and ispell-filter-continue is asserted when we
;; are not continuing, treat the next item as a separate list. When
;; ispell-filter-continue is asserted, ispell-filter *should* always be a
@@ -2736,11 +2736,11 @@ Optional third arg SHIFT is an offset to apply based on
previous corrections."
(if (eq type ?#)
(setq count 0) ; no misses for type #
(setq count (string-to-number output) ; get number of misses.
- output (substring output (1+ (string-match " " output 1)))))
+ output (substring output (1+ (string-search " " output 1)))))
(setq offset (string-to-number output))
(setq output (if (eq type ?#) ; No miss or guess list.
nil
- (substring output (1+ (string-match " " output 1)))))
+ (substring output (1+ (string-search " " output 1)))))
(while output
(let ((end (string-match ", \\|\\($\\)" output))) ; end of miss/guess.
(setq cur-count (1+ cur-count))
@@ -2923,7 +2923,14 @@ Keeps argument list for future Ispell invocations for no
async support."
;; But first wait to see if some more output is going to arrive.
;; Otherwise we get cool errors like "Can't open ".
(sleep-for 1)
- (ispell-accept-output 3)
+ ;; Only call `ispell-accept-output' if the Ispell process
+ ;; is alive, to avoid showing an unhelpful error message
+ ;; about a missing process, instead of the error which
+ ;; reports why the Ispell process died.
+ (when (if ispell-async-processp
+ (process-live-p ispell-process)
+ ispell-process)
+ (ispell-accept-output 3))
(error "%s" (mapconcat #'identity ispell-filter "\n"))))
(setq ispell-filter nil) ; Discard version ID line
(let ((extended-char-mode (ispell-get-extended-character-mode)))
@@ -3636,8 +3643,7 @@ sequence inside of a word.
Standard ispell choices are then available."
;; FIXME: completion-at-point-function.
(interactive "P")
- (let ((cursor-location (point))
- (case-fold-search-val case-fold-search)
+ (let ((case-fold-search-val case-fold-search)
(word (ispell-get-word nil "\\*")) ; force "previous-word" processing.
start end possibilities replacement)
(setq start (car (cdr word))
@@ -3674,18 +3680,12 @@ Standard ispell choices are then available."
(ispell-add-per-file-word-list word))
(replacement ; REPLACEMENT WORD
(delete-region start end)
- (setq word (if (atom replacement) replacement (car replacement))
- cursor-location (+ (- (length word) (- end start))
- cursor-location))
- (insert word)
- (if (not (atom replacement)) ; recheck spelling of replacement.
- (progn
- (goto-char cursor-location)
- (ispell-word nil t)))))
+ (insert (if (atom replacement) replacement (car replacement)))
+ (unless (atom replacement) ; recheck spelling of replacement.
+ (ispell-word nil t))))
(if (get-buffer ispell-choices-buffer)
(kill-buffer ispell-choices-buffer))))
- (ispell-pdict-save ispell-silently-savep)
- (goto-char cursor-location)))
+ (ispell-pdict-save ispell-silently-savep)))
;;;###autoload
@@ -4081,7 +4081,7 @@ Includes LaTeX/Nroff modes and extended character mode."
(ispell-send-string "+\n~tex\n"))
((string-match "nroff-mode" string)
(ispell-send-string "-\n~nroff\n"))
- ((string-match "~" string) ; Set extended character mode.
+ ((string-search "~" string) ; Set extended character mode.
(ispell-send-string (concat string "\n")))
(t (message "Invalid Ispell Parsing argument!")
(sit-for 2))))))))
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index 1368af0..1d5d1ca 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -449,8 +449,8 @@ If no such character is found, move to beginning of line."
(progn
(beginning-of-line)
(skip-chars-backward
- (concat "^" (replace-regexp-in-string
- "\\\\" "\\\\" picture-tab-chars nil t))
+ (concat "^" (string-replace
+ "\\" "\\\\" picture-tab-chars))
(point-min))
(not (bobp))))
(move-to-column target))
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index 650d11d..895064b 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -718,7 +718,7 @@ While entering the regexp, completion on knows citation
keys is possible.
(insert string))
;; Reposition cursor?
- (when (string-match "\\?" string)
+ (when (string-search "?" string)
(search-backward "?")
(delete-char 1))
diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el
index 0157f84..9def10c 100644
--- a/lisp/textmodes/reftex-parse.el
+++ b/lisp/textmodes/reftex-parse.el
@@ -757,7 +757,7 @@ if the information is exact (t) or approximate (nil)."
(while (and (setq tail (memq (assq 'toc (cdr tail)) tail))
(setq entry (car tail))
(>= (nth 5 entry) level))
- (setq star (string-match "\\*" (nth 6 entry))
+ (setq star (string-search "*" (nth 6 entry))
context (nth 2 entry)
section-number
(reftex-section-number (nth 5 entry) star))
diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el
index 611102e..1908182 100644
--- a/lisp/textmodes/reftex-ref.el
+++ b/lisp/textmodes/reftex-ref.el
@@ -798,7 +798,7 @@ When called with 2 C-u prefix args, disable magic word
recognition."
(push (cons (current-buffer) buffer-invisibility-spec)
reftex-buffers-with-changed-invisibility)
(setq buffer-invisibility-spec nil))
- ((string-match "\r" (buffer-substring beg end))
+ ((string-search "\r" (buffer-substring beg end))
;; Invisible with selective display. We need to copy it.
(let ((string (buffer-substring-no-properties beg end)))
(switch-to-buffer "*RefTeX Context Copy*")
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index c732299..1cb2cf4 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -813,7 +813,7 @@ This enforces rescanning the buffer on next use."
(setq wordlist (nthcdr 4 entry)))
(if (and (stringp fmt)
- (string-match "@" fmt))
+ (string-search "@" fmt))
;; Special syntax for specifying a label format
(setq fmt (split-string fmt "@+"))
(setq fmt (list "\\label{%s}" fmt)))
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index ababd77..d7cd0ac 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -1014,12 +1014,18 @@ says which mode to use."
(tex-common-initialization))
(advice-add 'tex-mode :around #'tex--redirect-to-submode)
+(defvar tex-mode--recursing nil)
(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 file may have "mode: tex" in the local variable
+ ;; block, in which case we'll be called recursively
+ ;; infinitely. Inhibit that.
+ (let ((tex-mode--recursing tex-mode--recursing))
+ (funcall (if (or delay-mode-hooks tex-mode--recursing)
+ ;; We're called from one of the children already.
+ orig-fun
+ (setq tex-mode--recursing t)
+ (tex--guess-mode)))))
;; The following three autoloaded aliases appear to conflict with
;; AUCTeX. However, even though AUCTeX uses the mixed case variants
@@ -1426,20 +1432,22 @@ on the line for the invalidity you want to see."
;; Skip "Mismatches:" header line.
(forward-line 1)
(setq num-matches (1+ num-matches))
- (insert-buffer-substring buffer start end)
- (let ((text-end (point-marker))
- (inhibit-read-only t)
- text-beg)
- (forward-char (- start end))
- (setq text-beg (point-marker))
- (insert (format "%3d: " linenum))
- (add-text-properties
- text-beg (- text-end 1)
- '(mouse-face highlight
- help-echo
- "mouse-2: go to this invalidity"))
- (put-text-property text-beg (- text-end 1)
- 'occur-target tem))))))))
+ (let ((inhibit-read-only t))
+ (insert-buffer-substring buffer start end)
+ (let ((text-end (point-marker))
+ text-beg)
+ (forward-char (- start end))
+ (setq text-beg (point-marker))
+ (insert (format "%3d: " linenum))
+ (add-text-properties
+ text-beg (- text-end 1)
+ '(mouse-face highlight
+ help-echo
+ "mouse-2: go to this invalidity"))
+ (put-text-property (point) (- text-end 1)
+ 'occur-match t)
+ (put-text-property text-beg text-end
+ 'occur-target tem)))))))))
(with-current-buffer standard-output
(let ((no-matches (zerop num-matches))
(inhibit-read-only t))
@@ -2070,7 +2078,7 @@ Return the process in which TeX is running."
(let* ((cmd (eval command t))
(proc (tex-shell-proc))
(buf (process-buffer proc))
- (star (string-match "\\*" cmd))
+ (star (string-search "*" cmd))
(string
(concat
(if (null file)
@@ -2472,7 +2480,7 @@ Only applies the FSPEC to the args part of FORMAT."
(defun tex-start-tex (command file &optional dir)
"Start a TeX run, using COMMAND on FILE."
- (let* ((star (string-match "\\*" command))
+ (let* ((star (string-search "*" command))
(compile-command
(if star
(concat (substring command 0 star)
@@ -2531,7 +2539,10 @@ The value of `tex-command' specifies the command to use
to run TeX."
(file-name-as-directory (expand-file-name tex-directory)))
(tex-out-file (expand-file-name (concat tex-zap-file ".tex")
zap-directory))
- (main-file (expand-file-name (tex-main-file)))
+ ;; We may be running from an unsaved buffer, in which case
+ ;; there's no point in guessing for a main file name.
+ (main-file (and buffer-file-name
+ (expand-file-name (tex-main-file))))
(ismain (string-equal main-file (buffer-file-name)))
already-output)
;; Don't delete temp files if we do the same buffer twice in a row.
@@ -2540,9 +2551,11 @@ The value of `tex-command' specifies the command to use
to run TeX."
(let ((default-directory zap-directory)) ; why?
;; We assume the header is fully contained in tex-main-file.
;; We use f-f-ns so we get prompted about any changes on disk.
- (with-current-buffer (find-file-noselect main-file)
- (setq already-output (tex-region-header tex-out-file
- (and ismain beg))))
+ (if (not main-file)
+ (setq already-output 0)
+ (with-current-buffer (find-file-noselect main-file)
+ (setq already-output (tex-region-header tex-out-file
+ (and ismain beg)))))
;; Write out the specified region (but don't repeat anything
;; already written in the header).
(write-region (if ismain
@@ -2771,7 +2784,7 @@ so normally SUFFIX starts with one."
;; Not found, so split on first period.
(concat (file-name-directory file-name)
(substring file 0
- (string-match "\\." file))
+ (string-search "." file))
suffix)))
" "))
@@ -3335,7 +3348,6 @@ There might be text before point."
("\\oplus" . ?⊕)
("\\oslash" . ?⊘)
("\\otimes" . ?⊗)
- ("\\par" . ?
)
("\\parallel" . ?∥)
("\\partial" . ?∂)
("\\perp" . ?⊥)
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 4c2470f..ab17748 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -73,8 +73,8 @@ provider functions are called with no parameters at the point
in
question.
\"things\" include `symbol', `list', `sexp', `defun', `filename',
-`url', `email', `uuid', `word', `sentence', `whitespace', `line',
-and `page'.")
+`existing-filename', `url', `email', `uuid', `word', `sentence',
+`whitespace', `line', and `page'.")
;; Basic movement
@@ -156,30 +156,36 @@ positions of the thing found."
"Return the THING at point.
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun',
-`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
-`line', `number', and `page'.
+`filename', `existing-filename', `url', `email', `uuid', `word',
+`sentence', `whitespace', `line', `number', and `page'.
When the optional argument NO-PROPERTIES is non-nil,
strip text properties from the return value.
+If the current buffer uses fields (see Info node `(elisp)Fields'),
+this function will narrow to the field before identifying the
+thing at point.
+
See the file `thingatpt.el' for documentation on how to define
a symbol as a valid THING."
- (let ((text
- (cond
- ((cl-loop for (pthing . function) in thing-at-point-provider-alist
- when (eq pthing thing)
- for result = (funcall function)
- when result
- return result))
- ((get thing 'thing-at-point)
- (funcall (get thing 'thing-at-point)))
- (t
- (let ((bounds (bounds-of-thing-at-point thing)))
- (when bounds
- (buffer-substring (car bounds) (cdr bounds))))))))
- (when (and text no-properties (sequencep text))
- (set-text-properties 0 (length text) nil text))
- text))
+ (save-restriction
+ (narrow-to-region (field-beginning) (field-end))
+ (let ((text
+ (cond
+ ((cl-loop for (pthing . function) in thing-at-point-provider-alist
+ when (eq pthing thing)
+ for result = (funcall function)
+ when result
+ return result))
+ ((get thing 'thing-at-point)
+ (funcall (get thing 'thing-at-point)))
+ (t
+ (let ((bounds (bounds-of-thing-at-point thing)))
+ (when bounds
+ (buffer-substring (car bounds) (cdr bounds))))))))
+ (when (and text no-properties (sequencep text))
+ (set-text-properties 0 (length text) nil text))
+ text)))
;; Go to beginning/end
@@ -301,6 +307,17 @@ E.g.:
(define-thing-chars filename thing-at-point-file-name-chars)
+;; Files
+
+(defun thing-at-point-file-at-point (&optional _lax _bounds)
+ "Return the name of the existing file at point."
+ (when-let ((filename (thing-at-point 'filename)))
+ (setq filename (expand-file-name filename))
+ (and (file-exists-p filename)
+ filename)))
+
+(put 'existing-filename 'thing-at-point 'thing-at-point-file-at-point)
+
;; URIs
(defvar thing-at-point-beginning-of-url-regexp nil
@@ -481,7 +498,7 @@ looks like an email address, \"ftp://\"; if it starts with
(and (string-match "\\`[[:alnum:]]+\\'" str)
(eq (char-before (car bounds)) ?<)
(eq (char-after (cdr bounds)) ?>)
- (not (string-match "~" (expand-file-name (concat "~" str))))
+ (not (string-search "~" (expand-file-name (concat "~" str))))
(setq str (concat "mailto:"; str)))
;; If it looks like news.example.com, treat it as news.
(if (thing-at-point-newsgroup-p str)
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index 5710b8c..4c86388 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -434,10 +434,10 @@ Open another window."
(defun thumbs-call-setroot-command (img)
"Call the setroot program for IMG."
(run-hooks 'thumbs-before-setroot-hook)
- (shell-command (replace-regexp-in-string
- "\\*"
+ (shell-command (string-replace
+ "*"
(shell-quote-argument (expand-file-name img))
- thumbs-setroot-command nil t))
+ thumbs-setroot-command))
(run-hooks 'thumbs-after-setroot-hook))
(defun thumbs-set-image-at-point-to-root-window ()
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el
index ae91171..5258742 100644
--- a/lisp/time-stamp.el
+++ b/lisp/time-stamp.el
@@ -44,10 +44,7 @@
(defcustom time-stamp-format "%Y-%02m-%02d %02H:%02M:%02S %l"
"Format of the string inserted by \\[time-stamp].
This is a string, used verbatim except for character sequences beginning
-with %, as follows. The values of non-numeric formatted items depend
-on the locale setting recorded in `system-time-locale' and
-`locale-coding-system'. The examples here are for the default
-\(`C') locale.
+with %, as follows.
%:A weekday name: `Monday' %#A gives uppercase: `MONDAY'
%3a abbreviated weekday: `Mon' %#a gives uppercase: `MON'
@@ -79,6 +76,11 @@ A leading zero in the field width zero-fills a number.
For example, to get the format used by the `date' command,
use \"%3a %3b %2d %02H:%02M:%02S %Z %Y\".
+The values of non-numeric formatted items depend on the locale
+setting recorded in `system-time-locale' and `locale-coding-system'.
+The examples here are for the default (`C') locale.
+`time-stamp-time-zone' controls the time zone used.
+
The default padding of some formats has changed to be more compatible
with format-time-string. To be compatible with older versions of Emacs,
specify a padding width (as shown) or use the : modifier to request the
@@ -100,6 +102,10 @@ when they are saved, either add this line to your init
file:
(add-hook \\='before-save-hook \\='time-stamp)
or customize option `before-save-hook'.
+To enable automatic time-stamping for only a specific file, add this
+line to a local variables list near the end of the file:
+ eval: (add-hook \\='before-save-hook \\='time-stamp nil t)
+
See also the variable `time-stamp-warn-inactive'."
:type 'boolean)
@@ -151,26 +157,27 @@ the first (last) `time-stamp-line-limit' lines of the
file for the
file to be time-stamped by \\[time-stamp]. A value of 0 searches the
entire buffer (use with care).
-This value can also be set with the variable `time-stamp-pattern'.
+It may be more convenient to use `time-stamp-pattern' if you set more
+than one of `time-stamp-line-limit', `time-stamp-start', `time-stamp-end',
+or `time-stamp-format'.
-Do not change `time-stamp-line-limit', `time-stamp-start',
-`time-stamp-end', or `time-stamp-pattern' for yourself or you will be
-incompatible with other people's files! If you must change them for some
-application, do so in the local variables section of the time-stamped file
-itself.")
+These variables are best changed with file-local variables.
+If you were to change `time-stamp-line-limit', `time-stamp-start',
+`time-stamp-end', or `time-stamp-pattern' in your init file, you
+would be incompatible with other people's files.")
;;;###autoload(put 'time-stamp-line-limit 'safe-local-variable 'integerp)
(defvar time-stamp-start "Time-stamp:[ \t]+\\\\?[\"<]+" ;Do not change!
"Regexp after which the time stamp is written by \\[time-stamp].
-See also the variables `time-stamp-end' and `time-stamp-line-limit'.
-This value can also be set with the variable `time-stamp-pattern'.
+It may be more convenient to use `time-stamp-pattern' if you set more
+than one of `time-stamp-line-limit', `time-stamp-start', `time-stamp-end',
+or `time-stamp-format'.
-Do not change `time-stamp-line-limit', `time-stamp-start',
-`time-stamp-end', or `time-stamp-pattern' for yourself or you will be
-incompatible with other people's files! If you must change them for some
-application, do so in the local variables section of the time-stamped file
-itself.")
+These variables are best changed with file-local variables.
+If you were to change `time-stamp-line-limit', `time-stamp-start',
+`time-stamp-end', or `time-stamp-pattern' in your init file, you
+would be incompatible with other people's files.")
;;;###autoload(put 'time-stamp-start 'safe-local-variable 'stringp)
(defvar time-stamp-end "\\\\?[\">]" ;Do not change!
@@ -179,7 +186,9 @@ itself.")
and the following match of `time-stamp-end', then writes the
time stamp specified by `time-stamp-format' between them.
-This value can also be set with the variable `time-stamp-pattern'.
+It may be more convenient to use `time-stamp-pattern' if you set more
+than one of `time-stamp-line-limit', `time-stamp-start', `time-stamp-end',
+or `time-stamp-format'.
The end text normally starts on the same line as the start text ends,
but if there are any newlines in `time-stamp-format', the same number
@@ -187,10 +196,10 @@ of newlines must separate the start and end.
\\[time-stamp] tries
to not change the number of lines in the buffer. `time-stamp-inserts-lines'
controls this behavior.
-Do not change `time-stamp-start', `time-stamp-end', `time-stamp-pattern',
-or `time-stamp-inserts-lines' for yourself or you will be incompatible
-with other people's files! If you must change them for some application,
-do so in the local variables section of the time-stamped file itself.")
+These variables are best changed with file-local variables.
+If you were to change `time-stamp-line-limit', `time-stamp-start',
+`time-stamp-end', `time-stamp-pattern', or `time-stamp-inserts-lines' in
+your init file, you would be incompatible with other people's files.")
;;;###autoload(put 'time-stamp-end 'safe-local-variable 'stringp)
@@ -204,10 +213,9 @@ immediately after the start pattern. This behavior can
cause
unexpected changes in the buffer if used carelessly, but it is useful
for generating repeated time stamps.
-Do not change `time-stamp-end' or `time-stamp-inserts-lines' for
-yourself or you will be incompatible with other people's files!
-If you must change them for some application, do so in the local
-variables section of the time-stamped file itself.")
+These variables are best changed with file-local variables.
+If you were to change `time-stamp-end' or `time-stamp-inserts-lines' in
+your init file, you would be incompatible with other people's files.")
;;;###autoload(put 'time-stamp-inserts-lines 'safe-local-variable 'symbolp)
@@ -215,10 +223,9 @@ variables section of the time-stamped file itself.")
"How many templates \\[time-stamp] will look for in a buffer.
The same time stamp will be written in each case.
-Do not change `time-stamp-count' for yourself or you will be
-incompatible with other people's files! If you must change it for
-some application, do so in the local variables section of the
-time-stamped file itself.")
+`time-stamp-count' is best changed with a file-local variable.
+If you were to change it in your init file, you would be incompatible
+with other people's files.")
;;;###autoload(put 'time-stamp-count 'safe-local-variable 'integerp)
@@ -244,6 +251,15 @@ part as \"%%\" to use the normal format.
The fourth part is a regexp identifying the pattern following the time stamp.
This part may be omitted to use the normal pattern.
+The pattern does not need to match the entire line of the time stamp.
+
+These variables are best changed with file-local variables.
+If you were to change `time-stamp-pattern', `time-stamp-line-limit',
+`time-stamp-start', or `time-stamp-end' in your init file, you
+would be incompatible with other people's files.
+
+See also `time-stamp-count' and `time-stamp-inserts-lines'.
+
Examples:
\"-10/\" (sets only `time-stamp-line-limit')
@@ -255,38 +271,44 @@ Examples:
`time-stamp-format' and `time-stamp-end')
\"newcommand{\\\\\\\\timestamp}{%%}\" (sets `time-stamp-start'
-and `time-stamp-end')
-
-Do not change `time-stamp-pattern' `time-stamp-line-limit',
-`time-stamp-start', or `time-stamp-end' for yourself or you will be
-incompatible with other people's files! If you must change them for
-some application, do so only in the local variables section of the
-time-stamped file itself.")
+and `time-stamp-end')")
;;;###autoload(put 'time-stamp-pattern 'safe-local-variable 'stringp)
;;;###autoload
(defun time-stamp ()
- "Update the time stamp string(s) in the buffer.
-A template in a file can be automatically updated with a new time stamp
-every time you save the file. Add this line to your init file:
- (add-hook \\='before-save-hook \\='time-stamp)
-or customize option `before-save-hook'.
-Normally the template must appear in the first 8 lines of a file and
-look like one of the following:
+ "Update any time stamp string(s) in the buffer.
+This function looks for a time stamp template and updates it with
+the current date, time, and/or other info.
+
+The template, which you manually create on one of the first 8 lines
+of the file before running this function, by default can look like
+one of the following (your choice):
Time-stamp: <>
Time-stamp: \" \"
-The time stamp is written between the brackets or quotes:
+This function writes the current time between the brackets or quotes,
+by default formatted like this:
Time-stamp: <2020-08-07 17:10:21 gildea>
-The time stamp is updated only if the variable
-`time-stamp-active' is non-nil.
-The format of the time stamp is set by the variable
-`time-stamp-pattern' or `time-stamp-format'.
-The variables `time-stamp-pattern', `time-stamp-line-limit',
-`time-stamp-start', `time-stamp-end', `time-stamp-count', and
-`time-stamp-inserts-lines' control finding the template."
+Although you can run this function manually to update a time stamp
+once, usually you want automatic time stamp updating.
+
+A time stamp can be automatically updated with current information
+every time you save a file. To enable time-stamping for all files,
+customize option `before-save-hook' or add this line to your init file:
+ (add-hook \\='before-save-hook \\='time-stamp)
+
+To enable automatic time-stamping for only a specific file, add
+this line to a local variables list near the end of the file:
+ eval: (add-hook \\='before-save-hook \\='time-stamp nil t)
+
+If the file has no time-stamp template, this function does nothing.
+
+You can set `time-stamp-pattern' in a files's local variables list
+to customize the information in the time stamp and where it is written.
+
+The time stamp is updated only if `time-stamp-active' is non-nil."
(interactive)
(let ((line-limit time-stamp-line-limit)
(ts-start time-stamp-start)
@@ -431,6 +453,8 @@ With ARG, turn time stamping on if and only if ARG is
positive."
(message "time-stamp is now %s." (if time-stamp-active "active" "off")))
(defun time-stamp--format (format time)
+ "FORMAT a TIME in zone `time-stamp-time-zone'.
+Internal helper used by `time-stamp-string-preprocess'."
(format-time-string format time time-stamp-time-zone))
(defun time-stamp-string (&optional ts-format time)
@@ -457,7 +481,7 @@ normally the current time is used."
(defun time-stamp-string-preprocess (format &optional time)
"Use a FORMAT to format date, time, file, and user information.
Optional second argument TIME is only for testing.
-Implements extensions to `format-time-string'
+This is an internal routine implementing extensions to `format-time-string'
and all `time-stamp-format' compatibility."
(let ((fmt-len (length format))
(ind 0)
@@ -682,14 +706,15 @@ and all `time-stamp-format' compatibility."
(defun time-stamp-do-number (format-char alt-form field-width time)
"Handle compatible FORMAT-CHAR where only default width/padding will change.
ALT-FORM is whether `#' specified. FIELD-WIDTH is the string
-width specification or \"\". TIME is the time to convert."
+width specification or \"\". TIME is the time to convert.
+This is an internal helper for `time-stamp-string-preprocess'."
(let ((format-string (concat "%" (char-to-string format-char))))
(if (and (> alt-form 0) (not (string-equal field-width "")))
"" ;discourage "%:2d" and the like
(string-to-number (time-stamp--format format-string time)))))
(defvar time-stamp-conversion-warn t
- "Warn about soon-to-be-unsupported forms in `time-stamp-format'.
+ "Enable warnings about soon-to-be-unsupported forms in `time-stamp-format'.
If nil, these warnings are disabled, which would be a bad idea!
You really need to update your files instead.
@@ -755,7 +780,7 @@ Suggests replacing OLD-FORM with NEW-FORM."
;; Principles guiding our choices:
;;
;; - The syntax should be easy to remember and the effect predictable.
-;; - It should be possible to produces as many useful effects as possible.
+;; - The syntax should enable as many useful effects as possible.
;;
;; Padding choices:
;;
@@ -789,21 +814,21 @@ Suggests replacing OLD-FORM with NEW-FORM."
;; %07:z "+99:00:00" "+100:00"
;; %7::z "+99:00:00" "+100:00:00"
-;;; * BNF syntax of the offset string produced by %z
-
-;; <offset> ::= <sign><hours>[<minutes>[<seconds>]]<padding> |
-;; <sign><hours>[<colonminutes>[<colonseconds>]]<padding> |
-;; <sign><bighours><colonminutes>[<colonseconds>]<padding>
-;; <sign> ::= "+"|"-"
-;; <hours> ::= <2digits>
-;; <minutes> ::= <2digits>
-;; <seconds> ::= <2digits>
-;; <colonminutes> ::= ":"<minutes>
-;; <colonseconds> ::= ":"<seconds>
-;; <2digits> ::= <digit><digit>
-;; <digit> ::= "0"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9"
-;; <bighours> ::= <digit>*<digit><2digits>
-;; <padding> ::= " "*
+;;; * ABNF syntax of the offset string produced by %z
+
+;; offset = sign hours [minutes [seconds]] padding /
+;; sign hours [colonminutes [colonseconds]] padding /
+;; sign bighours colonminutes [colonseconds] padding
+;; sign = "+" / "-"
+;; hours = digitpair
+;; minutes = digitpair
+;; seconds = digitpair
+;; colonminutes = ":" minutes
+;; colonseconds = ":" seconds
+;; digitpair = digit digit
+;; digit = "0" / "1" / "2" / "3" / "4" / "5" / "6" / "7" / "8" / "9"
+;; bighours = 1*digit digitpair
+;; padding = *" "
(defun time-stamp-formatz-from-parsed-options (flag-minimize
flag-pad-spaces-only
diff --git a/lisp/tmm.el b/lisp/tmm.el
index 2040f52..0d8c22d 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -268,7 +268,7 @@ Stores a list of all the shortcuts in the free variable
`tmm-short-cuts'."
(cdr elt)))
(t
(let* ((str (car elt))
- (paren (string-match "(" str))
+ (paren (string-search "(" str))
(pos 0) (word 0) char)
(catch 'done ; ??? is this slow?
(while (and (or (not tmm-shortcut-words) ; no limit on words
@@ -410,23 +410,15 @@ It uses the free variable `tmm-table-undef' to keep
undefined keys."
(if (eq elt 'undefined)
(setq tmm-table-undef (cons (cons event nil) tmm-table-undef))
(unless (assoc event tmm-table-undef)
- (cond ((if (listp elt)
- (or (keymapp elt) (eq (car elt) 'lambda))
- (and (symbolp elt) (fboundp elt)))
+ (cond ((or (functionp elt) (keymapp elt))
(setq km elt))
- ((if (listp (cdr-safe elt))
- (or (keymapp (cdr-safe elt))
- (eq (car (cdr-safe elt)) 'lambda))
- (and (symbolp (cdr-safe elt)) (fboundp (cdr-safe elt))))
+ ((or (keymapp (cdr-safe elt)) (functionp (cdr-safe elt)))
(setq km (cdr elt))
(and (stringp (car elt)) (setq str (car elt))))
- ((if (listp (cdr-safe (cdr-safe elt)))
- (or (keymapp (cdr-safe (cdr-safe elt)))
- (eq (car (cdr-safe (cdr-safe elt))) 'lambda))
- (and (symbolp (cdr-safe (cdr-safe elt)))
- (fboundp (cdr-safe (cdr-safe elt)))))
+ ((or (keymapp (cdr-safe (cdr-safe elt)))
+ (functionp (cdr-safe (cdr-safe elt))))
(setq km (cddr elt))
(and (stringp (car elt)) (setq str (car elt))))
@@ -447,11 +439,8 @@ It uses the free variable `tmm-table-undef' to keep
undefined keys."
(if enable
(setq km (if (eval enable) km 'ignore))))
- ((if (listp (cdr-safe (cdr-safe (cdr-safe elt))))
- (or (keymapp (cdr-safe (cdr-safe (cdr-safe elt))))
- (eq (car (cdr-safe (cdr-safe (cdr-safe elt)))) 'lambda))
- (and (symbolp (cdr-safe (cdr-safe (cdr-safe elt))))
- (fboundp (cdr-safe (cdr-safe (cdr-safe elt))))))
+ ((or (keymapp (cdr-safe (cdr-safe (cdr-safe elt))))
+ (functionp (cdr-safe (cdr-safe (cdr-safe elt)))))
; New style of easy-menu
(setq km (cdr (cddr elt)))
(and (stringp (car elt)) (setq str (car elt))))
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 03d9f54..23b67ee 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -346,7 +346,7 @@ It is also called if Tooltip mode is on, for text-only
displays."
(not cursor-in-echo-area)) ;Don't overwrite a prompt.
(cond
((stringp help)
- (setq help (replace-regexp-in-string "\n" ", " help))
+ (setq help (string-replace "\n" ", " help))
(unless (or tooltip-previous-message
(equal-including-properties help (current-message))
(and (stringp tooltip-help-message)
diff --git a/lisp/transient.el b/lisp/transient.el
index 5f66a13..5f441e8 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -3064,18 +3064,18 @@ Optional support for popup buttons is also implemented
here."
((equal (seq-take seq len) transient--redisplay-key)
(let ((pre (key-description (vconcat (seq-take seq len))))
(suf (key-description (vconcat (seq-drop seq len)))))
- (setq pre (replace-regexp-in-string "RET" "C-m" pre t))
- (setq pre (replace-regexp-in-string "TAB" "C-i" pre t))
- (setq suf (replace-regexp-in-string "RET" "C-m" suf t))
- (setq suf (replace-regexp-in-string "TAB" "C-i" suf t))
+ (setq pre (string-replace "RET" "C-m" pre))
+ (setq pre (string-replace "TAB" "C-i" pre))
+ (setq suf (string-replace "RET" "C-m" suf))
+ (setq suf (string-replace "TAB" "C-i" suf))
;; We use e.g. "-k" instead of the more correct "- k",
;; because the former is prettier. If we did that in
;; the definition, then we want to drop the space that
;; is reinserted above. False-positives are possible
;; for silly bindings like "-C-c C-c".
- (unless (string-match-p " " key)
- (setq pre (replace-regexp-in-string " " "" pre))
- (setq suf (replace-regexp-in-string " " "" suf)))
+ (unless (string-search " " key)
+ (setq pre (string-replace " " "" pre))
+ (setq suf (string-replace " " "" suf)))
(concat (propertize pre 'face 'default)
(and (string-prefix-p (concat pre " ") key) " ")
(transient--colorize-key suf cmd)
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index f291414..06cfacc 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -102,10 +102,10 @@ instead of the filename inheritance method."
(byserv
(setq retval (cdr-safe (assoc file byserv)))
(if (and (not retval)
- (string-match "/" file))
+ (string-search "/" file))
(while (and byserv (not retval))
(setq data (car (car byserv)))
- (if (or (not (string-match "/" data)) ; It's a realm - take it!
+ (if (or (not (string-search "/" data)) ; It's a realm - take it!
(and
(>= (length file) (length data))
(string= data (substring file 0 (length data)))))
@@ -251,12 +251,12 @@ a match."
(assoc dirkey keylist)
;; No exact match found. Continue to look for partial match if
;; dirkey is not a realm.
- (and (string-match "/" dirkey)
+ (and (string-search "/" dirkey)
(let (match)
(while (and (null match) keylist)
(if (or
;; Any realm candidate matches. Why?
- (not (string-match "/" (caar keylist)))
+ (not (string-search "/" (caar keylist)))
;; Parent directory matches.
(string-prefix-p (caar keylist) dirkey))
(setq match (car keylist))
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 68556d6..ed0402a 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -102,7 +102,15 @@
;;;###autoload
(define-minor-mode url-handler-mode
- "Toggle using `url' library for URL filenames (URL Handler mode)."
+ "Handle URLs as if they were file names throughout Emacs.
+After switching on this minor mode, Emacs file primitives handle
+URLs. For instance:
+
+ (file-exists-p \"https://www.gnu.org/\";)
+ => t
+
+and `C-x C-f https://www.gnu.org/ RET' will give you the HTML at
+that URL in a buffer."
:global t :group 'url
;; Remove old entry, if any.
(setq file-name-handler-alist
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index e3c1786..ba13a17 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1494,17 +1494,18 @@ The return value of this function is the retrieval
buffer."
;; Sometimes we get a zero-length data chunk after the process has
;; been changed to 'free', which means it has no buffer associated
;; with it. Do nothing if there is no buffer, or 0 length data.
- (and (process-buffer proc)
- (/= (length data) 0)
- (with-current-buffer (process-buffer proc)
- (url-http-debug "Calling after change function `%s' for `%S'"
url-http-after-change-function proc)
- (funcall url-http-after-change-function
- (point-max)
- (progn
- (goto-char (point-max))
- (insert data)
- (point-max))
- (length data)))))
+ (let ((b (process-buffer proc)))
+ (when (and (buffer-live-p b) (not (zerop (length data))))
+ (with-current-buffer b
+ (url-http-debug "Calling after change function `%s' for `%S'"
+ url-http-after-change-function proc)
+ (funcall url-http-after-change-function
+ (point-max)
+ (progn
+ (goto-char (point-max))
+ (insert data)
+ (point-max))
+ (length data))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; file-name-handler stuff from here on out
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
index 29c2780..4fd631d 100644
--- a/lisp/url/url-mailto.el
+++ b/lisp/url/url-mailto.el
@@ -105,7 +105,7 @@
(goto-char (point-max)))
(insert (mapconcat
(lambda (string)
- (replace-regexp-in-string "\r\n" "\n" string))
+ (string-replace "\r\n" "\n" string))
(cdar args) "\n")))
(url-mail-goto-field (caar args))
;; (setq func (intern-soft (concat "mail-" (caar args))))
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index 49cc587..4fe909c 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -106,7 +106,7 @@
(article (url-unhex-string (url-filename url))))
(url-news-open-host host port (url-user url) (url-password url))
(cond
- ((string-match "@" article) ; Its a specific article
+ ((string-search "@" article) ; Its a specific article
(setq buf (url-news-fetch-message-id host article)))
((string= article "") ; List all newsgroups
(gnus))
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 8b79736..113ac28 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -252,7 +252,7 @@ Will not do anything if `url-show-status' is nil."
(while pairs
(setq cur (car pairs)
pairs (cdr pairs))
- (unless (string-match "=" cur)
+ (unless (string-search "=" cur)
(setq cur (concat cur "=")))
(when (string-match "=" cur)
diff --git a/lisp/url/url.el b/lisp/url/url.el
index a6565e2..ccc95a6 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -235,85 +235,55 @@ If INHIBIT-COOKIES is non-nil, refuse to store cookies.
If
TIMEOUT is passed, it should be a number that says (in seconds)
how long to wait for a response before giving up."
(url-do-setup)
-
- (let ((retrieval-done nil)
- (start-time (current-time))
- (url-asynchronous nil)
- (asynch-buffer nil)
- (timed-out nil))
- (setq asynch-buffer
- (url-retrieve url (lambda (&rest ignored)
- (url-debug 'retrieval "Synchronous fetching done
(%S)" (current-buffer))
- (setq retrieval-done t
- asynch-buffer (current-buffer)))
- nil silent inhibit-cookies))
- (if (null asynch-buffer)
- ;; We do not need to do anything, it was a mailto or something
- ;; similar that takes processing completely outside of the URL
- ;; package.
- nil
- (let ((proc (get-buffer-process asynch-buffer)))
- ;; If the access method was synchronous, `retrieval-done' should
- ;; hopefully already be set to t. If it is nil, and `proc' is also
- ;; nil, it implies that the async process is not running in
- ;; asynch-buffer. This happens e.g. for FTP files. In such a case
- ;; url-file.el should probably set something like a `url-process'
- ;; buffer-local variable so we can find the exact process that we
- ;; should be waiting for. In the mean time, we'll just wait for any
- ;; process output.
- (while (and (not retrieval-done)
- (or (not timeout)
- (not (setq timed-out
- (time-less-p timeout
- (time-since start-time))))))
- (url-debug 'retrieval
- "Spinning in url-retrieve-synchronously: %S (%S)"
- retrieval-done asynch-buffer)
- (if (buffer-local-value 'url-redirect-buffer asynch-buffer)
- (setq proc (get-buffer-process
- (setq asynch-buffer
- (buffer-local-value 'url-redirect-buffer
- asynch-buffer))))
- (if (and proc (memq (process-status proc)
- '(closed exit signal failed))
- ;; Make sure another process hasn't been started.
- (eq proc (or (get-buffer-process asynch-buffer) proc)))
- ;; FIXME: It's not clear whether url-retrieve's callback is
- ;; guaranteed to be called or not. It seems that url-http
- ;; decides sometimes consciously not to call it, so it's not
- ;; clear that it's a bug, but even then we need to decide how
- ;; url-http can then warn us that the download has completed.
- ;; In the mean time, we use this here workaround.
- ;; XXX: The callback must always be called. Any
- ;; exception is a bug that should be fixed, not worked
- ;; around.
- (progn ;; Call delete-process so we run any sentinel now.
- (delete-process proc)
- (setq retrieval-done t)))
- ;; We used to use `sit-for' here, but in some cases it wouldn't
- ;; work because apparently pending keyboard input would always
- ;; interrupt it before it got a chance to handle process input.
- ;; `sleep-for' was tried but it lead to other forms of
- ;; hanging. --Stef
- (unless (or (with-local-quit
- (accept-process-output proc 1))
- (null proc))
- ;; accept-process-output returned nil, maybe because the process
- ;; exited (and may have been replaced with another). If we got
- ;; a quit, just stop.
- (when quit-flag
- (delete-process proc))
- (setq proc (and (not quit-flag)
- (get-buffer-process asynch-buffer))))))
- ;; On timeouts, make sure we kill any pending processes.
- ;; There may be more than one if we had a redirect.
- (when timed-out
- (when (process-live-p proc)
- (delete-process proc))
- (when-let ((aproc (get-buffer-process asynch-buffer)))
- (when (process-live-p aproc)
- (delete-process aproc))))))
- asynch-buffer))
+ (let* (url-asynchronous
+ data-buffer
+ (callback (lambda (&rest _args)
+ (setq data-buffer (current-buffer))
+ (url-debug 'retrieval
+ "Synchronous fetching done (%S)"
+ data-buffer)))
+ (start-time (current-time))
+ (proc-buffer (url-retrieve url callback nil silent
+ inhibit-cookies)))
+ (if (not proc-buffer)
+ (url-debug 'retrieval "Synchronous fetching unnecessary %s" url)
+ (unwind-protect
+ (catch 'done
+ (while (not data-buffer)
+ (when (and timeout (time-less-p timeout
+ (time-since start-time)))
+ (url-debug 'retrieval "Timed out %s (after %ss)" url
+ (float-time (time-since start-time)))
+ (throw 'done 'timeout))
+ (url-debug 'retrieval
+ "Spinning in url-retrieve-synchronously: nil (%S)"
+ proc-buffer)
+ (when-let ((redirect-buffer
+ (buffer-local-value 'url-redirect-buffer
+ proc-buffer)))
+ (unless (eq redirect-buffer proc-buffer)
+ (url-debug
+ 'retrieval "Redirect in url-retrieve-synchronously: %S ->
%S"
+ proc-buffer redirect-buffer)
+ (let (kill-buffer-query-functions)
+ (kill-buffer proc-buffer))
+ ;; Accommodate hack in commit 55d1d8b.
+ (setq proc-buffer redirect-buffer)))
+ (when-let ((proc (get-buffer-process proc-buffer)))
+ (when (memq (process-status proc)
+ '(closed exit signal failed))
+ ;; Process sentinel vagaries occasionally cause
+ ;; url-retrieve to fail calling callback.
+ (unless data-buffer
+ (url-debug 'retrieval "Dead process %s" url)
+ (throw 'done 'exception))))
+ ;; Querying over consumer internet in the US takes 100
+ ;; ms, so split the difference.
+ (accept-process-output nil 0.05)))
+ (unless (eq data-buffer proc-buffer)
+ (let (kill-buffer-query-functions)
+ (kill-buffer proc-buffer)))))
+ data-buffer))
;; url-mm-callback called from url-mm, which requires mm-decode.
(declare-function mm-dissect-buffer "mm-decode"
diff --git a/lisp/userlock.el b/lisp/userlock.el
index 38aaf6a..a38f6ac 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -125,7 +125,8 @@ You can <%s>uit; don't modify this file."
(with-demoted-errors "Unchanged content check: %S"
;; Even tho we receive `filename', we know that `filename' refers to the
current
;; buffer's file.
- (cl-assert (equal filename (expand-file-name buffer-file-truename)))
+ (cl-assert (equal (expand-file-name filename)
+ (expand-file-name buffer-file-truename)))
;; Note: rather than read the file and compare to the buffer, we could save
;; the buffer and compare to the file, but for encrypted data this
;; wouldn't work well (and would risk exposing the data).
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 4652afa..eeb32f8 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -357,6 +357,18 @@ well."
:foreground "green" :extend t))
"`diff-mode' face used to highlight added lines.")
+(defface diff-changed-unspecified
+ '((default
+ :inherit diff-changed)
+ (((class color) (min-colors 88) (background light))
+ :background "grey90" :extend t)
+ (((class color) (min-colors 88) (background dark))
+ :background "grey20" :extend t)
+ (((class color))
+ :foreground "grey" :extend t))
+ "`diff-mode' face used to highlight changed lines."
+ :version "28.1")
+
(defface diff-changed
'((t nil))
"`diff-mode' face used to highlight changed lines."
@@ -436,9 +448,10 @@ well."
(defvar diff-use-changed-face (and (face-differs-from-default-p 'diff-changed)
(not (face-equal 'diff-changed 'diff-added))
(not (face-equal 'diff-changed
'diff-removed)))
- "If non-nil, use the face `diff-changed' for changed lines in context diffs.
-Otherwise, use the face `diff-removed' for removed lines,
-and the face `diff-added' for added lines.")
+ "Controls how changed lines are fontified in context diffs.
+If non-nil, use the face `diff-changed-unspecified'. Otherwise,
+use the face `diff-removed' for removed lines, and the face
+`diff-added' for added lines.")
(defvar diff-font-lock-keywords
`((,(concat "\\(" diff-hunk-header-re-unified "\\)\\(.*\\)$")
@@ -470,7 +483,7 @@ and the face `diff-added' for added lines.")
diff-indicator-added-face
diff-indicator-removed-face)))))
(2 (if diff-use-changed-face
- 'diff-changed
+ 'diff-changed-unspecified
;; Otherwise, use the same method as above.
(save-match-data
(let ((limit (save-excursion (diff-beginning-of-hunk))))
@@ -956,11 +969,11 @@ If the OLD prefix arg is passed, tell the file NAME of
the old file."
(list (match-string 1)))
header-files
;; this assumes that there are no spaces in filenames
- (when (re-search-backward
- "^diff \\(-\\S-+ +\\)*\\(\\S-+\\)\\( +\\(\\S-+\\)\\)?"
- nil t)
- (list (if old (match-string 2) (match-string 4))
- (if old (match-string 4) (match-string 2)))))))))
+ (and (re-search-backward "^diff " nil t)
+ (looking-at
+ "^diff \\(-[^ \t\nL]+ +\\)*\\(-L +\\S-+ +\\)*\\(\\S-+\\)\\(
+\\(\\S-+\\)\\)?")
+ (list (if old (match-string 3) (match-string 5))
+ (if old (match-string 4) (match-string 3)))))))))
(defun diff-find-file-name (&optional old noprompt prefix)
"Return the file corresponding to the current patch.
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index fc6ea94..7c90348 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -400,7 +400,8 @@ keyboard input to go into icons."
;; skip dedicated and unsplittable frames
(ediff-destroy-control-frame control-buffer)
(let ((window-min-height 1)
- split-window-function wind-width-or-height
+ (window-combination-resize t)
+ split-window-function
three-way-comparison
wind-A-start wind-B-start wind-A wind-B wind-C)
(with-current-buffer control-buffer
@@ -419,22 +420,12 @@ keyboard input to go into icons."
(select-window (next-window nil 'ignore-minibuf)))
(delete-other-windows)
(set-window-dedicated-p (selected-window) nil)
- (split-window-vertically)
- (ediff-select-lowest-window)
- (ediff-setup-control-buffer control-buffer)
;; go to the upper window and split it betw A, B, and possibly C
(other-window 1)
(switch-to-buffer buf-A)
(setq wind-A (selected-window))
- (if three-way-comparison
- (setq wind-width-or-height
- (/ (if (eq split-window-function #'split-window-vertically)
- (window-height wind-A)
- (window-width wind-A))
- 3)))
-
- (funcall split-window-function wind-width-or-height)
+ (funcall split-window-function)
(if (eq (selected-window) wind-A)
(other-window 1))
@@ -443,7 +434,7 @@ keyboard input to go into icons."
(if three-way-comparison
(progn
- (funcall split-window-function) ; equally
+ (funcall split-window-function)
(if (eq (selected-window) wind-B)
(other-window 1))
(switch-to-buffer buf-C)
@@ -461,7 +452,9 @@ keyboard input to go into icons."
(set-window-start wind-A wind-A-start)
(set-window-start wind-B wind-B-start)))
- (ediff-select-lowest-window)
+ (select-window (display-buffer-in-direction
+ control-buffer
+ '((direction . bottom))))
(ediff-setup-control-buffer control-buffer)
))
@@ -746,6 +739,7 @@ keyboard input to go into icons."
(and (not (frame-live-p frame-A))
(or ctl-frame-exists-p
(eq frame-B (selected-frame))))))
+ (window-combination-resize t)
wind-A-start wind-B-start
designated-minibuffer-frame)
@@ -758,7 +752,7 @@ keyboard input to go into icons."
'B ediff-narrow-bounds))))
(if use-same-frame
- (let (wind-width-or-height) ; this affects 3way setups only
+ (progn
(if (and (eq frame-A frame-B) (frame-live-p frame-A))
(select-frame frame-A)
;; avoid dedicated and non-splittable windows
@@ -767,15 +761,7 @@ keyboard input to go into icons."
(switch-to-buffer buf-A)
(setq wind-A (selected-window))
- (if three-way-comparison
- (setq wind-width-or-height
- (/
- (if (eq split-window-function #'split-window-vertically)
- (window-height wind-A)
- (window-width wind-A))
- 3)))
-
- (funcall split-window-function wind-width-or-height)
+ (funcall split-window-function)
(if (eq (selected-window) wind-A)
(other-window 1))
(switch-to-buffer buf-B)
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 4a44787..46e9c97 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -974,8 +974,8 @@ Return non-nil if it is."
(not (looking-at (format ".+ .+ <%s>"
(regexp-quote mail))))
(looking-at ".+ \\(.+ <.+>\\) *\\((tiny change)\\)?"))
- (let ((author (replace-regexp-in-string " " " "
- (match-string 1))))
+ (let ((author (string-replace " " " "
+ (match-string 1))))
(unless (and log-edit-author
(string-match (regexp-quote author)
(car log-edit-author)))
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 694d452..956d9b3 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -214,6 +214,9 @@ Used in `smerge-diff-base-upper' and related functions."
["Invoke Ediff" smerge-ediff
:help "Use Ediff to resolve the conflicts"
:active (smerge-check 1)]
+ ["Refine" smerge-refine
+ :help "Highlight different words of the conflict"
+ :active (smerge-check 1)]
["Auto Resolve" smerge-resolve
:help "Try auto-resolution heuristics"
:active (smerge-check 1)]
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index de5a90d..5144b5d 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -467,7 +467,7 @@ in the branch repository (or whose status not be
determined)."
;; Erase the status text that matched.
(delete-region (match-beginning 0) (match-end 0))
(setq status
- (intern (replace-regexp-in-string " " "" statusword)))))
+ (intern (string-replace " " "" statusword)))))
(when status
(goto-char (point-min))
(skip-chars-forward " \n\t") ;Throw away spaces.
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index ef60713..ec6dc28 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -24,9 +24,9 @@
;;; Code:
+(require 'vc-rcs)
(eval-when-compile (require 'vc))
-(declare-function vc-branch-p "vc" (rev))
(declare-function vc-checkout "vc" (file &optional rev))
(declare-function vc-expand-dirs "vc" (file-or-dir-list backend))
(declare-function vc-read-revision "vc"
@@ -451,17 +451,17 @@ REV is the revision to check out."
((string= first-revision "")
(setq status (vc-cvs-merge-news file)))
(t
- (if (not (vc-branch-p first-revision))
+ (if (not (vc-rcs-branch-p first-revision))
(setq second-revision
(vc-read-revision
"Second revision: "
(list file) 'CVS nil
- (concat (vc-branch-part first-revision) ".")))
+ (concat (vc-rcs-branch-part first-revision) ".")))
;; We want to merge an entire branch. Set revisions
;; accordingly, so that vc-cvs-merge understands us.
(setq second-revision first-revision)
;; first-revision must be the starting point of the branch
- (setq first-revision (vc-branch-part first-revision)))
+ (setq first-revision (vc-rcs-branch-part first-revision)))
(setq status (vc-cvs-merge file first-revision second-revision))))
status))
@@ -542,14 +542,12 @@ Will fail unless you have administrative privileges on
the repo."
;;; History functions
;;;
-(declare-function vc-rcs-print-log-cleanup "vc-rcs" ())
;; Follows vc-cvs-command, which uses vc-do-command from vc-dispatcher.
(declare-function vc-exec-after "vc-dispatcher" (code))
(defun vc-cvs-print-log (files buffer &optional _shortlog _start-revision
limit)
"Print commit log associated with FILES into specified BUFFER.
Remaining arguments are ignored."
- (require 'vc-rcs)
;; It's just the catenation of the individual logs.
(vc-cvs-command
buffer
@@ -1173,7 +1171,7 @@ is non-nil."
(mtime (file-attribute-modification-time (file-attributes file)))
(parsed-time (progn (require 'parse-time)
(parse-time-string (concat time " +0000")))))
- (cond ((and (not (string-match "\\+" time))
+ (cond ((and (not (string-search "+" time))
(decoded-time-second parsed-time)
;; Compare just the seconds part of the file time,
;; since CVS file time stamp resolution is just 1 second.
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 1430871..037fbcb 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -242,6 +242,19 @@ included in the completions."
;;;###autoload (load "vc-git" nil t)
;;;###autoload (vc-git-registered file))))
+(defun vc-git--literal-pathspec (file)
+ "Prepend :(literal) path magic to FILE."
+ ;; Good example of file name that needs this: "test[56].xx".
+ (let ((lname (file-local-name file)))
+ ;; Expand abbreviated file names.
+ (when (file-name-absolute-p lname)
+ (setq lname (expand-file-name lname)))
+ (and file (concat ":(literal)" lname))))
+
+(defun vc-git--literal-pathspecs (files)
+ "Prepend :(literal) path magic to FILES."
+ (mapcar #'vc-git--literal-pathspec files))
+
(defun vc-git-registered (file)
"Check whether FILE is registered with git."
(let ((dir (vc-git-root file)))
@@ -255,12 +268,12 @@ included in the completions."
(name (file-relative-name file dir))
(str (with-demoted-errors "Error: %S"
(cd dir)
- (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
+ (vc-git--out-ok "ls-files" "-c" "-z" "--"
(vc-git--literal-pathspec name))
;; If result is empty, use ls-tree to check for deleted
;; file.
(when (eq (point-min) (point-max))
(vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
- "--" name))
+ "--" (vc-git--literal-pathspec name)))
(buffer-string))))
(and str
(> (length str) (length name))
@@ -342,7 +355,7 @@ in the order given by `git status'."
,@(when (version<= "1.7.6.3" (vc-git--program-version))
'("--ignored"))
"--"))
- (status (apply #'vc-git--run-command-string file args)))
+ (status (apply #'vc-git--run-command-string (vc-git--literal-pathspec
file) args)))
(if (null status)
;; If status is nil, there was an error calling git, likely because
;; the file is not in a git repo.
@@ -620,28 +633,28 @@ or an empty string if none."
(pcase (vc-git-dir-status-state->stage git-state)
('update-index
(if files
- (vc-git-command (current-buffer) 'async files "add" "--refresh"
"--")
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files) "add" "--refresh" "--")
(vc-git-command (current-buffer) 'async nil
"update-index" "--refresh")))
('ls-files-added
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"ls-files" "-z" "-c" "-s" "--"))
('ls-files-up-to-date
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"ls-files" "-z" "-c" "-s" "--"))
('ls-files-conflict
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"ls-files" "-z" "-u" "--"))
('ls-files-unknown
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"ls-files" "-z" "-o" "--exclude-standard" "--"))
('ls-files-ignored
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"ls-files" "-z" "-o" "-i" "--directory"
"--no-empty-directory" "--exclude-standard" "--"))
;; --relative added in Git 1.5.5.
('diff-index
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"diff-index" "--relative" "-z" "-M" "HEAD" "--")))
(vc-run-delayed
(vc-git-after-dir-status-stage git-state))))
@@ -869,12 +882,12 @@ The car of the list is the current branch."
(when flist
(vc-git-command nil 0 flist "update-index" "--add" "--"))
(when dlist
- (vc-git-command nil 0 dlist "add"))))
+ (vc-git-command nil 0 (vc-git--literal-pathspecs dlist) "add"))))
(defalias 'vc-git-responsible-p #'vc-git-root)
(defun vc-git-unregister (file)
- (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
+ (vc-git-command nil 0 (vc-git--literal-pathspec file) "rm" "-f" "--cached"
"--"))
(declare-function log-edit-mode "log-edit" ())
(declare-function log-edit-toggle-header "log-edit" (header value))
@@ -941,7 +954,7 @@ It is based on `log-edit-mode', and has Git-specific
extensions.")
(lambda (value) (when (equal value "yes") (list argument)))))
;; When operating on the whole tree, better pass "-a" than ".", since "."
;; fails when we're committing a merge.
- (apply #'vc-git-command nil 0 (if only files)
+ (apply #'vc-git-command nil 0 (if only (vc-git--literal-pathspecs files))
(nconc (if msg-file (list "commit" "-F"
(file-local-name msg-file))
(list "commit" "-m"))
@@ -968,7 +981,7 @@ It is based on `log-edit-mode', and has Git-specific
extensions.")
(coding-system-for-write 'binary)
(fullname
(let ((fn (vc-git--run-command-string
- file "ls-files" "-z" "--full-name" "--")))
+ (vc-git--literal-pathspec file) "ls-files" "-z"
"--full-name" "--")))
;; ls-files does not return anything when looking for a
;; revision of a file that has been renamed or removed.
(if (string= fn "")
@@ -985,14 +998,14 @@ It is based on `log-edit-mode', and has Git-specific
extensions.")
(vc-git-root file)))
(defun vc-git-checkout (file &optional rev)
- (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
+ (vc-git-command nil 0 (vc-git--literal-pathspec file) "checkout" (or rev
"HEAD")))
(defun vc-git-revert (file &optional contents-done)
"Revert FILE to the version stored in the git repository."
(if contents-done
(vc-git-command nil 0 file "update-index" "--")
- (vc-git-command nil 0 file "reset" "-q" "--")
- (vc-git-command nil nil file "checkout" "-q" "--")))
+ (vc-git-command nil 0 (vc-git--literal-pathspec file) "reset" "-q" "--")
+ (vc-git-command nil nil (vc-git--literal-pathspec file) "checkout" "-q"
"--")))
(defvar vc-git-error-regexp-alist
'(("^ \\(.+\\)\\> *|" 1 nil nil 0))
@@ -1076,7 +1089,7 @@ This prompts for a branch to merge from."
(defun vc-git-conflicted-files (directory)
"Return the list of files with conflicts in DIRECTORY."
(let* ((status
- (vc-git--run-command-string directory "status" "--porcelain" "--"))
+ (vc-git--run-command-string (vc-git--literal-pathspec directory)
"status" "--porcelain" "--"))
(lines (when status (split-string status "\n" 'omit-nulls)))
files)
(dolist (line lines files)
@@ -1157,7 +1170,7 @@ If LIMIT is a revision string, use it as an end-revision."
(let ((inhibit-read-only t))
(with-current-buffer buffer
(apply #'vc-git-command buffer
- 'async files
+ 'async (vc-git--literal-pathspecs files)
(append
'("log" "--no-color")
(when (and vc-git-print-log-follow
@@ -1322,7 +1335,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
;; but since Git is one of the two backends that support this operation
;; so far, it's hard to tell; hg doesn't need this.
(with-temp-buffer
- (vc-call-backend 'git 'diff file "HEAD" nil (current-buffer))
+ (vc-call-backend 'git 'diff (list file) "HEAD" nil (current-buffer))
(goto-char (point-min))
(let ((last-offset 0)
(from-offset nil)
@@ -1408,7 +1421,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(if vc-git-diff-switches
(apply #'vc-git-command (or buffer "*vc-diff*")
1 ; bug#21969
- files
+ (vc-git--literal-pathspecs files)
command
"--exit-code"
(append (vc-switches 'git 'diff)
@@ -1493,7 +1506,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(let* ((fname (file-relative-name file))
(prev-rev (with-temp-buffer
(and
- (vc-git--out-ok "rev-list" "-2" rev "--" fname)
+ (vc-git--out-ok "rev-list" "-2" rev "--"
(vc-git--literal-pathspec fname))
(goto-char (point-max))
(bolp)
(zerop (forward-line -1))
@@ -1521,7 +1534,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(current-rev
(with-temp-buffer
(and
- (vc-git--out-ok "rev-list" "-1" rev "--" file)
+ (vc-git--out-ok "rev-list" "-1" rev "--"
(vc-git--literal-pathspec file))
(goto-char (point-max))
(bolp)
(zerop (forward-line -1))
@@ -1533,7 +1546,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(and current-rev
(with-temp-buffer
(and
- (vc-git--out-ok "rev-list" "HEAD" "--" file)
+ (vc-git--out-ok "rev-list" "HEAD" "--"
(vc-git--literal-pathspec file))
(goto-char (point-min))
(search-forward current-rev nil t)
(zerop (forward-line -1))
@@ -1543,13 +1556,13 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(or (vc-git-symbolic-commit next-rev) next-rev)))
(defun vc-git-delete-file (file)
- (vc-git-command nil 0 file "rm" "-f" "--"))
+ (vc-git-command nil 0 (vc-git--literal-pathspec file) "rm" "-f" "--"))
(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"))
+ (vc-git-command nil 0 (vc-git--literal-pathspecs files) "add"))
(defvar vc-git-extra-menu-map
(let ((map (make-sparse-keymap)))
@@ -1772,7 +1785,6 @@ The difference to vc-do-command is that this function
always invokes
(process-environment
(append
`("GIT_DIR"
- "GIT_LITERAL_PATHSPECS=1"
;; Avoid repository locking during background operations
;; (bug#21559).
,@(when revert-buffer-in-progress-p
@@ -1807,7 +1819,6 @@ The difference to vc-do-command is that this function
always invokes
(process-environment
(append
`("GIT_DIR"
- "GIT_LITERAL_PATHSPECS=1"
;; Avoid repository locking during background operations
;; (bug#21559).
,@(when revert-buffer-in-progress-p
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index c9c1e91..4a64caa 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -851,8 +851,8 @@ if we don't understand a construct, we signal
(push "\\[" parts))
(t
(let ((x (substring glob i j)))
- (setf x (replace-regexp-in-string
- "\\\\" "\\\\" x t t))
+ (setf x (string-replace
+ "\\" "\\\\" x))
(setf i (1+ j))
(cond ((eq (aref x 0) ?!)
(setf (aref x 0) ?^))
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 6ffc1a8..0b0c71b 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -41,7 +41,6 @@
(require 'cl-lib)
(require 'vc))
-(declare-function vc-branch-p "vc" (rev))
(declare-function vc-read-revision "vc"
(prompt &optional files backend default initial-input))
(declare-function vc-buffer-context "vc-dispatcher" ())
@@ -173,6 +172,19 @@ For a description of possible values, see
`vc-check-master-templates'."
(defun vc-rcs-dir-extra-headers (&rest _ignore))
+;; functions that operate on RCS revision numbers.
+(defun vc-rcs-branch-p (rev)
+ "Return t if REV is a branch revision."
+ (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))
+(define-obsolete-function-alias 'vc-branch-p #'vc-rcs-branch-p "28.1")
+
+(defun vc-rcs-branch-part (rev)
+ "Return the branch part of a revision number REV."
+ (let ((index (string-match "\\.[0-9]+\\'" rev)))
+ (when index
+ (substring rev 0 index))))
+(define-obsolete-function-alias 'vc-branch-part #'vc-rcs-branch-part "28.1")
+
(defun vc-rcs-working-revision (file)
"RCS-specific version of `vc-working-revision'."
(or (and vc-consult-headers
@@ -198,7 +210,7 @@ When VERSION is given, perform check for that version."
;; If we are not on the trunk, we need to examine the
;; whole current branch.
(vc-insert-file (vc-master-name file) "^desc")
- (vc-rcs-find-most-recent-rev (vc-branch-part version))))))
+ (vc-rcs-find-most-recent-rev (vc-rcs-branch-part version))))))
(defun vc-rcs-workfile-unchanged-p (file)
"Has FILE remained unchanged since last checkout?"
@@ -326,7 +338,7 @@ whether to remove it."
(setq rev default-branch)
(setq switches (cons "-f" switches)))
(if (and (not rev) old-version)
- (setq rev (vc-branch-part old-version)))
+ (setq rev (vc-rcs-branch-part old-version)))
(apply #'vc-do-command "*vc*" 0 "ci" (vc-master-name file)
;; if available, use the secure check-in option
(and (vc-rcs-release-p "5.6.4") "-j")
@@ -349,11 +361,11 @@ whether to remove it."
;; branch accordingly
(cond
((and old-version new-version
- (not (string= (vc-branch-part old-version)
- (vc-branch-part new-version))))
+ (not (string= (vc-rcs-branch-part old-version)
+ (vc-rcs-branch-part new-version))))
(vc-rcs-set-default-branch file
(if (vc-rcs-trunk-p new-version) nil
- (vc-branch-part new-version)))
+ (vc-rcs-branch-part new-version)))
;; If this is an old (pre-1992!) RCS release, we might have
;; to remove a remaining lock.
(if (not (vc-rcs-release-p "5.6.2"))
@@ -414,7 +426,7 @@ attempt the checkout for all registered files beneath it."
;; REV is t ...
(if (not (vc-rcs-trunk-p workrev))
;; ... go to head of current branch
- (vc-branch-part workrev)
+ (vc-rcs-branch-part workrev)
;; ... go to head of trunk
(vc-rcs-set-default-branch file
nil)
@@ -431,7 +443,7 @@ attempt the checkout for all registered files beneath it."
file
(if (vc-rcs-latest-on-branch-p file new-version)
(if (vc-rcs-trunk-p new-version) nil
- (vc-branch-part new-version))
+ (vc-rcs-branch-part new-version))
new-version)))))
(message "Checking out %s...done" file))))))
@@ -456,17 +468,17 @@ revert all registered files beneath it."
((string= first-revision "")
(error "A starting RCS revision is required"))
(t
- (if (not (vc-branch-p first-revision))
+ (if (not (vc-rcs-branch-p first-revision))
(setq second-revision
(vc-read-revision
"Second RCS revision: "
(list file) 'RCS nil
- (concat (vc-branch-part first-revision) ".")))
+ (concat (vc-rcs-branch-part first-revision) ".")))
;; We want to merge an entire branch. Set revisions
;; accordingly, so that vc-rcs-merge understands us.
(setq second-revision first-revision)
;; first-revision must be the starting point of the branch
- (setq first-revision (vc-branch-part first-revision)))))
+ (setq first-revision (vc-rcs-branch-part first-revision)))))
(vc-rcs-merge file first-revision second-revision)))
(defun vc-rcs-merge (file first-version &optional second-version)
@@ -637,11 +649,11 @@ Optional arg REVISION is a revision to annotate from."
;; Find which branches (if any) must be included in the edits.
(let ((par revision)
bpt kids)
- (while (setq bpt (vc-branch-part par)
- par (vc-branch-part bpt))
+ (while (setq bpt (vc-rcs-branch-part par)
+ par (vc-rcs-branch-part bpt))
(setq kids (cdr (assq 'branches (cdr (assoc par revisions)))))
;; A branchpoint may have multiple children. Find the right one.
- (while (not (string= bpt (vc-branch-part (car kids))))
+ (while (not (string= bpt (vc-rcs-branch-part (car kids))))
(setq kids (cdr kids)))
(push (cons par (car kids)) nbls)))
;; Start with the full text.
@@ -818,7 +830,7 @@ systime, or nil if there is none. Also, reposition point."
or nil if there is no previous revision. This default
implementation works for MAJOR.MINOR-style revision numbers as
used by RCS and CVS."
- (let ((branch (vc-branch-part rev))
+ (let ((branch (vc-rcs-branch-part rev))
(minor-num (string-to-number (vc-rcs-minor-part rev))))
(when branch
(if (> minor-num 1)
@@ -830,7 +842,7 @@ used by RCS and CVS."
nil
;; we are at the beginning of a branch --
;; return revision of starting point
- (vc-branch-part branch))))))
+ (vc-rcs-branch-part branch))))))
(defun vc-rcs-next-revision (file rev)
"Return the revision number immediately following REV for FILE,
@@ -838,7 +850,7 @@ or nil if there is no next revision. This default
implementation
works for MAJOR.MINOR-style revision numbers as used by RCS
and CVS."
(when (not (string= rev (vc-working-revision file)))
- (let ((branch (vc-branch-part rev))
+ (let ((branch (vc-rcs-branch-part rev))
(minor-num (string-to-number (vc-rcs-minor-part rev))))
(concat branch "." (number-to-string (1+ minor-num))))))
@@ -965,7 +977,7 @@ to its master version."
(setq latest-rev rev)
(setq value (match-string 1)))))
(or value
- (vc-branch-part branch))))
+ (vc-rcs-branch-part branch))))
(defun vc-rcs-fetch-master-state (file &optional working-revision)
"Compute the master file's idea of the state of FILE.
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index c30920d..544a6c7 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -192,7 +192,7 @@ switches."
(let ((state (cdr (assq (aref (match-string 1) 0) state-map)))
(propstat (cdr (assq (aref (match-string 2) 0) state-map)))
(filename (if (memq system-type '(windows-nt ms-dos))
- (replace-regexp-in-string "\\\\" "/" (match-string
4))
+ (string-replace "\\" "/" (match-string 4))
(match-string 4))))
(and (memq propstat '(conflict edited))
(not (eq state 'conflict)) ; conflict always wins
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 9338b71..f6ae270 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -486,11 +486,19 @@
;; from ignored files.
;; When called from Lisp code, if DIRECTORY is non-nil, the
;; repository to use will be deduced by DIRECTORY.
+;; The default behavior is to add or remove a line from the file
+;; returned by the `find-ignore-file' function.
;;
;; - ignore-completion-table (directory)
;;
;; Return the completion table for files ignored by the current
;; version control system, e.g., the entries in `.gitignore' and
+;; `.bzrignore'. The default behavior is to read the contents of
+;; the file returned by the `find-ignore-file' function.
+;;
+;; - find-ignore-file
+;;
+;; Return the ignore file that controls FILE, e.g. `.gitignore' or
;; `.bzrignore'.
;;
;; - previous-revision (file rev)
@@ -852,7 +860,9 @@ See `run-hooks'."
(defcustom vc-revert-show-diff t
"If non-nil, `vc-revert' shows a `vc-diff' buffer before querying."
- :type 'boolean
+ :type '(choice (const :tag "Show and bury afterwards" t)
+ (const :tag "Show and kill afterwards" kill)
+ (const :tag "Don't show" nil))
:version "24.1")
;; Header-insertion hair
@@ -2047,9 +2057,9 @@ saving the buffer."
;; here, this way the *vc-diff* buffer is setup correctly, so
;; relative file names work.
(let ((default-directory rootdir))
- (vc-diff-internal
- t (list backend (list rootdir) working-revision) nil nil
- (called-interactively-p 'interactive))))))
+ (vc-diff-internal
+ t (list backend (list rootdir) working-revision) nil nil
+ (called-interactively-p 'interactive))))))
;;;###autoload
(defun vc-root-dir ()
@@ -2749,7 +2759,7 @@ to the working revision (except for keyword expansion)."
(if (= nfiles 1) "" "s"))))))
(error "Revert canceled")))
(when diff-buffer
- (quit-windows-on diff-buffer)))
+ (quit-windows-on diff-buffer (eq vc-revert-show-diff 'kill))))
(dolist (file files)
(message "Reverting %s..." (vc-delistify files))
(vc-revert-file file)
@@ -3064,20 +3074,6 @@ log entries should be gathered."
(vc-call-backend (vc-responsible-backend default-directory)
'update-changelog args))
-;; functions that operate on RCS revision numbers. This code should
-;; also be moved into the backends. It stays for now, however, since
-;; it is used in code below.
-(defun vc-branch-p (rev)
- "Return t if REV is a branch revision."
- (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))
-
-;;;###autoload
-(defun vc-branch-part (rev)
- "Return the branch part of a revision number REV."
- (let ((index (string-match "\\.[0-9]+\\'" rev)))
- (when index
- (substring rev 0 index))))
-
(defun vc-default-responsible-p (_backend _file)
"Indicate whether BACKEND is responsible for FILE.
The default is to return nil always."
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index aaa5683..a3a1274 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -593,7 +593,7 @@ Used when `whitespace-style' includes the value `empty'.")
(defface whitespace-empty
'((((class mono)) :inverse-video t :weight bold :underline t)
- (t :background "yellow" :foreground "firebrick"))
+ (t :background "yellow" :foreground "firebrick" :extend t))
"Face used to visualize empty lines at beginning and/or end of buffer."
:group 'whitespace)
@@ -924,7 +924,10 @@ Any other value is treated as nil."
"Toggle whitespace visualization (Whitespace mode).
See also `whitespace-style', `whitespace-newline' and
-`whitespace-display-mappings'."
+`whitespace-display-mappings'.
+
+This mode uses a number of faces to visualize the whitespace; see
+the customization group `whitespace' for details."
:lighter " ws"
:init-value nil
:global nil
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index 54b71c9..7ce0633 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -218,7 +218,7 @@ Nothing is assumed about value."
(error (prin1-to-string signal)))))
(when (string-match "\n\\'" pp)
(setq pp (substring pp 0 (1- (length pp)))))
- (if (cond ((string-match "\n" pp)
+ (if (cond ((string-search "\n" pp)
nil)
((> (length pp) (- (window-width) (current-column)))
nil)
diff --git a/lisp/windmove.el b/lisp/windmove.el
index f747c40..ef970bb 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -170,7 +170,7 @@ placement bugs in old versions of Emacs."
(defcustom windmove-allow-all-windows nil
"Whether the windmove commands are allowed to target all type of windows.
-If this variable is set to non-nil, all windmove commmands will
+If this variable is set to non-nil, all windmove commands will
ignore the `no-other-window' parameter applied by `display-buffer-alist'
or `set-window-parameter'."
:type 'boolean
diff --git a/lisp/window.el b/lisp/window.el
index 0346397..e14d472 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -4721,8 +4721,8 @@ This function is called by `prev-buffer'."
window new-buffer (nth 1 entry) (nth 2 entry))
(throw 'found t)))))
- (when skipped
- ;; Show first skipped buffer.
+ (when (and skipped (not (functionp switch-to-prev-buffer-skip)))
+ ;; Show first skipped buffer, unless skip was a function.
(setq new-buffer skipped)
(set-window-buffer-start-and-point window new-buffer)))
@@ -4831,6 +4831,7 @@ This function is called by `next-buffer'."
;; nreverse here!)
(dolist (entry (reverse (window-prev-buffers window)))
(when (and (not (eq new-buffer (car entry)))
+ (not (eq old-buffer (car entry)))
(setq new-buffer (car entry))
(or (buffer-live-p new-buffer)
(not (setq killed-buffers
@@ -4842,8 +4843,8 @@ This function is called by `next-buffer'."
window new-buffer (nth 1 entry) (nth 2 entry))
(throw 'found t))))
- (when skipped
- ;; Show first skipped buffer.
+ (when (and skipped (not (functionp switch-to-prev-buffer-skip)))
+ ;; Show first skipped buffer, unless skip was a function.
(setq new-buffer skipped)
(set-window-buffer-start-and-point window new-buffer)))
diff --git a/lisp/woman.el b/lisp/woman.el
index 0bc992d..fe9f896 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -418,7 +418,7 @@ As a special case, if PATHS is nil then replace it by
calling
(if (memq system-type '(windows-nt ms-dos))
(cond ((null paths)
(mapcar #'woman-Cyg-to-Win (woman-parse-man.conf)))
- ((string-match-p ";" paths)
+ ((string-search ";" paths)
;; Assume DOS-style path-list...
(mapcan ; splice list into list
(lambda (x)
@@ -1939,12 +1939,12 @@ Optional argument REDRAW, if non-nil, forces mode line
to be updated."
(setq symbol (car p)) ; 1. name
(if (functionp symbol) ; 2. command doc
(if (setq doc (documentation symbol t))
- (substring doc 0 (string-match "\n" doc))
+ (substring doc 0 (string-search "\n" doc))
"(not documented)"))
(if (custom-variable-p symbol) ; 3. variable doc
(if (setq doc (documentation-property
symbol 'variable-documentation t))
- (substring doc 0 (string-match "\n" doc))))))
+ (substring doc 0 (string-search "\n" doc))))))
(setq p (cdr p))))
;; Output the result:
(and (apropos-print t nil)
@@ -1955,7 +1955,7 @@ Optional argument REDRAW, if non-nil, forces mode line to
be updated."
(defun WoMan-getpage-in-background (topic)
"Use TOPIC to start WoMan from `Man-follow-manual-reference'."
;; topic is a string, generally of the form "section topic"
- (let ((s (string-match " " topic)))
+ (let ((s (string-search " " topic)))
(if s (setq topic (substring topic (1+ s))))
(woman topic)))
@@ -3840,7 +3840,7 @@ Leave 1 blank line. Format paragraphs upto TO."
((eolp) ; extend line
;; Insert character INCLUDING TEXT PROPERTIES:
;; (insert (substring overlap i (1+ i)))
- (let ((eol (string-match "\n" overlap i)))
+ (let ((eol (string-search "\n" overlap i)))
(insert (substring overlap i eol))
(setq i (or eol imax)))
)
diff --git a/lisp/xdg.el b/lisp/xdg.el
index 0bdfd11..e5165bb 100644
--- a/lisp/xdg.el
+++ b/lisp/xdg.el
@@ -208,8 +208,8 @@ Optional argument GROUP defaults to the string \"Desktop
Entry\"."
"Partition VALUE into elements delimited by unescaped semicolons."
(let (res)
(setq value (string-trim-left value))
- (dolist (x (split-string (replace-regexp-in-string "\\\\;" "\0" value)
";"))
- (push (replace-regexp-in-string "\0" ";" x) res))
+ (dolist (x (split-string (string-replace "\\;" "\0" value) ";"))
+ (push (string-replace "\0" ";" x) res))
(when (null (string-match-p "[^[:blank:]]" (car res))) (pop res))
(nreverse res)))
diff --git a/lisp/xml.el b/lisp/xml.el
index 4e2dd13..1b2d655 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -922,11 +922,11 @@ references and parameter-entity references."
(progn
(setq elem (match-string-no-properties 1 string)
modifier (match-string-no-properties 2 string))
- (if (string-match-p "|" elem)
+ (if (string-search "|" elem)
(setq elem (cons 'choice
(mapcar 'xml-parse-elem-type
(split-string elem "|"))))
- (if (string-match-p "," elem)
+ (if (string-search "," elem)
(setq elem (cons 'seq
(mapcar 'xml-parse-elem-type
(split-string elem ",")))))))
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index b8df550..f8cb7a7 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -95,9 +95,7 @@ NEW-SESSION specifies whether to create a new xwidget-webkit
session.
Interactively, URL defaults to the string looking like a url around point."
(interactive (progn
(require 'browse-url)
- (browse-url-interactive-arg "xwidget-webkit URL: "
- ;;(xwidget-webkit-current-url)
- )))
+ (browse-url-interactive-arg "xwidget-webkit URL: ")))
(or (featurep 'xwidget-internal)
(user-error "Your Emacs was not compiled with xwidgets support"))
(when (stringp url)
@@ -112,7 +110,7 @@ Interactively, URL defaults to the string looking like a
url around point."
"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)
+ (interactive nil xwidget-webkit-mode)
(let ((url (xwidget-webkit-current-url)))
(with-selected-window (split-window-below)
(xwidget-webkit-new-session url))))
@@ -121,7 +119,7 @@ in `split-window-below' with a new xwidget webkit session."
"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)
+ (interactive nil xwidget-webkit-mode)
(let ((url (xwidget-webkit-current-url)))
(with-selected-window (split-window-right)
(xwidget-webkit-new-session url))))
@@ -168,12 +166,12 @@ in `split-window-right' with a new xwidget webkit
session."
(defun xwidget-webkit-zoom-in ()
"Increase webkit view zoom factor."
- (interactive)
+ (interactive nil xwidget-webkit-mode)
(xwidget-webkit-zoom (xwidget-webkit-current-session) 0.1))
(defun xwidget-webkit-zoom-out ()
"Decrease webkit view zoom factor."
- (interactive)
+ (interactive nil xwidget-webkit-mode)
(xwidget-webkit-zoom (xwidget-webkit-current-session) -0.1))
(defun xwidget-webkit-scroll-up (&optional arg)
@@ -181,7 +179,7 @@ in `split-window-right' with a new xwidget webkit session."
Stop if bottom of page is reached.
Interactively, ARG is the prefix numeric argument.
Negative ARG scrolls down."
- (interactive "P")
+ (interactive "P" xwidget-webkit-mode)
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
(format "window.scrollBy(0, %d);"
@@ -192,7 +190,7 @@ Negative ARG scrolls down."
Stop if top of page is reached.
Interactively, ARG is the prefix numeric argument.
Negative ARG scrolls up."
- (interactive "P")
+ (interactive "P" xwidget-webkit-mode)
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
(format "window.scrollBy(0, -%d);"
@@ -203,7 +201,7 @@ Negative ARG scrolls up."
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")
+ (interactive "p" xwidget-webkit-mode)
(xwidget-webkit-scroll-up (* n (window-font-height))))
(defun xwidget-webkit-scroll-down-line (&optional n)
@@ -211,14 +209,14 @@ If N is omitted or nil, scroll up by one line."
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")
+ (interactive "p" xwidget-webkit-mode)
(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")
+ (interactive "p" xwidget-webkit-mode)
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
(format "window.scrollBy(%d, 0);"
@@ -228,7 +226,7 @@ If N is omitted or nil, scroll forwards by one char."
"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")
+ (interactive "p" xwidget-webkit-mode)
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
(format "window.scrollBy(-%d, 0);"
@@ -236,14 +234,14 @@ If N is omitted or nil, scroll backwards by one char."
(defun xwidget-webkit-scroll-top ()
"Scroll webkit to the very top."
- (interactive)
+ (interactive nil xwidget-webkit-mode)
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
"window.scrollTo(pageXOffset, 0);"))
(defun xwidget-webkit-scroll-bottom ()
"Scroll webkit to the very bottom."
- (interactive)
+ (interactive nil xwidget-webkit-mode)
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
"window.scrollTo(pageXOffset, window.document.body.scrollHeight);"))
@@ -261,7 +259,7 @@ If N is omitted or nil, scroll backwards by one char."
(defun xwidget-event-handler ()
"Receive xwidget event."
- (interactive)
+ (interactive nil xwidget-webkit-mode)
(xwidget-log "stuff happened to xwidget %S" last-input-event)
(let*
((xwidget-event-type (nth 1 last-input-event))
@@ -302,12 +300,14 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the
originating xwidget."
(defvar bookmark-make-record-function)
(when (memq window-system '(mac ns))
- (defvar xwidget-webkit-enable-plugins nil
+ (defcustom xwidget-webkit-enable-plugins nil
"Enable plugins for xwidget webkit.
-If non-nil, plugins are enabled. Otherwise, disabled."))
+If non-nil, plugins are enabled. Otherwise, disabled."
+ :type 'boolean
+ :version "28.1"))
-(define-derived-mode xwidget-webkit-mode
- special-mode "xwidget-webkit" "Xwidget webkit view mode."
+(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)
@@ -420,7 +420,7 @@ function findactiveelement(doc){
(defun xwidget-webkit-insert-string ()
"Insert string into the active field in the current webkit widget."
;; Read out the string in the field first and provide for edit.
- (interactive)
+ (interactive nil xwidget-webkit-mode)
;; As the prompt differs on JavaScript execution results,
;; the function must handle the prompt itself.
(let ((xww (xwidget-webkit-current-session)))
@@ -456,7 +456,7 @@ XW is the xwidget identifier, TEXT is retrieved from the
webkit."
(defun xwidget-webkit-end-edit-textarea ()
"End editing of a webkit text area."
- (interactive)
+ (interactive nil xwidget-webkit-mode)
(goto-char (point-min))
(while (search-forward "\n" nil t)
(replace-match "\\n" nil t))
@@ -472,7 +472,8 @@ XW is the xwidget identifier, TEXT is retrieved from the
webkit."
The ELEMENT-SELECTOR must be a valid CSS selector. For example,
use this to display an anchor."
(interactive (list (xwidget-webkit-current-session)
- (read-string "Element selector: ")))
+ (read-string "Element selector: "))
+ xwidget-webkit-mode)
(xwidget-webkit-execute-script
xw
(format "
@@ -488,7 +489,8 @@ use this to display an anchor."
"Make webkit xwidget XW show a named element ELEMENT-NAME.
For example, use this to display an anchor."
(interactive (list (xwidget-webkit-current-session)
- (read-string "Element name: ")))
+ (read-string "Element name: "))
+ xwidget-webkit-mode)
;; TODO: This needs to be interfaced into browse-url somehow. The
;; tricky part is that we need to do this in two steps: A: load the
;; base url, wait for load signal to arrive B: navigate to the
@@ -508,7 +510,8 @@ For example, use this to display an anchor."
"Make webkit xwidget XW show an id-element ELEMENT-ID.
For example, use this to display an anchor."
(interactive (list (xwidget-webkit-current-session)
- (read-string "Element id: ")))
+ (read-string "Element id: "))
+ xwidget-webkit-mode)
(xwidget-webkit-execute-script
xw
(format "
@@ -524,7 +527,8 @@ For example, use this to display an anchor."
"Make webkit xwidget XW show a name or element id ELEMENT-ID.
For example, use this to display an anchor."
(interactive (list (xwidget-webkit-current-session)
- (read-string "Name or element id: ")))
+ (read-string "Name or element id: "))
+ xwidget-webkit-mode)
(xwidget-webkit-execute-script
xw
(format "
@@ -539,12 +543,12 @@ For example, use this to display an anchor."
(defun xwidget-webkit-adjust-size-to-content ()
"Adjust webkit to content size."
- (interactive)
+ (interactive nil xwidget-webkit-mode)
(xwidget-adjust-size-to-content (xwidget-webkit-current-session)))
(defun xwidget-webkit-adjust-size-dispatch ()
"Adjust size according to mode."
- (interactive)
+ (interactive nil xwidget-webkit-mode)
(xwidget-webkit-adjust-size-to-window (xwidget-webkit-current-session))
;; The recenter is intended to correct a visual glitch.
;; It errors out if the buffer isn't visible, but then we don't get
@@ -573,12 +577,12 @@ For example, use this to display an anchor."
(defun xwidget-webkit-adjust-size (w h)
"Manually set webkit size to width W, height H."
;; TODO shouldn't be tied to the webkit xwidget
- (interactive "nWidth:\nnHeight:\n")
+ (interactive "nWidth:\nnHeight:\n" xwidget-webkit-mode)
(xwidget-resize (xwidget-webkit-current-session) w h))
(defun xwidget-webkit-fit-width ()
"Adjust width of webkit to window width."
- (interactive)
+ (interactive nil xwidget-webkit-mode)
(xwidget-webkit-adjust-size (- (nth 2 (window-inside-pixel-edges))
(car (window-inside-pixel-edges)))
1000))
@@ -630,22 +634,22 @@ For example, use this to display an anchor."
(defun xwidget-webkit-back ()
"Go back to previous URL in xwidget webkit buffer."
- (interactive)
+ (interactive nil xwidget-webkit-mode)
(xwidget-webkit-goto-history (xwidget-webkit-current-session) -1))
(defun xwidget-webkit-forward ()
"Go forward in history."
- (interactive)
+ (interactive nil xwidget-webkit-mode)
(xwidget-webkit-goto-history (xwidget-webkit-current-session) 1))
(defun xwidget-webkit-reload ()
"Reload current URL."
- (interactive)
+ (interactive nil xwidget-webkit-mode)
(xwidget-webkit-goto-history (xwidget-webkit-current-session) 0))
(defun xwidget-webkit-current-url ()
"Display the current xwidget webkit URL and place it on the `kill-ring'."
- (interactive)
+ (interactive nil xwidget-webkit-mode)
(let ((url (xwidget-webkit-uri (xwidget-webkit-current-session))))
(message "URL: %s" (kill-new (or url "")))))
@@ -659,7 +663,7 @@ For example, use this to display an anchor."
(defun xwidget-webkit-copy-selection-as-kill ()
"Get the webkit selection and put it on the `kill-ring'."
- (interactive)
+ (interactive nil xwidget-webkit-mode)
(xwidget-webkit-get-selection #'kill-new))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/oldXMenu/Activate.c b/oldXMenu/Activate.c
index 91439ea..8ffa817 100644
--- a/oldXMenu/Activate.c
+++ b/oldXMenu/Activate.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
Copyright (C) 2001-2021 Free Software Foundation, Inc.
diff --git a/oldXMenu/AddPane.c b/oldXMenu/AddPane.c
index e7246f2..b14b3e8 100644
--- a/oldXMenu/AddPane.c
+++ b/oldXMenu/AddPane.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
* XMenu: MIT Project Athena, X Window system menu package
diff --git a/oldXMenu/AddSel.c b/oldXMenu/AddSel.c
index 2a52a6a..9596cae 100644
--- a/oldXMenu/AddSel.c
+++ b/oldXMenu/AddSel.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/ChgPane.c b/oldXMenu/ChgPane.c
index 733f659..c9c4a5e 100644
--- a/oldXMenu/ChgPane.c
+++ b/oldXMenu/ChgPane.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/ChgSel.c b/oldXMenu/ChgSel.c
index 5a46b5c..c26781b 100644
--- a/oldXMenu/ChgSel.c
+++ b/oldXMenu/ChgSel.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/Create.c b/oldXMenu/Create.c
index e209bbe..2077a71 100644
--- a/oldXMenu/Create.c
+++ b/oldXMenu/Create.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
diff --git a/oldXMenu/DelPane.c b/oldXMenu/DelPane.c
index 10234e0..37a2095 100644
--- a/oldXMenu/DelPane.c
+++ b/oldXMenu/DelPane.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/DelSel.c b/oldXMenu/DelSel.c
index ca2ea28..47cc168 100644
--- a/oldXMenu/DelSel.c
+++ b/oldXMenu/DelSel.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/Destroy.c b/oldXMenu/Destroy.c
index 7f0f614..fdaa69b 100644
--- a/oldXMenu/Destroy.c
+++ b/oldXMenu/Destroy.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/Error.c b/oldXMenu/Error.c
index 0173845..b49e172 100644
--- a/oldXMenu/Error.c
+++ b/oldXMenu/Error.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/EvHand.c b/oldXMenu/EvHand.c
index bd15359..94789c2 100644
--- a/oldXMenu/EvHand.c
+++ b/oldXMenu/EvHand.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/FindPane.c b/oldXMenu/FindPane.c
index 8101d00..3e76321 100644
--- a/oldXMenu/FindPane.c
+++ b/oldXMenu/FindPane.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/FindSel.c b/oldXMenu/FindSel.c
index e2a5dbb..53d1405 100644
--- a/oldXMenu/FindSel.c
+++ b/oldXMenu/FindSel.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
Copyright (C) 2001-2021 Free Software Foundation, Inc.
diff --git a/oldXMenu/InsPane.c b/oldXMenu/InsPane.c
index da92f49..89253e1 100644
--- a/oldXMenu/InsPane.c
+++ b/oldXMenu/InsPane.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/InsSel.c b/oldXMenu/InsSel.c
index f538043..527a7a0 100644
--- a/oldXMenu/InsSel.c
+++ b/oldXMenu/InsSel.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/Internal.c b/oldXMenu/Internal.c
index 3e97f9a..476336c 100644
--- a/oldXMenu/Internal.c
+++ b/oldXMenu/Internal.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
Copyright (C) 1993, 1996, 2001-2021 Free Software Foundation, Inc.
diff --git a/oldXMenu/Locate.c b/oldXMenu/Locate.c
index 1605b4b..bd12666 100644
--- a/oldXMenu/Locate.c
+++ b/oldXMenu/Locate.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/Post.c b/oldXMenu/Post.c
index e78fedc..5247736 100644
--- a/oldXMenu/Post.c
+++ b/oldXMenu/Post.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/Recomp.c b/oldXMenu/Recomp.c
index 2aec87a..5c129fc 100644
--- a/oldXMenu/Recomp.c
+++ b/oldXMenu/Recomp.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/SetAEQ.c b/oldXMenu/SetAEQ.c
index ee2d64b..57debf0 100644
--- a/oldXMenu/SetAEQ.c
+++ b/oldXMenu/SetAEQ.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/SetFrz.c b/oldXMenu/SetFrz.c
index c8998ee..eb54dd6 100644
--- a/oldXMenu/SetFrz.c
+++ b/oldXMenu/SetFrz.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/SetPane.c b/oldXMenu/SetPane.c
index f29a81c..b43c777 100644
--- a/oldXMenu/SetPane.c
+++ b/oldXMenu/SetPane.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/SetSel.c b/oldXMenu/SetSel.c
index 2f950d4..251b5f9 100644
--- a/oldXMenu/SetSel.c
+++ b/oldXMenu/SetSel.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/XCrAssoc.c b/oldXMenu/XCrAssoc.c
index 7150cbc..e017cbb 100644
--- a/oldXMenu/XCrAssoc.c
+++ b/oldXMenu/XCrAssoc.c
@@ -1,5 +1,23 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
#include <config.h>
diff --git a/oldXMenu/XDelAssoc.c b/oldXMenu/XDelAssoc.c
index ec1d09d..26a635e 100644
--- a/oldXMenu/XDelAssoc.c
+++ b/oldXMenu/XDelAssoc.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
#include "XMenuInt.h"
diff --git a/oldXMenu/XDestAssoc.c b/oldXMenu/XDestAssoc.c
index 94c0454..7306944 100644
--- a/oldXMenu/XDestAssoc.c
+++ b/oldXMenu/XDestAssoc.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
#include "XMenuInt.h"
diff --git a/oldXMenu/XLookAssoc.c b/oldXMenu/XLookAssoc.c
index fad960d..577e63f 100644
--- a/oldXMenu/XLookAssoc.c
+++ b/oldXMenu/XLookAssoc.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
#include <config.h>
#include <X11/Xlib.h>
diff --git a/oldXMenu/XMakeAssoc.c b/oldXMenu/XMakeAssoc.c
index 2530e8e..256d4eb 100644
--- a/oldXMenu/XMakeAssoc.c
+++ b/oldXMenu/XMakeAssoc.c
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
#include "XMenuInt.h"
diff --git a/oldXMenu/XMenu.h b/oldXMenu/XMenu.h
index 8e4292f..50ea683 100644
--- a/oldXMenu/XMenu.h
+++ b/oldXMenu/XMenu.h
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/oldXMenu/XMenuInt.h b/oldXMenu/XMenuInt.h
index 369b8c1..86b8e05 100644
--- a/oldXMenu/XMenuInt.h
+++ b/oldXMenu/XMenuInt.h
@@ -1,6 +1,24 @@
/* Copyright Massachusetts Institute of Technology 1985 */
-#include "copyright.h"
+/*
+
+Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
+
+Permission to use, copy, modify, and distribute this
+software and its documentation for any purpose and without
+fee is hereby granted, provided that the above copyright
+notice appear in all copies and that both that copyright
+notice and this permission notice appear in supporting
+documentation, and that the name of M.I.T. not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+M.I.T. makes no representations about the suitability of
+this software for any purpose. It is provided "as is"
+without express or implied warranty.
+
+*/
+
+
/*
diff --git a/src/Makefile.in b/src/Makefile.in
index 22c7aee..732cd8f 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -326,7 +326,8 @@ GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
LIBGMP = @LIBGMP@
-LIBGCCJIT = @LIBGCCJIT_LIB@
+LIBGCCJIT_LIBS = @LIBGCCJIT_LIBS@
+LIBGCCJIT_CFLAGS = @LIBGCCJIT_CFLAGS@
## dynlib.o if necessary, else empty
DYNLIB_OBJ = @DYNLIB_OBJ@
@@ -367,7 +368,7 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \
-I$(lib) -I$(top_srcdir)/lib \
$(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \
$(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \
- $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \
+ $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(LIBGCCJIT_CFLAGS) $(DBUS_CFLAGS) \
$(XRANDR_CFLAGS) $(XINERAMA_CFLAGS) $(XFIXES_CFLAGS) $(XDBE_CFLAGS) \
$(WEBKIT_CFLAGS) $(LCMS2_CFLAGS) \
$(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
@@ -516,7 +517,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE)
$(LIBIMAGE) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(HARFBUZZ_LIBS) $(LIBOTF_LIBS)
$(M17N_FLT_LIBS) \
$(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \
$(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \
- $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT)
+ $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS)
## FORCE it so that admin/unidata can decide whether this file is
## up-to-date. Although since charprop depends on bootstrap-emacs,
diff --git a/src/alloc.c b/src/alloc.c
index 8edcd06..4ea337d 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -7318,7 +7318,7 @@ Frames, windows, buffers, and subprocesses count as
vectors
make_int (strings_consed));
}
-#ifdef GNU_LINUX
+#if defined GNU_LINUX && defined __GLIBC__
DEFUN ("malloc-info", Fmalloc_info, Smalloc_info, 0, 0, "",
doc: /* Report malloc information to stderr.
This function outputs to stderr an XML-formatted
@@ -7678,7 +7678,7 @@ N should be nonnegative. */);
defsubr (&Sgarbage_collect_maybe);
defsubr (&Smemory_info);
defsubr (&Smemory_use_counts);
-#ifdef GNU_LINUX
+#if defined GNU_LINUX && defined __GLIBC__
defsubr (&Smalloc_info);
#endif
defsubr (&Ssuspicious_object);
diff --git a/src/buffer.c b/src/buffer.c
index b177c5e..4eb7ab6 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1768,6 +1768,7 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
/* Run hooks with the buffer to be killed as the current buffer. */
{
ptrdiff_t count = SPECPDL_INDEX ();
+ bool modified;
record_unwind_protect_excursion ();
set_buffer_internal (b);
@@ -1782,9 +1783,12 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
return unbind_to (count, Qnil);
}
+ /* Is this a modified buffer that's visiting a file? */
+ modified = !NILP (BVAR (b, filename))
+ && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b);
+
/* Query if the buffer is still modified. */
- if (INTERACTIVE && !NILP (BVAR (b, filename))
- && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
+ if (INTERACTIVE && modified)
{
AUTO_STRING (format, "Buffer %s modified; kill anyway? ");
tem = do_yes_or_no_p (CALLN (Fformat, format, BVAR (b, name)));
@@ -1792,6 +1796,23 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
return unbind_to (count, Qnil);
}
+ /* Delete the autosave file, if requested. */
+ if (modified
+ && kill_buffer_delete_auto_save_files
+ && delete_auto_save_files
+ && !NILP (Frecent_auto_save_p ())
+ && STRINGP (BVAR (b, auto_save_file_name))
+ && !NILP (Ffile_exists_p (BVAR (b, auto_save_file_name)))
+ /* If `auto-save-visited-mode' is on, then we're auto-saving
+ to the visited file -- don't delete it.. */
+ && NILP (Fstring_equal (BVAR (b, auto_save_file_name),
+ BVAR (b, filename))))
+ {
+ tem = do_yes_or_no_p (build_string ("Delete auto-save file? "));
+ if (!NILP (tem))
+ call0 (intern ("delete-auto-save-file-if-necessary"));
+ }
+
/* If the hooks have killed the buffer, exit now. */
if (!BUFFER_LIVE_P (b))
return unbind_to (count, Qt);
@@ -1888,24 +1909,6 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
replace_buffer_in_windows_safely (buffer);
Vinhibit_quit = tem;
- /* Delete any auto-save file, if we saved it in this session.
- But not if the buffer is modified. */
- if (STRINGP (BVAR (b, auto_save_file_name))
- && BUF_AUTOSAVE_MODIFF (b) != 0
- && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b)
- && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
- && NILP (Fsymbol_value (intern ("auto-save-visited-file-name"))))
- {
- Lisp_Object delete;
- delete = Fsymbol_value (intern ("delete-auto-save-files"));
- if (! NILP (delete))
- internal_delete_file (BVAR (b, auto_save_file_name));
- }
-
- /* Deleting an auto-save file could have killed our buffer. */
- if (!BUFFER_LIVE_P (b))
- return Qt;
-
if (b->base_buffer)
{
INTERVAL i;
@@ -2995,7 +2998,7 @@ overlays_in (EMACS_INT beg, EMACS_INT end, bool extend,
ptrdiff_t next = ZV;
ptrdiff_t prev = BEGV;
bool inhibit_storing = 0;
- bool end_is_Z = end == Z;
+ bool end_is_Z = end == ZV;
for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
tail; tail = tail->next)
@@ -4268,9 +4271,10 @@ DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2,
0,
doc: /* Return a list of the overlays that overlap the region BEG ...
END.
Overlap means that at least one character is contained within the overlay
and also contained within the specified region.
+
Empty overlays are included in the result if they are located at BEG,
between BEG and END, or at END provided END denotes the position at the
-end of the buffer. */)
+end of the accessible part of the buffer. */)
(Lisp_Object beg, Lisp_Object end)
{
ptrdiff_t len, noverlays;
@@ -5801,7 +5805,10 @@ Note that this is overridden by the variable
`truncate-partial-width-windows' if that variable is non-nil
and this buffer is not full-frame width.
-Minibuffers set this variable to nil. */);
+Minibuffers set this variable to nil.
+
+Don't set this to a non-nil value when `visual-line-mode' is
+turned on, as it could produce confusing results. */);
DEFVAR_PER_BUFFER ("word-wrap", &BVAR (current_buffer, word_wrap), Qnil,
doc: /* Non-nil means to use word-wrapping for
continuation lines.
@@ -6365,6 +6372,18 @@ nil NORECORD argument since it may lead to infinite
recursion. */);
Vbuffer_list_update_hook = Qnil;
DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook");
+ DEFVAR_BOOL ("kill-buffer-delete-auto-save-files",
+ kill_buffer_delete_auto_save_files,
+ doc: /* If non-nil, offer to delete any autosave file when
killing a buffer.
+
+If `delete-auto-save-files' is nil, any autosave deletion is inhibited. */);
+ kill_buffer_delete_auto_save_files = 0;
+
+ DEFVAR_BOOL ("delete-auto-save-files", delete_auto_save_files,
+ doc: /* Non-nil means delete auto-save file when a buffer is
saved.
+This is the default. If nil, auto-save file deletion is inhibited. */);
+ delete_auto_save_files = 1;
+
defsubr (&Sbuffer_live_p);
defsubr (&Sbuffer_list);
defsubr (&Sget_buffer);
diff --git a/src/callint.c b/src/callint.c
index 6f8a7f1..44dae36 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -606,7 +606,7 @@ invoke it (via an `interactive' spec that contains, for
instance, an
break;
case 'e': /* The invoking event. */
- if (next_event >= key_count)
+ if (!inhibit_mouse_event_check && next_event >= key_count)
error ("%s must be bound to an event with parameters",
(SYMBOLP (function)
? SSDATA (SYMBOL_NAME (function))
@@ -900,6 +900,14 @@ Its purpose is to give temporary modes such as Isearch mode
a way to turn themselves off when a mouse command switches windows. */);
Vmouse_leave_buffer_hook = Qnil;
+ DEFVAR_BOOL ("inhibit-mouse-event-check", inhibit_mouse_event_check,
+ doc: /* Whether the interactive spec "e" requires a mouse gesture event.
+If non-nil, `(interactive "e")' doesn't signal an error when the command
+was invoked by an input event that is not a mouse gesture: a click, a drag,
+etc. To create the event data when the input was some other event,
+use `event-start', `event-end', and `event-click-count'. */);
+ inhibit_mouse_event_check = false;
+
defsubr (&Sinteractive);
defsubr (&Scall_interactively);
defsubr (&Sfuncall_interactively);
diff --git a/src/callproc.c b/src/callproc.c
index 675b78d..fa43f97 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -232,6 +232,8 @@ directory where the process is run (see below). If you
want to make the
input come from an Emacs buffer, use `call-process-region' instead.
Third argument DESTINATION specifies how to handle program's output.
+(\"Output\" here means both standard output and standard error
+output.)
If DESTINATION is a buffer, or t that stands for the current buffer,
it means insert output in that buffer before point.
If DESTINATION is nil, it means discard output; 0 means discard
diff --git a/src/cmds.c b/src/cmds.c
index c8a96d9..00fde0e 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -455,7 +455,7 @@ internal_self_insert (int c, EMACS_INT n)
ptrdiff_t to;
if (INT_ADD_WRAPV (PT, chars_to_delete, &to))
to = PTRDIFF_MAX;
- replace_range (PT, to, string, 1, 1, 1, 0);
+ replace_range (PT, to, string, 1, 1, 1, 0, false);
Fforward_char (make_fixnum (n));
}
else if (n > 1)
diff --git a/src/coding.c b/src/coding.c
index 46e7fca..d027c7d 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -8250,6 +8250,39 @@ decode_coding_object (struct coding_system *coding,
}
+/* Encode the text in the range FROM/FROM_BYTE and TO/TO_BYTE in
+ SRC_OBJECT into DST_OBJECT by coding context CODING.
+
+ SRC_OBJECT is a buffer, a string, or Qnil.
+
+ If it is a buffer, the text is at point of the buffer. FROM and TO
+ are positions in the buffer.
+
+ If it is a string, the text is at the beginning of the string.
+ FROM and TO are indices into the string.
+
+ If it is nil, the text is at coding->source. FROM and TO are
+ indices into coding->source.
+
+ DST_OBJECT is a buffer, Qt, or Qnil.
+
+ If it is a buffer, the encoded text is inserted at point of the
+ buffer. If the buffer is the same as SRC_OBJECT, the source text
+ is replaced with the encoded text.
+
+ If it is Qt, a string is made from the encoded text, and set in
+ CODING->dst_object. However, if CODING->raw_destination is non-zero,
+ the encoded text is instead returned in CODING->destination as a C string,
+ and the caller is responsible for freeing CODING->destination. This
+ feature is meant to be used when the caller doesn't need the result as
+ a Lisp string, and wants to avoid unnecessary consing of large strings.
+
+ If it is Qnil, the encoded text is stored at CODING->destination.
+ The caller must allocate CODING->dst_bytes bytes at
+ CODING->destination by xmalloc. If the encoded text is longer than
+ CODING->dst_bytes, CODING->destination is reallocated by xrealloc
+ (and CODING->dst_bytes is enlarged accordingly). */
+
void
encode_coding_object (struct coding_system *coding,
Lisp_Object src_object,
@@ -8275,11 +8308,14 @@ encode_coding_object (struct coding_system *coding,
attrs = CODING_ID_ATTRS (coding->id);
- if (EQ (src_object, dst_object))
+ bool same_buffer = false;
+ if (EQ (src_object, dst_object) && BUFFERP (src_object))
{
struct Lisp_Marker *tail;
- for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
+ same_buffer = true;
+
+ for (tail = BUF_MARKERS (XBUFFER (src_object)); tail; tail = tail->next)
{
tail->need_adjustment
= tail->charpos == (tail->insertion_type ? from : to);
@@ -8298,7 +8334,7 @@ encode_coding_object (struct coding_system *coding,
else
insert_1_both ((char *) coding->source + from, chars, bytes, 0, 0, 0);
- if (EQ (src_object, dst_object))
+ if (same_buffer)
{
set_buffer_internal (XBUFFER (src_object));
saved_pt = PT, saved_pt_byte = PT_BYTE;
@@ -8329,7 +8365,7 @@ encode_coding_object (struct coding_system *coding,
{
code_conversion_save (0, 0);
set_buffer_internal (XBUFFER (src_object));
- if (EQ (src_object, dst_object))
+ if (same_buffer)
{
saved_pt = PT, saved_pt_byte = PT_BYTE;
coding->src_object = del_range_1 (from, to, 1, 1);
@@ -9476,7 +9512,7 @@ not fully specified.) */)
}
/* Whether STRING only contains chars in the 0..127 range. */
-static bool
+bool
string_ascii_p (Lisp_Object string)
{
ptrdiff_t nbytes = SBYTES (string);
diff --git a/src/comp.c b/src/comp.c
index c380346..7e21331 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -71,6 +71,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#undef gcc_jit_context_new_binary_op
#undef gcc_jit_context_new_call
#undef gcc_jit_context_new_call_through_ptr
+#undef gcc_jit_context_new_cast
#undef gcc_jit_context_new_comparison
#undef gcc_jit_context_new_field
#undef gcc_jit_context_new_function
@@ -176,6 +177,9 @@ DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_call,
DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_call_through_ptr,
(gcc_jit_context *ctxt, gcc_jit_location *loc,
gcc_jit_rvalue *fn_ptr, int numargs, gcc_jit_rvalue **args));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_cast,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ gcc_jit_rvalue *rvalue, gcc_jit_type *type));
DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_comparison,
(gcc_jit_context *ctxt, gcc_jit_location *loc,
enum gcc_jit_comparison op, gcc_jit_rvalue *a, gcc_jit_rvalue
*b));
@@ -288,6 +292,7 @@ init_gccjit_functions (void)
LOAD_DLL_FN (library, gcc_jit_context_new_binary_op);
LOAD_DLL_FN (library, gcc_jit_context_new_call);
LOAD_DLL_FN (library, gcc_jit_context_new_call_through_ptr);
+ LOAD_DLL_FN (library, gcc_jit_context_new_cast);
LOAD_DLL_FN (library, gcc_jit_context_new_comparison);
LOAD_DLL_FN (library, gcc_jit_context_new_field);
LOAD_DLL_FN (library, gcc_jit_context_new_function);
@@ -358,6 +363,7 @@ init_gccjit_functions (void)
#define gcc_jit_context_new_binary_op fn_gcc_jit_context_new_binary_op
#define gcc_jit_context_new_call fn_gcc_jit_context_new_call
#define gcc_jit_context_new_call_through_ptr
fn_gcc_jit_context_new_call_through_ptr
+#define gcc_jit_context_new_cast fn_gcc_jit_context_new_cast
#define gcc_jit_context_new_comparison fn_gcc_jit_context_new_comparison
#define gcc_jit_context_new_field fn_gcc_jit_context_new_field
#define gcc_jit_context_new_function fn_gcc_jit_context_new_function
@@ -499,13 +505,6 @@ static f_reloc_t freloc;
#define NUM_CAST_TYPES 15
-enum cast_kind_of_type
- {
- kind_unsigned,
- kind_signed,
- kind_pointer
- };
-
typedef struct {
EMACS_INT len;
gcc_jit_rvalue *r_val;
@@ -571,14 +570,9 @@ typedef struct {
be used for the scope. */
gcc_jit_type *cast_union_type;
gcc_jit_function *cast_functions_from_to[NUM_CAST_TYPES][NUM_CAST_TYPES];
- /* We add one to make space for the last member which is the "biggest_type"
- member. */
- gcc_jit_type *cast_types[NUM_CAST_TYPES + 1];
- size_t cast_type_sizes[NUM_CAST_TYPES + 1];
- enum cast_kind_of_type cast_type_kind[NUM_CAST_TYPES + 1];
- const char *cast_type_names[NUM_CAST_TYPES + 1];
- gcc_jit_field *cast_union_fields[NUM_CAST_TYPES + 1];
- size_t cast_union_field_biggest_type;
+ gcc_jit_function *cast_ptr_to_int;
+ gcc_jit_function *cast_int_to_ptr;
+ gcc_jit_type *cast_types[NUM_CAST_TYPES];
gcc_jit_function *func; /* Current function being compiled. */
bool func_has_non_local; /* From comp-func has-non-local slot. */
EMACS_INT func_speed; /* From comp-func speed slot. */
@@ -1113,13 +1107,6 @@ emit_coerce (gcc_jit_type *new_type, gcc_jit_rvalue *obj)
int old_index = type_to_cast_index (old_type);
int new_index = type_to_cast_index (new_type);
- if (comp.cast_type_sizes[old_index] < comp.cast_type_sizes[new_index]
- && comp.cast_type_kind[new_index] == kind_signed)
- xsignal3 (Qnative_ice,
- build_string ("FIXME: sign extension not implemented"),
- build_string (comp.cast_type_names[old_index]),
- build_string (comp.cast_type_names[new_index]));
-
/* Lookup the appropriate cast function in the cast matrix. */
return gcc_jit_context_new_call (comp.ctxt,
NULL,
@@ -3111,30 +3098,17 @@ define_thread_state_struct (void)
gcc_jit_type_get_pointer (gcc_jit_struct_as_type (comp.thread_state_s));
}
-struct cast_type
-{
- gcc_jit_type *type;
- const char *name;
- size_t bytes_size;
- enum cast_kind_of_type kind;
-};
-
static gcc_jit_function *
-define_cast_from_to (struct cast_type from, int from_index, struct cast_type
to,
- int to_index)
+define_type_punning (const char *name,
+ gcc_jit_type *from, gcc_jit_field *from_field,
+ gcc_jit_type *to, gcc_jit_field *to_field)
{
- /* FIXME: sign extension not implemented. */
- if (comp.cast_type_sizes[from_index] < comp.cast_type_sizes[to_index]
- && comp.cast_type_kind[to_index] == kind_signed)
- return NULL;
-
- char *name = format_string ("cast_from_%s_to_%s", from.name, to.name);
gcc_jit_param *param = gcc_jit_context_new_param (comp.ctxt, NULL,
- from.type, "arg");
+ from, "arg");
gcc_jit_function *result = gcc_jit_context_new_function (comp.ctxt,
NULL,
GCC_JIT_FUNCTION_INTERNAL,
- to.type,
+ to,
name,
1,
¶m,
@@ -3148,26 +3122,63 @@ define_cast_from_to (struct cast_type from, int
from_index, struct cast_type to,
comp.cast_union_type,
"union_cast");
- /* Zero the union first. */
gcc_jit_block_add_assignment (entry_block, NULL,
gcc_jit_lvalue_access_field (tmp_union, NULL,
- comp.cast_union_fields[NUM_CAST_TYPES]),
- gcc_jit_context_new_rvalue_from_int (
- comp.ctxt,
- comp.cast_types[NUM_CAST_TYPES],
- 0));
-
- gcc_jit_block_add_assignment (entry_block, NULL,
- gcc_jit_lvalue_access_field (tmp_union, NULL,
- comp.cast_union_fields[from_index]),
+ from_field),
gcc_jit_param_as_rvalue (param));
gcc_jit_block_end_with_return (entry_block,
NULL,
gcc_jit_rvalue_access_field (
gcc_jit_lvalue_as_rvalue (tmp_union),
- NULL,
- comp.cast_union_fields[to_index]));
+ NULL, to_field));
+
+ return result;
+}
+
+struct cast_type
+{
+ gcc_jit_type *type;
+ const char *name;
+ bool is_ptr;
+};
+
+static gcc_jit_function *
+define_cast_from_to (struct cast_type from, struct cast_type to)
+{
+ char *name = format_string ("cast_from_%s_to_%s", from.name, to.name);
+ gcc_jit_param *param = gcc_jit_context_new_param (comp.ctxt, NULL,
+ from.type, "arg");
+ gcc_jit_function *result
+ = gcc_jit_context_new_function (comp.ctxt,
+ NULL,
+ GCC_JIT_FUNCTION_INTERNAL,
+ to.type, name,
+ 1, ¶m, 0);
+ DECL_BLOCK (entry_block, result);
+
+ gcc_jit_rvalue *tmp = gcc_jit_param_as_rvalue (param);
+ if (from.is_ptr != to.is_ptr)
+ {
+ if (from.is_ptr)
+ {
+ tmp = gcc_jit_context_new_cast (comp.ctxt, NULL,
+ tmp, comp.void_ptr_type);
+ tmp = gcc_jit_context_new_call (comp.ctxt, NULL,
+ comp.cast_ptr_to_int, 1, &tmp);
+ }
+ else
+ {
+ tmp = gcc_jit_context_new_cast (comp.ctxt, NULL,
+ tmp, comp.uintptr_type);
+ tmp = gcc_jit_context_new_call (comp.ctxt, NULL,
+ comp.cast_int_to_ptr, 1, &tmp);
+ }
+ }
+
+ tmp = gcc_jit_context_new_cast (comp.ctxt, NULL, tmp, to.type);
+
+ gcc_jit_block_end_with_return (entry_block, NULL, tmp);
return result;
}
@@ -3176,69 +3187,58 @@ static void
define_cast_functions (void)
{
struct cast_type cast_types[NUM_CAST_TYPES]
- = { { comp.bool_type, "bool", sizeof (bool), kind_unsigned },
- { comp.char_ptr_type, "char_ptr", sizeof (char *), kind_pointer },
- { comp.int_type, "int", sizeof (int), kind_signed },
- { comp.lisp_cons_ptr_type, "cons_ptr", sizeof (struct Lisp_Cons *),
- kind_pointer },
- { comp.lisp_obj_ptr_type, "lisp_obj_ptr", sizeof (Lisp_Object *),
- kind_pointer },
- { comp.lisp_word_tag_type, "lisp_word_tag", sizeof (Lisp_Word_tag),
- kind_unsigned },
- { comp.lisp_word_type, "lisp_word", sizeof (Lisp_Word),
- LISP_WORDS_ARE_POINTERS ? kind_pointer : kind_signed },
- { comp.long_long_type, "long_long", sizeof (long long), kind_signed },
- { comp.long_type, "long", sizeof (long), kind_signed },
- { comp.ptrdiff_type, "ptrdiff", sizeof (ptrdiff_t), kind_signed },
- { comp.uintptr_type, "uintptr", sizeof (uintptr_t), kind_unsigned },
- { comp.unsigned_long_long_type, "unsigned_long_long",
- sizeof (unsigned long long), kind_unsigned },
- { comp.unsigned_long_type, "unsigned_long", sizeof (unsigned long),
- kind_unsigned },
- { comp.unsigned_type, "unsigned", sizeof (unsigned), kind_unsigned },
- { comp.void_ptr_type, "void_ptr", sizeof (void*), kind_pointer } };
-
- /* Find the biggest size. It should be unsigned long long, but to be
- sure we find it programmatically. */
- size_t biggest_size = 0;
- for (int i = 0; i < NUM_CAST_TYPES; ++i)
- biggest_size = max (biggest_size, cast_types[i].bytes_size);
+ = { { comp.bool_type, "bool", false },
+ { comp.char_ptr_type, "char_ptr", true },
+ { comp.int_type, "int", false },
+ { comp.lisp_cons_ptr_type, "lisp_cons_ptr", true },
+ { comp.lisp_obj_ptr_type, "lisp_obj_ptr", true },
+ { comp.lisp_word_tag_type, "lisp_word_tag", false },
+ { comp.lisp_word_type, "lisp_word", LISP_WORDS_ARE_POINTERS },
+ { comp.long_long_type, "long_long", false },
+ { comp.long_type, "long", false },
+ { comp.ptrdiff_type, "ptrdiff", false },
+ { comp.uintptr_type, "uintptr", false },
+ { comp.unsigned_long_long_type, "unsigned_long_long", false },
+ { comp.unsigned_long_type, "unsigned_long", false },
+ { comp.unsigned_type, "unsigned", false },
+ { comp.void_ptr_type, "void_ptr", true } };
+ gcc_jit_field *cast_union_fields[2];
+
+ /* Define the union used for type punning. */
+ cast_union_fields[0] = gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ comp.void_ptr_type,
+ "void_ptr");
+ cast_union_fields[1] = gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ comp.uintptr_type,
+ "uintptr");
- /* Define the union used for casting. */
- for (int i = 0; i < NUM_CAST_TYPES; ++i)
- {
- comp.cast_types[i] = cast_types[i].type;
- comp.cast_union_fields[i] = gcc_jit_context_new_field (comp.ctxt,
- NULL,
- cast_types[i].type,
- cast_types[i].name);
- comp.cast_type_names[i] = cast_types[i].name;
- comp.cast_type_sizes[i] = cast_types[i].bytes_size;
- comp.cast_type_kind[i] = cast_types[i].kind;
- }
+ comp.cast_union_type
+ = gcc_jit_context_new_union_type (comp.ctxt,
+ NULL,
+ "cast_union",
+ 2, cast_union_fields);
+
+ comp.cast_ptr_to_int = define_type_punning ("cast_pointer_to_uintptr_t",
+ comp.void_ptr_type,
+ cast_union_fields[0],
+ comp.uintptr_type,
+ cast_union_fields[1]);
+ comp.cast_int_to_ptr = define_type_punning ("cast_uintptr_t_to_pointer",
+ comp.uintptr_type,
+ cast_union_fields[1],
+ comp.void_ptr_type,
+ cast_union_fields[0]);
- gcc_jit_type *biggest_type = gcc_jit_context_get_int_type (comp.ctxt,
- biggest_size,
- false);
- comp.cast_types[NUM_CAST_TYPES] = biggest_type;
- comp.cast_union_fields[NUM_CAST_TYPES] =
- gcc_jit_context_new_field (comp.ctxt, NULL, biggest_type, "biggest_type");
- comp.cast_type_names[NUM_CAST_TYPES] = "biggest_type";
- comp.cast_type_sizes[NUM_CAST_TYPES] = biggest_size;
- comp.cast_type_kind[NUM_CAST_TYPES] = kind_unsigned;
-
- comp.cast_union_type =
- gcc_jit_context_new_union_type (comp.ctxt,
- NULL,
- "cast_union",
- NUM_CAST_TYPES + 1,
- comp.cast_union_fields);
+ for (int i = 0; i < NUM_CAST_TYPES; ++i)
+ comp.cast_types[i] = cast_types[i].type;
/* Define the cast functions using a matrix. */
for (int i = 0; i < NUM_CAST_TYPES; ++i)
for (int j = 0; j < NUM_CAST_TYPES; ++j)
comp.cast_functions_from_to[i][j] =
- define_cast_from_to (cast_types[i], i, cast_types[j], j);
+ define_cast_from_to (cast_types[i], cast_types[j]);
}
static void
@@ -4490,6 +4490,15 @@ DEFUN ("comp--compile-ctxt-to-file",
Fcomp__compile_ctxt_to_file,
GCC_JIT_INT_OPTION_OPTIMIZATION_LEVEL,
comp.speed < 0 ? 0
: (comp.speed > 3 ? 3 : comp.speed));
+
+ /* On MacOS set a unique dylib ID. */
+#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) \
+ && defined (DARWIN_OS)
+ gcc_jit_context_add_driver_option (comp.ctxt, "-install_name");
+ gcc_jit_context_add_driver_option (
+ comp.ctxt, SSDATA (Ffile_name_nondirectory (filename)));
+#endif
+
comp.d_default_idx =
CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-default, Vcomp_ctxt));
comp.d_impure_idx =
diff --git a/src/composite.c b/src/composite.c
index 129e9d6..e97f8e2 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -961,6 +961,23 @@ char_composable_p (int c)
&& (XFIXNUM (val) <= UNICODE_CATEGORY_Zs))))));
}
+static inline bool
+inhibit_auto_composition (void)
+{
+ if (NILP (Vauto_composition_mode))
+ return true;
+
+ if (STRINGP (Vauto_composition_mode))
+ {
+ char *name = tty_type_name (Qnil);
+
+ if (name && ! strcmp (SSDATA (Vauto_composition_mode), name))
+ return true;
+ }
+
+ return false;
+}
+
/* Update cmp_it->stop_pos to the next position after CHARPOS (and
BYTEPOS) where character composition may happen. If BYTEPOS is
negative, compute it. ENDPOS is a limit of searching. If it is
@@ -1015,7 +1032,7 @@ composition_compute_stop_pos (struct composition_it
*cmp_it, ptrdiff_t charpos,
cmp_it->ch = -1;
}
if (NILP (BVAR (current_buffer, enable_multibyte_characters))
- || NILP (Vauto_composition_mode))
+ || inhibit_auto_composition ())
return;
if (bytepos < 0)
{
@@ -1741,7 +1758,7 @@ composition_adjust_point (ptrdiff_t last_pt, ptrdiff_t
new_pt)
}
if (NILP (BVAR (current_buffer, enable_multibyte_characters))
- || NILP (Vauto_composition_mode))
+ || inhibit_auto_composition ())
return new_pt;
/* Next check the automatic composition. */
@@ -1941,7 +1958,7 @@ See `find-composition' for more details. */)
if (!find_composition (from, to, &start, &end, &prop, string))
{
if (!NILP (BVAR (current_buffer, enable_multibyte_characters))
- && ! NILP (Vauto_composition_mode)
+ && ! inhibit_auto_composition ()
&& find_automatic_composition (from, to, (ptrdiff_t) -1,
&start, &end, &gstring, string))
return list3 (make_fixnum (start), make_fixnum (end), gstring);
@@ -2040,7 +2057,10 @@ The default value is the function `compose-chars-after'.
*/);
DEFVAR_LISP ("auto-composition-mode", Vauto_composition_mode,
doc: /* Non-nil if Auto-Composition mode is enabled.
-Use the command `auto-composition-mode' to change this variable. */);
+Use the command `auto-composition-mode' to change this variable.
+
+If this variable is a string, `auto-composition-mode' will be disabled in
+buffers displayed on a terminal whose type compares equal to this string. */);
Vauto_composition_mode = Qt;
DEFVAR_LISP ("auto-composition-function", Vauto_composition_function,
diff --git a/src/data.c b/src/data.c
index ffca7e7..27b642d 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1045,6 +1045,8 @@ The value, if non-nil, is a list of mode name symbols.
*/)
if (COMPILEDP (fun))
{
+ if (PVSIZE (fun) <= COMPILED_INTERACTIVE)
+ return Qnil;
Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE);
if (VECTORP (form))
/* New form -- the second element is the command modes. */
diff --git a/src/editfns.c b/src/editfns.c
index 8ab17eb..c8219de 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2371,7 +2371,7 @@ Both characters must have the same length of multi-byte
form. */)
/* replace_range is less efficient, because it moves the gap,
but it handles combining correctly. */
replace_range (pos, pos + 1, string,
- false, false, true, false);
+ false, false, true, false, false);
pos_byte_next = CHAR_TO_BYTE (pos);
if (pos_byte_next > pos_byte)
/* Before combining happened. We should not increment
@@ -2578,7 +2578,7 @@ It returns the number of characters changed. */)
but it should handle multibyte characters correctly. */
string = make_multibyte_string ((char *) str, 1, str_len);
replace_range (pos, pos + 1, string,
- true, false, true, false);
+ true, false, true, false, false);
len = str_len;
}
else
@@ -2613,7 +2613,8 @@ It returns the number of characters changed. */)
= (VECTORP (val)
? Fconcat (1, &val)
: Fmake_string (make_fixnum (1), val, Qnil));
- replace_range (pos, pos + len, string, true, false, true, false);
+ replace_range (pos, pos + len, string, true, false, true, false,
+ false);
pos_byte += SBYTES (string);
pos += SCHARS (string);
characters_changed += SCHARS (string);
diff --git a/src/fileio.c b/src/fileio.c
index 04c9d7d..0db8ed7 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -749,6 +749,114 @@ For that reason, you should normally use `make-temp-file'
instead. */)
empty_unibyte_string, Qnil);
}
+DEFUN ("file-name-concat", Ffile_name_concat, Sfile_name_concat, 1, MANY, 0,
+ doc: /* Append COMPONENTS to DIRECTORY and return the resulting string.
+Elements in COMPONENTS must be a string or nil.
+DIRECTORY or the non-final elements in COMPONENTS may or may not end
+with a slash -- if they don't end with a slash, a slash will be
+inserted before contatenating.
+usage: (record DIRECTORY &rest COMPONENTS) */)
+ (ptrdiff_t nargs, Lisp_Object *args)
+{
+ ptrdiff_t chars = 0, bytes = 0, multibytes = 0, eargs = 0;
+ Lisp_Object *elements = args;
+ Lisp_Object result;
+ ptrdiff_t i;
+
+ /* First go through the list to check the types and see whether
+ they're all of the same multibytedness. */
+ for (i = 0; i < nargs; i++)
+ {
+ Lisp_Object arg = args[i];
+ /* Skip empty and nil elements. */
+ if (NILP (arg))
+ continue;
+ CHECK_STRING (arg);
+ if (SCHARS (arg) == 0)
+ continue;
+ eargs++;
+ /* Multibyte and non-ASCII. */
+ if (STRING_MULTIBYTE (arg) && SCHARS (arg) != SBYTES (arg))
+ multibytes++;
+ /* We're not adding a slash to the final part. */
+ if (i == nargs - 1
+ || IS_DIRECTORY_SEP (*(SSDATA (arg) + SBYTES (arg) - 1)))
+ {
+ bytes += SBYTES (arg);
+ chars += SCHARS (arg);
+ }
+ else
+ {
+ bytes += SBYTES (arg) + 1;
+ chars += SCHARS (arg) + 1;
+ }
+ }
+
+ /* Convert if needed. */
+ if ((multibytes != 0 && multibytes != nargs)
+ || eargs != nargs)
+ {
+ int j = 0;
+ elements = xmalloc (eargs * sizeof *elements);
+ bytes = 0;
+ chars = 0;
+
+ /* Filter out nil/"". */
+ for (i = 0; i < nargs; i++)
+ {
+ Lisp_Object arg = args[i];
+ if (!NILP (arg) && SCHARS (arg) != 0)
+ elements[j++] = arg;
+ }
+
+ for (i = 0; i < eargs; i++)
+ {
+ Lisp_Object arg = elements[i];
+ /* Use multibyte or all-ASCII strings as is. */
+ if (!STRING_MULTIBYTE (arg) && !string_ascii_p (arg))
+ elements[i] = Fstring_to_multibyte (arg);
+ arg = elements[i];
+ /* We have to recompute the number of bytes. */
+ if (i == eargs - 1
+ || IS_DIRECTORY_SEP (*(SSDATA (arg) + SBYTES (arg) - 1)))
+ {
+ bytes += SBYTES (arg);
+ chars += SCHARS (arg);
+ }
+ else
+ {
+ bytes += SBYTES (arg) + 1;
+ chars += SCHARS (arg) + 1;
+ }
+ }
+ }
+
+ /* Allocate an empty string. */
+ if (multibytes == 0)
+ result = make_uninit_string (chars);
+ else
+ result = make_uninit_multibyte_string (chars, bytes);
+ /* Null-terminate the string. */
+ *(SSDATA (result) + SBYTES (result)) = 0;
+
+ /* Copy over the data. */
+ char *p = SSDATA (result);
+ for (i = 0; i < eargs; i++)
+ {
+ Lisp_Object arg = elements[i];
+ memcpy (p, SSDATA (arg), SBYTES (arg));
+ p += SBYTES (arg);
+ /* The last element shouldn't have a slash added at the end. */
+ if (i < eargs - 1 && !IS_DIRECTORY_SEP (*(p - 1)))
+ *p++ = DIRECTORY_SEP;
+ }
+
+ if (elements != args)
+ xfree (elements);
+
+ return result;
+}
+
/* NAME must be a string. */
static bool
file_name_absolute_no_tilde_p (Lisp_Object name)
@@ -1199,6 +1307,8 @@ the root directory. */)
newdir = SSDATA (hdir);
newdirlim = newdir + SBYTES (hdir);
}
+ else if (!multibyte && STRING_MULTIBYTE (tem))
+ multibyte = 1;
#ifdef DOS_NT
collapse_newdir = false;
#endif
@@ -6488,6 +6598,7 @@ This includes interactive calls to `delete-file' and
defsubr (&Sdirectory_file_name);
defsubr (&Smake_temp_file_internal);
defsubr (&Smake_temp_name);
+ defsubr (&Sfile_name_concat);
defsubr (&Sexpand_file_name);
defsubr (&Ssubstitute_in_file_name);
defsubr (&Scopy_file);
diff --git a/src/fns.c b/src/fns.c
index 7b9e3b0..c39fce2 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1174,7 +1174,7 @@ string_make_multibyte (Lisp_Object string)
/* Convert STRING (if unibyte) to a multibyte string without changing
- the number of characters. Characters 0200 trough 0237 are
+ the number of characters. Characters 0200 through 0237 are
converted to eight-bit characters. */
Lisp_Object
@@ -1755,7 +1755,8 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 3, 0,
doc: /* Return non-nil if KEY is equal to the car of an element of
ALIST.
The value is actually the first element of ALIST whose car equals KEY.
-Equality is defined by TESTFN if non-nil or by `equal' if nil. */)
+Equality is defined by the function TESTFN, defaulting to `equal'.
+TESTFN is called with 2 arguments: a car of an alist element and KEY. */)
(Lisp_Object key, Lisp_Object alist, Lisp_Object testfn)
{
if (eq_comparable_value (key) && NILP (testfn))
@@ -5769,16 +5770,6 @@ characters. */ )
return list3 (make_int (lines), make_int (longest), make_float (mean));
}
-static bool
-string_ascii_p (Lisp_Object string)
-{
- ptrdiff_t nbytes = SBYTES (string);
- for (ptrdiff_t i = 0; i < nbytes; i++)
- if (SREF (string, i) > 127)
- return false;
- return true;
-}
-
DEFUN ("string-search", Fstring_search, Sstring_search, 2, 3, 0,
doc: /* Search for the string NEEDLE in the string HAYSTACK.
The return value is the position of the first occurrence of NEEDLE in
diff --git a/src/font.c b/src/font.c
index 7c1d1ff..e043ef8 100644
--- a/src/font.c
+++ b/src/font.c
@@ -1029,8 +1029,8 @@ font_expand_wildcards (Lisp_Object *field, int n)
X font backend driver, it is a font-entity. In that case, NAME is
a fully specified XLFD. */
-int
-font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font)
+static int
+font_parse_xlfd_1 (char *name, ptrdiff_t len, Lisp_Object font, int segments)
{
int i, j, n;
char *f[XLFD_LAST_INDEX + 1];
@@ -1040,17 +1040,27 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object
font)
if (len > 255 || !len)
/* Maximum XLFD name length is 255. */
return -1;
+
/* Accept "*-.." as a fully specified XLFD. */
if (name[0] == '*' && (len == 1 || name[1] == '-'))
i = 1, f[XLFD_FOUNDRY_INDEX] = name;
else
i = 0;
+
+ /* Split into segments. */
for (p = name + i; *p; p++)
if (*p == '-')
{
- f[i++] = p + 1;
- if (i == XLFD_LAST_INDEX)
- break;
+ /* If we have too many segments, then gather them up into the
+ FAMILY part of the name. This allows using fonts with
+ dashes in the FAMILY bit. */
+ if (segments > XLFD_LAST_INDEX && i == XLFD_WEIGHT_INDEX)
+ segments--;
+ else {
+ f[i++] = p + 1;
+ if (i == XLFD_LAST_INDEX)
+ break;
+ }
}
f[i] = name + len;
@@ -1215,6 +1225,28 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object
font)
return 0;
}
+int
+font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font)
+{
+ int found = font_parse_xlfd_1 (name, len, font, -1);
+ if (found > -1)
+ return found;
+
+ int segments = 0;
+ /* Count how many segments we have. */
+ for (char *p = name; *p; p++)
+ if (*p == '-')
+ segments++;
+
+ /* If we have a surplus of segments, then we try to parse again, in
+ case there's a font with dashes in the family name. */
+ if (segments > XLFD_LAST_INDEX)
+ return font_parse_xlfd_1 (name, len, font, segments);
+ else
+ return -1;
+}
+
+
/* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
length), and return the name length. If FONT_SIZE_INDEX of FONT is
0, use PIXEL_SIZE instead. */
diff --git a/src/fontset.c b/src/fontset.c
index 332be6c..7d4bd65 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1361,7 +1361,11 @@ check_fontset_name (Lisp_Object name, Lisp_Object *frame)
if (EQ (name, Qt))
return Vdefault_fontset;
if (NILP (name))
- id = FRAME_FONTSET (f);
+ {
+ if (!FRAME_WINDOW_P (f))
+ error ("Can't use fontsets in non-GUI frames");
+ id = FRAME_FONTSET (f);
+ }
else
{
CHECK_STRING (name);
diff --git a/src/frame.c b/src/frame.c
index b105268..f955668 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -729,7 +729,7 @@ adjust_frame_size (struct frame *f, int new_text_width, int
new_text_height,
&& (f->new_width >= 0 || f->new_height >= 0))
/* For implied resizes with inhibit 2 (external menu and tool
bar) pick up any new sizes the display engine has not
- processed yet. Otherwsie, we would request the old sizes
+ processed yet. Otherwise, we would request the old sizes
which will make this request appear as a request to set new
sizes and have the WM react accordingly which is not TRT.
@@ -1406,11 +1406,6 @@ affects all frames on the same terminal device. */)
(t->display_info.tty->name
? build_string (t->display_info.tty->name)
: Qnil));
- /* On terminal frames the `minibuffer' frame parameter is always
- virtually t. Avoid that a different value in parms causes
- complaints, see Bug#24758. */
- store_in_alist (&parms, Qminibuffer, Qt);
- Fmodify_frame_parameters (frame, parms);
/* Make the frame face hash be frame-specific, so that each
frame could change its face definitions independently. */
@@ -1423,6 +1418,12 @@ affects all frames on the same terminal device. */)
for (idx = 0; idx < table->count; ++idx)
set_hash_value_slot (table, idx, Fcopy_sequence (HASH_VALUE (table, idx)));
+ /* On terminal frames the `minibuffer' frame parameter is always
+ virtually t. Avoid that a different value in parms causes
+ complaints, see Bug#24758. */
+ store_in_alist (&parms, Qminibuffer, Qt);
+ Fmodify_frame_parameters (frame, parms);
+
f->can_set_window_size = true;
f->after_make_frame = true;
@@ -1837,15 +1838,20 @@ prev_frame (Lisp_Object frame, Lisp_Object minibuf)
DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
doc: /* Return the next frame in the frame list after FRAME.
-It considers only frames on the same terminal as FRAME.
-By default, skip minibuffer-only frames.
-If omitted, FRAME defaults to the selected frame.
-If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
-If MINIFRAME is a window, include only its own frame
-and any frame now using that window as the minibuffer.
-If MINIFRAME is `visible', include all visible frames.
-If MINIFRAME is 0, include all visible and iconified frames.
-Otherwise, include all frames. */)
+Only frames on the same terminal as FRAME are included in the list
+of candidate frames. If omitted, FRAME defaults to the selected frame.
+
+If MINIFRAME is nil (the default), include all frames except
+minibuffer-only frames.
+
+If MINIFRAME is a window, include only its own frame and any frame now
+using that window as the minibuffer.
+
+If MINIFRAME is `visible', include only visible frames.
+
+If MINIFRAME is 0, include only visible and iconified frames.
+
+If MINIFRAME is any other value, include all frames. */)
(Lisp_Object frame, Lisp_Object miniframe)
{
if (NILP (frame))
diff --git a/src/fringe.c b/src/fringe.c
index 47615f5..b651a4e 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -969,6 +969,14 @@ update_window_fringes (struct window *w, bool
keep_current_p)
if (w->pseudo_window_p)
return 0;
+ ptrdiff_t count = SPECPDL_INDEX ();
+
+ /* This function could be called for redisplaying non-selected
+ windows, in which case point has been temporarily moved to that
+ window's window-point. So we cannot afford quitting out of here,
+ as point is restored after this function returns. */
+ specbind (Qinhibit_quit, Qt);
+
if (!MINI_WINDOW_P (w)
&& (ind = BVAR (XBUFFER (w->contents), indicate_buffer_boundaries),
!NILP (ind)))
{
@@ -1331,6 +1339,8 @@ update_window_fringes (struct window *w, bool
keep_current_p)
row->fringe_bitmap_periodic_p = periodic_p;
}
+ unbind_to (count, Qnil);
+
return redraw_p && !keep_current_p;
}
diff --git a/src/image.c b/src/image.c
index bcd45eb..206c7ba 100644
--- a/src/image.c
+++ b/src/image.c
@@ -10039,7 +10039,7 @@ svg_load_image (struct frame *f, struct image *img,
char *contents,
#if LIBRSVG_CHECK_VERSION (2, 46, 0)
RsvgRectangle zero_rect, viewbox, out_logical_rect;
- /* Try the instrinsic dimensions first. */
+ /* Try the intrinsic dimensions first. */
gboolean has_width, has_height, has_viewbox;
RsvgLength iwidth, iheight;
double dpi = FRAME_DISPLAY_INFO (f)->resx;
@@ -10074,7 +10074,7 @@ svg_load_image (struct frame *f, struct image *img,
char *contents,
}
else
{
- /* We haven't found a useable set of sizes, so try working out
+ /* We haven't found a usable set of sizes, so try working out
the visible area. */
rsvg_handle_get_geometry_for_layer (rsvg_handle, NULL,
&zero_rect, &viewbox,
diff --git a/src/insdel.c b/src/insdel.c
index e66120e..40674e1 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -1392,7 +1392,7 @@ adjust_after_insert (ptrdiff_t from, ptrdiff_t from_byte,
void
replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
bool prepare, bool inherit, bool markers,
- bool adjust_match_data)
+ bool adjust_match_data, bool inhibit_mod_hooks)
{
ptrdiff_t inschars = SCHARS (new);
ptrdiff_t insbytes = SBYTES (new);
@@ -1552,8 +1552,11 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object
new,
if (adjust_match_data)
update_search_regs (from, to, from + SCHARS (new));
- signal_after_change (from, nchars_del, GPT - from);
- update_compositions (from, GPT, CHECK_BORDER);
+ if (!inhibit_mod_hooks)
+ {
+ signal_after_change (from, nchars_del, GPT - from);
+ update_compositions (from, GPT, CHECK_BORDER);
+ }
}
/* Replace the text from character positions FROM to TO with
diff --git a/src/keyboard.c b/src/keyboard.c
index 820229c..f6139b3 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -924,6 +924,7 @@ static Lisp_Object
cmd_error (Lisp_Object data)
{
Lisp_Object old_level, old_length;
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object conditions;
char macroerror[sizeof "After..kbd macro iterations: "
+ INT_STRLEN_BOUND (EMACS_INT)];
@@ -951,8 +952,8 @@ cmd_error (Lisp_Object data)
executing_kbd_macro = Qnil;
}
- Vstandard_output = Qt;
- Vstandard_input = Qt;
+ specbind (Qstandard_output, Qt);
+ specbind (Qstandard_input, Qt);
kset_prefix_arg (current_kboard, Qnil);
kset_last_prefix_arg (current_kboard, Qnil);
cancel_echoing ();
@@ -969,6 +970,7 @@ cmd_error (Lisp_Object data)
Vquit_flag = Qnil;
Vinhibit_quit = Qnil;
+ unbind_to (count, Qnil);
return make_fixnum (0);
}
@@ -1007,25 +1009,28 @@ Default value of `command-error-function'. */)
(Lisp_Object data, Lisp_Object context, Lisp_Object signal)
{
struct frame *sf = SELECTED_FRAME ();
- Lisp_Object conditions;
+ Lisp_Object conditions = Fget (XCAR (data), Qerror_conditions);
+ int is_minibuffer_quit = !NILP (Fmemq (Qminibuffer_quit, conditions));
CHECK_STRING (context);
/* If the window system or terminal frame hasn't been initialized
- yet, or we're not interactive, write the message to stderr and exit. */
- if (!sf->glyphs_initialized_p
- /* The initial frame is a special non-displaying frame. It
- will be current in daemon mode when there are no frames
- to display, and in non-daemon mode before the real frame
- has finished initializing. If an error is thrown in the
- latter case while creating the frame, then the frame
- will never be displayed, so the safest thing to do is
- write to stderr and quit. In daemon mode, there are
- many other potential errors that do not prevent frames
- from being created, so continuing as normal is better in
- that case. */
- || (!IS_DAEMON && FRAME_INITIAL_P (sf))
- || noninteractive)
+ yet, or we're not interactive, write the message to stderr and exit.
+ Don't do this for the minibuffer-quit condition. */
+ if (!is_minibuffer_quit
+ && (!sf->glyphs_initialized_p
+ /* The initial frame is a special non-displaying frame. It
+ will be current in daemon mode when there are no frames
+ to display, and in non-daemon mode before the real frame
+ has finished initializing. If an error is thrown in the
+ latter case while creating the frame, then the frame
+ will never be displayed, so the safest thing to do is
+ write to stderr and quit. In daemon mode, there are
+ many other potential errors that do not prevent frames
+ from being created, so continuing as normal is better in
+ that case. */
+ || (!IS_DAEMON && FRAME_INITIAL_P (sf))
+ || noninteractive))
{
print_error_message (data, Qexternal_debugging_output,
SSDATA (context), signal);
@@ -1034,12 +1039,10 @@ Default value of `command-error-function'. */)
}
else
{
- conditions = Fget (XCAR (data), Qerror_conditions);
-
clear_message (1, 0);
message_log_maybe_newline ();
- if (!NILP (Fmemq (Qminibuffer_quit, conditions)))
+ if (is_minibuffer_quit)
{
Fding (Qt);
}
@@ -4232,7 +4235,7 @@ decode_timer (Lisp_Object timer, struct timespec *result)
{
Lisp_Object *vec;
- if (! (VECTORP (timer) && ASIZE (timer) == 9))
+ if (! (VECTORP (timer) && ASIZE (timer) == 10))
return false;
vec = XVECTOR (timer)->contents;
if (! NILP (vec[0]))
@@ -9185,8 +9188,7 @@ access_keymap_keyremap (Lisp_Object map, Lisp_Object key,
Lisp_Object prompt,
/* If the function returned something invalid,
barf--don't ignore it. */
if (! (NILP (next) || VECTORP (next) || STRINGP (next)))
- error ("Function %s returns invalid key sequence",
- SSDATA (SYMBOL_NAME (tem)));
+ signal_error ("Function returns invalid key sequence", tem);
}
return next;
}
diff --git a/src/lisp.h b/src/lisp.h
index 80efd77..7bfc69b 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3586,6 +3586,7 @@ extern Lisp_Object detect_coding_system (const unsigned
char *, ptrdiff_t,
extern void init_coding (void);
extern void init_coding_once (void);
extern void syms_of_coding (void);
+extern bool string_ascii_p (Lisp_Object);
/* Defined in character.c. */
extern ptrdiff_t chars_in_text (const unsigned char *, ptrdiff_t);
@@ -3716,7 +3717,8 @@ extern void adjust_markers_for_delete (ptrdiff_t,
ptrdiff_t,
ptrdiff_t, ptrdiff_t);
extern void adjust_markers_bytepos (ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t, int);
-extern void replace_range (ptrdiff_t, ptrdiff_t, Lisp_Object, bool, bool,
bool, bool);
+extern void replace_range (ptrdiff_t, ptrdiff_t, Lisp_Object, bool, bool,
+ bool, bool, bool);
extern void replace_range_2 (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
const char *, ptrdiff_t, ptrdiff_t, bool);
extern void syms_of_insdel (void);
@@ -4650,6 +4652,7 @@ extern AVOID fatal (const char *msgid, ...)
ATTRIBUTE_FORMAT_PRINTF (1, 2);
/* Defined in terminal.c. */
extern void syms_of_terminal (void);
+extern char * tty_type_name (Lisp_Object);
/* Defined in font.c. */
extern void syms_of_font (void);
diff --git a/src/menu.c b/src/menu.c
index 3b1d740..d43360e 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -1284,12 +1284,16 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu)
/* Search for a string appearing directly as an element of the keymap.
That string is the title of the menu. */
prompt = Fkeymap_prompt (keymap);
- if (!NILP (prompt))
- title = prompt;
-#ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
+
+#if defined (USE_GTK) || defined (HAVE_NS)
+ if (STRINGP (prompt)
+ && SCHARS (prompt) > 0
+ && !NILP (Fget_text_property (make_fixnum (0), Qhide, prompt)))
+ title = Qnil;
else
- title = build_string ("Select");
#endif
+ if (!NILP (prompt))
+ title = prompt;
/* Make that be the pane title of the first pane. */
if (!NILP (prompt) && menu_items_n_panes >= 0)
@@ -1575,6 +1579,8 @@ syms_of_menu (void)
menu_items = Qnil;
staticpro (&menu_items);
+ DEFSYM (Qhide, "hide");
+
defsubr (&Sx_popup_menu);
defsubr (&Sx_popup_dialog);
defsubr (&Smenu_bar_menu_at_x_y);
diff --git a/src/minibuf.c b/src/minibuf.c
index 0f4349e..c9134ef 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -689,12 +689,15 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
call1 (Qpush_window_buffer_onto_prev, minibuf_window);
record_unwind_protect_void (minibuffer_unwind);
- record_unwind_protect (restore_window_configuration,
- list3 (Fcurrent_window_configuration (Qnil), Qt, Qt));
+ if (read_minibuffer_restore_windows)
+ record_unwind_protect (restore_window_configuration,
+ list3 (Fcurrent_window_configuration (Qnil),
+ Qt, Qt));
/* If the minibuffer window is on a different frame, save that
frame's configuration too. */
- if (!EQ (mini_frame, selected_frame))
+ if (read_minibuffer_restore_windows &&
+ !EQ (mini_frame, selected_frame))
record_unwind_protect (restore_window_configuration,
list3 (Fcurrent_window_configuration (mini_frame),
Qnil, Qt));
@@ -2527,6 +2530,19 @@ for instance when running a headless Emacs server.
Functions like
instead. */);
inhibit_interaction = 0;
+ DEFVAR_BOOL ("read-minibuffer-restore-windows",
read_minibuffer_restore_windows,
+ doc: /* Non-nil means restore window configurations on exit from
minibuffer.
+If this is non-nil (the default), reading input with the minibuffer will
+restore, on exit, the window configurations of the frame where the
+minibuffer was entered from and, if it is different, the frame that owns
+the associated minibuffer window.
+
+If this is nil, window configurations are not restored upon exiting
+the minibuffer. However, if `minibuffer-restore-windows' is present
+in `minibuffer-exit-hook', exiting the minibuffer will remove the window
+showing the *Completions* buffer, if any. */);
+ read_minibuffer_restore_windows = true;
+
defsubr (&Sactive_minibuffer_window);
defsubr (&Sset_minibuffer_window);
defsubr (&Sread_from_minibuffer);
diff --git a/src/nsfns.m b/src/nsfns.m
index 454a6fd..07bcab1 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -947,11 +947,7 @@ frame_parm_handler ns_frame_parm_handlers[] =
0, /* x_set_sticky */
0, /* x_set_tool_bar_position */
0, /* x_set_inhibit_double_buffering */
-#ifdef NS_IMPL_COCOA
ns_set_undecorated,
-#else
- 0, /* ns_set_undecorated */
-#endif
ns_set_parent_frame,
0, /* x_set_skip_taskbar */
ns_set_no_focus_on_map,
@@ -1347,6 +1343,11 @@ DEFUN ("x-create-frame", Fx_create_frame,
Sx_create_frame,
f->output_data.ns->in_animation = NO;
+#ifdef NS_IMPL_COCOA
+ /* If the app has previously been disabled, start it up again. */
+ [NSApp setActivationPolicy:NSApplicationActivationPolicyRegular];
+#endif
+
[[EmacsView alloc] initFrameFromEmacs: f];
ns_icon (f, parms);
diff --git a/src/nsimage.m b/src/nsimage.m
index 3c16cd3..dd2bb3b 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -265,16 +265,12 @@ ns_image_size_in_bytes (void *img)
image = [[EmacsImage alloc] initByReferencingFile:filename];
image->bmRep = nil;
-#ifdef NS_IMPL_COCOA
- imgRep = [NSBitmapImageRep imageRepWithData:[image TIFFRepresentation]];
-#else
- imgRep = [image bestRepresentationForDevice: nil];
-#endif
- if (imgRep == nil)
+ if (![image isValid])
{
[image release];
return nil;
}
+ imgRep = [[image representations] firstObject];
[image setSize: NSMakeSize([imgRep pixelsWide], [imgRep pixelsHigh])];
[image setName:filename];
@@ -381,51 +377,10 @@ ns_image_size_in_bytes (void *img)
}
}
- xbm_fg = fg;
[self addRepresentation: bmRep];
return self;
}
-/* Set color for a bitmap image. */
-- (instancetype)setXBMColor: (NSColor *)color
-{
- NSSize s = [self size];
- unsigned char *planes[5];
- EmacsCGFloat r, g, b, a;
- NSColor *rgbColor;
-
- if (bmRep == nil || color == nil)
- return self;
-
- if ([color colorSpace] != [NSColorSpace genericRGBColorSpace])
- rgbColor = [color colorUsingColorSpace:[NSColorSpace
genericRGBColorSpace]];
- else
- rgbColor = color;
-
- [rgbColor getRed: &r green: &g blue: &b alpha: &a];
-
- [bmRep getBitmapDataPlanes: planes];
-
- {
- int i, len = s.width*s.height;
- int rr = r * 0xff, gg = g * 0xff, bb = b * 0xff;
- unsigned char fgr = (xbm_fg >> 16) & 0xff;
- unsigned char fgg = (xbm_fg >> 8) & 0xff;
- unsigned char fgb = xbm_fg & 0xff;
-
- for (i = 0; i < len; ++i)
- if (planes[0][i] == fgr && planes[1][i] == fgg && planes[2][i] == fgb)
- {
- planes[0][i] = rr;
- planes[1][i] = gg;
- planes[2][i] = bb;
- }
- xbm_fg = ((rr << 16) & 0xff0000) + ((gg << 8) & 0xff00) + (bb & 0xff);
- }
-
- return self;
-}
-
- (instancetype)initForXPMWithDepth: (int)depth width: (int)width height:
(int)height
{
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 1b03fe9..3493e4e 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -959,7 +959,7 @@ ns_menu_show (struct frame *f, int x, int y, int menuflags,
}
pmenu = [[EmacsMenu alloc] initWithTitle:
- [NSString stringWithLispString: title]];
+ NILP (title) ? @"" : [NSString stringWithLispString:
title]];
[pmenu fillWithWidgetValue: first_wv->contents];
free_menubar_widget_value_tree (first_wv);
unbind_to (specpdl_count, Qnil);
@@ -991,12 +991,11 @@ free_frame_tool_bar (struct frame *f)
NSTRACE ("free_frame_tool_bar");
block_input ();
- view->wait_for_tool_bar = NO;
/* Note: This triggers an animation, which calls windowDidResize
repeatedly. */
f->output_data.ns->in_animation = 1;
- [[view toolbar] setVisible: NO];
+ [[[view window] toolbar] setVisible: NO];
f->output_data.ns->in_animation = 0;
unblock_input ();
@@ -1009,12 +1008,12 @@ update_frame_tool_bar (struct frame *f)
--------------------------------------------------------------------------
*/
{
int i, k = 0;
- EmacsView *view = FRAME_NS_VIEW (f);
- EmacsToolbar *toolbar = [view toolbar];
+ NSWindow *window = [FRAME_NS_VIEW (f) window];
+ EmacsToolbar *toolbar = (EmacsToolbar *)[window toolbar];
NSTRACE ("update_frame_tool_bar");
- if (view == nil || toolbar == nil) return;
+ if (window == nil || toolbar == nil) return;
block_input ();
#ifdef NS_IMPL_COCOA
@@ -1034,6 +1033,8 @@ update_frame_tool_bar (struct frame *f)
ptrdiff_t img_id;
struct image *img;
Lisp_Object image;
+ Lisp_Object labelObj;
+ const char *labelText;
Lisp_Object helpObj;
const char *helpText;
@@ -1060,6 +1061,8 @@ update_frame_tool_bar (struct frame *f)
{
idx = -1;
}
+ labelObj = TOOLPROP (TOOL_BAR_ITEM_LABEL);
+ labelText = NILP (labelObj) ? "" : SSDATA (labelObj);
helpObj = TOOLPROP (TOOL_BAR_ITEM_HELP);
if (NILP (helpObj))
helpObj = TOOLPROP (TOOL_BAR_ITEM_CAPTION);
@@ -1085,15 +1088,16 @@ update_frame_tool_bar (struct frame *f)
[toolbar addDisplayItemWithImage: img->pixmap
idx: k++
tag: i
+ labelText: labelText
helpText: helpText
enabled: enabled_p];
#undef TOOLPROP
}
- if (![toolbar isVisible])
+ if ([toolbar isVisible] != FRAME_EXTERNAL_TOOL_BAR (f))
{
f->output_data.ns->in_animation = 1;
- [toolbar setVisible: YES];
+ [toolbar setVisible: FRAME_EXTERNAL_TOOL_BAR (f)];
f->output_data.ns->in_animation = 0;
}
@@ -1120,13 +1124,6 @@ update_frame_tool_bar (struct frame *f)
[newDict release];
}
#endif
-
- if (view->wait_for_tool_bar && FRAME_TOOLBAR_HEIGHT (f) > 0)
- {
- view->wait_for_tool_bar = NO;
- [view setNeedsDisplay: YES];
- }
-
unblock_input ();
}
@@ -1196,6 +1193,7 @@ update_frame_tool_bar (struct frame *f)
- (void) addDisplayItemWithImage: (EmacsImage *)img
idx: (int)idx
tag: (int)tag
+ labelText: (const char *)label
helpText: (const char *)help
enabled: (BOOL)enabled
{
@@ -1213,6 +1211,7 @@ update_frame_tool_bar (struct frame *f)
item = [[[NSToolbarItem alloc] initWithItemIdentifier: identifier]
autorelease];
[item setImage: img];
+ [item setLabel: [NSString stringWithUTF8String: label]];
[item setToolTip: [NSString stringWithUTF8String: help]];
[item setTarget: emacsView];
[item setAction: @selector (toolbarClicked:)];
diff --git a/src/nsterm.h b/src/nsterm.h
index b29e76c..6d4ea77 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -348,16 +348,6 @@ typedef id instancetype;
#endif
-/* macOS 10.14 and above cannot draw directly "to the glass" and
- therefore we draw to an offscreen buffer and swap it in when the
- toolkit wants to draw the frame. GNUstep and macOS 10.7 and below
- do not support this method, so we revert to drawing directly to the
- glass. */
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101400
-#define NS_DRAW_TO_BUFFER 1
-#endif
-
-
/* ==========================================================================
NSColor, EmacsColor category.
@@ -416,6 +406,25 @@ typedef id instancetype;
@end
#endif
+/* EmacsWindow */
+@interface EmacsWindow : NSWindow
+{
+ NSPoint grabOffset;
+}
+
+#ifdef NS_IMPL_GNUSTEP
+- (NSInteger) orderedIndex;
+#endif
+
+- (instancetype)initWithEmacsFrame:(struct frame *)f;
+- (instancetype)initWithEmacsFrame:(struct frame *)f
fullscreen:(BOOL)fullscreen screen:(NSScreen *)screen;
+- (void)setParentChildRelationships;
+- (NSInteger)borderWidth;
+- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above;
+- (void)setAppearance;
+@end
+
+
/* ==========================================================================
The main Emacs view
@@ -423,7 +432,7 @@ typedef id instancetype;
==========================================================================
*/
@class EmacsToolbar;
-@class EmacsSurface;
+@class EmacsLayer;
#ifdef NS_IMPL_COCOA
@interface EmacsView : NSView <NSTextInput, NSWindowDelegate>
@@ -439,19 +448,13 @@ typedef id instancetype;
NSString *workingText;
BOOL processingCompose;
int fs_state, fs_before_fs, next_maximized;
- int bwidth;
int maximized_width, maximized_height;
- NSWindow *nonfs_window;
+ EmacsWindow *nonfs_window;
BOOL fs_is_native;
-#ifdef NS_DRAW_TO_BUFFER
- EmacsSurface *surface;
-#endif
@public
struct frame *emacsframe;
int scrollbarsNeedingUpdate;
- EmacsToolbar *toolbar;
NSRect ns_userRect;
- BOOL wait_for_tool_bar;
}
/* AppKit-side interface */
@@ -465,9 +468,7 @@ typedef id instancetype;
/* Emacs-side interface */
- (instancetype) initFrameFromEmacs: (struct frame *) f;
-- (void) createToolbar: (struct frame *)f;
- (void) setWindowClosing: (BOOL)closing;
-- (EmacsToolbar *) toolbar;
- (void) deleteWorkingText;
- (void) handleFS;
- (void) setFSValue: (int)value;
@@ -483,9 +484,9 @@ typedef id instancetype;
#endif
- (int)fullscreenState;
-#ifdef NS_DRAW_TO_BUFFER
-- (void)focusOnDrawingBuffer;
-- (void)unfocusDrawingBuffer;
+#ifdef NS_IMPL_COCOA
+- (void)lockFocus;
+- (void)unlockFocus;
#endif
- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect;
@@ -498,27 +499,6 @@ typedef id instancetype;
@end
-/* Small utility used for processing resize events under Cocoa. */
-@interface EmacsWindow : NSWindow
-{
- NSPoint grabOffset;
-}
-
-#ifdef NS_IMPL_GNUSTEP
-- (NSInteger) orderedIndex;
-#endif
-
-- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above;
-- (void)setAppearance;
-@end
-
-
-/* Fullscreen version of the above. */
-@interface EmacsFSWindow : EmacsWindow
-{
-}
-@end
-
/* ==========================================================================
The main menu implementation
@@ -568,6 +548,7 @@ typedef id instancetype;
- (void) addDisplayItemWithImage: (EmacsImage *)img
idx: (int)idx
tag: (int)tag
+ labelText: (const char *)label
helpText: (const char *)help
enabled: (BOOL)enabled;
@@ -647,7 +628,6 @@ typedef id instancetype;
NSBitmapImageRep *bmRep; /* used for accessing pixel data */
unsigned char *pixmapData[5]; /* shortcut to access pixel data */
NSColor *stippleMask;
- unsigned long xbm_fg;
@public
NSAffineTransform *transform;
BOOL smoothing;
@@ -657,7 +637,6 @@ typedef id instancetype;
- (instancetype)initFromXBM: (unsigned char *)bits width: (int)w height: (int)h
fg: (unsigned long)fg bg: (unsigned long)bg
reverseBytes: (BOOL)reverse;
-- (instancetype)setXBMColor: (NSColor *)color;
- (instancetype)initForXPMWithDepth: (int)depth width: (int)width height:
(int)height;
- (void)setPixmapData;
- (unsigned long)getPixelAtX: (int)x Y: (int)y;
@@ -716,23 +695,17 @@ typedef id instancetype;
+ (CGFloat)scrollerWidth;
@end
-#ifdef NS_DRAW_TO_BUFFER
-@interface EmacsSurface : NSObject
+#ifdef NS_IMPL_COCOA
+@interface EmacsLayer : CALayer
{
NSMutableArray *cache;
- NSSize size;
CGColorSpaceRef colorSpace;
IOSurfaceRef currentSurface;
- IOSurfaceRef lastSurface;
CGContextRef context;
- CGFloat scale;
}
-- (id) initWithSize: (NSSize)s ColorSpace: (CGColorSpaceRef)cs Scale:
(CGFloat)scale;
-- (void) dealloc;
-- (NSSize) getSize;
+- (id) initWithColorSpace: (CGColorSpaceRef)cs;
+- (void) setColorSpace: (CGColorSpaceRef)cs;
- (CGContextRef) getContext;
-- (void) releaseContext;
-- (IOSurfaceRef) getSurface;
@end
#endif
diff --git a/src/nsterm.m b/src/nsterm.m
index b9e2c9b..8d88f7b 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -70,9 +70,6 @@ GNUstep port and post-20 update by Adrian Robert
(arobert@cogsci.ucsd.edu)
#ifdef NS_IMPL_COCOA
#include "macfont.h"
#include <Carbon/Carbon.h>
-#endif
-
-#ifdef NS_DRAW_TO_BUFFER
#include <IOSurface/IOSurface.h>
#endif
@@ -272,9 +269,6 @@ long context_menu_value = 0;
/* display update */
static struct frame *ns_updating_frame;
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
-static NSView *focus_view = NULL;
-#endif
static int ns_window_num = 0;
static BOOL gsaved = NO;
#ifdef NS_IMPL_COCOA
@@ -1032,33 +1026,14 @@ ns_update_begin (struct frame *f)
{
// Fix reappearing tool bar in fullscreen for Mac OS X 10.7
BOOL tbar_visible = FRAME_EXTERNAL_TOOL_BAR (f) ? YES : NO;
- NSToolbar *toolbar = [FRAME_NS_VIEW (f) toolbar];
+ NSToolbar *toolbar = [[FRAME_NS_VIEW (f) window] toolbar];
if (! tbar_visible != ! [toolbar isVisible])
[toolbar setVisible: tbar_visible];
}
#endif
ns_updating_frame = f;
-#ifdef NS_DRAW_TO_BUFFER
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
- {
-#endif
- [view focusOnDrawingBuffer];
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
- else
- {
-#endif
-#endif /* NS_DRAW_TO_BUFFER */
-
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- [view lockFocus];
-#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
-#endif
-
+ [view lockFocus];
}
@@ -1069,39 +1044,21 @@ ns_update_end (struct frame *f)
external (RIF) call; for whole frame, called after gui_update_window_end
--------------------------------------------------------------------------
*/
{
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
EmacsView *view = FRAME_NS_VIEW (f);
-#endif
NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_end");
/* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */
MOUSE_HL_INFO (f)->mouse_face_defer = 0;
-#ifdef NS_DRAW_TO_BUFFER
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
- {
-#endif
- [FRAME_NS_VIEW (f) unfocusDrawingBuffer];
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
- else
- {
-#endif
-#endif /* NS_DRAW_TO_BUFFER */
-
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- block_input ();
-
- [view unlockFocus];
- [[view window] flushWindow];
+ block_input ();
- unblock_input ();
-#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
+ [view unlockFocus];
+#if defined (NS_IMPL_GNUSTEP)
+ [[view window] flushWindow];
#endif
+
+ unblock_input ();
ns_updating_frame = NULL;
}
@@ -1116,8 +1073,6 @@ ns_focus (struct frame *f, NSRect *r, int n)
the entire window.
--------------------------------------------------------------------------
*/
{
- EmacsView *view = FRAME_NS_VIEW (f);
-
NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_focus");
if (r != NULL)
{
@@ -1126,39 +1081,10 @@ ns_focus (struct frame *f, NSRect *r, int n)
if (f != ns_updating_frame)
{
-#ifdef NS_DRAW_TO_BUFFER
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
- {
-#endif
- [view focusOnDrawingBuffer];
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
- else
- {
-#endif
-#endif /* NS_DRAW_TO_BUFFER */
-
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if (view != focus_view)
- {
- if (focus_view != NULL)
- {
- [focus_view unlockFocus];
- [[focus_view window] flushWindow];
- }
-
- if (view)
- [view lockFocus];
- focus_view = view;
- }
-#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
-#endif
+ EmacsView *view = FRAME_NS_VIEW (f);
+ [view lockFocus];
}
-
/* clipping */
if (r)
{
@@ -1186,35 +1112,14 @@ ns_unfocus (struct frame *f)
gsaved = NO;
}
-#ifdef NS_DRAW_TO_BUFFER
- #if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
- {
-#endif
- if (! ns_updating_frame)
- [FRAME_NS_VIEW (f) unfocusDrawingBuffer];
- [FRAME_NS_VIEW (f) setNeedsDisplay:YES];
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
- else
+ if (f != ns_updating_frame)
{
+ EmacsView *view = FRAME_NS_VIEW (f);
+ [view unlockFocus];
+#if defined (NS_IMPL_GNUSTEP)
+ [[view window] flushWindow];
#endif
-#endif /* NS_DRAW_TO_BUFFER */
-
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if (f != ns_updating_frame)
- {
- if (focus_view != NULL)
- {
- [focus_view unlockFocus];
- [[focus_view window] flushWindow];
- focus_view = NULL;
- }
- }
-#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
-#endif
}
@@ -1381,7 +1286,7 @@ ns_ring_bell (struct frame *f)
}
}
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
static void
hide_bell (void)
/* --------------------------------------------------------------------------
@@ -1548,7 +1453,7 @@ ns_make_frame_visible (struct frame *f)
if (!FRAME_VISIBLE_P (f))
{
EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
- NSWindow *window = [view window];
+ EmacsWindow *window = (EmacsWindow *)[view window];
SET_FRAME_VISIBLE (f, 1);
ns_raise_frame (f, ! FRAME_NO_FOCUS_ON_MAP (f));
@@ -1571,11 +1476,8 @@ ns_make_frame_visible (struct frame *f)
relationship, so reinstate it. */
if ([window parentWindow] == nil && FRAME_PARENT_FRAME (f) != NULL)
{
- NSWindow *parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window];
-
block_input ();
- [parent addChildWindow: window
- ordered: NSWindowAbove];
+ [window setParentChildRelationships];
unblock_input ();
/* If the parent frame moved while the child frame was
@@ -1732,52 +1634,35 @@ ns_set_offset (struct frame *f, int xoff, int yoff, int
change_grav)
block_input ();
- if (FRAME_PARENT_FRAME (f))
- {
- /* Convert the parent frame's view rectangle into screen
- coords. */
- EmacsView *parentView = FRAME_NS_VIEW (FRAME_PARENT_FRAME (f));
- NSRect parentRect = [parentView convertRect:[parentView frame]
- toView:nil];
- parentRect = [[parentView window] convertRectToScreen:parentRect];
+ /* If there is no parent frame then just convert to screen
+ coordinates, UNLESS we have negative values, in which case I
+ think it's best to position from the bottom and right of the
+ current screen rather than the main screen or whole display. */
- if (f->size_hint_flags & XNegative)
- topLeft.x = NSMaxX (parentRect) - NSWidth (windowFrame) + xoff;
- else
- topLeft.x = NSMinX (parentRect) + xoff;
+ NSRect parentRect = ns_parent_window_rect (f);
- if (f->size_hint_flags & YNegative)
- topLeft.y = NSMinY (parentRect) + NSHeight (windowFrame) - yoff;
- else
- topLeft.y = NSMaxY (parentRect) - yoff;
- }
+ if (f->size_hint_flags & XNegative)
+ topLeft.x = NSMaxX (parentRect) - NSWidth (windowFrame) + xoff;
+ else if (FRAME_PARENT_FRAME (f))
+ topLeft.x = NSMinX (parentRect) + xoff;
else
- {
- /* If there is no parent frame then just convert to screen
- coordinates, UNLESS we have negative values, in which case I
- think it's best to position from the bottom and right of the
- current screen rather than the main screen or whole
- display. */
- NSRect screenFrame = [[[view window] screen] frame];
-
- if (f->size_hint_flags & XNegative)
- topLeft.x = NSMaxX (screenFrame) - NSWidth (windowFrame) + xoff;
- else
- topLeft.x = xoff;
+ topLeft.x = xoff;
- if (f->size_hint_flags & YNegative)
- topLeft.y = NSMinY (screenFrame) + NSHeight (windowFrame) - yoff;
- else
- topLeft.y = NSMaxY ([[[NSScreen screens] objectAtIndex:0] frame]) -
yoff;
+ if (f->size_hint_flags & YNegative)
+ topLeft.y = NSMinY (parentRect) + NSHeight (windowFrame) - yoff;
+ else if (FRAME_PARENT_FRAME (f))
+ topLeft.y = NSMaxY (parentRect) - yoff;
+ else
+ topLeft.y = NSMaxY ([[[NSScreen screens] objectAtIndex:0] frame]) - yoff;
#ifdef NS_IMPL_GNUSTEP
- /* Don't overlap the menu.
+ /* Don't overlap the menu.
- FIXME: Surely there's a better way than just hardcoding 100
- in here? */
- topLeft.x = 100;
+ FIXME: Surely there's a better way than just hardcoding 100 in
+ here? */
+ if (topLeft.x < 100)
+ topLeft.x = 100;
#endif
- }
NSTRACE_POINT ("setFrameTopLeftPoint", topLeft);
[[view window] setFrameTopLeftPoint:topLeft];
@@ -1800,45 +1685,38 @@ ns_set_window_size (struct frame *f,
{
EmacsView *view = FRAME_NS_VIEW (f);
NSWindow *window = [view window];
- NSRect wr = [window frame];
- int orig_height = wr.size.height;
+ NSRect frameRect;
NSTRACE ("ns_set_window_size");
if (view == nil)
return;
- NSTRACE_RECT ("current", wr);
+ NSTRACE_RECT ("current", [window frame]);
NSTRACE_MSG ("Width:%d Height:%d", width, height);
NSTRACE_MSG ("Font %d x %d", FRAME_COLUMN_WIDTH (f), FRAME_LINE_HEIGHT (f));
block_input ();
- wr.size.width = width + f->border_width;
- wr.size.height = height;
- if (! [view isFullscreen])
- wr.size.height += FRAME_NS_TITLEBAR_HEIGHT (f)
- + FRAME_TOOLBAR_HEIGHT (f);
+ frameRect = [window frameRectForContentRect:NSMakeRect (0, 0, width,
height)];
- /* Do not try to constrain to this screen. We may have multiple
- screens, and want Emacs to span those. Constraining to screen
- prevents that, and that is not nice to the user. */
- if (f->output_data.ns->zooming)
- f->output_data.ns->zooming = 0;
- else
- wr.origin.y += orig_height - wr.size.height;
+ /* Set the origin so the top left of the frame doesn't move. */
+ frameRect.origin = [window frame].origin;
+ frameRect.origin.y += NSHeight ([view frame]) - height;
- /* Usually it seems safe to delay changing the frame size, but when a
- series of actions are taken with no redisplay between them then we
- can end up using old values so don't delay here. */
- change_frame_size (f, width, height, false, NO, false);
+ if (f->output_data.ns->zooming)
+ f->output_data.ns->zooming = 0;
- [window setFrame:wr display:NO];
+ /* Usually it seems safe to delay changing the frame size, but when a
+ series of actions are taken with no redisplay between them then we
+ can end up using old values so don't delay here. */
+ change_frame_size (f, width, height, false, NO, false);
+
+ [window setFrame:frameRect display:NO];
unblock_input ();
}
-#ifdef NS_IMPL_COCOA
void
ns_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object
old_value)
/* --------------------------------------------------------------------------
@@ -1848,45 +1726,34 @@ ns_set_undecorated (struct frame *f, Lisp_Object
new_value, Lisp_Object old_valu
dragged, resized, iconified, maximized or deleted with the mouse. If
nil, draw the frame with all the elements listed above unless these
have been suspended via window manager settings.
-
- GNUStep cannot change an existing window's style.
--------------------------------------------------------------------------
*/
{
- EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
- NSWindow *window = [view window];
-
NSTRACE ("ns_set_undecorated");
if (!EQ (new_value, old_value))
{
+ EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
+ NSWindow *oldWindow = [view window];
+ NSWindow *newWindow;
+
block_input ();
- if (NILP (new_value))
- {
- FRAME_UNDECORATED (f) = false;
- [window setStyleMask: ((window.styleMask | FRAME_DECORATED_FLAGS)
- ^ FRAME_UNDECORATED_FLAGS)];
+ FRAME_UNDECORATED (f) = !NILP (new_value);
- [view createToolbar: f];
- }
- else
- {
- [window setToolbar: nil];
- /* Do I need to release the toolbar here? */
+ newWindow = [[EmacsWindow alloc] initWithEmacsFrame:f];
- FRAME_UNDECORATED (f) = true;
- [window setStyleMask: ((window.styleMask | FRAME_UNDECORATED_FLAGS)
- ^ FRAME_DECORATED_FLAGS)];
- }
+ if ([oldWindow isKeyWindow])
+ [newWindow makeKeyAndOrderFront:NSApp];
+
+ [newWindow setIsVisible:[oldWindow isVisible]];
+ if ([oldWindow isMiniaturized])
+ [newWindow miniaturize:NSApp];
- /* At this point it seems we don't have an active NSResponder,
- so some key presses (TAB) are swallowed by the system. */
- [window makeFirstResponder: view];
+ [oldWindow close];
unblock_input ();
}
}
-#endif /* NS_IMPL_COCOA */
void
ns_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object
old_value)
@@ -1913,7 +1780,6 @@ ns_set_parent_frame (struct frame *f, Lisp_Object
new_value, Lisp_Object old_val
--------------------------------------------------------------------------
*/
{
struct frame *p = NULL;
- NSWindow *parent, *child;
NSTRACE ("ns_set_parent_frame");
@@ -1926,72 +1792,11 @@ ns_set_parent_frame (struct frame *f, Lisp_Object
new_value, Lisp_Object old_val
error ("Invalid specification of `parent-frame'");
}
- if (p != FRAME_PARENT_FRAME (f))
- {
- block_input ();
- child = [FRAME_NS_VIEW (f) window];
-
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
-#endif
-
- if ([child parentWindow] != nil)
- {
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- parent = [child parentWindow];
-#endif
-
- [[child parentWindow] removeChildWindow:child];
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000
- if ([child respondsToSelector:@selector(setAccessibilitySubrole:)])
-#endif
- [child
setAccessibilitySubrole:NSAccessibilityStandardWindowSubrole];
-#endif
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- if (NILP (new_value))
- {
- NSTRACE ("child
setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary");
- [child
setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary];
- // if current parent in fullscreen and no new parent make child
fullscreen
- while (parent) {
- if (([parent styleMask] & NSWindowStyleMaskFullScreen) != 0)
- {
- [view toggleFullScreen:child];
- break;
- }
- // check all parents
- parent = [parent parentWindow];
- }
- }
-#endif
- }
-
- if (!NILP (new_value))
- {
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- // child frame must not be in fullscreen
- if ([view fsIsNative] && [view isFullscreen])
- [view toggleFullScreen:child];
- NSTRACE ("child
setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary");
- [child
setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary];
-#endif
- parent = [FRAME_NS_VIEW (p) window];
-
- [parent addChildWindow: child
- ordered: NSWindowAbove];
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000
- if ([child respondsToSelector:@selector(setAccessibilitySubrole:)])
-#endif
- [child
setAccessibilitySubrole:NSAccessibilityFloatingWindowSubrole];
-#endif
- }
-
- unblock_input ();
+ fset_parent_frame (f, new_value);
- fset_parent_frame (f, new_value);
- }
+ block_input ();
+ [(EmacsWindow *)[FRAME_NS_VIEW (f) window] setParentChildRelationships];
+ unblock_input ();
}
void
@@ -2433,12 +2238,10 @@ ns_set_frame_alpha (struct frame *f)
else if (0.0 <= alpha && alpha < alpha_min && alpha_min <= 1.0)
alpha = alpha_min;
-#ifdef NS_IMPL_COCOA
{
EmacsView *view = FRAME_NS_VIEW (f);
- [[view window] setAlphaValue: alpha];
+ [[view window] setAlphaValue: alpha];
}
-#endif
}
@@ -3092,8 +2895,40 @@ ns_compute_glyph_string_overhangs (struct glyph_string
*s)
==========================================================================
*/
+static NSMutableDictionary *fringe_bmp;
+
+static void
+ns_define_fringe_bitmap (int which, unsigned short *bits, int h, int w)
+{
+ NSBezierPath *p = [NSBezierPath bezierPath];
+
+ if (!fringe_bmp)
+ fringe_bmp = [[NSMutableDictionary alloc] initWithCapacity:25];
+
+ [p moveToPoint:NSMakePoint (0, 0)];
+
+ for (int y = 0 ; y < h ; y++)
+ for (int x = 0 ; x < w ; x++)
+ {
+ /* XBM rows are always round numbers of bytes, with any unused
+ bits ignored. */
+ int byte = y * (w/8 + (w%8 ? 1 : 0)) + x/8;
+ bool bit = bits[byte] & (0x80 >> x%8);
+ if (bit)
+ [p appendBezierPathWithRect:NSMakeRect (x, y, 1, 1)];
+ }
+
+ [fringe_bmp setObject:p forKey:[NSNumber numberWithInt:which]];
+}
+
+
+static void
+ns_destroy_fringe_bitmap (int which)
+{
+ [fringe_bmp removeObjectForKey:[NSNumber numberWithInt:which]];
+}
+
-extern int max_used_fringe_bitmap;
static void
ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
struct draw_fringe_bitmap_params *p)
@@ -3119,41 +2954,18 @@ ns_draw_fringe_bitmap (struct window *w, struct
glyph_row *row,
struct frame *f = XFRAME (WINDOW_FRAME (w));
struct face *face = p->face;
- static EmacsImage **bimgs = NULL;
- static int nBimgs = 0;
NSRect clearRect = NSZeroRect;
- NSRect imageRect = NSZeroRect;
NSRect rowRect = ns_row_rect (w, row, ANY_AREA);
NSTRACE_WHEN (NSTRACE_GROUP_FRINGE, "ns_draw_fringe_bitmap");
NSTRACE_MSG ("which:%d cursor:%d overlay:%d width:%d height:%d period:%d",
p->which, p->cursor_p, p->overlay_p, p->wd, p->h, p->dh);
- /* grow bimgs if needed */
- if (nBimgs < max_used_fringe_bitmap)
- {
- bimgs = xrealloc (bimgs, max_used_fringe_bitmap * sizeof *bimgs);
- memset (bimgs + nBimgs, 0,
- (max_used_fringe_bitmap - nBimgs) * sizeof *bimgs);
- nBimgs = max_used_fringe_bitmap;
- }
-
- /* Work out the rectangle we will composite into. */
- if (p->which)
- imageRect = NSMakeRect (p->x, p->y, p->wd, p->h);
+ /* Work out the rectangle we will need to clear. */
+ clearRect = NSMakeRect (p->x, p->y, p->wd, p->h);
- /* Work out the rectangle we will need to clear. Because we're
- compositing rather than blitting, we need to clear the area under
- the image regardless of anything else. */
if (p->bx >= 0 && !p->overlay_p)
- {
- clearRect = NSMakeRect (p->bx, p->by, p->nx, p->ny);
- clearRect = NSUnionRect (clearRect, imageRect);
- }
- else
- {
- clearRect = imageRect;
- }
+ clearRect = NSUnionRect (clearRect, NSMakeRect (p->bx, p->by, p->nx,
p->ny));
/* Handle partially visible rows. */
clearRect = NSIntersectionRect (clearRect, rowRect);
@@ -3169,53 +2981,29 @@ ns_draw_fringe_bitmap (struct window *w, struct
glyph_row *row,
NSRectFill (clearRect);
}
- if (p->which)
+ NSBezierPath *bmp = [fringe_bmp objectForKey:[NSNumber
numberWithInt:p->which]];
+ if (bmp)
{
- EmacsImage *img = bimgs[p->which - 1];
-
- 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);
- }
-
+ NSAffineTransform *transform = [NSAffineTransform transform];
+ NSColor *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];
- }
+ /* Because the image is defined at (0, 0) we need to take a copy
+ and then transform that copy to the new origin. */
+ bmp = [bmp copy];
+ [transform translateXBy:p->x yBy:p->y - p->dh];
+ [bmp transformUsingAffineTransform:transform];
- // 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);
+ 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;
- NSTRACE_RECT ("fromRect", fromRect);
+ [bm_color set];
+ [bmp fill];
- [img drawInRect: imageRect
- fromRect: fromRect
- operation: NSCompositingOperationSourceOver
- fraction: 1.0
- respectFlipped: YES
- hints: nil];
+ [bmp release];
}
ns_unfocus (f);
}
@@ -3690,7 +3478,7 @@ ns_draw_box (NSRect r, CGFloat hthickness, CGFloat
vthickness,
static void
-ns_draw_relief (NSRect r, int hthickness, int vthickness, char raised_p,
+ns_draw_relief (NSRect outer, int hthickness, int vthickness, char raised_p,
char top_p, char bottom_p, char left_p, char right_p,
struct glyph_string *s)
/* --------------------------------------------------------------------------
@@ -3701,7 +3489,7 @@ ns_draw_relief (NSRect r, int hthickness, int vthickness,
char raised_p,
{
static NSColor *baseCol = nil, *lightCol = nil, *darkCol = nil;
NSColor *newBaseCol = nil;
- NSRect sr = r;
+ NSRect inner;
NSTRACE ("ns_draw_relief");
@@ -3735,33 +3523,50 @@ ns_draw_relief (NSRect r, int hthickness, int
vthickness, char raised_p,
darkCol = [[baseCol shadowWithLevel: 0.3] retain];
}
- [(raised_p ? lightCol : darkCol) set];
-
- /* TODO: mitering. Using NSBezierPath doesn't work because of color switch.
*/
+ /* Calculate the inner rectangle. */
+ inner = NSInsetRect (outer, hthickness, vthickness);
- /* top */
- sr.size.height = hthickness;
- if (top_p) NSRectFill (sr);
+ [(raised_p ? lightCol : darkCol) set];
- /* left */
- sr.size.height = r.size.height;
- sr.size.width = vthickness;
- if (left_p) NSRectFill (sr);
+ if (top_p || left_p)
+ {
+ NSBezierPath *p = [NSBezierPath bezierPath];
+ [p moveToPoint:NSMakePoint (NSMinX (outer), NSMinY (outer))];
+ if (top_p)
+ {
+ [p lineToPoint:NSMakePoint (NSMaxX (outer), NSMinY (outer))];
+ [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMinY (inner))];
+ }
+ [p lineToPoint:NSMakePoint (NSMinX (inner), NSMinY (inner))];
+ if (left_p)
+ {
+ [p lineToPoint:NSMakePoint (NSMinX (inner), NSMaxY (inner))];
+ [p lineToPoint:NSMakePoint (NSMinX (outer), NSMaxY (outer))];
+ }
+ [p closePath];
+ [p fill];
+ }
[(raised_p ? darkCol : lightCol) set];
- /* bottom */
- sr.size.width = r.size.width;
- sr.size.height = hthickness;
- sr.origin.y += r.size.height - hthickness;
- if (bottom_p) NSRectFill (sr);
-
- /* right */
- sr.size.height = r.size.height;
- sr.origin.y = r.origin.y;
- sr.size.width = vthickness;
- sr.origin.x += r.size.width - vthickness;
- if (right_p) NSRectFill (sr);
+ if (bottom_p || right_p)
+ {
+ NSBezierPath *p = [NSBezierPath bezierPath];
+ [p moveToPoint:NSMakePoint (NSMaxX (outer), NSMaxY (outer))];
+ if (right_p)
+ {
+ [p lineToPoint:NSMakePoint (NSMaxX (outer), NSMinY (outer))];
+ [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMinY (inner))];
+ }
+ [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMaxY (inner))];
+ if (bottom_p)
+ {
+ [p lineToPoint:NSMakePoint (NSMinX (inner), NSMaxY (inner))];
+ [p lineToPoint:NSMakePoint (NSMinX (outer), NSMaxY (outer))];
+ }
+ [p closePath];
+ [p fill];
+ }
}
@@ -5170,8 +4975,8 @@ static struct redisplay_interface ns_redisplay_interface =
gui_get_glyph_overhangs,
gui_fix_overlapping_area,
ns_draw_fringe_bitmap,
- 0, /* define_fringe_bitmap */ /* FIXME: simplify ns_draw_fringe_bitmap */
- 0, /* destroy_fringe_bitmap */
+ ns_define_fringe_bitmap,
+ ns_destroy_fringe_bitmap,
ns_compute_glyph_string_overhangs,
ns_draw_glyph_string,
ns_define_frame_cursor,
@@ -5209,6 +5014,12 @@ ns_delete_terminal (struct terminal *terminal)
block_input ();
+#ifdef NS_IMPL_COCOA
+ /* Rather than try to clean up the NS environment we can just
+ disable the app and leave it waiting for any new frames. */
+ [NSApp setActivationPolicy:NSApplicationActivationPolicyProhibited];
+#endif
+
image_destroy_all_bitmaps (dpyinfo);
ns_delete_display (dpyinfo);
unblock_input ();
@@ -5357,6 +5168,8 @@ ns_term_init (Lisp_Object display_name)
terminal->name = xlispstrdup (display_name);
+ gui_init_fringe (terminal->rif);
+
unblock_input ();
if (!inhibit_x_resources)
@@ -6198,11 +6011,6 @@ not_in_argv (NSString *arg)
name:NSViewFrameDidChangeNotification
object:nil];
-#ifdef NS_DRAW_TO_BUFFER
- [surface release];
-#endif
-
- [toolbar release];
if (fs_state == FULLSCREEN_BOTH)
[nonfs_window release];
[super dealloc];
@@ -7148,43 +6956,6 @@ not_in_argv (NSString *arg)
}
-- (void)windowDidResize: (NSNotification *)notification
-{
- NSTRACE ("[EmacsView windowDidResize:]");
- if (!FRAME_LIVE_P (emacsframe))
- {
- NSTRACE_MSG ("Ignored (frame dead)");
- return;
- }
- if (emacsframe->output_data.ns->in_animation)
- {
- NSTRACE_MSG ("Ignored (in animation)");
- return;
- }
-
- if (! [self fsIsNative])
- {
- NSWindow *theWindow = [notification object];
- /* We can get notification on the non-FS window when in
- fullscreen mode. */
- if ([self window] != theWindow) return;
- }
-
- NSTRACE_RECT ("frame", [[notification object] frame]);
-
-#ifdef NS_IMPL_GNUSTEP
- NSWindow *theWindow = [notification object];
-
- /* In GNUstep, at least currently, it's possible to get a didResize
- without getting a willResize, therefore we need to act as if we got
- the willResize now. */
- NSSize sz = [theWindow frame].size;
- sz = [self windowWillResize: theWindow toSize: sz];
-#endif /* NS_IMPL_GNUSTEP */
-
- ns_send_appdefined (-1);
-}
-
#ifdef NS_IMPL_COCOA
- (void)viewDidEndLiveResize
{
@@ -7202,56 +6973,30 @@ not_in_argv (NSString *arg)
#endif /* NS_IMPL_COCOA */
-- (void)viewDidResize:(NSNotification *)notification
+- (void)resizeWithOldSuperviewSize: (NSSize)oldSize
{
- NSRect frame = [self frame];
- int neww, newh, oldw, oldh;
-
- if (! FRAME_LIVE_P (emacsframe))
- return;
-
- NSTRACE ("[EmacsView viewDidResize]");
-
-#ifdef NS_DRAW_TO_BUFFER
- /* If the buffer size doesn't match the view's backing size, destroy
- the buffer and let it be recreated at the correct size later. */
- if ([self wantsUpdateLayer] && surface)
- {
- NSRect surfaceRect = {{0, 0}, [surface getSize]};
- NSRect frameRect = [[self window] convertRectToBacking:frame];
+ NSRect frame;
+ int width, height;
- if (!NSEqualRects (frameRect, surfaceRect))
- {
- [surface release];
- surface = nil;
+ NSTRACE ("[EmacsView resizeWithOldSuperviewSize:]");
- [self setNeedsDisplay:YES];
- }
- }
-#endif
+ [super resizeWithOldSuperviewSize:oldSize];
- neww = (int)NSWidth (frame);
- newh = (int)NSHeight (frame);
- oldw = FRAME_PIXEL_WIDTH (emacsframe);
- oldh = FRAME_PIXEL_HEIGHT (emacsframe);
+ if (! FRAME_LIVE_P (emacsframe))
+ return;
- /* Don't want to do anything when the view size hasn't changed. */
- if (emacsframe->new_size_p
- ? (newh == emacsframe->new_height
- && neww == emacsframe->new_width)
- : (oldh == newh && oldw == neww))
- {
- NSTRACE_MSG ("No change");
- return;
- }
+ frame = [self frame];
+ width = (int)NSWidth (frame);
+ height = (int)NSHeight (frame);
- NSTRACE_SIZE ("New size", NSMakeSize (neww, newh));
- NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh));
+ NSTRACE_SIZE ("New size", NSMakeSize (width, height));
+ NSTRACE_SIZE ("Original size", size);
- change_frame_size (emacsframe, neww, newh, false, YES, false);
+ change_frame_size (emacsframe, width, height, false, YES, false);
SET_FRAME_GARBAGED (emacsframe);
cancel_mouse_face (emacsframe);
+ ns_send_appdefined (-1);
}
@@ -7346,50 +7091,16 @@ not_in_argv (NSString *arg)
}
-- (void)createToolbar: (struct frame *)f
+- (instancetype) initFrameFromEmacs: (struct frame *)f
{
- EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
- NSWindow *window = [view window];
-
- toolbar = [[EmacsToolbar alloc] initForView: self withIdentifier:
- [NSString stringWithFormat: @"Emacs Frame %d",
- ns_window_num]];
- [toolbar setVisible: NO];
- [window setToolbar: toolbar];
-
- /* Don't set frame garbaged until tool bar is up to date?
- This avoids an extra clear and redraw (flicker) at frame creation. */
- if (FRAME_EXTERNAL_TOOL_BAR (f)) wait_for_tool_bar = YES;
- else wait_for_tool_bar = NO;
+ NSTRACE ("[EmacsView initFrameFromEmacs:]");
+ NSTRACE_MSG ("cols:%d lines:%d", f->text_cols, f->text_lines);
-
-#ifdef NS_IMPL_COCOA
- {
- NSButton *toggleButton;
- toggleButton = [window standardWindowButton: NSWindowToolbarButton];
- [toggleButton setTarget: self];
- [toggleButton setAction: @selector (toggleToolbar: )];
- }
-#endif
-}
-
-
-- (instancetype) initFrameFromEmacs: (struct frame *)f
-{
- NSRect r, wr;
- Lisp_Object tem;
- EmacsWindow *win;
- NSColor *col;
- NSString *name;
-
- NSTRACE ("[EmacsView initFrameFromEmacs:]");
- NSTRACE_MSG ("cols:%d lines:%d", f->text_cols, f->text_lines);
-
- windowClosing = NO;
- processingCompose = NO;
- scrollbarsNeedingUpdate = 0;
- fs_state = FULLSCREEN_NONE;
- fs_before_fs = next_maximized = -1;
+ windowClosing = NO;
+ processingCompose = NO;
+ scrollbarsNeedingUpdate = 0;
+ fs_state = FULLSCREEN_NONE;
+ fs_before_fs = next_maximized = -1;
fs_is_native = NO;
#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
@@ -7403,21 +7114,11 @@ not_in_argv (NSString *arg)
nonfs_window = nil;
ns_userRect = NSMakeRect (0, 0, 0, 0);
- r = NSMakeRect (0, 0, FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols),
- FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines));
- [self initWithFrame: r];
+ [self initWithFrame:
+ NSMakeRect (0, 0, FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols),
+ FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines))];
[self setAutoresizingMask: NSViewWidthSizable | NSViewHeightSizable];
-#ifdef NS_DRAW_TO_BUFFER
- /* These settings mean AppKit will retain the contents of the frame
- on resize. Unfortunately it also means the frame will not be
- automatically marked for display, but we can do that ourselves in
- viewDidResize. */
- [self setLayerContentsRedrawPolicy:
- NSViewLayerContentsRedrawOnSetNeedsDisplay];
- [self setLayerContentsPlacement:NSViewLayerContentsPlacementTopLeft];
-#endif
-
FRAME_NS_VIEW (f) = self;
emacsframe = f;
#ifdef NS_IMPL_COCOA
@@ -7425,100 +7126,22 @@ not_in_argv (NSString *arg)
maximizing_resize = NO;
#endif
- win = [[EmacsWindow alloc]
- initWithContentRect: r
- styleMask: (FRAME_UNDECORATED (f)
- ? FRAME_UNDECORATED_FLAGS
- : FRAME_DECORATED_FLAGS)
- backing: NSBackingStoreBuffered
- defer: YES];
+ [[EmacsWindow alloc] initWithEmacsFrame:f];
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
- if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_7)
-#endif
- if (FRAME_PARENT_FRAME (f))
- [win
setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary];
- else
- [win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary];
-#endif
-
- wr = [win frame];
- bwidth = f->border_width = wr.size.width - r.size.width;
-
- [win setAcceptsMouseMovedEvents: YES];
- [win setDelegate: self];
-#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090
-#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090
- if ([win respondsToSelector: @selector(useOptimizedDrawing:)])
-#endif
- [win useOptimizedDrawing: YES];
+#ifdef NS_IMPL_COCOA
+ /* These settings mean AppKit will retain the contents of the frame
+ on resize. Unfortunately it also means the frame will not be
+ automatically marked for display, but we can do that ourselves in
+ resizeWithOldSuperviewSize. */
+ [self setWantsLayer:YES];
+ [self setLayerContentsRedrawPolicy:
+ NSViewLayerContentsRedrawOnSetNeedsDisplay];
+ [self setLayerContentsPlacement:NSViewLayerContentsPlacementTopLeft];
#endif
- [[win contentView] addSubview: self];
-
if (ns_drag_types)
[self registerForDraggedTypes: ns_drag_types];
- tem = f->name;
- name = NILP (tem) ? @"Emacs" : [NSString stringWithLispString:tem];
- [win setTitle: name];
-
- /* toolbar support */
- if (! FRAME_UNDECORATED (f))
- [self createToolbar: f];
-
-
- [win setAppearance];
-
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
- if ([win respondsToSelector: @selector(titlebarAppearsTransparent)])
- win.titlebarAppearsTransparent = FRAME_NS_TRANSPARENT_TITLEBAR (f);
-#endif
-
- tem = f->icon_name;
- if (!NILP (tem))
- [win setMiniwindowTitle:
- [NSString stringWithLispString:tem]];
-
- if (FRAME_PARENT_FRAME (f) != NULL)
- {
- NSWindow *parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window];
- [parent addChildWindow: win
- ordered: NSWindowAbove];
- }
-
- if (FRAME_Z_GROUP (f) != z_group_none)
- win.level = NSNormalWindowLevel
- + (FRAME_Z_GROUP_BELOW (f) ? -1 : 1);
-
- {
- NSScreen *screen = [win screen];
-
- if (screen != 0)
- {
- NSPoint pt = NSMakePoint
- (IN_BOUND (-SCREENMAX, f->left_pos
- + NS_PARENT_WINDOW_LEFT_POS (f), SCREENMAX),
- IN_BOUND (-SCREENMAX,
- NS_PARENT_WINDOW_TOP_POS (f) - f->top_pos,
- SCREENMAX));
-
- [win setFrameTopLeftPoint: pt];
-
- NSTRACE_RECT ("new frame", [win frame]);
- }
- }
-
- [win makeFirstResponder: self];
-
- col = ns_lookup_indexed_color (NS_FACE_BACKGROUND
- (FACE_FROM_ID (emacsframe, DEFAULT_FACE_ID)),
- emacsframe);
- [win setBackgroundColor: col];
- if ([col alphaComponent] != (EmacsCGFloat) 1.0)
- [win setOpaque: NO];
-
#if !defined (NS_IMPL_COCOA) \
|| MAC_OS_X_VERSION_MIN_REQUIRED <= 1090
#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090
@@ -7529,21 +7152,6 @@ not_in_argv (NSString *arg)
[NSApp registerServicesMenuSendTypes: ns_send_types
returnTypes: [NSArray array]];
- /* Set up view resize notifications. */
- [self setPostsFrameChangedNotifications:YES];
- [[NSNotificationCenter defaultCenter]
- addObserver:self
- selector:@selector (viewDidResize:)
- name:NSViewFrameDidChangeNotification object:nil];
-
- /* macOS Sierra automatically enables tabbed windows. We can't
- allow this to be enabled until it's available on a Free system.
- Currently it only happens by accident and is buggy anyway. */
-#ifdef NS_IMPL_COCOA
- if ([win respondsToSelector: @selector(setTabbingMode:)])
- [win setTabbingMode: NSWindowTabbingModeDisallowed];
-#endif
-
ns_window_num++;
return self;
}
@@ -7813,7 +7421,7 @@ not_in_argv (NSString *arg)
[NSApp setPresentationOptions: options];
}
#endif
- [toolbar setVisible:tbar_visible];
+ [[[self window]toolbar] setVisible:tbar_visible];
}
}
@@ -7856,12 +7464,12 @@ not_in_argv (NSString *arg)
#endif
if (FRAME_EXTERNAL_TOOL_BAR (emacsframe))
{
- [toolbar setVisible:YES];
+ [[[self window] toolbar] setVisible:YES];
update_frame_tool_bar (emacsframe);
[[self window] display];
}
else
- [toolbar setVisible:NO];
+ [[[self window] toolbar] setVisible:NO];
if (next_maximized != -1)
[[self window] performZoom:self];
@@ -7906,7 +7514,7 @@ not_in_argv (NSString *arg)
NSWindowCollectionBehavior b = [win collectionBehavior];
if (ns_use_native_fullscreen)
{
- if ([win parentWindow])
+ if (FRAME_PARENT_FRAME (emacsframe))
{
b &= ~NSWindowCollectionBehaviorFullScreenPrimary;
b |= NSWindowCollectionBehaviorFullScreenAuxiliary;
@@ -7933,7 +7541,7 @@ not_in_argv (NSString *arg)
- (void)toggleFullScreen: (id)sender
{
- NSWindow *w, *fw;
+ EmacsWindow *w, *fw;
BOOL onFirstScreen;
struct frame *f;
NSRect r, wr;
@@ -7952,7 +7560,7 @@ not_in_argv (NSString *arg)
return;
}
- w = [self window];
+ w = (EmacsWindow *)[self window];
onFirstScreen = [[w screen] isEqual:[[NSScreen screens] objectAtIndex:0]];
f = emacsframe;
wr = [w frame];
@@ -7987,27 +7595,9 @@ not_in_argv (NSString *arg)
#endif
}
- fw = [[EmacsFSWindow alloc]
- initWithContentRect:[w contentRectForFrameRect:wr]
- styleMask:NSWindowStyleMaskBorderless
- backing:NSBackingStoreBuffered
- defer:YES
- screen:screen];
-
- [fw setContentView:[w contentView]];
- [fw setTitle:[w title]];
- [fw setDelegate:self];
- [fw setAcceptsMouseMovedEvents: YES];
-#if !defined (NS_IMPL_COCOA) \
- || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090
-#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090
- if ([fw respondsToSelector: @selector(useOptimizedDrawing:)])
-#endif
- [fw useOptimizedDrawing: YES];
-#endif
- [fw setBackgroundColor: col];
- if ([col alphaComponent] != (EmacsCGFloat) 1.0)
- [fw setOpaque: NO];
+ fw = [[EmacsWindow alloc] initWithEmacsFrame:emacsframe
+ fullscreen:YES
+ screen:screen];
f->border_width = 0;
@@ -8015,7 +7605,6 @@ not_in_argv (NSString *arg)
[self windowWillEnterFullScreen];
[fw makeKeyAndOrderFront:NSApp];
- [fw makeFirstResponder:self];
[w orderOut:self];
r = [fw frameRectForContentRect:[screen frame]];
[fw setFrame: r display:YES animate:ns_use_fullscreen_animation];
@@ -8042,7 +7631,7 @@ not_in_argv (NSString *arg)
if ([col alphaComponent] != (EmacsCGFloat) 1.0)
[w setOpaque: NO];
- f->border_width = bwidth;
+ f->border_width = [w borderWidth];
// To do: consider using [NSNotificationCenter postNotificationName:] to
// send notifications.
@@ -8179,12 +7768,6 @@ not_in_argv (NSString *arg)
}
-- (EmacsToolbar *)toolbar
-{
- return toolbar;
-}
-
-
/* This gets called on toolbar button click. */
- (instancetype)toolbarClicked: (id)item
{
@@ -8221,44 +7804,54 @@ not_in_argv (NSString *arg)
}
-#ifdef NS_DRAW_TO_BUFFER
-- (void)focusOnDrawingBuffer
+#ifdef NS_IMPL_COCOA
+- (CALayer *)makeBackingLayer;
{
- CGFloat scale = [[self window] backingScaleFactor];
+ EmacsLayer *l = [[EmacsLayer alloc]
+ initWithColorSpace:[[[self window] colorSpace]
CGColorSpace]];
+ [l setDelegate:(id)self];
+ [l setContentsScale:[[self window] backingScaleFactor]];
- NSTRACE ("[EmacsView focusOnDrawingBuffer]");
-
- if (! surface)
- {
- NSRect frame = [self frame];
- NSSize s = NSMakeSize (NSWidth (frame) * scale, NSHeight (frame) *
scale);
+ return l;
+}
- surface = [[EmacsSurface alloc] initWithSize:s
- ColorSpace:[[[self window] colorSpace]
- CGColorSpace]
- Scale:scale];
- /* Since we're using NSViewLayerContentsRedrawOnSetNeedsDisplay
- the layer's scale factor is not set automatically, so do it
- now. */
- [[self layer] setContentsScale:scale];
- }
+- (void)lockFocus
+{
+ NSTRACE ("[EmacsView lockFocus]");
- CGContextRef context = [surface getContext];
+ if ([self wantsLayer])
+ {
+ CGContextRef context = [(EmacsLayer*)[self layer] getContext];
- [NSGraphicsContext
- setCurrentContext:[NSGraphicsContext
- graphicsContextWithCGContext:context
- flipped:YES]];
+ [NSGraphicsContext
+ setCurrentContext:[NSGraphicsContext
+ graphicsContextWithCGContext:context
+ flipped:YES]];
+ }
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ else
+ [super lockFocus];
+#endif
}
-- (void)unfocusDrawingBuffer
+- (void)unlockFocus
{
- NSTRACE ("[EmacsView unfocusDrawingBuffer]");
+ NSTRACE ("[EmacsView unlockFocus]");
- [NSGraphicsContext setCurrentContext:nil];
- [self setNeedsDisplay:YES];
+ if ([self wantsLayer])
+ {
+ [NSGraphicsContext setCurrentContext:nil];
+ [self setNeedsDisplay:YES];
+ }
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ else
+ {
+ [super unlockFocus];
+ [super flushWindow];
+ }
+#endif
}
@@ -8267,18 +7860,19 @@ not_in_argv (NSString *arg)
{
NSTRACE ("EmacsView windowDidChangeBackingProperties:]");
- if ([self wantsUpdateLayer])
+ if ([self wantsLayer])
{
NSRect frame = [self frame];
+ EmacsLayer *layer = (EmacsLayer *)[self layer];
- [surface release];
- surface = nil;
+ [layer setContentsScale:[[notification object] backingScaleFactor]];
+ [layer setColorSpace:[[[notification object] colorSpace] CGColorSpace]];
ns_clear_frame (emacsframe);
expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame));
}
}
-#endif /* NS_DRAW_TO_BUFFER */
+#endif /* NS_IMPL_COCOA */
- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect
@@ -8287,11 +7881,9 @@ not_in_argv (NSString *arg)
NSTRACE_RECT ("Source", srcRect);
NSTRACE_RECT ("Destination", dstRect);
-#ifdef NS_DRAW_TO_BUFFER
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if ([self wantsUpdateLayer])
+#ifdef NS_IMPL_COCOA
+ if ([self wantsLayer])
{
-#endif
double scale = [[self window] backingScaleFactor];
CGContextRef context = [[NSGraphicsContext currentContext] CGContext];
int bpp = CGBitmapContextGetBitsPerPixel (context) / 8;
@@ -8317,14 +7909,14 @@ not_in_argv (NSString *arg)
(char *) srcPixels + y * rowSize,
srcRowSize);
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
else
{
#endif
-#endif /* NS_DRAW_TO_BUFFER */
+#endif /* NS_IMPL_COCOA */
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
hide_bell(); // Ensure the bell image isn't scrolled.
ns_focus (emacsframe, &dstRect, 1);
@@ -8333,22 +7925,26 @@ not_in_argv (NSString *arg)
dstRect.origin.y - srcRect.origin.y)];
ns_unfocus (emacsframe);
#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
#endif
}
-#ifdef NS_DRAW_TO_BUFFER
+#ifdef NS_IMPL_COCOA
/* If the frame has been garbaged but the toolkit wants to draw, for
example when resizing the frame, we end up with a blank screen.
Sometimes this results in an unpleasant flicker, so try to
- redisplay before drawing. */
-- (void)viewWillDraw
+ redisplay before drawing.
+
+ This used to be done in viewWillDraw, but with the custom layer
+ that method is not called. We cannot call redisplay directly from
+ [NSView layout], because it may trigger another round of layout by
+ changing the frame size and recursive layout calls are banned. It
+ appears to be safe to call redisplay here. */
+- (void)layoutSublayersOfLayer:(CALayer *)layer
{
- if (FRAME_GARBAGED_P (emacsframe)
- && !redisplaying_p
- && [self wantsUpdateLayer])
+ if (!redisplaying_p && FRAME_GARBAGED_P (emacsframe))
{
/* If there is IO going on when redisplay is run here Emacs
crashes. I think it's because this code will always be run
@@ -8365,45 +7961,8 @@ not_in_argv (NSString *arg)
waiting_for_input = owfi;
}
}
-
-
-- (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;
-}
-
-
-- (void)updateLayer
-{
- NSTRACE ("[EmacsView updateLayer]");
-
- /* We run redisplay on frames that are garbaged, but marked for
- display, before updateLayer is called so if the frame is still
- garbaged that means the last redisplay must have refused to
- update the frame. */
- if (FRAME_GARBAGED_P (emacsframe))
- return;
-
- /* This can fail to update the screen if the same surface is
- provided twice in a row, even if its contents have changed.
- There's a private method, -[CALayer setContentsChanged], that we
- could use to force it, but we shouldn't often get the same
- surface twice in a row. */
- [surface releaseContext];
- [[self layer] setContents:(id)[surface getSurface]];
- [surface performSelectorOnMainThread:@selector (getContext)
- withObject:nil
- waitUntilDone:NO];
-}
-#endif
-
-
- (void)drawRect: (NSRect)rect
{
NSTRACE ("[EmacsView drawRect:" NSTRACE_FMT_RECT "]",
@@ -8647,6 +8206,242 @@ not_in_argv (NSString *arg)
@implementation EmacsWindow
+
+- (instancetype) initWithEmacsFrame:(struct frame *)f
+{
+ return [self initWithEmacsFrame:f fullscreen:NO screen:nil];
+}
+
+
+- (instancetype) initWithEmacsFrame:(struct frame *)f
+ fullscreen:(BOOL)fullscreen
+ screen:(NSScreen *)screen
+{
+ NSWindowStyleMask styleMask;
+
+ NSTRACE ("[EmacsWindow initWithEmacsFrame:fullscreen:screen:]");
+
+ if (fullscreen)
+ styleMask = NSWindowStyleMaskBorderless;
+ else if (FRAME_UNDECORATED (f))
+ styleMask = FRAME_UNDECORATED_FLAGS;
+ else
+ styleMask = FRAME_DECORATED_FLAGS;
+
+
+ self = [super initWithContentRect:
+ NSMakeRect (0, 0,
+ FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols),
+ FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f,
f->text_lines))
+ styleMask:styleMask
+ backing:NSBackingStoreBuffered
+ defer:YES
+ screen:screen];
+ if (self)
+ {
+ NSString *name;
+ NSColor *col;
+ NSScreen *screen = [self screen];
+ EmacsView *view = FRAME_NS_VIEW (f);
+
+ [self setDelegate:view];
+ [[self contentView] addSubview:view];
+ [self makeFirstResponder:view];
+
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090
+#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090
+ if ([self respondsToSelector: @selector(useOptimizedDrawing:)])
+#endif
+ [self useOptimizedDrawing:YES];
+#endif
+
+ [self setAcceptsMouseMovedEvents:YES];
+
+ name = NILP (f->name) ? @"Emacs" : [NSString
stringWithLispString:f->name];
+ [self setTitle:name];
+
+ if (!NILP (f->icon_name))
+ [self setMiniwindowTitle:
+ [NSString stringWithLispString:f->icon_name]];
+
+ [self setAppearance];
+
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
+ if ([self respondsToSelector:@selector(titlebarAppearsTransparent)])
+ [self setTitlebarAppearsTransparent:FRAME_NS_TRANSPARENT_TITLEBAR (f)];
+#endif
+
+ [self setParentChildRelationships];
+
+ if (FRAME_Z_GROUP (f) != z_group_none)
+ [self setLevel:NSNormalWindowLevel + (FRAME_Z_GROUP_BELOW (f) ? -1 :
1)];
+
+ if (screen != 0)
+ {
+ NSPoint pt = NSMakePoint
+ (IN_BOUND (-SCREENMAX, f->left_pos
+ + NS_PARENT_WINDOW_LEFT_POS (f), SCREENMAX),
+ IN_BOUND (-SCREENMAX,
+ NS_PARENT_WINDOW_TOP_POS (f) - f->top_pos,
+ SCREENMAX));
+
+ [self setFrameTopLeftPoint:pt];
+
+ NSTRACE_RECT ("new frame", [self frame]);
+ }
+
+ f->border_width = [self borderWidth];
+
+ col = ns_lookup_indexed_color (NS_FACE_BACKGROUND
+ (FACE_FROM_ID (f, DEFAULT_FACE_ID)),
+ f);
+ [self setBackgroundColor:col];
+ if ([col alphaComponent] != (EmacsCGFloat) 1.0)
+ [self setOpaque:NO];
+
+ /* toolbar support */
+ if (! FRAME_UNDECORATED (f))
+ [self createToolbar:f];
+
+ /* macOS Sierra automatically enables tabbed windows. We can't
+ allow this to be enabled until it's available on a Free system.
+ Currently it only happens by accident and is buggy anyway. */
+#ifdef NS_IMPL_COCOA
+ if ([self respondsToSelector:@selector(setTabbingMode:)])
+ [self setTabbingMode:NSWindowTabbingModeDisallowed];
+#endif
+ }
+
+ return self;
+}
+
+
+- (void)createToolbar: (struct frame *)f
+{
+ EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
+
+ EmacsToolbar *toolbar = [[EmacsToolbar alloc]
+ initForView:view
+ withIdentifier:[NSString
stringWithLispString:f->name]];
+ [self setToolbar:toolbar];
+
+ update_frame_tool_bar (f);
+
+#ifdef NS_IMPL_COCOA
+ {
+ NSButton *toggleButton;
+ toggleButton = [self standardWindowButton:NSWindowToolbarButton];
+ [toggleButton setTarget:view];
+ [toggleButton setAction:@selector (toggleToolbar:)];
+ }
+#endif
+}
+
+- (void)dealloc
+{
+ NSTRACE ("[EmacsWindow dealloc]");
+
+ /* We need to release the toolbar ourselves. */
+ [[self toolbar] release];
+ [super dealloc];
+}
+
+- (NSInteger) borderWidth
+{
+ return NSWidth ([self frame]) - NSWidth ([[self contentView] frame]);
+}
+
+
+- (void)setParentChildRelationships
+ /* After certain operations, for example making a frame visible or
+ resetting the NSWindow through modifying the undecorated status,
+ the parent/child relationship may be broken. We can also use
+ this method to set them, as long as the frame struct already has
+ the correct relationship set. */
+{
+ NSTRACE ("[EmacsWindow setParentChildRelationships]");
+
+ Lisp_Object frame, tail;
+ EmacsView *ourView = (EmacsView *)[self delegate];
+ struct frame *ourFrame = ourView->emacsframe;
+ struct frame *parentFrame = FRAME_PARENT_FRAME (ourFrame);
+ EmacsWindow *oldParentWindow = (EmacsWindow *)[self parentWindow];
+
+
+#ifdef NS_IMPL_COCOA
+ /* We have to set the accessibility subroles and/or the collection
+ behaviors early otherwise child windows may not go fullscreen as
+ expected later. */
+
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000
+ if ([child respondsToSelector:@selector(setAccessibilitySubrole:)])
+#endif
+ /* Set the accessibility subroles. */
+ if (parentFrame)
+ [self setAccessibilitySubrole:NSAccessibilityFloatingWindowSubrole];
+ else
+ [self setAccessibilitySubrole:NSAccessibilityStandardWindowSubrole];
+
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+ [ourView updateCollectionBehavior];
+#endif
+#endif
+
+
+ /* Check if we have an incorrectly set parent. */
+ if ((! parentFrame && oldParentWindow)
+ || (parentFrame && oldParentWindow
+ && ((EmacsView *)[oldParentWindow delegate])->emacsframe !=
parentFrame))
+ {
+ [[self parentWindow] removeChildWindow:self];
+
+#ifdef NS_IMPL_COCOA
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ if ([ourView respondsToSelector:@selector (toggleFullScreen)]
+#endif
+ /* If we are the descendent of a fullscreen window and we
+ have no new parent, go fullscreen. */
+ {
+ NSWindow *parent = (NSWindow *)oldParentWindow;
+ while (parent)
+ {
+ if (([parent styleMask] & NSWindowStyleMaskFullScreen) != 0)
+ {
+ [ourView toggleFullScreen:self];
+ break;
+ }
+ parent = [parent parentWindow];
+ }
+ }
+#endif
+ }
+
+ if (parentFrame)
+ {
+ NSWindow *parentWindow = [FRAME_NS_VIEW (parentFrame) window];
+
+#ifdef NS_IMPL_COCOA
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ if ([ourView respondsToSelector:@selector (toggleFullScreen)]
+#endif
+ /* Child frames must not be fullscreen. */
+ if ([ourView fsIsNative] && [ourView isFullscreen])
+ [ourView toggleFullScreen:self];
+#endif
+
+ [parentWindow addChildWindow:self
+ ordered:NSWindowAbove];
+ }
+
+ /* Check our child windows are configured correctly. */
+ FOR_EACH_FRAME (tail, frame)
+ {
+ if (FRAME_PARENT_FRAME (XFRAME (frame)) == ourFrame)
+ [(EmacsWindow *)[FRAME_NS_VIEW (XFRAME (frame)) window]
setParentChildRelationships];
+ }
+}
+
+
/* It seems the only way to reorder child frames is by removing them
from the parent and then reattaching them in the correct order. */
@@ -9056,22 +8851,15 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
{
return !FRAME_NO_ACCEPT_FOCUS (((EmacsView *)[self delegate])->emacsframe);
}
-@end /* EmacsWindow */
-
-
-@implementation EmacsFSWindow
-
-- (BOOL)canBecomeKeyWindow
-{
- return YES;
-}
- (BOOL)canBecomeMainWindow
+ /* Required for fullscreen and undecorated windows. */
{
return YES;
}
-@end
+@end /* EmacsWindow */
+
/* ==========================================================================
@@ -9570,7 +9358,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
@end /* EmacsScroller */
-#ifdef NS_DRAW_TO_BUFFER
+#ifdef NS_IMPL_COCOA
/* ==========================================================================
@@ -9578,7 +9366,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
==========================================================================
*/
-@implementation EmacsSurface
+@implementation EmacsLayer
/* An IOSurface is a pixel buffer that is efficiently copied to VRAM
@@ -9591,80 +9379,109 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
ability to draw to the screen at any time, we need to keep a cache
of multiple surfaces that we can use at will.
- The EmacsSurface class maintains this cache of surfaces, and
+ The EmacsLayer class maintains this cache of surfaces, and
handles the conversion to a CGGraphicsContext that AppKit can use
to draw on.
The cache is simple: if a free surface is found it is removed from
- the cache and set as the "current" surface. Once Emacs is done
- with drawing to the current surface, the previous surface that was
- drawn to is added to the cache for reuse, and the current one is
- set as the last surface. If no free surfaces are found in the
- cache then a new one is created.
-
- When AppKit wants to update the screen, we provide it with the last
- surface, as that has the most recent data.
-
- FIXME: It is possible for the cache to grow if Emacs draws faster
- than the surfaces can be drawn to the screen, so there should
- probably be some sort of pruning job that removes excess
- surfaces. */
+ the cache and set as the "current" surface. Emacs draws to the
+ surface and when the layer wants to update the screen we set it's
+ contents to the surface and then add it back on to the end of the
+ cache. If no free surfaces are found in the cache then a new one
+ is created. */
#define CACHE_MAX_SIZE 2
-- (id) initWithSize: (NSSize)s
- ColorSpace: (CGColorSpaceRef)cs
- Scale: (CGFloat)scl
+- (id) initWithColorSpace: (CGColorSpaceRef)cs
{
- NSTRACE ("[EmacsSurface initWithSize:ColorSpace:]");
+ NSTRACE ("[EmacsLayer initWithColorSpace:]");
- [super init];
-
- cache = [[NSMutableArray arrayWithCapacity:CACHE_MAX_SIZE] retain];
- size = s;
- colorSpace = cs;
- scale = scl;
+ self = [super init];
+ if (self)
+ {
+ cache = [[NSMutableArray arrayWithCapacity:CACHE_MAX_SIZE] retain];
+ [self setColorSpace:cs];
+ }
+ else
+ {
+ return nil;
+ }
return self;
}
-- (void) dealloc
+- (void) setColorSpace: (CGColorSpaceRef)cs
{
- if (context)
- CGContextRelease (context);
-
- if (currentSurface)
- CFRelease (currentSurface);
+ /* We don't need to clear the cache because the new colorspace will
+ be used next time we create a new context. */
+ if (cs)
+ colorSpace = cs;
+ else
+ colorSpace = CGColorSpaceCreateWithName(kCGColorSpaceGenericRGB);
+}
- for (id object in cache)
- CFRelease ((IOSurfaceRef)object);
+- (void) dealloc
+{
+ [self releaseSurfaces];
[cache release];
[super dealloc];
}
-/* Return the size values our cached data is using. */
-- (NSSize) getSize
+- (void) releaseSurfaces
{
- return size;
+ [self setContents:nil];
+ [self releaseContext];
+
+ if (currentSurface)
+ {
+ CFRelease (currentSurface);
+ currentSurface = nil;
+ }
+
+ if (cache)
+ {
+ for (id object in cache)
+ CFRelease ((IOSurfaceRef)object);
+
+ [cache removeAllObjects];
+ }
}
-/* Return a CGContextRef that can be used for drawing to the screen.
- This must ALWAYS be paired with a call to releaseContext, and the
- calls cannot be nested. */
+/* Check whether the current bounds match the IOSurfaces we are using.
+ If they do return YES, otherwise NO. */
+- (BOOL) checkDimensions
+{
+ int width = NSWidth ([self bounds]) * [self contentsScale];
+ int height = NSHeight ([self bounds]) * [self contentsScale];
+ IOSurfaceRef s = currentSurface ? currentSurface
+ : (IOSurfaceRef)[cache firstObject];
+
+ return !s || (IOSurfaceGetWidth (s) == width
+ && IOSurfaceGetHeight (s) == height);
+}
+
+
+/* Return a CGContextRef that can be used for drawing to the screen. */
- (CGContextRef) getContext
{
- NSTRACE ("[EmacsSurface getContext]");
+ CGFloat scale = [self contentsScale];
+
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer getContext]");
+ NSTRACE_MSG ("IOSurface count: %lu", [cache count] + (currentSurface ? 1 :
0));
+
+ if (![self checkDimensions])
+ [self releaseSurfaces];
if (!context)
{
IOSurfaceRef surface = NULL;
-
- NSTRACE_MSG ("IOSurface count: %lu", [cache count] + (lastSurface ? 1 :
0));
+ int width = NSWidth ([self bounds]) * scale;
+ int height = NSHeight ([self bounds]) * scale;
for (id object in cache)
{
@@ -9687,16 +9504,22 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
else if (!surface)
{
int bytesPerRow = IOSurfaceAlignProperty (kIOSurfaceBytesPerRow,
- size.width * 4);
+ width * 4);
surface = IOSurfaceCreate
- ((CFDictionaryRef)@{(id)kIOSurfaceWidth:[NSNumber
numberWithInt:size.width],
- (id)kIOSurfaceHeight:[NSNumber numberWithInt:size.height],
+ ((CFDictionaryRef)@{(id)kIOSurfaceWidth:[NSNumber
numberWithInt:width],
+ (id)kIOSurfaceHeight:[NSNumber numberWithInt:height],
(id)kIOSurfaceBytesPerRow:[NSNumber numberWithInt:bytesPerRow],
(id)kIOSurfaceBytesPerElement:[NSNumber numberWithInt:4],
(id)kIOSurfacePixelFormat:[NSNumber
numberWithUnsignedInt:'BGRA']});
}
+ if (!surface)
+ {
+ NSLog (@"Failed to create IOSurface for frame %@", [self delegate]);
+ return nil;
+ }
+
IOReturn lockStatus = IOSurfaceLock (surface, 0, nil);
if (lockStatus != kIOReturnSuccess)
NSLog (@"Failed to lock surface: %x", lockStatus);
@@ -9714,7 +9537,16 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
(kCGImageAlphaPremultipliedFirst
| kCGBitmapByteOrder32Host));
- CGContextTranslateCTM(context, 0, size.height);
+ if (!context)
+ {
+ NSLog (@"Failed to create context for frame %@", [self delegate]);
+ IOSurfaceUnlock (currentSurface, 0, nil);
+ CFRelease (currentSurface);
+ currentSurface = nil;
+ return nil;
+ }
+
+ CGContextTranslateCTM(context, 0, IOSurfaceGetHeight (currentSurface));
CGContextScaleCTM(context, scale, -scale);
}
@@ -9726,7 +9558,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
IOSurface, so it will be sent to VRAM. */
- (void) releaseContext
{
- NSTRACE ("[EmacsSurface releaseContextAndGetSurface]");
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer releaseContext]");
if (!context)
return;
@@ -9737,19 +9569,34 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
IOReturn lockStatus = IOSurfaceUnlock (currentSurface, 0, nil);
if (lockStatus != kIOReturnSuccess)
NSLog (@"Failed to unlock surface: %x", lockStatus);
-
- /* Put currentSurface back on the end of the cache. */
- [cache addObject:(id)currentSurface];
- lastSurface = currentSurface;
- currentSurface = NULL;
}
-/* Get the IOSurface that we want to draw to the screen. */
-- (IOSurfaceRef) getSurface
+- (void) display
{
- /* lastSurface always contains the most up-to-date and complete data. */
- return lastSurface;
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer display]");
+
+ if (context)
+ {
+ [self releaseContext];
+
+#if CACHE_MAX_SIZE == 1
+ /* This forces the layer to see the surface as updated. */
+ [self setContents:nil];
+#endif
+
+ [self setContents:(id)currentSurface];
+
+ /* Put currentSurface back on the end of the cache. */
+ [cache addObject:(id)currentSurface];
+ currentSurface = NULL;
+
+ /* Schedule a run of getContext so that if Emacs is idle it will
+ perform the buffer copy, etc. */
+ [self performSelectorOnMainThread:@selector (getContext)
+ withObject:nil
+ waitUntilDone:NO];
+ }
}
@@ -9759,19 +9606,20 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
- (void) copyContentsTo: (IOSurfaceRef) destination
{
IOReturn lockStatus;
+ IOSurfaceRef source = (IOSurfaceRef)[self contents];
void *sourceData, *destinationData;
int numBytes = IOSurfaceGetAllocSize (destination);
- NSTRACE ("[EmacsSurface copyContentsTo:]");
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer copyContentsTo:]");
- if (!lastSurface || lastSurface == destination)
+ if (!source || source == destination)
return;
- lockStatus = IOSurfaceLock (lastSurface, kIOSurfaceLockReadOnly, nil);
+ lockStatus = IOSurfaceLock (source, kIOSurfaceLockReadOnly, nil);
if (lockStatus != kIOReturnSuccess)
NSLog (@"Failed to lock source surface: %x", lockStatus);
- sourceData = IOSurfaceGetBaseAddress (lastSurface);
+ sourceData = IOSurfaceGetBaseAddress (source);
destinationData = IOSurfaceGetBaseAddress (destination);
/* Since every IOSurface should have the exact same settings, a
@@ -9779,17 +9627,17 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
the other. */
memcpy (destinationData, sourceData, numBytes);
- lockStatus = IOSurfaceUnlock (lastSurface, kIOSurfaceLockReadOnly, nil);
+ lockStatus = IOSurfaceUnlock (source, kIOSurfaceLockReadOnly, nil);
if (lockStatus != kIOReturnSuccess)
NSLog (@"Failed to unlock source surface: %x", lockStatus);
}
#undef CACHE_MAX_SIZE
-@end /* EmacsSurface */
+@end /* EmacsLayer */
-#endif
+#endif /* NS_IMPL_COCOA */
#ifdef NS_IMPL_GNUSTEP
diff --git a/src/process.c b/src/process.c
index c3186ee..bfca165 100644
--- a/src/process.c
+++ b/src/process.c
@@ -1718,7 +1718,10 @@ to use a pty, or nil to use the default specified through
:stderr STDERR -- STDERR is either a buffer or a pipe process attached
to the standard error of subprocess. Specifying this implies
`:connection-type' is set to `pipe'. If STDERR is nil, standard error
-is mixed with standard output and sent to BUFFER or FILTER.
+is mixed with standard output and sent to BUFFER or FILTER. (Note
+that specifying :stderr will create a new, separate (but associated)
+process, with its own filter and sentinel. See
+Info node `(elisp) Asynchronous Processes' for more details.)
:file-handler FILE-HANDLER -- If FILE-HANDLER is non-nil, then look
for a file name handler for the current buffer's `default-directory'
diff --git a/src/search.c b/src/search.c
index df384e1..14adeb5 100644
--- a/src/search.c
+++ b/src/search.c
@@ -30,6 +30,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "blockinput.h"
#include "intervals.h"
#include "pdumper.h"
+#include "composite.h"
#include "regex-emacs.h"
@@ -2725,7 +2726,7 @@ since only regular expressions have distinguished
subexpressions. */)
newpoint = sub_start + SCHARS (newtext);
/* Replace the old text with the new in the cleanest possible way. */
- replace_range (sub_start, sub_end, newtext, 1, 0, 1, true);
+ replace_range (sub_start, sub_end, newtext, 1, 0, 1, true, true);
if (case_action == all_caps)
Fupcase_region (make_fixnum (search_regs.start[sub]),
@@ -2750,6 +2751,9 @@ since only regular expressions have distinguished
subexpressions. */)
/* Now move point "officially" to the end of the inserted replacement. */
move_if_not_intangible (newpoint);
+ signal_after_change (sub_start, sub_end - sub_start, SCHARS (newtext));
+ update_compositions (sub_start, newpoint, CHECK_BORDER);
+
return Qnil;
}
diff --git a/src/syntax.c b/src/syntax.c
index 7bba336..057a4c3 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -17,7 +17,6 @@ GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
-
#include <config.h>
#include "lisp.h"
@@ -3547,8 +3546,10 @@ DEFUN ("parse-partial-sexp", Fparse_partial_sexp,
Sparse_partial_sexp, 2, 6, 0,
doc: /* Parse Lisp syntax starting at FROM until TO; return status of
parse at TO.
Parsing stops at TO or when certain criteria are met;
point is set to where parsing stops.
-If fifth arg OLDSTATE is omitted or nil,
- parsing assumes that FROM is the beginning of a function.
+
+If OLDSTATE is omitted or nil, parsing assumes that FROM is the
+ beginning of a function. If not, OLDSTATE should be the state at
+ FROM.
Value is a list of elements describing final state of parsing:
0. depth in parens.
@@ -3594,6 +3595,9 @@ Sixth arg COMMENTSTOP non-nil means stop after the start
of a comment.
else
target = TYPE_MINIMUM (EMACS_INT); /* We won't reach this depth. */
+ if (fix_position (to) < fix_position (from))
+ error ("End position is smaller than start position");
+
validate_region (&from, &to);
internalize_parse_state (oldstate, &state);
scan_sexps_forward (&state, XFIXNUM (from), CHAR_TO_BYTE (XFIXNUM (from)),
diff --git a/src/term.c b/src/term.c
index c995a44..6651b96 100644
--- a/src/term.c
+++ b/src/term.c
@@ -2169,6 +2169,14 @@ set_tty_color_mode (struct tty_display_info *tty, struct
frame *f)
#endif /* !DOS_NT */
+char *
+tty_type_name (Lisp_Object terminal)
+{
+ struct terminal *t = decode_tty_terminal (terminal);
+
+ return t? t->display_info.tty->type: NULL;
+}
+
DEFUN ("tty-type", Ftty_type, Stty_type, 0, 1, 0,
doc: /* Return the type of the tty device that TERMINAL uses.
Returns nil if TERMINAL is not on a tty device.
@@ -2177,10 +2185,9 @@ TERMINAL can be a terminal object, a frame, or nil
(meaning the
selected frame's terminal). */)
(Lisp_Object terminal)
{
- struct terminal *t = decode_tty_terminal (terminal);
+ char *name = tty_type_name (terminal);
- return (t && t->display_info.tty->type
- ? build_string (t->display_info.tty->type) : Qnil);
+ return (name? build_string (name) : Qnil);
}
DEFUN ("controlling-tty-p", Fcontrolling_tty_p, Scontrolling_tty_p, 0, 1, 0,
diff --git a/src/w32.c b/src/w32.c
index 968b4bb..0eb69d4 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -2389,8 +2389,13 @@ rand_as183 (void)
int
random (void)
{
- /* rand_as183 () gives us 15 random bits...hack together 30 bits. */
+ /* rand_as183 () gives us 15 random bits...hack together 30 bits for
+ Emacs with 32-bit EMACS_INT, and at least 31 bit for wider EMACS_INT. */
+#if EMACS_INT_MAX > INT_MAX
+ return ((rand_as183 () << 30) | (rand_as183 () << 15) | rand_as183 ());
+#else
return ((rand_as183 () << 15) | rand_as183 ());
+#endif
}
void
@@ -8753,7 +8758,7 @@ int
_sys_read_ahead (int fd)
{
child_process * cp;
- int rc;
+ int rc = 0;
if (fd < 0 || fd >= MAXDESC)
return STATUS_READ_ERROR;
diff --git a/src/xdisp.c b/src/xdisp.c
index 70d15ae..b2fcc16 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -4472,7 +4472,13 @@ face_at_pos (const struct it *it, enum
lface_attribute_index attr_filter)
static enum prop_handled
handle_face_prop (struct it *it)
{
+ ptrdiff_t count = SPECPDL_INDEX ();
+ /* Don't allow the user to quit out of face-merging code, in case
+ this is called when redisplaying a non-selected window, with
+ point temporarily moved to window-point. */
+ specbind (Qinhibit_quit, Qt);
const int new_face_id = face_at_pos (it, 0);
+ unbind_to (count, Qnil);
/* Is this a start of a run of characters with box face?
@@ -4595,6 +4601,7 @@ face_before_or_after_it_pos (struct it *it, bool before_p)
SAVE_IT (it_copy, *it, it_copy_data);
IT_STRING_CHARPOS (it_copy) = 0;
bidi_init_it (0, 0, FRAME_WINDOW_P (it_copy.f), &it_copy.bidi_it);
+ it_copy.bidi_it.scan_dir = 0;
do
{
@@ -5781,8 +5788,15 @@ handle_single_display_spec (struct it *it, Lisp_Object
spec, Lisp_Object object,
#ifdef HAVE_WINDOW_SYSTEM
else
{
+ ptrdiff_t count = SPECPDL_INDEX ();
+
it->what = IT_IMAGE;
+ /* Don't allow quitting from lookup_image, for when we are
+ displaying a non-selected window, and the buffer's point
+ was temporarily moved to the window-point. */
+ specbind (Qinhibit_quit, Qt);
it->image_id = lookup_image (it->f, value, it->face_id);
+ unbind_to (count, Qnil);
it->position = start_pos;
it->object = NILP (object) ? it->w->contents : object;
it->method = GET_FROM_IMAGE;
@@ -11757,7 +11771,7 @@ display_echo_area (struct window *w)
/* If there is no message, we must call display_echo_area_1
nevertheless because it resizes the window. But we will have to
reset the echo_area_buffer in question to nil at the end because
- with_echo_area_buffer will sets it to an empty buffer. */
+ with_echo_area_buffer will set it to an empty buffer. */
bool i = display_last_displayed_message_p;
/* According to the C99, C11 and C++11 standards, the integral value
of a "bool" is always 0 or 1, so this array access is safe here,
@@ -14884,7 +14898,15 @@ hscroll_window_tree (Lisp_Object window)
if (WINDOWP (w->contents))
hscrolled_p |= hscroll_window_tree (w->contents);
- else if (w->cursor.vpos >= 0)
+ else if (w->cursor.vpos >= 0
+ /* Don't allow hscroll in mini-windows that display
+ echo-area messages. This is because desired_matrix
+ of such windows was prepared while momentarily
+ switched to an echo-area buffer, which is different
+ from w->contents, and we simply cannot hscroll such
+ windows safely. */
+ && !(w == XWINDOW (echo_area_window)
+ && !NILP (echo_area_buffer[0])))
{
int h_margin;
int text_area_width;
@@ -15082,11 +15104,12 @@ hscroll_window_tree (Lisp_Object window)
else
{
if (hscroll_relative_p)
- wanted_x = text_area_width * hscroll_step_rel
- + h_margin;
+ wanted_x =
+ text_area_width * hscroll_step_rel + h_margin + x_offset;
else
- wanted_x = hscroll_step_abs * FRAME_COLUMN_WIDTH (it.f)
- + h_margin;
+ wanted_x =
+ hscroll_step_abs * FRAME_COLUMN_WIDTH (it.f)
+ + h_margin + x_offset;
hscroll
= max (0, it.current_x - wanted_x) / FRAME_COLUMN_WIDTH
(it.f);
}
@@ -17274,8 +17297,11 @@ run_window_scroll_functions (Lisp_Object window,
struct text_pos startp)
if (!NILP (Vwindow_scroll_functions))
{
+ ptrdiff_t count = SPECPDL_INDEX ();
+ specbind (Qinhibit_quit, Qt);
run_hook_with_args_2 (Qwindow_scroll_functions, window,
make_fixnum (CHARPOS (startp)));
+ unbind_to (count, Qnil);
SET_TEXT_POS_FROM_MARKER (startp, w->start);
/* In case the hook functions switch buffers. */
set_buffer_internal (XBUFFER (w->contents));
@@ -19268,7 +19294,7 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
w->start_at_line_beg = (CHARPOS (startp) == BEGV
|| FETCH_BYTE (BYTEPOS (startp) - 1) == '\n');
- /* Display the mode line, if we must. */
+ /* Display the mode line, header line, and tab-line, if we must. */
if ((update_mode_line
/* If window not full width, must redo its mode line
if (a) the window to its side is being redone and
@@ -19287,8 +19313,11 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
|| window_wants_header_line (w)
|| window_wants_tab_line (w)))
{
+ ptrdiff_t count1 = SPECPDL_INDEX ();
+ specbind (Qinhibit_quit, Qt);
display_mode_lines (w);
+ unbind_to (count1, Qnil);
/* If mode line height has changed, arrange for a thorough
immediate redisplay using the correct mode line height. */
@@ -19336,7 +19365,7 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
finish_menu_bars:
/* When we reach a frame's selected window, redo the frame's menu
- bar and the frame's title. */
+ bar, tool bar, tab-bar, and the frame's title. */
if (update_mode_line
&& EQ (FRAME_SELECTED_WINDOW (f), window))
{
@@ -22104,10 +22133,17 @@ extend_face_to_end_of_line (struct it *it)
|| WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0))
return;
+ ptrdiff_t count = SPECPDL_INDEX ();
+
+ /* Don't allow the user to quit out of face-merging code, in case
+ this is called when redisplaying a non-selected window, with
+ point temporarily moved to window-point. */
+ specbind (Qinhibit_quit, Qt);
const int extend_face_id = (it->face_id == DEFAULT_FACE_ID
|| it->s != NULL)
? DEFAULT_FACE_ID
: face_at_pos (it, LFACE_EXTEND_INDEX);
+ unbind_to (count, Qnil);
/* Face extension extends the background and box of IT->extend_face_id
to the end of the line. If the background equals the background
@@ -25427,8 +25463,9 @@ redisplay_mode_lines (Lisp_Object window, bool force)
}
-/* Display the mode and/or header line of window W. Value is the
- sum number of mode lines and header lines displayed. */
+/* Display the mode line, the header line, and the tab-line of window
+ W. Value is the sum number of mode lines, header lines, and tab
+ lines actually displayed. */
static int
display_mode_lines (struct window *w)
@@ -27008,7 +27045,7 @@ decode_mode_spec (struct window *w, register int c, int
field_width,
Lisp_Object val = Qnil;
if (STRINGP (curdir))
- val = call1 (intern ("file-remote-p"), curdir);
+ val = safe_call1 (intern ("file-remote-p"), curdir);
val = unbind_to (count, val);
@@ -35099,7 +35136,10 @@ not span the full frame width.
A value of nil means to respect the value of `truncate-lines'.
-If `word-wrap' is enabled, you might want to reduce this. */);
+If `word-wrap' is enabled, you might want to reduce the value of this.
+
+Don't set this to a non-nil value when `visual-line-mode' is
+turned on, as it could produce confusing results. */);
Vtruncate_partial_width_windows = make_fixnum (50);
DEFVAR_BOOL("word-wrap-by-category", word_wrap_by_category, doc: /*
@@ -35408,7 +35448,7 @@ and `scroll-right' overrides this variable's effect.
*/);
Vhscroll_step = make_fixnum (0);
DEFVAR_BOOL ("message-truncate-lines", message_truncate_lines,
- doc: /* If non-nil, messages are truncated instead of resizing the echo
area.
+ doc: /* If non-nil, messages are truncated when displaying the echo area.
Bind this around calls to `message' to let it take effect. */);
message_truncate_lines = false;
diff --git a/src/xfaces.c b/src/xfaces.c
index 207f0d6..2273fb4 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -5092,8 +5092,8 @@ gui_supports_face_attributes_p (struct frame *f,
{
Lisp_Object *def_attrs = def_face->lface;
- /* Check that other specified attributes are different that the default
- face. */
+ /* Check that other specified attributes are different from the
+ default face. */
if ((!UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX])
&& face_attr_equal_p (attrs[LFACE_UNDERLINE_INDEX],
def_attrs[LFACE_UNDERLINE_INDEX]))
diff --git a/src/xfns.c b/src/xfns.c
index 81349d0..0d0335c 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -7836,7 +7836,6 @@ syms_of_xfns (void)
DEFSYM (Qfont_parameter, "font-parameter");
DEFSYM (Qmono, "mono");
DEFSYM (Qassq_delete_all, "assq-delete-all");
- DEFSYM (Qhide, "hide");
DEFSYM (Qresize_mode, "resize-mode");
#ifdef USE_CAIRO
diff --git a/src/xftfont.c b/src/xftfont.c
index f734931..d8ad403 100644
--- a/src/xftfont.c
+++ b/src/xftfont.c
@@ -33,6 +33,12 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "ftfont.h"
#include "pdumper.h"
+#ifndef FC_LCD_FILTER
+/* Older fontconfig versions don't have FC_LCD_FILTER. */
+# define FC_LCD_FILTER "lcdfilter"
+#endif
+
+
/* Xft font driver. */
/* Structure pointed by (struct face *)->extra */
diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba
index 9f03482..0b61c74 100644
--- a/test/infra/Dockerfile.emba
+++ b/test/infra/Dockerfile.emba
@@ -82,6 +82,6 @@ ARG make_bootstrap_params=""
COPY . /checkout
WORKDIR /checkout
RUN ./autogen.sh autoconf
-RUN ./configure --with-nativecomp
+RUN ./configure --with-native-compilation
RUN make bootstrap -j2 NATIVE_FULL_AOT=1 BYTE_COMPILE_EXTRA_FLAGS='--eval
"(setq comp-speed 0)"'
RUN make -j4
diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml
index 6876a8b..5082b08 100644
--- a/test/infra/gitlab-ci.yml
+++ b/test/infra/gitlab-ci.yml
@@ -291,7 +291,7 @@ build-native-bootstrap-speed0:
# script:
# - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y
-qq -o=Dpkg::Use-Pty=0 libgccjit-6-dev
# - ./autogen.sh autoconf
-# - ./configure --with-nativecomp
+# - ./configure --with-native-compilation
# - make bootstrap NATIVE_FULL_AOT=1 BYTE_COMPILE_EXTRA_FLAGS='--eval
"(setq comp-speed 0)"' -j2
# timeout: 8 hours
@@ -300,7 +300,7 @@ build-native-bootstrap-speed0:
# script:
# - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y
-qq -o=Dpkg::Use-Pty=0 libgccjit-6-dev
# - ./autogen.sh autoconf
-# - ./configure --with-nativecomp
+# - ./configure --with-native-compilation
# - make bootstrap BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 1)"'
# timeout: 8 hours
@@ -309,7 +309,7 @@ build-native-bootstrap-speed0:
# script:
# - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y
-qq -o=Dpkg::Use-Pty=0 libgccjit-6-dev
# - ./autogen.sh autoconf
-# - ./configure --with-nativecomp
+# - ./configure --with-native-compilation
# - make bootstrap
# timeout: 8 hours
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index 3e97e9c..96169c7 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -286,7 +286,7 @@ This expects `auto-revert--messages' to be bound by
;; Repeated unpredictable failures, bug#32645.
;; Unlikely to be hydra-specific?
; (skip-unless (not (getenv "EMACS_HYDRA_CI")))
-
+ :tags '(:unstable)
(with-auto-revert-test
(let ((tmpfile (make-temp-file "auto-revert-test"))
;; Try to catch bug#32645.
@@ -671,6 +671,12 @@ This expects `auto-revert--messages' to be bound by
(auto-revert--deftest-remote auto-revert-test07-auto-revert-several-buffers
"Check autorevert for several buffers visiting the same remote file.")
+;; Mark all tests as unstable on Cygwin (bug#49665).
+(when (eq system-type 'cygwin)
+ (dolist (test (apropos-internal "^auto-revert" #'ert-test-boundp))
+ (setf (ert-test-tags (ert-get-test test))
+ (cons :unstable (ert-test-tags (ert-get-test test))))))
+
(defun auto-revert-test-all (&optional interactive)
"Run all tests for \\[auto-revert]."
(interactive "p")
diff --git a/test/lisp/calendar/icalendar-tests.el
b/test/lisp/calendar/icalendar-tests.el
index 6973f7e..de2a891 100644
--- a/test/lisp/calendar/icalendar-tests.el
+++ b/test/lisp/calendar/icalendar-tests.el
@@ -1442,6 +1442,13 @@ RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=09;BYMONTHDAY=21
SUMMARY:ff birthday (%d years old)")
+ (icalendar-tests--test-export
+ nil
+ nil
+ "%%(diary-offset '(diary-float t 3 4) 1) asdf"
+ nil)
+
+
;; FIXME!
;; export 2004-10-28 monthly, weekly entries
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el
index e93c96e..f4c43b0 100644
--- a/test/lisp/custom-tests.el
+++ b/test/lisp/custom-tests.el
@@ -96,6 +96,7 @@ Ensure the directory is recursively deleted after the fact."
(ert-deftest custom-tests-require-theme ()
"Test `require-theme'."
+ (require 'warnings)
(custom-tests--with-temp-dir
(let* ((default-directory temporary-file-directory)
(custom-theme-load-path (list default-directory))
diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el
index 0a0d783..b55982c 100644
--- a/test/lisp/dom-tests.el
+++ b/test/lisp/dom-tests.el
@@ -209,5 +209,13 @@ child results in an error."
(dom-pp node t)
(should (equal (buffer-string) "(\"foo\" nil)")))))
+(ert-deftest dom-test-search ()
+ (let ((dom '(a nil (b nil (c nil)))))
+ (should (equal (dom-search dom (lambda (d) (eq (dom-tag d) 'a)))
+ (list dom)))
+ (should (equal (dom-search dom (lambda (d) (memq (dom-tag d) '(b c))))
+ (list (car (dom-children dom))
+ (car (dom-children (car (dom-children dom)))))))))
+
(provide 'dom-tests)
;;; dom-tests.el ends here
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el
index 235c02f..666de89 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -146,7 +146,7 @@ The buffer's contents should %s:
"")
char
(if (string= fixture expected-string) "stay" "become")
- (replace-regexp-in-string "\n" "\\\\n" expected-string)
+ (string-replace "\n" "\\n" expected-string)
expected-point)))
`(ert-deftest ,(intern (format "electric-pair-%s-at-point-%s-in-%s%s"
name
@@ -871,7 +871,7 @@ baz\"\""
(defun electric-layout-for-c-style-du-jour (inserted)
"A function to use in `electric-layout-rules'"
- (when (memq inserted '(?{ ?}))
+ (when (memq inserted '(?\{ ?\}))
(save-excursion
(backward-char 2) (c-point-syntax) (forward-char) ; silly, but needed
(c-brace-newlines (c-point-syntax)))))
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 7c40f7e..ac96494 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -432,6 +432,15 @@
(let ((x 2))
(list (or (bytecomp-test-identity 'a) (setq x 3)) x))
+ (mapcar (lambda (b)
+ (let ((a nil))
+ (+ 0
+ (progn
+ (setq a b)
+ (setq b 1)
+ a))))
+ '(10))
+
(let* ((x 1)
(y (condition-case x
(/ 1 0)
@@ -503,6 +512,45 @@
(:success 'good))
(1+ x))))
(funcall f 3))
+
+ ;; Check `not' in cond switch (bug#49746).
+ (mapcar (lambda (x) (cond ((equal x "a") 1)
+ ((member x '("b" "c")) 2)
+ ((not x) 3)))
+ '("a" "b" "c" "d" nil))
+
+ ;; `let' and `let*' optimisations with body being constant or variable
+ (let* (a
+ (b (progn (setq a (cons 1 a)) 2))
+ (c (1+ b))
+ (d (list a c)))
+ d)
+ (let ((a nil))
+ (let ((b (progn (setq a (cons 1 a)) 2))
+ (c (progn (setq a (cons 3 a))))
+ (d (list a)))
+ d))
+ (let* ((_a 1)
+ (_b 2))
+ 'z)
+ (let ((_a 1)
+ (_b 2))
+ 'z)
+
+ ;; Check empty-list optimisations.
+ (mapcar (lambda (x) (member x nil)) '("a" 2 nil))
+ (mapcar (lambda (x) (memql x nil)) '(a 2 nil))
+ (mapcar (lambda (x) (memq x nil)) '(a nil))
+ (let ((n 0))
+ (list (mapcar (lambda (x) (member (setq n (1+ n)) nil)) '(a "nil"))
+ n))
+ (mapcar (lambda (x) (assoc x nil)) '("a" nil))
+ (mapcar (lambda (x) (assq x nil)) '(a nil))
+ (mapcar (lambda (x) (rassoc x nil)) '("a" nil))
+ (mapcar (lambda (x) (rassq x nil)) '(a nil))
+ (let ((n 0))
+ (list (mapcar (lambda (x) (assoc (setq n (1+ n)) nil)) '(a "nil"))
+ n))
)
"List of expressions for cross-testing interpreted and compiled code.")
diff --git a/test/lisp/emacs-lisp/check-declare-tests.el
b/test/lisp/emacs-lisp/check-declare-tests.el
index 9552bf0..276530f 100644
--- a/test/lisp/emacs-lisp/check-declare-tests.el
+++ b/test/lisp/emacs-lisp/check-declare-tests.el
@@ -106,11 +106,11 @@
(let ((res (buffer-string)))
;; Don't care too much about the format of the output, but
;; check that key information is present.
- (should (string-match-p "foo-file" res))
- (should (string-match-p "foo-fun" res))
- (should (string-match-p "bar-file" res))
- (should (string-match-p "it wasn't" res))
- (should (string-match-p "999" res))))))
+ (should (string-search "foo-file" res))
+ (should (string-search "foo-fun" res))
+ (should (string-search "bar-file" res))
+ (should (string-search "it wasn't" res))
+ (should (string-search "999" res))))))
(provide 'check-declare-tests)
;;; check-declare-tests.el ends here
diff --git a/test/lisp/emacs-lisp/checkdoc-tests.el
b/test/lisp/emacs-lisp/checkdoc-tests.el
index 7a7aa9f..2a1d8b2 100644
--- a/test/lisp/emacs-lisp/checkdoc-tests.el
+++ b/test/lisp/emacs-lisp/checkdoc-tests.el
@@ -49,27 +49,27 @@
(with-temp-buffer
(emacs-lisp-mode)
;; this method matches if A is the symbol `smthg' and if b is a list:
- (insert "(cl-defmethod foo ((a (eql smthg)) (b list)) \"Return A+B.\")")
+ (insert "(cl-defmethod foo ((a (eql 'smthg)) (b list)) \"Return A+B.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defmethod-qualified-ok ()
"Checkdoc should be happy with a `cl-defmethod' using qualifiers."
(with-temp-buffer
(emacs-lisp-mode)
- (insert "(cl-defmethod test :around ((a (eql smthg))) \"Return A.\")")
+ (insert "(cl-defmethod test :around ((a (eql 'smthg))) \"Return A.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-ok ()
"Checkdoc should be happy with a :extra qualified `cl-defmethod'."
(with-temp-buffer
(emacs-lisp-mode)
- (insert "(cl-defmethod foo :extra \"foo\" ((a (eql smthg))) \"Return
A.\")")
+ (insert "(cl-defmethod foo :extra \"foo\" ((a (eql 'smthg))) \"Return
A.\")")
(checkdoc-defun))
(with-temp-buffer
(emacs-lisp-mode)
(insert
- "(cl-defmethod foo :extra \"foo\" :after ((a (eql smthg))) \"Return
A.\")")
+ "(cl-defmethod foo :extra \"foo\" :after ((a (eql 'smthg))) \"Return
A.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-and-nil-args-ok ()
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el
b/test/lisp/emacs-lisp/cl-generic-tests.el
index 9312fb4..dd7511e 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -56,7 +56,14 @@
(should (equal (cl--generic-1 'a nil) '(a)))
(should (equal (cl--generic-1 4 nil) '("quatre" 4)))
(should (equal (cl--generic-1 5 nil) '("cinq" 5)))
- (should (equal (cl--generic-1 6 nil) '("six" a))))
+ (should (equal (cl--generic-1 6 nil) '("six" a)))
+ (defvar cl--generic-fooval 41)
+ (cl-defmethod cl--generic-1 ((_x (eql (+ cl--generic-fooval 1))) _y)
+ "forty-two")
+ (cl-defmethod cl--generic-1 (_x (_y (eql 42)))
+ "FORTY-TWO")
+ (should (equal (cl--generic-1 42 nil) "forty-two"))
+ (should (equal (cl--generic-1 nil 42) "FORTY-TWO")))
(cl-defstruct cl-generic-struct-parent a b)
(cl-defstruct (cl-generic-struct-child1 (:include cl-generic-struct-parent)) c)
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el
b/test/lisp/emacs-lisp/cl-lib-tests.el
index a5ec62b..a132d73 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -417,22 +417,6 @@
(should-error (cl-nth-value -1 (cl-values 2 3)) :type 'args-out-of-range)
(should (string= (cl-nth-value 0 "only lists") "only lists")))
-(ert-deftest cl-test-caaar ()
- (should (null (cl-caaar '())))
- (should (null (cl-caaar '(() (2)))))
- (should (null (cl-caaar '((() (2)) (a b)))))
- (should-error (cl-caaar '(1 2)) :type 'wrong-type-argument)
- (should-error (cl-caaar '((1 2))) :type 'wrong-type-argument)
- (should (= 1 (cl-caaar '(((1 2) (3 4))))))
- (should (null (cl-caaar '((() (3 4)))))))
-
-(ert-deftest cl-test-caadr ()
- (should (null (cl-caadr '())))
- (should (null (cl-caadr '(1))))
- (should-error (cl-caadr '(1 2)) :type 'wrong-type-argument)
- (should (= 2 (cl-caadr '(1 (2 3)))))
- (should (equal '((2) (3)) (cl-caadr '((1) (((2) (3))) (4))))))
-
(ert-deftest cl-test-ldiff ()
(let ((l '(1 2 3)))
(should (null (cl-ldiff '() '())))
diff --git a/test/lisp/emacs-lisp/edebug-tests.el
b/test/lisp/emacs-lisp/edebug-tests.el
index 2f45050..f8fa223 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -723,7 +723,7 @@ test and possibly others should be updated."
(edebug-on-error nil)
error-message
(command-error-function (lambda (&rest args)
- (setq error-message (cl-cadar args)))))
+ (setq error-message (cadar args)))))
(edebug-tests-run-kbd-macro
"@" (edebug-tests-should-be-at "format-node" "start")
"SPC" (edebug-tests-should-be-at "format-node" "vectorp")
@@ -744,7 +744,7 @@ test and possibly others should be updated."
(edebug-on-error nil)
(error-message "")
(command-error-function (lambda (&rest args)
- (setq error-message (cl-cadar args)))))
+ (setq error-message (cadar args)))))
(edebug-tests-run-kbd-macro
"@ SPC SPC SPC SPC SPC"
(edebug-tests-should-be-at "try-flavors" "macro")
diff --git a/test/lisp/emacs-lisp/lisp-mnt-tests.el
b/test/lisp/emacs-lisp/lisp-mnt-tests.el
new file mode 100644
index 0000000..84cdc72
--- /dev/null
+++ b/test/lisp/emacs-lisp/lisp-mnt-tests.el
@@ -0,0 +1,36 @@
+;;; lisp-mnt-tests.el --- Tests for lisp-mnt -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 2020-2021 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'lisp-mnt)
+
+(ert-deftest lm--tests-crack-address ()
+ (should (equal (lm-crack-address
+ "Bob Weiner <rsw@gnu.org>, Mats Lidell <matsl@gnu.org>")
+ '(("Bob Weiner" . "rsw@gnu.org")
+ ("Mats Lidell" . "matsl@gnu.org")))))
+
+(provide 'lisp-mnt-tests)
+;;; lisp-mnt-tests.el ends here
diff --git a/test/lisp/emacs-lisp/map-tests.el
b/test/lisp/emacs-lisp/map-tests.el
index a04c6be..c0f0dbc 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -446,16 +446,24 @@ Evaluate BODY for each created map."
(ert-deftest test-map-merge ()
"Test `map-merge'."
- (should (equal (map-merge 'list '(a 1) '((b . 2) (c . 3))
- #s(hash-table data (c 4)))
- '((c . 4) (b . 2) (a . 1)))))
+ (should (equal (sort (map-merge 'list '(a 1) '((b . 2) (c . 3))
+ #s(hash-table data (c 4)))
+ (lambda (x y) (string< (car x) (car y))))
+ '((a . 1) (b . 2) (c . 4))))
+ (should (equal (map-merge 'list () '(:a 1)) '((:a . 1))))
+ (should (equal (map-merge 'alist () '(:a 1)) '((:a . 1))))
+ (should (equal (map-merge 'plist () '(:a 1)) '(:a 1))))
(ert-deftest test-map-merge-with ()
- (should (equal (map-merge-with 'list #'+
- '((1 . 2))
- '((1 . 3) (2 . 4))
- '((1 . 1) (2 . 5) (3 . 0)))
- '((3 . 0) (2 . 9) (1 . 6)))))
+ (should (equal (sort (map-merge-with 'list #'+
+ '((1 . 2))
+ '((1 . 3) (2 . 4))
+ '((1 . 1) (2 . 5) (3 . 0)))
+ #'car-less-than-car)
+ '((1 . 6) (2 . 9) (3 . 0))))
+ (should (equal (map-merge-with 'list #'+ () '(:a 1)) '((:a . 1))))
+ (should (equal (map-merge-with 'alist #'+ () '(:a 1)) '((:a . 1))))
+ (should (equal (map-merge-with 'plist #'+ () '(:a 1)) '(:a 1))))
(ert-deftest test-map-merge-empty ()
"Test merging of empty maps."
@@ -513,5 +521,14 @@ Evaluate BODY for each created map."
'value2))
(should (equal (map-elt ht 'key) 'value2))))
+(ert-deftest test-setf-map-with-function ()
+ (let ((num 0)
+ (map nil))
+ (setf (map-elt map 'foo)
+ (funcall (lambda ()
+ (cl-incf num))))
+ ;; Check that the function is only called once.
+ (should (= num 1))))
+
(provide 'map-tests)
;;; map-tests.el ends here
diff --git a/test/lisp/emacs-lisp/memory-report-tests.el
b/test/lisp/emacs-lisp/memory-report-tests.el
index da5f4f5..e352dd1 100644
--- a/test/lisp/emacs-lisp/memory-report-tests.el
+++ b/test/lisp/emacs-lisp/memory-report-tests.el
@@ -45,6 +45,7 @@
(should (equal (memory-report-object-size (list 'foo)) 16))
+ (should (equal (memory-report-object-size (vector 1 2 3)) 64))
(should (equal (memory-report-object-size (vector 1 2 3 4)) 80))
(should (equal (memory-report-object-size "") 32))
@@ -52,6 +53,29 @@
(should (equal (memory-report-object-size (propertize "a" 'face 'foo))
81)))
+(ert-deftest memory-report-sizes-vectors ()
+ (should (= (memory-report--object-size
+ (make-hash-table :test #'eq)
+ ["long string that should be at least 40 bytes"])
+ 108))
+ (let ((string "long string that should be at least 40 bytes"))
+ (should (= (memory-report--object-size
+ (make-hash-table :test #'eq)
+ (vector string))
+ 108))
+ (should (= (memory-report--object-size
+ (make-hash-table :test #'eq)
+ (vector string string))
+ 124))))
+
+(ert-deftest memory-report-sizes-structs ()
+ (cl-defstruct memory-report-test-struct
+ (item0 nil)
+ (item1 nil))
+ (let ((s (make-memory-report-test-struct :item0 "hello" :item1 "world")))
+ (should (= (memory-report-object-size s)
+ 90))))
+
(provide 'memory-report-tests)
;;; memory-report-tests.el ends here
diff --git a/test/lisp/emacs-lisp/pcase-tests.el
b/test/lisp/emacs-lisp/pcase-tests.el
index 2120139..7ad01e7 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -100,4 +100,61 @@
(should (equal (funcall f 'b1) '(4 5 nil nil)))
(should (equal (funcall f 'b2) '(nil nil 8 9)))))
+(ert-deftest pcase-tests-cl-type ()
+ (should (equal (pcase 1
+ ((cl-type integer) 'integer))
+ 'integer))
+ (should (equal (pcase 1
+ ((cl-type (integer 0 2)) 'integer-0<=n<=2))
+ 'integer-0<=n<=2))
+ (should-error (pcase 1
+ ((cl-type notatype) 'integer))))
+
+(ert-deftest pcase-tests-setq ()
+ (should (equal (let (a b)
+ (pcase-setq `((,a) (,b)) '((1) (2)))
+ (list a b))
+ (list 1 2)))
+
+ (should (equal (list nil nil)
+ (let ((a 'unset)
+ (b 'unset))
+ (pcase-setq `(head ,a ,b) nil)
+ (list a b))))
+
+ (should (equal (let (a b)
+ (pcase-setq `[,a ,b] [1 2])
+ (list a b))
+ '(1 2)))
+
+ (should-error (let (a b)
+ (pcase-setq `[,a ,b] nil)
+ (list a b)))
+
+ (should (equal (let (a b)
+ (pcase-setq a 1 b 2)
+ (list a b))
+ '(1 2)))
+
+ (should (= (let (a)
+ (pcase-setq a 1 `(,a) '(2))
+ a)
+ 2))
+
+ (should (equal (let (array list-item array-copy)
+ (pcase-setq (or `(,list-item) array) [1 2 3]
+ array-copy array
+ ;; This re-sets `array' to nil.
+ (or `(,list-item) array) '(4))
+ (list array array-copy list-item))
+ '(nil [1 2 3] 4)))
+
+ (let ((a nil))
+ (should-error (pcase-setq a 1 b)
+ :type '(wrong-number-of-arguments))
+ (should (eq a nil)))
+
+ (should-error (pcase-setq a)
+ :type '(wrong-number-of-arguments)))
+
;;; pcase-tests.el ends here.
diff --git a/test/lisp/emacs-lisp/seq-tests.el
b/test/lisp/emacs-lisp/seq-tests.el
index 05c7fbe..44e855e 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -383,6 +383,30 @@ Evaluate BODY for each created sequence.
(should (null b))
(should (null c)))))
+(ert-deftest test-seq-setq ()
+ (with-test-sequences (seq '(1 2 3 4))
+ (let (a b c d e)
+ (seq-setq (a b c d e) seq)
+ (should (= a 1))
+ (should (= b 2))
+ (should (= c 3))
+ (should (= d 4))
+ (should (null e)))
+ (let (a b others)
+ (seq-setq (a b &rest others) seq)
+ (should (= a 1))
+ (should (= b 2))
+ (should (same-contents-p others (seq-drop seq 2)))))
+ (let ((a)
+ (seq '(1 (2 (3 (4))))))
+ (seq-setq (_ (_ (_ (a)))) seq)
+ (should (= a 4)))
+ (let (seq a b c)
+ (seq-setq (a b c) seq)
+ (should (null a))
+ (should (null b))
+ (should (null c))))
+
(ert-deftest test-seq-min-max ()
(with-test-sequences (seq '(4 5 3 2 0 4))
(should (= (seq-min seq) 0))
diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el
index 3ceb392..f8113bf 100644
--- a/test/lisp/ffap-tests.el
+++ b/test/lisp/ffap-tests.el
@@ -123,6 +123,25 @@ left alone when opening a URL in an external browser."
(save-excursion (insert "type="))
(ffap-guess-file-name-at-point))))
+(ert-deftest ffap-ido-mode ()
+ (require 'ido)
+ (with-temp-buffer
+ (let ((ido-mode t)
+ (read-file-name-function read-file-name-function)
+ (read-buffer-function read-buffer-function))
+ ;; Says ert-deftest:
+ ;; Macros in BODY are expanded when the test is defined, not when it
+ ;; is run. If a macro (possibly with side effects) is to be tested,
+ ;; it has to be wrapped in `(eval (quote ...))'.
+ (eval (quote (ido-everywhere)))
+ (let ((read-file-name-function (lambda (&rest args)
+ (expand-file-name
+ (nth 4 args)
+ (nth 1 args)))))
+ (save-excursion (insert "ffap-tests.el"))
+ (let (kill-buffer-query-functions)
+ (kill-buffer (call-interactively #'find-file-at-point)))))))
+
(provide 'ffap-tests)
;;; ffap-tests.el ends here
diff --git a/test/lisp/files-resources/.dir-locals.el
b/test/lisp/files-resources/.dir-locals.el
index 84997b8..84393aa 100644
--- a/test/lisp/files-resources/.dir-locals.el
+++ b/test/lisp/files-resources/.dir-locals.el
@@ -1,2 +1,5 @@
;; This is used by files-tests.el.
-((auto-mode-alist . (("\\.quux\\'" . tcl-mode))))
+((auto-mode-alist . (("\\.quux\\'" . tcl-mode)
+ ("\\.zot1\\'" . foobar)
+ ("\\.zot2\\'" . (lambda ()))
+ ("\\.zot3\\'" . dired-mode))))
diff --git a/test/lisp/files-resources/auto-test.zot1
b/test/lisp/files-resources/auto-test.zot1
new file mode 100644
index 0000000..80acfcc
--- /dev/null
+++ b/test/lisp/files-resources/auto-test.zot1
@@ -0,0 +1 @@
+zot1
diff --git a/test/lisp/files-resources/auto-test.zot2
b/test/lisp/files-resources/auto-test.zot2
new file mode 100644
index 0000000..975fc76
--- /dev/null
+++ b/test/lisp/files-resources/auto-test.zot2
@@ -0,0 +1 @@
+zot2
diff --git a/test/lisp/files-resources/auto-test.zot3
b/test/lisp/files-resources/auto-test.zot3
new file mode 100644
index 0000000..faa0715
--- /dev/null
+++ b/test/lisp/files-resources/auto-test.zot3
@@ -0,0 +1 @@
+zot3
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index fce7e3f..aa5150b 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -206,24 +206,24 @@ form.")
"Test for https://debbugs.gnu.org/21454 ."
(let ((input-result
(if (memq system-type '(windows-nt ms-dos))
- '(("x:/foo/bar//baz/;y:/bar/foo/baz//" nil
- ("x:/foo/bar/baz/" "y:/bar/foo/baz/"))
+ '(("/foo/bar//baz/;/bar/foo/baz//" nil
+ ("/foo/bar//baz/" "/bar/foo/baz//"))
("x:/foo/bar/;y:/bar/qux/;z:/qux/foo" nil
("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x://foo/bar/;y:/bar/qux/;z:/qux/foo/" nil
- ("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
+ ("x://foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x:/foo/bar/;y:/bar/qux/;z:/qux/foo/" nil
("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x:/foo//bar/;y:/bar/qux/;z:/qux/foo/" nil
- ("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
+ ("x:/foo//bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x:/foo//bar/;y:/bar/qux/;z:/qux/foo" nil
- ("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
+ ("x:/foo//bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x:/foo/bar" "$FOO/baz/;z:/qux/foo/"
("x:/foo/bar/baz/" "z:/qux/foo/"))
- ("x://foo/bar/" "$FOO/baz/;z:/qux/foo/"
- ("x:/foo/bar/baz/" "z:/qux/foo/")))
+ ("//foo/bar/" "$FOO/baz/;/qux/foo/"
+ ("/foo/bar//baz/" "/qux/foo/")))
'(("/foo/bar//baz/:/bar/foo/baz//" nil
- ("/foo/bar/baz/" "/bar/foo/baz/"))
+ ("/foo/bar//baz/" "/bar/foo/baz//"))
("/foo/bar/:/bar/qux/:/qux/foo" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
("//foo/bar/:/bar/qux/:/qux/foo/" nil
@@ -231,11 +231,11 @@ form.")
("/foo/bar/:/bar/qux/:/qux/foo/" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
("/foo//bar/:/bar/qux/:/qux/foo/" nil
- ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo//bar/" "/bar/qux/" "/qux/foo/"))
("/foo//bar/:/bar/qux/:/qux/foo" nil
- ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo//bar/" "/bar/qux/" "/qux/foo/"))
("/foo/bar" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))
- ("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/"
"/qux/foo/")))))
+ ("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar//baz/"
"/qux/foo/")))))
(foo-env (getenv "FOO"))
(bar-env (getenv "BAR")))
(unwind-protect
@@ -316,7 +316,9 @@ be $HOME."
(ert-deftest files-tests-file-name-non-special--subprocess ()
"Check that Bug#25949 and Bug#48177 are fixed."
- (skip-unless (and (executable-find "true") (file-exists-p null-device)))
+ (skip-unless (and (executable-find "true") (file-exists-p null-device)
+ ;; These systems cannot set date of the null device.
+ (not (memq system-type '(windows-nt ms-dos)))))
(let ((default-directory (file-name-quote temporary-file-directory))
(true (file-name-quote (executable-find "true")))
(null (file-name-quote null-device)))
@@ -608,7 +610,7 @@ unquoted file names."
(ert-deftest files-tests-file-name-non-special-dired-compress-handler ()
;; `dired-compress-file' can get confused by filenames with ":" in
;; them, which causes this to fail on `windows-nt' systems.
- (when (string-match-p ":" (expand-file-name temporary-file-directory))
+ (when (string-search ":" (expand-file-name temporary-file-directory))
(ert-skip "FIXME: `dired-compress-file' unreliable when filenames contain
`:'."))
(files-tests--with-temp-non-special (tmpfile nospecial)
(let ((compressed (dired-compress-file nospecial)))
@@ -951,40 +953,51 @@ unquoted file names."
(ert-deftest files-test-auto-save-name-default ()
(with-temp-buffer
- (let ((auto-save-file-name-transforms nil))
+ (let ((auto-save-file-name-transforms nil)
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
(setq buffer-file-name "/tmp/foo.txt")
- (should (equal (make-auto-save-file-name) "/tmp/#foo.txt#")))))
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/tmp/#foo.txt#")))))
(ert-deftest files-test-auto-save-name-transform ()
(with-temp-buffer
(setq buffer-file-name "/tmp/foo.txt")
(let ((auto-save-file-name-transforms
- '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" nil))))
- (should (equal (make-auto-save-file-name) "/var/tmp/#foo.txt#")))))
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" nil)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/var/tmp/#foo.txt#")))))
(ert-deftest files-test-auto-save-name-unique ()
(with-temp-buffer
(setq buffer-file-name "/tmp/foo.txt")
(let ((auto-save-file-name-transforms
- '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t))))
- (should (equal (make-auto-save-file-name) "/var/tmp/#!tmp!foo.txt#")))
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/var/tmp/#!tmp!foo.txt#")))
(let ((auto-save-file-name-transforms
- '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1))))
- (should (equal (make-auto-save-file-name)
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-auto-save-file-name) name-start)
"/var/tmp/#b57c5a04f429a83305859d3350ecdab8315a9037#")))))
(ert-deftest files-test-lock-name-default ()
- (let ((lock-file-name-transforms nil))
- (should (equal (make-lock-file-name "/tmp/foo.txt") "/tmp/.#foo.txt"))))
+ (let ((lock-file-name-transforms nil)
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-lock-file-name "/tmp/foo.txt") name-start)
+ "/tmp/.#foo.txt"))))
(ert-deftest files-test-lock-name-unique ()
(let ((lock-file-name-transforms
- '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t))))
- (should (equal (make-lock-file-name "/tmp/foo.txt")
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-lock-file-name "/tmp/foo.txt") name-start)
"/var/tmp/.#!tmp!foo.txt")))
(let ((lock-file-name-transforms
- '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1))))
- (should (equal (make-lock-file-name "/tmp/foo.txt")
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-lock-file-name "/tmp/foo.txt") name-start)
"/var/tmp/.#b57c5a04f429a83305859d3350ecdab8315a9037"))))
(ert-deftest files-tests-file-name-non-special-make-directory ()
@@ -1446,9 +1459,11 @@ See <https://debbugs.gnu.org/36401>."
(ert-deftest files-colon-path ()
(if (memq system-type '(windows-nt ms-dos))
(should (equal (parse-colon-path "x:/foo//bar/baz")
- '("x:/foo/bar/baz/")))
+ '("x:/foo//bar/baz/")))
(should (equal (parse-colon-path "/foo//bar/baz")
- '("/foo/bar/baz/")))))
+ '("/foo//bar/baz/"))))
+ (should (equal (parse-colon-path (concat "." path-separator "/tmp"))
+ '("./" "/tmp/"))))
(ert-deftest files-test-magic-mode-alist-doctype ()
"Test that DOCTYPE and variants put files in mhtml-mode."
@@ -1537,7 +1552,226 @@ The door of all subtleties!
(ert-deftest files-test-dir-locals-auto-mode-alist ()
"Test an `auto-mode-alist' entry in `.dir-locals.el'"
(find-file (ert-resource-file "whatever.quux"))
- (should (eq major-mode 'tcl-mode)))
+ (should (eq major-mode 'tcl-mode))
+ (find-file (ert-resource-file "auto-test.zot1"))
+ (should (eq major-mode 'fundamental-mode))
+ (find-file (ert-resource-file "auto-test.zot2"))
+ (should (eq major-mode 'fundamental-mode))
+ (find-file (ert-resource-file "auto-test.zot3"))
+ (should (eq major-mode 'fundamental-mode)))
+
+(defun files-tests--save-some-buffers (pred def-pred-bind exp-1 exp-2)
+ "Helper function to test `save-some-buffers'.
+
+This function creates two file-visiting buffers, BUF-1, BUF-2 in
+different directories at the same level, i.e., none of them is a
+subdir of the other; then it modifies both buffers; finally, it
+calls `save-some-buffers' from BUF-1 with first arg t, second
+arg PRED and `save-some-buffers-default-predicate' let-bound to
+DEF-PRED-BIND.
+
+EXP-1 and EXP-2 are the expected values of calling `buffer-modified-p'
+on BUF-1 and BUF-2 after the `save-some-buffers' call.
+
+The test is repeated with `save-some-buffers-default-predicate'
+let-bound to PRED and passing nil as second arg of
+`save-some-buffers'."
+ (let* ((dir (make-temp-file "testdir" 'dir))
+ (file-1 (expand-file-name "subdir-1/file.foo" dir))
+ (file-2 (expand-file-name "subdir-2/file.bar" dir))
+ (inhibit-message t)
+ buf-1 buf-2)
+ (unwind-protect
+ (progn
+ (make-empty-file file-1 'parens)
+ (make-empty-file file-2 'parens)
+ (setq buf-1 (find-file file-1)
+ buf-2 (find-file file-2))
+ (dolist (buf (list buf-1 buf-2))
+ (with-current-buffer buf (insert "foobar\n")))
+ ;; Run the test.
+ (with-current-buffer buf-1
+ (let ((save-some-buffers-default-predicate def-pred-bind))
+ (save-some-buffers t pred))
+ (should (eq exp-1 (buffer-modified-p buf-1)))
+ (should (eq exp-2 (buffer-modified-p buf-2))))
+ ;; Set both buffers as modified to run another test.
+ (dolist (buf (list buf-1 buf-2))
+ (with-current-buffer buf (set-buffer-modified-p t)))
+ ;; The result of this test must be identical as the previous one.
+ (with-current-buffer buf-1
+ (let ((save-some-buffers-default-predicate (or pred
def-pred-bind)))
+ (save-some-buffers t nil))
+ (should (eq exp-1 (buffer-modified-p buf-1)))
+ (should (eq exp-2 (buffer-modified-p buf-2)))))
+ ;; Clean up.
+ (dolist (buf (list buf-1 buf-2))
+ (with-current-buffer buf
+ (set-buffer-modified-p nil)
+ (kill-buffer buf)))
+ (delete-directory dir 'recursive))))
+
+(ert-deftest files-tests-save-some-buffers ()
+ "Test `save-some-buffers'.
+Test the 3 cases for the second argument PRED, i.e., nil, t, or
+predicate.
+The value of `save-some-buffers-default-predicate' is ignored unless
+PRED is nil."
+ (let* ((foo-file-p (lambda () (string-suffix-p ".foo" buffer-file-name)))
+ (bar-file-p (lambda () (string-suffix-p ".bar" buffer-file-name)))
+ (args-results `((nil nil nil nil)
+ (nil ,foo-file-p nil t)
+ (nil ,bar-file-p t nil)
+ (,foo-file-p nil nil t)
+ (,bar-file-p nil t nil)
+
+ (buffer-modified-p nil nil nil)
+ (t nil nil nil)
+ (t ,foo-file-p nil nil)
+
+ (,foo-file-p save-some-buffers-root nil t)
+ (nil save-some-buffers-root nil t)
+ (,bar-file-p save-some-buffers-root t nil)
+ (t save-some-buffers-root nil nil))))
+ (pcase-dolist (`(,pred ,def-pred-bind ,exp-1 ,exp-2) args-results)
+ (files-tests--save-some-buffers pred def-pred-bind exp-1 exp-2))))
+
+(defmacro files-tests--with-buffer-offer-save (buffers-offer fn-test
fn-binders args-results)
+ "Helper macro to test `save-some-buffers' and `save-buffers-kill-emacs'.
+
+This macro creates several non-file-visiting buffers in different
+directories at the same level, i.e., none of them is a subdir of the
+other. Then it modifies the buffers and sets their `buffer-offer-save'
+as specified by BUFFERS-OFFER, a list of elements (BUFFER OFFER-SAVE).
+Finally, it calls FN-TEST from the first buffer.
+
+FN-TEST is the function to test: either `save-some-buffers' or
+`save-buffers-kill-emacs'. This function is called with
+`save-some-buffers-default-predicate' let-bound to a value
+specified inside ARGS-RESULTS.
+
+FN-BINDERS is a list of elements (FUNCTION . BINDING), where FUNCTION
+is a function symbol that this macro temporary binds to BINDING during
+the FN-TEST call.
+
+ARGS-RESULTS is a list of elements (FN-ARGS CALLERS-DIR EXPECTED), where
+FN-ARGS are the arguments for FN-TEST;
+CALLERS-DIR specifies the value to let-bind
+\`save-some-buffers-default-predicate';
+ EXPECTED is the expected result of the test."
+ (declare (debug (form symbol form form)))
+ (let ((dir (gensym "dir"))
+ (buffers (gensym "buffers")))
+ `(let* ((,dir (make-temp-file "testdir" 'dir))
+ (inhibit-message t)
+ (use-dialog-box nil)
+ ,buffers)
+ (pcase-dolist (`(,bufsym ,offer-save) ,buffers-offer)
+ (let* ((buf (generate-new-buffer (symbol-name bufsym)))
+ (subdir (expand-file-name
+ (format "subdir-%s" (buffer-name buf))
+ ,dir)))
+ (make-directory subdir 'parens)
+ (push buf ,buffers)
+ (with-current-buffer buf
+ (cd subdir)
+ (setq buffer-offer-save offer-save)
+ (insert "foobar\n"))))
+ (setq ,buffers (nreverse ,buffers))
+ (let ((nb-saved-buffers 0))
+ (unwind-protect
+ (pcase-dolist (`(,fn-test-args ,callers-dir ,expected)
+ ,args-results)
+ (setq nb-saved-buffers 0)
+ (with-current-buffer (car ,buffers)
+ (cl-letf
+ (,@(mapcar (lambda (pair) `((symbol-function ,(car pair))
,(cdr pair)))
+ fn-binders)
+ (save-some-buffers-default-predicate callers-dir))
+ (apply #',fn-test fn-test-args)
+ (should (equal nb-saved-buffers expected)))))
+ ;; Clean up.
+ (dolist (buf ,buffers)
+ (with-current-buffer buf
+ (set-buffer-modified-p nil)
+ (kill-buffer buf)))
+ (delete-directory ,dir 'recursive))))))
+
+(defmacro files-tests-with-all-permutations (permutation list &rest body)
+ "Execute BODY forms for all permutations of LIST.
+Execute the forms with the symbol PERMUTATION bound to the current
+permutation."
+ (declare (indent 2) (debug (symbol form body)))
+ (let ((vec (gensym "vec")))
+ `(let ((,vec (vconcat ,list)))
+ (cl-labels ((swap (,vec i j)
+ (let ((tmp (aref ,vec j)))
+ (aset ,vec j (aref ,vec i))
+ (aset ,vec i tmp)))
+ (permute (,vec l r)
+ (if (= l r)
+ (let ((,permutation (append ,vec nil)))
+ ,@body)
+ (cl-loop for idx from l below (1+ r) do
+ (swap ,vec idx l)
+ (permute ,vec (1+ l) r)
+ (swap ,vec idx l)))))
+ (permute ,vec 0 (1- (length ,vec)))))))
+
+(ert-deftest files-tests-buffer-offer-save ()
+ "Test `save-some-buffers' for non-file-visiting buffers.
+Check the behavior of `save-some-buffers' for non-file-visiting
+buffers under several values of `buffer-offer-save'.
+The value of `save-some-buffers-default-predicate' is ignored unless
+PRED is nil."
+ (let* ((buffers-offer-init '((buf-1 t) (buf-2 always) (buf-3 nil)))
+ (nb-might-save
+ (length
+ (cl-remove-if (lambda (l) (null (cadr l))) buffers-offer-init)))
+ (nb-always-save
+ (length
+ (cl-remove-if-not (lambda (l) (eq 'always (cadr l)))
buffers-offer-init))))
+ (files-tests-with-all-permutations
+ buffers-offer
+ buffers-offer-init
+ (dolist (pred `(nil t save-some-buffers-root))
+ (dolist (callers-dir `(nil save-some-buffers-root))
+ (let* ((head-offer (cadar buffers-offer))
+ (res (cond ((null pred)
+ (if (null callers-dir) nb-always-save (or (and
head-offer 1) 0)))
+ (t
+ ;; Save any buffer with `buffer-offer-save'
non-nil.
+ (if (eq pred t) nb-might-save
+ ;; Restrict to caller's dir.
+ (or (and head-offer 1) 0)))))
+ (args-res `(((nil ,pred) ,callers-dir ,res))))
+ (files-tests--with-buffer-offer-save
+ buffers-offer
+ save-some-buffers
+ ;; Increase counter and answer 'n' when prompted to save a buffer.
+ (('read-event . (lambda (&rest _) (cl-incf nb-saved-buffers) ?n)))
+ args-res)))))))
+
+(ert-deftest files-tests-save-buffers-kill-emacs--asks-to-save-buffers ()
+ "Test that `save-buffers-kill-emacs' asks to save buffers as expected.
+Prompt users for any modified buffer with `buffer-offer-save' non-nil."
+ (let* ((buffers-offer-init '((buf-1 t) (buf-2 always) (buf-3 nil)))
+ (nb-might-save
+ (length
+ (cl-remove-if (lambda (l) (null (cadr l))) buffers-offer-init))))
+ (files-tests-with-all-permutations
+ buffers-offer
+ buffers-offer-init
+ (files-tests--with-buffer-offer-save
+ buffers-offer
+ save-buffers-kill-emacs
+ ;; Increase counter and answer 'n' when prompted to save a buffer.
+ (('read-event . (lambda (&rest _) (cl-incf nb-saved-buffers) ?n))
+ ('kill-emacs . #'ignore)) ; Do not kill Emacs.
+ `((nil nil ,nb-might-save)
+ ;; `save-some-buffers-default-predicate' (i.e. the 2nd element) is
ignored.
+ (nil save-some-buffers-root ,nb-might-save))))))
+
(provide 'files-tests)
;;; files-tests.el ends here
diff --git a/test/lisp/gnus/nnrss-tests.el b/test/lisp/gnus/nnrss-tests.el
index 9821ec7..92b7dac 100644
--- a/test/lisp/gnus/nnrss-tests.el
+++ b/test/lisp/gnus/nnrss-tests.el
@@ -26,4 +26,20 @@
(should (equal (nnrss-normalize-date "2004-09-17T05:09:49.001+00:00")
"Fri, 17 Sep 2004 05:09:49 +0000")))
+(defconst test-nnrss-xml
+ '((rss
+ ((version . "2.0")
+ (xmlns:dc . "http://purl.org/dc/elements/1.1/";))
+ (channel
+ ((xmlns:content . "http://purl.org/rss/1.0/modules/content/";))))))
+
+(ert-deftest test-nnrss-namespace-top ()
+ (should (equal (nnrss-get-namespace-prefix
+ test-nnrss-xml "http://purl.org/dc/elements/1.1/";)
+ "dc:")))
+(ert-deftest test-nnrss-namespace-inner ()
+ (should (equal (nnrss-get-namespace-prefix
+ test-nnrss-xml "http://purl.org/rss/1.0/modules/content/";)
+ "content:")))
+
;;; nnrss-tests.el ends here
diff --git a/test/lisp/international/mule-util-resources/utf-8.txt
b/test/lisp/international/mule-util-resources/utf-8.txt
new file mode 100644
index 0000000..385bbb4
--- /dev/null
+++ b/test/lisp/international/mule-util-resources/utf-8.txt
@@ -0,0 +1,2 @@
+Thís is a test line 1.
+Line 2.
diff --git a/test/lisp/international/mule-util-tests.el
b/test/lisp/international/mule-util-tests.el
index 6518be6..0fcff9d 100644
--- a/test/lisp/international/mule-util-tests.el
+++ b/test/lisp/international/mule-util-tests.el
@@ -22,6 +22,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'mule-util)
(defconst mule-util-test-truncate-data
@@ -82,4 +83,43 @@
(dotimes (i (length mule-util-test-truncate-data))
(mule-util-test-truncate-create i))
+(ert-deftest filepos/bufferpos-tests-utf-8 ()
+ (let ((coding-system-for-read 'utf-8-unix))
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "utf-8.txt"))
+ (should (eq buffer-file-coding-system 'utf-8-unix))
+ ;; First line is "Thís is a test line 1.".
+ ;; Bytes start counting at 0; chars at 1.
+ (should (= (filepos-to-bufferpos 1 'exact) 2))
+ (should (= (bufferpos-to-filepos 2 'exact) 1))
+ ;; After non-ASCII.
+ (should (= (filepos-to-bufferpos 4 'exact) 4))
+ (should (= (bufferpos-to-filepos 4 'exact) 4)))))
+
+(ert-deftest filepos/bufferpos-tests-binary ()
+ (let ((coding-system-for-read 'binary))
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "utf-8.txt"))
+ (should (eq buffer-file-coding-system 'no-conversion))
+ ;; First line is "Thís is a test line 1.".
+ ;; Bytes start counting at 0; chars at 1.
+ (should (= (filepos-to-bufferpos 1 'exact) 2))
+ (should (= (bufferpos-to-filepos 2 'exact) 1))
+ ;; After non-ASCII.
+ (should (= (filepos-to-bufferpos 4 'exact) 5))
+ (should (= (bufferpos-to-filepos 5 'exact) 4)))))
+
+(ert-deftest filepos/bufferpos-tests-undecided ()
+ (let ((coding-system-for-read 'binary))
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "utf-8.txt"))
+ (setq buffer-file-coding-system 'undecided)
+ (should-error (filepos-to-bufferpos 1 'exact))
+ (should-error (bufferpos-to-filepos 2 'exact))
+ (should (= (filepos-to-bufferpos 1 'approximate) 2))
+ (should (= (bufferpos-to-filepos 2 'approximate) 1))
+ ;; After non-ASCII.
+ (should (= (filepos-to-bufferpos 4 'approximate) 5))
+ (should (= (bufferpos-to-filepos 5 'approximate) 4)))))
+
;;; mule-util-tests.el ends here
diff --git a/test/lisp/international/ucs-normalize-tests.el
b/test/lisp/international/ucs-normalize-tests.el
index 51f4ed3..2b489dc 100644
--- a/test/lisp/international/ucs-normalize-tests.el
+++ b/test/lisp/international/ucs-normalize-tests.el
@@ -233,6 +233,7 @@ implementations:
(ert-deftest ucs-normalize-part1 ()
:tags '(:expensive-test)
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 1800s
;; This takes a long time, so make sure we're compiled.
(dolist (fun '(ucs-normalize-tests--part1-rule2
ucs-normalize-tests--rule1-failing-for-partX
diff --git a/test/lisp/mail/mail-parse-tests.el
b/test/lisp/mail/mail-parse-tests.el
new file mode 100644
index 0000000..70de92d
--- /dev/null
+++ b/test/lisp/mail/mail-parse-tests.el
@@ -0,0 +1,54 @@
+;;; mail-parse-tests.el --- tests for mail-parse.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'mail-parse)
+(require 'subr-x)
+
+(ert-deftest test-mail-header-parse-address-lax ()
+ (should (equal (mail-header-parse-address-lax
+ "Lars Ingebrigtsen <larsi@gnus.org>")
+ '("larsi@gnus.org" . "Lars Ingebrigtsen")))
+ (should (equal (mail-header-parse-address-lax
+ "Lars Ingebrigtsen larsi@gnus.org>")
+ '("larsi@gnus.org" . "Lars Ingebrigtsen")))
+ (should (equal (mail-header-parse-address-lax
+ "Lars Ingebrigtsen larsi@gnus.org")
+ '("larsi@gnus.org" . "Lars Ingebrigtsen")))
+ (should (equal (mail-header-parse-address-lax
+ "larsi@gnus.org (Lars Ingebrigtsen)")
+ '("larsi@gnus.org " . "Lars Ingebrigtsen")))
+ (should (equal (mail-header-parse-address-lax "larsi@gnus.org")
+ '("larsi@gnus.org")))
+ (should (equal (mail-header-parse-address-lax "foo")
+ nil)))
+
+(ert-deftest test-mail-header-parse-addresses-lax ()
+ (should (equal (mail-header-parse-addresses-lax
+ "Bob Weiner <rsw@gnu.org>, Mats Lidell <matsl@gnu.org>")
+ '(("rsw@gnu.org" . "Bob Weiner")
+ ("matsl@gnu.org" . "Mats Lidell")))))
+
+(provide 'mail-parse-tests)
+
+;;; mail-parse-tests.el ends here
diff --git a/test/lisp/mail/rfc6068-tests.el b/test/lisp/mail/rfc6068-tests.el
new file mode 100644
index 0000000..caf8230
--- /dev/null
+++ b/test/lisp/mail/rfc6068-tests.el
@@ -0,0 +1,52 @@
+;;; rfc6068-tests.el --- Tests for rfc6068.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'rfc6068)
+
+(ert-deftest rfc6068-unhexify-string ()
+ (should (equal (rfc6068-unhexify-string "hello%20there") "hello there"))
+ (should (equal (rfc6068-unhexify-string "caf%C3%A9") "café")))
+
+(ert-deftest rfc6068-parse-mailto-url ()
+ (should
+ (equal
+ (rfc6068-parse-mailto-url "mailto:foo@example.org?subject=Foo&bar=baz";)
+ '(("To" . "foo@example.org") ("Subject" . "Foo") ("Bar" . "baz"))))
+ (should
+ (equal
+ (rfc6068-parse-mailto-url "mailto:foo@bar.com?to=bar@example.org";)
+ '(("To" . "foo@bar.com, bar@example.org"))))
+ (should
+ (equal (rfc6068-parse-mailto-url "mailto:foo@bar.com?subject=bar%20baz";)
+ '(("To" . "foo@bar.com") ("Subject" . "bar baz"))))
+ (should
+ (equal (rfc6068-parse-mailto-url
"mailto:foo@bar.com?subject=bar%20baz&to=other@bar.com";)
+ '(("Subject" . "bar baz") ("To" . "foo@bar.com, other@bar.com"))))
+ (should
+ (equal (rfc6068-parse-mailto-url
"mailto:user@example.org?subject=caf%C3%A9&body=caf%C3%A9";)
+ '(("To" . "user@example.org") ("Subject" . "café") ("Body" .
"café")))))
+
+(provide 'rfc6068-tests)
+
+;;; rfc6068-tests.el ends here
diff --git a/test/lisp/mh-e/mh-xface-tests.el b/test/lisp/mh-e/mh-xface-tests.el
new file mode 100644
index 0000000..65e3c82
--- /dev/null
+++ b/test/lisp/mh-e/mh-xface-tests.el
@@ -0,0 +1,35 @@
+;;; mh-xface-tests.el --- tests for mh-xface.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'mh-xface)
+
+(ert-deftest mh-x-image-url-sane-p ()
+ "Test that `mh-x-image-url-sane-p' accepts a URL exactly if it is sane."
+ (should (equal (mh-x-image-url-sane-p (concat "http://";
+ (make-string 101 ?a)))
+ nil)) ;too long
+ (should (equal (mh-x-image-url-sane-p "http") nil)) ;too short
+ (should (equal (mh-x-image-url-sane-p "http:") t))
+ (should (equal (mh-x-image-url-sane-p "https") nil)) ;too short
+ (should (equal (mh-x-image-url-sane-p "https:") t))
+ (should (equal (mh-x-image-url-sane-p "https://www.example.com/me.png";) t))
+ (should (equal (mh-x-image-url-sane-p "abcde:") nil)))
diff --git a/test/lisp/net/netrc-resources/netrc-folding
b/test/lisp/net/netrc-resources/netrc-folding
new file mode 100644
index 0000000..85e5e32
--- /dev/null
+++ b/test/lisp/net/netrc-resources/netrc-folding
@@ -0,0 +1,6 @@
+# Foo
+machine XM login XL password XP
+
+machine YM
+ login YL
+ password YP
diff --git a/test/lisp/net/netrc-tests.el b/test/lisp/net/netrc-tests.el
index 1328b19..f75328a 100644
--- a/test/lisp/net/netrc-tests.el
+++ b/test/lisp/net/netrc-tests.el
@@ -48,6 +48,13 @@
(should (equal (netrc-credentials "ftp.example.org")
'("jrh" "*baz*")))))
+(ert-deftest test-netrc-credentials ()
+ (let ((netrc-file (ert-resource-file "netrc-folding")))
+ (should
+ (equal (netrc-parse netrc-file)
+ '((("machine" . "XM") ("login" . "XL") ("password" . "XP"))
+ (("machine" . "YM")) (("login" . "YL")) (("password" .
"YP")))))))
+
(provide 'netrc-tests)
;;; netrc-tests.el ends here
diff --git a/test/lisp/net/network-stream-tests.el
b/test/lisp/net/network-stream-tests.el
index 1a4cc74..4a0b23d 100644
--- a/test/lisp/net/network-stream-tests.el
+++ b/test/lisp/net/network-stream-tests.el
@@ -128,7 +128,7 @@
(when prev
(setq string (concat prev string))
(process-put proc 'previous-string nil)))
- (if (and (not (string-match "\n" string))
+ (if (and (not (string-search "\n" string))
(> (length string) 0))
(process-put proc 'previous-string string))
(let ((command (split-string string)))
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 71bdd74..c0f90bc 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -95,7 +95,7 @@
;; From fedora.org: 2605:bc80:3010:600:dead:beef:cafe:fed9
;; 5004 ~~> Version Status (OK) NOOP Addr-Type (4 -> IPv6)
(socks-filter proc "\5\0\0\4\x26\x05\xbc\x80\x30\x10\x00\x60")
- (ert-info ("State still waiting and response emtpy")
+ (ert-info ("State still waiting and response empty")
(should (eq (process-get proc 'socks-state) socks-state-waiting))
(should-not (process-get proc 'socks-response)))
(ert-info ("Scratch field holds partial payload of pending msg")
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index b3a0021..27b37d4 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -177,6 +177,19 @@ The temporary file is not created."
(make-temp-name "tramp-test")
(if local temporary-file-directory tramp-test-temporary-file-directory))))
+;; Method "smb" supports `make-symbolic-link' only if the remote host
+;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el, tramp-rclone.el
+;; and tramp-sshfs.el do not support symbolic links at all.
+(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
+ "Run BODY, ignoring \"make-symbolic-link not supported\" file error."
+ (declare (indent defun) (debug (body)))
+ `(condition-case err
+ (progn ,@body)
+ (file-error
+ (unless (string-equal (error-message-string err)
+ "make-symbolic-link not supported")
+ (signal (car err) (cdr err))))))
+
;; Don't print messages in nested `tramp--test-instrument-test-case' calls.
(defvar tramp--test-instrument-test-case-p nil
"Whether `tramp--test-instrument-test-case' run.
@@ -2866,7 +2879,8 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(file-name-nondirectory tmp-name1) tmp-name2))
(tmp-name4 (expand-file-name "foo" tmp-name1))
(tmp-name5 (expand-file-name "foo" tmp-name2))
- (tmp-name6 (expand-file-name "foo" tmp-name3)))
+ (tmp-name6 (expand-file-name "foo" tmp-name3))
+ (tmp-name7 (tramp--test-make-temp-name nil quoted)))
;; Copy complete directory.
(unwind-protect
@@ -2922,7 +2936,48 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
;; Cleanup.
(ignore-errors
(delete-directory tmp-name1 'recursive)
- (delete-directory tmp-name2 'recursive))))))
+ (delete-directory tmp-name2 'recursive)))
+
+ ;; Copy symlink to directory. Implemented since Emacs 28.1.
+ (when (boundp 'copy-directory-create-symlink)
+ (dolist (copy-directory-create-symlink '(nil t))
+ (unwind-protect
+ (tramp--test-ignore-make-symbolic-link-error
+ ;; Copy to file name.
+ (make-directory tmp-name1)
+ (write-region "foo" nil tmp-name4)
+ (make-symbolic-link tmp-name1 tmp-name7)
+ (should (file-directory-p tmp-name1))
+ (should (file-exists-p tmp-name4))
+ (should (file-symlink-p tmp-name7))
+ (copy-directory tmp-name7 tmp-name2)
+ (if copy-directory-create-symlink
+ (should
+ (string-equal
+ (file-symlink-p tmp-name2) (file-symlink-p tmp-name7)))
+ (should (file-directory-p tmp-name2)))
+ ;; Copy to directory name.
+ (delete-directory tmp-name2 'recursive)
+ (make-directory tmp-name2)
+ (should (file-directory-p tmp-name2))
+ (copy-directory tmp-name7 (file-name-as-directory tmp-name2))
+ (if copy-directory-create-symlink
+ (should
+ (string-equal
+ (file-symlink-p
+ (expand-file-name
+ (file-name-nondirectory tmp-name7) tmp-name2))
+ (file-symlink-p tmp-name7)))
+ (should
+ (file-directory-p
+ (expand-file-name
+ (file-name-nondirectory tmp-name7) tmp-name2)))))
+
+ ;; Cleanup.
+ (ignore-errors
+ (delete-directory tmp-name1 'recursive)
+ (delete-directory tmp-name2 'recursive)
+ (delete-directory tmp-name7 'recursive))))))))
(ert-deftest tramp-test16-directory-files ()
"Check `directory-files'."
@@ -3266,19 +3321,6 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(ignore-errors (kill-buffer buffer))
(ignore-errors (delete-directory tmp-name1 'recursive))))))
-;; Method "smb" supports `make-symbolic-link' only if the remote host
-;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el, tramp-rclone.el
-;; and tramp-sshfs.el do not support symbolic links at all.
-(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
- "Run BODY, ignoring \"make-symbolic-link not supported\" file error."
- (declare (indent defun) (debug (body)))
- `(condition-case err
- (progn ,@body)
- (file-error
- (unless (string-equal (error-message-string err)
- "make-symbolic-link not supported")
- (signal (car err) (cdr err))))))
-
(ert-deftest tramp-test18-file-attributes ()
"Check `file-attributes'.
This tests also `access-file', `file-readable-p',
@@ -4096,7 +4138,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (file-selinux-context tmp-name1))
- (copy-file tmp-name1 tmp-name2)
+ (copy-file tmp-name1 tmp-name2 nil nil nil 'preserve-permissions)
(should (file-selinux-context tmp-name2))
(should
(equal
@@ -4535,16 +4577,51 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-process proc)))
+ ;; Process connection type.
+ (when (and (tramp--test-sh-p)
+ (not (tramp-direct-async-process-p))
+ ;; `executable-find' has changed the number of
+ ;; parameters in Emacs 27.1, so we use `apply' for
+ ;; older Emacsen.
+ (ignore-errors
+ (with-no-warnings
+ (apply #'executable-find '("hexdump" remote)))))
+ (dolist (process-connection-type '(nil pipe t pty))
+ (unwind-protect
+ (with-temp-buffer
+ (setq proc
+ (start-file-process
+ (format "test4-%s" process-connection-type)
+ (current-buffer) "hexdump" "-v" "-e" "/1 \"%02X\n\""))
+ (should (processp proc))
+ (should (equal (process-status proc) 'run))
+ (process-send-string proc "foo\r\n")
+ (process-send-eof proc)
+ ;; Read output.
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (< (- (point-max) (point-min))
+ (length "66\n6F\n6F\n0D\n0A\n"))
+ (while (accept-process-output proc 0 nil t))))
+ (should
+ (string-match-p
+ (if (memq process-connection-type '(nil pipe))
+ "66\n6F\n6F\n0D\n0A\n"
+ "66\n6F\n6F\n0A\n0A\n")
+ (buffer-string))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-process proc)))))
+
;; PTY.
(unwind-protect
(with-temp-buffer
;; It works only for tramp-sh.el, and not direct async processes.
(if (or (not (tramp--test-sh-p)) (tramp-direct-async-process-p))
(should-error
- (start-file-process "test4" (current-buffer) nil)
+ (start-file-process "test5" (current-buffer) nil)
:type 'wrong-type-argument)
- (setq proc (start-file-process "test4" (current-buffer) nil))
+ (setq proc (start-file-process "test5" (current-buffer) nil))
(should (processp proc))
(should (equal (process-status proc) 'run))
;; On MS Windows, `process-tty-name' returns nil.
@@ -4559,8 +4636,9 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
"Define ert test `TEST-direct-async' for direct async processes.
If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(declare (indent 1))
- ;; `make-process' supports file name handlers since Emacs 27.
- (when (let ((file-name-handler-alist '(("" . #'tramp--test-always))))
+ ;; `make-process' supports file name handlers since Emacs 27. We
+ ;; cannot use `tramp--test-always' during compilation of the macro.
+ (when (let ((file-name-handler-alist '(("" . (lambda (&rest _) t)))))
(ignore-errors (make-process :file-handler t)))
`(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) ()
,docstring
@@ -4749,7 +4827,53 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
;; Cleanup.
(ignore-errors (delete-process proc))
- (ignore-errors (delete-file tmp-name)))))))
+ (ignore-errors (delete-file tmp-name))))
+
+ ;; Process connection type.
+ (when (and (tramp--test-sh-p)
+ (not (tramp-direct-async-process-p))
+ ;; `executable-find' has changed the number of
+ ;; parameters in Emacs 27.1, so we use `apply' for
+ ;; older Emacsen.
+ (ignore-errors
+ (with-no-warnings
+ (apply #'executable-find '("hexdump" remote)))))
+ (dolist (connection-type '(nil pipe t pty))
+ ;; `process-connection-type' is taken when
+ ;; `:connection-type' is nil.
+ (dolist (process-connection-type
+ (unless connection-type '(nil pipe t pty)))
+ (unwind-protect
+ (with-temp-buffer
+ (setq proc
+ (with-no-warnings
+ (make-process
+ :name
+ (format "test7-%s-%s"
+ connection-type process-connection-type)
+ :buffer (current-buffer)
+ :connection-type connection-type
+ :command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
+ :file-handler t)))
+ (should (processp proc))
+ (should (equal (process-status proc) 'run))
+ (process-send-string proc "foo\r\n")
+ (process-send-eof proc)
+ ;; Read output.
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (< (- (point-max) (point-min))
+ (length "66\n6F\n6F\n0D\n0A\n"))
+ (while (accept-process-output proc 0 nil t))))
+ (should
+ (string-match-p
+ (if (memq (or connection-type process-connection-type)
+ '(nil pipe))
+ "66\n6F\n6F\n0D\n0A\n"
+ "66\n6F\n6F\n0A\n0A\n")
+ (buffer-string))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-process proc)))))))))
(tramp--test--deftest-direct-async-process tramp-test30-make-process
"Check direct async `make-process'.")
@@ -6320,6 +6444,7 @@ This requires restrictions of file name syntax."
;; These tests are inspired by Bug#17238.
(ert-deftest tramp-test41-special-characters ()
"Check special characters in file names."
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 245s
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
@@ -6330,6 +6455,7 @@ This requires restrictions of file name syntax."
"Check special characters in file names.
Use the `stat' command."
:tags '(:expensive-test)
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 287s
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
@@ -6348,6 +6474,7 @@ Use the `stat' command."
"Check special characters in file names.
Use the `perl' command."
:tags '(:expensive-test)
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 266s
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
@@ -6369,6 +6496,7 @@ Use the `perl' command."
"Check special characters in file names.
Use the `ls' command."
:tags '(:expensive-test)
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 287s
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
@@ -6434,6 +6562,7 @@ Use the `ls' command."
(ert-deftest tramp-test42-utf8 ()
"Check UTF8 encoding in file names and file contents."
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-rsync-p)))
@@ -6449,6 +6578,7 @@ Use the `ls' command."
"Check UTF8 encoding in file names and file contents.
Use the `stat' command."
:tags '(:expensive-test)
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 595s
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-docker-p)))
@@ -6471,6 +6601,7 @@ Use the `stat' command."
"Check UTF8 encoding in file names and file contents.
Use the `perl' command."
:tags '(:expensive-test)
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-docker-p)))
@@ -6496,6 +6627,7 @@ Use the `perl' command."
"Check UTF8 encoding in file names and file contents.
Use the `ls' command."
:tags '(:expensive-test)
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 690s
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-docker-p)))
diff --git a/test/lisp/gnus/nnrss-tests.el b/test/lisp/newcomment-tests.el
similarity index 55%
copy from test/lisp/gnus/nnrss-tests.el
copy to test/lisp/newcomment-tests.el
index 9821ec7..5485673 100644
--- a/test/lisp/gnus/nnrss-tests.el
+++ b/test/lisp/newcomment-tests.el
@@ -1,6 +1,6 @@
-;;; nnrss-tests.el --- tests for gnus/nnrss.el -*- lexical-binding:t -*-
+;;; newcomment-tests.el -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -17,13 +17,23 @@
;; 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 'nnrss)
-
-(ert-deftest test-nnrss-normalize ()
- (should (equal (nnrss-normalize-date "2004-09-17T05:09:49.001+00:00")
- "Fri, 17 Sep 2004 05:09:49 +0000")))
-;;; nnrss-tests.el ends here
+(ert-deftest test-uncomment-space-comment-continue ()
+ (let ((comment-style 'multi-line)
+ (comment-continue " ")
+ (text " a\n b"))
+ (should
+ (equal text
+ (with-temp-buffer
+ (c-mode)
+ (insert text)
+ (comment-region (point-min) (point-max))
+ (uncomment-region (point-min) (point-max))
+ (buffer-string))))))
+
+;;; newcomment-testsuite.el ends here
diff --git a/test/lisp/mail/rfc2368-tests.el
b/test/lisp/obsolete/rfc2368-tests.el
similarity index 100%
rename from test/lisp/mail/rfc2368-tests.el
rename to test/lisp/obsolete/rfc2368-tests.el
diff --git a/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
index 8af4625..bb3d487 100644
--- a/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
+++ b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
@@ -17,7 +17,7 @@ For each of the HERE documents, the following checks will
done:
=item *
-All occurrences of the string "look-here" are fontified correcty.
+All occurrences of the string "look-here" are fontified correctly.
Note that we deliberately test the face, not the syntax property:
Users won't care for the syntax property, but they see the face.
Different implementations with different syntax properties have been
diff --git a/test/lisp/progmodes/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index 4d2bac6..5f3ba4d 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -154,16 +154,106 @@ point in the distant past, and is still broken in
perl-mode. "
(should (equal (get-text-property (match-beginning 0) 'face)
'font-lock-keyword-face))))
+(ert-deftest cperl-test-identify-heredoc ()
+ "Test whether a construct containing \"<<\" followed by a
+ bareword is properly identified for a here-document if
+ appropriate."
+ (let ((here-docs
+ '("$text .= <<DELIM;" ; mutator concatenating a here-doc
+ "func($arg) . <<DELIM;" ; concatenating a return value
+ "func 1, <<DELIM;" ; a function taking two arguments
+ ))
+ ;; There forms are currently mishandled in `perl-mode' :-(
+ (here-docs-cperl
+ '("print {a} <<DELIM;" ; printing to a file handle
+ "system $prog <<DELIM;" ; lie about the program's name
+ ))
+ (_undecidable
+ '("foo <<bar") ; could be either "foo() <<bar"
+ ; or "foo(<<bar)"
+ ))
+ (dolist (code (append here-docs (if (eq cperl-test-mode #'cperl-mode)
+ here-docs-cperl)))
+ (with-temp-buffer
+ (insert code "\n\nDELIM\n")
+ (funcall cperl-test-mode)
+ (goto-char (point-min))
+ (forward-line 1)
+ ;; We should now be within a here-doc.
+ (let ((ppss (syntax-ppss)))
+ (should (and (nth 8 ppss) (nth 4 ppss))))
+ ))))
+
+(ert-deftest cperl-test-identify-no-heredoc ()
+ "Test whether a construct containing \"<<\" which is not a
+ here-document is properly rejected."
+ (let (
+ (not-here-docs
+ '("while (<<>>) {" ; double angle bracket operator
+ "expr <<func();" ; left shift by a return value
+ "$var <<func;" ; left shift by a return value
+ "($var+1) <<func;" ; same for an expression
+ "$hash{key} <<func;" ; same for a hash element
+ "or $var <<func;" ; same for an expression
+ "sorted $by <<func" ; _not_ a call to sort
+ ))
+ (_undecidable
+ '("foo <<bar" ; could be either "foo() <<bar"
+ ; or "foo(<<bar)"
+ "$foo = <<;") ; empty delim forbidden since 5.28
+ ))
+ (dolist (code not-here-docs)
+ (with-temp-buffer
+ (insert code "\n\n")
+ (funcall cperl-test-mode)
+ (goto-char (point-min))
+ (forward-line 1)
+ ;; Point is not within a here-doc (nor string nor comment).
+ (let ((ppss (syntax-ppss)))
+ (should-not (nth 8 ppss)))
+ ))))
+
+(ert-deftest cperl-test-here-doc-missing-end ()
+ "Verify that a missing here-document terminator gives a message.
+This message prints the terminator which wasn't found and is only
+issued by CPerl mode."
+ (skip-unless (eq cperl-test-mode #'cperl-mode))
+ (ert-with-message-capture collected-messages
+ (with-temp-buffer
+ (insert "my $foo = <<HERE\n")
+ (insert "some text here\n")
+ (goto-char (point-min))
+ (funcall cperl-test-mode)
+ (cperl-find-pods-heres)
+ (should (string-match "End of here-document [‘'`]HERE[’']"
+ collected-messages))))
+ (ert-with-message-capture collected-messages
+ (with-temp-buffer
+ (insert "my $foo = <<HERE . <<'THERE'\n")
+ (insert "some text here\n")
+ (insert "HERE\n")
+ (insert "more text here\n")
+ (goto-char (point-min))
+ (funcall cperl-test-mode)
+ (cperl-find-pods-heres)
+ (should (string-match "End of here-document [‘'`]THERE[’']"
+ collected-messages)))))
+
(defvar perl-continued-statement-offset)
(defvar perl-indent-level)
+(defconst cperl--tests-heredoc-face
+ (if (equal cperl-test-mode 'perl-mode) 'perl-heredoc
+ 'font-lock-string-face))
+(defconst cperl--tests-heredoc-delim-face
+ (if (equal cperl-test-mode 'perl-mode) 'perl-heredoc
+ 'font-lock-constant-face))
+
(ert-deftest cperl-test-heredocs ()
"Test that HERE-docs are fontified with the appropriate face."
(require 'perl-mode)
(let ((file (ert-resource-file "here-docs.pl"))
(cperl-continued-statement-offset perl-continued-statement-offset)
- (target-font (if (equal cperl-test-mode 'perl-mode) 'perl-heredoc
- 'font-lock-string-face))
(case-fold-search nil))
(with-temp-buffer
(insert-file-contents file)
@@ -176,7 +266,7 @@ point in the distant past, and is still broken in
perl-mode. "
(while (search-forward "look-here" nil t)
(should (equal
(get-text-property (match-beginning 0) 'face)
- target-font))
+ cperl--tests-heredoc-face))
(beginning-of-line)
(should (null (looking-at "[ \t]")))
(forward-line 1)))
@@ -339,6 +429,72 @@ under timeout control."
(should (string-match
"poop ('foo', \n 'bar')" (buffer-string))))))
+(ert-deftest cperl-test-bug-14343 ()
+ "Verify that inserting text into a HERE-doc string with Elisp
+does not break fontification."
+ (with-temp-buffer
+ (insert "my $string = <<HERE;\n"
+ "One line of text.\n"
+ "Last line of this string.\n"
+ "HERE\n")
+ (funcall cperl-test-mode)
+ (font-lock-ensure)
+ (goto-char (point-min))
+ (search-forward "One line")
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-face))
+ (beginning-of-line)
+ (insert "Another line if text.\n")
+ (font-lock-ensure)
+ (forward-line -1)
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-face))
+ (search-forward "HERE")
+ (beginning-of-line)
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-delim-face)))
+ ;; insert into an empty here-document
+ (with-temp-buffer
+ (insert "print <<HERE;\n"
+ "HERE\n")
+ (funcall cperl-test-mode)
+ (font-lock-ensure)
+ (goto-char (point-min))
+ (forward-line)
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-delim-face))
+ ;; Insert a newline into the empty here-document
+ (goto-char (point-min))
+ (forward-line)
+ (insert "\n")
+ (search-forward "HERE")
+ (beginning-of-line)
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-delim-face))
+ ;; Insert text at the beginning of the here-doc
+ (goto-char (point-min))
+ (forward-line)
+ (insert "text")
+ (font-lock-ensure)
+ (search-backward "text")
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-face))
+ (search-forward "HERE")
+ (beginning-of-line)
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-delim-face))
+ ;; Insert a new line immediately before the delimiter
+ ;; (That's where the point is anyway)
+ (insert "A new line\n")
+ (font-lock-ensure)
+ ;; The delimiter is still the delimiter
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-delim-face))
+ (forward-line -1)
+ ;; The new line has been "added" to the here-document
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-face))))
+
(ert-deftest cperl-test-bug-16368 ()
"Verify that `cperl-forward-group-in-re' doesn't hide errors."
(skip-unless (eq cperl-test-mode #'cperl-mode))
diff --git a/test/lisp/progmodes/perl-mode-tests.el
b/test/lisp/progmodes/perl-mode-tests.el
index f63f8ad..3f4af5e 100644
--- a/test/lisp/progmodes/perl-mode-tests.el
+++ b/test/lisp/progmodes/perl-mode-tests.el
@@ -21,6 +21,13 @@
(require 'perl-mode)
+(ert-deftest perl-test-lock ()
+ (with-temp-buffer
+ (perl-mode)
+ (insert "$package = foo;")
+ (font-lock-ensure (point-min) (point-max))
+ (should (equal (get-text-property 4 'face)
'font-lock-variable-name-face))))
+
;;;; Re-use cperl-mode tests
(defvar cperl-test-mode)
diff --git a/test/lisp/progmodes/project-tests.el
b/test/lisp/progmodes/project-tests.el
index 68460a9..1e3f258 100644
--- a/test/lisp/progmodes/project-tests.el
+++ b/test/lisp/progmodes/project-tests.el
@@ -107,4 +107,19 @@ directory name (Bug#48471)."
collect (file-relative-name file dir))))
(should (equal relative-files '("some-file"))))))
+(ert-deftest project-ignores-bug-50240 ()
+ "Check that `project-files' does not ignore all files.
+When `project-ignores' includes a name matching project dir."
+ (skip-unless (executable-find find-program))
+ (project-tests--with-temporary-directory dir
+ (make-empty-file (expand-file-name "some-file" dir))
+ (let* ((project (make-project-tests--trivial
+ :root (file-name-as-directory dir)
+ :ignores (list (file-name-nondirectory
+ (directory-file-name dir)))))
+ (files (project-files project)))
+ (should (equal files
+ (list
+ (expand-file-name "some-file" dir)))))))
+
;;; project-tests.el ends here
diff --git a/test/lisp/progmodes/ruby-mode-tests.el
b/test/lisp/progmodes/ruby-mode-tests.el
index e2ea0d9..8bdfdc3 100644
--- a/test/lisp/progmodes/ruby-mode-tests.el
+++ b/test/lisp/progmodes/ruby-mode-tests.el
@@ -875,6 +875,28 @@ VALUES-PLIST is a list with alternating index and value
elements."
(ruby-mode-set-encoding)
(should (string= "# coding: iso-8859-15\nⓇ" (buffer-string))))))
+(ert-deftest ruby-imenu-with-private-modifier ()
+ (ruby-with-temp-buffer
+ (ruby-test-string
+ "class Blub
+ | def hi
+ | 'Hi!'
+ | end
+ |
+ | def bye
+ | 'Bye!'
+ | end
+ |
+ | private def hiding
+ | 'You can't see me'
+ | end
+ |end")
+ (should (equal (mapcar #'car (ruby-imenu-create-index))
+ '("Blub"
+ "Blub#hi"
+ "Blub#bye"
+ "Blub#hiding")))))
+
(ert-deftest ruby--indent/converted-from-manual-test ()
:tags '(:expensive-test)
;; Converted from manual test.
diff --git a/test/lisp/progmodes/sh-script-tests.el
b/test/lisp/progmodes/sh-script-tests.el
new file mode 100644
index 0000000..c21010c
--- /dev/null
+++ b/test/lisp/progmodes/sh-script-tests.el
@@ -0,0 +1,51 @@
+;;; sh-script-tests.el --- Tests for sh-script.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'sh-script)
+(require 'ert)
+
+(ert-deftest test-sh-script-indentation ()
+ (with-temp-buffer
+ (insert "relative-path/to/configure --prefix=$prefix\\
+ --with-x")
+ (shell-script-mode)
+ (goto-char (point-min))
+ (forward-line 1)
+ (indent-for-tab-command)
+ (should (equal
+ (buffer-substring-no-properties (point-min) (point-max))
+ "relative-path/to/configure --prefix=$prefix\\
+ --with-x"))))
+
+(ert-deftest test-basic-sh-indentation ()
+ (with-temp-buffer
+ (insert "myecho () {\necho foo\n}\n")
+ (shell-script-mode)
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string)
+ "myecho () {
+ echo foo
+}
+"))))
+
+;;; sh-script-tests.el ends here
diff --git a/test/lisp/progmodes/xref-tests.el
b/test/lisp/progmodes/xref-tests.el
index d294522..ff4b647 100644
--- a/test/lisp/progmodes/xref-tests.el
+++ b/test/lisp/progmodes/xref-tests.el
@@ -52,6 +52,14 @@
(should (string-match-p "file1\\.txt\\'" (xref-location-group (nth 0
locs))))
(should (string-match-p "file2\\.txt\\'" (xref-location-group (nth 1
locs))))))
+(ert-deftest xref-matches-in-directory-filters-with-ignores ()
+ (let ((locs (xref-matches-in-directory "bar" "*" xref-tests--data-dir
+ '("./file1.*"))))
+ (should (= 1 (length locs)))
+ (should (string-match-p "file2\\.txt\\'" (xref-location-group
+ (xref-item-location
+ (nth 0 locs)))))))
+
(ert-deftest xref-matches-in-directory-finds-two-matches-on-the-same-line ()
(let ((locs (xref-tests--locations-in-data-dir "foo")))
(should (= 2 (length locs)))
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index 6d004e6..7f62a41 100644
--- a/test/lisp/replace-tests.el
+++ b/test/lisp/replace-tests.el
@@ -465,7 +465,12 @@ Return the last evalled form in BODY."
;; isearch-lazy-highlight-new-loop and sit-for (bug#36328)
((symbol-function 'replace-highlight)
(lambda (&rest _args)
- (string-match "[A-Z ]" "ForestGreen"))))
+ (string-match "[A-Z ]" "ForestGreen")))
+ ;; Override `sit-for' and `ding' so that we don't have
+ ;; to wait and listen to bells when running the test.
+ ((symbol-function 'sit-for)
+ (lambda (&rest _args) (redisplay)))
+ ((symbol-function 'ding) 'ignore))
(perform-replace ,from ,to t
replace-tests-perform-replace-regexp-flag nil))
,@body))))
@@ -584,7 +589,7 @@ bound to HIGHLIGHT-LOCUS."
(replace-tests-with-highlighted-occurrence highlight-locus
(occur-mode-display-occurrence)
(with-current-buffer (marker-buffer
- (get-text-property (point) 'occur-target))
+ (caar (get-text-property (point) 'occur-target)))
(should (funcall check-overlays has-overlay)))))))
(ert-deftest replace-regexp-bug45973 ()
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index c571dc3..1ab539f 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -664,7 +664,29 @@ guaranteed by the originator of a cluster definition."
(should (member (format "/%s:%s" cluster2 (file-local-name file2))
(car shadow-literal-groups)))
;; Bug#49596.
- (should (member (concat primary file1) (car shadow-literal-groups))))
+ (should (member (concat primary file1) (car shadow-literal-groups)))
+
+ ;; Error handling.
+ (setq shadow-literal-groups nil)
+ ;; There's no `buffer-file-name'.
+ (with-temp-buffer
+ (call-interactively #'shadow-define-literal-group)
+ (set-buffer-modified-p nil))
+ (should-not shadow-literal-groups)
+ ;; Define an empty literal group.
+ (setq mocked-input `(,(kbd "RET")))
+ (with-temp-buffer
+ (set-visited-file-name file1)
+ (call-interactively #'shadow-define-literal-group)
+ (set-buffer-modified-p nil))
+ (should-not shadow-literal-groups)
+ ;; Use a non-existing site name.
+ (setq mocked-input `("foo" ,(kbd "RET")))
+ (with-temp-buffer
+ (set-visited-file-name file1)
+ (call-interactively #'shadow-define-literal-group)
+ (set-buffer-modified-p nil))
+ (should-not shadow-literal-groups))
;; Cleanup.
(shadow--tests-cleanup))))
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index 4b153d1..3ece612 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -959,6 +959,17 @@ See Bug#21722."
(with-shell-command-dont-erase-buffer str output-buffer-is-current
(should (= (point) (alist-get shell-command-dont-erase-buffer
expected-point)))))))
+(ert-deftest test-undo-region ()
+ (with-temp-buffer
+ (insert "This is a test\n")
+ (goto-char (point-min))
+ (setq buffer-undo-list nil)
+ (downcase-word 1)
+ (should (= (length (delq nil (undo-make-selective-list 1 9))) 2))
+ (should (= (length (delq nil (undo-make-selective-list 4 9))) 1))
+ ;; FIXME this is the off-by-one error case.
+ ;;(should (= (length (delq nil (undo-make-selective-list 5 9))) 0))
+ (should (= (length (delq nil (undo-make-selective-list 6 9))) 0))))
(provide 'simple-test)
;;; simple-test.el ends here
diff --git a/test/lisp/so-long-tests/so-long-tests-helpers.el
b/test/lisp/so-long-tests/so-long-tests-helpers.el
index ab4d9c6..dd2331e 100644
--- a/test/lisp/so-long-tests/so-long-tests-helpers.el
+++ b/test/lisp/so-long-tests/so-long-tests-helpers.el
@@ -43,7 +43,8 @@
(cl-case action
('so-long-mode
(should (eq major-mode 'so-long-mode))
- (so-long-tests-assert-overrides))
+ (so-long-tests-assert-overrides)
+ (so-long-tests-assert-preserved))
('so-long-minor-mode
(should (eq so-long-minor-mode t))
(so-long-tests-assert-overrides))
@@ -62,7 +63,8 @@
(cl-case action
('so-long-mode
(should-not (eq major-mode 'so-long-mode))
- (so-long-tests-assert-overrides-reverted))
+ (so-long-tests-assert-overrides-reverted)
+ (so-long-tests-assert-preserved))
('so-long-minor-mode
(should-not (eq so-long-minor-mode t))
(so-long-tests-assert-overrides-reverted))
@@ -90,6 +92,17 @@
(when (boundp (car ovar))
(should (equal (symbol-value (car ovar)) (cdr ovar))))))
+(defun so-long-tests-assert-preserved ()
+ "Assert that preserved modes and variables have their expected values."
+ (dolist (var so-long-mode-preserved-variables)
+ (when (boundp var)
+ (should (equal (symbol-value var)
+ (alist-get var so-long-tests-memory)))))
+ (dolist (mode so-long-mode-preserved-minor-modes)
+ (when (boundp mode)
+ (should (equal (symbol-value mode)
+ (alist-get mode so-long-tests-memory))))))
+
(defun so-long-tests-remember ()
"Remember the original states of modes and variables.
@@ -107,7 +120,22 @@ state against this remembered state."
(dolist (mode so-long-minor-modes)
(when (boundp mode)
(push (cons mode (symbol-value mode))
+ so-long-tests-memory)))
+ (dolist (var so-long-mode-preserved-variables)
+ (when (boundp var)
+ (push (cons var (symbol-value var))
+ so-long-tests-memory)))
+ (dolist (mode so-long-mode-preserved-minor-modes)
+ (when (boundp mode)
+ (push (cons mode (symbol-value mode))
so-long-tests-memory))))
+(defun so-long-tests-predicates ()
+ "Return the list of testable predicate functions."
+ (if (fboundp 'buffer-line-statistics)
+ '(so-long-statistics-excessive-p
+ so-long-detected-long-line-p)
+ '(so-long-detected-long-line-p)))
+
(provide 'so-long-tests-helpers)
;;; so-long-tests-helpers.el ends here
diff --git a/test/lisp/so-long-tests/so-long-tests.el
b/test/lisp/so-long-tests/so-long-tests.el
index a6d8721..8e4597c 100644
--- a/test/lisp/so-long-tests/so-long-tests.el
+++ b/test/lisp/so-long-tests/so-long-tests.el
@@ -57,101 +57,131 @@
(declare-function so-long-tests-assert-active "so-long-tests-helpers")
(declare-function so-long-tests-assert-reverted "so-long-tests-helpers")
(declare-function so-long-tests-assert-and-revert "so-long-tests-helpers")
+(declare-function so-long-tests-predicates "so-long-tests-helpers")
-;; Enable the automated behavior for all tests.
+;; Enable the automated behaviour for all tests.
(global-so-long-mode 1)
(ert-deftest so-long-tests-threshold-under ()
"Under line length threshold."
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1- so-long-threshold) ?x))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode))))
+ (dolist (so-long-predicate (so-long-tests-predicates))
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1- so-long-threshold) ?x))
+ (normal-mode)
+ (should (eq major-mode 'emacs-lisp-mode)))))
(ert-deftest so-long-tests-threshold-at ()
"At line length threshold."
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1- so-long-threshold) ?x))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode))))
+ (dolist (so-long-predicate (so-long-tests-predicates))
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1- so-long-threshold) ?x))
+ (normal-mode)
+ (should (eq major-mode 'emacs-lisp-mode)))))
(ert-deftest so-long-tests-threshold-over ()
"Over line length threshold."
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (normal-mode)
- (so-long-tests-remember)
- (insert (make-string (1+ so-long-threshold) ?x))
- (normal-mode)
- (so-long-tests-assert-and-revert 'so-long-mode)))
+ (dolist (so-long-predicate (so-long-tests-predicates))
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (normal-mode)
+ (so-long-tests-remember)
+ (insert (make-string (1+ so-long-threshold) ?x))
+ (normal-mode)
+ (so-long-tests-assert-and-revert 'so-long-mode))))
(ert-deftest so-long-tests-skip-comments ()
"Skip leading shebang, whitespace, and comments."
- ;; Long comment, no newline.
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1+ so-long-threshold) ?\;))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode)))
- ;; Long comment, with newline.
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1+ so-long-threshold) ?\;))
- (insert "\n")
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode)))
- ;; Long comment, with short text following.
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1+ so-long-threshold) ?\;))
- (insert "\n")
- (insert (make-string so-long-threshold ?x))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode)))
- ;; Long comment, with long text following.
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1+ so-long-threshold) ?\;))
- (insert "\n")
- (insert (make-string (1+ so-long-threshold) ?x))
- (normal-mode)
- (should (eq major-mode 'so-long-mode))))
+ ;; Only for `so-long-detected-long-line-p' -- comments are not
+ ;; treated differently when using `so-long-statistics-excessive-p'.
+ (dolist (so-long-predicate (so-long-tests-predicates))
+ ;; Long comment, no newline.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1+ so-long-threshold) ?\;))
+ (normal-mode)
+ (should (eq major-mode
+ (cond ((eq so-long-predicate #'so-long-detected-long-line-p)
+ 'emacs-lisp-mode)
+ ((eq so-long-predicate
#'so-long-statistics-excessive-p)
+ 'so-long-mode)))))
+ ;; Long comment, with newline.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1+ so-long-threshold) ?\;))
+ (insert "\n")
+ (normal-mode)
+ (should (eq major-mode
+ (cond ((eq so-long-predicate #'so-long-detected-long-line-p)
+ 'emacs-lisp-mode)
+ ((eq so-long-predicate
#'so-long-statistics-excessive-p)
+ 'so-long-mode)))))
+ ;; Long comment, with short text following.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1+ so-long-threshold) ?\;))
+ (insert "\n")
+ (insert (make-string so-long-threshold ?x))
+ (normal-mode)
+ (should (eq major-mode
+ (cond ((eq so-long-predicate #'so-long-detected-long-line-p)
+ 'emacs-lisp-mode)
+ ((eq so-long-predicate
#'so-long-statistics-excessive-p)
+ 'so-long-mode)))))
+ ;; Long comment, with long text following.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1+ so-long-threshold) ?\;))
+ (insert "\n")
+ (insert (make-string (1+ so-long-threshold) ?x))
+ (normal-mode)
+ (should (eq major-mode 'so-long-mode)))))
(ert-deftest so-long-tests-max-lines ()
"Give up after `so-long-max-lines'."
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- ;; Insert exactly `so-long-max-lines' non-comment lines, followed
- ;; by a long line.
- (dotimes (_ so-long-max-lines)
- (insert "x\n"))
- (insert (make-string (1+ so-long-threshold) ?x))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode))
- ;; If `so-long-max-lines' is nil, don't give up the search.
- (let ((so-long-max-lines nil))
- (normal-mode)
- (should (eq major-mode 'so-long-mode)))
- ;; If `so-long-skip-leading-comments' is nil, all lines are
- ;; counted, and so the shebang line counts, which makes the
- ;; long line one line further away.
- (let ((so-long-skip-leading-comments nil)
- (so-long-max-lines (1+ so-long-max-lines)))
+ ;; Only for `so-long-detected-long-line-p' -- the whole buffer is
+ ;; 'seen' when using `so-long-statistics-excessive-p'.
+ (dolist (so-long-predicate (so-long-tests-predicates))
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ ;; Insert exactly `so-long-max-lines' non-comment lines, followed
+ ;; by a long line.
+ (dotimes (_ so-long-max-lines)
+ (insert "x\n"))
+ (insert (make-string (1+ so-long-threshold) ?x))
(normal-mode)
- (should (eq major-mode 'emacs-lisp-mode))
- (let ((so-long-max-lines (1+ so-long-max-lines)))
+ (should (eq major-mode
+ (cond ((eq so-long-predicate #'so-long-detected-long-line-p)
+ 'emacs-lisp-mode)
+ ((eq so-long-predicate
#'so-long-statistics-excessive-p)
+ 'so-long-mode))))
+ ;; If `so-long-max-lines' is nil, don't give up the search.
+ (let ((so-long-max-lines nil))
(normal-mode)
- (should (eq major-mode 'so-long-mode))))))
+ (should (eq major-mode 'so-long-mode)))
+ ;; If `so-long-skip-leading-comments' is nil, all lines are
+ ;; counted, and so the shebang line counts, which makes the
+ ;; long line one line further away.
+ (let ((so-long-skip-leading-comments nil)
+ (so-long-max-lines (1+ so-long-max-lines)))
+ (normal-mode)
+ (should (eq major-mode
+ (cond ((eq so-long-predicate
#'so-long-detected-long-line-p)
+ 'emacs-lisp-mode)
+ ((eq so-long-predicate
#'so-long-statistics-excessive-p)
+ 'so-long-mode))))
+ (let ((so-long-max-lines (1+ so-long-max-lines)))
+ (normal-mode)
+ (should (eq major-mode 'so-long-mode)))))))
(ert-deftest so-long-tests-invisible-buffer-function ()
"Call `so-long-invisible-buffer-function' in invisible buffers."
@@ -180,7 +210,7 @@
;; From Emacs 27 the `display-buffer' call is insufficient.
;; The various 'window change functions' are now invoked by the
;; redisplay, and redisplay does nothing at all in batch mode,
- ;; so we cannot test under this revised behavior. Refer to:
+ ;; so we cannot test under this revised behaviour. Refer to:
;; https://lists.gnu.org/r/emacs-devel/2019-10/msg00971.html
;; For interactive (non-batch) test runs, calling `redisplay'
;; does do the trick; so do that first.
@@ -195,7 +225,9 @@
;; Emacs adds the framework necessary to make `redisplay' work
;; in batch mode.
(unless (eq so-long--active t)
- (run-window-configuration-change-hook))))
+ (with-suppressed-warnings
+ ((obsolete run-window-configuration-change-hook))
+ (run-window-configuration-change-hook)))))
(so-long-tests-assert-and-revert 'so-long-mode))
;; `so-long-invisible-buffer-function' is `nil'.
(with-temp-buffer
@@ -230,7 +262,9 @@
(redisplay)
(when noninteractive
(unless (eq so-long--active t)
- (run-window-configuration-change-hook))))
+ (with-suppressed-warnings
+ ((obsolete run-window-configuration-change-hook))
+ (run-window-configuration-change-hook)))))
(should (eq major-mode 'emacs-lisp-mode))))
(ert-deftest so-long-tests-actions ()
@@ -323,20 +357,76 @@
(normal-mode)
(should (eq major-mode 'so-long-mode)))))
+(ert-deftest so-long-tests-preserved-variables-and-modes ()
+ "Preserved variables and minor modes when using `so-long-mode'."
+ ;; Test the user options `so-long-mode-preserved-variables' and
+ ;; `so-long-mode-preserved-minor-modes'. The minor mode `view-mode'
+ ;; is 'preserved' by default (using both options).
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (normal-mode)
+ ;; We enable `view-mode' before triggering `so-long'.
+ (insert (make-string (1+ so-long-threshold) ?x))
+ (view-mode 1)
+ (should (eq view-mode t))
+ (should (eq buffer-read-only t))
+ (so-long-tests-remember)
+ (let ((so-long-action 'so-long-mode)
+ (menu (so-long-menu)))
+ (so-long)
+ (so-long-tests-assert-active 'so-long-mode)
+ (should (eq view-mode t))
+ (should (eq buffer-read-only t))
+ ;; Revert.
+ (funcall (lookup-key menu [so-long-revert]))
+ (so-long-tests-assert-reverted 'so-long-mode)
+ (should (eq view-mode t))
+ (should (eq buffer-read-only t))
+ ;; Disable `view-mode'. Note that without the preserved
+ ;; variables, the conflict between how `view-mode' and `so-long'
+ ;; each deal with the buffer's original `buffer-read-only' value
+ ;; would lead to a situation whereby the buffer would still be
+ ;; read-only after `view-mode' had been disabled.
+ (view-mode 0)
+ (should (eq view-mode nil))
+ (should (eq buffer-read-only nil))))
+ ;; Without `view-mode'.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (normal-mode)
+ (insert (make-string (1+ so-long-threshold) ?x))
+ (should (eq view-mode nil))
+ (so-long-tests-remember)
+ (let ((so-long-action 'so-long-mode)
+ (menu (so-long-menu)))
+ (so-long)
+ (so-long-tests-assert-active 'so-long-mode)
+ (should (eq view-mode nil))
+ ;; Revert.
+ (funcall (lookup-key menu [so-long-revert]))
+ (so-long-tests-assert-reverted 'so-long-mode)
+ (should (eq view-mode nil)))))
+
(ert-deftest so-long-tests-predicate ()
"Custom predicate function."
;; Test the `so-long-predicate' user option.
+ ;; Always true. Trigger when we normally wouldn't.
(with-temp-buffer
(display-buffer (current-buffer))
(insert "#!emacs\n")
- ;; Always false.
- (let ((so-long-predicate #'ignore))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode)))
- ;; Always true.
(let ((so-long-predicate (lambda () t)))
(normal-mode)
- (should (eq major-mode 'so-long-mode)))))
+ (should (eq major-mode 'so-long-mode))))
+ ;; Always false. Don't trigger when we normally would.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1+ so-long-threshold) ?x))
+ (let ((so-long-predicate #'ignore))
+ (normal-mode)
+ (should (eq major-mode 'emacs-lisp-mode)))))
(ert-deftest so-long-tests-file-local-action ()
"File-local action."
@@ -405,7 +495,10 @@
(insert ,local-vars)
(normal-mode)
;; Remember the `emacs-lisp-mode' state. The other cases
- ;; will validate the 'reverted' state against this.
+ ;; will validate the 'reverted' state against this. (Note
+ ;; that we haven't displayed the buffer, and therefore only
+ ;; `so-long-invisible-buffer-function' has acted, so we are
+ ;; still remembering the 'before' state.)
(so-long-tests-remember)
(should (eq major-mode 'emacs-lisp-mode)))
;; Downgrade the action from major mode to minor mode.
diff --git a/test/lisp/so-long-tests/spelling-tests.el
b/test/lisp/so-long-tests/spelling-tests.el
index 0be8555..f778b64 100644
--- a/test/lisp/so-long-tests/spelling-tests.el
+++ b/test/lisp/so-long-tests/spelling-tests.el
@@ -57,7 +57,7 @@
(unwind-protect
(cl-letf (((symbol-function 'ispell-command-loop)
(lambda (_miss _guess word _start _end)
- (message "Unrecognized word: %s." word)
+ (message "Unrecognised word: %s." word)
(throw 'mistake t))))
(catch 'mistake
(find-library "so-long")
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index b57982a..54bee7b 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -62,6 +62,25 @@
(0 font-lock-keyword-face))))))))
+;;;; List functions.
+
+(ert-deftest subr-test-caaar ()
+ (should (null (caaar '())))
+ (should (null (caaar '(() (2)))))
+ (should (null (caaar '((() (2)) (a b)))))
+ (should-error (caaar '(1 2)) :type 'wrong-type-argument)
+ (should-error (caaar '((1 2))) :type 'wrong-type-argument)
+ (should (= 1 (caaar '(((1 2) (3 4))))))
+ (should (null (caaar '((() (3 4)))))))
+
+(ert-deftest subr-test-caadr ()
+ (should (null (caadr '())))
+ (should (null (caadr '(1))))
+ (should-error (caadr '(1 2)) :type 'wrong-type-argument)
+ (should (= 2 (caadr '(1 (2 3)))))
+ (should (equal '((2) (3)) (caadr '((1) (((2) (3))) (4))))))
+
+
;;;; Keymap support.
(ert-deftest subr-test-kbd ()
@@ -694,5 +713,59 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350.";
(should-not (buffer-local-boundp 'test-not-boundp buf))
(should (buffer-local-boundp 'test-global-boundp buf))))
+(ert-deftest test-replace-string-in-region ()
+ (with-temp-buffer
+ (insert "foo bar zot foobar")
+ (should (= (replace-string-in-region "foo" "new" (point-min) (point-max))
+ 2))
+ (should (equal (buffer-string) "new bar zot newbar")))
+
+ (with-temp-buffer
+ (insert "foo bar zot foobar")
+ (should (= (replace-string-in-region "foo" "new" (point-min) 14)
+ 1))
+ (should (equal (buffer-string) "new bar zot foobar")))
+
+ (with-temp-buffer
+ (insert "foo bar zot foobar")
+ (should-error (replace-string-in-region "foo" "new" (point-min) 30)))
+
+ (with-temp-buffer
+ (insert "Foo bar zot foobar")
+ (should (= (replace-string-in-region "Foo" "new" (point-min))
+ 1))
+ (should (equal (buffer-string) "new bar zot foobar"))))
+
+(ert-deftest test-replace-regexp-in-region ()
+ (with-temp-buffer
+ (insert "foo bar zot foobar")
+ (should (= (replace-regexp-in-region "fo+" "new" (point-min) (point-max))
+ 2))
+ (should (equal (buffer-string) "new bar zot newbar")))
+
+ (with-temp-buffer
+ (insert "foo bar zot foobar")
+ (should (= (replace-regexp-in-region "fo+" "new" (point-min) 14)
+ 1))
+ (should (equal (buffer-string) "new bar zot foobar")))
+
+ (with-temp-buffer
+ (insert "foo bar zot foobar")
+ (should-error (replace-regexp-in-region "fo+" "new" (point-min) 30)))
+
+ (with-temp-buffer
+ (insert "Foo bar zot foobar")
+ (should (= (replace-regexp-in-region "Fo+" "new" (point-min))
+ 1))
+ (should (equal (buffer-string) "new bar zot foobar"))))
+
+(ert-deftest test-with-existing-directory ()
+ (let ((dir (make-temp-name "/tmp/not-exist-")))
+ (let ((default-directory dir))
+ (should-not (file-exists-p default-directory)))
+ (with-existing-directory
+ (should-not (equal dir default-directory))
+ (should (file-exists-p default-directory)))))
+
(provide 'subr-tests)
;;; subr-tests.el ends here
diff --git a/test/lisp/term-tests.el b/test/lisp/term-tests.el
index 503cb5d..50ac370 100644
--- a/test/lisp/term-tests.el
+++ b/test/lisp/term-tests.el
@@ -56,7 +56,7 @@
first line\r
next line\r\n"))
(should (equal (term-test-screen-from-input 40 12 str)
- (replace-regexp-in-string "\r" "" str)))))
+ (string-replace "\r" "" str)))))
(ert-deftest term-carriage-return ()
(skip-unless (not (memq system-type '(windows-nt ms-dos))))
diff --git a/test/lisp/textmodes/fill-tests.el
b/test/lisp/textmodes/fill-tests.el
index a4c7f44..fcc2c75 100644
--- a/test/lisp/textmodes/fill-tests.el
+++ b/test/lisp/textmodes/fill-tests.el
@@ -54,7 +54,7 @@
(beg (line-beginning-position))
(end (line-end-position))
(fill-prefix (make-string (- pos beg) ?\s))
- ;; `fill-column' is too small to accomodate the current line
+ ;; `fill-column' is too small to accommodate the current line
(fill-column (- end beg 10)))
(fill-region-as-paragraph beg end nil nil pos))
(should (equal (buffer-string) string)))))
@@ -69,7 +69,7 @@
(beg (line-beginning-position))
(end (line-end-position))
(fill-prefix (make-string (- pos beg) ?\s))
- ;; `fill-column' is too small to accomodate the current line
+ ;; `fill-column' is too small to accommodate the current line
(fill-column (- end beg 10)))
(fill-region-as-paragraph beg end nil nil pos))
(should (equal
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index fba6f21..1849480 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -223,4 +223,12 @@ position to retrieve THING.")
(should (equal (test--number "0xf00" 2) 3840))
(should (equal (test--number "0xf00" 3) 3840)))
+(ert-deftest test-fields ()
+ (with-temp-buffer
+ (insert (propertize "foo" 'field 1) "bar" (propertize "zot" 'field 2))
+ (goto-char 1)
+ (should (eq (symbol-at-point) 'foo))
+ (goto-char 5)
+ (should (eq (symbol-at-point) 'bar))))
+
;;; thingatpt.el ends here
diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el
index 0d64320..4e6fbbb 100644
--- a/test/lisp/time-stamp-tests.el
+++ b/test/lisp/time-stamp-tests.el
@@ -849,7 +849,7 @@ The functions in `pattern-mod' are composed left to right."
(defun formatz-mod-del-colons (string)
"Returns STRING with any colons removed."
- (replace-regexp-in-string ":" "" string))
+ (string-replace ":" "" string))
(defun formatz-mod-add-00 (string)
"Returns STRING with \"00\" appended."
diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el
index 5bc4ad6..fefe50d 100644
--- a/test/lisp/vc/diff-mode-tests.el
+++ b/test/lisp/vc/diff-mode-tests.el
@@ -468,4 +468,16 @@ baz"))))
(114 131 (diff-mode syntax face font-lock-string-face))
(134 140 (diff-mode syntax face
font-lock-keyword-face))))))))
+(ert-deftest test-hunk-file-names ()
+ (with-temp-buffer
+ (insert "diff -c /tmp/ange-ftp13518wvE.el /tmp/ange-ftp1351895K.el\n")
+ (goto-char (point-min))
+ (should (equal (diff-hunk-file-names)
+ '("/tmp/ange-ftp1351895K.el" "/tmp/ange-ftp13518wvE.el"))))
+ (with-temp-buffer
+ (insert "diff -c -L /ftp:slbhao:/home/albinus/src/tramp/lisp/tramp.el -L
/ftp:slbhao:/home/albinus/src/emacs/lisp/net/tramp.el /tmp/ange-ftp13518wvE.el
/tmp/ange-ftp1351895K.el\n")
+ (goto-char (point-min))
+ (should (equal (diff-hunk-file-names)
+ '("/tmp/ange-ftp1351895K.el" "/tmp/ange-ftp13518wvE.el")))))
+
(provide 'diff-mode-tests)
diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el
index 5430535..4169a96 100644
--- a/test/lisp/vc/vc-tests.el
+++ b/test/lisp/vc/vc-tests.el
@@ -52,7 +52,7 @@
;; - responsible-p (file)
;; - receive-file (file rev)
;; - unregister (file) DONE
-;; * checkin (files comment)
+;; * checkin (files comment) DONE
;; * find-revision (file rev buffer)
;; * checkout (file &optional rev)
;; * revert (file &optional contents-done)
@@ -75,7 +75,7 @@
;; - show-log-entry (revision)
;; - comment-history (file)
;; - update-changelog (files)
-;; * diff (files &optional async rev1 rev2 buffer)
+;; * diff (files &optional async rev1 rev2 buffer) DONE
;; - revision-completion-table (files)
;; - annotate-command (file buf &optional rev)
;; - annotate-time ()
@@ -100,7 +100,7 @@
;; - log-edit-mode ()
;; - check-headers ()
;; - delete-file (file)
-;; - rename-file (old new)
+;; - rename-file (old new) DONE
;; - find-file-hook ()
;; - extra-menu ()
;; - extra-dir-menu ()
@@ -110,6 +110,7 @@
(require 'ert)
(require 'vc)
+(require 'log-edit)
(declare-function w32-application-type "w32proc.c")
@@ -547,6 +548,127 @@ This checks also `vc-backend' and
`vc-responsible-backend'."
(if tempdir (delete-directory tempdir t))
(run-hooks 'vc-test--cleanup-hook)))))
+(defun vc-test--rename-file (backend)
+ "Check the rename-file action."
+
+ (let ((vc-handled-backends `(,backend))
+ (default-directory
+ (file-name-as-directory
+ (expand-file-name
+ (make-temp-name "vc-test") temporary-file-directory)))
+ (process-environment process-environment)
+ tempdir
+ vc-test--cleanup-hook)
+ (when (eq backend 'Bzr)
+ (setq tempdir (make-temp-file "vc-test--rename-file" t)
+ process-environment (cons (format "BZR_HOME=%s" tempdir)
+ process-environment)))
+
+ (unwind-protect
+ (progn
+ ;; Cleanup.
+ (add-hook
+ 'vc-test--cleanup-hook
+ `(lambda () (delete-directory ,default-directory 'recursive)))
+
+ ;; Create empty repository.
+ (make-directory default-directory)
+ (vc-test--create-repo-function backend)
+
+ (let ((tmp-name (expand-file-name "foo" default-directory))
+ (new-name (expand-file-name "bar" default-directory)))
+ ;; Write a new file.
+ (write-region "foo" nil tmp-name nil 'nomessage)
+
+ ;; Register it. Renaming can fail otherwise.
+ (vc-register
+ (list backend (list (file-name-nondirectory tmp-name))))
+
+ (vc-rename-file tmp-name new-name)
+
+ (should (not (file-exists-p tmp-name)))
+ (should (file-exists-p new-name))
+
+ (should (equal (vc-state new-name)
+ (if (memq backend '(RCS SCCS))
+ 'up-to-date
+ 'added)))))
+
+ ;; Save exit.
+ (ignore-errors
+ (if tempdir (delete-directory tempdir t))
+ (run-hooks 'vc-test--cleanup-hook)))))
+
+(declare-function log-edit-done "vc/log-edit")
+
+(defun vc-test--version-diff (backend)
+ "Check the diff version of a repository."
+
+ (let ((vc-handled-backends `(,backend))
+ (default-directory
+ (file-name-as-directory
+ (expand-file-name
+ (make-temp-name "vc-test") temporary-file-directory)))
+ (process-environment process-environment)
+ tempdir
+ vc-test--cleanup-hook)
+ (when (eq backend 'Bzr)
+ (setq tempdir (make-temp-file "vc-test--version-diff" t)
+ process-environment (cons (format "BZR_HOME=%s" tempdir)
+ process-environment)))
+ (when (memq backend '(Bzr Git))
+ (setq process-environment (cons "EMAIL=john@doe.ee"
+ process-environment)))
+ (unwind-protect
+ (progn
+ ;; Cleanup.
+ (add-hook
+ 'vc-test--cleanup-hook
+ `(lambda () (delete-directory ,default-directory 'recursive)))
+
+ ;; Create empty repository. Check repository checkout model.
+ (make-directory default-directory)
+ (vc-test--create-repo-function backend)
+
+ (let* ((tmp-name (expand-file-name "foo" default-directory))
+ (files (list (file-name-nondirectory tmp-name))))
+ ;; Write and register a new file.
+ (write-region "originaltext" nil tmp-name nil 'nomessage)
+ (vc-register (list backend files))
+
+ (let ((buff (find-file tmp-name)))
+ (with-current-buffer buff
+ (progn
+ ;; Optionally checkout file.
+ (when (memq backend '(RCS CVS SCCS))
+ (vc-checkout tmp-name))
+
+ ;; Checkin file.
+ (vc-checkin files backend)
+ (insert "Testing vc-version-diff")
+ (log-edit-done))))
+
+ ;; Modify file content.
+ (when (memq backend '(RCS CVS SCCS))
+ (vc-checkout tmp-name))
+ (write-region "updatedtext" nil tmp-name nil 'nomessage)
+
+ ;; Check version diff.
+ (vc-version-diff files nil nil)
+ (should (bufferp (get-buffer "*vc-diff*")))
+
+ (with-current-buffer "*vc-diff*"
+ (progn
+ (let ((rawtext (buffer-substring-no-properties (point-min)
+ (point-max))))
+ (should (string-search "-originaltext" rawtext))
+ (should (string-search "+updatedtext" rawtext)))))))
+
+ ;; Save exit.
+ (ignore-errors
+ (if tempdir (delete-directory tempdir t))
+ (run-hooks 'vc-test--cleanup-hook)))))
+
;; Create the test cases.
(defun vc-test--rcs-enabled ()
@@ -648,7 +770,35 @@ This checks also `vc-backend' and
`vc-responsible-backend'."
(ert-get-test
',(intern
(format "vc-test-%s01-register" backend-string))))))
- (vc-test--checkout-model ',backend))))))
+ (vc-test--checkout-model ',backend))
+
+ (ert-deftest
+ ,(intern (format "vc-test-%s05-rename-file" backend-string)) ()
+ ,(format "Check `vc-rename-file' for the %s backend."
+ backend-string)
+ (skip-unless
+ (ert-test-passed-p
+ (ert-test-most-recent-result
+ (ert-get-test
+ ',(intern
+ (format "vc-test-%s01-register" backend-string))))))
+ ;; CVS calls vc-delete-file, which insists on prompting
+ ;; "Really want to delete ...?"
+ (skip-unless (not (eq 'CVS ',backend)))
+ (vc-test--rename-file ',backend))
+
+ (ert-deftest
+ ,(intern (format "vc-test-%s06-version-diff" backend-string)) ()
+ ,(format "Check `vc-version-diff' for the %s backend."
+ backend-string)
+ (skip-unless
+ (ert-test-passed-p
+ (ert-test-most-recent-result
+ (ert-get-test
+ ',(intern
+ (format "vc-test-%s01-register" backend-string))))))
+ (vc-test--version-diff ',backend))
+ ))))
(provide 'vc-tests)
;;; vc-tests.el ends here
diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el
index ba276e2..96a01fc 100644
--- a/test/lisp/wdired-tests.el
+++ b/test/lisp/wdired-tests.el
@@ -31,7 +31,7 @@ Partially modifying a file name should succeed."
(let* ((test-dir (make-temp-file "test-dir-" t))
(test-file (concat (file-name-as-directory test-dir) "foo.c"))
(replace "bar")
- (new-file (replace-regexp-in-string "foo" replace test-file))
+ (new-file (string-replace "foo" replace test-file))
(wdired-use-interactive-rename t))
(write-region "" nil test-file nil 'silent)
(advice-add 'dired-query ; Don't ask confirmation to overwrite a file.
@@ -109,7 +109,7 @@ wdired-mode."
(let* ((test-dir (make-temp-file "test-dir-" t))
(test-file (concat (file-name-as-directory test-dir) "foo.c"))
(replace "bar")
- (new-file (replace-regexp-in-string "foo" replace test-file)))
+ (new-file (string-replace "foo" replace test-file)))
(write-region "" nil test-file nil 'silent)
(let ((buf (find-file-noselect test-dir)))
(unwind-protect
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 11f842e..059926f 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -754,7 +754,7 @@ with parameters from the *Messages* buffer modification."
(should-length 2 (overlays-in 1 (point-max)))
(should-length 1 (overlays-in (point-max) (point-max)))
(narrow-to-region 1 50)
- (should-length 0 (overlays-in 1 (point-max)))
+ (should-length 1 (overlays-in 1 (point-max)))
(should-length 1 (overlays-in (point-max) (point-max))))))
@@ -1399,4 +1399,88 @@ with parameters from the *Messages* buffer modification."
(should (memq long-overlay (overlays-in 3 3)))
(should (memq zero-overlay (overlays-in 3 3))))))
+(ert-deftest test-remove-overlays ()
+ (with-temp-buffer
+ (insert "foo")
+ (make-overlay (point) (point))
+ (should (= (length (overlays-in (point-min) (point-max))) 1))
+ (remove-overlays)
+ (should (= (length (overlays-in (point-min) (point-max))) 0)))
+
+ (with-temp-buffer
+ (insert "foo")
+ (goto-char 2)
+ (make-overlay (point) (point))
+ ;; We only count zero-length overlays at the end of the buffer.
+ (should (= (length (overlays-in 1 2)) 0))
+ (narrow-to-region 1 2)
+ ;; We've now narrowed, so the zero-length overlay is at the end of
+ ;; the (accessible part of the) buffer.
+ (should (= (length (overlays-in 1 2)) 1))
+ (remove-overlays)
+ (should (= (length (overlays-in (point-min) (point-max))) 0))))
+
+(ert-deftest test-kill-buffer-auto-save-default ()
+ (let ((file (make-temp-file "ert"))
+ auto-save)
+ (should (file-exists-p file))
+ ;; Always answer yes.
+ (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
+ (unwind-protect
+ (progn
+ (find-file file)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save)
+ (should (file-exists-p auto-save))
+ (kill-buffer (current-buffer))
+ (should (file-exists-p auto-save)))
+ (ignore-errors (delete-file file))
+ (when auto-save
+ (ignore-errors (delete-file auto-save)))))))
+
+(ert-deftest test-kill-buffer-auto-save-delete ()
+ (let ((file (make-temp-file "ert"))
+ auto-save)
+ (should (file-exists-p file))
+ (setq kill-buffer-delete-auto-save-files t)
+ ;; Always answer yes.
+ (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
+ (unwind-protect
+ (progn
+ (find-file file)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save)
+ (should (file-exists-p auto-save))
+ ;; This should delete the auto-save file.
+ (kill-buffer (current-buffer))
+ (should-not (file-exists-p auto-save)))
+ (ignore-errors (delete-file file))
+ (when auto-save
+ (ignore-errors (delete-file auto-save)))))
+ ;; Answer no to deletion.
+ (cl-letf (((symbol-function #'yes-or-no-p)
+ (lambda (prompt)
+ (not (string-search "Delete auto-save file" prompt)))))
+ (unwind-protect
+ (progn
+ (find-file file)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save)
+ (should (file-exists-p auto-save))
+ ;; This should not delete the auto-save file.
+ (kill-buffer (current-buffer))
+ (should (file-exists-p auto-save)))
+ (ignore-errors (delete-file file))
+ (when auto-save
+ (ignore-errors (delete-file auto-save)))))))
+
;;; buffer-tests.el ends here
diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el
index 0309b2b..134f567 100644
--- a/test/src/coding-tests.el
+++ b/test/src/coding-tests.el
@@ -56,7 +56,7 @@
(set-buffer-multibyte nil)
(insert (encode-coding-string "あ" 'euc-jp) "\xd" "\n")
(decode-coding-region (point-min) (point-max) 'euc-jp-dos)
- (should-not (string-match-p "\^M" (buffer-string)))))
+ (should-not (string-search "\^M" (buffer-string)))))
;; Return the contents (specified by CONTENT-TYPE; ascii, latin, or
;; binary) of a test file.
diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el
index b989c97..f4d123b 100644
--- a/test/src/fileio-tests.el
+++ b/test/src/fileio-tests.el
@@ -160,4 +160,26 @@ Also check that an encoding error can appear in a symlink."
(should-error (file-exists-p "/foo\0bar")
:type 'wrong-type-argument))
+(ert-deftest fileio-tests/file-name-concat ()
+ (should (equal (file-name-concat "foo" "bar") "foo/bar"))
+ (should (equal (file-name-concat "foo" "bar") "foo/bar"))
+ (should (equal (file-name-concat "foo" "bar" "zot") "foo/bar/zot"))
+ (should (equal (file-name-concat "foo/" "bar") "foo/bar"))
+ (should (equal (file-name-concat "foo//" "bar") "foo//bar"))
+ (should (equal (file-name-concat "foo/" "bar/" "zot") "foo/bar/zot"))
+ (should (equal (file-name-concat "fóo" "bar") "fóo/bar"))
+ (should (equal (file-name-concat "foo" "bár") "foo/bár"))
+ (should (equal (file-name-concat "fóo" "bár") "fóo/bár"))
+ (let ((string (make-string 5 ?a)))
+ (should (not (multibyte-string-p string)))
+ (aset string 2 255)
+ (should (not (multibyte-string-p string)))
+ (should (equal (file-name-concat "fóo" string) "fóo/aa\377aa")))
+ (should (equal (file-name-concat "foo") "foo"))
+ (should (equal (file-name-concat "foo/") "foo/"))
+ (should (equal (file-name-concat "foo" "") "foo"))
+ (should (equal (file-name-concat "foo" "" "" "" nil) "foo"))
+ (should (equal (file-name-concat "" "bar") "bar"))
+ (should (equal (file-name-concat "" "") "")))
+
;;; fileio-tests.el ends here
diff --git a/test/src/font-tests.el b/test/src/font-tests.el
index de153b8..ea57b12 100644
--- a/test/src/font-tests.el
+++ b/test/src/font-tests.el
@@ -159,6 +159,31 @@ expected font properties from parsing NAME.")
(insert "\n"))))
(goto-char (point-min)))
+(ert-deftest font-parse-xlfd-test ()
+ ;; Normal number of segments.
+ (should (equal (font-get
+ (font-spec :name "-GNU
-FreeSans-semibold-italic-normal-*-*-*-*-*-*-0-iso10646-1")
+ :family)
+ 'FreeSans))
+ (should (equal (font-get
+ (font-spec :name "-GNU
-FreeSans-semibold-italic-normal-*-*-*-*-*-*-0-iso10646-1")
+ :foundry)
+ 'GNU\ ))
+ ;; Dash in the family name.
+ (should (equal (font-get
+ (font-spec :name
"-Take-mikachan-PS-normal-normal-normal-*-*-*-*-*-*-0-iso10646-1")
+ :family)
+ 'mikachan-PS))
+ (should (equal (font-get
+ (font-spec :name
"-Take-mikachan-PS-normal-normal-normal-*-*-*-*-*-*-0-iso10646-1")
+ :weight)
+ 'normal))
+ ;; Synthetic test.
+ (should (equal (font-get
+ (font-spec :name
"-foundry-name-with-lots-of-dashes-normal-normal-normal-*-*-*-*-*-*-0-iso10646-1")
+ :family)
+ 'name-with-lots-of-dashes)))
+
;; Local Variables:
;; no-byte-compile: t
;; End:
diff --git a/test/src/json-tests.el b/test/src/json-tests.el
index 908945f..8dc0a74 100644
--- a/test/src/json-tests.el
+++ b/test/src/json-tests.el
@@ -252,7 +252,7 @@ Test with both unibyte and multibyte strings."
(let* ((input
"{ \"abc\" : [9, false] , \"def\" : null }")
(output
- (replace-regexp-in-string " " "" input)))
+ (string-replace " " "" input)))
(should (equal (json-parse-string input
:object-type 'plist
:null-object :json-null
diff --git a/test/lisp/gnus/nnrss-tests.el b/test/src/search-tests.el
similarity index 50%
copy from test/lisp/gnus/nnrss-tests.el
copy to test/src/search-tests.el
index 9821ec7..b7b4ab9 100644
--- a/test/lisp/gnus/nnrss-tests.el
+++ b/test/src/search-tests.el
@@ -1,6 +1,6 @@
-;;; nnrss-tests.el --- tests for gnus/nnrss.el -*- lexical-binding:t -*-
+;;; search-tests.el --- tests for search.c functions -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2016, 2018-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -20,10 +20,23 @@
;;; Code:
(require 'ert)
-(require 'nnrss)
-(ert-deftest test-nnrss-normalize ()
- (should (equal (nnrss-normalize-date "2004-09-17T05:09:49.001+00:00")
- "Fri, 17 Sep 2004 05:09:49 +0000")))
-
-;;; nnrss-tests.el ends here
+(ert-deftest test-replace-match-modification-hooks ()
+ (let ((ov-set nil))
+ (with-temp-buffer
+ (insert "1 abc")
+ (setq ov-set (make-overlay 3 5))
+ (overlay-put
+ ov-set 'modification-hooks
+ (list (lambda (o after &rest _args)
+ (when after
+ (let ((inhibit-modification-hooks t))
+ (save-excursion
+ (goto-char 2)
+ (insert "234")))))))
+ (goto-char 3)
+ (if (search-forward "bc")
+ (replace-match "bcd"))
+ (should (= (point) 10)))))
+
+;;; search-tests.el ends here
diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el
index e4e3054..bd89283 100644
--- a/test/src/syntax-tests.el
+++ b/test/src/syntax-tests.el
@@ -500,4 +500,10 @@ the `parse-partial-sexp's are expected to stop. See
(syntax-pps-comments /* 56 76 77 58)
(syntax-pps-comments /* 60 78 79)
+(ert-deftest test-from-to-parse-partial-sexp ()
+ (with-temp-buffer
+ (insert "foo")
+ (should (parse-partial-sexp 1 1))
+ (should-error (parse-partial-sexp 2 1))))
+
;;; syntax-tests.el ends here
- feature/rcirc-update updated (a66fd7b -> 2e24b66), Philip Kaludercic, 2021/09/11
- feature/rcirc-update 7a89e0f 2/7: Rename rcirc-omit-after-reconnect to rcirc-omit-after-connect, Philip Kaludercic, 2021/09/11
- feature/rcirc-update 550011c 3/7: * rcirc.texi: Document rcirc-omit-responses-after-join, Philip Kaludercic, 2021/09/11
- feature/rcirc-update 2e24b66 7/7: * rcirc.texi: Replace defun-rcirc-command with rcirc-define-command, Philip Kaludercic, 2021/09/11
- feature/rcirc-update 0d08745 4/7: * rcirc.texi: Document rcirc-track-ignore-server-buffer-flag, Philip Kaludercic, 2021/09/11
- feature/rcirc-update 88b6237 5/7: * rcirc.texi: Document rcirc-nick-filter and rcirc-channel-filter, Philip Kaludercic, 2021/09/11
- feature/rcirc-update 6d31d5b 1/7: Merge branch 'master' into feature/rcirc-update,
Philip Kaludercic <=
- feature/rcirc-update 251a9f5 6/7: * rcirc.texi: Document rcirc-track-abbrevate-flag, Philip Kaludercic, 2021/09/11