[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/etags-regen 8cb5af4 3/4: Merge branch 'master' into scratch/etag
|
From: |
Dmitry Gutov |
|
Subject: |
scratch/etags-regen 8cb5af4 3/4: Merge branch 'master' into scratch/etags-regen |
|
Date: |
Mon, 6 Sep 2021 11:17:37 -0400 (EDT) |
branch: scratch/etags-regen
commit 8cb5af412e4757de05b0ce95410630f9b71f677e
Merge: 87ab046 9e2cc40
Author: Dmitry Gutov <dgutov@yandex.ru>
Commit: Dmitry Gutov <dgutov@yandex.ru>
Merge branch 'master' into scratch/etags-regen
---
admin/authors.el | 6 +-
configure.ac | 2 +-
doc/emacs/dired.texi | 5 +
doc/emacs/files.texi | 13 +-
doc/emacs/misc.texi | 9 +
doc/lispref/commands.texi | 3 +
doc/lispref/control.texi | 4 +
doc/lispref/display.texi | 3 +-
doc/lispref/elisp.texi | 1 +
doc/lispref/modes.texi | 13 +-
doc/lispref/searching.texi | 36 +-
doc/lispref/sequences.texi | 17 +
doc/misc/gnus.texi | 19 +
doc/misc/tramp.texi | 50 +-
etc/NEWS | 129 +-
etc/emacs.desktop | 1 -
etc/emacsclient-mail.desktop | 5 +-
etc/emacsclient.desktop | 4 +-
etc/themes/wombat-theme.el | 2 +-
lisp/apropos.el | 8 +-
lisp/arc-mode.el | 4 +-
lisp/autoinsert.el | 4 +-
lisp/bindings.el | 2 +-
lisp/calc/calc-aent.el | 4 +-
lisp/calc/calc-ext.el | 6 +-
lisp/calc/calc-forms.el | 2 +-
lisp/calc/calc-graph.el | 2 +-
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 | 6 +-
lisp/calc/calcalg2.el | 6 +-
lisp/calc/calcalg3.el | 6 +-
lisp/calendar/cal-html.el | 2 +-
lisp/calendar/cal-tex.el | 20 +-
lisp/calendar/icalendar.el | 18 +-
lisp/calendar/iso8601.el | 6 +-
lisp/calendar/time-date.el | 2 +-
lisp/calendar/todo-mode.el | 2 +-
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 | 2 +-
lisp/cus-edit.el | 2 +-
lisp/cus-theme.el | 2 +-
lisp/descr-text.el | 2 +-
lisp/dired-aux.el | 8 +-
lisp/dired-x.el | 8 +-
lisp/dired.el | 20 +-
lisp/dos-fns.el | 12 +-
lisp/edmacro.el | 2 +-
lisp/emacs-lisp/cl-generic.el | 29 +-
lisp/emacs-lisp/cl-macs.el | 6 +-
lisp/emacs-lisp/comp.el | 2 +-
lisp/emacs-lisp/debug.el | 6 +-
lisp/emacs-lisp/easy-mmode.el | 6 +-
lisp/emacs-lisp/easymenu.el | 14 +-
lisp/emacs-lisp/eieio-opt.el | 4 +-
lisp/emacs-lisp/eieio-speedbar.el | 4 +-
lisp/emacs-lisp/lisp-mnt.el | 25 +-
lisp/emacs-lisp/map.el | 60 +-
lisp/emacs-lisp/memory-report.el | 5 +-
lisp/emacs-lisp/package.el | 15 +-
lisp/emacs-lisp/pcase.el | 40 +
lisp/emacs-lisp/re-builder.el | 2 +-
lisp/emacs-lisp/seq.el | 8 +
lisp/emacs-lisp/shortdoc.el | 17 +-
lisp/emacs-lisp/smie.el | 4 +-
lisp/emacs-lisp/subr-x.el | 1 +
lisp/emacs-lisp/warnings.el | 2 +-
lisp/emulation/viper-ex.el | 6 +-
lisp/env.el | 4 +-
lisp/epa-mail.el | 2 +-
lisp/epg.el | 2 +-
lisp/erc/erc-backend.el | 10 +-
lisp/erc/erc-dcc.el | 6 +-
lisp/erc/erc-speedbar.el | 12 +-
lisp/erc/erc.el | 10 +-
lisp/eshell/em-glob.el | 2 +-
lisp/eshell/esh-proc.el | 2 +-
lisp/eshell/esh-util.el | 2 +-
lisp/eshell/esh-var.el | 2 +-
lisp/faces.el | 2 +-
lisp/ffap.el | 9 +-
lisp/files.el | 71 +-
lisp/font-lock.el | 14 +-
lisp/format.el | 6 +
lisp/forms.el | 2 +-
lisp/frameset.el | 2 +-
lisp/fringe.el | 2 +-
lisp/gnus/gnus-art.el | 4 +-
lisp/gnus/gnus-group.el | 2 +-
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 | 14 +-
lisp/gnus/gnus-spec.el | 2 +-
lisp/gnus/gnus-start.el | 2 +-
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 | 8 +-
lisp/gnus/message.el | 34 +-
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 | 4 +-
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 | 2 +-
lisp/help-mode.el | 2 +-
lisp/help.el | 2 +-
lisp/hippie-exp.el | 4 +-
lisp/htmlfontify.el | 2 +-
lisp/ibuffer.el | 2 +-
lisp/icomplete.el | 26 +-
lisp/ido.el | 10 +-
lisp/image-dired.el | 270 ++--
lisp/image/image-converter.el | 2 +-
lisp/info-look.el | 11 +
lisp/info-xref.el | 2 +-
lisp/info.el | 16 +-
lisp/international/mule-cmds.el | 2 +-
lisp/international/mule-diag.el | 4 +-
lisp/international/mule-util.el | 25 +-
lisp/language/korea-util.el | 2 +-
lisp/linum.el | 2 +-
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/rfc2368.el | 2 +-
lisp/mail/rmail.el | 4 +-
lisp/mail/rmailkwd.el | 2 +-
lisp/mail/rmailout.el | 4 +-
lisp/mail/rmailsum.el | 2 +-
lisp/mail/smtpmail.el | 4 +-
lisp/mail/uce.el | 8 +-
lisp/mail/undigest.el | 2 +-
lisp/man.el | 4 +-
lisp/mh-e/mh-alias.el | 6 +-
lisp/mh-e/mh-comp.el | 4 +-
lisp/mh-e/mh-speed.el | 2 +-
lisp/mh-e/mh-utils.el | 4 +-
lisp/minibuffer.el | 72 +-
lisp/mouse.el | 2 +-
lisp/mpc.el | 10 +-
lisp/net/ange-ftp.el | 6 +-
lisp/net/browse-url.el | 2 +-
lisp/net/eww.el | 2 +-
lisp/net/mailcap.el | 2 +-
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 | 9 +-
lisp/net/tramp-cache.el | 6 +-
lisp/net/tramp-cmds.el | 2 +-
lisp/net/tramp-compat.el | 12 +-
lisp/net/tramp-gvfs.el | 2 +-
lisp/net/tramp-sh.el | 60 +-
lisp/net/tramp-smb.el | 26 +-
lisp/net/tramp.el | 59 +-
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/obsolete/terminal.el | 2 +-
lisp/obsolete/tpu-edt.el | 6 +-
lisp/obsolete/url-ns.el | 2 +-
lisp/pcmpl-unix.el | 2 +-
lisp/play/dunnet.el | 20 +-
lisp/play/handwrite.el | 2 +-
lisp/proced.el | 2 +-
lisp/profiler.el | 2 +-
lisp/progmodes/cc-defs.el | 53 +-
lisp/progmodes/cc-engine.el | 1363 +++++++++++++-------
lisp/progmodes/cc-fonts.el | 136 +-
lisp/progmodes/cc-langs.el | 195 ++-
lisp/progmodes/cc-mode.el | 70 +-
lisp/progmodes/ebnf2ps.el | 2 +-
lisp/progmodes/gdb-mi.el | 10 +-
lisp/progmodes/grep.el | 11 +-
lisp/progmodes/gud.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/project.el | 2 +-
lisp/progmodes/prolog.el | 2 +-
lisp/progmodes/python.el | 3 +-
lisp/progmodes/ruby-mode.el | 8 +-
lisp/progmodes/sh-script.el | 3 +-
lisp/progmodes/sql.el | 6 +-
lisp/progmodes/which-func.el | 2 +-
lisp/progmodes/xscheme.el | 4 +-
lisp/replace.el | 61 +-
lisp/select.el | 2 +-
lisp/ses.el | 2 +-
lisp/shell.el | 4 +-
lisp/simple.el | 49 +-
lisp/speedbar.el | 12 +-
lisp/startup.el | 6 +-
lisp/subr.el | 65 +-
lisp/tab-bar.el | 16 +-
lisp/tar-mode.el | 2 +-
lisp/term.el | 6 +-
lisp/term/linux.el | 3 +
lisp/term/pc-win.el | 2 +-
lisp/term/w32-win.el | 2 +-
lisp/term/xterm.el | 12 +-
lisp/textmodes/bibtex.el | 2 +-
lisp/textmodes/ispell.el | 10 +-
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 | 20 +-
lisp/thingatpt.el | 2 +-
lisp/thumbs.el | 6 +-
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/vc/diff-mode.el | 31 +-
lisp/vc/log-edit.el | 4 +-
lisp/vc/vc-bzr.el | 2 +-
lisp/vc/vc-cvs.el | 2 +-
lisp/vc/vc-git.el | 65 +-
lisp/vc/vc-hg.el | 4 +-
lisp/vc/vc-svn.el | 2 +-
lisp/vc/vc.el | 12 +-
lisp/wid-browse.el | 2 +-
lisp/woman.el | 10 +-
lisp/xdg.el | 4 +-
lisp/xml.el | 4 +-
src/alloc.c | 4 +-
src/buffer.c | 5 +-
src/font.c | 42 +-
src/fringe.c | 10 +
src/keyboard.c | 6 +-
src/nsterm.m | 1 -
src/w32.c | 9 +-
src/xdisp.c | 17 +-
test/Makefile.in | 2 +-
test/lisp/autorevert-tests.el | 2 +-
test/lisp/dom-tests.el | 8 +
test/lisp/electric-tests.el | 2 +-
test/lisp/emacs-lisp/check-declare-tests.el | 10 +-
test/lisp/emacs-lisp/cl-generic-tests.el | 5 +-
test/lisp/emacs-lisp/lisp-mnt-tests.el | 36 +
test/lisp/emacs-lisp/map-tests.el | 24 +-
test/lisp/emacs-lisp/memory-report-tests.el | 16 +
test/lisp/emacs-lisp/pcase-tests.el | 47 +
test/lisp/emacs-lisp/seq-tests.el | 24 +
test/lisp/files-tests.el | 35 +-
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/mail/mail-parse-tests.el | 54 +
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/tramp-tests.el | 40 +-
test/lisp/progmodes/ruby-mode-tests.el | 22 +
test/lisp/subr-tests.el | 46 +
test/lisp/term-tests.el | 2 +-
test/lisp/time-stamp-tests.el | 2 +-
test/lisp/vc/diff-mode-tests.el | 12 +
test/lisp/wdired-tests.el | 4 +-
test/src/buffer-tests.el | 23 +-
test/src/coding-tests.el | 2 +-
test/src/font-tests.el | 25 +
test/src/json-tests.el | 2 +-
301 files changed, 3520 insertions(+), 1718 deletions(-)
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/configure.ac b/configure.ac
index be97d9c..eff5591 100644
--- a/configure.ac
+++ b/configure.ac
@@ -4909,7 +4909,7 @@ emacs_broken_SIGIO=no
case $opsys in
dnl SIGIO exists, but the feature doesn't work in the way Emacs needs.
- hpux* | nacl | openbsd | solaris | unixware )
+ hpux* | nacl | solaris | unixware )
emacs_broken_SIGIO=yes
;;
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 3fbaf8b..680b20c 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -1553,6 +1553,11 @@ image. You comment a file from the thumbnail buffer by
typing
@kbd{c}. You will be prompted for a comment. Type @kbd{C-t c} to add
a comment from Dired (@code{image-dired-dired-comment-files}).
+@vindex image-dired-thumb-visible-marks
+ Files that are marked in Dired will also be marked in Image-Dired if
+@code{image-dired-thumb-visible-marks} is non-@code{nil} (which is the
+default).
+
Image-Dired also provides simple image manipulation. In the
thumbnail buffer, type @kbd{L} to rotate the original image 90 degrees
anti clockwise, and @kbd{R} to rotate it 90 degrees clockwise. This
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 7edf4d2..8304e40 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -948,7 +948,7 @@ Manual}). For customizations, see the Custom group
@code{time-stamp}.
then change your mind, you can @dfn{revert} the changes and go back to
the saved version of the file. To do this, type @kbd{C-x x g}. Since
reverting unintentionally could lose a lot of work, Emacs asks for
-confirmation first.
+confirmation first if the buffer is modified.
The @code{revert-buffer} command tries to position point in such a
way that, if the file was edited only slightly, you will be at
@@ -991,6 +991,17 @@ revert it automatically if it has changed---provided the
buffer itself
is not modified. (If you have edited the text, it would be wrong to
discard your changes.)
+@vindex revert-buffer-quick-short-answers
+@findex revert-buffer-quick
+ The @kbd{C-x x g} keystroke is bound to the
+@code{revert-buffer-quick} command. This is like the
+@code{revert-buffer} command, but prompts less. Unlike
+@code{revert-buffer}, it will not prompt if the current buffer visits
+a file, and the buffer is not modified. It also respects the
+@code{revert-buffer-quick-short-answers} user option. If this option
+is non-@code{nil}, use a shorter @kbd{y/n} query instead of a longer
+@kbd{yes/no} query.
+
You can also tell Emacs to revert buffers automatically when their
visited files change on disk; @pxref{Auto Revert}.
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 8bf1032..528cfa9 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -2973,6 +2973,15 @@ URLs.
For more information, view the package commentary by typing @kbd{C-h P
browse-url @key{RET}}.
+@findex url-handler-mode
+ Emacs also has a minor mode that has some support for handling
+@acronym{URL}s as if they were files. @code{url-handler-mode} is a
+global minor mode that affects most of the Emacs commands and
+primitives that deal with file names. After switching on this mode,
+you can say, for instance, @kbd{C-x C-f https://www.gnu.org/ RET} to
+see the @acronym{HTML} for that web page, and you can then edit it and
+save it to a local file, for instance.
+
@node Goto Address mode
@subsection Activating URLs
@findex goto-address-mode
diff --git a/doc/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 5026d0a..aacf66c 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -1312,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..79fb72a 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -1917,7 +1917,8 @@ This function returns a list of the overlays that overlap
the region
contains one or more characters in the region; empty overlays
(@pxref{Managing Overlays, empty overlay}) overlap if they are at
@var{beg}, strictly between @var{beg} and @var{end}, or at @var{end}
-when @var{end} denotes the position at the end of the buffer.
+when @var{end} denotes the position at the end of the accessible part
+of the buffer.
@end defun
@defun next-overlay-change pos
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/modes.texi b/doc/lispref/modes.texi
index d48c9cc..d9caeab 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -1728,7 +1728,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
@@ -3444,9 +3445,17 @@ for string constants.
@item font-lock-doc-face
@vindex font-lock-doc-face
-for documentation strings in the code. This inherits, by default, from
+for documentation embedded in program code inside specially-formed
+comments or strings. This face inherits, by default, from
@code{font-lock-string-face}.
+@item font-lock-doc-markup-face
+@vindex font-lock-doc-markup-face
+for mark-up elements in text using @code{font-lock-doc-face}.
+It is typically used for the mark-up constructs in documentation embedded
+in program code, following conventions such as Haddock, Javadoc or Doxygen.
+This face inherits, by default, from @code{font-lock-constant-face}.
+
@item font-lock-negation-char-face
@vindex font-lock-negation-char-face
for easily-overlooked negation characters.
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 1d3e2d9..4d5ae3c 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -2540,9 +2540,9 @@ associated with it still exists.
@cindex replacement after search
@cindex searching and replacing
- If you want to find all matches for a regexp in part of the buffer,
-and replace them, the best way is to write an explicit loop using
-@code{re-search-forward} and @code{replace-match}, like this:
+ If you want to find all matches for a regexp in part of the buffer
+and replace them, the most flexible way is to write an explicit loop
+using @code{re-search-forward} and @code{replace-match}, like this:
@example
(while (re-search-forward "foo[ \t]+bar" nil t)
@@ -2553,9 +2553,33 @@ and replace them, the best way is to write an explicit
loop using
@xref{Replacing Match,, Replacing the Text that Matched}, for a
description of @code{replace-match}.
- However, replacing matches in a string is more complex, especially
-if you want to do it efficiently. So Emacs provides two functions to do
-this.
+ It may be more convenient to limit the replacements to a specific
+region. The function @code{replace-regexp-in-region} does that.
+
+@defun replace-regexp-in-region regexp replacement &optional start end
+This function replaces all the occurrences of @var{regexp} with
+@var{replacement} in the region of buffer text between @var{start} and
+@var{end}; @var{start} defaults to position of point, and @var{end}
+defaults to the last accessible position of the buffer. The search
+for @var{regexp} is case-sensitive, and @var{replacement} is inserted
+without changing its letter-case. The @var{replacement} string can
+use the same special elements starting with @samp{\} as
+@code{replace-match} does. The function returns the number of
+replaced occurrences, or @code{nil} if @var{regexp} is not found. The
+function preserves the position of point.
+
+@example
+(replace-regexp-in-region "foo[ \t]+bar" "foobar")
+@end example
+@end defun
+
+@defun replace-string-in-region string replacement &optional start end
+ This function works similarly to @code{replace-regexp-in-region},
+but searches for, and replaces, literal @var{string}s instead of
+regular expressions.
+@end defun
+
+ Emacs also has special functions for replacing matches in a string.
@defun replace-regexp-in-string regexp rep string &optional fixedcase literal
subexp start
This function copies @var{string} and searches it for matches for
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 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/misc/gnus.texi b/doc/misc/gnus.texi
index 17da507..5f3fba0 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -4145,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
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 5672648..bd9bd99 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,32 @@ To open @command{powershell} as a remote shell, use this:
@end lisp
+@subsection Remote process connection type
+@vindex process-connection-type
+@cindex tramp-process-connection-type
+
+Asynchronous processes differ in the way, whether they use a pseudo
+tty, or not. This is controlled by the variable
+@code{process-connection-type}, which can be @code{t} or @code{pty}
+(use a pseudo tty), or @code{nil} or @code{pipe} (don't use it).
+@value{tramp} is based on running shells on the remote host, which
+require a pseudo tty. Therefore, it declares the variable
+@code{tramp-process-connection-type}, which carries this information
+for remote processes. Per default, its value is @code{t}. The name
+of the remote pseudo tty is returned by the function
+@code{process-tty-name}.
+
+If a remote process, started by @code{start-file-process}, shouldn't
+use a pseudo tty, this is emulated by let-binding this variable to
+@code{nil} or @code{pipe}. There is still a pseudo tty for the
+started process, but some terminal properties are changed, like
+suppressing translation of carriage return characters into newline.
+
+The function @code{make-process} allows an explicit setting by the
+@code{:connection-type} keyword. If this keyword is not used, the
+value of @code{tramp-process-connection-type} is applied instead.
+
+
@anchor{Improving performance of asynchronous remote processes}
@subsection Improving performance of asynchronous remote processes
@cindex Asynchronous remote processes
@@ -4578,6 +4604,16 @@ supported on your proxy host.
@item
+Does @value{tramp} support @acronym{SSH} security keys?
+
+Yes. @command{OpenSSH} has added support for @acronym{FIDO} hardware
+devices via special key types @option{*-sk}. @value{tramp} supports
+the additional handshaking messages for them. This requires at least
+@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} compatible
+security key, like yubikey, solokey, or nitrokey.
+
+
+@item
@value{tramp} does not connect to Samba or MS Windows hosts running
SMB1 connection protocol
diff --git a/etc/NEWS b/etc/NEWS
index 674152c..aaff30b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -149,6 +149,15 @@ invoked with the '--declarations' command-line option.
** New command 'font-lock-update', bound to 'C-x x f'.
This command updates the syntax highlighting in this buffer.
++++
+** A new standard face 'font-lock-doc-markup-face'.
+Intended for documentation mark-up syntax and tags inside text that
+uses 'font-lock-doc-face', with which it should harmonise. It would
+typically be used in structured documentation comments in program
+source code by language-specific modes, for mark-up conventions like
+Haddock, Javadoc or Doxygen. By default this face inherits from
+'font-lock-constant-face'.
+
** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA.
+++
@@ -255,6 +264,12 @@ This works in text buffers and over images. Typing a
numeric prefix arg
The value is saved in the user option 'mouse-wheel-scroll-amount-horizontal'.
---
+** New choice 'permanent' for 'shift-select-mode'.
+When the mark was activated by shifted motion keys,
+non-shifted motion keys don't deactivate the mark
+after customizing 'shift-select-mode' to 'permanent'.
+
+---
** The default value of 'frame-title-format' and 'icon-title-format' has
changed.
These variables are used to display the title bar of visible frames
and the title bar of an iconified frame. They now show the name of
@@ -310,7 +325,7 @@ search buffer due to too many matches being highlighted.
+++
** A new keymap for buffer actions has been added.
The 'C-x x' keymap now holds keystrokes for various buffer-oriented
-commands. The new keystrokes are 'C-x x g' ('revert-buffer'),
+commands. The new keystrokes are 'C-x x g' ('revert-buffer-quick'),
'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), 'C-x x n'
('clone-buffer'), 'C-x x i' ('insert-buffer'), 'C-x x t'
('toggle-truncate-lines') and 'C-x x f' ('font-lock-update').
@@ -354,6 +369,11 @@ by dragging the tab lines of their topmost windows with
the mouse.
* Editing Changes in Emacs 28.1
+** New value 'save-some-buffers-root' of 'save-some-buffers-default-predicate'.
+It allows to ask about saving only files under the project root
+or in subdirectories of the directory that was default during
+command invocation.
+
---
** Dragging a file to Emacs will now also push the name of the file
onto 'file-name-history'.
@@ -559,6 +579,10 @@ The new 'cl-type' pattern compares types using 'cl-typep',
which allows
comparing simple types like '(cl-type integer)', as well as forms like
'(cl-type (integer 0 10))'.
+*** New macro 'pcase-setq'
+This macro is the 'setq' equivalent of 'pcase-let', which allows for
+destructuring patterns in a 'setq' form.
+
+++
** profiler.el
The results displayed by 'profiler-report' now have the usage figures
@@ -631,13 +655,14 @@ This allows controlling the current/total number of
matches for the
prompt prefix.
+++
-*** 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 minor modes 'icomplete-vertical-mode' and 'fido-vertical-mode'
+These modes are modify Icomplete ('M-x icomplete-mode') and Fido ('M-x
+fido-mode'), to display completions candidates vertically instead of
+horizontally. In Icomplete, completions are rotated and selection
+kept at the top. In Fido, completions scroll like a typical dropdown
+widget. Both these new minor modes will first turn on their
+respective non-vertical counterparts first, if they are not on
+already.
---
*** Default value of 'icomplete-compute-delay' has been changed to 0.15 s.
@@ -798,7 +823,7 @@ The method of highlighting is specified by the user options
'next-error-highlight' and 'next-error-highlight-no-select'.
---
-*** A fringe arrow in the '*Occur*' buffer indicates the selected match.
+*** A fringe arrow in the "*Occur*" buffer indicates the selected match.
---
*** Occur mode may use a different type for 'occur-target' property values.
@@ -818,7 +843,7 @@ It is now defined as a generalized variable that can be
used with
---
*** 'form' in '(eql form)' specializers in 'cl-defmethod' is now evaluated.
-This corresponds to the behaviour of defmethod in Common Lisp Object System.
+This corresponds to the behavior of defmethod in Common Lisp Object System.
For compatibility, '(eql SYMBOL)' does not evaluate SYMBOL, for now.
** New minor mode 'cl-font-lock-built-in-mode' for 'lisp-mode'.
@@ -943,12 +968,6 @@ keys, add the following to your init file:
** 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
@@ -1003,6 +1022,10 @@ String or list of strings specifying switches for Git
log under VC.
** Gnus
+++
+*** New user option 'gnus-topic-display-predicate'.
+This can be used to inhibit the display of some topics completely.
+
++++
*** nnimap now supports the oauth2.el library.
+++
@@ -1551,8 +1574,10 @@ like cell phones, tablets or cameras.
*** New connection method "sshfs", which allows accessing remote files
via a file system mounted with 'sshfs'.
----
-*** Tramp supports authentication via yubikey now.
++++
+*** 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.
@@ -1612,6 +1637,14 @@ This is a slightly deeper copy than the previous
'copy-sequence'.
---
*** The function 'map-contains-key' now supports plists.
+---
+*** More consistent duplicate key handling in 'map-merge-with'.
+Until now, 'map-merge-with' promised to call its function argument
+whenever multiple maps contained 'eql' keys. However, this did not
+always coincide with the keys that were actually merged, which could
+be 'equal' instead. The function argument is now called whenever keys
+are merged, for greater consistency with 'map-merge' and 'map-elt'.
+
** Package
---
@@ -1981,7 +2014,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.
+++
@@ -2325,6 +2358,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'.
@@ -2390,8 +2428,51 @@ When non-nil, this option suppresses lock files for
remote files.
This command, called interactively, toggles the local value of
'create-lockfiles' in the current buffer.
+** image-dired
+
+---
+*** 'image-dired-mouse-toggle-mark' now toggles files in the active region.
+
++++
+*** New user option 'image-dired-thumb-visible-marks'.
+If non-nil (the default), use 'image-dired-thumb-mark' to say what
+images are marked.
+
+*** New command 'image-dired-tag-marked-thumbnails'.
+
+*** New command 'image-dired-delete-marked'.
+
** Miscellaneous
++++
+*** New function 'replace-regexp-in-region'.
+
++++
+*** New function 'replace-string-in-region'.
+
+---
+*** New function 'mail-header-parse-addresses-lax'.
+This takes a comma-separated string and returns a list of mail/name
+pairs.
+
+---
+*** New function 'mail-header-parse-address-lax'.
+Parse a string as a mail address-like string.
+
+---
+*** 'shell-script-mode' now supports 'outline-minor-mode'.
+The outline headings have lines that start with "###".
+
++++
+*** New command 'revert-buffer-quick'.
+This is bound to 'C-x x g' and is like `revert-buffer', but prompts
+less.
+
++++
+*** New user option 'revert-buffer-quick-short-answers'. This
+controls how the new 'revert-buffer-quick' (`C-x x g') command
+prompts.
+
---
*** fileloop will now skip missing files instead of signalling an error.
@@ -2981,7 +3062,7 @@ command, which updates the syntax highlighting in the
current buffer.
** In 'f90-mode', the backslash character ('\') no longer escapes.
For about a decade, the backslash character has no longer had a
-special escape syntax in Fortran F90. To get the old behaviour back,
+special escape syntax in Fortran F90. To get the old behavior back,
say something like:
(modify-syntax-entry ?\\ "\\" f90-mode-syntax-table)
@@ -3000,6 +3081,14 @@ This is to keep the same behavior as Eshell.
* Incompatible Lisp Changes in Emacs 28.1
++++
+** 'overlays-in' now handles zero-length overlays slightly differently.
+Previosly, zero-length overlays at the end of the buffer were included
+in the result (if the region queried for stopped at that position).
+The same was not the case if the buffer had been narrowed to exclude
+the real end of the buffer. This has now been changed, and
+zero-length overlays at `point-max' are always included in the results.
+
---
** 'replace-match' now runs modification hooks slightly later.
The function is documented to leave point after the replacement text,
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/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/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 8e5799f..0345944 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1469,7 +1469,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/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..9ac24bf 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -1025,7 +1025,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(calc-pop-stack 1))))
(if (string-match "\\[.+\\]" range)
(setq range (substring range 1 -1)))
- (if (and (not (string-match ":" range))
+ (if (and (not (string-search ":" range))
(or (string-match "," range)
(string-match " " range)))
(aset range (match-beginning 0) ?\:))
diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el
index 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..a10b317 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -2126,7 +2126,7 @@ the United States."
(goto-char (point-max))
(cond ((null prefix) (insert " "))
((and (> (length prefix) 4)
- (string-match " " prefix 4))
+ (string-search " " prefix 4))
(insert (substring prefix 0 4) " "))
(t (insert (format "%4s " prefix))))
(insert fval "\n")
@@ -2469,7 +2469,7 @@ the United States."
(calc-minibuffer-contains
"[-+]?\\(.*\\+/- *\\|.*mod *\\)?\\([0-9]+\\.?0*[@oh]
*\\)?\\([0-9]+\\.?0*['m]
*\\)?[0-9]*\\(\\.?[0-9]*\\(e[-+]?[0-3]?[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?\\)?\\|[0-9]:\\([0-9]+:\\)?[0-9]*\\)?[\"s]?\\'"))
(if (and (memq last-command-event '(?@ ?o ?h ?\' ?m))
- (string-match " " calc-hms-format))
+ (string-search " " calc-hms-format))
(insert " "))
(if (and (memq last-command '(calcDigit-start calcDigit-key))
(eq last-command-event ?.))
@@ -3059,7 +3059,7 @@ the United States."
(defun calc-count-lines (s)
(let ((pos 0)
(num 1))
- (while (setq pos (string-match "\n" s pos))
+ (while (setq pos (string-search "\n" s pos))
(setq pos (1+ pos)
num (1+ num)))
num))
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/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-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/icalendar.el b/lisp/calendar/icalendar.el
index d18ec5e..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
@@ -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/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/todo-mode.el b/lisp/calendar/todo-mode.el
index 680beb8..371d106 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -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)))
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 40f58f2..7af8e8f 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -2439,7 +2439,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")
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-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/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..0b8c693 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)
@@ -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
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..ff82250 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1587,8 +1587,8 @@ see `dired-use-ls-dired' for more details.")
;; because newlines in dirnames are uncommon, and people may
;; have gotten used to seeing unescaped "\" in the headers.
;; Note: adjust dired-build-subdir-alist if you change this.
- (setq dir (replace-regexp-in-string "\\\\" "\\\\" dir nil t)
- dir (replace-regexp-in-string "\n" "\\n" dir nil t)))
+ (setq dir (string-replace "\\" "\\\\" dir)
+ dir (string-replace "\n" "\\n" dir)))
;; If we used --dired and it worked, the lines are already indented.
;; Otherwise, indent them.
(unless (save-excursion
@@ -2872,7 +2872,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 +2909,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 +2947,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 +3167,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 "-").
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..9e4a71c 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
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index db5a5a0..4a69df1 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1153,22 +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."
- (let ((form (cadr specializer)))
- (puthash (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)
- 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 caf8bba..4ef1948 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -3332,14 +3332,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 +3599,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'.
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index a04413b..ed75bf2 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -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)))
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 069c7a9..2007f79 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
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 8a2b3b4..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.
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/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/map.el b/lisp/emacs-lisp/map.el
index c593428..988a62a 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.
@@ -371,37 +371,51 @@ 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.")
diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el
index 1125dde..aee2a00 100644
--- a/lisp/emacs-lisp/memory-report.el
+++ b/lisp/emacs-lisp/memory-report.el
@@ -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,8 +238,6 @@ by counted more than once."
(* (memory-report--size 'object) (hash-table-size value)))))
(maphash
(lambda (key elem)
- (setf (gethash key counted) t)
- (setf (gethash elem counted) t)
(cl-incf total (memory-report--object-size counted key))
(cl-incf total (memory-report--object-size counted elem)))
value)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index dfd2148..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)
@@ -4152,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
@@ -4169,9 +4176,7 @@ activations need to be changed, such as when
`package-load-list' is modified."
;; Prefer uncompiled files (and don't accept .so files).
(let ((load-suffixes '(".el" ".elc")))
(locate-library (package--autoloads-file-name pkg))))
- (pfile (let ((print-length nil)
- (print-level nil))
- (prin1-to-string file))))
+ (pfile (prin1-to-string file)))
(insert "(let ((load-true-file-name " pfile ")\
(load-file-name " pfile "))\n")
(insert-file-contents file)
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/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/seq.el b/lisp/emacs-lisp/seq.el
index e8fc4a2..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
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index a74a5a4..7d4a69f 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -700,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"))
@@ -894,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"))
@@ -1317,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)
@@ -1332,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/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..9d62955 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -573,7 +573,7 @@ callback data (if any)."
"--status-fd" "1"
"--yes")
(if (and (not (eq (epg-context-protocol context) 'CMS))
- (string-match ":" (or agent-info "")))
+ (string-search ":" (or agent-info "")))
'("--use-agent"))
(if (and (not (eq (epg-context-protocol context) 'CMS))
(epg-context-progress-callback context))
diff --git a/lisp/erc/erc-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-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.el b/lisp/erc/erc.el
index 026c6f8..7320201 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -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-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-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..a3a6f1b 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -3062,7 +3062,7 @@ also the same size as FACE on FRAME, or fail."
(let ((fonts (x-list-fonts pattern face frame 1)))
(or fonts
(if face
- (if (string-match-p "\\*" pattern)
+ (if (string-search "*" pattern)
(if (null (face-font face))
(error "No matching fonts are the same height as the
frame default font")
(error "No matching fonts are the same height as face
`%s'" face))
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 9be9c29..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))
@@ -1532,10 +1532,7 @@ which may actually result in an URL rather than a
filename."
(cl-case operation
;; We mainly just want to disable these bits:
(substitute-in-file-name (car args))
- (expand-file-name
- (if (equal (car args) "http://<remove>")
- ""
- (car args)))
+ (expand-file-name (car args))
(otherwise
(apply operation args)))))
@@ -1546,7 +1543,7 @@ which may actually result in an URL rather than a
filename."
(progn
(push elem file-name-handler-alist)
(if (ffap-url-p guess)
- (read-file-name prompt "http://<remove>" nil nil guess)
+ (read-file-name prompt guess guess)
(unless guess
(setq guess default-directory))
(unless (ffap-file-remote-p guess)
diff --git a/lisp/files.el b/lisp/files.el
index b58f90d..875ac55 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -783,9 +783,6 @@ nil (meaning `default-directory') as the associated list
element."
(mapcar (lambda (f)
(if (equal "" f) nil
(let ((dir (file-name-as-directory f)))
- (when (file-name-absolute-p dir)
- ;; Expand "~".
- (setq dir (expand-file-name dir)))
;; Previous implementation used `substitute-in-file-name'
;; which collapse multiple "/" in front. Do the same for
;; backward compatibility.
@@ -3604,7 +3601,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)
@@ -5204,7 +5201,7 @@ The function `find-backup-file-name' also uses this."
(expand-file-name
(subst-char-in-string
?/ ?!
- (replace-regexp-in-string "!" "!!" file))
+ (string-replace "!" "!!" file))
backup-directory))
(expand-file-name (file-name-nondirectory file)
(file-name-as-directory abs-backup-directory))))))
@@ -5730,9 +5727,23 @@ be saved."
:group 'auto-save
;; FIXME nil should not be a valid option, let alone the default,
;; eg so that add-function can be used.
- :type '(choice (const :tag "Default" nil) function)
+ :type '(choice (const :tag "Default" nil)
+ (function :tag "Only in subdirs of root"
+ save-some-buffers-root)
+ (function :tag "Custom function"))
:version "26.1")
+(defun save-some-buffers-root ()
+ "A predicate to check whether the buffer is under the root directory.
+Can be used as a value of `save-some-buffers-default-predicate'
+to save buffers only under the project root or in subdirectories
+of the directory that was default during command invocation."
+ (let ((root (or (and (featurep 'project) (project-current)
+ (fboundp 'project-root)
+ (project-root (project-current)))
+ default-directory)))
+ (lambda () (file-in-directory-p default-directory root))))
+
(defun save-some-buffers (&optional arg pred)
"Save some modified file-visiting buffers. Asks user about each one.
You can answer `y' or SPC to save, `n' or DEL not to save, `C-r'
@@ -5761,6 +5772,11 @@ change the additional actions you can take on files."
(interactive "P")
(unless pred
(setq pred save-some-buffers-default-predicate))
+ ;; Allow `pred' to be a function that returns a predicate
+ ;; with lexical bindings in its original environment (bug#46374).
+ (let ((pred-fun (and (functionp pred) (funcall pred))))
+ (when (functionp pred-fun)
+ (setq pred pred-fun)))
(let* ((switched-buffer nil)
(save-some-buffers--switch-window-callback
(lambda (buffer)
@@ -6564,6 +6580,38 @@ details on the arguments, see `revert-buffer'."
(revert-buffer-with-fine-grain-success-p)
(fmakunbound 'revert-buffer-with-fine-grain-success-p)))))
+(defcustom revert-buffer-quick-short-answers nil
+ "How much confirmation to be done by the `revert-buffer-quick' command.
+If non-nil, use `y-or-n-p' instead of `yes-or-no-p'."
+ :version "28.1"
+ :type 'boolean)
+
+(defun revert-buffer-quick (&optional auto-save)
+ "Like `revert-buffer', but asks for less confirmation.
+If the current buffer is visiting a file, and the buffer is not
+modified, no confirmation is required.
+
+This command heeds the `revert-buffer-quick-short-answers' user option.
+
+If AUTO-SAVE (the prefix argument), offer to revert from latest
+auto-save file, if that is more recent than the visited file."
+ (interactive "P")
+ (cond
+ ;; If we've visiting a file, and we have no changes, don't ask for
+ ;; confirmation.
+ ((and buffer-file-name
+ (not (buffer-modified-p)))
+ (revert-buffer (not auto-save) t)
+ (message "Reverted buffer"))
+ ;; Heed `revert-buffer-quick-short-answers'.
+ (revert-buffer-quick-short-answers
+ (let ((use-short-answers t))
+ (revert-buffer (not auto-save))))
+ ;; Call `revert-buffer' normally.
+ (t
+ (revert-buffer (not auto-save)))))
+
+
(defun recover-this-file ()
"Recover the visited file--get contents from its last auto-save file."
(interactive)
@@ -6739,6 +6787,7 @@ This command is used in the special Dired buffer created
by
(message "No files can be recovered from this session now")))
(kill-buffer buffer))))
+
(defun kill-buffer-ask (buffer)
"Kill BUFFER if confirmed."
(when (yes-or-no-p (format "Buffer %s %s. Kill? "
@@ -6879,7 +6928,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
@@ -6982,7 +7031,7 @@ by `sh' are supported."
(prog1 ; copy everything upto next `]'.
(substring wildcard
i
- (setq j (string-match
+ (setq j (string-search
"]" wildcard i)))
(setq i (if j (1- j) (1- len)))))))
((eq ch ?.) "\\.")
@@ -7108,7 +7157,7 @@ need to be passed verbatim to shell commands."
;; DOS/Windows don't allow `"' in file names. So if the
;; argument has quotes, we can safely assume it is already
;; quoted by the caller.
- (if (or (string-match "[\"]" pattern)
+ (if (or (string-search "\"" pattern)
;; We quote [&()#$`'] in case their shell is a port of a
;; Unixy shell. We quote [,=+] because stock DOS and
;; Windows shells require that in some cases, such as
@@ -7992,7 +8041,7 @@ based on existing mode bits, as in \"og+rX-w\"."
(default
(and (stringp modestr)
(string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
- (replace-regexp-in-string
+ (string-replace
"-" ""
(format "u=%s,g=%s,o=%s"
(match-string 1 modestr)
@@ -8008,6 +8057,7 @@ based on existing mode bits, as in \"og+rX-w\"."
(define-obsolete-variable-alias 'cache-long-line-scans
'cache-long-scans "24.4")
+
;; Trashcan handling.
(defcustom trash-directory nil
"Directory for `move-file-to-trash' to move files and directories to.
@@ -8158,6 +8208,7 @@ Otherwise, trash FILENAME using the freedesktop.org
conventions,
(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/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/frameset.el b/lisp/frameset.el
index e698d54..6aa94f8 100644
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -636,7 +636,7 @@ see `frameset-filter-alist'."
(not (frameset-switch-to-gui-p parameters))
(let* ((prefix:p (symbol-name (car current)))
(p (intern (substring prefix:p
- (1+ (string-match-p ":" prefix:p)))))
+ (1+ (string-search ":" prefix:p)))))
(val (cdr current))
(found (assq p filtered)))
(if (not found)
diff --git a/lisp/fringe.el b/lisp/fringe.el
index 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 fb0295d..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)
@@ -8288,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 6202567..b1134397 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -2186,7 +2186,7 @@ handle COLLECTION as a list, hash table, or vector."
require-match initial-input
(or hist 'gnus-group-history)
def)))
- (replace-regexp-in-string "\n" "" group)))
+ (string-replace "\n" "" group)))
;;;###autoload
(defun gnus-fetch-group (group &optional articles)
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 8182630..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)))
@@ -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)
@@ -1669,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)
":-"
@@ -1863,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
@@ -2136,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-start.el b/lisp/gnus/gnus-start.el
index 44e97d5..02bbe19 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -854,7 +854,7 @@ If REGEXP is given, lines that match it will be deleted."
(goto-char (point-max))
;; Make sure that each dribble entry is a single line, so that
;; the "remove" code above works.
- (insert (replace-regexp-in-string "\n" "\\\\n" string) "\n")
+ (insert (string-replace "\n" "\\n" string) "\n")
(bury-buffer gnus-dribble-buffer)
(with-current-buffer gnus-group-buffer
(gnus-group-set-mode-line)))))
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 8b93acc..d52bd26 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -3526,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."
@@ -3742,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 bcbf747..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
@@ -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)
@@ -7053,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") ".
@@ -7357,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") ".
@@ -8599,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))
@@ -8889,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)
@@ -8931,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 3cf6545..8a48cd8 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1299,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")
@@ -1761,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 d7fb038..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)
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 8206115..2f82d83 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -99,7 +99,7 @@ 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-symbok' 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)
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/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..3b96198 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -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/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..e06b33e 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -298,18 +298,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)
@@ -623,6 +626,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 +635,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)))
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/image-dired.el b/lisp/image-dired.el
index 2509ecf..7092f75 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'.
@@ -704,7 +672,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 +694,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 +712,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 +762,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
@@ -992,6 +960,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 +1014,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)
@@ -1173,6 +1145,13 @@ FILE-TAGS is an alist in the following form:
(cons x tag))
files))))
+(defun image-dired-tag-marked-thumbnails ()
+ "Tag marked thumbnails."
+ (interactive)
+ (when-let ((dired-buf (image-dired-associated-dired-buffer)))
+ (with-current-buffer dired-buf
+ (image-dired-tag-files nil))))
+
(defun image-dired-tag-thumbnail ()
"Tag current thumbnail."
(interactive)
@@ -1404,14 +1383,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."
@@ -1623,7 +1603,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 +1610,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)
@@ -2311,16 +2289,70 @@ 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 marked thumbnails and associated images."
+ (interactive)
+ (goto-char (point-min))
+ (let ((dired-buf (image-dired-associated-dired-buffer)))
+ (while (not (eobp))
+ (if (image-dired-thumb-file-marked-p)
+ (image-dired-delete-char)
+ (forward-char)))
+ (image-dired--line-up-with-method)
+ (with-current-buffer dired-buf
+ (dired-do-delete))))
+
+(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 97bf1ac..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)))))
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..3718a1e 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1732,14 +1732,14 @@ escaped (\\\",\\\\)."
(concat
" ("
(if (stringp Info-current-file)
- (replace-regexp-in-string
+ (string-replace
"%" "%%"
(file-name-sans-extension
(file-name-nondirectory Info-current-file)))
(format "*%S*" Info-current-file))
") "
(if Info-current-node
- (propertize (replace-regexp-in-string
+ (propertize (string-replace
"%" "%%" Info-current-node)
'face 'mode-line-buffer-id
'help-echo
@@ -2483,7 +2483,7 @@ Table of contents is created from the tree structure of
menus."
(match-string-no-properties 1)))
(section "Top")
menu-items)
- (when (and upnode (string-match "(" upnode)) (setq upnode nil))
+ (when (and upnode (string-search "(" upnode)) (setq upnode nil))
(when (and (not (Info-index-node nodename file))
(re-search-forward "^\\* Menu:" bound t))
(forward-line 1)
@@ -2616,7 +2616,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 +2933,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 +3778,7 @@ Build a menu of the possible matches."
"The following packages match the keyword ‘" nodename "’:\n\n")
(insert "* Menu:\n\n")
(let ((keywords
- (mapcar #'intern (if (string-match-p "," nodename)
+ (mapcar #'intern (if (string-search "," nodename)
(split-string nodename ",[ \t\n]*" t)
(list nodename))))
hits desc)
@@ -5244,7 +5244,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 +5252,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..71e2653 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -2166,7 +2166,7 @@ See `set-language-info-alist' for use in programs."
(let ((str (eval (get-language-info language-name 'sample-text))))
(if (stringp str)
(insert "Sample text:\n "
- (replace-regexp-in-string "\n" "\n " str)
+ (string-replace "\n" "\n " str)
"\n\n")))
(error nil))
(let ((input-method (get-language-info language-name 'input-method))
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 2d3cd25b..02169ce 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -905,13 +905,13 @@ The IGNORED argument is ignored."
(setq family "*-*")
(if (symbolp family)
(setq family (symbol-name family)))
- (or (string-match "-" family)
+ (or (string-search "-" family)
(setq family (concat "*-" family))))
(if (not registry)
(setq registry "*-*")
(if (symbolp registry)
(setq registry (symbol-name registry)))
- (or (string-match "-" registry)
+ (or (string-search "-" registry)
(= (aref registry (1- (length registry))) ?*)
(setq registry (concat registry "*"))))
(insert (format"\n -%s-%s-%s-%s-%s-*-*-*-*-*-*-%s"
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/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/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/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/rfc2368.el b/lisp/mail/rfc2368.el
index 553f3cc..b96f15d 100644
--- a/lisp/mail/rfc2368.el
+++ b/lisp/mail/rfc2368.el
@@ -91,7 +91,7 @@ Note: make sure MAILTO-URL has been \"unhtmlized\" (e.g.,
& -> &), before
calling this function."
(let ((case-fold-search t)
prequery query headers-alist)
- (setq mailto-url (replace-regexp-in-string "\n" " " mailto-url))
+ (setq mailto-url (string-replace "\n" " " mailto-url))
(if (string-match rfc2368-mailto-regexp mailto-url)
(progn
(setq prequery
diff --git a/lisp/mail/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 ac933b9..9dd9573 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -759,7 +759,7 @@ the message being processed."
;; If there are multiple lines in FROM,
;; discard up to the last newline in it.
(while (and (stringp from)
- (setq newline (string-match "\n" 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 8e3927c..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)))
@@ -700,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/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..4fae69d 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -637,8 +637,8 @@ See also `mh-compose-forward-as-mime-flag',
(defun mh-forwarded-letter-subject (from subject)
"Return a Subject suitable for a forwarded message.
Original message has headers FROM and SUBJECT."
- (let ((addr-start (string-match "<" from))
- (comment (string-match "(" from)))
+ (let ((addr-start (string-search "<" from))
+ (comment (string-search "(" from)))
(cond ((and addr-start (> addr-start 0))
;; Full Name <luser@host>
(setq from (substring from 0 (1- addr-start))))
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/minibuffer.el b/lisp/minibuffer.el
index 2c6340e..f335a9e 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2706,7 +2706,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)
@@ -2741,7 +2749,7 @@ Useful to give the user default values that won't be
substituted."
(defun completion--make-envvar-table ()
(mapcar (lambda (enventry)
- (substring enventry 0 (string-match-p "=" enventry)))
+ (substring enventry 0 (string-search "=" enventry)))
process-environment))
(defconst completion--embedded-envvar-re
@@ -2810,7 +2818,7 @@ same as `substitute-in-file-name'."
pred action))
((eq (car-safe action) 'boundaries)
(let ((start (length (file-name-directory string)))
- (end (string-match-p "/" (cdr action))))
+ (end (string-search "/" (cdr action))))
`(boundaries
;; if `string' is "C:" in w32, (file-name-directory string)
;; returns "C:/", so `start' is 3 rather than 2.
@@ -3939,27 +3947,39 @@ that is non-nil."
((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))))))
+ (cond
+ (;; Sort by flex score whenever outside the minibuffer or
+ ;; in the minibuffer with some input. 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 in this cond
+ ;; will be ignored.
+ (or (not (window-minibuffer-p))
+ (> (point-max) (minibuffer-prompt-end)))
+ (sort
+ (if existing-sort-fn
+ (funcall existing-sort-fn completions)
+ 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))))))
+ (;; If no existing sort fn and nothing flexy happening, use
+ ;; the customary sorting strategy.
+ ;;
+ ;; JT@2021-08-15: FIXME: ideally this wouldn't repeat
+ ;; logic in `completion-all-sorted-completions', but that
+ ;; logic has other context that is either expensive to
+ ;; compute or not easy to access here.
+ (not existing-sort-fn)
+ (let ((lalpha (minibuffer--sort-by-length-alpha completions))
+ (hist (and (minibufferp)
+ (and (not (eq minibuffer-history-variable t))
+ (symbol-value
minibuffer-history-variable)))))
+ (if hist (minibuffer--sort-by-position hist lalpha) lalpha)))
+ (t (funcall existing-sort-fn completions))))))
`(metadata
(display-sort-function
. ,(compose-flex-sort-fn
@@ -3988,7 +4008,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
@@ -4005,7 +4025,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..cf7c17b 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"
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/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 3f3a3df..e302aa8 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."
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 6d64100..f739cd7 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -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"))))))))
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index eec3ec7..2a81d2e 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
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index aeeb9bd..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)))))
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 f11f36e..e7aec50 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -800,7 +800,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
(dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist)))
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 5e0accc..c16e232 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -924,7 +924,10 @@ implementation will be used."
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
+ (connection-type
+ (if (plist-member args :connection-type)
+ (plist-get args :connection-type)
+ tramp-process-connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
@@ -940,7 +943,7 @@ implementation will be used."
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
- (unless (or (null connection-type) (memq connection-type '(pipe pty)))
+ (unless (memq connection-type '(nil pipe t pty))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -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 fcfad01..5a00915 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -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 6e46407..b713d5e 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -351,7 +351,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
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index eff14a2..e4f54cf 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -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
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 7cf90b9..f00434c 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -519,7 +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-yubikey-regexp tramp-action-show-and-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.
@@ -537,7 +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-yubikey-regexp tramp-action-show-and-confirm-message)
+ (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.
@@ -1740,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
@@ -2309,7 +2309,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
@@ -2602,8 +2603,8 @@ The method used must be an out-of-band method."
(save-restriction
(narrow-to-region beg-marker end-marker)
;; Some busyboxes are reluctant to discard colors.
- (unless
- (string-match-p "color" (tramp-get-connection-property v "ls" ""))
+ (unless (tramp-compat-string-search
+ "color" (tramp-get-connection-property v "ls" ""))
(goto-char (point-min))
(while (re-search-forward tramp-display-escape-sequence-regexp nil
t)
(replace-match "")))
@@ -2751,7 +2752,10 @@ implementation will be used."
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
+ (connection-type
+ (if (plist-member args :connection-type)
+ (plist-get args :connection-type)
+ tramp-process-connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
@@ -2767,7 +2771,7 @@ implementation will be used."
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
- (unless (or (null connection-type) (memq connection-type '(pipe pty)))
+ (unless (memq connection-type '(nil pipe t pty))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -2828,7 +2832,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
@@ -2915,6 +2919,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.
@@ -2957,7 +2964,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)))
@@ -3039,7 +3046,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)
@@ -4308,7 +4315,7 @@ process to set up. VEC specifies the connection."
;; Use MULE to select the right EOL convention for communicating
;; with the process.
(let ((cs (or (and (memq 'utf-8-hfs (coding-system-list))
- (string-match-p "^Darwin" uname)
+ (string-prefix-p "Darwin" uname)
(cons 'utf-8-hfs 'utf-8-hfs))
(and (memq 'utf-8 (coding-system-list))
(string-match-p "utf-?8" (tramp-get-remote-locale vec))
@@ -4321,7 +4328,7 @@ process to set up. VEC specifies the connection."
cs-encode (or (cdr cs) 'undecided)
cs-encode
(coding-system-change-eol-conversion
- cs-encode (if (string-match-p "^Darwin" uname) 'mac 'unix)))
+ cs-encode (if (string-prefix-p "Darwin" uname) 'mac 'unix)))
(tramp-send-command vec "(echo foo ; echo bar)" t)
(goto-char (point-min))
(when (search-forward "\r" nil t)
@@ -4371,7 +4378,7 @@ process to set up. VEC specifies the connection."
;; IRIX64 bash expands "!" even when in single quotes. This
;; destroys our shell functions, we must disable it. See
;;
<https://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
- (when (string-match-p "^IRIX64" uname)
+ (when (string-prefix-p "IRIX64" uname)
(tramp-send-command vec "set +H" t))
;; Disable tab expansion.
@@ -4627,12 +4634,12 @@ means standard output and thus the current buffer), or
nil (which
means discard it)."
(tramp-call-process
nil tramp-encoding-shell
- (when (and input (not (string-match-p "%s" cmd))) input)
+ (when (and input (not (tramp-compat-string-search "%s" cmd))) input)
(if (eq output t) t nil)
nil
tramp-encoding-command-switch
(concat
- (if (string-match-p "%s" cmd) (format cmd input) cmd)
+ (if (tramp-compat-string-search "%s" cmd) (format cmd input) cmd)
(if (stringp output) (concat " >" output) ""))))
(defconst tramp-inline-compress-commands
@@ -5222,7 +5229,7 @@ Return ATTR."
(when (stringp (car attr))
(aset (nth 8 attr) 0 ?l)))
;; Convert directory indication bit.
- (when (string-match-p "^d" (nth 8 attr))
+ (when (string-prefix-p "d" (nth 8 attr))
(setcar attr t))
;; Convert symlink from `tramp-do-file-attributes-with-stat'.
;; Decode also multibyte string.
@@ -5802,12 +5809,13 @@ function cell is returned to be applied on a buffer."
(with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-encoding vec)
(tramp-get-connection-property (tramp-get-process vec) prop nil)))
- (prop1 (if (string-match-p "encoding" prop)
+ (prop1 (if (tramp-compat-string-search "encoding" prop)
"inline-compress" "inline-decompress"))
compress)
;; The connection property might have been cached. So we must
;; send the script to the remote side - maybe.
- (when (and coding (symbolp coding) (string-match-p "remote" prop))
+ (when (and coding (symbolp coding)
+ (tramp-compat-string-search "remote" prop))
(let ((name (symbol-name coding)))
(while (string-match "-" name)
(setq name (replace-match "_" nil t name)))
@@ -5819,7 +5827,7 @@ function cell is returned to be applied on a buffer."
;; Return the value.
(cond
((and compress (symbolp coding))
- (if (string-match-p "decompress" prop1)
+ (if (tramp-compat-string-search "decompress" prop1)
`(lambda (beg end)
(,coding beg end)
(let ((coding-system-for-write 'binary)
@@ -5838,16 +5846,16 @@ function cell is returned to be applied on a buffer."
(,coding (point-min) (point-max)))))
((symbolp coding)
coding)
- ((and compress (string-match-p "decoding" prop))
+ ((and compress (tramp-compat-string-search "decoding" prop))
(format
;; Windows shells need the program file name after
;; the pipe symbol be quoted if they use forward
;; slashes as directory separators.
(cond
- ((and (string-match-p "local" prop)
+ ((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
@@ -5855,14 +5863,14 @@ function cell is returned to be applied on a buffer."
;; Windows shells need the program file name after
;; the pipe symbol be quoted if they use forward
;; slashes as directory separators.
- (if (and (string-match-p "local" prop)
+ (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 3d5be61..6937244 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -849,7 +849,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Check result.
(when entry
- (list (and (string-match-p "d" (nth 1 entry))
+ (list (and (tramp-compat-string-search "d" (nth 1 entry))
t) ;0 file type
-1 ;1 link count
uid ;2 uid
@@ -982,7 +982,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(mapcar
(lambda (x)
(list
- (if (string-match-p "d" (nth 1 x))
+ (if (tramp-compat-string-search "d" (nth 1 x))
(file-name-as-directory (nth 0 x))
(nth 0 x))))
(tramp-smb-get-file-entries directory)))))))
@@ -1021,7 +1021,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(defun tramp-smb-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
(if (file-exists-p filename)
- (string-match-p
+ (tramp-compat-string-search
"w"
(or (tramp-compat-file-attribute-modes (file-attributes filename)) ""))
(let ((dir (file-name-directory filename)))
@@ -1076,9 +1076,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Check for matching entries.
(mapcar
(lambda (x)
- (when (string-match-p
- (format "^%s" base) (nth 0 x))
- x))
+ (when (string-match-p (format "^%s" base) (nth 0 x)) x))
entries)
;; We just need the only and only entry FILENAME.
(list (assoc base entries)))))
@@ -1088,14 +1086,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(sort
entries
(lambda (x y)
- (if (string-match-p "t" switches)
+ (if (tramp-compat-string-search "t" switches)
;; Sort by date.
(time-less-p (nth 3 y) (nth 3 x))
;; Sort by name.
(string-lessp (nth 0 x) (nth 0 y))))))
;; Handle "-F" switch.
- (when (string-match-p "F" switches)
+ (when (tramp-compat-string-search "F" switches)
(mapc
(lambda (x)
(unless (zerop (length (car x)))
@@ -1124,7 +1122,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(expand-file-name
(nth 0 x) (file-name-directory filename))
'string)))))
- (when (string-match-p "l" switches)
+ (when (tramp-compat-string-search "l" switches)
(insert
(format
"%10s %3d %-8s %-8s %8s %s "
@@ -1153,7 +1151,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(put-text-property start (point) 'dired-filename t))
;; Insert symlink.
- (when (and (string-match-p "l" switches)
+ (when (and (tramp-compat-string-search "l" switches)
(stringp (tramp-compat-file-attribute-type attr)))
(insert " -> " (tramp-compat-file-attribute-type attr))))
@@ -1551,7 +1549,7 @@ component is used as the target of the symlink."
;; Save exit.
(with-current-buffer (tramp-get-connection-buffer v)
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (if (tramp-compat-string-search tramp-temp-buffer-name (buffer-name))
(progn
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
@@ -1857,10 +1855,12 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
mode (or (match-string 1 line) "")
mode (format
"%s%s"
- (if (string-match-p "D" mode) "d" "-")
+ (if (tramp-compat-string-search "D" mode) "d" "-")
(mapconcat
(lambda (_x) "") " "
- (concat "r" (if (string-match-p "R" mode) "-" "w") "x")))
+ (format
+ "r%sx"
+ (if (tramp-compat-string-search "R" mode) "-" "w"))))
line (substring line 0 -6))
(cl-return))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 959a0e7..83df05c 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -697,11 +697,19 @@ The regexp should match at end of buffer."
:version "27.1"
:type 'regexp)
-;; Yubikey requires the user physically to touch the device with their
-;; finger. We must tell it to the user.
-(defcustom tramp-yubikey-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 yubikey confirmation message.
+ "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)
@@ -1256,14 +1264,14 @@ this variable to be set as well."
:type '(choice (const nil) integer))
;; Logging in to a remote host normally requires obtaining a pty. But
-;; Emacs on macOS has process-connection-type set to nil by default,
+;; Emacs on macOS has `process-connection-type' set to nil by default,
;; so on those systems Tramp doesn't obtain a pty. Here, we allow
;; for an override of the system default.
(defcustom tramp-process-connection-type t
"Overrides `process-connection-type' for connections from Tramp.
Tramp binds `process-connection-type' to the value given here before
opening a connection to a remote host."
- :type '(choice (const nil) (const t) (const pty)))
+ :type '(choice (const nil) (const t) (const pipe) (const pty)))
(defcustom tramp-connection-timeout 60
"Defines the max time to wait for establishing a connection (in seconds).
@@ -1617,7 +1625,8 @@ default values are used."
(setq v (tramp-dissect-hop-name hop)
hop (and hop (tramp-make-tramp-hop-name v))))
(let ((tramp-default-host
- (or (and v (not (string-match-p "%h" (tramp-file-name-host v)))
+ (or (and v (not (tramp-compat-string-search
+ "%h" (tramp-file-name-host v)))
(tramp-file-name-host v))
tramp-default-host)))
(setq method (tramp-find-method method user host)
@@ -1965,7 +1974,7 @@ ARGUMENTS to actually emit the message (if applicable)."
(if (not btf)
(setq fn "")
(and (symbolp btf) (setq fn (symbol-name btf))
- (or (not (string-match-p "^tramp" fn))
+ (or (not (string-prefix-p "tramp" fn))
(get btf 'tramp-suppress-trace))
(setq fn nil))
(setq btn (1+ btn))))
@@ -2217,7 +2226,7 @@ If VAR is nil, then we bind `v' to the structure and
`method', `user',
"Report progress of an operation for Tramp."
(let* ((parameters (cdr reporter))
(message (aref parameters 3)))
- (when (string-match-p message (or (current-message) ""))
+ (when (tramp-compat-string-search message (or (current-message) ""))
(tramp-compat-progress-reporter-update reporter value suffix))))
(defmacro with-tramp-progress-reporter (vec level message &rest body)
@@ -2331,7 +2340,7 @@ Example:
(unless (and (functionp (nth 0 (car v)))
(cond
;; Windows registry.
- ((string-match-p "^HKEY_CURRENT_USER" (nth 1 (car v)))
+ ((string-prefix-p "HKEY_CURRENT_USER" (nth 1 (car v)))
(and (memq system-type '(cygwin windows-nt))
(zerop
(tramp-call-process
@@ -2990,8 +2999,7 @@ remote host and localname (filename on remote host)."
"Return all method completions for PARTIAL-METHOD."
(mapcar
(lambda (method)
- (and method
- (string-match-p (concat "^" (regexp-quote partial-method)) method)
+ (and method (string-prefix-p partial-method method)
(tramp-completion-make-tramp-file-name method nil nil nil)))
(mapcar #'car tramp-methods)))
@@ -3003,8 +3011,7 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match
HOST."
(cond
((and partial-user partial-host)
- (if (and host
- (string-match-p (concat "^" (regexp-quote partial-host)) host)
+ (if (and host (string-prefix-p partial-host host)
(string-equal partial-user (or user partial-user)))
(setq user partial-user)
(setq user nil
@@ -3012,16 +3019,12 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match
HOST."
(partial-user
(setq host nil)
- (unless
- (and user
- (string-match-p (concat "^" (regexp-quote partial-user)) user))
+ (unless (and user (string-prefix-p partial-user user))
(setq user nil)))
(partial-host
(setq user nil)
- (unless
- (and host
- (string-match-p (concat "^" (regexp-quote partial-host)) host))
+ (unless (and host (string-prefix-p partial-host host))
(setq host nil)))
(t (setq user nil
@@ -3699,7 +3702,7 @@ User is always nil."
(list filename switches wildcard full-directory-p))
;; `ls-lisp' always returns full listings. We must remove
;; superfluous parts.
- (unless (string-match-p "l" switches)
+ (unless (tramp-compat-string-search "l" switches)
(save-excursion
(goto-char (point-min))
(while (setq start
@@ -4090,7 +4093,10 @@ 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
+ (if (plist-member args :connection-type)
+ (plist-get args :connection-type)
+ tramp-process-connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
@@ -4106,7 +4112,7 @@ 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)))
+ (unless (memq connection-type '(nil pipe t pty))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -4122,14 +4128,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))))
@@ -4691,10 +4697,11 @@ Wait, until the connection buffer changes."
(goto-char (point-min))
(tramp-check-for-regexp proc tramp-process-action-regexp)
(with-temp-message (replace-regexp-in-string "[\r\n]" "" (match-string
0))
+ (redisplay 'force)
;; Hide message in buffer.
(narrow-to-region (point-max) (point-max))
;; Wait for new output.
- (tramp-wait-for-regexp proc 30 "."))
+ (tramp-wait-for-regexp proc 30 tramp-security-key-confirmed-regexp))
;; Reenable the timers.
(with-timeout-unsuspend stimers)))
t)
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/obsolete/terminal.el b/lisp/obsolete/terminal.el
index dbfc79b..0167a00 100644
--- a/lisp/obsolete/terminal.el
+++ b/lisp/obsolete/terminal.el
@@ -1222,7 +1222,7 @@ of the terminal-emulator"
(cond ((string-match "\\`[-a-zA-Z0-9+=_.@/:]+\\'"
string)
string)
- ((not (string-match "[$]" string))
+ ((not (string-search "$" string))
;; "[\"\\]" are special to sh and the lisp reader in the same way
(prin1-to-string string))
(t
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/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/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/cc-defs.el b/lisp/progmodes/cc-defs.el
index 5d93435..01bd64c 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."
@@ -236,6 +240,7 @@ The current point is used if POINT isn't specified.
POSITION can be
one of the following symbols:
`bol' -- beginning of line
+`boll' -- beginning of logical line (i.e. without preceding escaped NL)
`eol' -- end of line
`eoll' -- end of logical line (i.e. without escaped NL)
`bod' -- beginning of defun
@@ -266,6 +271,15 @@ to it is returned. This function does not modify the
point or the mark."
(beginning-of-line)
(point))))
+ ((eq position 'boll)
+ `(save-excursion
+ ,@(if point `((goto-char ,point)))
+ (while (progn (beginning-of-line)
+ (when (not (bobp))
+ (eq (char-before (1- (point))) ?\\)))
+ (backward-char))
+ (point)))
+
((eq position 'eol)
(if (and (cc-bytecomp-fboundp 'line-end-position) (not point))
'(line-end-position)
@@ -1254,6 +1268,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 +1279,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..5d2e41a 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 psuedo closer.
+ t
+ (setq saved-match-data (match-data))
+ (setq found t)
+ nil))))
+ (and found
+ (<= (point) beg))
+ ;; (not (save-excursion
+ ;; (goto-char (match-beginning 2))
+ ;; (c-literal-start)))
+ ))))
+ (set-match-data saved-match-data))
+
+ ;; Test whether we've found the sought closing delimiter.
+ (unless (or (null (match-data))
+ (and (not (eobp))
+ (<= (point) beg))
+ (> (match-beginning 0) beg)
+ (progn (goto-char (match-beginning 2))
+ (not (c-literal-start))))
+ (cons (match-beginning 1) (match-end 1)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun c-ml-string-delims-around-point ()
+ ;; Get POINT's relationship to any containing multi-line string or such a
+ ;; multi-line string which point is at the end of.
+ ;;
+ ;; If point isn't thus situated, return nil.
+ ;; Otherwise return the following cons:
+ ;;
+ ;; (OPENER . CLOSER)
+ ;;
+ ;; , where each of OPENER and CLOSER is a dotted list of the form
+ ;;
+ ;; (START-DELIM END-DELIM . QUOTE-POSITION)
+ ;;
+ ;; , the bounds of the delimiters and the buffer position of the ?" in the
+ ;; delimiter. If the ml-string is not validly terminated, CLOSER is instead
;; nil.
;;
;; Note: this function is dependent upon the correct syntax-table text
;; properties being set.
- (let ((state (c-semi-pp-to-literal (point)))
- open-quote-pos open-paren-pos close-paren-pos close-quote-pos id)
- (save-excursion
- (when
- (and
- (cond
- ((null (cadr state))
- (or (eq (char-after) ?\")
- (search-backward "\"" (max (- (point) 17) (point-min)) t)))
- ((and (eq (cadr state) 'string)
- (goto-char (nth 2 state))
- (cond
- ((eq (char-after) ?\"))
- ((eq (char-after) ?\()
- (let ((here (point)))
- (goto-char (max (- (point) 18) (point-min)))
- (while
- (and
- (search-forward-regexp
- c-c++-raw-string-opener-re
- (1+ here) 'limit)
- (< (point) here)))
- (and (eq (point) (1+ here))
- (match-beginning 1)
- (goto-char (1- (match-beginning 1)))))))
- (not (bobp)))))
- (c-at-c++-raw-string-opener))
- (setq open-quote-pos (point)
- open-paren-pos (match-end 1)
- id (match-string-no-properties 1))
- (goto-char (1+ open-paren-pos))
- (when (and (not (c-get-char-property open-paren-pos 'syntax-table))
- (search-forward (concat ")" id "\"") nil t))
- (setq close-paren-pos (match-beginning 0)
- close-quote-pos (1- (point))))))
- (and open-quote-pos
- (list
- (cond
- ((<= (point) open-paren-pos)
- 'open-delim)
- ((and close-paren-pos
- (> (point) close-paren-pos))
- 'close-delim)
- (t nil))
- open-quote-pos open-paren-pos close-paren-pos close-quote-pos))))
-
-(defun c-raw-string-in-end-delim (beg end)
- ;; If the region (BEG END) intersects a possible raw string terminator,
- ;; return a cons of the position of the ) and the position of the " in the
- ;; first one found.
- (save-excursion
- (goto-char (max (- beg 17) (point-min)))
- (while
- (and
- (search-forward-regexp ")\\([^ ()\\\n\r\t]\\{0,16\\}\\)\""
- (min (+ end 17) (point-max)) t)
- (<= (point) beg)))
- (unless (or (<= (point) beg)
- (>= (match-beginning 0) end))
- (cons (match-beginning 0) (match-end 1)))))
-
-(defun c-depropertize-raw-string (id open-quote open-paren bound)
- ;; Point is immediately after a raw string opening delimiter. Remove any
- ;; `syntax-table' text properties associated with the delimiter (if it's
- ;; unmatched) or the raw string.
- ;;
- ;; ID, a string, is the delimiter's identifier. OPEN-QUOTE and OPEN-PAREN
- ;; are the buffer positions of the delimiter's components. BOUND is the
- ;; bound for searching for a matching closing delimiter; it is usually nil,
- ;; but if we're inside a macro, it's the end of the macro (i.e. just before
- ;; the terminating \n).
- ;;
- ;; Point is moved to after the (terminated) raw string, or left after the
- ;; unmatched opening delimiter, as the case may be. The return value is of
- ;; no significance.
- (let ((open-paren-prop (c-get-char-property open-paren 'syntax-table))
- first)
- ;; If the delimiter is "unclosed", or sombody's used " in their id, clear
- ;; the 'syntax-table property from all of them.
- (setq first (c-clear-char-property-with-value-on-char
- open-quote open-paren 'syntax-table '(1) ?\"))
- (if first (c-truncate-lit-pos-cache first))
+ (let ((here (point))
+ (state (c-semi-pp-to-literal (point)))
+ open-dlist close-dlist ret found opener)
(cond
- ((null open-paren-prop)
- ;; Should be a terminated raw string...
- (when (search-forward (concat ")" id "\"") nil t)
- ;; Yes, it is. :-)
- ;; Clear any '(1)s from "s in the identifier.
- (setq first (c-clear-char-property-with-value-on-char
- (1+ (match-beginning 0)) (1- (match-end 0))
- 'syntax-table '(1) ?\"))
- (if first (c-truncate-lit-pos-cache first))
- ;; Clear any random `syntax-table' text properties from the contents.
- (let* ((closing-paren (match-beginning 0))
- (first-st
- (and
- (< (1+ open-paren) closing-paren)
- (or
- (and (c-get-char-property (1+ open-paren) 'syntax-table)
- (1+ open-paren))
- (and
- (setq first
- (c-next-single-property-change
- (1+ open-paren) 'syntax-table nil closing-paren))
- (< first closing-paren)
- first)))))
- (when first-st
- (c-clear-char-properties first-st (match-beginning 0)
- 'syntax-table)
- (c-truncate-lit-pos-cache first-st))
- (when (c-get-char-property (1- (match-end 0)) 'syntax-table)
- ;; Was previously an unterminated (ordinary) string
- (save-excursion
- (goto-char (1- (match-end 0)))
- (when (c-safe (c-forward-sexp)) ; to '(1) at EOL.
- (c-clear-char-property (1- (point)) 'syntax-table))
- (c-clear-char-property (1- (match-end 0)) 'syntax-table)
- (c-truncate-lit-pos-cache (1- (match-end 0))))))))
- ((or (and (equal open-paren-prop '(15)) (null bound))
- (equal open-paren-prop '(1)))
- ;; An unterminated raw string either not in a macro, or in a macro with
- ;; the open parenthesis right up against the end of macro
- (c-clear-char-property open-quote 'syntax-table)
- (c-truncate-lit-pos-cache open-quote)
- (c-clear-char-property open-paren 'syntax-table))
- (t
- ;; An unterminated string in a macro, with at least one char after the
- ;; open paren
- (c-clear-char-property open-quote 'syntax-table)
- (c-truncate-lit-pos-cache open-quote)
- (c-clear-char-property open-paren 'syntax-table)
- (c-clear-char-property-with-value (1+ open-paren) bound 'syntax-table
- '(15))))))
-
-(defun c-depropertize-raw-strings-in-region (start finish)
- ;; Remove any `syntax-table' text properties associated with C++ raw strings
- ;; contained in the region (START FINISH). Point is undefined at entry and
- ;; exit, and the return value has no significance.
- (goto-char start)
- (while (and (< (point) finish)
- (re-search-forward
- (concat "\\(" ; 1
- c-anchored-cpp-prefix ; 2
- "\\)\\|\\(" ; 3
- c-c++-raw-string-opener-re ; 4
- "\\)")
- finish t))
- (when (save-excursion
- (goto-char (match-beginning 0)) (not (c-in-literal)))
- (if (match-beginning 4) ; the id
- ;; We've found a raw string
- (c-depropertize-raw-string
- (match-string-no-properties 4) ; id
- (1+ (match-beginning 3)) ; open quote
- (match-end 4) ; open paren
- nil) ; bound
- ;; We've found a CPP construct. Search for raw strings within it.
- (goto-char (match-beginning 2)) ; the "#"
- (c-end-of-macro)
- (let ((eom (point)))
- (goto-char (match-end 2)) ; after the "#".
- (while (and (< (point) eom)
- (c-syntactic-re-search-forward
- c-c++-raw-string-opener-re eom t))
- (c-depropertize-raw-string
- (match-string-no-properties 1) ; id
- (1+ (match-beginning 0)) ; open quote
- (match-end 1) ; open paren
- eom))))))) ; bound.
-
-(defun c-before-change-check-raw-strings (beg end)
- ;; This function clears `syntax-table' text properties from C++ raw strings
- ;; whose delimiters are about to change in the region (c-new-BEG c-new-END).
- ;; BEG and END are the standard arguments supplied to any before-change
- ;; function.
+ ((or
+ ;; Is HERE between the start of an opener and the "?
+ (and (null (cadr state))
+ (progn
+ ;; Search for the start of the opener.
+ (goto-char (max (- (point) (1- c-ml-string-max-opener-len))
+ (point-min)))
+ (setq found nil)
+ ;; In the next loop, skip over any complete ml strings, or an ml
+ ;; string opener which is in a macro not containing HERE, or an
+ ;; apparent "opener" which is in a comment or string.
+ (while
+ (and (re-search-forward c-ml-string-opener-re
+ (+ here (1-
c-ml-string-max-opener-len))
+ t)
+ (< (match-beginning 1) here)
+ (or
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (or (c-in-literal)
+ (and (c-beginning-of-macro)
+ (< (progn (c-end-of-macro) (point))
+ here))))
+ (and
+ (setq found (match-beginning 1))
+ (<= (point) here)
+ (save-match-data
+ (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties 1))
+ here t))
+ (<= (point) here))))
+ (setq found nil))
+ found))
+ ;; Is HERE after the "?
+ (and (eq (cadr state) 'string)
+ (goto-char (nth 2 state))
+ (c-ml-string-opener-at-or-around-point)))
+ (setq open-dlist (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))
+ (goto-char (cadr open-dlist))
+ (setq ret
+ (cons open-dlist
+ (if (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties 1))
+ nil t)
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2)))
+ nil)))
+ (goto-char here)
+ ret)
+ ;; Is HERE between the " and the end of the closer?
+ ((and (null (cadr state))
+ (progn
+ (if (null c-ml-string-back-closer-re)
+ (goto-char (max (- here (1- c-ml-string-max-closer-len))
+ (point-min)))
+ (goto-char here)
+ (re-search-backward c-ml-string-back-closer-re nil t))
+ (re-search-forward c-ml-string-any-closer-re
+ (+ here -1 c-ml-string-max-closer-len-no-leader)
+ t))
+ (>= (match-end 1) here)
+ (<= (match-end 2) here)
+ (setq close-dlist (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))
+ (goto-char (car close-dlist))
+ (setq state (c-semi-pp-to-literal (point)))
+ (eq (cadr state) 'string)
+ (goto-char (nth 2 state))
+ (setq opener (c-ml-string-opener-around-point))
+ (goto-char (cadr opener))
+ (setq open-dlist (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))
+ (re-search-forward (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties 1))
+ nil t))
+ (goto-char here)
+ (cons open-dlist close-dlist))
+
+ (t (goto-char here)
+ nil))))
+
+(defun c-position-wrt-ml-delims (ml-string-delims)
+ ;; Given ML-STRING-DELIMS, a structure produced by
+ ;; `c-ml-string-delims-around-point' called at point, return one of the
+ ;; following indicating where POINT is with respect to the multi-line
+ ;; string:
+ ;; o - nil; not in the string.
+ ;; o - open-delim: in the open-delimiter.
+ ;; o - close-delim: in the close-delimiter.
+ ;; o - after-close: just after the close-delimiter
+ ;; o - string: inside the delimited string.
+ (cond
+ ((null ml-string-delims)
+ nil)
+ ((< (point) (cadar ml-string-delims))
+ 'open-delim)
+ ((or (null (cdr ml-string-delims))
+ (<= (point) (cadr ml-string-delims)))
+ 'string)
+ ((eq (point) (caddr ml-string-delims))
+ 'after-close)
+ (t 'close-delim)))
+
+(defun c-before-change-check-ml-strings (beg end)
+ ;; This function clears `syntax-table' text properties from multi-line
+ ;; strings whose delimiters are about to change in the region (c-new-BEG
+ ;; c-new-END). BEG and END are the standard arguments supplied to any
+ ;; before-change function.
;;
;; Point is undefined on both entry and exit, and the return value has no
;; significance.
;;
;; This function is called as a before-change function solely due to its
- ;; membership of the C++ value of `c-get-state-before-change-functions'.
+ ;; membership of mode-specific value of
+ ;; `c-get-state-before-change-functions'.
(goto-char end)
- (setq c-raw-string-end-delim-disrupted nil)
+ (setq c-ml-string-end-delim-disrupted nil)
;; We use the following to detect a R"<id>( being swallowed into a string by
;; the pending change.
(setq c-old-END-literality (c-in-literal))
+ (goto-char beg)
+ (setq c-old-beg-ml (c-ml-string-delims-around-point))
+ (setq c-beg-pos (c-position-wrt-ml-delims c-old-beg-ml))
+ (setq c-old-1-beg-ml
+ (and (not (or c-old-beg-ml (bobp)))
+ (goto-char (1- beg))
+ (c-ml-string-delims-around-point)))
+ (goto-char end)
+ (setq c-old-end-ml
+ (if (or (eq end beg)
+ (and c-old-beg-ml
+ (>= end (caar c-old-beg-ml))
+ (or (null (cdr c-old-beg-ml))
+ (< end (caddr c-old-beg-ml)))))
+ c-old-beg-ml
+ (c-ml-string-delims-around-point)))
+ (setq c-end-pos (c-position-wrt-ml-delims c-old-end-ml))
+
(c-save-buffer-state
- ((term-del (c-raw-string-in-end-delim beg end))
+ ((term-del (c-ml-string-in-end-delim beg end (car c-old-beg-ml)))
Rquote close-quote)
- (setq c-old-beg-rs (progn (goto-char beg) (c-raw-string-pos))
- c-old-end-rs (progn (goto-char end) (c-raw-string-pos)))
(cond
- ;; We're not changing, or we're obliterating raw strings.
- ((and (null c-old-beg-rs) (null c-old-end-rs)))
- ;; We're changing the putative terminating delimiter of a raw string
+ ;; We're not changing, or we're obliterating ml strings.
+ ((and (null c-beg-pos) (null c-end-pos)))
+ ;; We're changing the putative terminating delimiter of an ml string
;; containing BEG.
- ((and c-old-beg-rs term-del
- (or (null (nth 3 c-old-beg-rs))
- (<= (car term-del) (nth 3 c-old-beg-rs))))
- (setq Rquote (1- (cadr c-old-beg-rs))
- close-quote (1+ (cdr term-del)))
- (setq c-raw-string-end-delim-disrupted t)
- (c-depropertize-raw-strings-in-region Rquote close-quote)
+ ((and c-beg-pos term-del
+ (or (null (cdr c-old-beg-ml))
+ (<= (car term-del) (cadr c-old-beg-ml))))
+ (setq Rquote (caar c-old-beg-ml)
+ close-quote (cdr term-del))
+ (setq c-ml-string-end-delim-disrupted t)
+ (c-depropertize-ml-strings-in-region Rquote close-quote)
(setq c-new-BEG (min c-new-BEG Rquote)
c-new-END (max c-new-END close-quote)))
;; We're breaking an escaped NL in a raw string in a macro.
- ((and c-old-end-rs
+ ((and c-old-end-ml
(< beg end)
(goto-char end) (eq (char-before) ?\\)
(c-beginning-of-macro))
(let ((bom (point))
(eom (progn (c-end-of-macro) (point))))
- (c-depropertize-raw-strings-in-region bom eom)
+ (c-depropertize-ml-strings-in-region bom eom)
(setq c-new-BEG (min c-new-BEG bom)
c-new-END (max c-new-END eom))))
;; We're changing only the contents of a raw string.
- ((and (equal (cdr c-old-beg-rs) (cdr c-old-end-rs))
- (null (car c-old-beg-rs)) (null (car c-old-end-rs))))
+ ;; Any critical deletion of "s will be handled in
+ ;; `c-after-change-unmark-ml-strings'.
+ ((and (equal c-old-beg-ml c-old-end-ml)
+ (eq c-beg-pos 'string) (eq c-end-pos 'string)))
((or
;; We're removing (at least part of) the R" of the starting delim of a
;; raw string:
- (null c-old-beg-rs)
- (and (eq beg (cadr c-old-beg-rs))
+ (null c-old-beg-ml)
+ (and (eq beg (caar c-old-beg-ml))
(< beg end))
;; Or we're removing the ( of the starting delim of a raw string.
- (and (eq (car c-old-beg-rs) 'open-delim)
- (or (null c-old-end-rs)
- (not (eq (car c-old-end-rs) 'open-delim))
- (not (equal (cdr c-old-beg-rs) (cdr c-old-end-rs))))))
- (let ((close (nth 4 (or c-old-end-rs c-old-beg-rs))))
- (setq Rquote (1- (cadr (or c-old-end-rs c-old-beg-rs)))
- close-quote (if close (1+ close) (point-max))))
- (c-depropertize-raw-strings-in-region Rquote close-quote)
+ (and (eq c-beg-pos 'open-delim)
+ (or (null c-old-end-ml)
+ (not (eq c-end-pos 'open-delim))
+ (not (equal c-old-beg-ml c-old-end-ml))))
+ ;; Or we're disrupting a starting delim by typing into it, or removing
+ ;; characters from it.
+ (and (eq c-beg-pos 'open-delim)
+ (eq c-end-pos 'open-delim)
+ (equal c-old-beg-ml c-old-end-ml)))
+ (let ((close (caddr (or c-old-end-ml c-old-beg-ml))))
+ (setq Rquote (caar (or c-old-end-ml c-old-beg-ml))
+ close-quote (or close (point-max))))
+ (c-depropertize-ml-strings-in-region Rquote close-quote)
(setq c-new-BEG (min c-new-BEG Rquote)
- c-new-END (max c-new-END close-quote)))
- ;; We're changing only the text of the identifier of the opening
- ;; delimiter of a raw string.
- ((and (eq (car c-old-beg-rs) 'open-delim)
- (equal c-old-beg-rs c-old-end-rs))))))
-
-(defun c-propertize-raw-string-id (start end)
- ;; If the raw string identifier between buffer positions START and END
- ;; contains any double quote characters, put a punctuation syntax-table text
- ;; property on them. The return value is of no significance.
- (save-excursion
- (goto-char start)
- (while (and (skip-chars-forward "^\"" end)
- (< (point) end))
- (c-put-char-property (point) 'syntax-table '(1))
- (c-truncate-lit-pos-cache (point))
- (forward-char))))
-
-(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.
@@ -12274,7 +12675,7 @@ comment at the start of cc-engine.el for more info."
(save-excursion
(while
(progn
- (c-syntactic-skip-backward "^;=}>" closest-lim t)
+ (c-syntactic-skip-backward "^;=,}>" closest-lim
t)
(and (eq (char-before) ?>)
(c-backward-token-2)
(not (looking-at c-haskell-op-re)))))
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/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index a00440d..884104a 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -4337,7 +4337,7 @@ end
(let ((len (1- (length str)))
(index 0)
new start fmt)
- (while (setq start (string-match "%" str index))
+ (while (setq start (string-search "%" str index))
(setq fmt (if (< start len) (aref str (1+ start)) ?\?)
new (concat new
(substring str index start)
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index b9c8305..67ad39b 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -1382,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)))))
@@ -1479,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))))
@@ -1963,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)
@@ -2416,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)
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 8f0a5ac..b2a9b3e 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -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 05ad82a..08814eb 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -3150,7 +3150,7 @@ Obeying it means displaying in another window the
specified file and line."
(buffer-substring (region-beginning) (region-end))
(apply gud-find-expr-function args))))
(save-match-data
- (if (string-match "\n" expr)
+ (if (string-search "\n" expr)
(error "Expression must not include a newline"))
(with-current-buffer gud-comint-buffer
(save-excursion
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/project.el b/lisp/progmodes/project.el
index 714edeb..e864deb 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
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 0b520e3..2e23c2e 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -2277,7 +2277,7 @@ between them)."
;(goto-char beg)
(if (search-forward-regexp "^[ \t]*\\(%+\\|\\*+\\|/\\*+\\)[ \t]*"
end t)
- (replace-regexp-in-string "/" " " (buffer-substring beg (point)))
+ (string-replace "/" " " (buffer-substring beg (point)))
(beginning-of-line)
(when (search-forward-regexp "^[ \t]+" end t)
(buffer-substring beg (point)))))))))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 2557704..20299c2 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -3085,7 +3085,8 @@ t when called interactively."
(list (read-string "Python command: ") nil t))
(let ((process (or process (python-shell-get-process-or-error msg))))
(if (string-match ".\n+." string) ;Multiline.
- (let* ((temp-file-name (python-shell--save-temp-file string))
+ (let* ((temp-file-name (with-current-buffer (process-buffer process)
+ (python-shell--save-temp-file string)))
(file-name (or (buffer-file-name) temp-file-name)))
(python-shell-send-file file-name process temp-file-name t))
(comint-send-string process string)
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..b667473 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
@@ -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/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/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/replace.el b/lisp/replace.el
index ee46286..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)))
@@ -2101,7 +2101,7 @@ 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
@@ -2506,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:
@@ -2767,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.
@@ -2793,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
@@ -3240,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/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..81c2714 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -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/shell.el b/lisp/shell.el
index 5aab80d..292f267 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -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
@@ -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 3ad8634..7da315e 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2194,6 +2194,8 @@ Also see `suggest-key-bindings'."
(setq binding candidate))))
binding))
+(defvar execute-extended-command--binding-timer nil)
+
(defun execute-extended-command (prefixarg &optional command-name typed)
;; Based on Fexecute_extended_command in keyboard.c of Emacs.
;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
@@ -2258,15 +2260,24 @@ invoking, give a prefix argument to
`execute-extended-command'."
(setq binding (execute-extended-command--shorter
(symbol-name function) typed))))
(when binding
- (with-temp-message
- (format-message "You can run the command `%s' with %s"
- function
- (if (stringp binding)
- (concat "M-x " binding " RET")
- (key-description binding)))
- (sit-for (if (numberp suggest-key-bindings)
- suggest-key-bindings
- 2))))))))
+ ;; This is normally not necessary -- the timer should run
+ ;; immediately, but be defensive and ensure that we never
+ ;; have two of these timers in flight.
+ (when execute-extended-command--binding-timer
+ (cancel-timer execute-extended-command--binding-timer))
+ (setq execute-extended-command--binding-timer
+ (run-at-time
+ 0 nil
+ (lambda ()
+ (with-temp-message
+ (format-message "You can run the command `%s' with %s"
+ function
+ (if (stringp binding)
+ (concat "M-x " binding " RET")
+ (key-description binding)))
+ (sit-for (if (numberp suggest-key-bindings)
+ suggest-key-bindings
+ 2)))))))))))
(defun execute-extended-command-for-buffer (prefixarg &optional
command-name typed)
@@ -4272,11 +4283,11 @@ the contents are inserted into the buffer anyway.
Optional arguments ACTION and FRAME are as for `display-buffer',
and are used only if a pop-up buffer is displayed."
- (cond ((and (stringp message) (not (string-match "\n" message)))
+ (cond ((and (stringp message) (not (string-search "\n" message)))
;; Trivial case where we can use the echo area
(message "%s" message))
((and (stringp message)
- (= (string-match "\n" message) (1- (length message))))
+ (= (string-search "\n" message) (1- (length message))))
;; Trivial case where we can just remove single trailing newline
(message "%s" (substring message 0 (1- (length message)))))
(t
@@ -6649,9 +6660,16 @@ is temporarily turned on. Furthermore, the mark will be
deactivated
by any subsequent point motion key that was not shift-translated, or
by any action that normally deactivates the mark in Transient Mark mode.
+When the value is `permanent', the mark will be deactivated by any
+action which normally does that, but not by motion keys that were
+not shift-translated.
+
See `this-command-keys-shift-translated' for the meaning of
shift-translation."
- :type 'boolean
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "Permanent" permanent)
+ (other :tag "On" t))
+ :version "28.1"
:group 'editing-basics)
(defun handle-shift-selection ()
@@ -6669,7 +6687,12 @@ translation.
Otherwise, if the region has been activated temporarily,
deactivate it, and restore the variable `transient-mark-mode' to
its earlier value."
- (cond ((and shift-select-mode this-command-keys-shift-translated)
+ (cond ((and (eq shift-select-mode 'permanent)
+ this-command-keys-shift-translated)
+ (unless mark-active
+ (push-mark nil nil t)))
+ ((and shift-select-mode
+ this-command-keys-shift-translated)
(unless (and mark-active
(eq (car-safe transient-mark-mode) 'only))
(setq-local transient-mark-mode
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 34fbec9..3cc3e27 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -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 b828660..0a31ef2 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3681,7 +3681,7 @@ See Info node `(elisp)Security Considerations'."
"''"
;; Quote everything except POSIX filename characters.
;; This should be safe enough even for really weird shells.
- (replace-regexp-in-string
+ (string-replace
"\n" "'\n'"
(replace-regexp-in-string "[^-0-9a-zA-Z_./\n]" "\\\\\\&" argument))))
))
@@ -3859,6 +3859,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.
@@ -4808,7 +4869,7 @@ It understands Emacs Lisp quoting within STRING, such that
(split-string-and-unquote (combine-and-quote-strings strs)) == strs
The SEPARATOR regexp defaults to \"\\s-+\"."
(let ((sep (or separator "\\s-+"))
- (i (string-match "\"" string)))
+ (i (string-search "\"" string)))
(if (null i)
(split-string string sep t) ; no quoting: easy
(append (unless (eq i 0) (split-string (substring string 0 i) sep t))
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 7459e1b..4ec1143 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -365,6 +365,7 @@ When this is nil, you can create new tabs with \\[tab-new]."
(force-mode-line-update))
:group 'tab-bar
:version "27.1")
+(make-obsolete-variable 'tab-bar-new-button-show 'tab-bar-format "28.1")
(defvar tab-bar-new-button " + "
"Button for creating a new tab.")
@@ -398,16 +399,6 @@ If nil, don't show it at all."
(defvar tab-bar-forward-button " > "
"Button for going forward in tab history.")
-(defcustom tab-bar-history-buttons-show t
- "Show back and forward buttons when `tab-bar-history-mode' is enabled."
- :type 'boolean
- :initialize 'custom-initialize-default
- :set (lambda (sym val)
- (set-default sym val)
- (force-mode-line-update))
- :group 'tab-bar
- :version "28.1")
-
(defcustom tab-bar-tab-hints nil
"Show absolute numbers on tabs in the tab bar before the tab name.
This helps to select the tab by its number using `tab-bar-select-tab'
@@ -590,7 +581,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
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..b3870a8 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -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..bc61a3a 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.
+ (global-auto-composition-mode -1)
+
(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/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..e63bf36 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -944,9 +944,10 @@ See `xterm--init-frame-title'"
(defun xterm-set-window-title (&optional terminal)
"Set the window title of the Xterm TERMINAL.
The title is constructed from `frame-title-format'."
- (send-string-to-terminal
- (format "\e]2;%s\a" (format-mode-line frame-title-format))
- terminal))
+ (unless (display-graphic-p terminal)
+ (send-string-to-terminal
+ (format "\e]2;%s\a" (format-mode-line frame-title-format))
+ terminal)))
(defun xterm--selection-char (type)
(pcase type
@@ -1015,10 +1016,9 @@ hitting screen's max DCS length."
'terminal-init-screen))
(bytes (encode-coding-string data 'utf-8-unix))
(base-64 (if screen
- (replace-regexp-in-string
+ (string-replace
"\n" "\e\\\eP"
- (base64-encode-string bytes)
- :fixedcase :literal)
+ (base64-encode-string bytes))
(base64-encode-string bytes :no-line-break)))
(length (length base-64)))
(if (> length xterm-max-cut-length)
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 31186fb..5cece1a 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -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/ispell.el b/lisp/textmodes/ispell.el
index 4c64531..6785299 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -2497,7 +2497,7 @@ if defined."
"Customize `ispell-alternate-dictionary' to set yours.")))
(let* ((process-connection-type ispell-use-ptys-p)
- (wild-p (string-match "\\*" word))
+ (wild-p (string-search "*" word))
(look-p (and ispell-look-p ; Only use look for an exact match.
(or ispell-have-new-look (not wild-p))))
(prog (if look-p ispell-look-command ispell-grep-command))
@@ -2560,7 +2560,7 @@ if defined."
(continue t)
end)
(while continue
- (setq end (string-match "\n" output start)) ; get text up to the newline.
+ (setq end (string-search "\n" output start)) ; get text up to the
newline.
;; If we get out of sync and ispell-filter-continue is asserted when we
;; are not continuing, treat the next item as a separate list. When
;; ispell-filter-continue is asserted, ispell-filter *should* always be a
@@ -2732,11 +2732,11 @@ Optional third arg SHIFT is an offset to apply based on
previous corrections."
(if (eq type ?#)
(setq count 0) ; no misses for type #
(setq count (string-to-number output) ; get number of misses.
- output (substring output (1+ (string-match " " output 1)))))
+ output (substring output (1+ (string-search " " output 1)))))
(setq offset (string-to-number output))
(setq output (if (eq type ?#) ; No miss or guess list.
nil
- (substring output (1+ (string-match " " output 1)))))
+ (substring output (1+ (string-search " " output 1)))))
(while output
(let ((end (string-match ", \\|\\($\\)" output))) ; end of miss/guess.
(setq cur-count (1+ cur-count))
@@ -4077,7 +4077,7 @@ Includes LaTeX/Nroff modes and extended character mode."
(ispell-send-string "+\n~tex\n"))
((string-match "nroff-mode" string)
(ispell-send-string "-\n~nroff\n"))
- ((string-match "~" string) ; Set extended character mode.
+ ((string-search "~" string) ; Set extended character mode.
(ispell-send-string (concat string "\n")))
(t (message "Invalid Ispell Parsing argument!")
(sit-for 2))))))))
diff --git a/lisp/textmodes/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 d9d8059..c53acf5 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -2072,7 +2072,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)
@@ -2474,7 +2474,7 @@ Only applies the FSPEC to the args part of FORMAT."
(defun tex-start-tex (command file &optional dir)
"Start a TeX run, using COMMAND on FILE."
- (let* ((star (string-match "\\*" command))
+ (let* ((star (string-search "*" command))
(compile-command
(if star
(concat (substring command 0 star)
@@ -2533,7 +2533,10 @@ The value of `tex-command' specifies the command to use
to run TeX."
(file-name-as-directory (expand-file-name tex-directory)))
(tex-out-file (expand-file-name (concat tex-zap-file ".tex")
zap-directory))
- (main-file (expand-file-name (tex-main-file)))
+ ;; We may be running from an unsaved buffer, in which case
+ ;; there's no point in guessing for a main file name.
+ (main-file (and buffer-file-name
+ (expand-file-name (tex-main-file))))
(ismain (string-equal main-file (buffer-file-name)))
already-output)
;; Don't delete temp files if we do the same buffer twice in a row.
@@ -2542,9 +2545,11 @@ The value of `tex-command' specifies the command to use
to run TeX."
(let ((default-directory zap-directory)) ; why?
;; We assume the header is fully contained in tex-main-file.
;; We use f-f-ns so we get prompted about any changes on disk.
- (with-current-buffer (find-file-noselect main-file)
- (setq already-output (tex-region-header tex-out-file
- (and ismain beg))))
+ (if (not main-file)
+ (setq already-output 0)
+ (with-current-buffer (find-file-noselect main-file)
+ (setq already-output (tex-region-header tex-out-file
+ (and ismain beg)))))
;; Write out the specified region (but don't repeat anything
;; already written in the header).
(write-region (if ismain
@@ -2773,7 +2778,7 @@ so normally SUFFIX starts with one."
;; Not found, so split on first period.
(concat (file-name-directory file-name)
(substring file 0
- (string-match "\\." file))
+ (string-search "." file))
suffix)))
" "))
@@ -3337,7 +3342,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 5bbf1a8..66bbfb0 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -492,7 +492,7 @@ looks like an email address, \"ftp://\"; if it starts with
(and (string-match "\\`[[:alnum:]]+\\'" str)
(eq (char-before (car bounds)) ?<)
(eq (char-after (cdr bounds)) ?>)
- (not (string-match "~" (expand-file-name (concat "~" str))))
+ (not (string-search "~" (expand-file-name (concat "~" str))))
(setq str (concat "mailto:"; str)))
;; If it looks like news.example.com, treat it as news.
(if (thing-at-point-newsgroup-p str)
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/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/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/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/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..c8f36fb 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -1173,7 +1173,7 @@ is non-nil."
(mtime (file-attribute-modification-time (file-attributes file)))
(parsed-time (progn (require 'parse-time)
(parse-time-string (concat time " +0000")))))
- (cond ((and (not (string-match "\\+" time))
+ (cond ((and (not (string-search "+" time))
(decoded-time-second parsed-time)
;; Compare just the seconds part of the file time,
;; since CVS file time stamp resolution is just 1 second.
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 1430871..935dc8b 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -242,6 +242,15 @@ included in the completions."
;;;###autoload (load "vc-git" nil t)
;;;###autoload (vc-git-registered file))))
+(defun vc-git--literal-pathspec (pathspec)
+ "Prepend :(literal) path magic to PATHSPEC."
+ ;; Good example of PATHSPEC that needs this: "test[56].xx".
+ (and pathspec (concat ":(literal)" pathspec)))
+
+(defun vc-git--literal-pathspecs (pathspecs)
+ "Prepend :(literal) path magic to PATHSPECS."
+ (mapcar #'vc-git--literal-pathspec pathspecs))
+
(defun vc-git-registered (file)
"Check whether FILE is registered with git."
(let ((dir (vc-git-root file)))
@@ -255,12 +264,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 +351,7 @@ in the order given by `git status'."
,@(when (version<= "1.7.6.3" (vc-git--program-version))
'("--ignored"))
"--"))
- (status (apply #'vc-git--run-command-string file args)))
+ (status (apply #'vc-git--run-command-string (vc-git--literal-pathspec
file) args)))
(if (null status)
;; If status is nil, there was an error calling git, likely because
;; the file is not in a git repo.
@@ -620,28 +629,28 @@ or an empty string if none."
(pcase (vc-git-dir-status-state->stage git-state)
('update-index
(if files
- (vc-git-command (current-buffer) 'async files "add" "--refresh"
"--")
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files) "add" "--refresh" "--")
(vc-git-command (current-buffer) 'async nil
"update-index" "--refresh")))
('ls-files-added
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"ls-files" "-z" "-c" "-s" "--"))
('ls-files-up-to-date
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"ls-files" "-z" "-c" "-s" "--"))
('ls-files-conflict
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"ls-files" "-z" "-u" "--"))
('ls-files-unknown
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"ls-files" "-z" "-o" "--exclude-standard" "--"))
('ls-files-ignored
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"ls-files" "-z" "-o" "-i" "--directory"
"--no-empty-directory" "--exclude-standard" "--"))
;; --relative added in Git 1.5.5.
('diff-index
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"diff-index" "--relative" "-z" "-M" "HEAD" "--")))
(vc-run-delayed
(vc-git-after-dir-status-stage git-state))))
@@ -869,12 +878,12 @@ The car of the list is the current branch."
(when flist
(vc-git-command nil 0 flist "update-index" "--add" "--"))
(when dlist
- (vc-git-command nil 0 dlist "add"))))
+ (vc-git-command nil 0 (vc-git--literal-pathspecs dlist) "add"))))
(defalias 'vc-git-responsible-p #'vc-git-root)
(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 +950,7 @@ It is based on `log-edit-mode', and has Git-specific
extensions.")
(lambda (value) (when (equal value "yes") (list argument)))))
;; When operating on the whole tree, better pass "-a" than ".", since "."
;; fails when we're committing a merge.
- (apply #'vc-git-command nil 0 (if only files)
+ (apply #'vc-git-command nil 0 (if only (vc-git--literal-pathspecs files))
(nconc (if msg-file (list "commit" "-F"
(file-local-name msg-file))
(list "commit" "-m"))
@@ -968,7 +977,7 @@ It is based on `log-edit-mode', and has Git-specific
extensions.")
(coding-system-for-write 'binary)
(fullname
(let ((fn (vc-git--run-command-string
- file "ls-files" "-z" "--full-name" "--")))
+ (vc-git--literal-pathspec file) "ls-files" "-z"
"--full-name" "--")))
;; ls-files does not return anything when looking for a
;; revision of a file that has been renamed or removed.
(if (string= fn "")
@@ -985,14 +994,14 @@ It is based on `log-edit-mode', and has Git-specific
extensions.")
(vc-git-root file)))
(defun vc-git-checkout (file &optional rev)
- (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
+ (vc-git-command nil 0 (vc-git--literal-pathspec file) "checkout" (or rev
"HEAD")))
(defun vc-git-revert (file &optional contents-done)
"Revert FILE to the version stored in the git repository."
(if contents-done
(vc-git-command nil 0 file "update-index" "--")
- (vc-git-command nil 0 file "reset" "-q" "--")
- (vc-git-command nil nil file "checkout" "-q" "--")))
+ (vc-git-command nil 0 (vc-git--literal-pathspec file) "reset" "-q" "--")
+ (vc-git-command nil nil (vc-git--literal-pathspec file) "checkout" "-q"
"--")))
(defvar vc-git-error-regexp-alist
'(("^ \\(.+\\)\\> *|" 1 nil nil 0))
@@ -1076,7 +1085,7 @@ This prompts for a branch to merge from."
(defun vc-git-conflicted-files (directory)
"Return the list of files with conflicts in DIRECTORY."
(let* ((status
- (vc-git--run-command-string directory "status" "--porcelain" "--"))
+ (vc-git--run-command-string (vc-git--literal-pathspec directory)
"status" "--porcelain" "--"))
(lines (when status (split-string status "\n" 'omit-nulls)))
files)
(dolist (line lines files)
@@ -1157,7 +1166,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 +1331,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
;; but since Git is one of the two backends that support this operation
;; so far, it's hard to tell; hg doesn't need this.
(with-temp-buffer
- (vc-call-backend 'git 'diff file "HEAD" nil (current-buffer))
+ (vc-call-backend 'git 'diff (list file) "HEAD" nil (current-buffer))
(goto-char (point-min))
(let ((last-offset 0)
(from-offset nil)
@@ -1408,7 +1417,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(if vc-git-diff-switches
(apply #'vc-git-command (or buffer "*vc-diff*")
1 ; bug#21969
- files
+ (vc-git--literal-pathspecs files)
command
"--exit-code"
(append (vc-switches 'git 'diff)
@@ -1493,7 +1502,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(let* ((fname (file-relative-name file))
(prev-rev (with-temp-buffer
(and
- (vc-git--out-ok "rev-list" "-2" rev "--" fname)
+ (vc-git--out-ok "rev-list" "-2" rev "--"
(vc-git--literal-pathspec fname))
(goto-char (point-max))
(bolp)
(zerop (forward-line -1))
@@ -1521,7 +1530,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(current-rev
(with-temp-buffer
(and
- (vc-git--out-ok "rev-list" "-1" rev "--" file)
+ (vc-git--out-ok "rev-list" "-1" rev "--"
(vc-git--literal-pathspec file))
(goto-char (point-max))
(bolp)
(zerop (forward-line -1))
@@ -1533,7 +1542,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(and current-rev
(with-temp-buffer
(and
- (vc-git--out-ok "rev-list" "HEAD" "--" file)
+ (vc-git--out-ok "rev-list" "HEAD" "--"
(vc-git--literal-pathspec file))
(goto-char (point-min))
(search-forward current-rev nil t)
(zerop (forward-line -1))
@@ -1543,13 +1552,13 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(or (vc-git-symbolic-commit next-rev) next-rev)))
(defun vc-git-delete-file (file)
- (vc-git-command nil 0 file "rm" "-f" "--"))
+ (vc-git-command nil 0 (vc-git--literal-pathspecs file) "rm" "-f" "--"))
(defun vc-git-rename-file (old new)
- (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
+ (vc-git-command nil 0 (vc-git--literal-pathspecs (list old new)) "mv" "-f"
"--"))
(defun vc-git-mark-resolved (files)
- (vc-git-command nil 0 files "add"))
+ (vc-git-command nil 0 (vc-git--literal-pathspecs files) "add"))
(defvar vc-git-extra-menu-map
(let ((map (make-sparse-keymap)))
@@ -1772,7 +1781,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 +1815,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-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..e2b12c6 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)
@@ -2595,8 +2603,8 @@ with its diffs (if the underlying VCS supports that)."
(setq backend (vc-responsible-backend rootdir))
(unless backend
(error "Directory is not version controlled")))
- (setq default-directory rootdir)
- (vc-print-log-internal backend (list rootdir) revision revision limit
+ (setq default-directory (expand-file-name rootdir))
+ (vc-print-log-internal backend (list default-directory) revision revision
limit
(when with-diff 'with-diff))))
;;;###autoload
diff --git a/lisp/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/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/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..7e4c849 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -2995,7 +2995,7 @@ overlays_in (EMACS_INT beg, EMACS_INT end, bool extend,
ptrdiff_t next = ZV;
ptrdiff_t prev = BEGV;
bool inhibit_storing = 0;
- bool end_is_Z = end == Z;
+ bool end_is_Z = end == ZV;
for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
tail; tail = tail->next)
@@ -4268,9 +4268,10 @@ DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2,
0,
doc: /* Return a list of the overlays that overlap the region BEG ...
END.
Overlap means that at least one character is contained within the overlay
and also contained within the specified region.
+
Empty overlays are included in the result if they are located at BEG,
between BEG and END, or at END provided END denotes the position at the
-end of the buffer. */)
+end of the accessible part of the buffer. */)
(Lisp_Object beg, Lisp_Object end)
{
ptrdiff_t len, noverlays;
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/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/keyboard.c b/src/keyboard.c
index 820229c..2e4c4e6 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);
}
diff --git a/src/nsterm.m b/src/nsterm.m
index 3676418..ba5d81f 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -2929,7 +2929,6 @@ ns_destroy_fringe_bitmap (int 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)
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 e62f7e3..972b901 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -17275,8 +17275,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));
@@ -19269,7 +19272,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
@@ -19288,8 +19291,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. */
@@ -19337,7 +19343,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))
{
@@ -25428,8 +25434,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)
@@ -27009,7 +27016,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);
diff --git a/test/Makefile.in b/test/Makefile.in
index 7047c24..a3412d6 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -163,7 +163,7 @@ endif
WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; }
## On Hydra or Emba, always show logs for certain problematic tests.
ifdef EMACS_HYDRA_CI
-lisp/net/tramp-tests.log \
+lisp/net/tramp-tests.log lisp/electric-tests.log \
: WRITE_LOG = 2>&1 | tee $@
endif
ifdef EMACS_EMBA_CI
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index 449dabf..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.
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..ea856ab 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
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/cl-generic-tests.el
b/test/lisp/emacs-lisp/cl-generic-tests.el
index b48a48f..dd7511e 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -60,7 +60,10 @@
(defvar cl--generic-fooval 41)
(cl-defmethod cl--generic-1 ((_x (eql (+ cl--generic-fooval 1))) _y)
"forty-two")
- (should (equal (cl--generic-1 42 nil) "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/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..658ed2e 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."
diff --git a/test/lisp/emacs-lisp/memory-report-tests.el
b/test/lisp/emacs-lisp/memory-report-tests.el
index da5f4f5..0c0297b 100644
--- a/test/lisp/emacs-lisp/memory-report-tests.el
+++ b/test/lisp/emacs-lisp/memory-report-tests.el
@@ -45,6 +45,7 @@
(should (equal (memory-report-object-size (list 'foo)) 16))
+ (should (equal (memory-report-object-size (vector 1 2 3)) 64))
(should (equal (memory-report-object-size (vector 1 2 3 4)) 80))
(should (equal (memory-report-object-size "") 32))
@@ -52,6 +53,21 @@
(should (equal (memory-report-object-size (propertize "a" 'face 'foo))
81)))
+(ert-deftest memory-report-sizes-vectors ()
+ (should (= (memory-report--object-size
+ (make-hash-table :test #'eq)
+ ["long string that should be at least 40 bytes"])
+ 108))
+ (let ((string "long string that should be at least 40 bytes"))
+ (should (= (memory-report--object-size
+ (make-hash-table :test #'eq)
+ (vector string))
+ 108))
+ (should (= (memory-report--object-size
+ (make-hash-table :test #'eq)
+ (vector string string))
+ 124))))
+
(provide 'memory-report-tests)
;;; memory-report-tests.el ends here
diff --git a/test/lisp/emacs-lisp/pcase-tests.el
b/test/lisp/emacs-lisp/pcase-tests.el
index 02d3878..7ad01e7 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -110,4 +110,51 @@
(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/files-tests.el b/test/lisp/files-tests.el
index a612c06..fb24b98 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
@@ -610,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)))
@@ -1459,14 +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/"))))
- (let* ((path (concat "." path-separator "/tmp"))
- (parsed-path (parse-colon-path path))
- (name-start (if (memq system-type '(windows-nt ms-dos)) 2)))
- (should (equal (car parsed-path) "./"))
- (should (equal (substring (cadr parsed-path) name-start) "/tmp/"))))
+ '("/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."
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/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/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/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 052c030..3008861 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4749,7 +4749,45 @@ 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)
+ ;; `executable-find' has changed the number of
+ ;; parameters in Emacs 27.1, so we use `apply' for
+ ;; older Emacsen.
+ (ignore-errors
+ (with-no-warnings
+ (apply #'executable-find '("hexdump" remote)))))
+ (dolist (connection-type '(nil pipe t pty))
+ (unwind-protect
+ (with-temp-buffer
+ (setq proc
+ (with-no-warnings
+ (make-process
+ :name (format "test7-%s" connection-type)
+ :buffer (current-buffer)
+ :connection-type connection-type
+ :command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
+ :file-handler t)))
+ (should (processp proc))
+ (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 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'.")
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/subr-tests.el b/test/lisp/subr-tests.el
index b57982a..21b8a27 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -694,5 +694,51 @@ 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"))))
+
(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/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/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..118311c 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,25 @@ 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))))
+
;;; 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/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